diff options
415 files changed, 13699 insertions, 8485 deletions
diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 4a126c4e5a..8dbdf43e52 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -118,7 +118,15 @@ /gramlib/ @coq/parsing-maintainers /parsing/ @coq/parsing-maintainers -########## Plugins ########## +########## Standard library and plugins ########## + +/theories/ @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 @@ -195,16 +203,6 @@ /tactics/class_tactics.* @coq/typeclasses-maintainers /test-suite/typeclasses/ @coq/typeclasses-maintainers -########## Standard library ########## - -/theories/ @coq/stdlib-maintainers - -/theories/Classes/ @coq/typeclasses-maintainers - -/theories/Reals/ @coq/reals-library-maintainers - -/theories/Compat/ @coq/compat-maintainers - ########## Tools ########## /tools/coqdoc/ @coq/coqdoc-maintainers diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f439b0c34f..e8ee0c537b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -18,7 +18,7 @@ stages: variables: # Format: $IMAGE-V$DATE [Cache is not used as of today but kept here # for reference] - CACHEKEY: "bionic_coq-V2020-03-13-V69" + CACHEKEY: "bionic_coq-V2020-05-06-V70" IMAGE: "$CI_REGISTRY_IMAGE:$CACHEKEY" # By default, jobs run in the base switch; override to select another switch OPAM_SWITCH: "base" @@ -676,6 +676,9 @@ library:ci-color: library:ci-compcert: extends: .ci-template-flambda +library:ci-coq_tools: + extends: .ci-template + library:ci-coqprime: stage: stage-3 extends: .ci-template-flambda @@ -693,16 +696,16 @@ library:ci-coqprime: library:ci-coquelicot: extends: .ci-template -library:ci-cross-crypto: +library:ci-cross_crypto: extends: .ci-template -library:ci-fcsl-pcm: +library:ci-fcsl_pcm: extends: .ci-template # 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: +library:ci-fiat_crypto: extends: .ci-template stage: stage-4 needs: @@ -716,7 +719,11 @@ library:ci-fiat-crypto: - plugin:ci-rewriter library:ci-flocq: - extends: .ci-template + extends: .ci-template-flambda + artifacts: + name: "$CI_JOB_NAME" + paths: + - _build_ci library:ci-corn: extends: .ci-template-flambda @@ -724,10 +731,10 @@ library:ci-corn: needs: - build:edge+flambda - plugin:ci-bignums - - library:ci-math-classes + - library:ci-math_classes dependencies: - build:edge+flambda - - library:ci-math-classes + - library:ci-math_classes library:ci-geocoq: extends: .ci-template-flambda @@ -735,10 +742,10 @@ library:ci-geocoq: library:ci-hott: extends: .ci-template -library:ci-iris-lambda-rust: +library:ci-lambda_rust: extends: .ci-template-flambda -library:ci-math-classes: +library:ci-math_classes: extends: .ci-template-flambda stage: stage-3 artifacts: @@ -752,7 +759,7 @@ library:ci-math-classes: - build:edge+flambda - plugin:ci-bignums -library:ci-math-comp: +library:ci-mathcomp: extends: .ci-template-flambda library:ci-sf: @@ -767,11 +774,18 @@ library:ci-tlc: library:ci-unimath: extends: .ci-template-flambda -library:ci-verdi-raft: +library:ci-verdi_raft: extends: .ci-template-flambda library:ci-vst: extends: .ci-template-flambda + stage: stage-3 + needs: + - build:edge+flambda + - library:ci-flocq + dependencies: + - build:edge+flambda + - library:ci-flocq # Plugins are by definition the projects that depend on Coq's ML API @@ -9,7 +9,9 @@ ## If you're mentioned here and want to update your information, ## either amend this file and commit it, or contact the coqdev list +Guillaume Allais <guillaume.allais@ens-lyon.org> gallais <guillaume.allais@ens-lyon.org> Abhishek Anand <abhishek.anand.iitg@gmail.com> Abhishek Anand (@brixpro-home) <abhishek.anand.iitg@gmail.com> +Abhishek Anand <abhishek.anand.iitg@gmail.com> Abhishek Anand (optiplex7010@home) <abhishek.anand.iitg@gmail.com> Léo Andrès <leo@ndrs.fr> zapashcanon <leo@ndrs.fr> Jim Apple <github.public@jbapple.com> jbapple <github.public@jbapple.com> Bruno Barras <bruno.barras@inria.fr> barras <barras@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -21,13 +23,17 @@ Yves Bertot <yves.bertot@inria.fr> Yves Bertot <Yves.Bertot@inri Yves Bertot <yves.bertot@inria.fr> Yves Bertot <bertot@nardis.inria.fr> Frédéric Besson <frederic.besson@inria.fr> fbesson <fbesson@85f007b7-540e-0410-9357-904b9bb8a0f7> Siddharth Bhat <siddu.druid@gmail.com> Siddharth <siddu.druid@gmail.com> +Lasse Blaauwbroek <lasse@blaauwbroek.eu> Lasse Blaauwbroek <lasse@lasse-work.localdomain> Simon Boulier <simon.boulier@ens-rennes.fr> SimonBoulier <simon.boulier@ens-rennes.fr> +Simon Boulier <simon.boulier@ens-rennes.fr> SimonBoulier <SimonBoulier@users.noreply.github.com> Pierre Boutillier <pierre.boutillier@ens-lyon.org> pboutill <pboutill@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre <pierre.boutillier@ens-lyon.org> Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre Boutillier <pierre.boutillier@pps.univ-paris-diderot.fr> +Michele Caci <michele.caci@gmail.com> mcaci <michele.caci@gmail.com> Arthur Charguéraud <arthur@chargueraud.org> charguer <arthur@chargueraud.org> Xavier Clerc <xavier.clerc@inria.fr> xclerc <xclerc@85f007b7-540e-0410-9357-904b9bb8a0f7> Xavier Clerc <xavier.clerc@inria.fr> xclerc <xavier.clerc@inria.fr> +Cyril Cohen <cohen@crans.org> Cyril Cohen <CohenCyril@users.noreply.github.com> Pierre Corbineau <Pierre.Corbineau@NOSPAM@imag.fr> corbinea <corbinea@85f007b7-540e-0410-9357-904b9bb8a0f7> Judicaël Courant <courant@gforge> courant <courant@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre Courtieu <Pierre.Courtieu@cnam.fr> courtieu <courtieu@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -39,8 +45,10 @@ Maxime Dénès <mail@maximedenes.fr> Maxime Dénès <maxime.dene Olivier Desmettre <desmettr@gforge> desmettr <desmettr@85f007b7-540e-0410-9357-904b9bb8a0f7> Damien Doligez <doligez@gforge> doligez <doligez@85f007b7-540e-0410-9357-904b9bb8a0f7> İsmail Dönmez <ismail-s@users.noreply.github.com> Ismail <ismail-s@users.noreply.github.com> +formalize.eth <formalize@protonmail.com> ilya <ilya@localhost.localdomain> Andres Erbsen <andreser@mit.edu> Andres Erbsen <andres@kevix.co> Jim Fehrle <jfehrle@sbcglobal.net> Jim <jfehrle@sbcglobal.net> +Jim Fehrle <jfehrle@sbcglobal.net> Jim Fehrle <jim.fehrle@gmail.com> Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> filliatr <filliatr@85f007b7-540e-0410-9357-904b9bb8a0f7> Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> Jean-Christophe Filliatre <Jean-Christophe.Filliatre@lri.fr> Julien Forest <julien.forest@ensiie.fr> jforest <jforest@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -63,6 +71,7 @@ Jason Gross <jgross@mit.edu> Jason Gross <jasongross9@gmai Vincent Gross <vgross@gforge> vgross <vgross@85f007b7-540e-0410-9357-904b9bb8a0f7> Huang Guan-Shieng <huang@gforge> huang <huang@85f007b7-540e-0410-9357-904b9bb8a0f7> Hugo Herbelin <Hugo.Herbelin@inria.fr> herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> +Hugo Herbelin <Hugo.Herbelin@inria.fr> Hugo Herbelin <herbelin@users.noreply.github.com> Jasper Hugunin <jasperh@cs.washington.edu> Jasper Hugunin <jasper@hashplex.com> Tom Hutchinson <thutchin@gforge> thutchin <thutchin@85f007b7-540e-0410-9357-904b9bb8a0f7> Cezary Kaliszyk <cek@gforge> cek <cek@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -74,13 +83,18 @@ Matej Košík <matej.kosik@inria.fr> Matej Kosik <matej.kosik@in Matej Košík <matej.kosik@inria.fr> Matej Košík <mail@matej-kosik.net> Ambroise Lafont <chaster_killer@hotmail.fr> amblaf <you@example.com> Ambroise Lafont <chaster_killer@hotmail.fr> Ambroise <chaster_killer@hotmail.fr> -Vincent Laporte <Vincent.Laporte@fondation-inria.fr> Vincent Laporte <Vincent.Laporte@gmail.com> +Vincent Laporte <Vincent.Laporte@inria.fr> Vincent Laporte <Vincent.Laporte@gmail.com> +Vincent Laporte <Vincent.Laporte@inria.fr> Vincent Laporte <Vincent.Laporte@fondation-inria.fr> Marc Lasson <marc.lasson@gmail.com> mlasson <marc.lasson@gmail.com> William Lawvere <mundungus.corleone@gmail.com> william-lawvere <mundungus.corleone@gmail.com> +Larry Darryl Lee Jr. <llee454@gmail.com> llee454@gmail.com <llee454@gmail.com> +Xavier Leroy <xavier.leroy@college-de-france.fr> Xavier Leroy <xavier.leroy@inria.fr> Pierre Letouzey <pierre.letouzey@inria.fr> letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre Letouzey <pierre.letouzey@inria.fr> letouzey <pierre.letouzey@inria.fr> Xia Li-yao <lysxia@gmail.com> Lysxia <lysxia@gmail.com> +Yishuai Li <yishuai@cis.upenn.edu> Yishuai Li <yishuai@upenn.edu> Assia Mahboubi <assia.mahboubi@inria.fr> amahboub <amahboub@85f007b7-540e-0410-9357-904b9bb8a0f7> +Kenji Maillard <kenji.maillard@inria.fr> Kenji Maillard <kenji@maillard.blue> Evgeny Makarov <emakarov@gforge> emakarov <emakarov@85f007b7-540e-0410-9357-904b9bb8a0f7> Gregory Malecha <gmalecha@eecs.harvard.edu> Gregory Malecha <gmalecha@cs.harvard.edu> Gregory Malecha <gmalecha@eecs.harvard.edu> Gregory Malecha <gmalecha@gmail.com> @@ -101,11 +115,15 @@ Russell O'Connor <roconnor@blockstream.io> roconnor-blockstream <roconno Christine Paulin <cpaulin@gforge> cpaulin <cpaulin@85f007b7-540e-0410-9357-904b9bb8a0f7> Christine Paulin <cpaulin@gforge> mohring <mohring@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7> +Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> Pierre-Marie Pédrot <pierre-marie.pedrot@irif.fr> Frederic Peschanski <frederic.peschanski@lip6.fr> fredokun <frederic.peschanski@lip6.fr> Clément Pit-Claudel <clement.pitclaudel@live.com> Clément Pit--Claudel <clement.pitclaudel@live.com> +Clément Pit-Claudel <clement.pitclaudel@live.com> Clément Pit-Claudel <cpitclaudel@users.noreply.github.com> Loïc Pottier <pottier@gforge> pottier <pottier@85f007b7-540e-0410-9357-904b9bb8a0f7> Matthias Puech <puech@gforge> puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7> +Robert Rand <rnrand@gmail.com> Robert Rand <rxtreme@gmail.com> Lars Rasmusson <lars.rasmusson@sics.se> larsr <Lars.Rasmusson@sics.se> +Lars Rasmusson <lars.rasmusson@sics.se> larsr <Lars.Rasmusson@gmail.com> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> ddr <ddr@85f007b7-540e-0410-9357-904b9bb8a0f7> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel De Rauglaudre <ddr@gforge> @@ -116,6 +134,7 @@ Pierre Roux <pierre@roux01.fr> Pierre Roux <pierre.roux@oner Matthew Ryan <mr_1993@hotmail.co.uk> mrmr1993 <mr_1993@hotmail.co.uk> Claudio Sacerdoti Coen <sacerdot@gforge> sacerdot <sacerdot@85f007b7-540e-0410-9357-904b9bb8a0f7> Kazuhiko Sakaguchi <pi8027@gmail.com> Kazuhiko Sakaguchi <sakaguchi@coins.tsukuba.ac.jp> +Kazuhiko Sakaguchi <pi8027@gmail.com> Kazuhiko Sakaguchi <sakaguchi@peano-system.jp> Vincent Siles <vsiles@gforge> vsiles <vsiles@85f007b7-540e-0410-9357-904b9bb8a0f7> Michael Soegtrop <michael.soegtrop@intel.com> Michael Soegtrop <7895506+MSoegtropIMC@users.noreply.github.com> Elie Soubiran <soubiran@gforge> soubiran <soubiran@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -138,8 +157,9 @@ Benjamin Werner <werner@gforge> werner <werner@85f007b7-540e- Wang Zhuyang <hawnzug@gmail.com> hawnzug <hawnzug@gmail.com> Beta Ziliani <beta@mpi-sws.org> Beta Ziliani <bziliani@famaf.unc.edu.ar> Beta Ziliani <beta@mpi-sws.org> beta <beta@mpi-sws.org> -Théo Zimmermann <theo.zimmermann@univ-paris-diderot.fr> Theo Zimmermann <theo.zimmermann@ens.fr> -Théo Zimmermann <theo.zimmermann@univ-paris-diderot.fr> Théo Zimmermann <theo.zimmi@gmail.com> +Théo Zimmermann <theo.zimmermann@inria.fr> Theo Zimmermann <theo.zimmermann@ens.fr> +Théo Zimmermann <theo.zimmermann@inria.fr> Théo Zimmermann <theo.zimmi@gmail.com> +Théo Zimmermann <theo.zimmermann@inria.fr> Théo Zimmermann <theo.zimmermann@univ-paris-diderot.fr> # Anonymous accounts diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 201d740073..3582d18cf6 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -30,17 +30,18 @@ well. - [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) - [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) - - [Fixing bugs and performing small changes](#fixing-bugs-and-performing-small-changes) - - [Proposing large changes: Coq Enhancement Proposals](#proposing-large-changes-coq-enhancement-proposals) - - [Collaborating on a pull request](#collaborating-on-a-pull-request) - [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) @@ -443,6 +444,72 @@ 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 above +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 #### + +You are always welcome to open a PR for a change of any size. +However, 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 less +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 #### @@ -644,59 +711,35 @@ Add coqdoc comments to extend the [standard library documentation][stdlib-doc]. See the [coqdoc documentation][coqdoc-documentation] to learn more. -### 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. - -In any case, feel free to just ignore the recommendation above, and -jump ahead and open a PR with your fix. If it is not yet complete, do -not hesitate to open a [*draft PR*][GitHub-draft-PR] to get early -feedback, and talk to developers on [Gitter][]. - -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 above -on how to contribute to the documentation, and the README in -[`doc/changelog`][user-changelog] for how to add a changelog entry. +## Becoming a maintainer ## -### Proposing large changes: Coq Enhancement Proposals ### +### Reviewing pull requests ### -You are always welcome to open a PR for a change of any size. -However, 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. +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). -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]. +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 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. -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 less -components, are more likely to be reviewed and merged promptly. +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. -### Collaborating on a pull request ### +#### 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 @@ -721,42 +764,14 @@ 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. -## 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 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. - ### Merging pull requests ### Our [CODEOWNERS][] file associates a team of maintainers to each -component. When a PR is opened (or a draft PR 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. +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 @@ -1100,6 +1115,33 @@ interface to mark as read, save for later or mute threads. You can also manage your GitHub web notifications using a tool such as [Octobox][]. +##### 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][Gitter]. 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 diff --git a/Makefile.build b/Makefile.build index 5b26f11b12..3140df4cee 100644 --- a/Makefile.build +++ b/Makefile.build @@ -56,6 +56,10 @@ TIMING_SORT_BY ?= auto 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 @@ -123,6 +127,18 @@ 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:: @@ -130,9 +146,9 @@ make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: $(HIDE)($(MAKE) --no-print-directory $(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_REAL_ARG) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(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_REAL_ARG) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(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' @@ -201,12 +217,12 @@ DEPENDENCIES := \ # Default timing command # Use /usr/bin/env time on linux, gtime on Mac OS -TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)" +TIMEFMT?="$@ (real: %e, user: %U, sys: %S, mem: %M ko)" ifneq (,$(TIMED)) -ifeq (0,$(shell /usr/bin/env time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +ifeq (0,$(shell /usr/bin/env time -f "" true >/dev/null 2>/dev/null; echo $$?)) STDTIME?=/usr/bin/env time -f $(TIMEFMT) else -ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +ifeq (0,$(shell gtime -f "" true >/dev/null 2>/dev/null; echo $$?)) STDTIME?=gtime -f $(TIMEFMT) else STDTIME?=time @@ -233,8 +249,8 @@ MLINCLUDES=$(LOCALINCLUDES) USERCONTRIBINCLUDES=$(addprefix -I user-contrib/,$(USERCONTRIBDIRS)) -OCAMLC := $(OCAMLFIND) ocamlc $(CAMLFLAGS) -OCAMLOPT := $(OCAMLFIND) opt $(CAMLFLAGS) +OCAMLC = $(TIMER) $(OCAMLFIND) ocamlc $(CAMLFLAGS) +OCAMLOPT = $(TIMER) $(OCAMLFIND) opt $(CAMLFLAGS) BYTEFLAGS=$(CAMLDEBUG) $(USERFLAGS) OPTFLAGS=$(CAMLDEBUGOPT) $(CAMLTIMEPROF) $(USERFLAGS) $(FLAMBDA_FLAGS) @@ -269,10 +285,6 @@ OPT:= BESTOBJ:=.cmo BESTLIB:=.cma BESTDYN:=.cma - -# needed while booting if non -local -CAML_LD_LIBRARY_PATH := $(PWD)/kernel/byterun:$(CAML_LD_LIBRARY_PATH) -export CAML_LD_LIBRARY_PATH endif define bestobj diff --git a/Makefile.ci b/Makefile.ci index d4383fd409..af92d476ba 100644 --- a/Makefile.ci +++ b/Makefile.ci @@ -19,21 +19,22 @@ CI_TARGETS= \ ci-coq_dpdgraph \ ci-coquelicot \ ci-corn \ - ci-cross-crypto \ + ci-cross_crypto \ + ci-coq_tools \ ci-coqprime \ ci-elpi \ - ci-ext-lib \ + ci-ext_lib \ ci-equations \ - ci-fcsl-pcm \ - ci-fiat-crypto \ + ci-fcsl_pcm \ + ci-fiat_crypto \ ci-fiat_parsers \ ci-flocq \ ci-geocoq \ ci-coqhammer \ ci-hott \ - ci-iris-lambda-rust \ - ci-math-classes \ - ci-math-comp \ + ci-lambda_rust \ + ci-math_classes \ + ci-mathcomp \ ci-metacoq \ ci-mtac2 \ ci-paramcoq \ @@ -43,12 +44,12 @@ CI_TARGETS= \ ci-relation_algebra \ ci-rewriter \ ci-sf \ - ci-simple-io \ + ci-simple_io \ ci-stdlib2 \ ci-tlc \ ci-unimath \ ci-unicoq \ - ci-verdi-raft \ + ci-verdi_raft \ ci-vst .PHONY: ci-all $(CI_TARGETS) @@ -63,19 +64,21 @@ ci-color: ci-bignums ci-coqprime: ci-bignums -ci-math-classes: ci-bignums +ci-math_classes: ci-bignums -ci-corn: ci-math-classes +ci-corn: ci-math_classes ci-mtac2: ci-unicoq -ci-fiat-crypto: ci-coqprime ci-rewriter +ci-fiat_crypto: ci-coqprime ci-rewriter -ci-simple-io: ci-ext-lib -ci-quickchick: ci-ext-lib ci-simple-io +ci-simple_io: ci-ext_lib +ci-quickchick: ci-ext_lib ci-simple_io ci-metacoq: ci-equations +ci-vst: ci-flocq + # Generic rule, we use make to ease CI integration $(CI_TARGETS): ci-%: +./dev/ci/ci-wrapper.sh $* diff --git a/Makefile.doc b/Makefile.doc index effd624cff..8be032ceb3 100644 --- a/Makefile.doc +++ b/Makefile.doc @@ -100,6 +100,9 @@ doc-stdlib: \ full-stdlib: \ doc/stdlib/html/index.html doc/stdlib/FullLibrary.ps doc/stdlib/FullLibrary.pdf +sphinx-clean: + rm -rf $(SPHINXBUILDDIR) + .PHONY: plugin-tutorial plugin-tutorial: states tools +$(MAKE) COQBIN=$(PWD)/bin/ -C $(PLUGINTUTO) diff --git a/Makefile.dune b/Makefile.dune index b002c7709d..c2899dcaba 100644 --- a/Makefile.dune +++ b/Makefile.dune @@ -1,7 +1,7 @@ # -*- mode: makefile -*- # Dune Makefile for Coq -.PHONY: help states world watch check # Main developer targets +.PHONY: help help-install states world watch check # Main developer targets .PHONY: refman-html refman-pdf stdlib-html apidoc # Documentation targets .PHONY: test-suite .PHONY: fmt ocheck ireport clean # Maintenance targets @@ -11,6 +11,7 @@ # DUNEOPT=--display=short help: + @echo "" @echo "Welcome to Coq's Dune-based build system. Common developer targets are:" @echo "" @echo " - states: build a minimal functional coqtop" @@ -19,8 +20,15 @@ help: @echo " - check: build all ML files as fast as possible" @echo " - test-suite: run Coq's test suite" @echo "" - @echo " Note: these targets produce a developer build," - @echo " not suitable for distribution to end-users" + @echo " Note: running ./configure is not recommended," + @echo " see dev/doc/build-system.dune.md for more info" + @echo " Note: these targets produce a developer build, not suitable" + @echo " for distribution to end-users or install" + @echo "" + @echo " To run an \$$app \\in {coqc,coqtop,coqbyte,coqide}:" + @echo "" + @echo " - use 'dune exec -- dev/shim/\$$app-prelude args'" + @echo " Example: 'dune exec -- dev/shim/coqc-prelude file.v'" @echo "" @echo " Documentation targets:" @echo "" @@ -37,9 +45,14 @@ help: @echo " - clean: remove build directory and autogenerated files" @echo " - help: show this message" @echo "" - @echo " To run an app \\in {coqc,coqtop,coqbyte,coqide}:" + @echo " Type 'make help-install' for installation instructions" + +help-install: + @echo "" + @echo "The Dune-based Coq build is split in packages; see Dune and dev/doc" + @echo "documentation for more details. A quick install of Coq alone can done with" @echo "" - @echo " - use 'dune exec -- dev/shim/app-prelude args'" + @echo " ./configure -prefix <install_prefix> && dune build -p coq && dune install -p coq" @echo "" @echo " Provided opam/dune packages are:" @echo "" @@ -52,8 +65,16 @@ help: @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 using release mode, use: 'dune install -p package'" - @echo " See Dune documentation for more information." + @echo " Packages _must_ be installed using release mode, to install a package use: " + @echo "" + @echo " - 'dune install -p package'" + @echo "" + @echo " Example: " + @echo "" + @echo " - 'dune build -p coq,coqide-server,coqide && dune install -p coq coqide-server coqide'" + @echo "" + @echo " Note that building a package in release mode ignores other packages present in" + @echo " the worktree. See Dune documentation for more information." voboot: @echo "This target is empty and not needed anymore" diff --git a/checker/check.ml b/checker/check.ml index 4212aac6ea..31bfebc3d5 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -255,7 +255,7 @@ let try_locate_qualified_library lib = match lib with (*s Low-level interning of libraries from files *) let raw_intern_library f = - System.raw_intern_state Coq_config.vo_magic_number f + ObjFile.open_in ~file:f (************************************************************************) (* Internalise libraries *) @@ -294,57 +294,56 @@ type intern_mode = Rec | Root | Dep (* Rec = standard, Root = -norec, Dep = depe (* Dependency graph *) let depgraph = ref LibraryMap.empty -let marshal_in_segment ~validate ~value f ch = +let marshal_in_segment ~validate ~value ~segment f ch = + let () = LargeFile.seek_in ch segment.ObjFile.pos in if validate then - let v, stop, digest = + let v = try - let stop = input_binary_int ch in let v = Analyze.parse_channel ch in let digest = Digest.input ch in - v, stop, digest + let () = if not (String.equal digest segment.ObjFile.hash) then raise Exit in + v with _ -> user_err (str "Corrupted file " ++ quote (str f)) in let () = Validate.validate value v in let v = Analyze.instantiate v in - Obj.obj v, stop, digest + Obj.obj v else - System.marshal_in_segment f ch + System.marshal_in f ch -let skip_in_segment f ch = - try - let stop = (input_binary_int ch : int) in - seek_in ch stop; - let digest = Digest.input ch in - stop, digest - with _ -> - user_err (str "Corrupted file " ++ quote (str f)) - -let marshal_or_skip ~validate ~value f ch = +let marshal_or_skip ~validate ~value ~segment f ch = if validate then - let v, pos, digest = marshal_in_segment ~validate ~value f ch in - Some v, pos, digest + let v = marshal_in_segment ~validate:true ~value ~segment f ch in + Some v else - let pos, digest = skip_in_segment f ch in - None, pos, digest + None let intern_from_file ~intern_mode (dir, f) = let validate = intern_mode <> Dep in Flags.if_verbose chk_pp (str"[intern "++str f++str" ..."); let (sd,md,table,opaque_csts,digest) = try + (* First pass to read the metadata of the file *) let ch = System.with_magic_number_check raw_intern_library f in - let (sd:summary_disk), _, digest = marshal_in_segment ~validate ~value:Values.v_libsum f ch in - let (md:library_disk), _, digest = marshal_in_segment ~validate ~value:Values.v_lib f ch in - let (opaque_csts:seg_univ option), _, udg = marshal_in_segment ~validate ~value:Values.v_univopaques f ch in - let (tasks:'a option), _, _ = marshal_in_segment ~validate ~value:Values.(Opt Any) f ch in - let (table:seg_proofs option), pos, checksum = - marshal_or_skip ~validate ~value:Values.v_opaquetable f ch in + let seg_sd = ObjFile.get_segment ch ~segment:"summary" in + let seg_md = ObjFile.get_segment ch ~segment:"library" in + let seg_univs = ObjFile.get_segment ch ~segment:"universes" in + let seg_tasks = ObjFile.get_segment ch ~segment:"tasks" in + let seg_opaque = ObjFile.get_segment ch ~segment:"opaques" in + let () = ObjFile.close_in ch in + (* Actually read the data *) + let ch = open_in_bin f in + + let (sd:summary_disk) = marshal_in_segment ~validate ~value:Values.v_libsum ~segment:seg_sd f ch in + let (md:library_disk) = marshal_in_segment ~validate ~value:Values.v_lib ~segment:seg_md f ch in + let (opaque_csts:seg_univ option) = marshal_in_segment ~validate ~value:Values.v_univopaques ~segment:seg_univs f ch in + let (tasks:'a option) = marshal_in_segment ~validate ~value:Values.(Opt Any) ~segment:seg_tasks f ch in + let (table:seg_proofs option) = + marshal_or_skip ~validate ~value:Values.v_opaquetable ~segment:seg_opaque f ch in (* Verification of the final checksum *) let () = close_in ch in let ch = open_in_bin f in - if not (String.equal (Digest.channel ch pos) checksum) then - user_err ~hdr:"intern_from_file" (str "Checksum mismatch"); let () = close_in ch in if dir <> sd.md_name then user_err ~hdr:"intern_from_file" @@ -361,8 +360,9 @@ let intern_from_file ~intern_mode (dir, f) = end; Flags.if_verbose chk_pp (str" done]" ++ fnl ()); let digest = - if opaque_csts <> None then Safe_typing.Dvivo (digest,udg) - else (Safe_typing.Dvo_or_vi digest) in + let open ObjFile in + if opaque_csts <> None then Safe_typing.Dvivo (seg_md.hash, seg_univs.hash) + else (Safe_typing.Dvo_or_vi seg_md.hash) in sd,md,table,opaque_csts,digest with e -> Flags.if_verbose chk_pp (str" failed!]" ++ fnl ()); raise e in depgraph := LibraryMap.add sd.md_name sd.md_deps !depgraph; diff --git a/checker/check.mllib b/checker/check.mllib index d47a93c70d..a16a871dc3 100644 --- a/checker/check.mllib +++ b/checker/check.mllib @@ -1,5 +1,6 @@ Analyze +CheckFlags CheckInductive Mod_checking CheckTypes diff --git a/checker/checkFlags.ml b/checker/checkFlags.ml new file mode 100644 index 0000000000..1f5e76bd83 --- /dev/null +++ b/checker/checkFlags.ml @@ -0,0 +1,23 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +open Declarations + +let set_local_flags flags env = + let flags = + { (Environ.typing_flags env) with + check_guarded = flags.check_guarded; + check_positive = flags.check_positive; + check_universes = flags.check_universes; + conv_oracle = flags.conv_oracle; + cumulative_sprop = flags.cumulative_sprop; + } + in + Environ.set_typing_flags flags env diff --git a/checker/checkFlags.mli b/checker/checkFlags.mli new file mode 100644 index 0000000000..2e41e656f1 --- /dev/null +++ b/checker/checkFlags.mli @@ -0,0 +1,12 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +val set_local_flags : Declarations.typing_flags -> Environ.env -> Environ.env +(** Set flags except for those ignored by the checker (eg vm_compute). *) diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml index a1d5aedb01..c370a77ea0 100644 --- a/checker/checkInductive.ml +++ b/checker/checkInductive.ml @@ -164,16 +164,7 @@ let check_inductive env mind mb = mind_private; mind_typing_flags; } = (* Locally set typing flags for further typechecking *) - let mb_flags = mb.mind_typing_flags in - let env = Environ.set_typing_flags - {env.env_typing_flags with - check_guarded = mb_flags.check_guarded; - check_positive = mb_flags.check_positive; - check_universes = mb_flags.check_universes; - conv_oracle = mb_flags.conv_oracle; - } - env - in + 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 diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml index 44b7089fd0..2f795ff8d9 100644 --- a/checker/mod_checking.ml +++ b/checker/mod_checking.ml @@ -17,14 +17,7 @@ let set_indirect_accessor f = indirect_accessor := f let check_constant_declaration env kn cb = Flags.if_verbose Feedback.msg_notice (str " checking cst:" ++ Constant.print kn); - let cb_flags = cb.const_typing_flags in - let env = Environ.set_typing_flags - {env.env_typing_flags with - check_guarded = cb_flags.check_guarded; - check_universes = cb_flags.check_universes; - conv_oracle = cb_flags.conv_oracle;} - env - in + let env = CheckFlags.set_local_flags cb.const_typing_flags env in let poly, env = match cb.const_universes with | Monomorphic ctx -> @@ -84,7 +77,6 @@ let mk_mtb mp sign delta = mod_expr = (); mod_type = sign; mod_type_alg = None; - mod_constraints = Univ.ContextSet.empty; mod_delta = delta; mod_retroknowledge = ModTypeRK; } diff --git a/checker/safe_checking.ml b/checker/safe_checking.ml index 524ffbc022..b5beab532e 100644 --- a/checker/safe_checking.ml +++ b/checker/safe_checking.ml @@ -14,7 +14,7 @@ open Environ let import senv clib univs digest = let mb = Safe_typing.module_of_library clib in let env = Safe_typing.env_of_safe_env senv in - let env = push_context_set ~strict:true mb.mod_constraints env in + let env = push_context_set ~strict:true (Safe_typing.univs_of_library clib) env in let env = push_context_set ~strict:true univs env in let env = Modops.add_retroknowledge mb.mod_retroknowledge env in Mod_checking.check_module env mb.mod_mp mb; diff --git a/checker/values.ml b/checker/values.ml index b9efce6948..76e3ab0d45 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -241,7 +241,10 @@ let v_cst_def = [|[|Opt Int|]; [|v_cstr_subst|]; [|v_opaque|]; [|v_primitive|]|] 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_tuple "typing_flags" + [|v_bool; v_bool; v_bool; + v_oracle; v_bool; v_bool; + v_bool; v_bool; v_bool|] let v_univs = v_sum "universes" 0 [|[|v_context_set|]; [|v_abs_context|]|] @@ -356,17 +359,17 @@ and v_impl = and v_noimpl = v_unit and v_module = Tuple ("module_body", - [|v_mp;v_impl;v_sign;Opt v_mexpr;v_context_set;v_resolver;v_retroknowledge|]) + [|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_context_set;v_resolver;v_unit|]) + [|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_compiled_lib = - v_tuple "compiled" [|v_dp;v_module;v_deps;v_engagement;Any|] + v_tuple "compiled" [|v_dp;v_module;v_context_set;v_deps;v_engagement;Any|] (** Library objects *) diff --git a/checker/votour.ml b/checker/votour.ml index a83ba20dd6..3fb3ccadf4 100644 --- a/checker/votour.ml +++ b/checker/votour.ml @@ -349,14 +349,63 @@ let parse_header chan = let size64 = input_binary_int chan in { magic; length; size32; size64; objects } +module ObjFile = +struct + type segment = { name : string; - mutable pos : int; - typ : Values.value; + pos : int64; + len : int64; + hash : Digest.t; mutable header : header; } -let make_seg name typ = { name; typ; pos = 0; header = dummy_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"; @@ -364,13 +413,13 @@ let visit_vo f = Printf.printf "Object sizes are in words (%d bits)\n" Sys.word_size; Printf.printf "At prompt, <n> enters the <n>-th child, u goes up 1 level, x exits\n\n%!"; - let segments = [| - make_seg "summary" Values.v_libsum; - make_seg "library" Values.v_lib; - make_seg "univ constraints of opaque proofs" Values.v_univopaques; - make_seg "STM tasks" (Opt Values.v_stm_seg); - make_seg "opaque proofs" Values.v_opaquetable; - |] in + 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 *) @@ -379,28 +428,23 @@ let visit_vo f = let module Visit = Visit(Repr) in while true do let ch = open_in_bin f in - let magic = input_binary_int ch in - Printf.printf "File format: %d\n%!" magic; - for i=0 to Array.length segments - 1 do - let pos = input_binary_int ch in - segments.(i).pos <- pos_in ch; - let header = parse_header ch in - segments.(i).header <- header; - seek_in ch pos; - ignore(Digest.input ch); - done; + 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 { name; pos; header } -> + 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 %d (size %iw)\n" i name pos size) + Printf.printf " %d: %s, starting at byte %Ld (size %iw)\n" i name pos size) segments; match read_num (Array.length segments) with | Some seg -> - seek_in ch segments.(seg).pos; + 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 - Visit.visit segments.(seg).typ o [] + let typ = try List.assoc seg.name known_segments with Not_found -> Any in + Visit.visit typ o [] | None -> () done diff --git a/config/coq_config.mli b/config/coq_config.mli index 6ed4bf9b8e..12856cb6e6 100644 --- a/config/coq_config.mli +++ b/config/coq_config.mli @@ -35,7 +35,7 @@ val caml_version : string (* OCaml version used to compile Coq *) val caml_version_nums : int list (* OCaml version used to compile Coq by components *) val date : string (* release date *) val compile_date : string (* compile date *) -val vo_magic_number : int +val vo_version : int32 val state_magic_number : int val all_src_dirs : string list diff --git a/configure.ml b/configure.ml index eaa0e321b0..75c11dab5f 100644 --- a/configure.ml +++ b/configure.ml @@ -751,10 +751,10 @@ let check_coqide () = if !prefs.coqide = Some No then set_ide No "CoqIde manually disabled"; let dir, via = get_lablgtkdir () in if dir = "" - then set_ide No "LablGtk3 not found" + then set_ide No "LablGtk3 or LablGtkSourceView3 not found" else let (ok, version) = check_lablgtk_version () in - let found = sprintf "LablGtk3 found (%s)" version in + let found = sprintf "LablGtk3 and LablGtkSourceView3 found (%s)" version in if not ok then set_ide No (found^", but too old (required >= 3.0, found " ^ version ^ ")"); (* We're now sure to produce at least one kind of coqide *) lablgtkdir := shorten_camllib dir; @@ -983,7 +983,7 @@ let config_runtime () = ["-dllib";"-lcoqrun";"-dllpath";("\"" ^ coqtop ^ "/kernel/byterun\"")] | _ -> let ld="CAML_LD_LIBRARY_PATH" in - build_loadpath := sprintf "export %s:='%s/kernel/byterun':$(%s)" ld coqtop ld; + build_loadpath := sprintf "export %s:=%s/kernel/byterun:$(%s)" ld coqtop ld; ["-dllib";"-lcoqrun";"-dllpath";coqlib/"kernel/byterun"] let vmbyteflags = config_runtime () @@ -1059,6 +1059,7 @@ let write_configml f = let pr_s = pr "let %s = %S\n" in let pr_b = pr "let %s = %B\n" in let pr_i = pr "let %s = %d\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 @@ -1086,7 +1087,7 @@ let write_configml f = pr_s "exec_extension" exe; pr "let gtk_platform = `%s\n" !idearchdef; pr_b "has_natdynlink" hasnatdynlink; - pr_i "vo_magic_number" vo_magic; + pr_i32 "vo_version" vo_magic; pr_i "state_magic_number" state_magic; pr_s "browser" browser; pr_s "wwwcoq" !prefs.coqwebsite; diff --git a/dev/base_include b/dev/base_include index 96a867475d..45e79147c1 100644 --- a/dev/base_include +++ b/dev/base_include @@ -129,7 +129,7 @@ open Elim open Equality open Hipattern open Inv -open Leminv +open Ltac_plugin.Leminv open Tacticals open Tactics open Eqschemes diff --git a/dev/ci/README-developers.md b/dev/ci/README-developers.md index 6a740b9033..d5c6096100 100644 --- a/dev/ci/README-developers.md +++ b/dev/ci/README-developers.md @@ -72,17 +72,32 @@ Moreover your PR must absolutely update the [`CHANGES.md`](../../CHANGES.md) fil ### 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, call the script as: -``` -./dev/tools/create-overlays.sh ejgallego 9873 aac_tactics elpi ltac -``` -replacing `ejgallego` by your GitHub nickname and `9873` by the actual PR -number. 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`. +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 @@ -124,7 +139,7 @@ Currently available artifacts are: - 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. Furthemore, these artifacts are + artifacts in the PR checks section. Furthermore, these artifacts are automatically deployed at: + Coq's Reference Manual [master branch]: diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh index c18e556da8..b87a9c0392 100755 --- a/dev/ci/ci-basic-overlay.sh +++ b/dev/ci/ci-basic-overlay.sh @@ -46,9 +46,9 @@ : "${math_classes_CI_GITURL:=https://github.com/coq-community/math-classes}" : "${math_classes_CI_ARCHIVEURL:=${math_classes_CI_GITURL}/archive}" -: "${Corn_CI_REF:=master}" -: "${Corn_CI_GITURL:=https://github.com/coq-community/corn}" -: "${Corn_CI_ARCHIVEURL:=${Corn_CI_GITURL}/archive}" +: "${corn_CI_REF:=master}" +: "${corn_CI_GITURL:=https://github.com/coq-community/corn}" +: "${corn_CI_ARCHIVEURL:=${corn_CI_GITURL}/archive}" ######################################################################## # Iris @@ -59,19 +59,19 @@ : "${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/iris/stdpp}" : "${stdpp_CI_ARCHIVEURL:=${stdpp_CI_GITURL}/-/archive}" -: "${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/iris/iris}" -: "${Iris_CI_ARCHIVEURL:=${Iris_CI_GITURL}/-/archive}" +: "${iris_CI_GITURL:=https://gitlab.mpi-sws.org/iris/iris}" +: "${iris_CI_ARCHIVEURL:=${iris_CI_GITURL}/-/archive}" -: "${lambdaRust_CI_REF:=master}" -: "${lambdaRust_CI_GITURL:=https://gitlab.mpi-sws.org/iris/lambda-rust}" -: "${lambdaRust_CI_ARCHIVEURL:=${lambdaRust_CI_GITURL}/-/archive}" +: "${lambda_rust_CI_REF:=master}" +: "${lambda_rust_CI_GITURL:=https://gitlab.mpi-sws.org/iris/lambda-rust}" +: "${lambda_rust_CI_ARCHIVEURL:=${lambda_rust_CI_GITURL}/-/archive}" ######################################################################## # HoTT ######################################################################## -: "${HoTT_CI_REF:=master}" -: "${HoTT_CI_GITURL:=https://github.com/HoTT/HoTT}" -: "${HoTT_CI_ARCHIVEURL:=${HoTT_CI_GITURL}/archive}" +: "${hott_CI_REF:=master}" +: "${hott_CI_GITURL:=https://github.com/HoTT/HoTT}" +: "${hott_CI_ARCHIVEURL:=${hott_CI_GITURL}/archive}" ######################################################################## # CoqHammer @@ -83,16 +83,23 @@ ######################################################################## # GeoCoq ######################################################################## -: "${GeoCoq_CI_REF:=master}" -: "${GeoCoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq}" -: "${GeoCoq_CI_ARCHIVEURL:=${GeoCoq_CI_GITURL}/archive}" +: "${geocoq_CI_REF:=master}" +: "${geocoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq}" +: "${geocoq_CI_ARCHIVEURL:=${geocoq_CI_GITURL}/archive}" ######################################################################## # Flocq ######################################################################## -: "${Flocq_CI_REF:=master}" -: "${Flocq_CI_GITURL:=https://gitlab.inria.fr/flocq/flocq}" -: "${Flocq_CI_ARCHIVEURL:=${Flocq_CI_GITURL}/-/archive}" +: "${flocq_CI_REF:=master}" +: "${flocq_CI_GITURL:=https://gitlab.inria.fr/flocq/flocq}" +: "${flocq_CI_ARCHIVEURL:=${flocq_CI_GITURL}/-/archive}" + +######################################################################## +# coq-tools +######################################################################## +: "${coq_tools_CI_REF:=master}" +: "${coq_tools_CI_GITURL:=https://github.com/JasonGross/coq-tools}" +: "${coq_tools_CI_ARCHIVEURL:=${coq_tools_CI_GITURL}/archive}" ######################################################################## # Coquelicot @@ -242,7 +249,7 @@ # ext-lib ######################################################################## : "${ext_lib_CI_REF:=master}" -: "${ext_lib_CI_GITURL:=https://github.com/coq-ext-lib/coq-ext-lib}" +: "${ext_lib_CI_GITURL:=https://github.com/coq-community/coq-ext-lib}" : "${ext_lib_CI_ARCHIVEURL:=${ext_lib_CI_GITURL}/archive}" ######################################################################## diff --git a/dev/ci/ci-coq_tools.sh b/dev/ci/ci-coq_tools.sh new file mode 100755 index 0000000000..9c95c49c9f --- /dev/null +++ b/dev/ci/ci-coq_tools.sh @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +ci_dir="$(dirname "$0")" +. "${ci_dir}/ci-common.sh" + +git_download coq_tools + +( cd "${CI_BUILD_DIR}/coq_tools" && make check || \ + { RV=$?; 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 $RV; } ) diff --git a/dev/ci/ci-corn.sh b/dev/ci/ci-corn.sh index a0c714884c..ac3978dc8d 100755 --- a/dev/ci/ci-corn.sh +++ b/dev/ci/ci-corn.sh @@ -3,6 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -git_download Corn +git_download corn -( cd "${CI_BUILD_DIR}/Corn" && ./configure.sh && make && make install ) +( cd "${CI_BUILD_DIR}/corn" && ./configure.sh && make && make install ) diff --git a/dev/ci/ci-cross-crypto.sh b/dev/ci/ci-cross_crypto.sh index 900d12c1dd..900d12c1dd 100755 --- a/dev/ci/ci-cross-crypto.sh +++ b/dev/ci/ci-cross_crypto.sh diff --git a/dev/ci/ci-ext-lib.sh b/dev/ci/ci-ext_lib.sh index 5eb167d97d..5eb167d97d 100755 --- a/dev/ci/ci-ext-lib.sh +++ b/dev/ci/ci-ext_lib.sh diff --git a/dev/ci/ci-fcsl-pcm.sh b/dev/ci/ci-fcsl_pcm.sh index cb951630c8..cb951630c8 100755 --- a/dev/ci/ci-fcsl-pcm.sh +++ b/dev/ci/ci-fcsl_pcm.sh diff --git a/dev/ci/ci-fiat-crypto.sh b/dev/ci/ci-fiat_crypto.sh index 811fefda35..811fefda35 100755 --- a/dev/ci/ci-fiat-crypto.sh +++ b/dev/ci/ci-fiat_crypto.sh diff --git a/dev/ci/ci-flocq.sh b/dev/ci/ci-flocq.sh index e9f8324f28..a3a704091b 100755 --- a/dev/ci/ci-flocq.sh +++ b/dev/ci/ci-flocq.sh @@ -3,6 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -git_download Flocq +git_download flocq -( cd "${CI_BUILD_DIR}/Flocq" && autoconf && ./configure && ./remake "-j${NJOBS}" ) +( cd "${CI_BUILD_DIR}/flocq" && autoconf && ./configure && ./remake "-j${NJOBS}" && ./remake install ) diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh index 8c57318477..e4fc983e68 100755 --- a/dev/ci/ci-geocoq.sh +++ b/dev/ci/ci-geocoq.sh @@ -5,6 +5,6 @@ ci_dir="$(dirname "$0")" install_ssralg -git_download GeoCoq +git_download geocoq -( cd "${CI_BUILD_DIR}/GeoCoq" && ./configure.sh && make ) +( cd "${CI_BUILD_DIR}/geocoq" && ./configure.sh && make ) diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh index c8e6fe690f..4b92c8cb4d 100755 --- a/dev/ci/ci-hott.sh +++ b/dev/ci/ci-hott.sh @@ -3,6 +3,6 @@ ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" -git_download HoTT +git_download hott -( cd "${CI_BUILD_DIR}/HoTT" && ./autogen.sh -skip-submodules && ./configure && make && make validate ) +( cd "${CI_BUILD_DIR}/hott" && ./autogen.sh -skip-submodules && ./configure && make && make validate ) diff --git a/dev/ci/ci-iris-lambda-rust.sh b/dev/ci/ci-lambda_rust.sh index d99e140bce..1ef0c2cb8f 100755 --- a/dev/ci/ci-iris-lambda-rust.sh +++ b/dev/ci/ci-lambda_rust.sh @@ -5,17 +5,17 @@ ci_dir="$(dirname "$0")" install_ssreflect -# Setup lambdaRust first -git_download lambdaRust +# Setup lambda_rust first +git_download lambda_rust # Extract required version of Iris (avoiding "+" which does not work on MacOS :( *) -Iris_CI_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambdaRust/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') +iris_CI_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambda_rust/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') # Setup Iris -git_download Iris +git_download iris # Extract required version of std++ -stdpp_CI_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/Iris/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') +stdpp_CI_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/iris/opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') # Setup std++ git_download stdpp @@ -24,7 +24,7 @@ git_download stdpp ( cd "${CI_BUILD_DIR}/stdpp" && make && make install ) # Build and validate Iris -( cd "${CI_BUILD_DIR}/Iris" && make && make validate && make install ) +( cd "${CI_BUILD_DIR}/iris" && make && make validate && make install ) -# Build lambdaRust -( cd "${CI_BUILD_DIR}/lambdaRust" && make && make install ) +# Build lambda_rust +( cd "${CI_BUILD_DIR}/lambda_rust" && make && make install ) diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math_classes.sh index ae31a8e7f8..ae31a8e7f8 100755 --- a/dev/ci/ci-math-classes.sh +++ b/dev/ci/ci-math_classes.sh diff --git a/dev/ci/ci-math-comp.sh b/dev/ci/ci-mathcomp.sh index cae127ee7b..cae127ee7b 100755 --- a/dev/ci/ci-math-comp.sh +++ b/dev/ci/ci-mathcomp.sh diff --git a/dev/ci/ci-simple-io.sh b/dev/ci/ci-simple_io.sh index e7bcd80de7..e7bcd80de7 100755 --- a/dev/ci/ci-simple-io.sh +++ b/dev/ci/ci-simple_io.sh diff --git a/dev/ci/ci-verdi-raft.sh b/dev/ci/ci-verdi_raft.sh index 3bcd52c464..3bcd52c464 100755 --- a/dev/ci/ci-verdi-raft.sh +++ b/dev/ci/ci-verdi_raft.sh diff --git a/dev/ci/docker/bionic_coq/Dockerfile b/dev/ci/docker/bionic_coq/Dockerfile index e240ea3ba1..9ee6496ee5 100644 --- a/dev/ci/docker/bionic_coq/Dockerfile +++ b/dev/ci/docker/bionic_coq/Dockerfile @@ -1,4 +1,4 @@ -# CACHEKEY: "bionic_coq-V2020-03-13-V69" +# CACHEKEY: "bionic_coq-V2020-05-06-V70" # ^^ Update when modifying this file. FROM ubuntu:bionic @@ -39,7 +39,7 @@ ENV COMPILER="4.05.0" # with the compiler version. ENV BASE_OPAM="num ocamlfind.1.8.1 ounit.2.2.2 odoc.1.5.0" \ CI_OPAM="menhir.20190626 ocamlgraph.1.8.8" \ - BASE_ONLY_OPAM="elpi.1.10.2" + BASE_ONLY_OPAM="elpi.1.11.0" # BASE switch; CI_OPAM contains Coq's CI dependencies. ENV COQIDE_OPAM="cairo2.0.6.1 lablgtk3-sourceview3.3.1.0" diff --git a/dev/ci/nix/default.nix b/dev/ci/nix/default.nix index c8ea59f08a..b3ced999f6 100644 --- a/dev/ci/nix/default.nix +++ b/dev/ci/nix/default.nix @@ -22,7 +22,7 @@ let ssreflect = coqPackages.ssreflect.overrideAttrs (o: { }); in let coq-ext-lib = coqPackages.coq-ext-lib.overrideAttrs (o: { - src = fetchTarball "https://github.com/coq-ext-lib/coq-ext-lib/tarball/master"; + src = fetchTarball "https://github.com/coq-community/coq-ext-lib/tarball/master"; }); in let simple-io = diff --git a/dev/ci/user-overlays/11896-ppedrot-evar-inst-list.sh b/dev/ci/user-overlays/11896-ppedrot-evar-inst-list.sh new file mode 100644 index 0000000000..cd6b408813 --- /dev/null +++ b/dev/ci/user-overlays/11896-ppedrot-evar-inst-list.sh @@ -0,0 +1,24 @@ +if [ "$CI_PULL_REQUEST" = "11896" ] || [ "$CI_BRANCH" = "evar-inst-list" ]; then + + coqhammer_CI_REF="evar-inst-list" + coqhammer_CI_GITURL=https://github.com/ppedrot/coqhammer + + elpi_CI_REF="evar-inst-list" + elpi_CI_GITURL=https://github.com/ppedrot/coq-elpi + + equations_CI_REF="evar-inst-list" + equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations + + metacoq_CI_REF="evar-inst-list" + metacoq_CI_GITURL=https://github.com/ppedrot/metacoq + + mtac2_CI_REF="evar-inst-list" + mtac2_CI_GITURL=https://github.com/ppedrot/Mtac2 + + quickchick_CI_REF="evar-inst-list" + quickchick_CI_GITURL=https://github.com/ppedrot/QuickChick + + unicoq_CI_REF="evar-inst-list" + unicoq_CI_GITURL=https://github.com/ppedrot/unicoq + +fi diff --git a/dev/ci/user-overlays/12023-herbelin-master+fixing-empty-Ltac-v-file.sh b/dev/ci/user-overlays/12023-herbelin-master+fixing-empty-Ltac-v-file.sh new file mode 100644 index 0000000000..6bee3c7bb6 --- /dev/null +++ b/dev/ci/user-overlays/12023-herbelin-master+fixing-empty-Ltac-v-file.sh @@ -0,0 +1,15 @@ +if [ "$CI_PULL_REQUEST" = "12023" ] || [ "$CI_BRANCH" = "master+fixing-empty-Ltac-v-file" ]; then + + fiat_crypto_CI_REF=master+pr12023-atomic-tactic-now-qualified-in-ltac-file + fiat_crypto_CI_GITURL=https://github.com/herbelin/fiat-crypto + + mtac2_CI_REF=master+pr12023-atomic-tactic-now-qualified-in-ltac-file + mtac2_CI_GITURL=https://github.com/herbelin/Mtac2 + + metacoq_CI_REF=master+pr12023-atomic-tactic-now-qualified-in-ltac-file + metacoq_CI_GITURL=https://github.com/herbelin/template-coq + + unimath_CI_REF=master+pr12023-atomic-tactic-now-qualified-in-ltac-file + unimath_CI_GITURL=https://github.com/herbelin/UniMath + +fi diff --git a/dev/ci/user-overlays/12107-SkySkimmer-no-mod-univs.sh b/dev/ci/user-overlays/12107-SkySkimmer-no-mod-univs.sh new file mode 100644 index 0000000000..b5faabcfe1 --- /dev/null +++ b/dev/ci/user-overlays/12107-SkySkimmer-no-mod-univs.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "12107" ] || [ "$CI_BRANCH" = "no-mod-univs" ]; then + + elpi_CI_REF=no-mod-univs + elpi_CI_GITURL=https://github.com/SkySkimmer/coq-elpi + +fi diff --git a/dev/ci/user-overlays/12227-ppedrot-refiner-rm-v82.sh b/dev/ci/user-overlays/12227-ppedrot-refiner-rm-v82.sh new file mode 100644 index 0000000000..0f8daf418c --- /dev/null +++ b/dev/ci/user-overlays/12227-ppedrot-refiner-rm-v82.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "12227" ] || [ "$CI_BRANCH" = "refiner-rm-v82" ]; then + + equations_CI_REF="refiner-rm-v82" + equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations + +fi diff --git a/dev/ci/user-overlays/12267-gares-elpi-1.11.sh b/dev/ci/user-overlays/12267-gares-elpi-1.11.sh new file mode 100644 index 0000000000..ceb7afe3d1 --- /dev/null +++ b/dev/ci/user-overlays/12267-gares-elpi-1.11.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "12267" ] || [ "$CI_BRANCH" = "elpi-1.11" ]; then + + elpi_CI_REF="coq-master+elpi-1.11" + elpi_hb_CI_REF="coq-master+elpi.11" + +fi diff --git a/dev/top_printers.ml b/dev/top_printers.ml index 542893ad0b..00050a89e1 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -287,7 +287,7 @@ let constr_display csr = "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) -> "Evar("^(Pp.string_of_ppcmds (Evar.print e))^","^(array_display l)^")" + | Evar (e,l) -> "Evar("^(Pp.string_of_ppcmds (Evar.print e))^","^(array_display (Array.of_list 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)^")" @@ -383,7 +383,7 @@ let print_pure_constr csr = 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 "{"; - Array.iter (fun x -> print_space (); box_display x) l; + List.iter (fun x -> print_space (); box_display x) l; print_string"}" | Const (c,u) -> print_string "Cons("; sp_con_display c; diff --git a/doc/changelog/02-specification-language/11235-non_maximal_implicit.rst b/doc/changelog/02-specification-language/11235-non_maximal_implicit.rst index 67e43973ce..768ef68339 100644 --- a/doc/changelog/02-specification-language/11235-non_maximal_implicit.rst +++ b/doc/changelog/02-specification-language/11235-non_maximal_implicit.rst @@ -1,5 +1,5 @@ - **Added:** - Syntax for non maximal implicit arguments in definitions and terms using + 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 <https://github.com/coq/coq/pull/11235>`_, diff --git a/doc/changelog/02-specification-language/11368-trailing_implicit_error.rst b/doc/changelog/02-specification-language/11368-trailing_implicit_error.rst index 11d7218ed0..66139f76e1 100644 --- a/doc/changelog/02-specification-language/11368-trailing_implicit_error.rst +++ b/doc/changelog/02-specification-language/11368-trailing_implicit_error.rst @@ -1,5 +1,5 @@ - **Changed:** - The warning raised when a trailing implicit is declared to be non maximally + The warning raised when a trailing implicit is declared to be non-maximally inserted (with the command :cmd:`Arguments`) has been turned into an error. This was deprecated since Coq 8.10 (`#11368 <https://github.com/coq/coq/pull/11368>`_, diff --git a/doc/changelog/02-specification-language/12121-master+fix11903-warn-non-truly-fixpoint.rst b/doc/changelog/02-specification-language/12121-master+fix11903-warn-non-truly-fixpoint.rst new file mode 100644 index 0000000000..d69a94205f --- /dev/null +++ b/doc/changelog/02-specification-language/12121-master+fix11903-warn-non-truly-fixpoint.rst @@ -0,0 +1,5 @@ +- **Added:** + New warning on using :cmd:`Fixpoint` or :cmd:`CoFixpoint` for + definitions which are not recursive + (`#12121 <https://github.com/coq/coq/pull/12121>`_, + by Hugo Herbelin) diff --git a/doc/changelog/03-notations/11120-master+refactoring-application-printing.rst b/doc/changelog/03-notations/11120-master+refactoring-application-printing.rst index d95f554766..eeb4c755f6 100644 --- a/doc/changelog/03-notations/11120-master+refactoring-application-printing.rst +++ b/doc/changelog/03-notations/11120-master+refactoring-application-printing.rst @@ -10,7 +10,7 @@ Herbelin, fixing `#4690 <https://github.com/coq/coq/pull/4690>`_ and `#11091 <https://github.com/coq/coq/pull/11091>`_). -- **Changed:** Interpretation scopes are now always inherited in +- **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 diff --git a/doc/changelog/04-tactics/11883-fix-autounfold.rst b/doc/changelog/04-tactics/11883-fix-autounfold.rst new file mode 100644 index 0000000000..83ff177380 --- /dev/null +++ b/doc/changelog/04-tactics/11883-fix-autounfold.rst @@ -0,0 +1,13 @@ +- **Fixed:** + The behavior of :tacn:`autounfold` no longer depends on the names of terms and modules + (`#11883 <https://github.com/coq/coq/pull/11883>`_, + fixes `#7812 <https://github.com/coq/coq/issues/7812>`_, + by Attila Gáspár). +- **Changed:** + `at` clauses can no longer be used with :tacn:`autounfold`. Since they had no effect, it is safe to remove them + (`#11883 <https://github.com/coq/coq/pull/11883>`_, + by Attila Gáspár). +- **Changed:** + :tacn:`autounfold` no longer fails when the :cmd:`Opaque` command is used on constants in the hint databases + (`#11883 <https://github.com/coq/coq/pull/11883>`_, + by Attila Gáspár). diff --git a/doc/changelog/04-tactics/12023-master+fixing-empty-Ltac-v-file.rst b/doc/changelog/04-tactics/12023-master+fixing-empty-Ltac-v-file.rst new file mode 100644 index 0000000000..f10208e9b2 --- /dev/null +++ b/doc/changelog/04-tactics/12023-master+fixing-empty-Ltac-v-file.rst @@ -0,0 +1,6 @@ +- **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 <https://github.com/coq/coq/pull/12023>`_, + by Hugo Herbelin; minor source of incompatibilities). diff --git a/doc/changelog/04-tactics/12116-master+fix12045-missing-reduction-in-using-ind-scheme.rst b/doc/changelog/04-tactics/12116-master+fix12045-missing-reduction-in-using-ind-scheme.rst new file mode 100644 index 0000000000..7af2b4d97b --- /dev/null +++ b/doc/changelog/04-tactics/12116-master+fix12045-missing-reduction-in-using-ind-scheme.rst @@ -0,0 +1,5 @@ +- **Fixed:** + Anomaly with induction schemes whose conclusion is not normalized + (`#12116 <https://github.com/coq/coq/pull/12116>`_, + by Hugo Herbelin; fixes + `#12045 <https://github.com/coq/coq/pull/12045>`_) diff --git a/doc/changelog/04-tactics/12213-zify-Nat.rst b/doc/changelog/04-tactics/12213-zify-Nat.rst new file mode 100644 index 0000000000..8b744cd193 --- /dev/null +++ b/doc/changelog/04-tactics/12213-zify-Nat.rst @@ -0,0 +1,3 @@ +- **Added:** + The :tacn:`zify` tactic is now aware of `Nat.le`, `Nat.lt` and `Nat.eq` + (`#12213 <https://github.com/coq/coq/pull/12213>`_, by Frédéric Besson; fixes `#12210 <https://github.com/coq/coq/issues/12210>`_). diff --git a/doc/changelog/05-tactic-language/12197-ltacprof-multi-success.rst b/doc/changelog/05-tactic-language/12197-ltacprof-multi-success.rst new file mode 100644 index 0000000000..b90c8e7a1f --- /dev/null +++ b/doc/changelog/05-tactic-language/12197-ltacprof-multi-success.rst @@ -0,0 +1,8 @@ +- **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 + <https://github.com/coq/coq/issues/12196>`_, `#12197 + <https://github.com/coq/coq/pull/12197>`_, by Jason Gross). diff --git a/doc/changelog/07-commands-and-options/11665-cumulative-attr.rst b/doc/changelog/07-commands-and-options/11665-cumulative-attr.rst index b6a034941d..7b690da68d 100644 --- a/doc/changelog/07-commands-and-options/11665-cumulative-attr.rst +++ b/doc/changelog/07-commands-and-options/11665-cumulative-attr.rst @@ -6,7 +6,6 @@ ``Private`` (`#11665 <https://github.com/coq/coq/pull/11665>`_, by Théo Zimmermann). -- **Changed:** - Legacy attributes can now be passed in any order. See - :ref:`gallina-attributes` (`#11665 - <https://github.com/coq/coq/pull/11665>`_, by Théo Zimmermann). +- **Changed:** :term:`Legacy attributes <attribute>` can now be passed + in any order (`#11665 <https://github.com/coq/coq/pull/11665>`_, by + Théo Zimmermann). diff --git a/doc/changelog/07-commands-and-options/12034-cumul-sprop.rst b/doc/changelog/07-commands-and-options/12034-cumul-sprop.rst new file mode 100644 index 0000000000..ad7cf44482 --- /dev/null +++ b/doc/changelog/07-commands-and-options/12034-cumul-sprop.rst @@ -0,0 +1,5 @@ +- **Changed:** + Added :flag:`Cumulative StrictProp` to control cumulativity of + |SProp| and deprecated now redundant command line + ``--cumulative-sprop`` (`#12034 + <https://github.com/coq/coq/pull/12034>`_, by Gaëtan Gilbert). diff --git a/doc/changelog/08-tools/11606-memory-in-timing-scripts.rst b/doc/changelog/08-tools/11606-memory-in-timing-scripts.rst new file mode 100644 index 0000000000..e09c6ef3a3 --- /dev/null +++ b/doc/changelog/08-tools/11606-memory-in-timing-scripts.rst @@ -0,0 +1,25 @@ +- **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 <https://github.com/coq/coq/pull/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 <https://github.com/coq/coq/pull/11606>`_, + by Jason Gross). + +- **Changed:** + 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 + <https://github.com/coq/coq/pull/11606>`_, by Jason Gross). diff --git a/doc/changelog/08-tools/12026-master+coqdoc-self-linked-defs-wish7093.rst b/doc/changelog/08-tools/12026-master+coqdoc-self-linked-defs-wish7093.rst new file mode 100644 index 0000000000..5c4ef82b8b --- /dev/null +++ b/doc/changelog/08-tools/12026-master+coqdoc-self-linked-defs-wish7093.rst @@ -0,0 +1,4 @@ +- **Added:** + Definitions in coqdoc link to themselves, giving access in html to their own url + (`#12026 <https://github.com/coq/coq/pull/12026>`_, + by Hugo Herbelin; granting `#7093 <https://github.com/coq/coq/pull/7093>`_). diff --git a/doc/changelog/08-tools/12027-master+fix3415-coqdoc-record.rst b/doc/changelog/08-tools/12027-master+fix3415-coqdoc-record.rst new file mode 100644 index 0000000000..ae9b69e592 --- /dev/null +++ b/doc/changelog/08-tools/12027-master+fix3415-coqdoc-record.rst @@ -0,0 +1,5 @@ +- **Fixed:** + Fields of a record tuple now link in coqdoc to their definition + (`#12027 <https://github.com/coq/coq/pull/12027>`_, fixes + `#3415 <https://github.com/coq/coq/issues/3415>`_, + by Hugo Herbelin; ). diff --git a/doc/changelog/08-tools/12033-master+coqdoc-fix7697-passing-binders-location.rst b/doc/changelog/08-tools/12033-master+coqdoc-fix7697-passing-binders-location.rst new file mode 100644 index 0000000000..af0d28305a --- /dev/null +++ b/doc/changelog/08-tools/12033-master+coqdoc-fix7697-passing-binders-location.rst @@ -0,0 +1,5 @@ +- **Added:** + Add hyperlinks on bound variables for coqdoc + (`#12033 <https://github.com/coq/coq/pull/12033>`_, + by Hugo Herbelin; it incidentally fixes + `#7697 <https://github.com/coq/coq/pull/7697>`_). diff --git a/doc/changelog/08-tools/12091-master+coqdoc-css-target.rst b/doc/changelog/08-tools/12091-master+coqdoc-css-target.rst new file mode 100644 index 0000000000..f6af5d40e8 --- /dev/null +++ b/doc/changelog/08-tools/12091-master+coqdoc-css-target.rst @@ -0,0 +1,4 @@ +- **Added:** + ``Coqdoc``: Highlighting of the exact position of the target of links + (`#12091 <https://github.com/coq/coq/pull/12091>`_, + by Hugo Herbelin). diff --git a/doc/changelog/08-tools/12126-adjust-timed-name.rst b/doc/changelog/08-tools/12126-adjust-timed-name.rst new file mode 100644 index 0000000000..c305b384d9 --- /dev/null +++ b/doc/changelog/08-tools/12126-adjust-timed-name.rst @@ -0,0 +1,8 @@ +- **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 + <https://github.com/coq/coq/pull/12126>`_, by Jason Gross). diff --git a/doc/changelog/08-tools/12211-time-ocaml.rst b/doc/changelog/08-tools/12211-time-ocaml.rst new file mode 100644 index 0000000000..7ff68cc495 --- /dev/null +++ b/doc/changelog/08-tools/12211-time-ocaml.rst @@ -0,0 +1,5 @@ +- **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 + <https://github.com/coq/coq/pull/12211>`_, by Jason Gross). diff --git a/doc/changelog/09-coqide/12060-ide-disable-csd.rst b/doc/changelog/09-coqide/12060-ide-disable-csd.rst new file mode 100644 index 0000000000..b61ab26007 --- /dev/null +++ b/doc/changelog/09-coqide/12060-ide-disable-csd.rst @@ -0,0 +1,6 @@ +- **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 <https://github.com/coq/coq/pull/12060>`_, + fixes `#11080 <https://github.com/coq/coq/issues/11080>`_, + by Attila Gáspár). diff --git a/doc/changelog/09-coqide/12068-master+coqide-completion-no-matched.rst b/doc/changelog/09-coqide/12068-master+coqide-completion-no-matched.rst new file mode 100644 index 0000000000..dbb4bdecab --- /dev/null +++ b/doc/changelog/09-coqide/12068-master+coqide-completion-no-matched.rst @@ -0,0 +1,5 @@ +- **Fixed:** + New patch presumably fixing the random Coq 8.11 segfault issue with CoqIDE completion + (`#12068 <https://github.com/coq/coq/pull/12068>`_, + by Hugo Herbelin, presumably fixing + `#11943 <https://github.com/coq/coq/pull/11943>`_). diff --git a/doc/changelog/09-coqide/12106-master+coqide-style-apply-all-windows.rst b/doc/changelog/09-coqide/12106-master+coqide-style-apply-all-windows.rst new file mode 100644 index 0000000000..6b1148a9a8 --- /dev/null +++ b/doc/changelog/09-coqide/12106-master+coqide-style-apply-all-windows.rst @@ -0,0 +1,5 @@ +- **Fixed:** + Highlighting style consistently applied to all three buffers of CoqIDE + (`#12106 <https://github.com/coq/coq/pull/12106>`_, + by Hugo Herbelin; fixes + `#11506 <https://github.com/coq/coq/pull/11506>`_). diff --git a/doc/changelog/10-standard-library/12008-ollibs-bool.rst b/doc/changelog/10-standard-library/12008-ollibs-bool.rst new file mode 100644 index 0000000000..7c10d261a7 --- /dev/null +++ b/doc/changelog/10-standard-library/12008-ollibs-bool.rst @@ -0,0 +1,5 @@ +- **Added:** + Order relations ``ltb`` and ``compareb`` 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 <https://github.com/coq/coq/pull/12008>`_, + by Olivier Laurent). diff --git a/doc/changelog/10-standard-library/12014-ollibs-vector.rst b/doc/changelog/10-standard-library/12014-ollibs-vector.rst new file mode 100644 index 0000000000..87625dd23b --- /dev/null +++ b/doc/changelog/10-standard-library/12014-ollibs-vector.rst @@ -0,0 +1,10 @@ +- **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 <https://github.com/coq/coq/pull/12014>`_, + by Olivier Laurent). diff --git a/doc/changelog/10-standard-library/12018-master+implb-characterization.rst b/doc/changelog/10-standard-library/12018-master+implb-characterization.rst new file mode 100644 index 0000000000..4b0abdfa3b --- /dev/null +++ b/doc/changelog/10-standard-library/12018-master+implb-characterization.rst @@ -0,0 +1,19 @@ +- **Added:** + 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 <https://github.com/coq/coq/pull/12018>`_,` + by Hugo Herbelin).` diff --git a/doc/changelog/10-standard-library/12031-ollibs-cpermutation.rst b/doc/changelog/10-standard-library/12031-ollibs-cpermutation.rst new file mode 100644 index 0000000000..95b4cce2f7 --- /dev/null +++ b/doc/changelog/10-standard-library/12031-ollibs-cpermutation.rst @@ -0,0 +1,4 @@ +- **Added:** + Definition and properties of cyclic permutations / circular shifts: ``CPermutation`` + (`#12031 <https://github.com/coq/coq/pull/12031>`_, + by Olivier Laurent). diff --git a/doc/changelog/10-standard-library/12044-issue-12015.rst b/doc/changelog/10-standard-library/12044-issue-12015.rst new file mode 100644 index 0000000000..166fc80fb0 --- /dev/null +++ b/doc/changelog/10-standard-library/12044-issue-12015.rst @@ -0,0 +1,10 @@ +- **Fixed:** + Rewrote ``Structures.OrderedTypeEx.String_as_OT.compare`` + to avoid huge proof terms + (Fixes `#12015 <https://github.com/coq/coq/issues/12015>`_, + `#12044 <https://github.com/coq/coq/pull/12044>`_, + by formalize.eth (formalize@protonmail.com)). +- **Added:** + Added ``Structures.OrderedTypeEx.Ascii_as_OT`` + (`#12044 <https://github.com/coq/coq/pull/12044>`_, + by formalize.eth (formalize@protonmail.com)). diff --git a/doc/changelog/10-standard-library/12073-split-nsatz.rst b/doc/changelog/10-standard-library/12073-split-nsatz.rst new file mode 100644 index 0000000000..bc3c24e441 --- /dev/null +++ b/doc/changelog/10-standard-library/12073-split-nsatz.rst @@ -0,0 +1,11 @@ +- **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 (fixes `#5445 + <https://github.com/coq/coq/issues/5445>`_, `#12073 + <https://github.com/coq/coq/pull/12073>`_, by Jason Gross). diff --git a/doc/changelog/10-standard-library/12119-issue12119.rst b/doc/changelog/10-standard-library/12119-issue12119.rst new file mode 100644 index 0000000000..42672b1465 --- /dev/null +++ b/doc/changelog/10-standard-library/12119-issue12119.rst @@ -0,0 +1,5 @@ +- **Changed:** + new lemma ``NoDup_incl_NoDup`` in ``List.v`` + to remove useless hypothesis `NoDup l'` in ``Sorting.Permutation.NoDup_Permutation_bis`` + (`#12119 <https://github.com/coq/coq/pull/12119>`_, + by Olivier Laurent). diff --git a/doc/changelog/10-standard-library/12121-master+fix11903-warn-non-truly-fixpoint.rst b/doc/changelog/10-standard-library/12121-master+fix11903-warn-non-truly-fixpoint.rst new file mode 100644 index 0000000000..f22fff0736 --- /dev/null +++ b/doc/changelog/10-standard-library/12121-master+fix11903-warn-non-truly-fixpoint.rst @@ -0,0 +1,5 @@ +- **Fixed:** + :cmd:`Fixpoint`\s of the standard library without a recursive call turned + into ordinary :cmd:`Definition`\s + (`#12121 <https://github.com/coq/coq/pull/12121>`_, + by Hugo Herbelin; fixes `#11903 <https://github.com/coq/coq/pull/11903>`_). diff --git a/doc/changelog/10-standard-library/12263-fix-haskell-extraction.rst b/doc/changelog/10-standard-library/12263-fix-haskell-extraction.rst new file mode 100644 index 0000000000..c80a070181 --- /dev/null +++ b/doc/changelog/10-standard-library/12263-fix-haskell-extraction.rst @@ -0,0 +1,9 @@ +- **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 + <https://github.com/coq/coq/pull/12263>`_, fixes `#12257 + <https://github.com/coq/coq/issues/12257>`_ and `#12258 + <https://github.com/coq/coq/issues/12258>`_, by Jason Gross). diff --git a/doc/common/styles/html/coqremote/sites/all/themes/coq/coqdoc.css b/doc/common/styles/html/coqremote/sites/all/themes/coq/coqdoc.css deleted file mode 100644 index d23ea8f362..0000000000 --- a/doc/common/styles/html/coqremote/sites/all/themes/coq/coqdoc.css +++ /dev/null @@ -1,329 +0,0 @@ -body { 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: <span class="id" title="...">) */ - -.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 <span> (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[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; -} diff --git a/doc/common/styles/html/coqremote/sites/all/themes/coq/style.css b/doc/common/styles/html/coqremote/sites/all/themes/coq/style.css deleted file mode 100644 index 32c0b33166..0000000000 --- a/doc/common/styles/html/coqremote/sites/all/themes/coq/style.css +++ /dev/null @@ -1,801 +0,0 @@ -body -{ - background: white; - color:#444; - font:normal normal normal small/1.5em "Lucida Grande", Verdana, sans-serif; - margin:0; - padding:0; -} - -h2 -{ - font-size:150%; - font-weight:normal; - margin:20px 0 0; -} - -h3 -{ - font-size:130%; - font-weight:normal; -} - -a:link,a:visited -{ - color:#660403; - font-weight:normal; - text-decoration:none; -} - -a:hover -{ - color: red; - text-decoration:none; -} - -#container -{ - margin: 0; - padding: 0; - } - - /*----------header, logo and site name styles----------*/ - #headertop - { - display: block; - /* position:absolute; */ - min-width: 700px; - top: 0; - width: 100%; - height:30px; - z-index: 1; - background: transparent url('images/header_top.png') repeat-x; - } - - #header - { - min-width: 700px; - width: 100%; height:70px; - position: relative; - left: 0; top: 0; - background: transparent url('images/header_bot.png') repeat-x; - } - - #logo - { - float:left; - z-index: 2; - position: absolute; - top: -15px; - left: 0px; - } - - #logo img - { - border:0; - float:left; - } - - #logoWrapper - { - line-height:4em; - } - - #siteName - { - position: relative; - top: 10px; left: 80px; - color:#fff; - float:left; - font-size:350%; - } - - #siteName a - { - color:#fff; - text-decoration:none; - } - - #siteName a:hover - { - color:#ddd; - text-decoration:none; - } - - #siteSlogan - { - color:#eee; - float:left; - font-size:170%; - margin:50px 0 0 10px; - text-transform:lowercase; - white-space:nowrap; - } - - /*----------nav styles -- primary links in header----------*/ - - #nav -{ - position:absolute; right:0; - margin: 0; - padding: 5px; - } - -#nav ul - { - list-style:none outside none; - list-style-image:none; - margin:0; - padding:0; - } - - #nav li - { - display: inline; - margin: 0; padding: 4px; - } - - #nav li a - { - border:medium none; - color:#ccc; - font-weight:normal; - padding-left:10px; - padding-right:10px; - text-decoration:none; - } - - #nav li a:hover - { - background:#7B0505 none repeat; - border:medium none; - border-left:1px solid #ddd; - border-right:1px solid #ddd; - color:#fff; - padding: 6px 9px 5px 9px; - } - - -/************** FOOTER *******************/ - - -#footer -{ - background:transparent url('images/footer.png') repeat-x; - width:100%; - clear:both; - font-size:85%; - text-align:center; - /* position:fixed; */ - margin: 0; - padding: 0; -} - - -#nav-footer -{ - display: inline; - color:#444; - margin: 0; - padding: 0; - text-align:right; - } - -#nav-footer ul - { - list-style:none outside none; - list-style-image:none; - margin:0; - padding:0px; padding-right: 5px; - } - -#nav-footer li -{ - display:inline; padding: 4px; -} - - #nav-footer li a - { - border:medium none; - color:#ccc; - font-size: 11px; - font-weight:normal; - padding-left: 10px; - padding-right: 10px; - text-decoration:none; - } - - #nav-footer li a:hover - { - background:#7B0505 none repeat; - border:medium none; - border-left:1px solid #ddd; - border-right:1px solid #ddd; - color:#fff; - margin:0; - padding: 3px 9px 0px 9px; - } - - - /*----------main content----------*/ - #content - { - display: block; - position: static; - -/* min-width: 640px; */ - max-width: 800px; - - margin-left:40px; - margin-right:300px; - padding: 2ex 2ex; - - z-index:1; - } - -.content { - display: block; - position: relative; - - margin: 0; - padding: 0; -} - - /*----------sidebar styles----------*/ - #sidebarWrapper - { - /* background:transparent url('images/sidebar_bottom.jpg') no-repeat scroll left bottom;*/ - display:block; - position:fixed; - /* avant : top: 100px; right:0px*/ - top: 15px; /* 180 */ - right:0px; - left: auto; - - margin-right: 0px; - - /* avant - width: 12%; - min-width:80px; */ - - /* width: 18%; */ - /* min-*/ - width:270px; - - z-index:0; - overflow:hidden; - -/* ajout precedent:*/ -/* min-height:320px; - padding:10px; - background-image:url('http://www.lix.polytechnique.fr/Labo/Denis.Cousineau/data/coq/rttr340bis.png'); - background-repeat : repeat-x ;*/ - -/* last ajout */ - /* min-height:510px; */ /* 360 */ - padding-left:0px; - padding-right:0px; - padding-top:105px; /* 40 */ - padding-bottom:/*105px*/115px; - /* background:transparent url('http://www.lix.polytechnique.fr/Labo/Denis.Cousineau/data/coq/trig6b.png') no-repeat scroll left top; */ - background:transparent url('images/sidebarbot.png') no-repeat scroll right bottom; - - } - -#sidebar { - padding-left: 40px; - padding-top: 105px; - overflow: visible; - background:transparent url('images/sidebartop.png') no-repeat scroll right top; -} - -#sidebar .title -{ - /* avant :border-bottom:1px solid #eee;*/ - /* avant : color:#660403;*/ - color:#2D0102; - font-size:120%; - font-weight:bold; - line-height:19px; - margin:10px 0; -} - -/*----------page styles----------*/ -.pageTitle -{ - color:#2D0102; - font-size:220%; - margin:10px 0 20px; -} - -.mission -{ - background-color:#efefef; - border:solid 1px #ccc; - margin:0 0 10px 0; - padding:10px; -} - -.messages -{ - color:#C80000; - font-size:110%; - margin:10px 0; -} - -/*----------node styles----------*/ -.nodeTitle -{ - background: url('images/nodeTitle.gif') no-repeat 0 100%; - color:#9a0000; - font-size: 100%; - margin:0; -} - -.nodeTitle a -{ - color:#660403; - text-decoration:none; -} - -.nodeTitle a:hover -{ - color:#d00000; - text-decoration:none; -} - -.node -{ - margin:0 0 20px; -} - -.content p -{ - margin:10px 0; -} - -.submitted -{ - color:#a3a3a3; - font-size:70%; -} - -.nodeLinks -{ - font-size:95%; - margin:0; - padding:0; -} - -.taxonomy -{ - background:url('icons/tag_red.png') no-repeat 0 7px; - font-size:80%; - padding:0 0 5px 16px; -} - -/*----------comment styles----------*/ -.commentTitle -{ - Border-bottom:1px solid #ddd; - color:#9a0000; - font-size:130%; - margin:20px 0 0; -} - -.commentTitle a -{ - color:#660403; - text-decoration:none; -} - -.commentTitle a:hover -{ - color:#d00000; - text-decoration:none; -} - -.commentLinks -{ - background:#f7f7f7; - border:1px solid #e1e1e1; - color:#444; - font-size:95%; - margin:20px 0 30px; - padding:4px 0 4px 4px; -} - - -/*----------img styles----------*/ -img -{ - padding:3px; -} - -/*----------icons for links----------*/ -.comment_comments a -{ - background:url('icons/comment.png') no-repeat 0 2px; - padding-bottom:5px; - padding-left:20px; -} - -.node_read_more a -{ - background:url('icons/page_white_go.png') no-repeat; - padding-bottom:5px; - padding-left:20px; -} - -.comment_add a,.comment_reply a -{ - background:url('icons/comment_add.png') no-repeat; - padding-bottom:5px; - padding-left:20px; -} -.comment_delete a -{ - background:url('icons/comment_delete.png') no-repeat; - padding-bottom:5px; - padding-left:20px; -} - -.comment_edit a -{ - background:url('icons/comment_edit.png') no-repeat; - padding-bottom:5px; - padding-left:20px; -} - -/*----------TinyMCE editor----------*/ -body.mceContentBody -{ - background:#fff; - color:#000; - font-size:12px; -} - -body.mceContentBody a:link -{ - color:#ff0000; -} - -/*----------table styles----------*/ -table -{ - margin:1em 0; - width:100%; -} - -thead th -{ - border-bottom:2px solid #AAA; - color:#494949; - font-weight:bold; -} - -td,th -{ - padding:.3em 0 .5em; -} - -tr.even,tr.odd,tbody th -{ - border:solid #D5D6D7; - border-width:1px 0; -} - -tr.even -{ - background:#fff; -} - -td.region,td.module,td.container -{ - background:#D5D6D7; - border-bottom:1px solid #AAA; - border-top:1.5em solid #fff; - color:#455067; - font-weight:bold; -} - -tr:first-child td.region,tr:first-child td.module,tr:first-child td.container -{ - border-top-width:0; -} - -td.menu-disabled,td.menu-disabled a -{ - background-color:#D5C2C2; - color:#000; -} - -/*----------other styles----------*/ - -.block -{ - margin:5px 0 20px; -} - -.thumbnail,.preview -{ - border:1px solid #ccc; -} - -.lstlisting { - display: block; - font-family: monospace; - white-space: pre; - margin: 1em 0; -} -.center { - text-align: center; -} -.centered { - display: block-inline; -} - -/*----------download table------------*/ - -table.downloadtable -{ - width:90%; - margin-left:auto; - margin-right:auto; -} - -table.downloadtable td.downloadheader -{ -padding: 2px 1em; -font-weight: bold; -font-size: 120%; -color: white; -background: transparent url('images/header_bot.png') repeat-x; -/*background-color: #660403; */ -border: solid 2px white; -border-left: none; -} - -table.downloadtable td.downloadcategory -{ -padding: 2px 1em; -background-color: #dfbfbe; -text-indent: 0; -} - -table.downloadtable td.downloadsize -{ -text-indent: 0; -white-space: nowrap; -height: 52px; -} - -table.downloadtable td -{ -padding: 2px 1em; -background-color: #dfbfbe; -border-right: solid white 2px; -} - - -table.downloadtable td.downloadtopline -{ -border-top: solid white 2px; -} - -table.downloadtable td.downloadtoprightline -{ -border-top: solid 2px white; -border-right: solid 2px white; -} - -table.downloadtable td.downloadbottomline -{ -border-bottom: solid 2px white; -border-right: solid 2px white; -} - -table.downloadtable td.downloadbottomrightline -{ -border-bottom: solid 2px white; -border-right: solid 2px white; -} - -table.downloadtable td.downloadrightline -{ -border-right: solid 2px white; -} - -table.downloadtable td.downloadback -{ -background-color: #efe4e4; -} - -table.downloadtable td.downloadbottomback -{ -border-bottom: solid 2px white; -background-color: #efe4e4; -} - - -/*********** Normal text style ************/ - -p { - text-indent:3em; -} - -ul { - margin: 0px; - margin-left:4em; - padding: 0px; - list-style-type:square; -} - -li -{ - text-indent: 0px; - margin: 0px; - padding: 0px; -} - -tt { font-size: 1em; } - -pre { font-size: 1em; } - -/*********** Framework ***********/ -.framework -{ - display: block; - position:relative; - border:solid 1px #660033; - margin: 8ex 1em; /* 8ex 8ex 1em 1em; */ - padding: 0; -} - -.frameworkcontent -{ - position:relative; - left:0px; - - - margin: 0; - padding: .5ex 2em; - - text-indent: 2em; - text-align: justify; -} - - -.frameworklabel -{ - display: inline; - position:relative; - top:-1.3ex; - - margin-left:2ex; - padding-top:.4ex; - padding-bottom:.4ex; - padding-right:1ex; - padding-left:1ex; - - border: none; - background: white; - color: black; - - font-weight: bold; - font-size:115%; -} - -.frameworklinks { - display:block; - position:relative; - top:1.4ex; - - margin-right:2ex; - - text-align:right; - font-size:100% - } - -.frameworklinks ul -{ - display: inline; - padding: 0px 1ex; - - border: none; - background: white; -} - - -.frameworklinks li - { - display:inline; - padding: 1ex 0px; - } - - .frameworklinks li a -{ - border:medium none; - - margin: 0px 1ex; - padding-left:2px; - padding-right:3px; - - font-weight:normal; - text-decoration:none; - - color: #660003; -} - - .frameworklinks li a:hover - { - color: red; - - border: none; - } - -/* General flat lists */ -.flatlist li {display: inline} - -/* For sections in bycat.html */ -.bycatsection dt { - text-indent: 3em -} - -.bycatsection dt a -{ - font-weight: bold; - color:#444; -} - -/* footnote is used in the new contribution form */ -.footnote { - text-indent: 0pt; - font-size: 80%; - color: silver; - text-align: justify -} - -/****************** CoqIDE Screenshots *****************/ - - -.SCpager { - position:relative; - top:5px; - width:630px; - background: transparent url('images/header_bot.png') repeat-x; - padding:4px; -} - -.SCpagercontent { - width:390px; - position:relative; - margin-left:auto; - margin-right:auto; -} - -.SCthumb { - height:45px; - margin-left:2px; - margin-right:2px; -} - -.SCthumbselected { - height:55px; - margin-left:2px; - margin-right:2px; -} - -.SCcontent { - position:relative; - top:5px; - width:638px; - background-color: #dfbfbe; -} - -.SCscreenshot { - position:relative; - height:400px; - width:auto; - margin:15px auto 15px 19px; -} @@ -23,19 +23,33 @@ (targets refman-html) (alias refman-html) (package coq-doc) - (deps (alias refman-deps)) + ; Cannot use this deps alias because of ocaml/dune#3415 + ; (deps (alias refman-deps)) + (deps + (package coq) + (source_tree sphinx) + (source_tree tools/coqrst) + unreleased.rst + (env_var SPHINXWARNOPT)) (action - (run env COQLIB=%{project_root} sphinx-build %{env:SPHINXWARNOPT=-W} -b html sphinx %{targets}))) + (run env COQLIB=%{project_root} sphinx-build -q %{env:SPHINXWARNOPT=-W} -b html sphinx %{targets}))) (rule (targets refman-pdf) (alias refman-pdf) (package coq-doc) - (deps (alias refman-deps)) + ; Cannot use this deps alias because of ocaml/dune#3415 + ; (deps (alias refman-deps)) + (deps + (package coq) + (source_tree sphinx) + (source_tree tools/coqrst) + unreleased.rst + (env_var SPHINXWARNOPT)) (action (progn - (run env COQLIB=%{project_root} sphinx-build %{env:SPHINXWARNOPT=-W} -b latex sphinx %{targets}) - (chdir %{targets} (run make))))) + (run env COQLIB=%{project_root} sphinx-build -q %{env:SPHINXWARNOPT=-W} -b latex sphinx %{targets}) + (chdir %{targets} (run make LATEXMKOPTS=-silent))))) ; Installable directories are not yet fully supported by Dune. See ; ocaml/dune#1868. Yet, this makes coq-doc.install a valid target to diff --git a/doc/sphinx/README.rst b/doc/sphinx/README.rst index 0802b5d0b4..e20469bb8b 100644 --- a/doc/sphinx/README.rst +++ b/doc/sphinx/README.rst @@ -358,6 +358,13 @@ In addition to the objects and directives above, the ``coqrst`` Sphinx plugin de <http://www.sphinx-doc.org/en/stable/markup/para.html#directive-productionlist>`_ 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. The term will also appear in the Glossary Index. + + Example:: + + A :gdef:`prime` number is divisible only by itself and 1. + Common mistakes =============== diff --git a/doc/sphinx/_static/notations.css b/doc/sphinx/_static/notations.css index 733a73bd21..9546f7107e 100644 --- a/doc/sphinx/_static/notations.css +++ b/doc/sphinx/_static/notations.css @@ -215,6 +215,14 @@ 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; diff --git a/doc/sphinx/addendum/generalized-rewriting.rst b/doc/sphinx/addendum/generalized-rewriting.rst index 315c9d4a80..759f630b85 100644 --- a/doc/sphinx/addendum/generalized-rewriting.rst +++ b/doc/sphinx/addendum/generalized-rewriting.rst @@ -529,7 +529,7 @@ pass additional arguments such as ``using relation``. setoid_symmetry {? in @ident} setoid_transitivity setoid_rewrite {? @orientation} @term {? at @occurrences} {? in @ident} - setoid_replace @term with @term {? using relation @term} {? in @ident} {? by @tactic} + setoid_replace @term with @term {? using relation @term} {? in @ident} {? by @ltac_expr3} :name: setoid_reflexivity; setoid_symmetry; setoid_transitivity; setoid_rewrite; setoid_replace The ``using relation`` arguments cannot be passed to the unprefixed form. diff --git a/doc/sphinx/addendum/implicit-coercions.rst b/doc/sphinx/addendum/implicit-coercions.rst index cfaa681d20..a6dc15da55 100644 --- a/doc/sphinx/addendum/implicit-coercions.rst +++ b/doc/sphinx/addendum/implicit-coercions.rst @@ -37,6 +37,8 @@ In addition to these user-defined classes, we have two built-in classes: * ``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 class class .. prodn:: diff --git a/doc/sphinx/addendum/omega.rst b/doc/sphinx/addendum/omega.rst index 082ea4691b..e1b1ee8e8d 100644 --- a/doc/sphinx/addendum/omega.rst +++ b/doc/sphinx/addendum/omega.rst @@ -1,4 +1,4 @@ -.. _omega: +.. _omega_chapter: Omega: a solver for quantifier-free problems in Presburger Arithmetic ===================================================================== @@ -28,6 +28,7 @@ Description of ``omega`` ------------------------ .. tacn:: omega + :name: omega .. deprecated:: 8.12 diff --git a/doc/sphinx/addendum/program.rst b/doc/sphinx/addendum/program.rst index 5cffe9e435..52862dea47 100644 --- a/doc/sphinx/addendum/program.rst +++ b/doc/sphinx/addendum/program.rst @@ -290,7 +290,7 @@ optional identifier is used when multiple functions have unsolved obligations (e.g. when defining mutually recursive blocks). The optional tactic is replaced by the default one if not specified. -.. cmd:: {? {| Local | Global } } Obligation Tactic := @tactic +.. cmd:: {? {| Local | Global } } Obligation Tactic := @ltac_expr :name: Obligation Tactic Sets the default obligation solving tactic applied to all obligations @@ -314,11 +314,11 @@ optional tactic is replaced by the default one if not specified. Start the proof of the next unsolved obligation. -.. cmd:: Solve Obligations {? {? of @ident} with @tactic} +.. cmd:: Solve Obligations {? {? of @ident} with @ltac_expr} Tries to solve each obligation of ``ident`` using the given ``tactic`` or the default one. -.. cmd:: Solve All Obligations {? with @tactic} +.. 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). diff --git a/doc/sphinx/addendum/sprop.rst b/doc/sphinx/addendum/sprop.rst index 9acdd18b89..b19239ed22 100644 --- a/doc/sphinx/addendum/sprop.rst +++ b/doc/sphinx/addendum/sprop.rst @@ -7,27 +7,26 @@ SProp (proof irrelevant propositions) 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`. -Using :math:`\SProp` may be prevented by passing ``-disallow-sprop`` -to the |Coq| program or using :flag:`Allow StrictProp`. +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 :name: Allow StrictProp - Allows using :math:`\SProp` when set and forbids it when unset. The - initial value depends on whether you used the command line - ``-disallow-sprop`` and ``-allow-sprop``. - -.. exn:: SProp not allowed, you need to Set Allow StrictProp or to use the -allow-sprop command-line-flag. - :undocumented: - -.. coqtop:: none + Enables or disables the use of |SProp|. It is enabled by default. + The command-line flag ``-disallow-sprop`` disables |SProp| at + startup. - Set Allow StrictProp. + .. 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. @@ -38,29 +37,35 @@ Basic constructs The purpose of :math:`\SProp` is to provide types where all elements are convertible: -.. coqdoc:: +.. coqtop:: all - Definition irrelevance (A:SProp) (P:A -> Prop) (x:A) (v:P x) (y:A) : P y := v. + 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` for functions, the property of being a type of definitionally irrelevant values is impredicative, and so is :math:`\SProp`: -.. coqdoc:: +.. coqtop:: all Check fun (A:Type) (B:A -> SProp) => (forall x:A, B x) : SProp. -.. warning:: - - Conversion checking through bytecode or native code compilation - currently does not understand proof irrelevance. - In order to keep conversion tractable, cumulativity for :math:`\SProp` -is forbidden: +is forbidden, unless the :flag:`Cumulative StrictProp` flag is turned +on: .. coqtop:: all Fail Check (fun (A:SProp) => A : Type). + Set Cumulative StrictProp. + Check (fun (A:SProp) => A : Type). + +.. coqtop:: none + + Unset Cumulative StrictProp. We can explicitly lift strict propositions into the relevant world by using a wrapping inductive type. The inductive stops definitional @@ -240,3 +245,10 @@ so correctly converts ``x`` and ``y``. the kernel when it is passed a term with incorrect relevance marks. To avoid conversion issues as in ``late_mark`` you may wish to use it to find when your tactics are producing incorrect marks. + +.. flag:: Cumulative StrictProp + :name: Cumulative StrictProp + + Set this flag (it is off by default) to make the kernel accept + cumulativity between |SProp| and other universes. This makes + typechecking incomplete. diff --git a/doc/sphinx/addendum/type-classes.rst b/doc/sphinx/addendum/type-classes.rst index bd4c276571..903aa266e2 100644 --- a/doc/sphinx/addendum/type-classes.rst +++ b/doc/sphinx/addendum/type-classes.rst @@ -241,7 +241,7 @@ binders. For example: Definition lt `{eqa : EqDec A, ! Ord eqa} (x y : A) := andb (le x y) (neqb x y). -The ``!`` modifier switches the way a binder is parsed back to the regular +The ``!`` modifier switches the way a binder is parsed back to the usual interpretation of Coq. In particular, it uses the implicit arguments mechanism if available, as shown in the example. @@ -323,7 +323,7 @@ Summary of the commands .. cmdv:: Existing Class @ident - This variant declares a class a posteriori from a constant or + This variant declares a class from a previously declared constant or inductive definition. No methods or instances are defined. .. warn:: @ident is already declared as a typeclass @@ -394,7 +394,7 @@ few other commands related to typeclasses. :name: typeclasses eauto This proof search tactic implements the resolution engine that is run - implicitly during type-checking. This tactic uses a different resolution + implicitly during type checking. This tactic uses a different resolution engine than :tacn:`eauto` and :tacn:`auto`. The main differences are the following: diff --git a/doc/sphinx/addendum/universe-polymorphism.rst b/doc/sphinx/addendum/universe-polymorphism.rst index a08495badd..2958d866ac 100644 --- a/doc/sphinx/addendum/universe-polymorphism.rst +++ b/doc/sphinx/addendum/universe-polymorphism.rst @@ -227,7 +227,7 @@ 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), +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 @@ -426,6 +426,19 @@ 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: diff --git a/doc/sphinx/appendix/indexes/index.rst b/doc/sphinx/appendix/indexes/index.rst index 2ece726df7..7dd0f62a9f 100644 --- a/doc/sphinx/appendix/indexes/index.rst +++ b/doc/sphinx/appendix/indexes/index.rst @@ -11,16 +11,17 @@ find what you are looking for. .. toctree:: - ../../genindex + ../../std-glossindex ../../coq-cmdindex ../../coq-tacindex + ../../coq-attrindex ../../coq-optindex ../../coq-exnindex - ../../coq-attrindex + ../../genindex For reference, here are direct links to the documentation of: -- :ref:`flags, options and tables <flags-options-tables>`; +- :ref:`attributes` +- :ref:`flags-options-tables`; - controlling the display of warning messages with the :opt:`Warnings` option; -- :ref:`gallina-attributes`. diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst index 31fb1b7382..453b8597f9 100644 --- a/doc/sphinx/changes.rst +++ b/doc/sphinx/changes.rst @@ -55,7 +55,8 @@ __ 811Reals_ Additionally, while the :tacn:`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 (see -also the warning message in the :ref:`corresponding chapter <omega>`). +also the warning message in the :ref:`corresponding chapter +<omega_chapter>`). The ``dev/doc/critical-bugs`` file documents the known critical bugs of |Coq| and affected releases. See the `Changes in 8.11+beta1`_ @@ -326,7 +327,7 @@ Changes in 8.11+beta1 the documentation by Théo Zimmermann and Jim Fehrle). - **Added:** Ltac2 tactic notations with “constr” arguments can specify the - interpretation scope for these arguments; + notation scope for these arguments; see :ref:`ltac2_notations` for details (`#10289 <https://github.com/coq/coq/pull/10289>`_, by Vincent Laporte). @@ -481,10 +482,12 @@ Changes in 8.11+beta1 .. _811Reals: - **Added:** - Module `Reals.ConstructiveCauchyReals` defines constructive real numbers + Module `Reals.Cauchy.ConstructiveCauchyReals` defines constructive real numbers by Cauchy sequences of rational numbers (`#10445 <https://github.com/coq/coq/pull/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: @@ -1556,14 +1559,13 @@ changes: - Vernacular: - - Experimental support for :ref:`attributes <gallina-attributes>` on + - Experimental support for :term:`attributes <attribute>` 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 (scopes)` and - :cmd:`Arguments`, with the help of Jasper Hugunin. + 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. @@ -2401,9 +2403,9 @@ Tactics - 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 + 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 a priori closer to the expectations. + 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 @@ -3469,7 +3471,7 @@ Tactics 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 +- 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". @@ -4836,7 +4838,7 @@ 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 foo as a class a posteriori. +- 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, @@ -4846,7 +4848,7 @@ Type classes Vernacular commands - New command "Timeout <n> <command>." interprets a command and a timeout - interrupts the interpretation after <n> seconds. + interrupts the execution after <n> seconds. - New command "Compute <expr>." is a shortcut for "Eval vm_compute in <expr>". - New command "Fail <command>." interprets a command and is successful iff the command fails on an error (but not an anomaly). Handy for tests and @@ -6031,7 +6033,7 @@ main motivations were syntax. Together with the revision of the concrete syntax, a new mechanism of -*interpretation scopes* permits to reuse the same symbols (typically +, +*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. @@ -6069,7 +6071,7 @@ 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 -interpretation scopes and of the commands for easily adding new +notation scopes and of the commands for easily adding new notations. Hugo Herbelin is the main implementer of the restructured standard library. @@ -6291,12 +6293,12 @@ Syntax extensions - "Grammar" for terms disappears - "Grammar" for tactics becomes "Tactic Notation" - "Syntax" disappears -- Introduction of a notion of interpretation scope allowing to use the +- 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 - interpretation scope is currently open) [see documentation for details] -- Notation now mandatorily requires a precedence and associativity + 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 @@ -6373,7 +6375,7 @@ New syntax with no dependency of t1 and t2 in the arguments of the constructors; this may cause incompatibilities for files translated using coq 8.0beta -Interpretation scopes +Notation scopes - Delimiting key %bool for bool_scope added - Import no more needed to activate argument scopes from a module diff --git a/doc/sphinx/conf.py b/doc/sphinx/conf.py index 2ed9ec21b3..dbe582df95 100755 --- a/doc/sphinx/conf.py +++ b/doc/sphinx/conf.py @@ -183,18 +183,10 @@ todo_include_todos = False nitpicky = True nitpick_ignore = [ ('token', token) for token in [ - 'assums', 'binders', 'collection', - 'dirpath', - 'ind_body', 'modpath', - 'module', - 'simple_tactic', - 'symbol', - 'term_pattern', - 'term_pattern_string', - 'toplevel_selector', + 'tactic', ]] # -- Options for HTML output ---------------------------------------------- diff --git a/doc/sphinx/coq-attrindex.rst b/doc/sphinx/coq-attrindex.rst index f2ace20374..a0c8bba90d 100644 --- a/doc/sphinx/coq-attrindex.rst +++ b/doc/sphinx/coq-attrindex.rst @@ -1,5 +1,9 @@ :orphan: +.. hack to get index in TOC + +.. _attribute_index: + --------------- Attribute index --------------- diff --git a/doc/sphinx/coq-optindex.rst b/doc/sphinx/coq-optindex.rst index 0961bea61f..e03b2abc32 100644 --- a/doc/sphinx/coq-optindex.rst +++ b/doc/sphinx/coq-optindex.rst @@ -2,6 +2,8 @@ .. hack to get index in TOC +.. _options_index: + ------------------------------- Flags, options and tables index ------------------------------- diff --git a/doc/sphinx/coqdoc.css b/doc/sphinx/coqdoc.css deleted file mode 100644 index a325a33842..0000000000 --- a/doc/sphinx/coqdoc.css +++ /dev/null @@ -1,338 +0,0 @@ -/************************************************************************/ -/* * The Coq Proof Assistant / The Coq Development Team */ -/* v * Copyright INRIA, CNRS and contributors */ -/* <O___,, * (see version control and CREDITS file for authors & dates) */ -/* \VV/ **************************************************************/ -/* // * This file is distributed under the terms of the */ -/* * GNU Lesser General Public License Version 2.1 */ -/* * (see LICENSE file for the text of the license) */ -/************************************************************************/ -body { 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: <span class="id" title="...">) */ - -.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 <span> (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[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; -} diff --git a/doc/sphinx/history.rst b/doc/sphinx/history.rst index 153dc1f368..02821613cc 100644 --- a/doc/sphinx/history.rst +++ b/doc/sphinx/history.rst @@ -210,7 +210,7 @@ definitions of “inversion predicates”. Version 1 ~~~~~~~~~ -This software is a prototype type-checker for a higher-order logical +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 @@ -409,7 +409,7 @@ 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 +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… @@ -1396,7 +1396,7 @@ Tactics 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, +- 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. diff --git a/doc/sphinx/language/cic.rst b/doc/sphinx/language/cic.rst index 09a3897a06..b125d21a3c 100644 --- a/doc/sphinx/language/cic.rst +++ b/doc/sphinx/language/cic.rst @@ -24,9 +24,9 @@ to a type and takes the form “*for all x of type* :math:`T`, :math:`P`”. The “: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`”. -The types of types are *sorts*. Types and sorts are themselves terms +The types of types are called :gdef:`sort`\s. Types and sorts are themselves terms so that terms, types and sorts are all components of a common -syntactic language of terms which is described in Section :ref:`terms` but, +syntactic language of terms which is described in Section :ref:`terms`. But first, we describe sorts. @@ -1108,6 +1108,75 @@ between universes for inductive types in the Type hierarchy. 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:: none + + Unset Positivity Checking. + Inductive A: Type := introA: ((A -> Prop) -> Prop) -> A. + Set Positivity Checking. + + .. 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 diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst new file mode 100644 index 0000000000..9473cc5a15 --- /dev/null +++ b/doc/sphinx/language/core/basic.rst @@ -0,0 +1,520 @@ +============================= +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 <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 +~~~~~~~~~~~~~~~~~~ + +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 +<https://en.wikipedia.org/wiki/Order_of_operations>`_ 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 <syntax-extensions-and-notation-scopes>` can extend the + syntax at run time. Some notations are defined in the 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:`interactive proof mode <proofhandling>`, + :ref:`custom entries <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 <https://github.com/ejgallego/coq-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. + +Numerals + Numerals are sequences of digits with an optional fractional part + and exponent, optionally preceded by a minus sign. :n:`@int` is an integer; + a numeral without fractional or exponent parts. :n:`@num` is a non-negative + integer. Underscores embedded in the digits are ignored, for example + ``1_000_000`` is the same as ``1000000``. + + .. insertprodn numeral digit + + .. prodn:: + numeral ::= {+ @digit } {? . {+ @digit } } {? {| e | E } {? {| + | - } } {+ @digit } } + int ::= {? - } {+ @digit } + num ::= {+ @digit } + digit ::= 0 .. 9 + +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`. + +Keywords + The following character sequences are reserved keywords that cannot be + used as identifiers:: + + _ Axiom CoFixpoint Definition Fixpoint Hypothesis Parameter Prop + SProp Set Theorem Type Variable as at cofix discriminated else end + fix for forall fun if in let match return then where with + + Note that notations and plugins may define additional keywords. + +Other tokens + The set of + tokens defined at any given time can vary because the :cmd:`Notation` + command can define new tokens. A :cmd:`Require` command may load more notation definitions, + while the end of a :cmd:`Section` may remove notations. Some notations + are defined in the standard library (see :ref:`thecoqlibrary`) and are generally + loaded automatically at startup time. + + Here are the character sequences that |Coq| directly defines as tokens + without using :cmd:`Notation`:: + + ! #[ % & ' ( () (bfs) (dfs) ) * ** + , - -> + . .( .. ... / : ::= := :> :>> ; < <+ <- <: + <<: <= = => > >-> >= ? @ @{ [ [= ] _ + `( `{ { {| | |- || } + + When multiple tokens match the beginning of a sequence of characters, + the longest matching token 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. + +Essential vocabulary +-------------------- + +This section presents the most essential notions to understand the +rest of the |Coq| manual: :term:`terms <term>` and :term:`types +<type>` on the one hand, :term:`commands <command>` and :term:`tactics +<tactic>` 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 <core-language>`, while + others (like :n:`@term_if`) are language extensions that are + presented in :ref:`the next chapter <extensions>`. + + .. insertprodn term qualid_annotated + + .. prodn:: + term ::= @term_forall_or_fun + | @term_let + | @term_if + | @term_fix + | @term_cofix + | @term100 + term100 ::= @term_cast + | @term10 + term10 ::= @term_application + | @one_term + one_term ::= @term_explicit + | @term1 + term1 ::= @term_projection + | @term_scope + | @term0 + term0 ::= @qualid_annotated + | @sort + | @primitive_notations + | @term_evar + | @term_match + | @term_record + | @term_generalizing + | @term_ltac + | ( @term ) + qualid_annotated ::= @qualid {? @univ_annot } + + .. note:: + + Many :term:`commands <command>` and :term:`tactics <tactic>` + 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 + <https://en.wikipedia.org/wiki/Dependent_type>`_). Because of + this, types and terms share a common syntax. All types are terms, + but not all terms are types: + + .. insertprodn type type + + .. prodn:: + type ::= @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:`witness`\es. Note that deciding + whether a type is inhabited is `undecidable + <https://en.wikipedia.org/wiki/Undecidable_problem>`_. + + Formally, types can be used to construct logical foundations for + mathematics alternative to the standard `"set theory" + <https://en.wikipedia.org/wiki/Set_theory>`_: we call such + logical foundations `"type theories" + <https://en.wikipedia.org/wiki/Type_theory>`_. |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 <command>` or :term:`tactics <tactic>`, generally + terminated with a period and optionally decorated with + :term:`attributes <attribute>`. + + .. insertprodn document sentence + + .. prodn:: + document ::= {* @sentence } + sentence ::= {? @attributes } @command . + | {? @attributes } {? @num : } @query_command . + | {? @attributes } {? @toplevel_selector } @ltac_expr {| . | ... } + | @control_command + + :n:`@ltac_expr` syntax supports both simple and compound + :term:`tactics <tactic>`. 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 {* @string } + + This command prints "Comments ok" and does not change anything + to the state of the document. + + tactic + + Tactics specify how to transform the current proof state as a + step in creating a proof. They are syntactically valid only when + |Coq| is in 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 behavior of a single +:term:`sentence`. 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` modifies the behavior of a single sentence. +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`. + +.. insertprodn attributes legacy_attr + +.. prodn:: + attributes ::= {* #[ {*, @attribute } ] } {* @legacy_attr } + attribute ::= @ident {? @attr_value } + attr_value ::= = @string + | ( {*, @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. + +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` :attr:`universes(polymorphic)` +`Monomorphic` :attr:`universes(monomorphic)` +`Cumulative` :attr:`universes(cumulative)` +`NonCumulative` :attr:`universes(noncumulative)` +`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. + +.. _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. + +Flags, options and tables are identified by a series of identifiers, each 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 {? {| @int | @string } } + :name: Set + + .. insertprodn setting_name setting_name + + .. prodn:: + setting_name ::= {+ @ident } + + 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 <set_unset_scope_qualifiers>`. + + .. 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 + :name: Unset + + 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 <set_unset_scope_qualifiers>`. + +.. 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 :attr:`local`, +:attr:`global` and :attr:`export` locality attributes: + +* no attribute: the original setting is *not* restored at the end of + the current module or section. +* :attr:`local` (or alternatively, the ``Local`` prefix): the setting + is applied within the current module or section. The original value + of the setting is restored at the end of the current module or + section. +* :attr:`export` (or alternatively, the ``Export`` prefix): similar to + :attr:`local`, the original value of the setting is restored at the + end of the current module or section. In addition, if the value is + set in a module, then :cmd:`Import`\-ing the module sets the option + or flag. +* :attr:`global` (or alternatively, the ``Global`` prefix): the + original setting is *not* restored at the end of the current module + or section. In addition, if the value is set in a file, then + :cmd:`Require`\-ing the file sets the option. + +Newly opened modules and sections inherit the current settings. + +.. note:: + + We discourage using the :attr:`global` 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 + (cf. :ref:`command-line-options`). diff --git a/doc/sphinx/language/core/index.rst b/doc/sphinx/language/core/index.rst index 5ee960d99b..5e83672463 100644 --- a/doc/sphinx/language/core/index.rst +++ b/doc/sphinx/language/core/index.rst @@ -6,23 +6,26 @@ 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 -notations, implicit arguments, etc. (that are presented in the -:ref:`next chapter <extensions>`), such complex terms get translated -down to a core language (the Calculus of Inductive Constructions) that -the kernel understands, and which we present here. Furthermore, while -users can build proofs interactively using tactics (see Chapter +:ref:`notations <syntax-extensions-and-notation-scopes>`, +:ref:`implicit arguments <ImplicitArguments>`, etc. (presented in the +:ref:`next chapter <extensions>`), 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 of the Calculus of Inductive Constructions whose -type corresponds to a theorem statement. The kernel is a type checker -which verifies that terms have their expected type. +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 the one hand and the elaboration -engine and tactics on the other hand follows what is known as the "de -Bruijn criterion" (keeping a small and well delimited trusted code +This separation between the kernel on one hand and the +:ref:`elaboration engine <extensions>` and :ref:`tactics +<writing-proofs>` 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 possible to reduce the trust in the whole system -to trusting a smaller, critical component: the kernel. In particular, +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. @@ -30,6 +33,7 @@ will have to check their output. .. toctree:: :maxdepth: 1 + basic ../gallina-specification-language ../cic records diff --git a/doc/sphinx/language/core/records.rst b/doc/sphinx/language/core/records.rst index 928378f55e..0080f1d052 100644 --- a/doc/sphinx/language/core/records.rst +++ b/doc/sphinx/language/core/records.rst @@ -15,14 +15,17 @@ expressions. In this sense, the :cmd:`Record` construction allows defining .. cmd:: {| Record | Structure } @record_definition {* with @record_definition } :name: Record; Structure - .. insertprodn record_definition field_body + .. insertprodn record_definition field_def .. prodn:: record_definition ::= {? > } @ident_decl {* @binder } {? : @type } {? @ident } %{ {*; @record_field } %} {? @decl_notations } - record_field ::= {* #[ {*, @attr } ] } @name {? @field_body } {? %| @num } {? @decl_notations } + record_field ::= {* #[ {*, @attribute } ] } @name {? @field_body } {? %| @num } {? @decl_notations } field_body ::= {* @binder } @of_type | {* @binder } @of_type := @term | {* @binder } := @term + term_record ::= %{%| {* @field_def } %|%} + field_def ::= @qualid {* @binder } := @term + Each :n:`@record_definition` defines a record named by :n:`@ident_decl`. The constructor name is given by :n:`@ident`. diff --git a/doc/sphinx/language/extensions/arguments-command.rst b/doc/sphinx/language/extensions/arguments-command.rst new file mode 100644 index 0000000000..34a48b368b --- /dev/null +++ b/doc/sphinx/language/extensions/arguments-command.rst @@ -0,0 +1,440 @@ +.. _ArgumentsCommand: + +Setting properties of a function's arguments +++++++++++++++++++++++++++++++++++++++++++++ + +.. cmd:: Arguments @smart_qualid {* @arg_specs } {* , {* @implicits_alt } } {? : {+, @args_modifier } } + :name: Arguments + + .. insertprodn smart_qualid args_modifier + + .. prodn:: + smart_qualid ::= @qualid + | @by_notation + by_notation ::= @string {? % @scope_key } + argument_spec ::= {? ! } @name {? % @scope_key } + arg_specs ::= @argument_spec + | / + | & + | ( {+ @argument_spec } ) {? % @scope_key } + | [ {+ @argument_spec } ] {? % @scope_key } + | %{ {+ @argument_spec } %} {? % @scope_key } + 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, implicit arguments + must be omitted in any expression that applies :token:`smart_qualid`. + * Declaring that some arguments of a given function should + be interpreted in a given 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:`( ... ) {? % @scope }` + :n:`(@name__1 @name__2 ...)%@scope` is shorthand for :n:`@name__1%@scope @name__2%@scope ...` + + :n:`[ ... ] {? % @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:`%{ ... %} {? % @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 `!` + evaulate to constructors. See :ref:`Args_effect_on_unfolding`. + + :n:`@name {? % @scope }` + a *formal parameter* of the function :n:`@smart_qualid` (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. + :token:`scope` can be either a scope name or its delimiting key. See :ref:`binding_to_scope`. + + `clear implicits` + makes all implicit arguments into explicit arguments + `default implicits` + automatically determine the implicit arguments of the object. + See :ref:`auto_decl_implicit_args`. + `rename` + rename implicit arguments for the object. See the example :ref:`here <renaming_implicit_arguments>`. + `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:`@smart_qualid` + `extra scopes` + defines extra argument scopes, to be used in case of coercion to ``Funclass`` + (see the :ref:`implicitcoercions` chapter) or with a computed type. + `simpl nomatch` + prevents performing a simplification step for :n:`@smart_qualid` + 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:`@smart_qualid`. 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<example_more_implicits>`. + + .. 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:`smart_qualid`. + + 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 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 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 a scope +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + The following command declares that the first two arguments of :g:`plus_fct` + are in the :token:`scope` delimited by the key ``F`` (``Rfun_scope``) and the third + argument is in the scope delimited by the key ``R`` (``R_scope``). + + .. coqdoc:: + + Arguments plus_fct (f1 f2)%F x%R. + + When interpreting a term, if some of the arguments of :token:`smart_qualid` are built + from a notation, then this notation is interpreted in the scope stack + extended by the scope bound (if any) to this argument. The effect of + the scope is limited to the argument itself. It does not propagate to + subterms but the subterms that, after interpretation of the notation, + turn to be themselves arguments of a reference are interpreted + accordingly to the 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 constant should never be unfolded by :tacn:`cbn`, + :tacn:`simpl` or :tacn:`hnf`: + + .. example:: + + .. coqtop:: all + + Arguments minus n m : simpl never. + + After that command an expression like :g:`(minus (S x) y)` is left + untouched by the tactics :tacn:`cbn` and :tacn:`simpl`. + ++ A 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 constant volatile, i.e. + always unfolded. + + .. example:: + + .. coqtop:: all + + Definition volatile := fun x : nat => x. + Arguments volatile / x. + ++ A 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 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 :math:`\beta`:math:`\iota`-reduction. Then, it + expands transparent constants and tries to reduce further using :math:`\beta`:math:`\iota`-reduction. + But, when no :math:`\iota` rule is applied after unfolding then + :math:`\delta`-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. diff --git a/doc/sphinx/language/extensions/implicit-arguments.rst b/doc/sphinx/language/extensions/implicit-arguments.rst index 36ce2fdd25..73b1b65097 100644 --- a/doc/sphinx/language/extensions/implicit-arguments.rst +++ b/doc/sphinx/language/extensions/implicit-arguments.rst @@ -105,28 +105,26 @@ This corresponds to a class of non-dependent implicit arguments that are solved based on the structure of their type only. -Maximal or non maximal insertion of implicit arguments -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Maximal and non-maximal insertion of implicit arguments +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In case a function is partially applied, and the next argument to be -applied is an implicit argument, two disciplines are applicable. In -the first case, the function is considered to have no arguments -furtherly: one says that the implicit argument is not maximally -inserted. In the second case, the function is considered to be -implicitly applied to the implicit arguments it is waiting for: one -says that the implicit argument is maximally inserted. +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 "[ ]". +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 declared -implicit. Trailing implicit arguments cannot be declared non maximally inserted, +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 [ ]. @@ -141,10 +139,9 @@ otherwise they would never be inserted. Casual use of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In a given expression, if it is clear that some argument of a function -can be inferred from the type of the other arguments, the user can -force the given argument to be guessed by replacing it by “_”. If -possible, the correct argument will be automatically generated. +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) @@ -156,12 +153,8 @@ possible, the correct argument will be automatically generated. Declaration of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In case one wants that some arguments of a given object (constant, -inductive types, constructors, assumptions, local or not) are always -inferred by |Coq|, one may declare once and for all which are the -expected implicit arguments of this object. There are two ways to do -this, *a priori* and *a posteriori*. - +Implicit arguments can be declared when a function is declared or +afterwards, using the :cmd:`Arguments` command. Implicit Argument Binders +++++++++++++++++++++++++ @@ -172,18 +165,20 @@ Implicit Argument Binders implicit_binders ::= %{ {+ @name } {? : @type } %} | [ {+ @name } {? : @type } ] -In the first setting, one wants to explicitly give the implicit -arguments of a declared object as part of its definition. To do this, -one has to surround the bindings of implicit arguments by curly -braces or square braces: +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. -This automatically declares the argument A of id as a maximally -inserted implicit argument. One can then do as-if the argument was -absent in every situation but still be able to specify it if needed: +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 @@ -191,7 +186,7 @@ absent in every situation but still be able to specify it if needed: Goal forall A, compose id id = id (A:=A). -For non maximally inserted implicit arguments, use square brackets: +For non-maximally inserted implicit arguments, use square brackets: .. coqtop:: all @@ -203,8 +198,7 @@ For non maximally inserted implicit arguments, use square brackets: Print Implicit map. -The syntax is supported in all top-level definitions: -:cmd:`Definition`, :cmd:`Fixpoint`, :cmd:`Lemma` and so on. For (co-)inductive datatype +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. @@ -225,11 +219,12 @@ The syntax is also supported in internal binders. For instance, in the following kinds of expressions, the type of each declaration present in :token:`binders` 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`. +* :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 @@ -259,190 +254,6 @@ Here is an example: Check let g {x:nat} (H:x=x) {x} (H:x=x) := x in 0. - -Declaring Implicit Arguments -++++++++++++++++++++++++++++ - - - -.. cmd:: Arguments @smart_qualid {* @argument_spec_block } {* , {* @more_implicits_block } } {? : {+, @arguments_modifier } } - :name: Arguments - - .. insertprodn smart_qualid arguments_modifier - - .. prodn:: - smart_qualid ::= @qualid - | @by_notation - by_notation ::= @string {? % @scope } - argument_spec_block ::= @argument_spec - | / - | & - | ( {+ @argument_spec } ) {? % @scope } - | [ {+ @argument_spec } ] {? % @scope } - | %{ {+ @argument_spec } %} {? % @scope } - argument_spec ::= {? ! } @name {? % @scope } - more_implicits_block ::= @name - | [ {+ @name } ] - | %{ {+ @name } %} - arguments_modifier ::= simpl nomatch - | simpl never - | default implicits - | clear bidirectionality hint - | clear implicits - | clear scopes - | clear scopes and implicits - | clear implicits and scopes - | rename - | assert - | extra scopes - - This command sets implicit arguments *a posteriori*, - where the list of :n:`@name`\s is a prefix of the list of - arguments of :n:`@smart_qualid`. Arguments in square - brackets are declared as implicit and arguments in curly brackets are declared as - maximally inserted. - - After the command is issued, implicit arguments can and must be - omitted in any expression that applies :token:`qualid`. - - 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 if the command occurs. - - A command containing :n:`@argument_spec_block & @argument_spec_block` - provides :ref:`bidirectionality_hints`. - - Use the :n:`@more_implicits_block` to specify multiple implicit arguments declarations - for names of constants, inductive types, constructors and lemmas that can only be - applied to a fixed number of arguments (excluding, for instance, - constants whose type is polymorphic). - The longest applicable list of implicit arguments will be used to select which - implicit arguments are inserted. - For printing, the omitted arguments are the ones of the longest list of implicit - arguments of the sequence. See the example :ref:`here<example_more_implicits>`. - - The :n:`@arguments_modifier` values have various effects: - - * :n:`clear implicits` - clears implicit arguments - * :n:`default implicits` - automatically determine the implicit arguments of the object. - See :ref:`auto_decl_implicit_args`. - * :n:`rename` - rename implicit arguments for the object - * :n:`assert` - assert that the object has the expected number of arguments with the - expected names. See the example here: :ref:`renaming_implicit_arguments`. - -.. exn:: The / modifier may only occur once. - :undocumented: - -.. exn:: The & modifier may only occur once. - :undocumented: - -.. 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 implicit arguments with :n:`@more_implicits_block` - - .. 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). - -.. note:: - Use the :cmd:`Print Implicit` command to see the implicit arguments - of an object (see :ref:`displaying-implicit-args`). - -.. _auto_decl_implicit_args: - -Automatic declaration of implicit arguments -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - The :n:`default implicits @arguments_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 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 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). - - Mode for automatic declaration of implicit arguments ++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -514,7 +325,7 @@ and the automatic declaration mode in on, the manual implicit arguments are adde 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 +some trailing implicit arguments can be inferred to be non-maximally inserted. In this case, they are converted to maximally inserted ones. .. example:: @@ -540,34 +351,23 @@ application. Use the :n:`(@ident := @term)` form of :token:`arg` to do so, where :token:`ident` is the name of the implicit argument 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 {? @univ_annot } {* @term1 }` form of :token:`term10`. +: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). - -.. _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. - .. _displaying-implicit-args: Displaying implicit arguments @@ -620,6 +420,30 @@ but succeeds in 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 flag on (it is off by default) deactivates the use of implicit arguments. @@ -629,6 +453,19 @@ Deactivation of implicit arguments for parsing 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). + .. _canonical-structure-declaration: Canonical structures @@ -668,7 +505,7 @@ in :ref:`canonicalstructures`; here only a simple example is given. Here is an example. - .. coqtop:: all + .. coqtop:: all reset Require Import Relations. @@ -806,7 +643,7 @@ Implicit generalization .. index:: `[! ] .. index:: `(! ) -.. insertprodn generalizing_binder typeclass_constraint +.. insertprodn generalizing_binder term_generalizing .. prodn:: generalizing_binder ::= `( {+, @typeclass_constraint } ) @@ -815,7 +652,8 @@ Implicit generalization 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 @@ -827,7 +665,7 @@ 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 \`( ) +non-maximally inserted implicit arguments and terms surrounded by \`( ) introduce them as explicit arguments. Generalizing binders always introduce their free variables as diff --git a/doc/sphinx/language/extensions/index.rst b/doc/sphinx/language/extensions/index.rst index 627e7f0acb..fc2ce03093 100644 --- a/doc/sphinx/language/extensions/index.rst +++ b/doc/sphinx/language/extensions/index.rst @@ -20,6 +20,7 @@ language presented in the :ref:`previous chapter <core-language>`. implicit-arguments ../../addendum/extended-pattern-matching ../../user-extensions/syntax-extensions + arguments-command ../../addendum/implicit-coercions ../../addendum/type-classes ../../addendum/canonical-structures diff --git a/doc/sphinx/language/gallina-extensions.rst b/doc/sphinx/language/gallina-extensions.rst index 57c8683aaa..5b78280edc 100644 --- a/doc/sphinx/language/gallina-extensions.rst +++ b/doc/sphinx/language/gallina-extensions.rst @@ -30,6 +30,11 @@ under its expanded form (see :flag:`Printing Matching`). 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 @@ -316,11 +321,11 @@ together, as well as a means of massive abstraction. parameters given by the :n:`@module_binder`\s. (A *functor* is a function from modules to modules.) - .. todo: would like to find a better term than "interactive", not very descriptive - :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` @@ -606,12 +611,9 @@ module can be accessed using the dot notation: Parameter x : T. End SIG. -The following definition of :g:`N` using the module type expression :g:`SIG` with +The definition of :g:`N` using the module type expression :g:`SIG` with :g:`Definition T := nat` is equivalent to the following one: -.. todo: what is other definition referred to above? - "Module N' : SIG with Definition T := nat. End N`." is not it. - .. coqtop:: in Module Type SIG'. @@ -855,7 +857,7 @@ Printing constructions in full .. flag:: Printing All Coercions, implicit arguments, the type of pattern matching, but also - notations (see :ref:`syntaxextensionsandinterpretationscopes`) can obfuscate the behavior of some + 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 flag on deactivates all high-level printing features such as coercions, @@ -866,6 +868,16 @@ Printing constructions in full :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 + .. _printing-universes: Printing universes @@ -906,7 +918,8 @@ Existential variables .. insertprodn term_evar term_evar .. prodn:: - term_evar ::= ?[ @ident ] + term_evar ::= _ + | ?[ @ident ] | ?[ ?@ident ] | ?@ident {? @%{ {+; @ident := @term } %} } @@ -1099,51 +1112,3 @@ 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)`. - -.. _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. - -An :cmd:`Arguments` command containing :n:`@argument_spec_block__1 & @argument_spec_block__2` -provides :ref:`bidirectionality_hints`. -It tells the typechecking algorithm, when type-checking -applications of :n:`@qualid`, to first type-check the arguments in -:n:`@argument_spec_block__1` and then propagate information from the typing context to -type-check the remaining arguments (in :n:`@argument_spec_block__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. diff --git a/doc/sphinx/language/gallina-specification-language.rst b/doc/sphinx/language/gallina-specification-language.rst index ccb236a174..353bed1b3d 100644 --- a/doc/sphinx/language/gallina-specification-language.rst +++ b/doc/sphinx/language/gallina-specification-language.rst @@ -7,197 +7,13 @@ This chapter describes Gallina, the specification language of Coq. It allows developing mathematical theories and to prove specifications of programs. The theories are built from axioms, hypotheses, parameters, lemmas, theorems and -definitions of constants, functions, predicates and sets. The syntax of logical -objects involved in theories is described in Section :ref:`term`. The -language of commands, called *The Vernacular* is described in Section -:ref:`vernacular`. - -In Coq, logical objects are typed to ensure their logical correctness. The -rules implemented by the typing algorithm are described in Chapter :ref:`calculusofinductiveconstructions`. - - -.. About the grammars in the manual - ================================ - - Grammars are presented in Backus-Naur form (BNF). Terminal symbols are - set in black ``typewriter font``. In addition, there are special notations for - regular expressions. - - An expression enclosed in square brackets ``[…]`` means at most one - occurrence of this expression (this corresponds to an optional - component). - - The notation “``entry sep … sep entry``” stands for a non empty sequence - of expressions parsed by entry and separated by the literal “``sep``” [1]_. - - Similarly, the notation “``entry … entry``” stands for a non empty - sequence of expressions parsed by the “``entry``” entry, without any - separator between. - - At the end, the notation “``[entry sep … sep entry]``” stands for a - possibly empty sequence of expressions parsed by the “``entry``” entry, - separated by the literal “``sep``”. - -.. _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. - -Numerals - Numerals are sequences of digits with an optional fractional part - and exponent, optionally preceded by a minus sign. :n:`@int` is an integer; - a numeral without fractional or exponent parts. :n:`@num` is a non-negative - integer. Underscores embedded in the digits are ignored, for example - ``1_000_000`` is the same as ``1000000``. - - .. insertprodn numeral digit - - .. prodn:: - numeral ::= {+ @digit } {? . {+ @digit } } {? {| e | E } {? {| + | - } } {+ @digit } } - int ::= {? - } {+ @digit } - num ::= {+ @digit } - digit ::= 0 .. 9 - -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`. - -Keywords - The following character sequences are reserved keywords that cannot be - used as identifiers:: - - _ Axiom CoFixpoint Definition Fixpoint Hypothesis IF Parameter Prop - SProp Set Theorem Type Variable as at by cofix discriminated else - end exists exists2 fix for forall fun if in lazymatch let match - multimatch return then using where with - - Note that plugins may define additional keywords when they are loaded. - -Other tokens - The set of - tokens defined at any given time can vary because the :cmd:`Notation` - command can define new tokens. A :cmd:`Require` command may load more notation definitions, - while the end of a :cmd:`Section` may remove notations. Some notations - are defined in the basic library (see :ref:`thecoqlibrary`) and are normally - loaded automatically at startup time. - - Here are the character sequences that Coq directly defines as tokens - without using :cmd:`Notation` (omitting 25 specialized tokens that begin with - ``#int63_``):: - - ! #[ % & ' ( () (bfs) (dfs) ) * ** + , - -> - . .( .. ... / : ::= := :> :>> ; < <+ <- <: - <<: <= = => > >-> >= ? @ @{ [ [= ] _ - `( `{ { {| | |- || } - - When multiple tokens match the beginning of a sequence of characters, - the longest matching token 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. +definitions of constants, functions, predicates and sets. .. _term: Terms ===== -Syntax of terms ---------------- - -The following grammars describe the basic syntax of the terms of the -*Calculus of Inductive Constructions* (also called Cic). The formal -presentation of Cic is given in Chapter :ref:`calculusofinductiveconstructions`. Extensions of this syntax -are given in Chapter :ref:`extensionsofgallina`. How to customize the syntax -is described in Chapter :ref:`syntaxextensionsandinterpretationscopes`. - -.. insertprodn term field_def - -.. prodn:: - term ::= forall @open_binders , @term - | fun @open_binders => @term - | @term_let - | if @term {? {? as @name } return @term100 } then @term else @term - | @term_fix - | @term_cofix - | @term100 - term100 ::= @term_cast - | @term10 - term10 ::= @term1 {+ @arg } - | @ @qualid {? @univ_annot } {* @term1 } - | @term1 - arg ::= ( @ident := @term ) - | @term1 - one_term ::= @term1 - | @ @qualid {? @univ_annot } - term1 ::= @term_projection - | @term0 % @scope - | @term0 - term0 ::= @qualid {? @univ_annot } - | @sort - | @numeral - | @string - | _ - | @term_evar - | @term_match - | ( @term ) - | %{%| {* @field_def } %|%} - | `%{ @term %} - | `( @term ) - | ltac : ( @ltac_expr ) - field_def ::= @qualid {* @binder } := @term - -.. note:: - - Many commands and tactics use :n:`@one_term` 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 with a :n:`@term1` applied to a list of arguments. - -.. _types: - -Types ------ - -.. prodn:: - type ::= @term - -:n:`@type`\s are a subset of :n:`@term`\s; not every :n:`@term` is a :n:`@type`. -Every term has an associated type, which -can be determined by applying the :ref:`typing-rules`. Distinct terms -may share the same type, for example 0 and 1 are both of type `nat`, the -natural numbers. - .. _gallina-identifiers: Qualified identifiers and simple identifiers @@ -223,9 +39,15 @@ Field identifiers, written :n:`@field_ident`, are identifiers prefixed by Numerals and strings -------------------- +.. insertprodn primitive_notations primitive_notations + +.. prodn:: + primitive_notations ::= @numeral + | @string + Numerals and strings have no predefined semantics in the calculus. They are merely notations that can be bound to objects through the notation mechanism -(see Chapter :ref:`syntaxextensionsandinterpretationscopes` for details). +(see Chapter :ref:`syntax-extensions-and-notation-scopes` for details). Initially, numerals are bound to Peano’s representation of natural numbers (see :ref:`datatypes`). @@ -352,6 +174,12 @@ Section :ref:`let-in`). Products: forall ---------------- +.. insertprodn term_forall_or_fun term_forall_or_fun + +.. prodn:: + term_forall_or_fun ::= forall @open_binders , @term + | fun @open_binders => @term + The expression :n:`forall @ident : @type, @term` denotes the *product* of the variable :n:`@ident` of type :n:`@type`, over the term :n:`@term`. As for abstractions, :g:`forall` is followed by a binder list, and products @@ -373,6 +201,14 @@ the propositional implication and function types. Applications ------------ +.. insertprodn term_application arg + +.. prodn:: + term_application ::= @term1 {+ @arg } + | @ @qualid_annotated {+ @term1 } + arg ::= ( @ident := @term ) + | @term1 + :n:`@term__fun @term` denotes applying the function :n:`@term__fun` to :token:`term`. :n:`@term__fun {+ @term__i }` denotes applying @@ -456,7 +292,7 @@ Definition by cases: match pattern10 ::= @pattern1 as @name | @pattern1 {* @pattern1 } | @ @qualid {* @pattern1 } - pattern1 ::= @pattern0 % @scope + pattern1 ::= @pattern0 % @scope_key | @pattern0 pattern0 ::= @qualid | %{%| {* @qualid := @pattern } %|%} @@ -634,34 +470,6 @@ co-recursion. It is the local counterpart of the :cmd:`CoFixpoint` command. When The Vernacular ============== -.. insertprodn vernacular sentence - -.. prodn:: - vernacular ::= {* @sentence } - sentence ::= {? @all_attrs } @command . - | {? @all_attrs } {? @num : } @query_command . - | {? @all_attrs } {? @toplevel_selector } @ltac_expr {| . | ... } - | @control_command - -The top-level input to |Coq| is a series of :n:`@sentence`\s, -which are :production:`tactic`\s or :production:`command`\s, -generally terminated with a period -and optionally decorated with :ref:`gallina-attributes`. :n:`@ltac_expr` syntax supports both simple -and compound tactics. For example: ``split`` is a simple tactic while ``split; auto`` combines two -simple tactics. - -Tactics specify how to transform the current proof state as a step in creating a proof. They -are syntactically valid only when |Coq| is in 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, command names begin with uppercase letters, while -tactic names begin with lowercase letters. Commands appear in the -HTML documentation in blue boxes after the label "Command". In the pdf, they appear -after the boldface label "Command:". Commands are listed in the :ref:`command_index`. - -Similarly, tactics appear after the label "Tactic". Tactics are listed in the :ref:`tactic_index`. - .. _gallina-assumptions: Assumptions @@ -697,7 +505,7 @@ has type :n:`@type`. of an object of this type) is accepted as a postulate. :cmd:`Axiom`, :cmd:`Conjecture`, :cmd:`Parameter` and their plural forms - are equivalent. They can take the :attr:`local` attribute (see :ref:`gallina-attributes`), + are equivalent. They can take the :attr:`local` :term:`attribute`, which makes the defined :n:`@ident`\s accessible by :cmd:`Import` and its variants only through their fully qualified names. @@ -764,7 +572,7 @@ Section :ref:`typing-rules`. | {* @binder } : @type These commands bind :n:`@term` to the name :n:`@ident` in the environment, - provided that :n:`@term` is well-typed. They can take the :attr:`local` attribute (see :ref:`gallina-attributes`), + provided that :n:`@term` is well-typed. They can take the :attr:`local` :term:`attribute`, which makes the defined :n:`@ident` accessible by :cmd:`Import` and its variants only through their fully qualified names. If :n:`@reduce` is present then :n:`@ident` is bound to the result of the specified @@ -1246,7 +1054,7 @@ The ability to define co-inductive types by constructors, hereafter called 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. +make type checking undecidable. Since the introduction of primitive records in Coq 8.5, an alternative presentation is available, called *negative co-inductive types*. This consists @@ -1639,82 +1447,6 @@ the proof and adds it to the environment. #. One can also use :cmd:`Admitted` in place of :cmd:`Qed` to turn the current asserted statement into an axiom and exit the proof editing mode. -.. _gallina-attributes: - -Attributes ------------ - -.. insertprodn all_attrs legacy_attr - -.. prodn:: - all_attrs ::= {* #[ {*, @attr } ] } {* @legacy_attr } - attr ::= @ident {? @attr_value } - attr_value ::= = @string - | ( {*, @attr } ) - legacy_attr ::= {| Local | Global } - | {| Polymorphic | Monomorphic } - | {| Cumulative | NonCumulative } - | Private - | Program - -Attributes modify the behavior of a command or tactic. -Syntactically, most commands and tactics can be decorated with attributes, but -attributes not supported by the command or tactic will be flagged as errors. - -The order of top-level attributes doesn't affect their meaning. ``#[foo,bar]``, ``#[bar,foo]``, -``#[foo]#[bar]`` and ``#[bar]#[foo]`` are equivalent. - -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` :attr:`universes(polymorphic)` -`Monomorphic` :attr:`universes(monomorphic)` -`Cumulative` :attr:`universes(cumulative)` -`NonCumulative` :attr:`universes(noncumulative)` -`Private` :attr:`private(matching)` -`Program` :attr:`program` -================ ================================ - -.. 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. - - This attribute is supported by the following commands: :cmd:`Ltac`, - :cmd:`Tactic Notation`, :cmd:`Notation`, :cmd:`Infix`. - - It can trigger the following warnings: - - .. warn:: Tactic @qualid is deprecated since @string__since. @string__note. - Tactic Notation @qualid is deprecated since @string__since. @string__note. - Notation @string 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). - - .. example:: - - .. coqtop:: all reset warn - - #[deprecated(since="8.9.0", note="Use idtac instead.")] - Ltac foo := idtac. - - Goal True. - Proof. - now foo. - Abort. - -.. warn:: Unsupported attribute - - This warning is an error by default. It is caused by using a - command with some attribute it does not understand. - .. [1] Except if the inductive type is empty in which case there is no equation that can be used to infer the return type. diff --git a/doc/sphinx/practical-tools/coqide.rst b/doc/sphinx/practical-tools/coqide.rst index b1f392c337..42e752841d 100644 --- a/doc/sphinx/practical-tools/coqide.rst +++ b/doc/sphinx/practical-tools/coqide.rst @@ -1,3 +1,5 @@ +.. |GtkSourceView| replace:: :smallcaps:`GtkSourceView` + .. _coqintegrateddevelopmentenvironment: |Coq| Integrated Development Environment @@ -98,19 +100,6 @@ processed color, though their preceding proofs have the processed color. Notice that for all these buttons, except for the "gears" button, their operations are also available in the menu, where their keyboard shortcuts are given. -Proof folding ------------------- - -As your script grows bigger and bigger, it might be useful to hide the -proofs of your theorems and lemmas. - -This feature is toggled via the Hide entry of the Navigation menu. The -proof shall be enclosed between ``Proof.`` and ``Qed.``, both with their final -dots. The proof that shall be hidden or revealed is the first one -whose beginning statement (such as ``Theorem``) precedes the insertion -cursor. - - Vernacular commands, templates ----------------------------------- @@ -158,7 +147,18 @@ presented as a notebook. The first section is for selecting the text font used for scripts, goal and message windows. -The second and third sections are for controlling colors and style. +The second and third 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 on internet for the various +possibilities). The fourth section is for customizing the editor. It includes in particular the ability to activate an Emacs mode named @@ -206,7 +206,7 @@ Displaying Unicode symbols ~~~~~~~~~~~~~~~~~~~~~~~~~~ You just need to define suitable notations as described in the chapter -:ref:`syntaxextensionsandinterpretationscopes`. For example, to use the +:ref:`syntax-extensions-and-notation-scopes`. For example, to use the mathematical symbols ∀ and ∃, you may define: .. coqtop:: in diff --git a/doc/sphinx/practical-tools/utilities.rst b/doc/sphinx/practical-tools/utilities.rst index 921c7bbbf7..408f8fc3ec 100644 --- a/doc/sphinx/practical-tools/utilities.rst +++ b/doc/sphinx/practical-tools/utilities.rst @@ -245,16 +245,17 @@ file timing data: COQDEP Fast.v COQDEP Slow.v COQC Slow.v - Slow (user: 0.34 mem: 395448 ko) + Slow.vo (user: 0.34 mem: 395448 ko) COQC Fast.v - Fast (user: 0.01 mem: 45184 ko) + 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, 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 + ``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:: @@ -271,24 +272,29 @@ file timing data: ``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 Fast.v - COQDEP Slow.v + COQDEP VFILES COQC Slow.v - Slow (user: 0.36 mem: 393912 ko) + Slow.vo (real: 0.52, user: 0.39, sys: 0.12, mem: 394648 ko) COQC Fast.v - Fast (user: 0.05 mem: 45992 ko) - Time | File Name - -------------------- - 0m00.41s | Total - -------------------- - 0m00.36s | Slow - 0m00.05s | Fast + 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`` @@ -325,7 +331,15 @@ file timing data: .. 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. + 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:: @@ -334,12 +348,12 @@ file timing data: :: - After | File Name | Before || Change | % Change - -------------------------------------------------------- - 0m00.39s | Total | 0m00.35s || +0m00.03s | +11.42% - -------------------------------------------------------- - 0m00.37s | Slow | 0m00.01s || +0m00.36s | +3600.00% - 0m00.02s | Fast | 0m00.34s || -0m00.32s | -94.11% + 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- diff --git a/doc/sphinx/proof-engine/ltac.rst b/doc/sphinx/proof-engine/ltac.rst index 1772362351..b184311bef 100644 --- a/doc/sphinx/proof-engine/ltac.rst +++ b/doc/sphinx/proof-engine/ltac.rst @@ -174,6 +174,14 @@ mode but it can also be used in toplevel definitions as shown below. ltac_def : `ident` [`ident` ... `ident`] := `ltac_expr` : `qualid` [`ident` ... `ident`] ::= `ltac_expr` +Tactics in terms +~~~~~~~~~~~~~~~~ + +.. insertprodn term_ltac term_ltac + +.. prodn:: + term_ltac ::= ltac : ( @ltac_expr ) + .. _ltac-semantics: Semantics @@ -474,7 +482,7 @@ Soft cut ~~~~~~~~ Another way of restricting backtracking is to restrict a tactic to a -single success *a posteriori*: +single success: .. tacn:: once @ltac_expr :name: once @@ -1778,16 +1786,22 @@ performance issue. and allow displaying and resetting 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. -.. warning:: - - Note that the profiler currently does not handle backtracking into - multi-success tactics, and issues a warning to this effect in many cases - when such backtracking occurs. - Run-time optimization tactic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst index 06106a6b4c..35062e0057 100644 --- a/doc/sphinx/proof-engine/ltac2.rst +++ b/doc/sphinx/proof-engine/ltac2.rst @@ -510,9 +510,9 @@ Static semantics **************** During internalization, Coq variables are resolved and antiquotations are -type-checked as Ltac2 terms, effectively producing a ``glob_constr`` in Coq +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 +type checking of **Ltac2**, the resulting term has not been fully computed and is potentially ill-typed as a runtime **Coq** term. .. example:: @@ -523,12 +523,12 @@ is potentially ill-typed as a runtime **Coq** term. Ltac2 myconstr () := constr:(nat -> 0). -Term antiquotations are type-checked in the enclosing Ltac2 typing context +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`. + The following will type check, with type `constr`. .. coqdoc:: @@ -539,7 +539,7 @@ expanded by the Coq binders from the term. .. example:: - The following Ltac2 expression will **not** type-check:: + The following Ltac2 expression will **not** type check:: `constr:(fun x : nat => ltac2:(exact x))` `(* Error: Unbound variable 'x' *)` @@ -583,7 +583,7 @@ Dynamic semantics ***************** During evaluation, a quoted term is fully evaluated to a kernel term, and is -in particular type-checked in the current environment. +in particular type checked in the current environment. Evaluation of a quoted term goes as follows. @@ -602,7 +602,7 @@ 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 +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. @@ -700,7 +700,7 @@ The following scopes are built-in. + parses :n:`c = @term` and produces :n:`constr:(c)` - This scope can be parameterized by a list of delimiting keys of interpretation + This scope can be parameterized by a list of delimiting keys of notation scopes (as described in :ref:`LocalInterpretationRulesForNotations`), describing how to interpret the parsed term. For instance, :n:`constr(A, B)` parses :n:`c = @term` and produces :n:`constr:(c%A%B)`. diff --git a/doc/sphinx/proof-engine/proof-handling.rst b/doc/sphinx/proof-engine/proof-handling.rst index 3b5233502d..cf4d432f64 100644 --- a/doc/sphinx/proof-engine/proof-handling.rst +++ b/doc/sphinx/proof-engine/proof-handling.rst @@ -90,9 +90,7 @@ list of assertion commands is given in :ref:`Assertions`. The command .. cmd:: Save @ident :name: Save - Forces the name of the original goal to be :token:`ident`. This - command can only be used if the original goal - was opened using the :cmd:`Goal` command. + Forces the name of the original goal to be :token:`ident`. .. cmd:: Admitted @@ -821,7 +819,7 @@ in compacted hypotheses: .. .. image:: ../_static/diffs-coqide-compacted.png - :alt: coqide with Set Diffs on with compacted hyptotheses + :alt: coqide with Set Diffs on with compacted hypotheses Controlling the effect of proof editing commands ------------------------------------------------ diff --git a/doc/sphinx/proof-engine/ssreflect-proof-language.rst b/doc/sphinx/proof-engine/ssreflect-proof-language.rst index b5d1e8bffd..4be18ccda9 100644 --- a/doc/sphinx/proof-engine/ssreflect-proof-language.rst +++ b/doc/sphinx/proof-engine/ssreflect-proof-language.rst @@ -286,7 +286,7 @@ example, the null and all list function(al)s can be defined as follows: .. coqtop:: all Variable d: Set. - Fixpoint null (s : list d) := + Definition null (s : list d) := if s is nil then true else false. Variable a : d -> bool. Fixpoint all (s : list d) : bool := @@ -1624,9 +1624,15 @@ 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:: +Notations can be used to name tactics, for example - Notation myop := (ltac:(some ltac code)) : ssripat_scope. +.. 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. diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst index 7da453b7af..8989dd29ab 100644 --- a/doc/sphinx/proof-engine/tactics.rst +++ b/doc/sphinx/proof-engine/tactics.rst @@ -1875,6 +1875,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) Lemma induction_test : forall n:nat, n = n -> n <= n. intros n H. induction n. + exact (le_n 0). .. exn:: Not an inductive product. :undocumented: @@ -2076,7 +2077,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) Now we are in a contradictory context and the proof can be solved. - .. coqtop:: all + .. coqtop:: all abort inversion H. @@ -2104,68 +2105,7 @@ analysis on inductive or co-inductive objects (see :ref:`inductive-definitions`) See also the larger example of :tacn:`dependent induction` and an explanation of the underlying technique. -.. tacn:: function induction (@qualid {+ @term}) - :name: function induction - - The tactic functional induction performs case analysis and induction - following the definition of a function. It makes use of a principle - generated by ``Function`` (see :ref:`advanced-recursive-functions`) or - ``Functional Scheme`` (see :ref:`functional-scheme`). - Note that this tactic is only available after a ``Require Import FunInd``. - -.. 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:`(@qualid {+ @term})` must be a correct full application - of :n:`@qualid`. In particular, the rules for implicit arguments are the - same as usual. For example use :n:`@qualid` if you want to write implicit - arguments explicitly. - -.. note:: - Parentheses around :n:`@qualid {+ @term}` are not mandatory and can be skipped. - -.. note:: - :n:`functional induction (f x1 x2 x3)` is actually a wrapper for - :n:`induction x1, x2, x3, (f x1 x2 x3) using @qualid` followed by a cleaning - phase, where :n:`@qualid` is the induction principle registered for :g:`f` - (by the ``Function`` (see :ref:`advanced-recursive-functions`) or - ``Functional Scheme`` (see :ref:`functional-scheme`) - command) corresponding to the sort of the goal. Therefore - ``functional induction`` may fail if the induction scheme :n:`@qualid` is not - defined. See also :ref:`advanced-recursive-functions` for the function - terms accepted by ``Function``. - -.. note:: - There is a difference between obtaining an induction scheme - for a function by using :g:`Function` (see :ref:`advanced-recursive-functions`) - and by using :g:`Functional Scheme` after a normal definition using - :g:`Fixpoint` or :g:`Definition`. See :ref:`advanced-recursive-functions` - for details. - -.. seealso:: :ref:`advanced-recursive-functions`, :ref:`functional-scheme` and :tacn:`inversion` - -.. exn:: Cannot find induction information on @qualid. - :undocumented: - -.. exn:: Not the right number of induction arguments. - :undocumented: - -.. tacv:: functional induction (@qualid {+ @term}) as @simple_intropattern using @term with @bindings_list - - Similarly to :tacn:`induction` and :tacn:`elim`, this allows giving - explicitly the name of the introduced variables, the induction principle, and - the values of dependent premises of the elimination scheme, including - *predicates* for mutual induction when :n:`@qualid` is part of a mutually - recursive definition. +.. seealso:: :tacn:`functional induction` .. tacn:: discriminate @term :name: discriminate @@ -2672,6 +2612,8 @@ and an explanation of the underlying technique. assumption. Qed. +.. seealso:: :tacn:`functional inversion` + .. tacn:: fix @ident @num :name: fix @@ -3187,6 +3129,7 @@ the conversion in hypotheses :n:`{+ @ident}`. head normal form according to the :math:`\beta`:math:`\delta`:math:`\iota`:math:`\zeta`-reduction rules, i.e. it reduces the head of the goal until it becomes a product or an irreducible term. All inner :math:`\beta`:math:`\iota`-redexes are also reduced. + The behavior of both :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`. @@ -3213,76 +3156,10 @@ the conversion in hypotheses :n:`{+ @ident}`. The :tacn:`cbn` tactic accepts the same flags as :tacn:`cbv` and :tacn:`lazy`. The behavior of both :tacn:`simpl` and :tacn:`cbn` - can be tuned using the Arguments vernacular command as follows: - - + A constant can be marked to be never unfolded by :tacn:`cbn` or - :tacn:`simpl`: - - .. example:: - - .. coqtop:: all - - Arguments minus n m : simpl never. - - After that command an expression like :g:`(minus (S x) y)` is left - untouched by the tactics :tacn:`cbn` and :tacn:`simpl`. - - + A constant can be marked to be unfolded only if applied to enough - arguments. The number of arguments required can be specified using the - ``/`` symbol in the argument list of the :cmd:`Arguments` command. - - .. example:: + can be tuned using the :cmd:`Arguments` command. - .. 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 constant volatile, i.e. - always unfolded. - - .. example:: - - .. coqtop:: all - - Definition volatile := fun x : nat => x. - Arguments volatile / x. - - + A 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)`. - - + A special heuristic to determine if a constant has to be unfolded - can be activated with the following command: - - .. example:: - - .. coqtop:: all - - Arguments minus n m : simpl nomatch. - - The heuristic avoids to perform a simplification step that would expose a - match construct in head position. For example the expression - :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 :math:`\beta`:math:`\iota`-reduction. Then, it - expands transparent constants and tries to reduce further using :math:`\beta`:math:`\iota`-reduction. - But, when no :math:`\iota` rule is applied after unfolding then - :math:`\delta`-reductions are not applied. For instance trying to use :tacn:`simpl` on - :g:`(plus n O) = n` changes nothing. + .. todo add "See <subsection about controlling the behavior of reduction strategies>" + to TBA section Notice that only transparent constants whose name can be reused in the recursive calls are possibly unfolded by :tacn:`simpl`. For instance a @@ -4010,10 +3887,10 @@ At Coq startup, only the core database is nonempty and can be used. :arith: This database contains all lemmas about Peano’s arithmetic proved in the directories Init and Arith. -:zarith: contains lemmas about binary signed integers from the directories - theories/ZArith. When required, the module Omega also extends the - database zarith with a high-cost hint that calls ``omega`` on equations - and inequalities in ``nat`` or ``Z``. +:zarith: contains 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: contains lemmas about booleans, mostly from directory theories/Bool. @@ -4604,42 +4481,6 @@ symbol :g:`=`. Analogous to :tacn:`dependent rewrite ->` but uses the equality from right to left. -Inversion ---------- - -.. tacn:: functional inversion @ident - :name: functional inversion - - :tacn:`functional inversion` is a tactic that performs inversion on hypothesis - :n:`@ident` of the form :n:`@qualid {+ @term} = @term` or :n:`@term = @qualid - {+ @term}` where :n:`@qualid` must have been defined using Function (see - :ref:`advanced-recursive-functions`). Note that this tactic is only - available after a ``Require Import FunInd``. - - .. 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. - - - .. tacv:: functional inversion @num - - This does the same thing as :n:`intros until @num` followed by - :n:`functional inversion @ident` where :token:`ident` is the - identifier for the last introduced hypothesis. - - .. tacv:: functional inversion @ident @qualid - functional inversion @num @qualid - - If the hypothesis :token:`ident` (or :token:`num`) 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. - Classical tactics ----------------- @@ -4696,18 +4537,6 @@ Automating 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. -.. tacn:: omega - :name: omega - - The tactic :tacn:`omega`, due to Pierre Crégut, is an automatic decision - procedure for Presburger arithmetic. It solves quantifier-free - formulas built with `~`, `\\/`, `/\\`, `->` on top of equalities, - inequalities and disequalities on both the type :g:`nat` of natural numbers - and :g:`Z` of binary integers. This tactic must be loaded by the command - ``Require Import Omega``. See the additional documentation about omega - (see Chapter :ref:`omega`). - - .. tacn:: ring :name: ring diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst index 7d031b9b7a..1759264e87 100644 --- a/doc/sphinx/proof-engine/vernacular-commands.rst +++ b/doc/sphinx/proof-engine/vernacular-commands.rst @@ -56,115 +56,6 @@ Displaying .. todo: "A.B" is permitted but unnecessary for modules/sections. should the command just take an @ident? - -.. _flags-options-tables: - -Flags, Options and Tables ------------------------------ - -Coq has many settings to control its behavior. Setting types include flags, options -and tables: - -* A *flag* has a boolean value, such as :flag:`Asymmetric Patterns`. -* An *option* generally has a numeric or string value, such as :opt:`Firstorder Depth`. -* A *table* contains a set of strings or qualids. -* In addition, some commands provide settings, such as :cmd:`Extraction Language`. - -.. FIXME Convert "Extraction Language" to an option. - -Flags, options and tables are identified by a series of identifiers, each with an initial -capital letter. - -.. cmd:: Set @setting_name {? {| @int | @string } } - :name: Set - - .. insertprodn setting_name setting_name - - .. prodn:: - setting_name ::= {+ @ident } - - 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 <set_unset_scope_qualifiers>`. - - .. warn:: There is no option @setting_name. - - This message also appears for unknown flags. - -.. cmd:: Unset @setting_name - :name: Unset - - 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 <set_unset_scope_qualifiers>`. - -.. 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, otherise this is equivalent to - :cmd:`Print Table`. The `for` clause is not valid for flags and options. - -.. 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 :attr:`local`, -:attr:`global` and :attr:`export` locality attributes: - -* no attribute: the original setting is *not* restored at the end of - the current module or section. -* :attr:`local` (an alternative syntax is to use the ``Local`` - prefix): the setting is applied within the current module or - section. The original value of the setting is restored at the end - of the current module or section. -* :attr:`export` (an alternative syntax is to use the ``Export`` - prefix): similar to :attr:`local`, the original value of the setting - is restored at the end of the current module or section. In - addition, if the value is set in a module, then :cmd:`Import`\-ing - the module sets the option or flag. -* :attr:`global` (an alternative syntax is to use the ``Global`` - prefix): the original setting is *not* restored at the end of the - current module or section. In addition, if the value is set in a - file, then :cmd:`Require`\-ing the file sets the option. - -Newly opened modules and sections inherit the current settings. - -.. note:: - - The use of the :attr:`global` attribute with the :cmd:`Set` and - :cmd:`Unset` commands is discouraged. 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 - (cf. :ref:`command-line-options`). - Query commands -------------- @@ -181,7 +72,8 @@ to accessible objects. (see Section :ref:`invocation-of-tactics`). or an accessible theorem, axiom, etc.: its kind (module, constant, assumption, inductive, constructor, abbreviation, …), long name, type, implicit arguments and - argument scopes. It does not print the body of definitions or proofs. + argument scopes (as set in the definition of :token:`smart_qualid` or + subsequently with the :cmd:`Arguments` command). It does not print the body of definitions or proofs. .. cmd:: Check @term @@ -210,7 +102,7 @@ to accessible objects. (see Section :ref:`invocation-of-tactics`). .. prodn:: search_item ::= @one_term - | @string {? % @scope } + | @string {? % @scope_key } Displays the name and type of all hypotheses of the selected goal (if any) and theorems of the current context @@ -1076,6 +968,8 @@ Controlling Typing Flags Print the status of the three typing flags: guard checking, positivity checking and universe checking. +See also :flag:`Cumulative StrictProp` in the |SProp| chapter. + .. example:: .. coqtop:: all reset diff --git a/doc/sphinx/std-glossindex.rst b/doc/sphinx/std-glossindex.rst new file mode 100644 index 0000000000..91e9da20fe --- /dev/null +++ b/doc/sphinx/std-glossindex.rst @@ -0,0 +1,9 @@ +:orphan: + +.. hack to get index in TOC + +.. _glossary_index: + +-------------- +Glossary index +-------------- diff --git a/doc/sphinx/user-extensions/proof-schemes.rst b/doc/sphinx/user-extensions/proof-schemes.rst index 34197c4fcf..e05be7c2c2 100644 --- a/doc/sphinx/user-extensions/proof-schemes.rst +++ b/doc/sphinx/user-extensions/proof-schemes.rst @@ -190,146 +190,7 @@ Combined Scheme Check tree_forest_mutrect. -.. _functional-scheme: - -Generation of induction principles with ``Functional`` ``Scheme`` ------------------------------------------------------------------ - - -.. cmd:: Functional Scheme @ident__0 := Induction for @ident' Sort @sort {* with @ident__i := Induction for @ident__i' Sort @sort} - - This command is a high-level experimental tool for - generating automatically induction principles corresponding to - (possibly mutually recursive) functions. First, it must be made - available via ``Require Import FunInd``. - Each :n:`@ident__i` is a different mutually defined function - name (the names must be in the same order as when they were defined). This - command generates the induction principle for each :n:`@ident__i`, following - the recursive structure and case analyses of the corresponding function - :n:`@ident__i'`. - -.. 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:`function 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. +.. seealso:: :ref:`functional-scheme` .. _derive-inversion: diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst index 512378b9fc..d72409e0d9 100644 --- a/doc/sphinx/user-extensions/syntax-extensions.rst +++ b/doc/sphinx/user-extensions/syntax-extensions.rst @@ -1,7 +1,7 @@ -.. _syntaxextensionsandinterpretationscopes: +.. _syntax-extensions-and-notation-scopes: -Syntax extensions and interpretation 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 @@ -14,7 +14,7 @@ variant of :cmd:`Notation` which does not modify the parser; this provides a form of :ref:`abbreviation <Abbreviations>`. 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:`interpretation scopes <Scopes>`. +of :ref:`notation scopes <Scopes>`. The main command to provide custom notations for tactics is :cmd:`Tactic Notation`. .. coqtop:: none @@ -26,33 +26,43 @@ The main command to provide custom notations for tactics is :cmd:`Tactic Notatio Notations --------- + Basic notations ~~~~~~~~~~~~~~~ -.. cmd:: Notation +.. cmd:: Notation @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. - A *notation* is a symbolic expression denoting some term or term - pattern. + Specifying :token:`scope_name` associates the notation with that scope. Otherwise + it is a *lonely notation*, that is, not associated with a scope. -A typical notation is the use of the infix symbol ``/\`` to denote the -logical conjunction (and). Such a notation is declared by + .. 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). -The expression :g:`(and A B)` is the abbreviated term and the string :g:`"A /\ B"` -(called a *notation*) tells how it is symbolically written. +:g:`"A /\ B"` is a *notation*, which tells how to represent the abbreviated term +:g:`(and A B)`. -A notation is always surrounded by double quotes (except when the +Notations must be in double quotes, except when the abbreviation has the form of an ordinary applicative expression; -see :ref:`Abbreviations`). The notation is composed of *tokens* separated by -spaces. Identifiers in the string (such as ``A`` and ``B``) are the *parameters* -of the notation. Each of them must occur at least once in the denoted term. The +see :ref:`Abbreviations`. The notation consists of *tokens* separated by +spaces. Alphanumeric strings (such as ``A`` and ``B``) 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*. -An identifier can be used as a symbol but it must be surrounded by -single quotes to avoid the confusion with a parameter. Similarly, +Substrings enclosed in single quotes are treated as literals. This is necessary +for substrings that would otherwise be interpreted as :n:`@ident`\s. Similarly, every symbol of at least 3 characters and starting with a simple quote must be quoted (then it starts by two single quotes). Here is an example. @@ -63,7 +73,8 @@ example. A notation binds a syntactic expression to a term. Unless the parser and pretty-printer of Coq already know how to deal with the syntactic -expression (see :ref:`ReservingNotations`), explicit precedences and +expression (such as through :cmd:`Reserved Notation` or for notations +that contain only literals), explicit precedences and associativity rules have to be given. .. note:: @@ -104,13 +115,12 @@ Similarly, an associativity is needed to decide whether :g:`True /\ False /\ Fal 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 of -the associativity of disjunction and conjunction, so let us apply for instance a +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 have to be -given between parentheses in a list of :token:`modifiers` that the :cmd:`Notation` -command understands. Here is how the previous examples refine. +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 @@ -158,8 +168,8 @@ One can also define notations for binders. 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 types casts, as shown by the command :cmd:`Print -Grammar constr` is at level 100. To avoid ``x : A`` being parsed as a type cast, +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: @@ -204,16 +214,6 @@ 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`. -.. cmd:: Print Grammar constr. - - This command displays the current state of the Coq term parser. - -.. cmd:: Print Grammar pattern. - - This displays the state of the subparser of patterns (the parser used in the - grammar of the ``match with`` constructions). - - Displaying symbolic notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -252,8 +252,7 @@ bar of the notation. Check (sig (fun x : nat => x=x)). -The second, more powerful control on printing is by using the format -:token:`modifier`. Here is an example +The second, more powerful control on printing is by using :n:`@syntax_modifier`\s. Here is an example .. coqtop:: all @@ -301,8 +300,8 @@ expression is performed at definition time. Type checking is done only at the time of use of the notation. .. note:: Sometimes, a notation is expected only for the parser. To do - so, the option ``only parsing`` is allowed in the list of :token:`modifiers` - of :cmd:`Notation`. Conversely, the ``only printing`` :token:`modifier` can be + so, the option ``only parsing`` is allowed in the list of :n:`@syntax_modifier`\s + in :cmd:`Notation`. Conversely, the ``only printing`` :n:`@syntax_modifier` can be used to declare that a notation should only be used for printing and should not declare a parsing rule. In particular, such notations do not modify the parser. @@ -313,13 +312,14 @@ The Infix command The :cmd:`Infix` command is a shortcut for declaring notations for infix symbols. -.. cmd:: Infix @string := @term {? (@modifiers) } +.. cmd:: Infix @string := @one_term {? ( {+, @syntax_modifier } ) } {? : @scope_name } This command is equivalent to - :n:`Notation "x @symbol y" := (@term x y) {? (@modifiers) }.` + :n:`Notation "x @string y" := (@one_term x y) {? ( {+, @syntax_modifier } ) } {? : @scope_name }` - where ``x`` and ``y`` are fresh names. Here is an example. + where ``x`` and ``y`` are fresh names and omitting the quotes around :n:`@string`. + Here is an example: .. coqtop:: in @@ -330,7 +330,7 @@ symbols. Reserving notations ~~~~~~~~~~~~~~~~~~~ -.. cmd:: Reserved Notation @string {? (@modifiers) } +.. 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 @@ -349,26 +349,34 @@ Reserving notations .. note:: The notations mentioned in the module :ref:`init-notations` are reserved. Hence their precedence and associativity cannot be changed. - .. cmdv:: Reserved Infix "@symbol" {* @modifiers} + .. 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, it is used by + 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. A specific interpretation can provide its own format - overriding the default format though. + notation. Individual interpretations can override the format. Simultaneous definition of terms and notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Thanks to reserved notations, the inductive, co-inductive, record, recursive and -corecursive definitions can benefit from customized notations. To do this, insert -a ``where`` notation clause after the definition of the (co)inductive type or +Thanks to reserved notations, inductive, co-inductive, record, 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). The exact syntax is given by :n:`@decl_notation` for inductive, co-inductive, recursive and corecursive definitions and in :ref:`record-types` -for records. Here are examples: +for records. + + .. insertprodn decl_notations decl_notation + + .. prodn:: + decl_notations ::= where @decl_notation {* and @decl_notation } + decl_notation ::= @string := @one_term {? ( only parsing ) } {? : @scope_name } + +Here are examples: .. coqtop:: in @@ -403,8 +411,29 @@ Displaying information about notations .. seealso:: - :flag:`Printing All` - To disable other elements in addition to notations. + :flag:`Printing All` to disable other elements in addition to notations. + + +.. cmd:: Print Grammar @ident + + Shows the grammar for the nonterminal :token:`ident`, which must be one of the following: + + - `constr` - for :token:`term`\s + - `pattern` - for :token:`pattern`\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 + + The first three of these give the precedence and associativity for each construct. + For example, these lines printed by `Print Grammar tactic` indicates that the `try` construct + is at level 3 and right-associative. `SELF` represents the `tactic_expr` nonterminal + at level 5 (the top level):: + + | "3" RIGHTA + [ IDENT "try"; SELF + + Note that the productions printed by this command are represented in the form used by + |Coq|'s parser (coqpp), which differs from how productions are shown in the documentation. .. _locating-notations: @@ -427,7 +456,7 @@ 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 interpretation scopes (see +:ref:`ImplicitArguments`) and notation scopes (see :ref:`Scopes`) of the constant. For instance: .. coqtop:: in reset @@ -441,7 +470,7 @@ the notation inherits the implicit arguments (see 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 interpretation scopes). +arguments (but not of notation scopes). Notations and binders ~~~~~~~~~~~~~~~~~~~~~ @@ -471,7 +500,7 @@ application of the notation: Check sigma z : nat, z = 0. -Notice the :token:`modifier` ``x ident`` in the declaration of the +Note the :n:`@syntax_modifier x ident` in the declaration of the notation. It tells to parse :g:`x` as a single identifier. Binders bound in the notation and parsed as patterns @@ -491,7 +520,7 @@ binder. Here is an example: Check subset '(x,y), x+y=0. -The :token:`modifier` ``p pattern`` in the declaration of the notation tells to parse +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: @@ -501,7 +530,7 @@ pattern, so, e.g., the following also works: 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 :token:`modifier` ``p strict pattern``. For parsing, however, a +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: @@ -541,7 +570,7 @@ 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 an identifier. The notation :g:`{ x | P }` is already defined in the standard -library with the ``as ident`` :token:`modifier`. We cannot redefine it but +library with the ``as ident`` :n:`@syntax_modifier`. We cannot redefine it but one can define an alternative notation, say :g:`{ p such that P }`, using instead ``as pattern``. @@ -561,7 +590,7 @@ is just an identifier, one could have said ``p at level 99 as strict pattern``. Note also that in the absence of a ``as ident``, ``as strict pattern`` or -``as pattern`` :token:`modifier`\s, the default is to consider sub-expressions occurring +``as pattern`` :n:`@syntax_modifier`\s, the default is to consider sub-expressions occurring in binding position and parsed as terms to be ``as ident``. .. _NotationsWithBinders: @@ -640,7 +669,7 @@ and the terminating expression is ``nil``. Here are other examples: Notations with recursive patterns can be reserved like standard notations, they can also be declared within -:ref:`interpretation scopes <Scopes>`. +:ref:`notation scopes <Scopes>`. .. _RecursiveNotationsWithBinders: @@ -662,7 +691,7 @@ except that in the iterator 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 :token:`modifiers` +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 @@ -740,10 +769,13 @@ Custom entries .. cmd:: Declare Custom Entry @ident - This command allows to define new grammar entries, called *custom + 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. + .. example:: For instance, we may want to define an ad hoc @@ -887,67 +919,48 @@ gives a way to let any arbitrary expression which is not handled by the custom entry ``expr`` be parsed or printed by the main grammar of term up to the insertion of a pair of curly brackets. -.. cmd:: Print Custom Grammar @ident. +.. cmd:: Print Custom Grammar @ident :name: Print Custom Grammar This displays the state of the grammar for terms associated to the custom entry :token:`ident`. -Summary +.. _NotationSyntax: + +Syntax ~~~~~~~ -.. _NotationSyntax: +Here are the syntax elements used by the various notation commands. -Syntax of notations -+++++++++++++++++++ - -The different syntactic forms taken by the commands declaring -notations are given below. The optional :n:`@scope` is described in -:ref:`Scopes`. - -.. productionlist:: coq - notation : [Local] Notation `string` := `term` [(`modifiers`)] [: `scope`]. - : [Local] Infix `string` := `qualid` [(`modifiers`)] [: `scope`]. - : [Local] Reserved Notation `string` [(`modifiers`)] . - : Inductive `ind_body` [`decl_notations`] with … with `ind_body` [`decl_notations`]. - : CoInductive `ind_body` [`decl_notations`] with … with `ind_body` [`decl_notations`]. - : Fixpoint `fix_body` [`decl_notations`] with … with `fix_body` [`decl_notations`]. - : CoFixpoint `fix_body` [`decl_notations`] with … with `fix_body` [`decl_notations`]. - : [Local] Declare Custom Entry `ident`. - modifiers : `modifier`, … , `modifier` - modifier : at level `num` - : in custom `ident` - : in custom `ident` at level `num` - : `ident` , … , `ident` at level `num` [`binderinterp`] - : `ident` , … , `ident` at next level [`binderinterp`] - : `ident` `explicit_subentry` - : left associativity - : right associativity - : no associativity - : only parsing - : only printing - : format `string` - explicit_subentry : ident - : global - : bigint - : [strict] pattern [at level `num`] - : binder - : closed binder - : constr [`binderinterp`] - : constr at level `num` [`binderinterp`] - : constr at next level [`binderinterp`] - : custom [`binderinterp`] - : custom at level `num` [`binderinterp`] - : custom at next level [`binderinterp`] - binderinterp : as ident - : as pattern - : as strict pattern - -.. insertprodn decl_notations decl_notation + .. insertprodn syntax_modifier level -.. prodn:: - decl_notations ::= where @decl_notation {* and @decl_notation } - decl_notation ::= @string := @one_term {? ( only parsing ) } {? : @ident } + .. prodn:: + syntax_modifier ::= at level @num + | in custom @ident {? at level @num } + | {+, @ident } at @level + | @ident at @level {? @binder_interp } + | @ident @explicit_subentry + | @ident @binder_interp + | left associativity + | right associativity + | no associativity + | only parsing + | only printing + | format @string {? @string } + explicit_subentry ::= ident + | global + | bigint + | strict pattern {? at level @num } + | binder + | closed binder + | constr {? at @level } {? @binder_interp } + | custom @ident {? at @level } {? @binder_interp } + | pattern {? at level @num } + binder_interp ::= as ident + | as pattern + | as strict pattern + level ::= level @num + | next level .. 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. @@ -981,106 +994,86 @@ notations are given below. The optional :n:`@scope` is described in due to legacy notation in the Coq standard library. It can be turned on with the ``-w disj-pattern-notation`` flag. -Persistence of notations -++++++++++++++++++++++++ - -Notations disappear when a section is closed. - -.. cmd:: Local Notation @notation +.. _Scopes: - Notations survive modules unless the command ``Local Notation`` is used instead - of :cmd:`Notation`. +Notation scopes +--------------- -.. cmd:: Local Declare Custom Entry @ident +A *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 numerals and +strings with the :cmd:`Numeral Notation` and :cmd:`String Notation` commands. - Custom entries survive modules unless the command ``Local Declare - Custom Entry`` is used instead of :cmd:`Declare Custom Entry`. + .. insertprodn scope scope_key -.. _Scopes: + .. prodn:: + scope ::= @scope_name + | @scope_key + scope_name ::= @ident + scope_key ::= @ident -Interpretation scopes ----------------------- +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. - .. insertprodn scope scope +.. cmd:: Declare Scope @scope_name - .. prodn:: - scope ::= @ident - -An *interpretation scope* is a set of notations for terms with their -interpretations. Interpretation scopes provide a weak, purely -syntactical form of notation overloading: the same notation, for -instance the infix symbol ``+``, can be used to denote distinct -definitions of the additive operator. Depending on which interpretation -scopes are currently open, the interpretation is different. -Interpretation scopes can include an interpretation for numerals and -strings, either at the OCaml level or using :cmd:`Numeral Notation` -or :cmd:`String Notation`. - -.. cmd:: Declare Scope @scope - - This adds a new scope named :n:`@scope`. Note that the initial - state of Coq declares by default the following interpretation scopes: + Declares a new notation scope. Note that the initial + state of Coq declares the following notation scopes: ``core_scope``, ``type_scope``, ``function_scope``, ``nat_scope``, ``bool_scope``, ``list_scope``, ``int_scope``, ``uint_scope``. -The syntax to associate a notation to a scope is given -:ref:`above <NotationSyntax>`. Here is a typical example which declares the -notation for conjunction in the scope ``type_scope``. - -.. coqtop:: in - - Notation "A /\ B" := (and A B) : type_scope. - -.. note:: A notation not defined in a scope is called a *lonely* - notation. No example of lonely notations can be found in the - initial state of Coq though. - + Use commands such as :cmd:`Notation` to add notations to the scope. Global interpretation rules for notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At any time, the interpretation of a notation for a term is done within -a *stack* of interpretation scopes and lonely notations. In case a -notation has several interpretations, the actual interpretation is the -one defined by (or in) the more recently declared (or opened) lonely -notation (or interpretation scope) which defines this notation. -Typically if a given notation is defined in some scope ``scope`` but has -also an interpretation not assigned to a scope, then, if ``scope`` is open -before the lonely interpretation is declared, then the lonely -interpretation is used (and this is the case even if the -interpretation of the notation in scope is given after the lonely -interpretation: otherwise said, only the order of lonely -interpretations and opening of scopes matters, and not the declaration -of interpretations within a scope). +a *stack* of notation scopes and 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. -.. cmd:: Open Scope @scope +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. - The command to add a scope to the interpretation scope stack is - :n:`Open Scope @scope`. +Use the :cmd:`Print Visibility` command to display the current notation scope stack. -.. cmd:: Close Scope @scope +.. cmd:: Open Scope @scope - It is also possible to remove a scope from the interpretation scope - stack by using the command :n:`Close 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. - Notice that this command does not only cancel the last :n:`Open Scope @scope` - but all its invocations. + 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. -.. note:: ``Open Scope`` and ``Close Scope`` do not survive the end of sections - where they occur. When defined outside of a section, they are exported - to the modules that import the module where they occur. + 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:: Local Open Scope @scope. - Local Close Scope @scope. +.. cmd:: Close Scope @scope - These variants are not exported to the modules that import the module where - they occur, even if outside a section. + Removes a scope from the notation scope stack. -.. cmd:: Global Open Scope @scope. - Global Close Scope @scope. + 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. - These variants survive sections. They behave as if Global were absent when - not inside a section. + 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: @@ -1090,123 +1083,40 @@ 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. -Local opening of an interpretation scope -+++++++++++++++++++++++++++++++++++++++++ - -It is possible to locally extend the interpretation scope stack using the syntax -:n:`(@term)%@ident` (or simply :n:`@term%@ident` for atomic terms), where :token:`ident` is a -special identifier called a *delimiting key* and bound to a given scope. - -In such a situation, the term term, and all its subterms, are -interpreted in the scope stack extended with the scope bound to :token:`ident`. - -.. cmd:: Delimit Scope @scope with @ident - - To bind a delimiting key to a scope, use the command - :n:`Delimit Scope @scope with @ident` - -.. cmd:: Undelimit Scope @scope - - To remove a delimiting key of a scope, use the command - :n:`Undelimit Scope @scope` - -Binding arguments of a constant to an interpretation scope -+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -.. cmd:: Arguments @qualid {+ @name%@ident} - :name: Arguments (scopes) - - It is possible to set in advance that some arguments of a given constant have - to be interpreted in a given scope. The command is - :n:`Arguments @qualid {+ @name%@ident}` where the list is a prefix of the - arguments of ``qualid`` optionally annotated with their scope :token:`ident`. Grouping - round parentheses can be used to decorate multiple arguments with the same - scope. :token:`ident` can be either a scope name or its delimiting key. For - example the following command puts the first two arguments of :g:`plus_fct` - in the scope delimited by the key ``F`` (``Rfun_scope``) and the last - argument in the scope delimited by the key ``R`` (``R_scope``). - - .. coqdoc:: - - Arguments plus_fct (f1 f2)%F x%R. - - The ``Arguments`` command accepts scopes decoration to all grouping - parentheses. In the following example arguments A and B are marked as - maximally inserted implicit arguments and are put into the ``type_scope`` scope. - - .. coqdoc:: - - Arguments respectful {A B}%type (R R')%signature _ _. - - When interpreting a term, if some of the arguments of :token:`qualid` are built - from a notation, then this notation is interpreted in the scope stack - extended by the scope bound (if any) to this argument. The effect of - the scope is limited to the argument itself. It does not propagate to - subterms but the subterms that, after interpretation of the notation, - turn to be themselves arguments of a reference are interpreted - accordingly to the argument scopes bound to this reference. - - .. cmdv:: Arguments @qualid : clear scopes - - This command can be used to clear argument scopes of :token:`qualid`. - - .. cmdv:: Arguments @qualid {+ @name%@ident} : extra scopes - - Defines extra argument scopes, to be used in case of coercion to ``Funclass`` - (see the :ref:`implicitcoercions` chapter) or with a computed type. +Opening a notation scope locally +++++++++++++++++++++++++++++++++ - .. cmdv:: Global Arguments @qualid {+ @name%@ident} +.. insertprodn term_scope term_scope - This behaves like :n:`Arguments qualid {+ @name%@ident}` but survives when a - section is closed instead of stopping working at section closing. Without the - ``Global`` modifier, the effect of the command stops when the section it belongs - to ends. - - .. cmdv:: Local Arguments @qualid {+ @name%@ident} - - This behaves like :n:`Arguments @qualid {+ @name%@ident}` but does not - survive modules and files. Without the ``Local`` modifier, the effect of the - command is visible from within other modules or files. - -.. seealso:: - - The command :cmd:`About` can be used to show the scopes bound to the - arguments of a function. +.. prodn:: + term_scope ::= @term0 % @scope_key -.. note:: +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 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: +In this case, :n:`@term` is +interpreted in the scope stack extended with the scope bound to :n:`@scope_key`. - .. coqtop:: all +.. cmd:: Delimit Scope @scope_name with @scope_key - Parameter g : bool -> bool. - Declare Scope mybool_scope. + Binds the delimiting key :token:`scope_key` to a scope. - Notation "@@" := true (only parsing) : bool_scope. - Notation "@@" := false (only parsing): mybool_scope. +.. cmd:: Undelimit Scope @scope_name - 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 #. + Removes the delimiting keys associated with a scope. -Binding types of arguments to an interpretation scope -+++++++++++++++++++++++++++++++++++++++++++++++++++++ +Binding types or coercion classes to a notation scope +++++++++++++++++++++++++++++++++++++++++++++++++++++++ -.. cmd:: Bind Scope @ident with {+ @class } +.. cmd:: Bind Scope @scope_name with {+ @class } - When an interpretation scope is naturally associated to a type (e.g. the - scope of operations on the natural numbers), it may be convenient to bind it - to this type. When a scope :token:`scope` is bound to a type :token:`type`, any function - gets its arguments of type :token:`type` interpreted by default in scope :token:`scope` - (this default behavior can however be overwritten by explicitly using the - command :cmd:`Arguments <Arguments (scopes)>`). + Binds the notation scope :token:`scope_name` to the type or coercion class :token:`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. 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 @@ -1214,10 +1124,6 @@ Binding types of arguments to an interpretation 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``. - More generally, any coercion :n:`@class` (see the :ref:`implicitcoercions` chapter) - can be bound to an interpretation scope. The command to do it is - :n:`Bind Scope @scope with @class` - .. coqtop:: in reset Parameter U : Set. @@ -1237,13 +1143,13 @@ Binding types of arguments to an interpretation 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 <Arguments (scopes)>` command. + :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`` interpretation scope -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The ``type_scope`` notation scope +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: type_scope @@ -1258,8 +1164,8 @@ 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`` interpretation scope -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The ``function_scope`` notation scope +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: function_scope @@ -1269,8 +1175,8 @@ recognized to be a ``Funclass`` instance, i.e., of type :g:`forall x:A, B` or :g:`A -> B`. -Interpretation scopes used in the standard library of Coq -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Notation scopes used in the standard library of Coq +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We give an overview of the scopes used in the standard library of Coq. For a complete list of notations in each scope, use the commands :cmd:`Print @@ -1356,40 +1262,52 @@ Scopes` or :cmd:`Print Scope`. Displaying information about scopes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -.. cmd:: Print Visibility +.. cmd:: Print Visibility {? @scope_name } - This displays the current stack of notations in scopes and lonely - notations that is used to interpret a notation. The top of the stack + 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. - .. cmdv:: Print Visibility @scope - - This displays the current stack of notations in scopes and lonely - notations assuming that :token:`scope` is pushed on top of the stack. This is - useful to know how a subterm locally occurring in the scope :token:`scope` is - interpreted. + 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 - This displays all the notations, delimiting keys and corresponding - classes of all the existing interpretation scopes. It also displays the - lonely notations. + 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 lonely notations. + + .. todo should the command report all delimiting keys? + + Use the :cmd:`Print Visibility` command to display the current notation scope stack. - .. cmdv:: Print Scope @scope - :name: Print Scope +.. cmd:: Print Scope @scope_name + :name: Print Scope - This displays all the notations defined in the interpretation scope :token:`scope`. - It also displays the delimiting key if any and the class to which the - scope is bound, if any. + 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:: {? Local} Notation @ident {+ @ident} := @term {? (only parsing)}. +.. cmd:: Notation @ident {* @ident__parm } := @one_term {? ( only parsing ) } + :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. An *abbreviation* is a name, possibly applied to arguments, that denotes a (presumably) more complex expression. Here are examples: @@ -1417,6 +1335,14 @@ Abbreviations 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 @@ -1453,7 +1379,7 @@ Abbreviations Like for notations, if the right-hand side of an abbreviation is a partially applied constant, the abbreviation inherits the implicit - arguments and interpretation scopes of the constant. As an + 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. @@ -1462,64 +1388,88 @@ Abbreviations Numeral notations ----------------- -.. cmd:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope. +.. cmd:: Numeral Notation @qualid @qualid__parse @qualid__print : @scope_name {? @numeral_modifier } :name: Numeral Notation + .. insertprodn numeral_modifier numeral_modifier + + .. prodn:: + numeral_modifier ::= ( warning after @numeral ) + | ( abstract after @numeral ) + This command allows the user to customize the way numeral literals are parsed and printed. - The token :n:`@ident__1` should be the name of an inductive type, - while :n:`@ident__2` and :n:`@ident__3` should be the names of the - parsing and printing functions, respectively. The parsing function - :n:`@ident__2` should have one of the following types: - - * :n:`Decimal.int -> @ident__1` - * :n:`Decimal.int -> option @ident__1` - * :n:`Decimal.uint -> @ident__1` - * :n:`Decimal.uint -> option @ident__1` - * :n:`Z -> @ident__1` - * :n:`Z -> option @ident__1` - * :n:`Decimal.decimal -> @ident__1` - * :n:`Decimal.decimal -> option @ident__1` - - And the printing function :n:`@ident__3` should have one of the - following types: - - * :n:`@ident__1 -> Decimal.int` - * :n:`@ident__1 -> option Decimal.int` - * :n:`@ident__1 -> Decimal.uint` - * :n:`@ident__1 -> option Decimal.uint` - * :n:`@ident__1 -> Z` - * :n:`@ident__1 -> option Z` - * :n:`@ident__1 -> Decimal.decimal` - * :n:`@ident__1 -> option Decimal.decimal` - - When parsing, the application of the parsing function - :n:`@ident__2` to the number will be fully reduced, and universes - of the resulting term will be refreshed. - - Note that only fully-reduced ground terms (terms containing only - function application, constructors, inductive type families, - sorts, and primitive integers) will be considered for printing. - - .. cmdv:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope (warning after @num). - - When a literal larger than :token:`num` is parsed, a warning - message about possible stack overflow, resulting from evaluating - :n:`@ident__2`, will be displayed. - - .. cmdv:: Numeral Notation @ident__1 @ident__2 @ident__3 : @scope (abstract after @num). - - When a literal :g:`m` larger than :token:`num` is parsed, the - result will be :n:`(@ident__2 m)`, without reduction of this - application to a normal form. Here :g:`m` will be a - :g:`Decimal.int` or :g:`Decimal.uint` or :g:`Z`, depending on the - type of the parsing function :n:`@ident__2`. This allows for a - more compact representation of literals in types such as :g:`nat`, - and limits parse failures due to stack overflow. Note that a - warning will be emitted when an integer larger than :token:`num` - is parsed. Note that :n:`(abstract after @num)` has no effect - when :n:`@ident__2` lands in an :g:`option` type. + :n:`@qualid` + 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:`Decimal.int -> @qualid` + * :n:`Decimal.int -> option @qualid` + * :n:`Decimal.uint -> @qualid` + * :n:`Decimal.uint -> option @qualid` + * :n:`Z -> @qualid` + * :n:`Z -> option @qualid` + * :n:`Decimal.decimal -> @qualid` + * :n:`Decimal.decimal -> option @qualid` + + And the printing function :n:`@qualid__print` should have one of the + following types: + + * :n:`@qualid -> Decimal.int` + * :n:`@qualid -> option Decimal.int` + * :n:`@qualid -> Decimal.uint` + * :n:`@qualid -> option Decimal.uint` + * :n:`@qualid -> Z` + * :n:`@qualid -> option Z` + * :n:`@qualid -> Decimal.decimal` + * :n:`@qualid -> option Decimal.decimal` + + 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, and primitive integers) will be considered for printing. + + :n:`( warning after @numeral )` + displays a warning message about a possible stack + overflow when calling :n:`@qualid__parse` to parse a literal larger than :n:`@numeral`. + + .. warn:: Stack overflow or segmentation fault happens when working with large numbers in @type (threshold may vary depending on your system limits and on the command executed). + + When a :cmd:`Numeral Notation` is registered in the current scope + with :n:`(warning after @numeral)`, this warning is emitted when + parsing a numeral greater than or equal to :token:`numeral`. + + :n:`( abstract after @numeral )` + returns :n:`(@qualid__parse m)` when parsing a literal + :n:`m` that's greater than :n:`@numeral` rather than reducing it to a normal form. + Here :g:`m` will be a + :g:`Decimal.int` or :g:`Decimal.uint` or :g:`Z`, depending on the + type of the parsing function :n:`@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:`numeral` + is parsed. Note that :n:`(abstract after @numeral)` 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:`Numeral Notation` is registered in the current scope + with :n:`(abstract after @numeral)`, this warning is emitted when + parsing a numeral greater than or equal to :token:`numeral`. + Typically, this indicates that the fully computed representation + of numerals can be so large that non-tail-recursive OCaml + functions run out of stack space when trying to walk them. + + .. 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 @num)` directive has no + effect when :n:`@qualid__parse` lands in an :g:`option` type. .. exn:: Cannot interpret this number as a value of type @type @@ -1529,22 +1479,16 @@ Numeral notations only for integers or non-negative integers, and the given numeral has a fractional or exponent part or is negative. - - .. exn:: @ident should go from Decimal.int to @type or (option @type). Instead of Decimal.int, the types Decimal.uint or Z or Int63.int or Decimal.decimal could be used (you may need to require BinNums or Decimal or Int63 first). + .. exn:: @qualid__parse should go from Decimal.int to @type or (option @type). Instead of Decimal.int, the types Decimal.uint or Z or Int63.int or Decimal.decimal could be used (you may need to require BinNums or Decimal or Int63 first). The parsing function given to the :cmd:`Numeral Notation` vernacular is not of the right type. - .. exn:: @ident should go from @type to Decimal.int or (option Decimal.int). Instead of Decimal.int, the types Decimal.uint or Z or Int63.int or Decimal.decimal could be used (you may need to require BinNums or Decimal or Int63 first). + .. exn:: @qualid__print should go from @type to Decimal.int or (option Decimal.int). Instead of Decimal.int, the types Decimal.uint or Z or Int63.int or Decimal.decimal could be used (you may need to require BinNums or Decimal or Int63 first). The printing function given to the :cmd:`Numeral Notation` vernacular is not of the right type. - .. exn:: @type is not an inductive type. - - Numeral notations can only be declared for inductive types with no - arguments. - .. exn:: Unexpected term @term while parsing a numeral notation. Parsing functions must always return ground terms, made up of @@ -1559,98 +1503,39 @@ Numeral notations concrete numeral expressed as a decimal. They may not return opaque constants. - .. exn:: Cannot interpret in @scope because @ident could not be found in the current environment. - - The inductive type used to register the numeral notation is no - longer available in the environment. Most likely, this is because - the numeral notation was declared inside a functor for an - inductive type inside the functor. This use case is not currently - supported. - - Alternatively, you might be trying to use a primitive token - notation from a plugin which forgot to specify which module you - must :g:`Require` for access to that notation. - - .. exn:: Syntax error: [prim:reference] expected after 'Notation' (in [vernac:command]). - - The type passed to :cmd:`Numeral Notation` must be a single - identifier. - - .. exn:: Syntax error: [prim:reference] expected after [prim:reference] (in [vernac:command]). - - Both functions passed to :cmd:`Numeral Notation` must be single - identifiers. - - .. exn:: The reference @ident was not found in the current environment. - - Identifiers passed to :cmd:`Numeral Notation` must exist in the - global environment. - - .. exn:: @ident is bound to a notation that does not denote a reference. - - Identifiers passed to :cmd:`Numeral Notation` must be global - references, or notations which denote to single identifiers. - - .. warn:: Stack overflow or segmentation fault happens when working with large numbers in @type (threshold may vary depending on your system limits and on the command executed). - - When a :cmd:`Numeral Notation` is registered in the current scope - with :n:`(warning after @num)`, this warning is emitted when - parsing a numeral greater than or equal to :token:`num`. - - .. warn:: To avoid stack overflow, large numbers in @type are interpreted as applications of @ident__2. - - When a :cmd:`Numeral Notation` is registered in the current scope - with :n:`(abstract after @num)`, this warning is emitted when - parsing a numeral greater than or equal to :token:`num`. - Typically, this indicates that the fully computed representation - of numerals can be so large that non-tail-recursive OCaml - functions run out of stack space when trying to walk them. - - For example - - .. coqtop:: all warn - - Check 90000. - - .. warn:: The 'abstract after' directive has no effect when the parsing function (@ident__2) targets an option type. - - As noted above, the :n:`(abstract after @num)` directive has no - effect when :n:`@ident__2` lands in an :g:`option` type. - String notations ----------------- -.. cmd:: String Notation @ident__1 @ident__2 @ident__3 : @scope. +.. cmd:: String Notation @qualid @qualid__parse @qualid__print : @scope_name :name: String Notation - This command allows the user to customize the way strings are parsed - and printed. + Allows the user to customize how strings are parsed and printed. - The token :n:`@ident__1` should be the name of an inductive type, - while :n:`@ident__2` and :n:`@ident__3` should be the names of the + The token :n:`@qualid` should be 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:`@ident__2` should have one of the following types: + :n:`@qualid__parse` should have one of the following types: - * :n:`Byte.byte -> @ident__1` - * :n:`Byte.byte -> option @ident__1` - * :n:`list Byte.byte -> @ident__1` - * :n:`list Byte.byte -> option @ident__1` + * :n:`Byte.byte -> @qualid` + * :n:`Byte.byte -> option @qualid` + * :n:`list Byte.byte -> @qualid` + * :n:`list Byte.byte -> option @qualid` - And the printing function :n:`@ident__3` should have one of the + The printing function :n:`@qualid__print` should have one of the following types: - * :n:`@ident__1 -> Byte.byte` - * :n:`@ident__1 -> option Byte.byte` - * :n:`@ident__1 -> list Byte.byte` - * :n:`@ident__1 -> option (list Byte.byte)` + * :n:`@qualid -> Byte.byte` + * :n:`@qualid -> option Byte.byte` + * :n:`@qualid -> list Byte.byte` + * :n:`@qualid -> option (list Byte.byte)` - When parsing, the application of the parsing function - :n:`@ident__2` to the string will be fully reduced, and universes - of the resulting term will be refreshed. + 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, and primitive integers) will be considered for printing. + Note that only fully-reduced ground terms (terms containing only + function application, constructors, inductive type families, + sorts, and primitive integers) will be considered for printing. .. exn:: Cannot interpret this string as a value of type @type @@ -1658,21 +1543,16 @@ String notations the given string. This error is given when the interpretation function returns :g:`None`. - .. exn:: @ident should go from Byte.byte or (list Byte.byte) to @type or (option @type). + .. exn:: @qualid__parse should go from Byte.byte or (list Byte.byte) to @type or (option @type). The parsing function given to the :cmd:`String Notation` vernacular is not of the right type. - .. exn:: @ident should go from @type to Byte.byte or (option Byte.byte) or (list Byte.byte) or (option (list Byte.byte)). + .. exn:: @qualid__print should go from @type to Byte.byte or (option Byte.byte) or (list Byte.byte) or (option (list Byte.byte)). The printing function given to the :cmd:`String Notation` vernacular is not of the right type. - .. exn:: @type is not an inductive type. - - String notations can only be declared for inductive types with no - arguments. - .. exn:: Unexpected term @term while parsing a string notation. Parsing functions must always return ground terms, made up of @@ -1687,11 +1567,18 @@ String notations concrete string expressed as a decimal. They may not return opaque constants. - .. exn:: Cannot interpret in @scope because @ident could not be found in the current environment. +The following errors apply to both string and numeral notations: + + .. exn:: @type is not an inductive type. + + String and numeral notations can only be declared for inductive types with no + arguments. - The inductive type used to register the string notation is no + .. 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 numeral notation is no longer available in the environment. Most likely, this is because - the string notation was declared inside a functor for an + the notation was declared inside a functor for an inductive type inside the functor. This use case is not currently supported. @@ -1701,131 +1588,184 @@ String notations .. exn:: Syntax error: [prim:reference] expected after 'Notation' (in [vernac:command]). - The type passed to :cmd:`String Notation` must be a single + The type passed to :cmd:`String Notation` or :cmd:`Numeral 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` must be single + Both functions passed to :cmd:`String Notation` or :cmd:`Numeral Notation` must be single qualified identifiers. - .. exn:: The reference @ident was not found in the current environment. + .. todo: generally we don't document syntax errors. Is this a good execption? - Identifiers passed to :cmd:`String Notation` must exist in the - global environment. + .. exn:: @qualid is bound to a notation that does not denote a reference. - .. exn:: @ident is bound to a notation that does not denote a reference. + Identifiers passed to :cmd:`String Notation` or :cmd:`Numeral Notation` must be global + references, or notations which evaluate to single qualified identifiers. - Identifiers passed to :cmd:`String Notation` must be global - references, or notations which denote to single identifiers. + .. todo note on "single qualified identifiers" https://github.com/coq/coq/pull/11718#discussion_r415076703 .. _TacticNotation: Tactic Notations ----------------- -Tactic notations allow to customize the syntax of tactics. They have the following syntax: +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 @num ) } {+ @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:`num` + 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`. -.. productionlist:: coq - tacn : Tactic Notation [`tactic_level`] [`prod_item` … `prod_item`] := `tactic`. - prod_item : `string` | `tactic_argument_type`(`ident`) - tactic_level : (at level `num`) - tactic_argument_type : ident | simple_intropattern | reference - : hyp | hyp_list | ne_hyp_list - : constr | uconstr | constr_list | ne_constr_list - : integer | integer_list | ne_integer_list - : int_or_var | int_or_var_list | ne_int_or_var_list - : tactic | tactic0 | tactic1 | tactic2 | tactic3 - : tactic4 | tactic5 + .. coqtop:: in -.. cmd:: Tactic Notation {? (at level @num)} {+ @prod_item} := @tactic. + Tactic Notation "destruct_with_eqn" constr(x) := destruct x eqn:?. - A tactic notation extends the parser and pretty-printer of tactics with a new - rule made of the list of production items. It then evaluates into the - tactic expression ``tactic``. For simple tactics, it is recommended to use - a terminal symbol, i.e. a string, for the first production item. The - tactic level indicates the parsing precedence of the tactic notation. - This information is particularly relevant for notations of tacticals. - Levels 0 to 5 are available (default is 5). + 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. - .. cmd:: Print Grammar tactic + The nonterminals that can specified in the tactic notation are: - To know the parsing precedences of the existing tacticals, use the command - ``Print Grammar tactic``. + .. todo uconstr represents a type with holes. At the moment uconstr doesn't + appear in the documented grammar. Maybe worth ressurecting with a better name, + maybe "open_term"? + see https://github.com/coq/coq/pull/11718#discussion_r413721234 - Each type of tactic argument has a specific semantic regarding how it - is parsed and how it is interpreted. The semantic is described in the - following table. The last command gives examples of tactics which use - the corresponding kind of argument. + .. todo 'open_constr' appears to be another possible value based on the + the message from "Tactic Notation open_constr := idtac". + Also (at least) "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 - * - Tactic argument type - - parsed as - - interpreted as + * - Specified :token:`ident` + - Parsed as + - Interpreted as - as in tactic * - ``ident`` - - identifier + - :token:`ident` - a user-given name - - intro + - :tacn:`intro` * - ``simple_intropattern`` - - simple_intropattern + - :token:`simple_intropattern` - an introduction pattern - - assert as + - :tacn:`assert` `as` * - ``hyp`` - - identifier + - :token:`ident` - a hypothesis defined in context - - clear + - :tacn:`clear` * - ``reference`` - - qualified identifier + - :token:`qualid` - a global reference of term - - unfold + - :tacn:`unfold` * - ``constr`` - - term + - :token:`term` - a term - - exact + - :tacn:`exact` * - ``uconstr`` - - term + - :token:`term` - an untyped term - - refine + - :tacn:`refine` * - ``integer`` - - integer + - :token:`int` - an integer - * - ``int_or_var`` - - identifier or integer + - :token:`int_or_var` - an integer - - do + - :tacn:`do` * - ``tactic`` - - tactic at level 5 + - :token:`ltac_expr` - a tactic - - * - ``tacticn`` - - tactic at level n - - a tactic + * - ``tactic``\ *n* (*n* in 0..5) + - :token:`ltac_expr`\ *n* + - a tactic at level *n* - * - *entry*\ ``_list`` - - list of *entry* + - :n:`{* entry }` - a list of how *entry* is interpreted - * - ``ne_``\ *entry*\ ``_list`` - - non-empty list of *entry* + - :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 @@ -1834,16 +1774,11 @@ Tactic notations allow to customize the syntax of tactics. They have the followi evaluates to integers only 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 + .. 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`` or ``int_or_var``. -.. cmdv:: Local Tactic Notation - - Tactic notations disappear when a section is closed. They survive when - a module is closed unless the command ``Local Tactic Notation`` is used instead - of :cmd:`Tactic Notation`. .. rubric:: Footnotes diff --git a/doc/sphinx/using/libraries/funind.rst b/doc/sphinx/using/libraries/funind.rst index ed00f3d455..40f9eedcf0 100644 --- a/doc/sphinx/using/libraries/funind.rst +++ b/doc/sphinx/using/libraries/funind.rst @@ -13,7 +13,7 @@ The following command is available when the ``FunInd`` library has been loaded v 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:`function induction`) and its fixpoint equality. + 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 @@ -27,7 +27,7 @@ The following command is available when the ``FunInd`` library has been loaded v to structurally recursive functions (i.e. when :n:`@fixannot` is a :n:`struct` clause). - See :tacn:`function induction` and :cmd:`Functional Scheme` for how to use + 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. @@ -166,4 +166,235 @@ terminating functions. :tacn:`functional inversion` will not be available for the function. -.. seealso:: :ref:`functional-scheme` and :tacn:`function induction` +Tactics +------- + +.. tacn:: functional induction (@qualid {+ @term}) + :name: functional induction + + The tactic functional induction performs case analysis and induction + following the definition of a function. It makes use of a principle + generated by :cmd:`Function` or :cmd:`Functional Scheme`. + Note that this tactic is only available after a ``Require Import FunInd``. + + .. 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:`(@qualid {+ @term})` must be a correct full application + of :n:`@qualid`. In particular, the rules for implicit arguments are the + same as usual. For example use :n:`@qualid` if you want to write implicit + arguments explicitly. + + .. note:: + Parentheses around :n:`@qualid {+ @term}` are not mandatory and can be skipped. + + .. note:: + :n:`functional induction (f x1 x2 x3)` is actually a wrapper for + :n:`induction x1, x2, x3, (f x1 x2 x3) using @qualid` followed by a cleaning + phase, where :n:`@qualid` is the induction principle registered for :g:`f` + (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: + + .. tacv:: functional induction (@qualid {+ @term}) as @simple_intropattern using @term with @bindings_list + + Similarly to :tacn:`induction` and :tacn:`elim`, this allows giving + explicitly the name of the introduced variables, the induction principle, and + the values of dependent premises of the elimination scheme, including + *predicates* for mutual induction when :n:`@qualid` is part of a mutually + recursive definition. + +.. tacn:: functional inversion @ident + :name: functional inversion + + :tacn:`functional inversion` is a tactic that performs inversion on hypothesis + :n:`@ident` of the form :n:`@qualid {+ @term} = @term` or :n:`@term = @qualid + {+ @term}` where :n:`@qualid` must have been defined using :cmd:`Function`. + Note that this tactic is only available after a ``Require Import FunInd``. + + .. 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. + + + .. tacv:: functional inversion @num + + This does the same thing as :n:`intros until @num` followed by + :n:`functional inversion @ident` where :token:`ident` is the + identifier for the last introduced hypothesis. + + .. tacv:: functional inversion @ident @qualid + functional inversion @num @qualid + + If the hypothesis :token:`ident` (or :token:`num`) has a type of the form + :n:`@qualid__1 {+ @term__i } = @qualid__2 {+ @term__j }` where + :n:`@qualid__1` and :n:`@qualid__2` are valid candidates to + functional inversion, this variant allows choosing which :token:`qualid` + is inverted. + +.. _functional-scheme: + +Generation of induction principles with ``Functional`` ``Scheme`` +----------------------------------------------------------------- + + +.. cmd:: Functional Scheme @ident__0 := Induction for @ident' Sort @sort {* with @ident__i := Induction for @ident__i' Sort @sort} + + This command is a high-level experimental tool for + generating automatically induction principles corresponding to + (possibly mutually recursive) functions. First, it must be made + available via ``Require Import FunInd``. + Each :n:`@ident__i` is a different mutually defined function + name (the names must be in the same order as when they were defined). This + command generates the induction principle for each :n:`@ident__i`, following + the recursive structure and case analyses of the corresponding function + :n:`@ident__i'`. + +.. 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. diff --git a/doc/sphinx/using/libraries/index.rst b/doc/sphinx/using/libraries/index.rst index ad10869439..0bd3054788 100644 --- a/doc/sphinx/using/libraries/index.rst +++ b/doc/sphinx/using/libraries/index.rst @@ -23,3 +23,4 @@ installed with the `opam package manager ../../addendum/extraction ../../addendum/miscellaneous-extensions funind + writing diff --git a/doc/sphinx/using/libraries/writing.rst b/doc/sphinx/using/libraries/writing.rst new file mode 100644 index 0000000000..325ea2af60 --- /dev/null +++ b/doc/sphinx/using/libraries/writing.rst @@ -0,0 +1,71 @@ +Writing Coq libraries and plugins +================================= + +This section presents the part of the Coq language that is useful only +to library and plugin authors. A tutorial for writing Coq plugins is +available in the Coq repository in `doc/plugin_tutorial +<https://github.com/coq/coq/tree/master/doc/plugin_tutorial>`_. + +Deprecating library objects or tactics +-------------------------------------- + +You may use the following :term:`attribute` to deprecate a notation or +tactic. When renaming a definition or theorem, you can introduce a +deprecated compatibility alias using :cmd:`Notation (abbreviation)` +(see :ref:`the example below <compatibility-alias>`). + +.. 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. + + This attribute is supported by the following commands: :cmd:`Ltac`, + :cmd:`Tactic Notation`, :cmd:`Notation`, :cmd:`Infix`. + + It can trigger the following warnings: + + .. warn:: Tactic @qualid is deprecated since @string__since. @string__note. + Tactic Notation @qualid is deprecated since @string__since. @string__note. + Notation @string 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). + +.. example:: Deprecating a tactic. + + .. coqtop:: all abort warn + + #[deprecated(since="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="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). diff --git a/doc/stdlib/Library.tex b/doc/stdlib/Library.tex index 44a0b1d361..1a9d4d738f 100644 --- a/doc/stdlib/Library.tex +++ b/doc/stdlib/Library.tex @@ -5,6 +5,7 @@ \usepackage[T1]{fontenc} \usepackage{fullpage} \usepackage{amsfonts} +\usepackage{amssymb} \usepackage{url} \usepackage[color]{../../coqdoc} diff --git a/doc/stdlib/hidden-files b/doc/stdlib/hidden-files index 65c88ed8d5..3af16cb731 100644 --- a/doc/stdlib/hidden-files +++ b/doc/stdlib/hidden-files @@ -53,6 +53,7 @@ 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/Omega.v theories/omega/OmegaLemmas.v diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index 7fa621c11c..4a62888552 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -13,6 +13,7 @@ through the <tt>Require Import</tt> command.</p> The core library (automatically loaded when starting Coq) </dt> <dd> + theories/Init/Ltac.v theories/Init/Notations.v theories/Init/Datatypes.v theories/Init/Logic.v @@ -98,6 +99,7 @@ through the <tt>Require Import</tt> command.</p> <dd> theories/Bool/Bool.v theories/Bool/BoolEq.v + theories/Bool/BoolOrder.v theories/Bool/DecBool.v theories/Bool/IfProp.v theories/Bool/Sumbool.v @@ -444,6 +446,7 @@ through the <tt>Require Import</tt> command.</p> theories/Sorting/PermutSetoid.v theories/Sorting/Mergesort.v theories/Sorting/Sorted.v + theories/Sorting/CPermutation.v </dd> <dt> <b>Wellfounded</b>: diff --git a/doc/tools/coqrst/coqdoc/main.py b/doc/tools/coqrst/coqdoc/main.py index a3fc069e6c..de0d912c03 100644 --- a/doc/tools/coqrst/coqdoc/main.py +++ b/doc/tools/coqrst/coqdoc/main.py @@ -48,28 +48,22 @@ def coqdoc(coq_code, coqdoc_bin=None): finally: os.remove(filename) -def is_whitespace_string(elem): - return isinstance(elem, NavigableString) and elem.strip() == "" - -def strip_soup(soup, pred): - """Strip elements matching pred from front and tail of soup.""" - while soup.contents and pred(soup.contents[-1]): - soup.contents.pop() - - skip = 0 - for elem in soup.contents: - if not pred(elem): - break - skip += 1 - - soup.contents[:] = soup.contents[skip:] +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_soup(root, is_whitespace_string) + # 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 diff --git a/doc/tools/coqrst/coqdomain.py b/doc/tools/coqrst/coqdomain.py index b448d0f9d3..df11960403 100644 --- a/doc/tools/coqrst/coqdomain.py +++ b/doc/tools/coqrst/coqdomain.py @@ -188,20 +188,19 @@ class CoqObject(ObjectDescription): def _add_index_entry(self, name, target): """Add `name` (pointing to `target`) to the main index.""" assert isinstance(name, str) - if not name.startswith("_"): - # 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)) + # 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)) aliases = None # additional indexed names for a command or other object def add_target_and_index(self, name, _, signode): """Attach a link target to `signode` and an index entry for `name`. This is only called (from ``ObjectDescription.run``) if ``:noindex:`` isn't specified.""" - if name: + if name and not (isinstance(name, str) and name.startswith('_')): target = self._add_target(signode, name) self._add_index_entry(name, target) if self.aliases is not None: @@ -473,8 +472,7 @@ class ProductionObject(CoqObject): op = "|" rhs = parts[1].strip() else: - nsplits = 2 - parts = signature.split(maxsplit=nsplits) + 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)) @@ -907,9 +905,13 @@ class CoqtopBlocksTransform(Transform): return isinstance(node, nodes.Element) and 'coqtop_options' in node @staticmethod - def split_sentences(source): - """Split Coq sentences in source. Could be improved.""" - return re.split(r"(?<=(?<!\.)\.)\s+", source) + def split_lines(source): + """Split Coq input in chunks + + A chunk is a minimal sequence of consecutive lines of the input that + ends with a '.' + """ + return re.split(r"(?<=(?<!\.)\.)\s+\n", source) @staticmethod def parse_options(node): @@ -988,7 +990,7 @@ class CoqtopBlocksTransform(Transform): repl.sendone('Unset Coqtop Exit On Error.') if options['warn']: repl.sendone('Set Warnings "default".') - for sentence in self.split_sentences(node.rawsource): + for sentence in self.split_lines(node.rawsource): pairs.append((sentence, repl.sendone(sentence))) if options['abort']: repl.sendone('Abort All.') @@ -1117,6 +1119,19 @@ class IndexXRefRole(XRefRole): title = index.localname return title, target +class StdGlossaryIndex(Index): + name, localname, shortname = "glossindex", "Glossary", "terms" + + def generate(self, docnames=None): + content = defaultdict(list) + + for ((type, itemname), (docname, anchor)) in self.domain.data['objects'].items(): + if type == 'term': + entries = content[itemname[0].lower()] + entries.append([itemname, 0, docname, anchor, '', '', '']) + content = sorted(content.items()) + return content, False + def GrammarProductionRole(typ, rawtext, text, lineno, inliner, options={}, content=[]): """A grammar production not included in a ``productionlist`` directive. @@ -1133,7 +1148,7 @@ def GrammarProductionRole(typ, rawtext, text, lineno, inliner, options={}, conte """ #pylint: disable=dangerous-default-value, unused-argument env = inliner.document.settings.env - targetid = 'grammar-token-{}'.format(text) + targetid = nodes.make_id('grammar-token-{}'.format(text)) target = nodes.target('', '', ids=[targetid]) inliner.document.note_explicit_target(target) code = nodes.literal(rawtext, text, role=typ.lower()) @@ -1144,6 +1159,35 @@ def GrammarProductionRole(typ, rawtext, text, lineno, inliner, options={}, conte GrammarProductionRole.role_name = "production" + +def GlossaryDefRole(typ, rawtext, text, lineno, inliner, options={}, content=[]): + """Marks the definition of a glossary term inline in the text. Matching :term:`XXX` + constructs will link to it. The term will also appear in the Glossary Index. + + Example:: + + A :gdef:`prime` number is divisible only by itself and 1. + """ + #pylint: disable=dangerous-default-value, unused-argument + env = inliner.document.settings.env + std = env.domaindata['std']['objects'] + key = ('term', text) + + if key in std: + MSG = 'Duplicate object: {}; other is at {}' + msg = MSG.format(text, env.doc2path(std[key][0])) + inliner.document.reporter.warning(msg, line=lineno) + + targetid = nodes.make_id('term-{}'.format(text)) + std[key] = (env.docname, targetid) + target = nodes.target('', '', ids=[targetid], names=[text]) + 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. @@ -1306,18 +1350,23 @@ COQ_ADDITIONAL_DIRECTIVES = [CoqtopDirective, InferenceDirective, PreambleDirective] -COQ_ADDITIONAL_ROLES = [GrammarProductionRole] +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()) - assert subdomains.issuperset(chain(*(idx.subdomains for idx in CoqDomain.indices))) - assert subdomains.issubset(CoqDomain.roles.keys()) + 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) diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg index 5034d9a3c9..c7e3ee18ad 100644 --- a/doc/tools/docgram/common.edit_mlg +++ b/doc/tools/docgram/common.edit_mlg @@ -179,7 +179,10 @@ case_item: [ ] binder_constr: [ +| MOVETO term_forall_or_fun "forall" open_binders "," operconstr200 +| MOVETO term_forall_or_fun "fun" open_binders "=>" operconstr200 | MOVETO term_let "let" name binders let_type_cstr ":=" operconstr200 "in" operconstr200 +| MOVETO term_if "if" operconstr200 as_return_type "then" operconstr200 "else" operconstr200 | MOVETO term_fix "let" "fix" fix_decl "in" operconstr200 | MOVETO term_cofix "let" "cofix" cofix_decl "in" operconstr200 | MOVETO term_let "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" operconstr200 "in" operconstr200 @@ -203,8 +206,10 @@ term_let: [ ] atomic_constr: [ -(* @Zimmi48: "string" used only for notations, but keep to be consistent with patterns *) -(* | DELETE string *) +| MOVETO qualid_annotated global univ_instance +| MOVETO primitive_notations NUMERAL +| MOVETO primitive_notations string +| MOVETO term_evar "_" | REPLACE "?" "[" ident "]" | WITH "?[" ident "]" | MOVETO term_evar "?[" ident "]" @@ -224,10 +229,18 @@ IDENT: [ | ident ] -scope: [ +scope_key: [ +| IDENT +] + +scope_name: [ | IDENT ] +scope: [ +| scope_name | scope_key +] + operconstr100: [ | MOVETO term_cast operconstr99 "<:" operconstr200 | MOVETO term_cast operconstr99 "<<:" operconstr200 @@ -235,7 +248,21 @@ operconstr100: [ | MOVETO term_cast operconstr99 ":>" ] +constr: [ +| REPLACE "@" global univ_instance +| WITH "@" qualid_annotated +| MOVETO term_explicit "@" qualid_annotated +] + operconstr10: [ +(* Separate this LIST0 in the nonempty and the empty case *) +(* The empty case is covered by constr *) +| REPLACE "@" global univ_instance LIST0 operconstr9 +| WITH "@" qualid_annotated LIST1 operconstr9 +| REPLACE operconstr9 +| WITH constr +| MOVETO term_application operconstr9 LIST1 appl_arg +| MOVETO term_application "@" qualid_annotated LIST1 operconstr9 (* fixme: add in as a prodn somewhere *) | MOVETO dangling_pattern_extension_rule "@" pattern_identref LIST1 identref | DELETE dangling_pattern_extension_rule @@ -250,7 +277,8 @@ operconstr1: [ | REPLACE operconstr0 ".(" global LIST0 appl_arg ")" | WITH operconstr0 ".(" global LIST0 appl_arg ")" (* huh? *) | REPLACE operconstr0 "%" IDENT -| WITH operconstr0 "%" scope +| WITH operconstr0 "%" scope_key +| MOVETO term_scope operconstr0 "%" scope_key | MOVETO term_projection operconstr0 ".(" global LIST0 appl_arg ")" | MOVETO term_projection operconstr0 ".(" "@" global LIST0 ( operconstr9 ) ")" ] @@ -260,6 +288,10 @@ operconstr0: [ | DELETE "{" binder_constr "}" | REPLACE "{|" record_declaration bar_cbrace | WITH "{|" LIST0 field_def bar_cbrace +| MOVETO term_record "{|" LIST0 field_def bar_cbrace +| MOVETO term_generalizing "`{" operconstr200 "}" +| MOVETO term_generalizing "`(" operconstr200 ")" +| MOVETO term_ltac "ltac" ":" "(" tactic_expr5 ")" ] fix_decls: [ @@ -376,7 +408,7 @@ pattern10: [ pattern1: [ | REPLACE pattern0 "%" IDENT -| WITH pattern0 "%" scope +| WITH pattern0 "%" scope_key ] pattern0: [ @@ -879,9 +911,14 @@ bar_cbrace: [ ] 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 *) + | INSERTALL "Print" ] @@ -906,14 +943,14 @@ command: [ | DELETE "Unset" option_table | REPLACE "Set" option_table option_setting | WITH OPT "Export" "Set" option_table (* set flag *) -| REPLACE "Test" option_table "for" LIST1 option_ref_value -| WITH "Test" option_table OPT ( "for" LIST1 option_ref_value ) +| REPLACE "Test" option_table "for" LIST1 table_value +| WITH "Test" option_table OPT ( "for" LIST1 table_value ) | DELETE "Test" option_table (* hide the fact that table names are limited to 2 IDENTs *) -| REPLACE "Add" IDENT IDENT LIST1 option_ref_value -| WITH "Add" option_table LIST1 option_ref_value -| DELETE "Add" IDENT LIST1 option_ref_value +| REPLACE "Add" IDENT IDENT LIST1 table_value +| WITH "Add" option_table 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" ident | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "as" ident | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "transitivity" "proved" "by" constr "as" ident @@ -969,9 +1006,9 @@ command: [ | DELETE "Preterm" (* hide the fact that table names are limited to 2 IDENTs *) -| REPLACE "Remove" IDENT IDENT LIST1 option_ref_value -| WITH "Remove" option_table LIST1 option_ref_value -| DELETE "Remove" IDENT LIST1 option_ref_value +| REPLACE "Remove" IDENT IDENT LIST1 table_value +| WITH "Remove" option_table LIST1 table_value +| DELETE "Remove" IDENT LIST1 table_value | DELETE "Restore" "State" IDENT | DELETE "Restore" "State" ne_string | "Restore" "State" [ IDENT | ne_string ] @@ -1012,27 +1049,60 @@ command: [ | 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 "Numeral" "Notation" reference reference reference ":" ident numnotoption +| WITH "Numeral" "Notation" reference reference reference ":" scope_name numnotoption +| REPLACE "String" "Notation" reference reference reference ":" ident +| WITH "String" "Notation" reference reference reference ":" scope_name -option_setting: [ -| OPTINREF ] -only_parsing: [ +option_setting: [ | OPTINREF ] 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 class_rawexpr +| WITH "Bind" "Scope" scope_name; "with" LIST1 class_rawexpr | REPLACE "Infix" ne_lstring ":=" constr [ "(" LIST1 syntax_modifier SEP "," ")" | ] OPT [ ":" IDENT ] -| WITH "Infix" ne_lstring ":=" constr OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" IDENT ] +| WITH "Infix" ne_lstring ":=" constr OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" scope_name ] | REPLACE "Notation" lstring ":=" constr [ "(" LIST1 syntax_modifier SEP "," ")" | ] OPT [ ":" IDENT ] -| WITH "Notation" lstring ":=" constr OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" IDENT ] +| WITH "Notation" lstring ":=" constr OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" scope_name ] | REPLACE "Reserved" "Infix" ne_lstring [ "(" LIST1 syntax_modifier SEP "," ")" | ] | WITH "Reserved" "Infix" ne_lstring OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] | REPLACE "Reserved" "Notation" ne_lstring [ "(" LIST1 syntax_modifier SEP "," ")" | ] | WITH "Reserved" "Notation" ne_lstring OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] ] +syntax_modifier: [ +| DELETE "in" "custom" IDENT +| REPLACE "in" "custom" IDENT; "at" "level" natural +| WITH "in" "custom" IDENT OPT ( "at" "level" natural ) +| REPLACE IDENT; "," LIST1 IDENT SEP "," "at" level +| WITH LIST1 IDENT SEP "," "at" level +] + +syntax_extension_type: [ +| 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 *) +] + numnotoption: [ | OPTINREF ] @@ -1086,7 +1156,7 @@ assumption_token: [ | WITH [ "Variable" | "Variables" ] ] -all_attrs: [ +attributes: [ | LIST0 ( "#[" LIST0 attribute SEP "," "]" ) LIST0 legacy_attr ] @@ -1407,12 +1477,12 @@ positive_search_mark: [ by_notation: [ | REPLACE ne_string OPT [ "%" IDENT ] -| WITH ne_string OPT [ "%" scope ] +| WITH ne_string OPT [ "%" scope_key ] ] scope_delimiter: [ | REPLACE "%" IDENT -| WITH "%" scope +| WITH "%" scope_key ] (* Don't show these details *) @@ -1422,6 +1492,23 @@ DELETE: [ | register_type_token ] + +decl_notation: [ +| REPLACE ne_lstring ":=" constr only_parsing OPT [ ":" IDENT ] +| WITH ne_lstring ":=" constr only_parsing OPT [ ":" scope_name ] +] + + +only_parsing: [ +| OPTINREF +] + +ltac_production_item: [ +| REPLACE ident "(" ident OPT ltac_production_sep ")" +| WITH ident OPT ( "(" ident OPT ltac_production_sep ")" ) +| DELETE ident +] + SPLICE: [ | noedit_mode | bigint @@ -1550,7 +1637,7 @@ SPLICE: [ | constructor_type | record_binder | at_level_opt -| option_ref_value +| table_value | positive_search_mark | in_or_out_modules | option_setting @@ -1588,6 +1675,7 @@ SPLICE: [ | searchabout_queries | locatable | scope_delimiter +| bignat | one_import_filter_name ] (* end SPLICE *) @@ -1632,7 +1720,6 @@ RENAME: [ | univ_instance univ_annot | simple_assum_coe assumpt | of_type_with_opt_coercion of_type -| attribute attr | attribute_value attr_value | constructor_list_or_record_decl constructors_or_record | record_binder_body field_body @@ -1640,6 +1727,12 @@ RENAME: [ | smart_global smart_qualid | searchabout_query search_item | option_table setting_name +| argument_spec_block arg_specs +| more_implicits_block implicits_alt +| arguments_modifier args_modifier +| constr_as_binder_kind binder_interp +| syntax_extension_type explicit_subentry +| numnotoption numeral_modifier ] (* todo: positive_search_mark is a lousy name for OPT "-" *) @@ -1737,12 +1830,12 @@ control_command: [ ] query_command: [ ] (* re-add since previously spliced *) sentence: [ -| OPT all_attrs command "." -| OPT all_attrs OPT ( num ":" ) query_command "." -| OPT all_attrs OPT toplevel_selector ltac_expr [ "." | "..." ] +| OPT attributes command "." +| OPT attributes OPT ( num ":" ) query_command "." +| OPT attributes OPT toplevel_selector ltac_expr [ "." | "..." ] | control_command ] -vernacular: [ +document: [ | LIST0 sentence ] diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml index f00fda0e8c..6d4c33f7be 100644 --- a/doc/tools/docgram/doc_grammar.ml +++ b/doc/tools/docgram/doc_grammar.ml @@ -50,7 +50,7 @@ let default_args = { verify = false; } -let start_symbols = ["vernacular"] +let start_symbols = ["document"] let tokens = [ "bullet"; "string"; "unicode_id_part"; "unicode_letter" ] (* translated symbols *) @@ -1771,11 +1771,13 @@ let process_rst g file args seen tac_prods cmd_prods = "doc/sphinx/language/core/records.rst"; "doc/sphinx/language/core/sections.rst"; "doc/sphinx/language/extensions/implicit-arguments.rst"; + "doc/sphinx/language/extensions/arguments-command.rst"; "doc/sphinx/language/using/libraries/funind.rst"; "doc/sphinx/language/gallina-specification-language.rst"; "doc/sphinx/language/gallina-extensions.rst"; - "doc/sphinx/proof-engine/vernacular-commands.rst" + "doc/sphinx/proof-engine/vernacular-commands.rst"; + "doc/sphinx/user-extensions/syntax-extensions.rst" ] in diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar index 04c20a7203..4274dccb40 100644 --- a/doc/tools/docgram/fullGrammar +++ b/doc/tools/docgram/fullGrammar @@ -524,12 +524,12 @@ command: [ | "Set" option_table option_setting | "Unset" option_table | "Print" "Table" option_table -| "Add" IDENT IDENT LIST1 option_ref_value -| "Add" IDENT LIST1 option_ref_value -| "Test" option_table "for" LIST1 option_ref_value +| "Add" IDENT IDENT LIST1 table_value +| "Add" IDENT LIST1 table_value +| "Test" option_table "for" LIST1 table_value | "Test" option_table -| "Remove" IDENT IDENT LIST1 option_ref_value -| "Remove" IDENT LIST1 option_ref_value +| "Remove" IDENT IDENT LIST1 table_value +| "Remove" IDENT LIST1 table_value | "Write" "State" IDENT | "Write" "State" ne_string | "Restore" "State" IDENT @@ -1318,7 +1318,7 @@ option_setting: [ | STRING ] -option_ref_value: [ +table_value: [ | global | STRING ] diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar index e71c80f829..df4e5a22e3 100644 --- a/doc/tools/docgram/orderedGrammar +++ b/doc/tools/docgram/orderedGrammar @@ -15,10 +15,9 @@ ltac_use_default: [ ] term: [ -| "forall" open_binders "," term -| "fun" open_binders "=>" term +| term_forall_or_fun | term_let -| "if" term OPT [ OPT [ "as" name ] "return" term100 ] "then" term "else" term +| term_if | term_fix | term_cofix | term100 @@ -30,44 +29,39 @@ term100: [ ] term10: [ -| term1 LIST1 arg -| "@" qualid OPT univ_annot LIST0 term1 -| term1 -] - -arg: [ -| "(" ident ":=" term ")" -| term1 +| term_application +| one_term ] one_term: [ +| term_explicit | term1 -| "@" qualid OPT univ_annot ] term1: [ | term_projection -| term0 "%" scope +| term_scope | term0 ] term0: [ -| qualid OPT univ_annot +| qualid_annotated | sort -| numeral -| string -| "_" +| primitive_notations | term_evar | term_match +| term_record +| term_generalizing +| term_ltac | "(" term ")" -| "{|" LIST0 field_def "|}" -| "`{" term "}" -| "`(" term ")" -| "ltac" ":" "(" ltac_expr ")" ] -field_def: [ -| qualid LIST0 binder ":=" term +qualid_annotated: [ +| qualid OPT univ_annot +] + +term_ltac: [ +| "ltac" ":" "(" ltac_expr ")" ] term_projection: [ @@ -75,7 +69,12 @@ term_projection: [ | term0 ".(" "@" qualid LIST0 ( term1 ) ")" ] +term_scope: [ +| term0 "%" scope_key +] + term_evar: [ +| "_" | "?[" ident "]" | "?[" "?" ident "]" | "?" ident OPT ( "@{" LIST1 ( ident ":=" term ) SEP ";" "}" ) @@ -85,6 +84,25 @@ dangling_pattern_extension_rule: [ | "@" "?" ident LIST1 ident ] +term_application: [ +| term1 LIST1 arg +| "@" qualid_annotated LIST1 term1 +] + +arg: [ +| "(" ident ":=" term ")" +| term1 +] + +term_explicit: [ +| "@" qualid_annotated +] + +primitive_notations: [ +| numeral +| string +] + assumption_token: [ | [ "Axiom" | "Axioms" ] | [ "Conjecture" | "Conjectures" ] @@ -158,14 +176,14 @@ where: [ | "before" ident ] -vernacular: [ +document: [ | LIST0 sentence ] sentence: [ -| OPT all_attrs command "." -| OPT all_attrs OPT ( num ":" ) query_command "." -| OPT all_attrs OPT toplevel_selector ltac_expr [ "." | "..." ] +| OPT attributes command "." +| OPT attributes OPT ( num ":" ) query_command "." +| OPT attributes OPT toplevel_selector ltac_expr [ "." | "..." ] | control_command ] @@ -178,17 +196,17 @@ query_command: [ tacticals: [ ] -all_attrs: [ -| LIST0 ( "#[" LIST0 attr SEP "," "]" ) LIST0 legacy_attr +attributes: [ +| LIST0 ( "#[" LIST0 attribute SEP "," "]" ) LIST0 legacy_attr ] -attr: [ +attribute: [ | ident OPT attr_value ] attr_value: [ | "=" string -| "(" LIST0 attr SEP "," ")" +| "(" LIST0 attribute SEP "," ")" ] legacy_attr: [ @@ -267,6 +285,10 @@ 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 @@ -275,6 +297,11 @@ term_let: [ | "let" "'" pattern "in" pattern ":=" term "return" term100 "in" term ] +term_forall_or_fun: [ +| "forall" open_binders "," term +| "fun" open_binders "=>" term +] + open_binders: [ | LIST1 name ":" term | LIST1 binder @@ -312,6 +339,11 @@ typeclass_constraint: [ | name ":" OPT "!" term ] +term_generalizing: [ +| "`{" term "}" +| "`(" term ")" +] + term_cast: [ | term10 "<:" term | term10 "<<:" term @@ -343,7 +375,7 @@ pattern10: [ ] pattern1: [ -| pattern0 "%" scope +| pattern0 "%" scope_key | pattern0 ] @@ -372,14 +404,6 @@ fix_definition: [ | ident_decl LIST0 binder OPT fixannot OPT ( ":" type ) OPT [ ":=" term ] OPT decl_notations ] -decl_notations: [ -| "where" decl_notation LIST0 ( "and" decl_notation ) -] - -decl_notation: [ -| string ":=" one_term OPT ( "(" "only" "parsing" ")" ) OPT [ ":" ident ] -] - thm_token: [ | "Theorem" | "Lemma" @@ -475,7 +499,7 @@ record_definition: [ ] record_field: [ -| LIST0 ( "#[" LIST0 attr SEP "," "]" ) name OPT field_body OPT [ "|" num ] OPT decl_notations +| LIST0 ( "#[" LIST0 attribute SEP "," "]" ) name OPT field_body OPT [ "|" num ] OPT decl_notations ] field_body: [ @@ -484,6 +508,14 @@ field_body: [ | LIST0 binder ":=" term ] +term_record: [ +| "{|" LIST0 field_def "|}" +] + +field_def: [ +| qualid LIST0 binder ":=" term +] + inductive_definition: [ | OPT ">" ident_decl LIST0 binder OPT [ "|" LIST0 binder ] OPT [ ":" type ] OPT ( ":=" OPT constructors_or_record ) OPT decl_notations ] @@ -571,43 +603,52 @@ smart_qualid: [ ] by_notation: [ -| string OPT [ "%" scope ] +| string OPT [ "%" scope_key ] ] -argument_spec_block: [ +argument_spec: [ +| OPT "!" name OPT ( "%" scope_key ) +] + +arg_specs: [ | argument_spec | "/" | "&" -| "(" LIST1 argument_spec ")" OPT ( "%" scope ) -| "[" LIST1 argument_spec "]" OPT ( "%" scope ) -| "{" LIST1 argument_spec "}" OPT ( "%" scope ) -] - -argument_spec: [ -| OPT "!" name OPT ( "%" scope ) +| "(" LIST1 argument_spec ")" OPT ( "%" scope_key ) +| "[" LIST1 argument_spec "]" OPT ( "%" scope_key ) +| "{" LIST1 argument_spec "}" OPT ( "%" scope_key ) ] -more_implicits_block: [ +implicits_alt: [ | name | "[" LIST1 name "]" | "{" LIST1 name "}" ] -arguments_modifier: [ +args_modifier: [ | "simpl" "nomatch" | "simpl" "never" | "default" "implicits" -| "clear" "bidirectionality" "hint" | "clear" "implicits" | "clear" "scopes" -| "clear" "scopes" "and" "implicits" -| "clear" "implicits" "and" "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 ] @@ -629,7 +670,6 @@ simple_reserv: [ command: [ | "Goal" term -| "Declare" "Scope" ident | "Pwd" | "Cd" OPT string | "Load" OPT "Verbose" [ string | ident ] @@ -669,8 +709,8 @@ command: [ | "Print" "Hint" "*" | "Print" "HintDb" ident | "Print" "Scopes" -| "Print" "Scope" ident -| "Print" "Visibility" OPT ident +| "Print" "Scope" scope_name +| "Print" "Visibility" OPT scope_name | "Print" "Implicit" smart_qualid | "Print" OPT "Sorted" "Universes" OPT ( "Subgraph" "(" LIST0 qualid ")" ) OPT string | "Print" "Assumptions" smart_qualid @@ -728,6 +768,7 @@ command: [ | "Hint" hint OPT ( ":" LIST1 ident ) | "Comments" LIST0 comment | "Declare" "Instance" ident_decl LIST0 binder ":" term OPT hint_info +| "Declare" "Scope" scope_name | "Obligation" int OPT ( "of" ident ) OPT ( ":" term OPT ( "with" ltac_expr ) ) | "Next" "Obligation" OPT ( "of" ident ) OPT ( "with" ltac_expr ) | "Solve" "Obligation" int OPT ( "of" ident ) "with" ltac_expr @@ -821,8 +862,8 @@ command: [ | "Print" "Rings" (* setoid_ring plugin *) | "Add" "Field" ident ":" one_term OPT ( "(" LIST1 field_mod SEP "," ")" ) (* setoid_ring plugin *) | "Print" "Fields" (* setoid_ring plugin *) -| "Numeral" "Notation" qualid qualid qualid ":" ident OPT numnotoption -| "String" "Notation" qualid qualid qualid ":" ident +| "Numeral" "Notation" qualid qualid qualid ":" scope_name OPT numeral_modifier +| "String" "Notation" qualid qualid qualid ":" 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 ( "(" num ")" ) ) [ LIST1 ( "(" assumpt ")" ) | assumpt ] @@ -871,19 +912,19 @@ command: [ | "Existing" "Instance" qualid OPT hint_info | "Existing" "Instances" LIST1 qualid OPT [ "|" num ] | "Existing" "Class" qualid -| "Arguments" smart_qualid LIST0 argument_spec_block LIST0 [ "," LIST0 more_implicits_block ] OPT [ ":" LIST1 arguments_modifier SEP "," ] +| "Arguments" smart_qualid 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 [ int | string ] | "Unset" setting_name -| "Open" "Scope" ident -| "Close" "Scope" ident -| "Delimit" "Scope" ident "with" ident -| "Undelimit" "Scope" ident -| "Bind" "Scope" ident "with" LIST1 class -| "Infix" string ":=" one_term OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" ident ] +| "Open" "Scope" scope +| "Close" "Scope" scope +| "Delimit" "Scope" scope_name "with" scope_key +| "Undelimit" "Scope" scope_name +| "Bind" "Scope" scope_name "with" LIST1 class +| "Infix" string ":=" one_term OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" scope_name ] | "Notation" ident LIST0 ident ":=" one_term OPT ( "(" "only" "parsing" ")" ) -| "Notation" string ":=" one_term OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" ident ] +| "Notation" string ":=" one_term OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] OPT [ ":" scope_name ] | "Format" "Notation" string string string | "Reserved" "Infix" string OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] | "Reserved" "Notation" string OPT [ "(" LIST1 syntax_modifier SEP "," ")" ] @@ -940,10 +981,6 @@ dirpath: [ | LIST0 ( ident "." ) ident ] -bignat: [ -| numeral -] - setting_name: [ | LIST1 ident ] @@ -956,7 +993,7 @@ comment: [ search_item: [ | one_term -| string OPT ( "%" scope ) +| string OPT ( "%" scope_key ) ] univ_name_list: [ @@ -987,13 +1024,7 @@ tacdef_body: [ ltac_production_item: [ | string -| ident "(" ident OPT ( "," string ) ")" -| ident -] - -numnotoption: [ -| "(" "warning" "after" bignat ")" -| "(" "abstract" "after" bignat ")" +| ident OPT ( "(" ident OPT ( "," string ) ")" ) ] int_or_id: [ @@ -1033,6 +1064,11 @@ field_mod: [ | "completeness" one_term (* setoid_ring plugin *) ] +numeral_modifier: [ +| "(" "warning" "after" numeral ")" +| "(" "abstract" "after" numeral ")" +] + hints_path: [ | "(" hints_path ")" | hints_path "*" @@ -1050,46 +1086,50 @@ class: [ | smart_qualid ] -level: [ -| "level" num -| "next" "level" -] - syntax_modifier: [ | "at" "level" num -| "in" "custom" ident -| "in" "custom" ident "at" "level" num +| "in" "custom" ident OPT ( "at" "level" num ) +| LIST1 ident SEP "," "at" level +| ident "at" level OPT binder_interp +| ident explicit_subentry +| ident binder_interp | "left" "associativity" | "right" "associativity" | "no" "associativity" -| "only" "printing" | "only" "parsing" +| "only" "printing" | "format" string OPT string -| ident "," LIST1 ident SEP "," "at" level -| ident "at" level OPT constr_as_binder_kind -| ident constr_as_binder_kind -| ident syntax_extension_type ] -constr_as_binder_kind: [ -| "as" "ident" -| "as" "pattern" -| "as" "strict" "pattern" -] - -syntax_extension_type: [ +explicit_subentry: [ | "ident" | "global" | "bigint" +| "strict" "pattern" OPT ( "at" "level" num ) | "binder" -| "constr" -| "constr" OPT ( "at" level ) OPT constr_as_binder_kind -| "pattern" -| "pattern" "at" "level" num -| "strict" "pattern" -| "strict" "pattern" "at" "level" num | "closed" "binder" -| "custom" ident OPT ( "at" level ) OPT constr_as_binder_kind +| "constr" OPT ( "at" level ) OPT binder_interp +| "custom" ident OPT ( "at" level ) OPT binder_interp +| "pattern" OPT ( "at" "level" num ) +] + +binder_interp: [ +| "as" "ident" +| "as" "pattern" +| "as" "strict" "pattern" +] + +level: [ +| "level" num +| "next" "level" +] + +decl_notations: [ +| "where" decl_notation LIST0 ( "and" decl_notation ) +] + +decl_notation: [ +| string ":=" one_term OPT ( "(" "only" "parsing" ")" ) OPT [ ":" scope_name ] ] simple_tactic: [ diff --git a/engine/eConstr.ml b/engine/eConstr.ml index 4508633858..ca681e58f8 100644 --- a/engine/eConstr.ml +++ b/engine/eConstr.ml @@ -355,7 +355,7 @@ let iter_with_full_binders sigma g f 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) -> Array.Fun1.iter f n l + | Evar (_,l) -> List.iter (fun c -> f n c) l | Case (_,p,c,bl) -> f n p; f n c; Array.Fun1.iter f n bl | Proj (p,c) -> f n c | Fix (_,(lna,tl,bl)) -> @@ -717,7 +717,7 @@ let val_of_named_context e = val_of_named_context (cast_named_context unsafe_eq let named_context_of_val e = cast_named_context (sym unsafe_eq) (named_context_of_val e) let of_existential : Constr.existential -> existential = - let gen : type a b. (a,b) eq -> 'c * b array -> 'c * a array = fun Refl x -> x in + let gen : type a b. (a,b) eq -> 'c * b list -> 'c * a list = fun Refl x -> x in gen unsafe_eq let lookup_rel i e = cast_rel_decl (sym unsafe_eq) (lookup_rel i e) diff --git a/engine/evarutil.ml b/engine/evarutil.ml index fdcdfe11f4..5fcadfcef7 100644 --- a/engine/evarutil.ml +++ b/engine/evarutil.ml @@ -200,7 +200,7 @@ let make_pure_subst evi args = match args with | a::rest -> (rest, (NamedDecl.get_id decl, a)::l) | _ -> anomaly (Pp.str "Instance does not match its signature.")) - (evar_filtered_context evi) (Array.rev_to_list args,[])) + (evar_filtered_context evi) (List.rev args,[])) (*------------------------------------* * functional operations on evar sets * @@ -448,7 +448,7 @@ let new_evar_instance ?src ?filter ?abstract_arguments ?candidates ?naming ?type assert (not !Flags.debug || List.distinct (ids_of_named_context (named_context_of_val sign))); let (evd, newevk) = new_pure_evar sign evd ?src ?filter ?abstract_arguments ?candidates ?naming ?typeclass_candidate ?principal typ in - evd, mkEvar (newevk,Array.of_list instance) + evd, mkEvar (newevk, instance) let new_evar_from_context ?src ?filter ?candidates ?naming ?typeclass_candidate ?principal sign evd typ = let instance = List.map (NamedDecl.get_id %> EConstr.mkVar) (named_context_of_val sign) in @@ -506,7 +506,7 @@ let generalize_evar_over_rels sigma (ev,args) = List.fold_left2 (fun (c,inst as x) a d -> if isRel sigma a then (mkNamedProd_or_LetIn d c,a::inst) else x) - (evi.evar_concl,[]) (Array.to_list args) sign + (evi.evar_concl,[]) args sign (************************************) (* Removing a dependency in an evar *) @@ -594,7 +594,7 @@ let rec check_and_clear_in_constr env evdref err ids global c = (* 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)) - ctxt (Array.to_list l) (Id.Map.empty,[]) in + ctxt l (Id.Map.empty,[]) 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 = @@ -736,7 +736,7 @@ let undefined_evars_of_term evd t = match EConstr.kind evd c with | Evar (n, l) -> let acc = Evar.Set.add n acc in - Array.fold_left evrec acc l + List.fold_left evrec acc l | _ -> EConstr.fold evd evrec acc c in evrec Evar.Set.empty t diff --git a/engine/evarutil.mli b/engine/evarutil.mli index 1dec63aaf0..b5c7ccb283 100644 --- a/engine/evarutil.mli +++ b/engine/evarutil.mli @@ -88,7 +88,7 @@ val new_evar_instance : named_context_val -> evar_map -> types -> constr list -> evar_map * constr -val make_pure_subst : evar_info -> 'a array -> (Id.t * 'a) list +val make_pure_subst : evar_info -> 'a list -> (Id.t * 'a) list val safe_evar_value : evar_map -> Constr.existential -> Constr.constr option diff --git a/engine/evd.ml b/engine/evd.ml index 65fe261ff4..5642145f6d 100644 --- a/engine/evd.ml +++ b/engine/evd.ml @@ -233,32 +233,27 @@ exception NotInstantiatedEvar (* Note: let-in contributes to the instance *) let evar_instance_array test_id info args = - let len = Array.length args in - let rec instrec filter ctxt i = match filter, ctxt with - | [], [] -> - if Int.equal i len then [] - else instance_mismatch () - | false :: filter, _ :: ctxt -> - instrec filter ctxt i - | true :: filter, d :: ctxt -> - if i < len then - let c = Array.unsafe_get args i in - if test_id d c then instrec filter ctxt (succ i) - else (NamedDecl.get_id d, c) :: instrec filter ctxt (succ i) - else instance_mismatch () + let rec instrec filter ctxt args = match filter, ctxt, args with + | [], [], [] -> [] + | false :: filter, _ :: ctxt, args -> + instrec filter ctxt args + | true :: filter, d :: ctxt, c :: args -> + if test_id d c then instrec filter ctxt args + else (NamedDecl.get_id d, c) :: instrec filter ctxt args | _ -> instance_mismatch () in match Filter.repr (evar_filter info) with | None -> - let map i d = - if (i < len) then - let c = Array.unsafe_get args i in - if test_id d c then None else Some (NamedDecl.get_id d, c) - else instance_mismatch () + let rec instance ctxt args = match ctxt, args with + | [], [] -> [] + | d :: ctxt, c :: args -> + if test_id d c then instance ctxt args + else (NamedDecl.get_id d, c) :: instance ctxt args + | _ -> instance_mismatch () in - List.map_filter_i map (evar_context info) + instance (evar_context info) args | Some filter -> - instrec filter (evar_context info) 0 + instrec filter (evar_context info) args let make_evar_instance_array info args = evar_instance_array (NamedDecl.get_id %> isVarId) info args @@ -794,7 +789,7 @@ let restrict evk filter ?candidates ?src evd = | _ -> Evar.Set.add evk evd.last_mods in let evar_names = EvNames.reassign_name_defined evk evk' evd.evar_names in let ctxt = Filter.filter_list filter (evar_context evar_info) in - let id_inst = Array.map_of_list (NamedDecl.get_id %> mkVar) ctxt in + let id_inst = List.map (NamedDecl.get_id %> mkVar) ctxt 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 = declare_restricted_evar evd.evar_flags evk evk' in @@ -1405,7 +1400,7 @@ 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 (Array.fold_left evrec acc l) + | Evar (n, l) -> Evar.Set.add n (List.fold_left evrec acc l) | _ -> Constr.fold evrec acc c in evrec Evar.Set.empty c @@ -1413,7 +1408,7 @@ let evars_of_term evd c = let evar_nodes_of_term c = let rec evrec acc c = match kind c with - | Evar (n, l) -> Evar.Set.add n (Array.fold_left evrec acc l) + | Evar (n, l) -> Evar.Set.add n (List.fold_left evrec acc l) | _ -> Constr.fold evrec acc c in evrec Evar.Set.empty c diff --git a/engine/evd.mli b/engine/evd.mli index bbdb63a467..c6c4a71b22 100644 --- a/engine/evd.mli +++ b/engine/evd.mli @@ -247,9 +247,9 @@ val existential_opt_value : evar_map -> econstr pexistential -> econstr option val existential_opt_value0 : evar_map -> existential -> constr option val evar_instance_array : (Constr.named_declaration -> 'a -> bool) -> evar_info -> - 'a array -> (Id.t * 'a) list + 'a list -> (Id.t * 'a) list -val instantiate_evar_array : evar_info -> econstr -> econstr array -> econstr +val instantiate_evar_array : evar_info -> econstr -> econstr list -> econstr val evars_reset_evd : ?with_conv_pbs:bool -> ?with_univs:bool -> evar_map -> evar_map -> evar_map diff --git a/engine/termops.ml b/engine/termops.ml index 16f2a87c1e..6d779e6a35 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -636,8 +636,8 @@ let map_constr_with_binders_left_to_right sigma g f l c = if b' == b then c else mkProj (p, b') | Evar (e,al) -> - let al' = Array.map_left (f l) al in - if Array.for_all2 (==) al' al then c + let al' = List.map_left (f l) al in + if List.for_all2 (==) al' al then c else mkEvar (e, al') | Case (ci,p,b,bl) -> (* In v8 concrete syntax, predicate is after the term to match! *) @@ -707,8 +707,8 @@ let map_constr_with_full_binders_gen userview sigma g f l cstr = let c' = f l c in if c' == c then cstr else mkProj (p, c') | Evar (e,al) -> - let al' = Array.map (f l) al in - if Array.for_all2 (==) al al' then cstr else mkEvar (e, al') + let al' = List.map (f l) al in + if List.for_all2 (==) al al' then cstr else mkEvar (e, al') | Case (ci,p,c,bl) when userview -> let p' = map_return_predicate_with_full_binders sigma g f l ci p in let c' = f l c in diff --git a/engine/uState.ml b/engine/uState.ml index ff85f09efa..00649ce042 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -39,7 +39,7 @@ type t = uctx_weak_constraints : UPairSet.t } -let initial_sprop_cumulative = UGraph.make_sprop_cumulative UGraph.initial_universes +let initial_sprop_cumulative = UGraph.set_cumulative_sprop true UGraph.initial_universes let empty = { uctx_names = UNameMap.empty, LMap.empty; @@ -57,11 +57,11 @@ let elaboration_sprop_cumul = ~key:["Elaboration";"StrictProp";"Cumulativity"] ~value:true let make ~lbound u = - let u = if elaboration_sprop_cumul () then UGraph.make_sprop_cumulative u else u in - { empty with - uctx_universes = u; - uctx_universes_lbound = lbound; - uctx_initial_universes = u} + let u = UGraph.set_cumulative_sprop (elaboration_sprop_cumul ()) u in + { empty with + uctx_universes = u; + uctx_universes_lbound = lbound; + uctx_initial_universes = u} let is_empty ctx = ContextSet.is_empty ctx.uctx_local && @@ -527,6 +527,14 @@ let demote_seff_univs univs uctx = let seff = LSet.union uctx.uctx_seff_univs univs in { uctx with uctx_seff_univs = seff } +let demote_global_univs env uctx = + let env_ugraph = Environ.universes env in + let global_univs = UGraph.domain env_ugraph in + let global_constraints, _ = UGraph.constraints_of_universes env_ugraph in + let promoted_uctx = + ContextSet.(of_set global_univs |> add_constraints global_constraints) in + { uctx with uctx_local = ContextSet.diff uctx.uctx_local promoted_uctx } + let merge_seff uctx ctx' = let levels = ContextSet.levels ctx' in let declare g = @@ -547,10 +555,11 @@ let emit_side_effects eff u = merge_seff u uctx let update_sigma_env uctx env = - let univs = UGraph.make_sprop_cumulative (Environ.universes env) in + let univs = UGraph.set_cumulative_sprop (elaboration_sprop_cumul()) (Environ.universes env) in let eunivs = - { uctx with uctx_initial_universes = univs; - uctx_universes = univs } + { uctx with + uctx_initial_universes = univs; + uctx_universes = univs } in merge_seff eunivs eunivs.uctx_local diff --git a/engine/uState.mli b/engine/uState.mli index cd1c9a174e..6707826aae 100644 --- a/engine/uState.mli +++ b/engine/uState.mli @@ -110,6 +110,11 @@ val merge : ?loc:Loc.t -> sideff:bool -> rigid -> t -> Univ.ContextSet.t -> t val merge_subst : t -> UnivSubst.universe_opt_subst -> t val emit_side_effects : Safe_typing.private_constants -> t -> t +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.LSet.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 diff --git a/engine/univSubst.ml b/engine/univSubst.ml index 6000650ad9..a691239ee2 100644 --- a/engine/univSubst.ml +++ b/engine/univSubst.ml @@ -131,7 +131,7 @@ let nf_evars_and_universes_opt_subst f subst = let rec aux c = match kind c with | Evar (evk, args) -> - let args = Array.map aux args in + let args = List.map aux args in (match try f (evk, args) with Not_found -> None with | None -> mkEvar (evk, args) | Some c -> aux c) diff --git a/ide/coqide.ml b/ide/coqide.ml index 3b36875e3a..ab2a17798e 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -1293,7 +1293,10 @@ let build_ui () = (* Initializing hooks *) let refresh_style style = let style = style_manager#style_scheme style in - let iter_session v = v.script#source_buffer#set_style_scheme style in + let iter_session v = + v.script#source_buffer#set_style_scheme style; + v.proof#source_buffer#set_style_scheme style; + v.messages#default_route#source_buffer#set_style_scheme style in List.iter iter_session notebook#pages in let refresh_language lang = diff --git a/ide/coqide_WIN32.ml.in b/ide/coqide_WIN32.ml.in index 2d3964f210..be8aab9e49 100644 --- a/ide/coqide_WIN32.ml.in +++ b/ide/coqide_WIN32.ml.in @@ -44,6 +44,7 @@ let () = Coq.gio_channel_of_descr_socket := Glib.Io.channel_of_descr_socket; set_win32_path (); Coq.interrupter := win32_interrupt; - reroute_stdout_stderr () + reroute_stdout_stderr (); + try ignore (Unix.getenv "GTK_CSD") with Not_found -> Unix.putenv "GTK_CSD" "0" let init () = () diff --git a/ide/session.ml b/ide/session.ml index b16af9c317..09391b7f50 100644 --- a/ide/session.ml +++ b/ide/session.ml @@ -151,7 +151,7 @@ let set_buffer_handlers else if it#has_tag Tags.Script.processed then Some old else if it#has_tag Tags.Script.error_bg then aux it it#backward_char else None in - aux it it in + aux it it#copy in let insert_cb it s = if String.length s = 0 then () else begin Minilib.log ("insert_cb " ^ string_of_int it#offset); let text_mark = add_mark it in diff --git a/ide/wg_Completion.ml b/ide/wg_Completion.ml index dcb71d96a1..cc24e71386 100644 --- a/ide/wg_Completion.ml +++ b/ide/wg_Completion.ml @@ -69,7 +69,7 @@ let is_substring s1 s2 = if !break then len2 - len1 else -1 -class completion_provider coqtop = +class completion_provider buffer coqtop = let self_provider = ref None in let active = ref true in let provider = object (self) @@ -97,9 +97,13 @@ class completion_provider coqtop = ctx#add_proposals (Option.get !self_provider) props true method populate ctx = - let iter = ctx#iter in + let iter = buffer#get_iter_at_mark `INSERT in + let () = insert_offset <- iter#offset in + let () = Minilib.log (Printf.sprintf "Completion at offset: %i" insert_offset) in let buffer = new GText.buffer iter#buffer in + if not (Gtk_parsing.ends_word iter#backward_char) then self#add_proposals ctx Proposals.empty else let start = Gtk_parsing.find_word_start iter in + if iter#offset - start#offset < auto_complete_length then self#add_proposals ctx Proposals.empty else let w = start#get_text ~stop:iter in let () = Minilib.log ("Completion of prefix: '" ^ w ^ "'") in let (off, prefix, props) = cache in @@ -127,17 +131,7 @@ class completion_provider coqtop = let occupied () = update synt in Coq.try_grab coqtop query occupied - method matched ctx = - if !active then - let iter = ctx#iter in - let () = insert_offset <- iter#offset in - let log = Printf.sprintf "Completion at offset: %i" insert_offset in - let () = Minilib.log log in - if Gtk_parsing.ends_word iter#backward_char then - let start = Gtk_parsing.find_word_start iter in - iter#offset - start#offset >= auto_complete_length - else false - else false + method matched ctx = !active method activation = [`INTERACTIVE; `USER_REQUESTED] diff --git a/ide/wg_Completion.mli b/ide/wg_Completion.mli index 93c4cbb602..8bb34fbbca 100644 --- a/ide/wg_Completion.mli +++ b/ide/wg_Completion.mli @@ -10,7 +10,7 @@ module Proposals : sig type t end -class completion_provider : Coq.coqtop -> +class completion_provider : GText.buffer -> Coq.coqtop -> object inherit GSourceView3.source_completion_provider method active : bool diff --git a/ide/wg_MessageView.ml b/ide/wg_MessageView.ml index b99e5f8069..6e22172d05 100644 --- a/ide/wg_MessageView.ml +++ b/ide/wg_MessageView.ml @@ -28,6 +28,7 @@ end class type message_view = object inherit GObj.widget + method source_buffer : GSourceView3.source_buffer method connect : message_view_signals method clear : unit method add : Pp.t -> unit @@ -44,7 +45,8 @@ class type message_view = let message_view () : message_view = let buffer = GSourceView3.source_buffer ~highlight_matching_brackets:true - ~tag_table:Tags.Message.table () + ~tag_table:Tags.Message.table + ?style_scheme:(style_manager#style_scheme source_style#get) () in let mark = buffer#create_mark ~left_gravity:false buffer#start_iter in let box = GPack.vbox () in @@ -88,6 +90,8 @@ let message_view () : message_view = val push = new GUtil.signal () + method source_buffer = buffer + method connect = new message_view_signals_impl box#as_widget push diff --git a/ide/wg_MessageView.mli b/ide/wg_MessageView.mli index 21c11b2754..054dd0e571 100644 --- a/ide/wg_MessageView.mli +++ b/ide/wg_MessageView.mli @@ -18,6 +18,7 @@ end class type message_view = object inherit GObj.widget + method source_buffer : GSourceView3.source_buffer method connect : message_view_signals method clear : unit method add : Pp.t -> unit diff --git a/ide/wg_ProofView.ml b/ide/wg_ProofView.ml index 3e03ef11f7..1de63953af 100644 --- a/ide/wg_ProofView.ml +++ b/ide/wg_ProofView.ml @@ -15,6 +15,7 @@ open Ideutils class type proof_view = object inherit GObj.widget + method source_buffer : GSourceView3.source_buffer method buffer : GText.buffer method refresh : force:bool -> unit method clear : unit -> unit @@ -195,7 +196,8 @@ let display mode (view : #GText.view_skel) goals hints evars = let proof_view () = let buffer = GSourceView3.source_buffer ~highlight_matching_brackets:true - ~tag_table:Tags.Proof.table () + ~tag_table:Tags.Proof.table + ?style_scheme:(style_manager#style_scheme source_style#get) () in let text_buffer = new GText.buffer buffer#as_buffer in let view = GSourceView3.source_view @@ -217,6 +219,8 @@ let proof_view () = val mutable evars = None val mutable last_width = -1 + method source_buffer = buffer + method buffer = text_buffer method clear () = buffer#set_text "" diff --git a/ide/wg_ProofView.mli b/ide/wg_ProofView.mli index db6fb9e9cd..8217f72066 100644 --- a/ide/wg_ProofView.mli +++ b/ide/wg_ProofView.mli @@ -11,6 +11,7 @@ class type proof_view = object inherit GObj.widget + method source_buffer : GSourceView3.source_buffer method buffer : GText.buffer method refresh : force:bool -> unit method clear : unit -> unit diff --git a/ide/wg_ScriptView.ml b/ide/wg_ScriptView.ml index f2d9f33d7d..62d58a5f23 100644 --- a/ide/wg_ScriptView.ml +++ b/ide/wg_ScriptView.ml @@ -287,7 +287,7 @@ end class script_view (tv : source_view) (ct : Coq.coqtop) = let view = new GSourceView3.source_view (Gobject.unsafe_cast tv) in -let provider = new Wg_Completion.completion_provider ct in +let provider = new Wg_Completion.completion_provider view#buffer ct in object (self) inherit GSourceView3.source_view (Gobject.unsafe_cast tv) diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 7a14ca3e48..a37bac3275 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -282,9 +282,9 @@ let insert_pat_alias ?loc p = function | Anonymous -> p | Name _ as na -> CAst.make ?loc @@ CPatAlias (p,(CAst.make ?loc na)) -let rec insert_coercion ?loc l c = match l with +let rec insert_entry_coercion ?loc l c = match l with | [] -> c - | (inscope,ntn)::l -> CAst.make ?loc @@ CNotation (Some inscope,ntn,([insert_coercion ?loc l c],[],[],[])) + | (inscope,ntn)::l -> CAst.make ?loc @@ CNotation (Some inscope,ntn,([insert_entry_coercion ?loc l c],[],[],[])) let rec insert_pat_coercion ?loc l c = match l with | [] -> c @@ -453,7 +453,8 @@ let rec extern_cases_pattern_in_scope (custom,scopes as allscopes) vars pat = with No_match -> let loc = pat.CAst.loc in match DAst.get pat with - | PatVar (Name id) when entry_has_ident custom -> CAst.make ?loc (CPatAtom (Some (qualid_of_ident ?loc id))) + | PatVar (Name id) when entry_has_global custom || entry_has_ident custom -> + CAst.make ?loc (CPatAtom (Some (qualid_of_ident ?loc id))) | pat -> match availability_of_entry_coercion custom InConstrEntrySomeLevel with | None -> raise No_match @@ -615,6 +616,10 @@ let is_projection nargs r = let is_hole = function CHole _ | CEvar _ -> true | _ -> false +let isCRef_no_univ = function + | CRef (_,None) -> true + | _ -> false + let is_significant_implicit a = not (is_hole (a.CAst.v)) @@ -849,7 +854,7 @@ let extern_possible_prim_token (custom,scopes) r = | Some coercion -> match availability_of_prim_token n sc scopes with | None -> raise No_match - | Some key -> insert_coercion coercion (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key) + | Some key -> insert_entry_coercion coercion (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key) let filter_enough_applied nargs l = match nargs with @@ -931,7 +936,8 @@ let rec extern inctx ?impargs scopes vars r = match DAst.get r with | GRef (ref,us) when entry_has_global (fst scopes) -> CAst.make ?loc (extern_ref vars ref us) - | GVar id when entry_has_ident (fst scopes) -> CAst.make ?loc (extern_var ?loc id) + | GVar id when entry_has_global (fst scopes) || entry_has_ident (fst scopes) -> + CAst.make ?loc (extern_var ?loc id) | c -> @@ -1081,7 +1087,7 @@ let rec extern inctx ?impargs scopes vars r = | GFloat f -> extern_float f (snd scopes) - in insert_coercion coercion (CAst.make ?loc c) + in insert_entry_coercion coercion (CAst.make ?loc c) and extern_typ ?impargs (subentry,(_,scopes)) = extern true ?impargs (subentry,(Notation.current_type_scope_name (),scopes)) @@ -1279,14 +1285,11 @@ and extern_notation (custom,scopes as allscopes) vars t rules = pi3 (extern_local_binder (subentry,(scopt,scl@scopes')) vars bl)) binderlists in let c = make_notation loc specific_ntn (l,ll,bl,bll) in - let c = insert_coercion coercion (insert_delimiters c key) in + let c = insert_entry_coercion coercion (insert_delimiters c key) in let args = fill_arg_scopes args argsscopes allscopes in let args = extern_args (extern true) vars args in CAst.make ?loc @@ extern_applied_notation nallargs argsimpls c args) | SynDefRule kn -> - match availability_of_entry_coercion custom InConstrEntrySomeLevel with - | None -> raise No_match - | Some coercion -> let l = List.map (fun (c,(subentry,(scopt,scl))) -> extern true (subentry,(scopt,scl@snd scopes)) vars c) @@ -1296,7 +1299,10 @@ and extern_notation (custom,scopes as allscopes) vars t rules = let args = fill_arg_scopes args argsscopes allscopes in let args = extern_args (extern true) vars args in let c = CAst.make ?loc @@ extern_applied_syntactic_definition nallargs argsimpls (a,cf) l args in - insert_coercion coercion c + if isCRef_no_univ c.CAst.v && entry_has_global custom then c + else match availability_of_entry_coercion custom InConstrEntrySomeLevel with + | None -> raise No_match + | Some coercion -> insert_entry_coercion coercion c with No_match -> extern_notation allscopes vars t rules diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 45255609e0..f82783f47d 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -53,6 +53,12 @@ type var_internalization_type = | Method | Variable +type var_unique_id = string + +let var_uid = + let count = ref 0 in + fun id -> incr count; Id.to_string id ^ ":" ^ string_of_int !count + type var_internalization_data = (* type of the "free" variable, for coqdoc, e.g. while typing the constructor of JMeq, "JMeq" behaves as a variable of type Inductive *) @@ -60,7 +66,9 @@ type var_internalization_data = (* signature of impargs of the variable *) Impargs.implicit_status list * (* subscopes of the args of the variable *) - scope_name option list + scope_name option list * + (* unique ID for coqdoc links *) + var_unique_id type internalization_env = (var_internalization_data) Id.Map.t @@ -177,15 +185,18 @@ let parsing_explicit = ref false let empty_internalization_env = Id.Map.empty -let compute_internalization_data env sigma ty typ impl = +let compute_internalization_data env sigma id ty typ impl = let impl = compute_implicits_with_manual env sigma typ (is_implicit_args()) impl in - (ty, impl, compute_arguments_scope sigma typ) + (ty, impl, compute_arguments_scope sigma typ, var_uid id) let compute_internalization_env env sigma ?(impls=empty_internalization_env) ty = List.fold_left3 - (fun map id typ impl -> Id.Map.add id (compute_internalization_data env sigma ty typ impl) map) + (fun map id typ impl -> Id.Map.add id (compute_internalization_data env sigma id ty typ impl) map) impls +let extend_internalization_data (r, impls, scopes, uid) impl scope = + (r, impls@[impl], scopes@[scope], uid) + (**********************************************************************) (* Contracting "{ _ }" in notations *) @@ -341,7 +352,7 @@ let impls_binder_list = let impls_type_list n ?(args = []) = let rec aux acc n c = match DAst.get c with | GProd (na,bk,_,c) -> aux (build_impls n bk na acc) (n+1) c - | _ -> (Variable,List.rev acc,[]) + | _ -> List.rev acc in aux args n let impls_term_list n ?(args = []) = @@ -351,7 +362,7 @@ let impls_term_list n ?(args = []) = let nb = match fix_kind with |GFix (_, n) -> n | GCoFix n -> n in let n,acc' = List.fold_left (fun (n,acc) (na, bk, _, _) -> (n+1,build_impls n bk na acc)) (n,acc) args.(nb) in aux acc' n bds.(nb) - |_ -> (Variable,List.rev acc,[]) + |_ -> List.rev acc in aux args n (* Check if in binder "(x1 x2 .. xn : t)", none of x1 .. xn-1 occurs in t *) @@ -431,8 +442,9 @@ let push_name_env ntnvars implargs env = if Id.Map.is_empty ntnvars && Id.equal id ldots_var then error_ldots_var ?loc; set_var_scope ?loc id false (env.tmp_scope,env.scopes) ntnvars; - Dumpglob.dump_binding ?loc id; - pure_push_name_env (id,implargs) env + let uid = var_uid id in + Dumpglob.dump_binding ?loc uid; + pure_push_name_env (id,(Variable,implargs,[],uid)) env let remember_binders_impargs env bl = List.map_filter (fun (na,_,_,_) -> @@ -463,7 +475,7 @@ let intern_generalized_binder intern_type ntnvars let ty' = intern_type {env with ids = ids; unb = true} ty in let fvs = Implicit_quantifiers.generalizable_vars_of_glob_constr ~bound:ids ~allowed:ids' ty' in let env' = List.fold_left - (fun env {loc;v=x} -> push_name_env ntnvars (Variable,[],[])(*?*) env (make ?loc @@ Name x)) + (fun env {loc;v=x} -> push_name_env ntnvars [](*?*) env (make ?loc @@ Name x)) env fvs in let b' = check_implicit_meaningful ?loc b' env in let bl = List.map @@ -530,7 +542,7 @@ let intern_cases_pattern_as_binder ?loc ntnvars env p = user_err ?loc (str "Unsupported nested \"as\" clause."); il,disjpat in - let env = List.fold_right (fun {loc;v=id} env -> push_name_env ntnvars (Variable,[],[]) env (make ?loc @@ Name id)) il env in + let env = List.fold_right (fun {loc;v=id} env -> push_name_env ntnvars [] env (make ?loc @@ Name id)) il env in let na = alias_of_pat (List.hd disjpat) in let ienv = Name.fold_right Id.Set.remove na env.ids in let id = Namegen.next_name_away_with_default "pat" na ienv in @@ -586,7 +598,7 @@ let intern_generalization intern env ntnvars loc bk ak c = GLambda (Name id, bk, DAst.make ?loc:loc' @@ GHole (Evar_kinds.BinderType (Name id), IntroAnonymous, None), acc)) in List.fold_right (fun ({loc;v=id} as lid) (env, acc) -> - let env' = push_name_env ntnvars (Variable,[],[]) env CAst.(make @@ Name id) in + let env' = push_name_env ntnvars [] env CAst.(make @@ Name id) in (env', abs lid acc)) fvs (env,c) in c' @@ -677,7 +689,7 @@ let traverse_binder intern_pat ntnvars (terms,_,binders,_ as subst) avoid (renam if onlyident then (* Do not try to interpret a variable as a constructor *) let na = out_patvar pat in - let env = push_name_env ntnvars (Variable,[],[]) env (make ?loc:pat.loc na) in + let env = push_name_env ntnvars [] env (make ?loc:pat.loc na) in (renaming,env), None, na else (* Interpret as a pattern *) @@ -1004,9 +1016,9 @@ let intern_var env (ltacvars,ntnvars) namedctx loc id us = else (* Is [id] registered with implicit arguments *) try - let ty,impls,argsc = Id.Map.find id env.impls in + let ty,impls,argsc,uid = Id.Map.find id env.impls in let tys = string_of_ty ty in - Dumpglob.dump_reference ?loc "<>" (Id.to_string id) tys; + Dumpglob.dump_reference ?loc "<>" uid tys; gvar (loc,id) us, make_implicits_list impls, argsc with Not_found -> (* Is [id] bound in current term or is an ltac var bound to constr *) @@ -1416,62 +1428,28 @@ let inductive_of_record loc record = let sort_fields ~complete loc fields completer = match fields with | [] -> None - | (first_field_ref, first_field_value):: other_fields -> + | (first_field_ref, _):: _ -> let (first_field_glob_ref, record) = try let gr = locate_reference first_field_ref in + Dumpglob.add_glob ?loc:first_field_ref.CAst.loc gr; (gr, Recordops.find_projection gr) with Not_found -> - raise (InternalizationError(loc, NotAProjection first_field_ref)) + raise (InternalizationError(first_field_ref.CAst.loc, NotAProjection first_field_ref)) in (* the number of parameters *) let nparams = record.Recordops.s_EXPECTEDPARAM in (* the reference constructor of the record *) - let base_constructor = - let global_record_id = GlobRef.ConstructRef record.Recordops.s_CONST in - try Nametab.shortest_qualid_of_global ?loc Id.Set.empty global_record_id - with Not_found -> - anomaly (str "Environment corruption for records.") in + let base_constructor = GlobRef.ConstructRef record.Recordops.s_CONST in let () = check_duplicate ?loc fields in - let (end_index, (* one past the last field index *) - first_field_index, (* index of the first field of the record *) - proj_list) (* list of projections *) - = - (* eliminate the first field from the projections, - but keep its index *) - let rec build_proj_list projs proj_kinds idx ~acc_first_idx acc = - match projs with - | [] -> (idx, acc_first_idx, acc) - | (Some field_glob_id) :: projs -> - let field_glob_ref = GlobRef.ConstRef field_glob_id in - let first_field = GlobRef.equal field_glob_ref first_field_glob_ref in - begin match proj_kinds with - | [] -> anomaly (Pp.str "Number of projections mismatch.") - | { Recordops.pk_true_proj = regular } :: proj_kinds -> - (* "regular" is false when the field is defined - by a let-in in the record declaration - (its value is fixed from other fields). *) - if first_field && not regular && complete then - user_err ?loc (str "No local fields allowed in a record construction.") - else if first_field then - build_proj_list projs proj_kinds (idx+1) ~acc_first_idx:idx acc - else if not regular && complete then - (* skip non-regular fields *) - build_proj_list projs proj_kinds idx ~acc_first_idx acc - else - build_proj_list projs proj_kinds (idx+1) ~acc_first_idx - ((idx, field_glob_id) :: acc) - end - | None :: projs -> - if complete then - (* we don't want anonymous fields *) - user_err ?loc (str "This record contains anonymous fields.") - else - (* anonymous arguments don't appear in proj_kinds *) - build_proj_list projs proj_kinds (idx+1) ~acc_first_idx acc - in - build_proj_list record.Recordops.s_PROJ record.Recordops.s_PROJKIND 1 ~acc_first_idx:0 [] - in + let build_proj idx proj kind = + if proj = None && complete then + (* we don't want anonymous fields *) + user_err ?loc (str "This record contains anonymous fields.") + else + (idx, proj, kind.Recordops.pk_true_proj) in + let proj_list = + List.map2_i build_proj 1 record.Recordops.s_PROJ record.Recordops.s_PROJKIND in (* now we want to have all fields assignments indexed by their place in the constructor *) let rec index_fields fields remaining_projs acc = @@ -1479,34 +1457,43 @@ let sort_fields ~complete loc fields completer = | (field_ref, field_value) :: fields -> let field_glob_ref = try locate_reference field_ref with Not_found -> - user_err ?loc ~hdr:"intern" + user_err ?loc:field_ref.CAst.loc ~hdr:"intern" (str "The field \"" ++ pr_qualid field_ref ++ str "\" does not exist.") in - let this_field_record = try Recordops.find_projection field_glob_ref - with Not_found -> - let inductive_ref = inductive_of_record loc record in - raise (InternalizationError(loc, NotAProjectionOf (field_ref, inductive_ref))) - in - let remaining_projs, (field_index, _) = - let the_proj (idx, glob_id) = GlobRef.equal field_glob_ref (GlobRef.ConstRef glob_id) in + let remaining_projs, (field_index, _, regular) = + let the_proj = function + | (idx, Some glob_id, _) -> GlobRef.equal field_glob_ref (GlobRef.ConstRef glob_id) + | (idx, None, _) -> false in try CList.extract_first the_proj remaining_projs with Not_found -> - let ind1 = inductive_of_record loc record in - let ind2 = inductive_of_record loc this_field_record in + let floc = field_ref.CAst.loc in + let this_field_record = + try Recordops.find_projection field_glob_ref + with Not_found -> + let inductive_ref = inductive_of_record floc record in + raise (InternalizationError(floc, NotAProjectionOf (field_ref, inductive_ref))) in + let ind1 = inductive_of_record floc record in + let ind2 = inductive_of_record floc this_field_record in raise (InternalizationError(loc, ProjectionsOfDifferentRecords (ind1, ind2))) in + if not regular && complete then + (* "regular" is false when the field is defined + by a let-in in the record declaration + (its value is fixed from other fields). *) + user_err ?loc (str "No local fields allowed in a record construction."); + Dumpglob.add_glob ?loc:field_ref.CAst.loc field_glob_ref; index_fields fields remaining_projs ((field_index, field_value) :: acc) | [] -> - (* the order does not matter as we sort them next, - List.rev_* is just for efficiency *) let remaining_fields = - let complete_field (idx, field_ref) = (idx, - completer idx field_ref record.Recordops.s_CONST) in - List.rev_map complete_field remaining_projs in + let complete_field (idx, field_ref, regular) = + if not regular && complete then + (* For terms, we keep only regular fields *) + None + else + Some (idx, completer idx field_ref record.Recordops.s_CONST) in + List.map_filter complete_field remaining_projs in List.rev_append remaining_fields acc in - let unsorted_indexed_fields = - index_fields other_fields proj_list - [(first_field_index, first_field_value)] in + let unsorted_indexed_fields = index_fields fields proj_list [] in let sorted_indexed_fields = let cmp_by_index (i, _) (j, _) = Int.compare i j in List.sort cmp_by_index unsorted_indexed_fields in @@ -1665,9 +1652,9 @@ let drop_notations_pattern looked_for genv = if get_asymmetric_patterns () then pl else let pars = List.make n (CAst.make ?loc @@ CPatAtom None) in List.rev_append pars pl in - match drop_syndef top scopes head pl with - | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c) - | None -> raise (InternalizationError (loc,NotAConstructor head)) + let (_,argscs) = find_remaining_scopes [] pl head in + let pats = List.map2 (in_pat_sc scopes) argscs pl in + DAst.make ?loc @@ RCPatCstr(head, [], pats) end | CPatCstr (head, None, pl) -> begin @@ -2052,7 +2039,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = (fun _idx fieldname constructorname -> let open Evar_kinds in let fieldinfo : Evar_kinds.record_field = - {fieldname=fieldname; recordname=inductive_of_constructor constructorname} + {fieldname=Option.get fieldname; recordname=inductive_of_constructor constructorname} in CAst.make ?loc @@ CHole (Some (Evar_kinds.QuestionMark { Evar_kinds.default_question_mark with @@ -2064,10 +2051,12 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = match fields with | None -> user_err ?loc ~hdr:"intern" (str"No constructor inference.") | Some (n, constrname, args) -> + let args_scopes = find_arguments_scope constrname in let pars = List.make n (CAst.make ?loc @@ CHole (None, IntroAnonymous, None)) in - let app = CAst.make ?loc @@ CAppExpl ((None, constrname,None), List.rev_append pars args) in - intern env app - end + let args = intern_args env args_scopes (List.rev_append pars args) in + let hd = DAst.make @@ GRef (constrname,None) in + DAst.make ?loc @@ GApp (hd, args) + end | CCases (sty, rtnpo, tms, eqns) -> let as_in_vars = List.fold_left (fun acc (_,na,inb) -> (Option.fold_left (fun acc { CAst.v = y } -> Name.fold_right Id.Set.add y acc) acc na)) @@ -2084,7 +2073,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = List.rev_append match_td matchs) tms ([],Id.Set.empty,Id.Map.empty,[]) in let env' = Id.Set.fold - (fun var bli -> push_name_env ntnvars (Variable,[],[]) bli (CAst.make @@ Name var)) + (fun var bli -> push_name_env ntnvars [] bli (CAst.make @@ Name var)) (Id.Set.union ex_ids as_in_vars) (restart_lambda_binders env) in @@ -2122,17 +2111,17 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = (* "in" is None so no match to add *) let ((b',(na',_)),_,_) = intern_case_item env' Id.Set.empty (b,na,None) in let p' = Option.map (fun u -> - let env'' = push_name_env ntnvars (Variable,[],[]) env' + let env'' = push_name_env ntnvars [] env' (CAst.make na') in intern_type (slide_binders env'') u) po in DAst.make ?loc @@ GLetTuple (List.map (fun { CAst.v } -> v) nal, (na', p'), b', - intern (List.fold_left (push_name_env ntnvars (Variable,[],[])) env nal) c) + intern (List.fold_left (push_name_env ntnvars []) env nal) c) | CIf (c, (na,po), b1, b2) -> let env' = reset_tmp_scope env in let ((c',(na',_)),_,_) = intern_case_item env' Id.Set.empty (c,na,None) in (* no "in" no match to ad too *) let p' = Option.map (fun p -> - let env'' = push_name_env ntnvars (Variable,[],[]) env + let env'' = push_name_env ntnvars [] env (CAst.make na') in intern_type (slide_binders env'') p) po in DAst.make ?loc @@ diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 9f06f16258..2eb96aad56 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -43,26 +43,28 @@ type var_internalization_type = | Method | Variable -type var_internalization_data = - var_internalization_type * - (* type of the "free" variable, for coqdoc, e.g. while typing the - constructor of JMeq, "JMeq" behaves as a variable of type Inductive *) - - Impargs.implicit_status list * (* signature of impargs of the variable *) - Notation_term.scope_name option list (* subscopes of the args of the variable *) +(** This collects relevant information for interning local variables: + - their coqdoc kind (a recursive call in a inductive, fixpoint of class; or a bound variable) + e.g. while typing the constructor of JMeq, "JMeq" behaves as a variable of type Inductive + - their implicit arguments + - their argument scopes *) +type var_internalization_data (** A map of free variables to their implicit arguments and scopes *) type internalization_env = var_internalization_data Id.Map.t val empty_internalization_env : internalization_env -val compute_internalization_data : env -> evar_map -> var_internalization_type -> +val compute_internalization_data : env -> evar_map -> Id.t -> var_internalization_type -> types -> Impargs.manual_implicits -> var_internalization_data val compute_internalization_env : env -> evar_map -> ?impls:internalization_env -> var_internalization_type -> Id.t list -> types list -> Impargs.manual_implicits list -> internalization_env +val extend_internalization_data : + var_internalization_data -> Impargs.implicit_status -> scope_name option -> var_internalization_data + type ltac_sign = { ltac_vars : Id.Set.t; (** Variables of Ltac which may be bound to a term *) diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml index e659a5ac5c..57ec708b07 100644 --- a/interp/dumpglob.ml +++ b/interp/dumpglob.ml @@ -246,8 +246,6 @@ let add_glob_kn ?loc kn = let lib_dp = Lib.dp_of_mp (mp_of_kn kn) in add_glob_gen ?loc sp lib_dp "syndef" -let dump_binding ?loc id = () - let dump_def ?loc ty secpath id = Option.iter (fun loc -> if !glob_output = Feedback then Feedback.feedback (Feedback.GlobDef (loc, id, secpath, ty)) @@ -275,3 +273,6 @@ let dump_notation (loc,(df,_)) sc sec = Option.iter (fun loc -> let location = (Loc.make_loc (i, i+1)) in dump_def ~loc:location "not" (Names.DirPath.to_string (Lib.current_dirpath sec)) (cook_notation df sc) ) loc + +let dump_binding ?loc uid = + dump_def ?loc "binder" "<>" uid diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli index 5409b20472..14e5a81308 100644 --- a/interp/dumpglob.mli +++ b/interp/dumpglob.mli @@ -36,7 +36,7 @@ val dump_secvar : ?loc:Loc.t -> Names.Id.t -> unit val dump_libref : ?loc:Loc.t -> Names.DirPath.t -> string -> unit val dump_notation_location : (int * int) list -> Constrexpr.notation -> (Notation.notation_location * Notation_term.scope_name option) -> unit -val dump_binding : ?loc:Loc.t -> Names.Id.Set.elt -> unit +val dump_binding : ?loc:Loc.t -> string -> unit val dump_notation : (Constrexpr.notation * Notation.notation_location) Loc.located -> Notation_term.scope_name option -> bool -> unit diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml index c31cdae6f5..de02882370 100644 --- a/kernel/cClosure.ml +++ b/kernel/cClosure.ml @@ -613,7 +613,7 @@ let rec to_constr lfts v = subst_constr subs f) | FEvar ((ev,args),env) -> let subs = comp_subs lfts env in - mkEvar(ev,Array.map (fun a -> subst_constr subs a) args) + mkEvar(ev,List.map (fun a -> subst_constr subs a) args) | FLIFT (k,a) -> to_constr (el_shft k lfts) a | FInt i -> @@ -1408,7 +1408,7 @@ and norm_head info tab m = Array.Fun1.map mk_clos (subs_liftn (Array.length na) e) bds in mkFix(n,(na, CArray.map (kl info tab) ftys, CArray.map (kl info tab) fbds)) | FEvar((i,args),env) -> - mkEvar(i, Array.map (fun a -> kl info tab (mk_clos env a)) args) + mkEvar(i, List.map (fun a -> kl info tab (mk_clos env a)) args) | FProj (p,c) -> mkProj (p, kl info tab c) | FLOCKED | FRel _ | FAtom _ | FFlex _ | FInd _ | FConstruct _ diff --git a/kernel/clambda.ml b/kernel/clambda.ml index 8c7aa6b17a..65de52c0f6 100644 --- a/kernel/clambda.ml +++ b/kernel/clambda.ml @@ -670,7 +670,7 @@ let rec lambda_of_constr env c = match Constr.kind c with | Meta _ -> raise (Invalid_argument "Cbytegen.lambda_of_constr: Meta") | Evar (evk, args) -> - let args = lambda_of_args env 0 args in + let args = Array.map_of_list (fun c -> lambda_of_constr env c) args in Levar (evk, args) | Cast (c, _, _) -> lambda_of_constr env c @@ -799,9 +799,6 @@ and lambda_of_args env start args = (fun i -> lambda_of_constr env args.(start + i)) else empty_args - - - (*********************************) let dump_lambda = ref false diff --git a/kernel/constr.ml b/kernel/constr.ml index ade03fdf93..703e3616a0 100644 --- a/kernel/constr.ml +++ b/kernel/constr.ml @@ -71,7 +71,7 @@ type case_info = (* [constr array] is an instance matching definitional [named_context] in the same order (i.e. last argument first) *) -type 'constr pexistential = existential_key * 'constr array +type 'constr pexistential = existential_key * 'constr list type ('constr, 'types) prec_declaration = Name.t binder_annot array * 'types array * 'constr array type ('constr, 'types) pfixpoint = @@ -110,7 +110,7 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term = type t = (t, t, Sorts.t, Instance.t) kind_of_term type constr = t -type existential = existential_key * constr array +type existential = existential_key * constr list type types = constr @@ -470,7 +470,7 @@ let fold f acc c = match kind c with | LetIn (_,b,t,c) -> f (f (f acc b) t) c | App (c,l) -> Array.fold_left f (f acc c) l | Proj (_p,c) -> f acc c - | Evar (_,l) -> Array.fold_left f acc l + | Evar (_,l) -> List.fold_left f acc l | Case (_,p,c,bl) -> Array.fold_left f (f (f acc p) c) bl | Fix (_,(_lna,tl,bl)) -> Array.fold_left2 (fun acc t b -> f (f acc t) b) acc tl bl @@ -490,7 +490,7 @@ let iter f c = match kind c with | LetIn (_,b,t,c) -> f b; f t; f c | App (c,l) -> f c; Array.iter f l | Proj (_p,c) -> f c - | Evar (_,l) -> Array.iter f l + | Evar (_,l) -> List.iter f l | Case (_,p,c,bl) -> f p; f c; Array.iter f bl | Fix (_,(_,tl,bl)) -> Array.iter f tl; Array.iter f bl | CoFix (_,(_,tl,bl)) -> Array.iter f tl; Array.iter f bl @@ -509,7 +509,7 @@ let iter_with_binders g f n c = match kind c with | Lambda (_,t,c) -> f n t; f (g n) c | LetIn (_,b,t,c) -> f n b; f n t; f (g n) c | App (c,l) -> f n c; Array.Fun1.iter f n l - | Evar (_,l) -> Array.Fun1.iter f n l + | Evar (_,l) -> List.iter (fun c -> f n c) l | Case (_,p,c,bl) -> f n p; f n c; Array.Fun1.iter f n bl | Proj (_p,c) -> f n c | Fix (_,(_,tl,bl)) -> @@ -536,7 +536,7 @@ let fold_constr_with_binders g f n acc c = | LetIn (_na,b,t,c) -> f (g n) (f n (f n acc b) t) c | App (c,l) -> Array.fold_left (f n) (f n acc c) l | Proj (_p,c) -> f n acc c - | Evar (_,l) -> Array.fold_left (f n) acc l + | Evar (_,l) -> List.fold_left (f n) acc l | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) c) bl | Fix (_,(_,tl,bl)) -> let n' = iterate g (Array.length tl) n in @@ -657,7 +657,7 @@ let map_gen userview f c = match kind c with if t' == t then c else mkProj (p, t') | Evar (e,l) -> - let l' = Array.Smart.map f l in + let l' = List.Smart.map f l in if l'==l then c else mkEvar (e, l') | Case (ci,p,b,bl) when userview -> @@ -722,7 +722,8 @@ let fold_map f accu c = match kind c with if t' == t then accu, c else accu, mkProj (p, t') | Evar (e,l) -> - let accu, l' = Array.Smart.fold_left_map f accu l in + (* Doesn't matter, we should not hashcons evars anyways *) + let accu, l' = List.fold_left_map f accu l in if l'==l then accu, c else accu, mkEvar (e, l') | Case (ci,p,b,bl) -> @@ -782,7 +783,7 @@ let map_with_binders g f l c0 = match kind c0 with if t' == t then c0 else mkProj (p, t') | Evar (e, al) -> - let al' = Array.Fun1.Smart.map f l al in + let al' = List.Smart.map (fun c -> f l c) al in if al' == al then c0 else mkEvar (e, al') | Case (ci, p, c, bl) -> @@ -834,7 +835,7 @@ let fold_with_full_binders g f n acc 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 (_,l) -> Array.fold_left (f n) acc l + | Evar (_,l) -> List.fold_left (f n) acc l | Case (_,p,c,bl) -> Array.fold_left (f n) (f n (f n acc p) 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 @@ -880,7 +881,7 @@ let compare_head_gen_leq_with kind1 kind2 leq_universes leq_sorts eq leq nargs t Int.equal len (Array.length l2) && leq (nargs+len) c1 c2 && Array.equal_norefl (eq 0) l1 l2 | Proj (p1,c1), Proj (p2,c2) -> Projection.equal p1 p2 && eq 0 c1 c2 - | Evar (e1,l1), Evar (e2,l2) -> Evar.equal e1 e2 && Array.equal (eq 0) l1 l2 + | Evar (e1,l1), Evar (e2,l2) -> Evar.equal e1 e2 && List.equal (eq 0) l1 l2 | Const (c1,u1), Const (c2,u2) -> (* The args length currently isn't used but may as well pass it. *) Constant.equal c1 c2 && leq_universes (GlobRef.ConstRef c1) nargs u1 u2 @@ -1039,7 +1040,7 @@ let constr_ord_int f t1 t2 = | Meta m1, Meta m2 -> Int.compare m1 m2 | Meta _, _ -> -1 | _, Meta _ -> 1 | Evar (e1,l1), Evar (e2,l2) -> - (Evar.compare =? (Array.compare f)) e1 e2 l1 l2 + (Evar.compare =? (List.compare f)) e1 e2 l1 l2 | Evar _, _ -> -1 | _, Evar _ -> 1 | Sort s1, Sort s2 -> Sorts.compare s1 s2 | Sort _, _ -> -1 | _, Sort _ -> 1 @@ -1141,7 +1142,7 @@ let hasheq t1 t2 = n1 == n2 && b1 == b2 && t1 == t2 && c1 == c2 | App (c1,l1), App (c2,l2) -> c1 == c2 && array_eqeq l1 l2 | Proj (p1,c1), Proj(p2,c2) -> p1 == p2 && c1 == c2 - | Evar (e1,l1), Evar (e2,l2) -> e1 == e2 && array_eqeq l1 l2 + | Evar (e1,l1), Evar (e2,l2) -> e1 == e2 && List.equal (==) l1 l2 | Const (c1,u1), Const (c2,u2) -> c1 == c2 && u1 == u2 | Ind (ind1,u1), Ind (ind2,u2) -> ind1 == ind2 && u1 == u2 | Construct (cstr1,u1), Construct (cstr2,u2) -> cstr1 == cstr2 && u1 == u2 @@ -1221,7 +1222,7 @@ let hashcons (sh_sort,sh_ci,sh_construct,sh_ind,sh_con,sh_na,sh_id) = let l, hl = hash_term_array l in (App (c,l), combinesmall 7 (combine hl hc)) | Evar (e,l) -> - let l, hl = hash_term_array l in + let l, hl = hash_list_array l in (Evar (e,l), combinesmall 8 (combine (Evar.hash e) hl)) | Const (c,u) -> let c' = sh_con c in @@ -1289,6 +1290,14 @@ let hashcons (sh_sort,sh_ci,sh_construct,sh_ind,sh_con,sh_na,sh_id) = let h = !accu land 0x3FFFFFFF in (HashsetTermArray.repr h t term_array_table, h) + and hash_list_array l = + let fold accu c = + let c, h = sh_rec c in + (combine accu h, c) + in + let h, l = List.fold_left_map fold 0 l in + (l, h land 0x3FFFFFFF) + in (* Make sure our statically allocated Rels (1 to 16) are considered as canonical, and hence hash-consed to themselves *) @@ -1316,7 +1325,7 @@ let rec hash t = | App (c,l) -> combinesmall 7 (combine (hash_term_array l) (hash c)) | Evar (e,l) -> - combinesmall 8 (combine (Evar.hash e) (hash_term_array l)) + combinesmall 8 (combine (Evar.hash e) (hash_term_list l)) | Const (c,u) -> combinesmall 9 (combine (Constant.hash c) (Instance.hash u)) | Ind (ind,u) -> @@ -1339,6 +1348,9 @@ let rec hash t = and hash_term_array t = Array.fold_left (fun acc t -> combine acc (hash t)) 0 t +and hash_term_list t = + List.fold_left (fun acc t -> combine (hash t) acc) 0 t + module CaseinfoHash = struct type t = case_info @@ -1458,7 +1470,7 @@ let rec debug_print c = prlist_with_sep spc debug_print (Array.to_list l) ++ str")") | Evar (e,l) -> hov 1 (str"Evar#" ++ int (Evar.repr e) ++ str"{" ++ - prlist_with_sep spc debug_print (Array.to_list l) ++str"}") + prlist_with_sep spc debug_print l ++str"}") | Const (c,u) -> str"Cst(" ++ pr_puniverses (Constant.debug_print c) u ++ str")" | Ind ((sp,i),u) -> str"Ind(" ++ pr_puniverses (MutInd.print sp ++ str"," ++ int i) u ++ str")" | Construct (((sp,i),j),u) -> diff --git a/kernel/constr.mli b/kernel/constr.mli index 16919b705a..00051d7551 100644 --- a/kernel/constr.mli +++ b/kernel/constr.mli @@ -83,7 +83,7 @@ val mkFloat : Float64.t -> constr val mkMeta : metavariable -> constr (** Constructs an existential variable *) -type existential = Evar.t * constr array +type existential = Evar.t * constr list val mkEvar : existential -> constr (** Construct a sort *) @@ -203,9 +203,9 @@ val mkCoFix : cofixpoint -> constr (** {6 Concrete type for making pattern-matching. } *) -(** [constr array] is an instance matching definitional [named_context] in +(** [constr list] is an instance matching definitional [named_context] in the same order (i.e. last argument first) *) -type 'constr pexistential = Evar.t * 'constr array +type 'constr pexistential = Evar.t * 'constr list type ('constr, 'types, 'sort, 'univs) kind_of_term = | Rel of int (** Gallina-variable introduced by [forall], [fun], [let-in], [fix], or [cofix]. *) diff --git a/kernel/declarations.ml b/kernel/declarations.ml index 244cd2865d..2f6a870c8a 100644 --- a/kernel/declarations.ml +++ b/kernel/declarations.ml @@ -92,6 +92,8 @@ type typing_flags = { indices_matter: bool; (** The universe of an inductive type must be above that of its indices. *) + cumulative_sprop : bool; + (** SProp <= Type *) } (* some contraints are in constant_constraints, some other may be in @@ -293,8 +295,6 @@ and 'a generic_module_body = mod_expr : 'a; (** implementation *) mod_type : module_signature; (** expanded type *) mod_type_alg : module_expression option; (** algebraic type *) - mod_constraints : Univ.ContextSet.t; (** - set of all universes constraints in the module *) mod_delta : Mod_subst.delta_resolver; (** quotiented set of equivalent constants and inductive names *) mod_retroknowledge : 'a module_retroknowledge } diff --git a/kernel/declareops.ml b/kernel/declareops.ml index 20dc21900c..0ab99cab35 100644 --- a/kernel/declareops.ml +++ b/kernel/declareops.ml @@ -26,6 +26,7 @@ let safe_flags oracle = { enable_VM = true; enable_native_compiler = true; indices_matter = true; + cumulative_sprop = false; } (** {6 Arities } *) @@ -390,7 +391,6 @@ and hcons_generic_module_body : let expr' = hcons_impl mb.mod_expr in let type' = hcons_module_signature mb.mod_type in let type_alg' = mb.mod_type_alg in - let constraints' = Univ.hcons_universe_context_set mb.mod_constraints in let delta' = mb.mod_delta in let retroknowledge' = mb.mod_retroknowledge in @@ -399,7 +399,6 @@ and hcons_generic_module_body : mb.mod_expr == expr' && mb.mod_type == type' && mb.mod_type_alg == type_alg' && - mb.mod_constraints == constraints' && mb.mod_delta == delta' && mb.mod_retroknowledge == retroknowledge' then mb @@ -408,7 +407,6 @@ and hcons_generic_module_body : mod_expr = expr'; mod_type = type'; mod_type_alg = type_alg'; - mod_constraints = constraints'; mod_delta = delta'; mod_retroknowledge = retroknowledge'; } diff --git a/kernel/environ.ml b/kernel/environ.ml index de8692ff21..d6d52dbc2b 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -279,6 +279,9 @@ let indices_matter env = env.env_typing_flags.indices_matter let universes env = env.env_stratification.env_universes let universes_lbound env = env.env_stratification.env_universes_lbound +let set_universes g env = + {env with env_stratification = {env.env_stratification with env_universes=g}} + let set_universes_lbound env lbound = let env_stratification = { env.env_stratification with env_universes_lbound = lbound } in { env with env_stratification } @@ -431,7 +434,7 @@ let push_subgraph (levels,csts) env = in map_universes add_subgraph env -let set_engagement c env = (* Unsafe *) +let set_engagement c env = { env with env_stratification = { env.env_stratification with env_engagement = c } } @@ -445,6 +448,7 @@ let same_flags { share_reduction; enable_VM; enable_native_compiler; + cumulative_sprop; } alt = check_guarded == alt.check_guarded && check_positive == alt.check_positive && @@ -453,14 +457,18 @@ let same_flags { indices_matter == alt.indices_matter && share_reduction == alt.share_reduction && enable_VM == alt.enable_VM && - enable_native_compiler == alt.enable_native_compiler + enable_native_compiler == alt.enable_native_compiler && + cumulative_sprop == alt.cumulative_sprop [@warning "+9"] -let set_typing_flags c env = (* Unsafe *) +let set_cumulative_sprop b = map_universes (UGraph.set_cumulative_sprop b) + +let set_typing_flags c env = if same_flags env.env_typing_flags c then env - else { env with env_typing_flags = c } + else set_cumulative_sprop c.cumulative_sprop { env with env_typing_flags = c } -let make_sprop_cumulative = map_universes UGraph.make_sprop_cumulative +let set_cumulative_sprop b env = + set_typing_flags {env.env_typing_flags with cumulative_sprop=b} env let set_allow_sprop b env = { env with env_stratification = diff --git a/kernel/environ.mli b/kernel/environ.mli index 25ecdfd852..7a46538772 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -102,6 +102,8 @@ val rel_context : env -> Constr.rel_context val named_context : env -> Constr.named_context val named_context_val : env -> named_context_val +val set_universes : UGraph.t -> env -> env + val opaque_tables : env -> Opaqueproof.opaquetab val set_opaque_tables : env -> Opaqueproof.opaquetab -> env @@ -310,7 +312,7 @@ val push_subgraph : Univ.ContextSet.t -> env -> env val set_engagement : engagement -> env -> env val set_typing_flags : typing_flags -> env -> env -val make_sprop_cumulative : env -> env +val set_cumulative_sprop : bool -> env -> env val set_allow_sprop : bool -> env -> env val sprop_allowed : env -> bool diff --git a/kernel/inferCumulativity.ml b/kernel/inferCumulativity.ml index f987164d52..662ad550b8 100644 --- a/kernel/inferCumulativity.ml +++ b/kernel/inferCumulativity.ml @@ -99,7 +99,7 @@ let rec infer_fterm cv_pb infos variances hd stk = end | FEvar ((_,args),e) -> let variances = infer_stack infos variances stk in - infer_vect infos variances (Array.map (mk_clos e) args) + infer_list infos variances (List.map (mk_clos e) args) | FRel _ -> infer_stack infos variances stk | FInt _ -> infer_stack infos variances stk | FFloat _ -> infer_stack infos variances stk @@ -168,6 +168,9 @@ and infer_stack infos variances (stk:CClosure.stack) = and infer_vect infos variances v = Array.fold_left (fun variances c -> infer_fterm CONV infos variances c []) variances v +and infer_list infos variances v = + List.fold_left (fun variances c -> infer_fterm CONV infos variances c []) variances v + let infer_term cv_pb env variances c = let open CClosure in let infos = (create_clos_infos all env, create_tab ()) in diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml index aa513c1536..317141e324 100644 --- a/kernel/mod_subst.ml +++ b/kernel/mod_subst.ml @@ -405,7 +405,7 @@ let rec map_kn f f' c = if (ct'== ct && l'==l) then c else mkApp (ct',l') | Evar (e,l) -> - let l' = Array.Smart.map func l in + let l' = List.Smart.map func l in if (l'==l) then c else mkEvar (e,l') | Fix (ln,(lna,tl,bl)) -> diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml index 76e2a584bd..44b010204b 100644 --- a/kernel/mod_typing.ml +++ b/kernel/mod_typing.ml @@ -23,7 +23,7 @@ open Modops open Mod_subst type 'alg translation = - module_signature * 'alg * delta_resolver * Univ.ContextSet.t + module_signature * 'alg * delta_resolver * Univ.Constraint.t let rec mp_from_mexpr = function | MEident mp -> mp @@ -54,8 +54,6 @@ let rec rebuild_mp mp l = | []-> mp | i::r -> rebuild_mp (MPdot(mp,Label.of_id i)) r -let (+++) = Univ.ContextSet.union - let rec check_with_def env struc (idl,(c,ctx)) mp equiv = let lab,idl = match idl with | [] -> assert false @@ -173,10 +171,10 @@ let rec check_with_mod env struc (idl,mp1) mp equiv = | Abstract -> let mtb_old = module_type_of_module old in let chk_cst = Subtyping.check_subtypes env' mtb_mp1 mtb_old in - Univ.ContextSet.add_constraints chk_cst old.mod_constraints + chk_cst | Algebraic (NoFunctor (MEident(mp'))) -> check_modpath_equiv env' mp1 mp'; - old.mod_constraints + Univ.Constraint.empty | _ -> error_generative_module_expected lab in let mp' = MPdot (mp,lab) in @@ -185,7 +183,7 @@ let rec check_with_mod env struc (idl,mp1) mp equiv = { new_mb with mod_mp = mp'; mod_expr = Algebraic (NoFunctor (MEident mp1)); - mod_constraints = cst } + } in let new_equiv = add_delta_resolver equiv new_mb.mod_delta in (* we propagate the new equality in the rest of the signature @@ -219,7 +217,7 @@ let rec check_with_mod env struc (idl,mp1) mp equiv = | Algebraic (NoFunctor (MEident mp0)) -> let mpnew = rebuild_mp mp0 idl in check_modpath_equiv env' mpnew mp; - before@(lab,spec)::after, equiv, Univ.ContextSet.empty + before@(lab,spec)::after, equiv, Univ.Constraint.empty | _ -> error_generative_module_expected lab end with @@ -231,11 +229,11 @@ let check_with env mp (sign,alg,reso,cst) = function let struc = destr_nofunctor sign in let struc', c', cst' = check_with_def env struc (idl, (c, ctx)) mp reso in let wd' = WithDef (idl, (c', ctx)) in - NoFunctor struc', MEwith (alg,wd'), reso, Univ.ContextSet.add_constraints cst' cst + NoFunctor struc', MEwith (alg,wd'), reso, Univ.Constraint.union cst' cst |WithMod(idl,mp1) as wd -> let struc = destr_nofunctor sign in let struc',reso',cst' = check_with_mod env struc (idl,mp1) mp reso in - NoFunctor struc', MEwith (alg,wd), reso', cst+++cst' + NoFunctor struc', MEwith (alg,wd), reso', Univ.Constraint.union cst' cst let translate_apply env inl (sign,alg,reso,cst1) mp1 mkalg = let farg_id, farg_b, fbody_b = destr_functor sign in @@ -247,7 +245,7 @@ let translate_apply env inl (sign,alg,reso,cst1) mp1 mkalg = let body = subst_signature subst fbody_b in let alg' = mkalg alg mp1 in let reso' = subst_codom_delta_resolver subst reso in - body,alg',reso', Univ.ContextSet.add_constraints cst2 cst1 + body,alg',reso', Univ.Constraint.union cst2 cst1 (** Translation of a module struct entry : - We translate to a module when a [module_path] is given, @@ -266,7 +264,7 @@ let rec translate_mse env mpo inl = function let mt = lookup_modtype mp1 env in module_body_of_type mt.mod_mp mt in - mb.mod_type, me, mb.mod_delta, Univ.ContextSet.empty + mb.mod_type, me, mb.mod_delta, Univ.Constraint.empty |MEapply (fe,mp1) -> translate_apply env inl (translate_mse env mpo inl fe) mp1 mk_alg_app |MEwith(me, with_decl) -> @@ -274,17 +272,16 @@ let rec translate_mse env mpo inl = function let mp = mp_from_mexpr me in check_with env mp (translate_mse env None inl me) with_decl -let mk_mod mp e ty cst reso = +let mk_mod mp e ty reso = { mod_mp = mp; mod_expr = e; mod_type = ty; mod_type_alg = None; - mod_constraints = cst; mod_delta = reso; mod_retroknowledge = ModBodyRK []; } -let mk_modtype mp ty cst reso = - let mb = mk_mod mp Abstract ty cst reso in +let mk_modtype mp ty reso = + let mb = mk_mod mp Abstract ty reso in { mb with mod_expr = (); mod_retroknowledge = ModTypeRK } let rec translate_mse_funct env mpo inl mse = function @@ -293,45 +290,45 @@ let rec translate_mse_funct env mpo inl mse = function sign, NoFunctor alg, reso, cst |(mbid, ty) :: params -> let mp_id = MPbound mbid in - let mtb = translate_modtype env mp_id inl ([],ty) in + let mtb, cst = translate_modtype env mp_id inl ([],ty) in let env' = add_module_type mp_id mtb env in - let sign,alg,reso,cst = translate_mse_funct env' mpo inl mse params in + let sign,alg,reso,cst' = translate_mse_funct env' mpo inl mse params in let alg' = MoreFunctor (mbid,mtb,alg) in - MoreFunctor (mbid, mtb, sign), alg',reso, cst +++ mtb.mod_constraints + MoreFunctor (mbid, mtb, sign), alg',reso, Univ.Constraint.union cst cst' and translate_modtype env mp inl (params,mte) = let sign,alg,reso,cst = translate_mse_funct env None inl mte params in - let mtb = mk_modtype (mp_from_mexpr mte) sign cst reso in + let mtb = mk_modtype (mp_from_mexpr mte) sign reso in let mtb' = subst_modtype_and_resolver mtb mp in - { mtb' with mod_type_alg = Some alg } + { mtb' with mod_type_alg = Some alg }, cst (** [finalize_module] : from an already-translated (or interactive) implementation and an (optional) signature entry, produces a final [module_body] *) -let finalize_module env mp (sign,alg,reso,cst) restype = match restype with - |None -> +let finalize_module env mp (sign,alg,reso,cst1) restype = match restype with + | None -> let impl = match alg with Some e -> Algebraic e | None -> FullStruct in - mk_mod mp impl sign cst reso - |Some (params_mte,inl) -> - let res_mtb = translate_modtype env mp inl params_mte in - let auto_mtb = mk_modtype mp sign Univ.ContextSet.empty reso in - let cst' = Subtyping.check_subtypes env auto_mtb res_mtb in + mk_mod mp impl sign reso, cst1 + | Some (params_mte,inl) -> + let res_mtb, cst2 = translate_modtype env mp inl params_mte in + let auto_mtb = mk_modtype mp sign reso in + let cst3 = Subtyping.check_subtypes env auto_mtb res_mtb in let impl = match alg with Some e -> Algebraic e | None -> Struct sign in { res_mtb with mod_mp = mp; mod_expr = impl; mod_retroknowledge = ModBodyRK []; - (** cst from module body typing, - cst' from subtyping, - constraints from module type. *) - mod_constraints = - Univ.ContextSet.add_constraints cst' (cst +++ res_mtb.mod_constraints) } + }, + (** cst from module body typing, + cst' from subtyping, + constraints from module type. *) + Univ.Constraint.(union cst1 (union cst2 cst3)) let translate_module env mp inl = function |MType (params,ty) -> - let mtb = translate_modtype env mp inl (params,ty) in - module_body_of_type mp mtb + let mtb, cst = translate_modtype env mp inl (params,ty) in + module_body_of_type mp mtb, cst |MExpr (params,mse,oty) -> let (sg,alg,reso,cst) = translate_mse_funct env (Some mp) inl mse params in let restype = Option.map (fun ty -> ((params,ty),inl)) oty in @@ -364,7 +361,7 @@ let rec translate_mse_inclmod env mp inl = function |MEident mp1 -> let mb = strengthen_and_subst_mb (lookup_module mp1 env) mp true in let sign = clean_bounded_mod_expr mb.mod_type in - sign,(),mb.mod_delta,Univ.ContextSet.empty + sign,(),mb.mod_delta,Univ.Constraint.empty |MEapply (fe,arg) -> let ftrans = translate_mse_inclmod env mp inl fe in translate_apply env inl ftrans arg (fun _ _ -> ()) @@ -375,6 +372,6 @@ let translate_mse_incl is_mod env mp inl me = let () = forbid_incl_signed_functor env me in translate_mse_inclmod env mp inl me else - let mtb = translate_modtype env mp inl ([],me) in + let mtb, cst = translate_modtype env mp inl ([],me) in let sign = clean_bounded_mod_expr mtb.mod_type in - sign,(),mtb.mod_delta,mtb.mod_constraints + sign, (), mtb.mod_delta, cst diff --git a/kernel/mod_typing.mli b/kernel/mod_typing.mli index fd5421aefe..94a4b17df3 100644 --- a/kernel/mod_typing.mli +++ b/kernel/mod_typing.mli @@ -23,13 +23,13 @@ open Names *) val translate_module : - env -> ModPath.t -> inline -> module_entry -> module_body + env -> ModPath.t -> inline -> module_entry -> module_body * Univ.Constraint.t (** [translate_modtype] produces a [module_type_body] whose [mod_type_alg] cannot be [None] (and of course [mod_expr] is [Abstract]). *) val translate_modtype : - env -> ModPath.t -> inline -> module_type_entry -> module_type_body + env -> ModPath.t -> inline -> module_type_entry -> module_type_body * Univ.Constraint.t (** Low-level function for translating a module struct entry : - We translate to a module when a [ModPath.t] is given, @@ -39,7 +39,7 @@ val translate_modtype : the extraction. *) type 'alg translation = - module_signature * 'alg * delta_resolver * Univ.ContextSet.t + module_signature * 'alg * delta_resolver * Univ.Constraint.t val translate_mse : env -> ModPath.t option -> inline -> module_struct_entry -> @@ -51,7 +51,7 @@ val translate_mse : val finalize_module : env -> ModPath.t -> (module_expression option) translation -> (module_type_entry * inline) option -> - module_body + module_body * Univ.Constraint.t (** [translate_mse_incl] translate the mse of a module or module type given to an Include *) diff --git a/kernel/modops.ml b/kernel/modops.ml index 301af328e4..77ef38dfd5 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -225,8 +225,7 @@ and subst_body : 'a. _ -> _ -> (_ -> 'a -> 'a) -> _ -> 'a generic_module_body -> && retro==retro' && delta'==mb.mod_delta then mb else - { mb with - mod_mp = mp'; + { mod_mp = mp'; mod_expr = me'; mod_type = ty'; mod_type_alg = aty'; diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml index 9ed0f6f411..02ee501f5f 100644 --- a/kernel/nativelambda.ml +++ b/kernel/nativelambda.ml @@ -474,7 +474,7 @@ let rec lambda_of_constr cache env sigma c = | Evar (evk,args as ev) -> (match evar_value sigma ev with | None -> - let args = Array.map (lambda_of_constr cache env sigma) args in + let args = Array.map_of_list (fun c -> lambda_of_constr cache env sigma c) args in Levar(evk, args) | Some t -> lambda_of_constr cache env sigma t) diff --git a/kernel/reduction.ml b/kernel/reduction.ml index 7574d7b21e..4ff90dd70d 100644 --- a/kernel/reduction.ml +++ b/kernel/reduction.ml @@ -367,9 +367,9 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv = let el1 = el_stack lft1 v1 in let el2 = el_stack lft2 v2 in let cuniv = convert_stacks l2r infos lft1 lft2 v1 v2 cuniv in - convert_vect l2r infos el1 el2 - (Array.map (mk_clos env1) args1) - (Array.map (mk_clos env2) args2) cuniv + convert_list l2r infos el1 el2 + (List.map (mk_clos env1) args1) + (List.map (mk_clos env2) args2) cuniv else raise NotConvertible (* 2 index known to be bound to no constant *) @@ -702,6 +702,13 @@ and convert_branches l2r infos ci e1 e2 lft1 lft2 br1 br2 cuniv = in Array.fold_right3 fold ci.ci_cstr_nargs br1 br2 cuniv +and convert_list l2r infos lft1 lft2 v1 v2 cuniv = match v1, v2 with +| [], [] -> cuniv +| c1 :: v1, c2 :: v2 -> + let cuniv = ccnv CONV l2r infos lft1 lft2 c1 c2 cuniv in + convert_list l2r infos lft1 lft2 v1 v2 cuniv +| _, _ -> raise NotConvertible + let clos_gen_conv trans cv_pb l2r evars env univs t1 t2 = let reds = CClosure.RedFlags.red_add_transparent betaiotazeta trans in let infos = create_clos_infos ~evars reds env in diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index 58b516dfdd..93337fca5d 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -116,6 +116,7 @@ type module_parameters = (MBId.t * module_type_body) list type compiled_library = { comp_name : DirPath.t; comp_mod : module_body; + comp_univs : Univ.ContextSet.t; comp_deps : library_info array; comp_enga : engagement; comp_natsymbs : Nativevalues.symbols @@ -243,8 +244,6 @@ let set_native_compiler b senv = let flags = Environ.typing_flags senv.env in set_typing_flags { flags with enable_native_compiler = b } senv -let make_sprop_cumulative senv = { senv with env = Environ.make_sprop_cumulative senv.env } - let set_allow_sprop b senv = { senv with env = Environ.set_allow_sprop b senv.env } (** Check that the engagement [c] expected by a library matches @@ -566,8 +565,7 @@ let constraints_of_sfb sfb = match sfb with | SFBconst cb -> globalize_constant_universes cb | SFBmind mib -> globalize_mind_universes mib - | SFBmodtype mtb -> [mtb.mod_constraints] - | SFBmodule mb -> [mb.mod_constraints] + | SFBmodtype _ | SFBmodule _ -> [] let add_retroknowledge pttc senv = { senv with @@ -986,35 +984,35 @@ let add_mind l mie senv = let add_modtype l params_mte inl senv = let mp = MPdot(senv.modpath, l) in - let mtb = Mod_typing.translate_modtype senv.env mp inl params_mte in + let mtb, cst = Mod_typing.translate_modtype senv.env mp inl params_mte in + let senv = push_context_set ~strict:true (Univ.LSet.empty,cst) senv in let mtb = Declareops.hcons_module_type mtb in - let senv' = add_field (l,SFBmodtype mtb) MT senv in - mp, senv' + let senv = add_field (l,SFBmodtype mtb) MT senv in + mp, senv (** full_add_module adds module with universes and constraints *) let full_add_module mb senv = - let senv = add_constraints (Now mb.mod_constraints) senv in let dp = ModPath.dp mb.mod_mp in let linkinfo = Nativecode.link_info_of_dirpath dp in { senv with env = Modops.add_linked_module mb linkinfo senv.env } let full_add_module_type mp mt senv = - let senv = add_constraints (Now mt.mod_constraints) senv in { senv with env = Modops.add_module_type mp mt senv.env } (** Insertion of modules *) let add_module l me inl senv = let mp = MPdot(senv.modpath, l) in - let mb = Mod_typing.translate_module senv.env mp inl me in + let mb, cst = Mod_typing.translate_module senv.env mp inl me in + let senv = push_context_set ~strict:true (Univ.LSet.empty,cst) senv in let mb = Declareops.hcons_module_body mb in - let senv' = add_field (l,SFBmodule mb) M senv in - let senv'' = - if Modops.is_functor mb.mod_type then senv' - else update_resolver (Mod_subst.add_delta_resolver mb.mod_delta) senv' + let senv = add_field (l,SFBmodule mb) M senv in + let senv = + if Modops.is_functor mb.mod_type then senv + else update_resolver (Mod_subst.add_delta_resolver mb.mod_delta) senv in - (mp,mb.mod_delta),senv'' + (mp,mb.mod_delta),senv (** {6 Starting / ending interactive modules and module types } *) @@ -1046,7 +1044,8 @@ let start_modtype l senv = let add_module_parameter mbid mte inl senv = let () = check_empty_struct senv in let mp = MPbound mbid in - let mtb = Mod_typing.translate_modtype senv.env mp inl ([],mte) in + let mtb, cst = Mod_typing.translate_modtype senv.env mp inl ([],mte) in + let senv = push_context_set ~strict:true (Univ.LSet.empty,cst) senv in let senv = full_add_module_type mp mtb senv in let new_variant = match senv.modvariant with | STRUCT (params,oldenv) -> STRUCT ((mbid,mtb) :: params, oldenv) @@ -1084,12 +1083,12 @@ let functorize_module params mb = let build_module_body params restype senv = let struc = NoFunctor (List.rev senv.revstruct) in let restype' = Option.map (fun (ty,inl) -> (([],ty),inl)) restype in - let mb = + let mb, cst = Mod_typing.finalize_module senv.env senv.modpath - (struc,None,senv.modresolver,senv.univ) restype' + (struc,None,senv.modresolver,Univ.Constraint.empty) restype' in let mb' = functorize_module params mb in - { mb' with mod_retroknowledge = ModBodyRK senv.local_retroknowledge } + { mb' with mod_retroknowledge = ModBodyRK senv.local_retroknowledge }, cst (** Returning back to the old pre-interactive-module environment, with one extra component and some updated fields @@ -1129,15 +1128,13 @@ let end_module l restype senv = let () = check_current_label l mp in let () = check_empty_context senv in let mbids = List.rev_map fst params in - let mb = build_module_body params restype senv in + let mb, cst = build_module_body params restype senv in + let senv = push_context_set ~strict:true (Univ.LSet.empty,cst) senv in let newenv = Environ.set_opaque_tables oldsenv.env (Environ.opaque_tables senv.env) in let newenv = Environ.set_native_symbols newenv senv.env.Environ.native_symbols in let newenv = set_engagement_opt newenv senv.engagement in - let senv'= - propagate_loads { senv with - env = newenv; - univ = Univ.ContextSet.union senv.univ mb.mod_constraints} in - let newenv = Environ.push_context_set ~strict:true mb.mod_constraints senv'.env in + let newenv = Environ.set_universes (Environ.universes senv.env) newenv in + let senv' = propagate_loads { senv with env = newenv } in let newenv = Modops.add_module mb newenv in let newresolver = if Modops.is_functor mb.mod_type then oldsenv.modresolver @@ -1146,12 +1143,11 @@ let end_module l restype senv = (mp,mbids,mb.mod_delta), propagate_senv (l,SFBmodule mb) newenv newresolver senv' oldsenv -let build_mtb mp sign cst delta = +let build_mtb mp sign delta = { mod_mp = mp; mod_expr = (); mod_type = sign; mod_type_alg = None; - mod_constraints = cst; mod_delta = delta; mod_retroknowledge = ModTypeRK } @@ -1163,11 +1159,11 @@ let end_modtype l senv = let mbids = List.rev_map fst params in let newenv = Environ.set_opaque_tables oldsenv.env (Environ.opaque_tables senv.env) in let newenv = Environ.set_native_symbols newenv senv.env.Environ.native_symbols in - let newenv = Environ.push_context_set ~strict:true senv.univ newenv in let newenv = set_engagement_opt newenv senv.engagement in + let newenv = Environ.set_universes (Environ.universes senv.env) newenv in let senv' = propagate_loads {senv with env=newenv} in let auto_tb = functorize params (NoFunctor (List.rev senv.revstruct)) in - let mtb = build_mtb mp auto_tb senv'.univ senv.modresolver in + let mtb = build_mtb mp auto_tb senv.modresolver in let newenv = Environ.add_modtype mtb senv'.env in let newresolver = oldsenv.modresolver in (mp,mbids), @@ -1181,7 +1177,7 @@ let add_include me is_module inl senv = let sign,(),resolver,cst = translate_mse_incl is_module senv.env mp_sup inl me in - let senv = add_constraints (Now cst) senv in + let senv = push_context_set ~strict:true (Univ.LSet.empty,cst) senv in (* Include Self support *) let rec compute_sign sign mb resolver senv = match sign with @@ -1201,7 +1197,7 @@ let add_include me is_module inl senv = in let resolver,str,senv = let struc = NoFunctor (List.rev senv.revstruct) in - let mtb = build_mtb mp_sup struc Univ.ContextSet.empty senv.modresolver in + let mtb = build_mtb mp_sup struc senv.modresolver in compute_sign sign mtb resolver senv in let senv = update_resolver (Mod_subst.add_delta_resolver resolver) senv @@ -1223,6 +1219,8 @@ let add_include me is_module inl senv = let module_of_library lib = lib.comp_mod +let univs_of_library lib = lib.comp_univs + type native_library = Nativecode.global list (** FIXME: MS: remove?*) @@ -1251,7 +1249,6 @@ let export ?except ~output_native_objects senv dir = mod_expr = FullStruct; mod_type = str; mod_type_alg = None; - mod_constraints = senv.univ; mod_delta = senv.modresolver; mod_retroknowledge = ModBodyRK senv.local_retroknowledge } @@ -1264,6 +1261,7 @@ let export ?except ~output_native_objects senv dir = let lib = { comp_name = dir; comp_mod = mb; + comp_univs = senv.univ; comp_deps = Array.of_list (DPmap.bindings senv.required); comp_enga = Environ.engagement senv.env; comp_natsymbs = symbols } @@ -1271,7 +1269,7 @@ let export ?except ~output_native_objects senv dir = mp, lib, ast (* cst are the constraints that were computed by the vi2vo step and hence are - * not part of the mb.mod_constraints field (but morally should be) *) + * not part of the [lib.comp_univs] field (but morally should be) *) let import lib cst vodigest senv = check_required senv.required lib.comp_deps; check_engagement senv.env lib.comp_enga; @@ -1281,8 +1279,8 @@ let import lib cst vodigest senv = let mp = MPfile lib.comp_name in let mb = lib.comp_mod in let env = Environ.push_context_set ~strict:true - (Univ.ContextSet.union mb.mod_constraints cst) - senv.env + (Univ.ContextSet.union lib.comp_univs cst) + senv.env in let env = let linkinfo = Nativecode.link_info_of_dirpath lib.comp_name in diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index b42746a882..b601279e87 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -135,7 +135,6 @@ val set_check_positive : bool -> safe_transformer0 val set_check_universes : bool -> safe_transformer0 val set_VM : bool -> safe_transformer0 val set_native_compiler : bool -> safe_transformer0 -val make_sprop_cumulative : safe_transformer0 val set_allow_sprop : bool -> safe_transformer0 val check_engagement : Environ.env -> Declarations.set_predicativity -> unit @@ -195,6 +194,7 @@ type compiled_library type native_library = Nativecode.global list val module_of_library : compiled_library -> Declarations.module_body +val univs_of_library : compiled_library -> Univ.ContextSet.t val start_library : DirPath.t -> ModPath.t safe_transformer diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 3f81a62956..28baa82666 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -336,7 +336,6 @@ and check_modtypes cst env mtb1 mtb2 subst1 subst2 equiv = mod_expr = Abstract; mod_type = subst_signature subst1 body_t1; mod_type_alg = None; - mod_constraints = mtb1.mod_constraints; mod_retroknowledge = ModBodyRK []; mod_delta = mtb1.mod_delta} env in @@ -347,7 +346,6 @@ and check_modtypes cst env mtb1 mtb2 subst1 subst2 equiv = let check_subtypes env sup super = let env = add_module_type sup.mod_mp sup env in - let env = Environ.push_context_set ~strict:true super.mod_constraints env in check_modtypes Univ.Constraint.empty env (strengthen sup sup.mod_mp) super empty_subst (map_mp super.mod_mp sup.mod_mp sup.mod_delta) false diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml index 449cd0f0f9..5f5f0ef8cd 100644 --- a/kernel/uGraph.ml +++ b/kernel/uGraph.ml @@ -37,7 +37,7 @@ let g_map f g = if g.graph == g' then g else {g with graph=g'} -let make_sprop_cumulative g = {g with sprop_cumulative=true} +let set_cumulative_sprop b g = {g with sprop_cumulative=b} let check_smaller_expr g (u,n) (v,m) = let diff = n - m in diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli index 8a8c09e911..8d9afb0990 100644 --- a/kernel/uGraph.mli +++ b/kernel/uGraph.mli @@ -13,8 +13,8 @@ open Univ (** {6 Graphs of universes. } *) type t -val make_sprop_cumulative : t -> t -(** Don't use this in the kernel, it makes the system incomplete. *) +val set_cumulative_sprop : bool -> t -> t +(** Makes the system incomplete. *) type 'a check_function = t -> 'a -> 'a -> bool diff --git a/lib/lib.mllib b/lib/lib.mllib index 2db59712b9..4e08e87084 100644 --- a/lib/lib.mllib +++ b/lib/lib.mllib @@ -14,6 +14,7 @@ CWarnings AcyclicGraph Rtree System +ObjFile Explore CProfile Future diff --git a/lib/objFile.ml b/lib/objFile.ml new file mode 100644 index 0000000000..96db51a010 --- /dev/null +++ b/lib/objFile.ml @@ -0,0 +1,229 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +open Pp +open System + +let magic_number = 0x436F7121l (* "Coq!" *) + +let error_corrupted file s = + CErrors.user_err ~hdr:"System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.") + +let open_trapping_failure name = + try open_out_bin name + with e when CErrors.noncritical e -> + CErrors.user_err ~hdr:"System.open" (str "Can't open " ++ str name) + +(* + +int32: big-endian, 4 bytes +int64: big-endian, 8 bytes + +-- string -- +int32 | length of the next field +data | + +-- segment summary -- +string | name +int64 | absolute position +int64 | length (without hash) +hash | MD5 (16 bytes) + +-- segment -- +... | binary data +hash | MD5 (16 bytes) + +-- summary -- +int32 | number of segment summaries +s1 | +... | segment summaries +sn | + +-- vo -- +int32 | magic number +int32 | Coq version +int64 | absolute position of the summary +... | segments +summary | + +*) + +type segment = { + name : string; + pos : int64; + len : int64; + hash : Digest.t; +} + +type in_handle = { + in_filename : string; + in_channel : in_channel; + in_segments : segment CString.Map.t; +} + +type out_handle = { + out_filename : string; + out_channel : out_channel; + mutable out_segments : segment CString.Map.t; +} + +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 output_int32 ch n = + for i = 0 to 3 do + output_byte ch (Int32.to_int (Int32.shift_right_logical n (24 - 8 * i))) + done + +let output_int64 ch n = + for i = 0 to 7 do + output_byte ch (Int64.to_int (Int64.shift_right_logical n (56 - 8 * i))) + done + +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 } + +let output_segment_summary ch seg = + let nlen = Int32.of_int (String.length seg.name) in + let () = output_int32 ch nlen in + let () = output_string ch seg.name in + let () = output_int64 ch seg.pos in + let () = output_int64 ch seg.len in + let () = Digest.output ch seg.hash in + () + +let rec input_segment_summaries ch n accu = + if Int32.equal n 0l then accu + else + let s = input_segment_summary ch in + let accu = CString.Map.add s.name s accu in + input_segment_summaries ch (Int32.pred n) accu + +let marshal_in_segment (type a) h ~segment : a * Digest.t = + let { in_channel = ch } = h in + let s = CString.Map.find segment h.in_segments in + let () = LargeFile.seek_in ch s.pos in + let (v : a) = marshal_in h.in_filename ch in + let () = assert (Int64.equal (LargeFile.pos_in ch) (Int64.add s.pos s.len)) in + let h = Digest.input ch in + let () = assert (String.equal h s.hash) in + (v, s.hash) + +let marshal_out_segment h ~segment v = + let { out_channel = ch } = h in + let () = assert (not (CString.Map.mem segment h.out_segments)) in + let pos = LargeFile.pos_out ch in + let () = Marshal.to_channel ch v [] in + let () = flush ch in + let pos' = LargeFile.pos_out ch in + let len = Int64.sub pos' pos in + let hash = + let in_ch = open_in_bin h.out_filename in + let () = LargeFile.seek_in in_ch pos in + let digest = Digest.channel in_ch (Int64.to_int len) in + let () = close_in in_ch in + digest + in + let () = Digest.output ch hash in + let s = { name = segment; pos; len; hash } in + let () = h.out_segments <- CString.Map.add segment s h.out_segments in + () + +let marshal_out_binary h ~segment = + let { out_channel = ch } = h in + let () = assert (not (CString.Map.mem segment h.out_segments)) in + let pos = LargeFile.pos_out ch in + let finish () = + let () = flush ch in + let pos' = LargeFile.pos_out ch in + let len = Int64.sub pos' pos in + let hash = + let in_ch = open_in_bin h.out_filename in + let () = LargeFile.seek_in in_ch pos in + let digest = Digest.channel in_ch (Int64.to_int len) in + let () = close_in in_ch in + digest + in + let () = Digest.output ch hash in + let s = { name = segment; pos; len; hash } in + h.out_segments <- CString.Map.add segment s h.out_segments + in + ch, finish + +let open_in ~file = + try + let ch = open_in_bin file in + let magic = input_int32 ch in + let version = input_int32 ch in + let () = + if not (Int32.equal magic magic_number) then + let e = { filename = file; actual = version; expected = magic_number } in + raise (Bad_magic_number e) + in + let () = + let expected = Coq_config.vo_version in + if not (Int32.equal version expected) then + let e = { filename = file; actual = version; expected } in + raise (Bad_version_number e) + 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 CString.Map.empty in + { in_filename = file; in_channel = ch; in_segments = seg } + with + | End_of_file -> error_corrupted file "premature end of file" + | Failure s | Sys_error s -> error_corrupted file s + +let close_in ch = + close_in ch.in_channel + +let get_segment ch ~segment = + CString.Map.find segment ch.in_segments + +let segments ch = ch.in_segments + +let open_out ~file = + let ch = open_trapping_failure file in + let () = output_int32 ch magic_number in + let () = output_int32 ch Coq_config.vo_version in + let () = output_int64 ch 0L (* placeholder *) in + { out_channel = ch; out_segments = CString.Map.empty; out_filename = file } + +let close_out { out_channel = ch; out_segments = seg } = + let () = flush ch in + let pos = LargeFile.pos_out ch in + (* Write the segment summary *) + let () = output_int32 ch (Int32.of_int (CString.Map.cardinal seg)) in + let iter _ s = output_segment_summary ch s in + let () = CString.Map.iter iter seg in + (* Overwrite the position place holder *) + let () = LargeFile.seek_out ch 8L in + let () = output_int64 ch pos in + let () = flush ch in + close_out ch diff --git a/lib/objFile.mli b/lib/objFile.mli new file mode 100644 index 0000000000..b15b04ee54 --- /dev/null +++ b/lib/objFile.mli @@ -0,0 +1,37 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +val magic_number : int32 + +type segment = { + name : string; + pos : int64; + len : int64; + hash : Digest.t; +} + +type in_handle +type out_handle + +val open_in : file:string -> in_handle +val close_in : in_handle -> unit +val marshal_in_segment : in_handle -> segment:string -> 'a * Digest.t +val get_segment : in_handle -> segment:string -> segment +val segments : in_handle -> segment CString.Map.t + +val open_out : file:string -> out_handle +val close_out : out_handle -> unit +val marshal_out_segment : out_handle -> segment:string -> 'a -> unit +val marshal_out_binary : out_handle -> segment:string -> out_channel * (unit -> unit) +(** [marshal_out_binary oh segment] is a low level, stateful, API returning + [oc, stop]. Once called no other API can be used on the same [oh] and only + [Stdlib.output_*] APIs should be used on [oc]. [stop ()] must be invoked in + order to signal that all data was written to [oc] (which should not be used + afterwards). Only after calling [stop] the other API can be used on [oh]. *) diff --git a/lib/system.ml b/lib/system.ml index d7f5fa26ab..4e98651d6e 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -182,36 +182,9 @@ let marshal_in filename ch = | End_of_file -> error_corrupted filename "premature end of file" | Failure s -> error_corrupted filename s -let digest_out = Digest.output -let digest_in filename ch = - try Digest.input ch - with - | End_of_file -> error_corrupted filename "premature end of file" - | Failure s -> error_corrupted filename s - -let marshal_out_segment f ch v = - let start = pos_out ch in - output_binary_int ch 0; (* dummy value for stop *) - marshal_out ch v; - let stop = pos_out ch in - seek_out ch start; - output_binary_int ch stop; - seek_out ch stop; - digest_out ch (Digest.file f) - -let marshal_in_segment f ch = - let stop = (input_binary_int f ch : int) in - let v = marshal_in f ch in - let digest = digest_in f ch in - v, stop, digest - -let skip_in_segment f ch = - let stop = (input_binary_int f ch : int) in - seek_in ch stop; - stop, digest_in f ch - -type magic_number_error = {filename: string; actual: int; expected: int} +type magic_number_error = {filename: string; actual: int32; expected: int32} exception Bad_magic_number of magic_number_error +exception Bad_version_number of magic_number_error let raw_extern_state magic filename = let channel = open_trapping_failure filename in @@ -225,8 +198,8 @@ let raw_intern_state magic filename = if not (Int.equal actual_magic magic) then raise (Bad_magic_number { filename=filename; - actual=actual_magic; - expected=magic}); + actual=Int32.of_int actual_magic; + expected=Int32.of_int magic}); channel with | End_of_file -> error_corrupted filename "premature end of file" @@ -256,10 +229,14 @@ let intern_state magic filename = let with_magic_number_check f a = try f a - with Bad_magic_number {filename=fname;actual=actual;expected=expected} -> + with + | Bad_magic_number {filename=fname; _} -> + CErrors.user_err ~hdr:"with_magic_number_check" + (str"File " ++ str fname ++ strbrk" is corrupted.") + | Bad_version_number {filename=fname;actual=actual;expected=expected} -> CErrors.user_err ~hdr:"with_magic_number_check" - (str"File " ++ str fname ++ strbrk" has bad magic number " ++ - int actual ++ str" (expected " ++ int expected ++ str")." ++ + (str"File " ++ str fname ++ strbrk" has bad version number " ++ + (str @@ Int32.to_string actual) ++ str" (expected " ++ (str @@ Int32.to_string expected) ++ str")." ++ spc () ++ strbrk "It is corrupted or was compiled with another version of Coq.") diff --git a/lib/system.mli b/lib/system.mli index 00701379bd..4a8c35b6ea 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -68,8 +68,9 @@ val file_exists_respecting_case : string -> string -> bool when the check fails, with the full file name and expected/observed magic numbers. *) -type magic_number_error = {filename: string; actual: int; expected: int} +type magic_number_error = {filename: string; actual: int32; expected: int32} exception Bad_magic_number of magic_number_error +exception Bad_version_number of magic_number_error val raw_extern_state : int -> string -> out_channel @@ -87,15 +88,6 @@ val with_magic_number_check : ('a -> 'b) -> 'a -> 'b val marshal_out : out_channel -> 'a -> unit val marshal_in : string -> in_channel -> 'a -(** Clones of Digest.output and Digest.input (with nice error message) *) - -val digest_out : out_channel -> Digest.t -> unit -val digest_in : string -> in_channel -> Digest.t - -val marshal_out_segment : string -> out_channel -> 'a -> unit -val marshal_in_segment : string -> in_channel -> 'a * int * Digest.t -val skip_in_segment : string -> in_channel -> int * Digest.t - (** {6 Time stamps.} *) type time diff --git a/library/global.ml b/library/global.ml index abc04a5e14..5c847fda96 100644 --- a/library/global.ml +++ b/library/global.ml @@ -99,7 +99,9 @@ let set_check_guarded c = globalize0 (Safe_typing.set_check_guarded c) let set_check_positive c = globalize0 (Safe_typing.set_check_positive c) let set_check_universes c = globalize0 (Safe_typing.set_check_universes c) let typing_flags () = Environ.typing_flags (env ()) -let make_sprop_cumulative () = globalize0 Safe_typing.make_sprop_cumulative +let set_cumulative_sprop b = + set_typing_flags {(typing_flags()) with Declarations.cumulative_sprop = b} +let is_cumulative_sprop () = (typing_flags()).Declarations.cumulative_sprop let set_allow_sprop b = globalize0 (Safe_typing.set_allow_sprop b) let sprop_allowed () = Environ.sprop_allowed (env()) let export_private_constants cd = globalize (Safe_typing.export_private_constants cd) diff --git a/library/global.mli b/library/global.mli index e7133a1034..2acd7e2a67 100644 --- a/library/global.mli +++ b/library/global.mli @@ -36,7 +36,8 @@ val set_check_guarded : bool -> unit val set_check_positive : bool -> unit val set_check_universes : bool -> unit val typing_flags : unit -> Declarations.typing_flags -val make_sprop_cumulative : unit -> unit +val set_cumulative_sprop : bool -> unit +val is_cumulative_sprop : unit -> bool val set_allow_sprop : bool -> unit val sprop_allowed : unit -> bool diff --git a/library/goptions.ml b/library/goptions.ml index 1418407533..f096c5d749 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -24,6 +24,10 @@ type option_value = | StringValue of string | StringOptValue of string option +type table_value = + | StringRefValue of string + | QualidRefValue of qualid + (** Summary of an option status *) type option_state = { opt_depr : bool; @@ -35,8 +39,13 @@ type option_state = { let nickname table = String.concat " " table +let error_no_table_of_this_type ~kind key = + user_err ~hdr:"Goptions" + (str ("There is no " ^ kind ^ "-valued table with this name: \"" ^ nickname key ^ "\".")) + let error_undeclared_key key = - user_err ~hdr:"Goptions" (str (nickname key) ++ str ": no table or option of this type") + user_err ~hdr:"Goptions" + (str ("There is no flag, option or table with this name: \"" ^ nickname key ^ "\".")) (****************************************************************************) (* 1- Tables *) @@ -184,6 +193,23 @@ end module MakeRefTable = functor (A : RefConvertArg) -> MakeTable (RefConvert(A)) +type iter_table_aux = { aux : 'a. 'a table_of_A -> Environ.env -> 'a -> unit } + +let iter_table f key lv = + let aux = function + | StringRefValue s -> + begin + try f.aux (get_string_table key) (Global.env()) s + with Not_found -> error_no_table_of_this_type ~kind:"string" key + end + | QualidRefValue locqid -> + begin + try f.aux (get_ref_table key) (Global.env()) locqid + with Not_found -> error_no_table_of_this_type ~kind:"qualid" key + end + in + List.iter aux lv + (****************************************************************************) (* 2- Flags. *) @@ -387,9 +413,10 @@ let declare_interpreted_string_option_and_ref ~depr ~key ~(value:'a) from_string (* Setting values of options *) let warn_unknown_option = - CWarnings.create ~name:"unknown-option" ~category:"option" - (fun key -> strbrk "There is no option " ++ - str (nickname key) ++ str ".") + CWarnings.create + ~name:"unknown-option" ~category:"option" + (fun key -> strbrk "There is no flag or option with this name: \"" ++ + str (nickname key) ++ str "\".") let set_option_value ?(locality = OptDefault) check_and_cast key v = let opt = try Some (get_option key) with Not_found -> None in @@ -398,38 +425,38 @@ let set_option_value ?(locality = OptDefault) check_and_cast key v = | Some (depr, (read,write,append)) -> write locality (check_and_cast v (read ())) -let show_value_type = function - | BoolValue _ -> "bool" - | IntValue _ -> "int" - | StringValue _ -> "string" - | StringOptValue _ -> "string" - -let bad_type_error opt_value actual_type = +let bad_type_error ~expected ~got = user_err Pp.(str "Bad type of value for this option:" ++ spc() ++ - str "expected " ++ str (show_value_type opt_value) ++ - str ", got " ++ str actual_type ++ str ".") + str "expected " ++ str expected ++ + str ", got " ++ str got ++ str ".") + +let error_flag () = + user_err Pp.(str "This is a flag. It does not take a value.") let check_int_value v = function + | BoolValue _ -> error_flag () | IntValue _ -> IntValue v - | optv -> bad_type_error optv "int" + | StringValue _ | StringOptValue _ -> + bad_type_error ~expected:"string" ~got:"int" let check_bool_value v = function | BoolValue _ -> BoolValue v - | optv -> bad_type_error optv "bool" + | _ -> user_err Pp.(str "This is an option. A value must be provided.") let check_string_value v = function + | BoolValue _ -> error_flag () + | IntValue _ -> bad_type_error ~expected:"int" ~got:"string" | StringValue _ -> StringValue v | StringOptValue _ -> StringOptValue (Some v) - | optv -> bad_type_error optv "string" let check_unset_value v = function | BoolValue _ -> BoolValue false | IntValue _ -> IntValue None | StringOptValue _ -> StringOptValue None - | optv -> bad_type_error optv "nothing" + | StringValue _ -> user_err Pp.(str "This option does not support the \"Unset\" command.") (* Nota: For compatibility reasons, some errors are treated as - warning. This allows a script to refer to an option that doesn't + warnings. This allows a script to refer to an option that doesn't exist anymore *) let set_int_option_value_gen ?locality = diff --git a/library/goptions.mli b/library/goptions.mli index 336cae420c..150954cbac 100644 --- a/library/goptions.mli +++ b/library/goptions.mli @@ -187,6 +187,10 @@ type option_value = | StringValue of string | StringOptValue of string option +type table_value = + | StringRefValue of string + | QualidRefValue of qualid + val set_option_value : ?locality:option_locality -> ('a -> option_value -> option_value) -> option_name -> 'a -> unit (** [set_option_value ?locality f name v] sets [name] to the result of @@ -204,4 +208,7 @@ type option_state = { val get_tables : unit -> option_state OptionMap.t val print_tables : unit -> Pp.t +type iter_table_aux = { aux : 'a. 'a table_of_A -> Environ.env -> 'a -> unit } +val iter_table : iter_table_aux -> option_name -> table_value list -> unit + val error_undeclared_key : option_name -> 'a diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml index 020ab9307d..52c6c5d0f9 100644 --- a/plugins/btauto/refl_btauto.ml +++ b/plugins/btauto/refl_btauto.ml @@ -164,14 +164,17 @@ module Btauto = struct let reify env t = lapp eval [|convert_env env; convert t|] - let print_counterexample p penv gl = + let print_counterexample p penv = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in let var = lapp witness [|p|] in let var = EConstr.of_constr var in (* Compute an assignment that dissatisfies the goal *) - let redfun, _ = Redexpr.reduction_of_red_expr (Refiner.pf_env gl) Genredexpr.(CbvVm None) in - let _, var = redfun Refiner.(pf_env gl) Refiner.(project gl) var in + let redfun, _ = Redexpr.reduction_of_red_expr env Genredexpr.(CbvVm None) in + let _, var = redfun env sigma var in let var = EConstr.Unsafe.to_constr var in - let rec to_list l = match decomp_term (Tacmach.project gl) l with + let rec to_list l = match decomp_term sigma l with | App (c, _) when c === (Lazy.force CoqList._nil) -> [] | App (c, [|_; h; t|]) @@ -196,7 +199,6 @@ module Btauto = struct let assign = List.combine penv var in let map_msg (key, v) = let b = if v then str "true" else str "false" in - let sigma, env = Tacmach.project gl, Tacmach.pf_env gl in let term = Printer.pr_constr_env env sigma key in term ++ spc () ++ str ":=" ++ spc () ++ b in @@ -205,7 +207,8 @@ module Btauto = struct str "Not a tautology:" ++ spc () ++ l with e when CErrors.noncritical e -> (str "Not a tautology") in - Tacticals.tclFAIL 0 msg gl + Tacticals.New.tclFAIL 0 msg + end let try_unification env = Proofview.Goal.enter begin fun gl -> @@ -216,7 +219,7 @@ module Btauto = struct match t with | App (c, [|typ; p; _|]) when c === eq -> (* should be an equality [@eq poly ?p (Cst false)] *) - let tac = Tacticals.New.tclORELSE0 Tactics.reflexivity (Proofview.V82.tactic (print_counterexample p env)) in + let tac = Tacticals.New.tclORELSE0 Tactics.reflexivity (print_counterexample p env) in tac | _ -> let msg = str "Btauto: Internal error" in diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml index 02383799a9..f7d78551d8 100644 --- a/plugins/extraction/extract_env.ml +++ b/plugins/extraction/extract_env.ml @@ -163,7 +163,8 @@ let expand_mexpr env mpo me = let expand_modtype env mp me = let inl = Some (Flags.get_inline_level()) in - Mod_typing.translate_modtype env mp inl ([],me) + let mtb, _cst = Mod_typing.translate_modtype env mp inl ([],me) in + mtb let no_delta = Mod_subst.empty_delta_resolver diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml index 7b2ce671a3..f4200854c2 100644 --- a/plugins/funind/functional_principles_proofs.ml +++ b/plugins/funind/functional_principles_proofs.ml @@ -41,7 +41,10 @@ let observe_tac s = observe_tac (fun _ _ -> Pp.str s) let finish_proof dynamic_infos g = observe_tac "finish" (Proofview.V82.of_tactic assumption) g -let refine c = Refiner.refiner ~check:true EConstr.Unsafe.(to_constr c) +let refine c = + Proofview.V82.of_tactic + (Refiner.refiner ~check:true EConstr.Unsafe.(to_constr c)) + let thin l = Proofview.V82.of_tactic (Tactics.clear l) let eq_constr sigma u v = EConstr.eq_constr_nounivs sigma u v diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml index eec78391af..c53dcc7edd 100644 --- a/plugins/funind/gen_principle.ml +++ b/plugins/funind/gen_principle.ml @@ -46,7 +46,7 @@ let build_newrecursive lnameargsardef = Constrintern.interp_context_evars ~program_mode:false env evd binders in let impl = - Constrintern.compute_internalization_data env0 evd + Constrintern.compute_internalization_data env0 evd recname Constrintern.Recursive arity impls' in let open Context.Named.Declaration in @@ -159,7 +159,7 @@ let recompute_binder_list fixpoint_exprl = fixpoint_exprl in let (_, _, _, typel), _, ctx, _ = - ComFixpoint.interp_fixpoint ~cofix:false fixl + ComFixpoint.interp_fixpoint ~check_recursivity:false ~cofix:false fixl in let constr_expr_typel = with_full_print @@ -191,61 +191,35 @@ let prepare_body {Vernacexpr.binders} rt = let fun_args, rt' = chop_rlambda_n n rt in (fun_args, rt') -let build_functional_principle ?(opaque = Declare.Transparent) - (evd : Evd.evar_map ref) old_princ_type sorts funs _i proof_tac hook = +let build_functional_principle (sigma : Evd.evar_map) old_princ_type sorts funs + _i proof_tac hook = (* First we get the type of the old graph principle *) let mutr_nparams = - (Tactics.compute_elim_sig !evd (EConstr.of_constr old_princ_type)) + (Tactics.compute_elim_sig sigma (EConstr.of_constr old_princ_type)) .Tactics.nparams in - (* let time1 = System.get_time () in *) let new_principle_type = Functional_principles_types.compute_new_princ_type_from_rel (Array.map Constr.mkConstU funs) sorts old_princ_type in - (* let time2 = System.get_time () in *) - (* Pp.msgnl (str "computing principle type := " ++ System.fmt_time_difference time1 time2); *) - let new_princ_name = - Namegen.next_ident_away_in_goal - (Id.of_string "___________princ_________") - Id.Set.empty - in let sigma, _ = - Typing.type_of ~refresh:true (Global.env ()) !evd - (EConstr.of_constr new_principle_type) - in - evd := sigma; - let hook = DeclareDef.Hook.make (hook new_principle_type) in - let lemma = - Lemmas.start_lemma ~name:new_princ_name ~poly:false !evd + Typing.type_of ~refresh:true (Global.env ()) sigma (EConstr.of_constr new_principle_type) in - (* let _tim1 = System.get_time () in *) let map (c, u) = EConstr.mkConstU (c, EConstr.EInstance.make u) in - let lemma, _ = - Lemmas.by - (Proofview.V82.tactic (proof_tac (Array.map map funs) mutr_nparams)) - lemma + let ftac = + Proofview.V82.tactic (proof_tac (Array.map map funs) mutr_nparams) in - (* let _tim2 = System.get_time () in *) - (* begin *) - (* let dur1 = System.time_difference tim1 tim2 in *) - (* Pp.msgnl (str ("Time to compute proof: ") ++ str (string_of_float dur1)); *) - (* end; *) - let {Declare.entries} = - Lemmas.pf_fold - (Declare.close_proof ~opaque ~keep_body_ucst_separate:false) - lemma + let env = Global.env () in + let uctx = Evd.evar_universe_context sigma in + let typ = EConstr.of_constr new_principle_type in + let body, typ, univs, _safe, _uctx = + Declare.build_by_tactic env ~uctx ~poly:false ~typ ftac in - match entries with - | [entry] -> (entry, hook) - | _ -> - CErrors.anomaly - Pp.( - str - "[build_functional_principle] close_proof returned more than one \ - proof term") + (* uctx was ignored before *) + let hook = DeclareDef.Hook.make (hook new_principle_type) in + (body, typ, univs, hook, sigma) let change_property_sort evd toSort princ princName = let open Context.Rel.Declaration in @@ -333,14 +307,16 @@ let generate_functional_principle (evd : Evd.evar_map ref) old_princ_type sorts register_with_sort Sorts.InProp; register_with_sort Sorts.InSet ) in - let entry, hook = - build_functional_principle evd old_princ_type new_sorts funs i proof_tac + let body, types, univs, hook, sigma0 = + build_functional_principle !evd old_princ_type new_sorts funs i proof_tac hook in + evd := sigma0; (* Pr 1278 : Don't forget to close the goal if an error is raised !!!! *) let uctx = Evd.evar_universe_context sigma in + let entry = Declare.definition_entry ~univs ?types body in let (_ : Names.GlobRef.t) = DeclareDef.declare_entry ~name:new_princ_name ~hook ~scope:(DeclareDef.Global Declare.ImportDefaultBehavior) @@ -1334,8 +1310,7 @@ let get_funs_constant mp = in l_const -let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : - Evd.side_effects Declare.proof_entry list = +let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : _ list = let exception Found_type of int in let env = Global.env () in let funs = List.map fst fas in @@ -1402,18 +1377,19 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : if Declareops.is_opaque (Global.lookup_constant equation) then Opaque else Transparent in - let entry, _hook = + let body, typ, univs, _hook, sigma0 = try - build_functional_principle ~opaque evd first_type (Array.of_list sorts) + build_functional_principle !evd first_type (Array.of_list sorts) this_block_funs 0 (Functional_principles_proofs.prove_princ_for_struct evd false 0 (Array.of_list (List.map fst funs))) (fun _ _ -> ()) with e when CErrors.noncritical e -> raise (Defining_principle e) in + evd := sigma0; incr i; (* The others are just deduced *) - if List.is_empty other_princ_types then [entry] + if List.is_empty other_princ_types then [(body, typ, univs, opaque)] else let other_fun_princ_types = let funs = Array.map Constr.mkConstU this_block_funs in @@ -1422,10 +1398,8 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : (Functional_principles_types.compute_new_princ_type_from_rel funs sorts) other_princ_types in - let first_princ_body = entry.Declare.proof_entry_body in - let ctxt, fix = - Term.decompose_lam_assum (fst (fst (Future.force first_princ_body))) - in + let first_princ_body = body in + let ctxt, fix = Term.decompose_lam_assum first_princ_body in (* the principle has for forall ...., fix .*) let (idxs, _), ((_, ta, _) as decl) = Constr.destFix fix in let other_result = @@ -1457,8 +1431,8 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : (* If we reach this point, the two principle are not mutually recursive We fall back to the previous method *) - let entry, _hook = - build_functional_principle evd + let body, typ, univs, _hook, sigma0 = + build_functional_principle !evd (List.nth other_princ_types (!i - 1)) (Array.of_list sorts) this_block_funs !i (Functional_principles_proofs.prove_princ_for_struct evd false @@ -1466,15 +1440,16 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : (Array.of_list (List.map fst funs))) (fun _ _ -> ()) in - entry + evd := sigma0; + (body, typ, univs, opaque) with Found_type i -> let princ_body = Termops.it_mkLambda_or_LetIn (Constr.mkFix ((idxs, i), decl)) ctxt in - Declare.definition_entry ~types:scheme_type princ_body) + (princ_body, Some scheme_type, univs, opaque)) other_fun_princ_types in - entry :: other_result + (body, typ, univs, opaque) :: other_result (* [derive_correctness funs graphs] create correctness and completeness lemmas for each function in [funs] w.r.t. [graphs] @@ -1527,11 +1502,8 @@ let derive_correctness (funs : Constr.pconstant list) (graphs : inductive list) with Not_found -> Array.of_list (List.map - (fun entry -> - ( EConstr.of_constr - (fst (fst (Future.force entry.Declare.proof_entry_body))) - , EConstr.of_constr (Option.get entry.Declare.proof_entry_type) - )) + (fun (body, typ, _opaque, _univs) -> + (EConstr.of_constr body, EConstr.of_constr (Option.get typ))) (make_scheme evd (Array.map_to_list (fun const -> (const, Sorts.InType)) funs))) in @@ -2225,11 +2197,14 @@ let build_scheme fas = in let bodies_types = make_scheme evd pconstants in List.iter2 - (fun (princ_id, _, _) def_entry -> - ignore - (Declare.declare_constant ~name:princ_id - ~kind:Decls.(IsProof Theorem) - (Declare.DefinitionEntry def_entry)); + (fun (princ_id, _, _) (body, types, univs, opaque) -> + let (_ : Constant.t) = + let opaque = if opaque = Declare.Opaque then true else false in + let def_entry = Declare.definition_entry ~univs ~opaque ?types body in + Declare.declare_constant ~name:princ_id + ~kind:Decls.(IsProof Theorem) + (Declare.DefinitionEntry def_entry) + in Declare.definition_message princ_id) fas bodies_types diff --git a/plugins/ltac/extratactics.mlg b/plugins/ltac/extratactics.mlg index 7754fe401e..0bad3cbe5b 100644 --- a/plugins/ltac/extratactics.mlg +++ b/plugins/ltac/extratactics.mlg @@ -312,7 +312,7 @@ let add_rewrite_hint ~poly bases ort t lcsr = if poly then ctx else (* This is a global universe context that shouldn't be refreshed at every use of the hint, declare it globally. *) - (Declare.declare_universe_context ~poly:false ctx; + (DeclareUctx.declare_universe_context ~poly:false ctx; Univ.ContextSet.empty) in CAst.make ?loc:(Constrexpr_ops.constr_loc ce) ((c, ctx), ort, Option.map (in_gen (rawwit wit_ltac)) t) in diff --git a/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg index e713ab13b2..5baa23b3e9 100644 --- a/plugins/ltac/g_ltac.mlg +++ b/plugins/ltac/g_ltac.mlg @@ -342,7 +342,7 @@ GRAMMAR EXTEND Gram hint: [ [ IDENT "Extern"; n = natural; c = OPT Constr.constr_pattern ; "=>"; tac = Pltac.tactic -> - { Hints.HintsExtern (n,c, in_tac tac) } ] ] + { ComHints.HintsExtern (n,c, in_tac tac) } ] ] ; operconstr: LEVEL "0" [ [ IDENT "ltac"; ":"; "("; tac = Pltac.tactic_expr; ")" -> diff --git a/tactics/leminv.ml b/plugins/ltac/leminv.ml index 5a8ec404ee..5a8ec404ee 100644 --- a/tactics/leminv.ml +++ b/plugins/ltac/leminv.ml diff --git a/tactics/leminv.mli b/plugins/ltac/leminv.mli index 5a5de7b58f..5a5de7b58f 100644 --- a/tactics/leminv.mli +++ b/plugins/ltac/leminv.mli diff --git a/plugins/ltac/ltac_plugin.mlpack b/plugins/ltac/ltac_plugin.mlpack index e83eab20dc..f31361279c 100644 --- a/plugins/ltac/ltac_plugin.mlpack +++ b/plugins/ltac/ltac_plugin.mlpack @@ -9,6 +9,7 @@ Tactic_debug Tacintern Profile_ltac Tactic_matching +Leminv Tacinterp Tacentries Evar_tactics diff --git a/plugins/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml index 14fab251d0..0dbf16a821 100644 --- a/plugins/ltac/profile_ltac.ml +++ b/plugins/ltac/profile_ltac.ml @@ -25,27 +25,20 @@ let is_profiling = Flags.profile_ltac let set_profiling b = is_profiling := b let get_profiling () = !is_profiling -(** LtacProf cannot yet handle backtracking into multi-success tactics. - To properly support this, we'd have to somehow recreate our location in the - call-stack, and stop/restart the intervening timers. This is tricky and - possibly expensive, so instead we currently just emit a warning that - profiling results will be off. *) -let encountered_multi_success_backtracking = ref false - -let warn_profile_backtracking = - CWarnings.create ~name:"profile-backtracking" ~category:"ltac" - (fun () -> strbrk "Ltac Profiler cannot yet handle backtracking \ - into multi-success tactics; profiling results may be wildly inaccurate.") - -let warn_encountered_multi_success_backtracking () = - if !encountered_multi_success_backtracking then - warn_profile_backtracking () - -let encounter_multi_success_backtracking () = - if not !encountered_multi_success_backtracking +let encountered_invalid_stack_no_self = ref false + +let warn_invalid_stack_no_self = + CWarnings.create ~name:"profile-invalid-stack-no-self" ~category:"ltac" + (fun () -> 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_multi_success_backtracking := true; - warn_encountered_multi_success_backtracking () + encountered_invalid_stack_no_self := true; + warn_invalid_stack_no_self () end @@ -76,8 +69,7 @@ module Local = Summary.Local let stack = Local.ref ~name:"LtacProf-stack" [empty_treenode root] let reset_profile_tmp () = - Local.(stack := [empty_treenode root]); - encountered_multi_success_backtracking := false + Local.(stack := [empty_treenode root]) (* ************** XML Serialization ********************* *) @@ -218,7 +210,6 @@ let to_string ~filter ?(cutoff=0.0) node = cumulate tree; !global in - warn_encountered_multi_success_backtracking (); let filter s n = filter s && (all_total <= 0.0 || n /. all_total >= cutoff /. 100.0) in let msg = h 0 (str "total time: " ++ padl 11 (format_sec (all_total))) ++ @@ -296,13 +287,15 @@ let exit_tactic ~count_call start_time c = match Local.(!stack) with | [] | [_] -> (* oops, our stack is invalid *) - encounter_multi_success_backtracking (); + encounter_invalid_stack_no_self (); reset_profile_tmp () | node :: (parent :: rest as full_stack) -> let name = string_of_call c in if not (String.equal name node.name) then (* oops, our stack is invalid *) - encounter_multi_success_backtracking (); + 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; @@ -332,38 +325,56 @@ let exit_tactic ~count_call start_time c = (* 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 -let tclFINALLY tac (finally : unit Proofview.tactic) = +(** [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 - Proofview.tclIFCATCH - tac - (fun v -> finally <*> Proofview.tclUNIT v) - (fun (exn, info) -> finally <*> Proofview.tclZERO ~info exn) + 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 s call_trace ?(count_call=true) tac = let open Proofview.Notations in - Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> - if !is_profiling then - match call_trace, Local.(!stack) with - | (_, c) :: _, parent :: rest -> - let name = string_of_call c in - let node = get_child name parent in - Local.(stack := node :: parent :: rest); - Some (time ()) - | _ :: _, [] -> assert false - | _ -> None - else None)) >>= function - | Some start_time -> - tclFINALLY - tac + (* 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 call_trace with - | (_, c) :: _ -> exit_tactic ~count_call start_time c - | [] -> ())))) - | None -> tac + if !is_profiling then + match call_trace, Local.(!stack) with + | (_, c) :: _, parent :: rest -> + let name = string_of_call c in + let node = get_child name parent in + Local.(stack := node :: parent :: rest); + Some (time ()) + | _ :: _, [] -> assert false + | _ -> None + else None))) + tac + (function + | Some start_time -> + (Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> + (match call_trace with + | (_, c) :: _ -> exit_tactic ~count_call start_time c + | [] -> ())))) + | None -> Proofview.tclUNIT ()) (* ************** Accumulation of data from workers ************************* *) @@ -396,6 +407,7 @@ let _ = | _ -> ())) let reset_profile () = + encountered_invalid_stack_no_self := false; reset_profile_tmp (); data := SM.empty diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index 35e131020b..3834b21a14 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -952,10 +952,11 @@ let fold_match env sigma c = then case_dep_scheme_kind_from_type else case_scheme_kind_from_type) in - let exists = Ind_tables.check_scheme sk ci.ci_ind in - if exists then - dep, pred, exists, Ind_tables.lookup_scheme sk ci.ci_ind - else raise Not_found + match Ind_tables.lookup_scheme sk ci.ci_ind with + | Some cst -> + dep, pred, true, cst + | None -> + raise Not_found in let app = let ind, args = Inductiveops.find_mrectype env sigma cty in @@ -1559,7 +1560,7 @@ let assert_replacing id newt tac = if Id.equal n id then ev' else mkVar n in let (e, _) = destEvar sigma ev in - (sigma, mkEvar (e, Array.map_of_list map nc)) + (sigma, mkEvar (e, List.map map nc)) end end in Proofview.tclTHEN prf (Proofview.tclFOCUS 2 2 tac) diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml index 7e4c4ce5c6..ee2c87d19a 100644 --- a/plugins/micromega/coq_micromega.ml +++ b/plugins/micromega/coq_micromega.ml @@ -128,249 +128,142 @@ let selecti s m = *) module M = struct (** - * Location of the Coq libraries. - *) - - let logic_dir = ["Coq"; "Logic"; "Decidable"] - - let mic_modules = - [ ["Coq"; "Lists"; "List"] - ; ["Coq"; "micromega"; "ZMicromega"] - ; ["Coq"; "micromega"; "Tauto"] - ; ["Coq"; "micromega"; "DeclConstant"] - ; ["Coq"; "micromega"; "RingMicromega"] - ; ["Coq"; "micromega"; "EnvRing"] - ; ["Coq"; "micromega"; "ZMicromega"] - ; ["Coq"; "micromega"; "RMicromega"] - ; ["Coq"; "micromega"; "Tauto"] - ; ["Coq"; "micromega"; "RingMicromega"] - ; ["Coq"; "micromega"; "EnvRing"] - ; ["Coq"; "QArith"; "QArith_base"] - ; ["Coq"; "Reals"; "Rdefinitions"] - ; ["Coq"; "Reals"; "Rpow_def"] - ; ["LRing_normalise"] ] - - [@@@ocaml.warning "-3"] - - let coq_modules = - Coqlib.( - init_modules @ [logic_dir] @ arith_modules @ zarith_base_modules - @ mic_modules) - - let bin_module = [["Coq"; "Numbers"; "BinNums"]] - - let r_modules = - [ ["Coq"; "Reals"; "Rdefinitions"] - ; ["Coq"; "Reals"; "Rpow_def"] - ; ["Coq"; "Reals"; "Raxioms"] - ; ["Coq"; "QArith"; "Qreals"] ] - - let z_modules = [["Coq"; "ZArith"; "BinInt"]] - - (** * Initialization : a large amount of Caml symbols are derived from * ZMicromega.v *) - let gen_constant_in_modules s m n = + let constr_of_ref str = EConstr.of_constr - ( UnivGen.constr_of_monomorphic_global - @@ Coqlib.gen_reference_in_modules s m n ) - - let init_constant = gen_constant_in_modules "ZMicromega" Coqlib.init_modules - - [@@@ocaml.warning "+3"] - - let constant = gen_constant_in_modules "ZMicromega" coq_modules - let bin_constant = gen_constant_in_modules "ZMicromega" bin_module - let r_constant = gen_constant_in_modules "ZMicromega" r_modules - let z_constant = gen_constant_in_modules "ZMicromega" z_modules - let m_constant = gen_constant_in_modules "ZMicromega" mic_modules - let coq_and = lazy (init_constant "and") - let coq_or = lazy (init_constant "or") - let coq_not = lazy (init_constant "not") - let coq_iff = lazy (init_constant "iff") - let coq_True = lazy (init_constant "True") - let coq_False = lazy (init_constant "False") - let coq_cons = lazy (constant "cons") - let coq_nil = lazy (constant "nil") - let coq_list = lazy (constant "list") - let coq_O = lazy (init_constant "O") - let coq_S = lazy (init_constant "S") - let coq_nat = lazy (init_constant "nat") - let coq_unit = lazy (init_constant "unit") + (UnivGen.constr_of_monomorphic_global (Coqlib.lib_ref str)) + + let coq_and = lazy (constr_of_ref "core.and.type") + let coq_or = lazy (constr_of_ref "core.or.type") + let coq_not = lazy (constr_of_ref "core.not.type") + let coq_iff = lazy (constr_of_ref "core.iff.type") + let coq_True = lazy (constr_of_ref "core.True.type") + let coq_False = lazy (constr_of_ref "core.False.type") + let coq_cons = lazy (constr_of_ref "core.list.cons") + let coq_nil = lazy (constr_of_ref "core.list.nil") + let coq_list = lazy (constr_of_ref "core.list.type") + let coq_O = lazy (constr_of_ref "num.nat.O") + let coq_S = lazy (constr_of_ref "num.nat.S") + let coq_nat = lazy (constr_of_ref "num.nat.type") + let coq_unit = lazy (constr_of_ref "core.unit.type") (* let coq_option = lazy (init_constant "option")*) - let coq_None = lazy (init_constant "None") - let coq_tt = lazy (init_constant "tt") - let coq_Inl = lazy (init_constant "inl") - let coq_Inr = lazy (init_constant "inr") - let coq_N0 = lazy (bin_constant "N0") - let coq_Npos = lazy (bin_constant "Npos") - let coq_xH = lazy (bin_constant "xH") - let coq_xO = lazy (bin_constant "xO") - let coq_xI = lazy (bin_constant "xI") - let coq_Z = lazy (bin_constant "Z") - let coq_ZERO = lazy (bin_constant "Z0") - let coq_POS = lazy (bin_constant "Zpos") - let coq_NEG = lazy (bin_constant "Zneg") - let coq_Q = lazy (constant "Q") - let coq_R = lazy (constant "R") - let coq_Qmake = lazy (constant "Qmake") - let coq_Rcst = lazy (constant "Rcst") - let coq_C0 = lazy (m_constant "C0") - let coq_C1 = lazy (m_constant "C1") - let coq_CQ = lazy (m_constant "CQ") - let coq_CZ = lazy (m_constant "CZ") - let coq_CPlus = lazy (m_constant "CPlus") - let coq_CMinus = lazy (m_constant "CMinus") - let coq_CMult = lazy (m_constant "CMult") - let coq_CPow = lazy (m_constant "CPow") - let coq_CInv = lazy (m_constant "CInv") - let coq_COpp = lazy (m_constant "COpp") - let coq_R0 = lazy (constant "R0") - let coq_R1 = lazy (constant "R1") - let coq_proofTerm = lazy (constant "ZArithProof") - let coq_doneProof = lazy (constant "DoneProof") - let coq_ratProof = lazy (constant "RatProof") - let coq_cutProof = lazy (constant "CutProof") - let coq_enumProof = lazy (constant "EnumProof") - let coq_ExProof = lazy (constant "ExProof") - let coq_Zgt = lazy (z_constant "Z.gt") - let coq_Zge = lazy (z_constant "Z.ge") - let coq_Zle = lazy (z_constant "Z.le") - let coq_Zlt = lazy (z_constant "Z.lt") - let coq_Eq = lazy (init_constant "eq") - let coq_Zplus = lazy (z_constant "Z.add") - let coq_Zminus = lazy (z_constant "Z.sub") - let coq_Zopp = lazy (z_constant "Z.opp") - let coq_Zmult = lazy (z_constant "Z.mul") - let coq_Zpower = lazy (z_constant "Z.pow") - let coq_Qle = lazy (constant "Qle") - let coq_Qlt = lazy (constant "Qlt") - let coq_Qeq = lazy (constant "Qeq") - let coq_Qplus = lazy (constant "Qplus") - let coq_Qminus = lazy (constant "Qminus") - let coq_Qopp = lazy (constant "Qopp") - let coq_Qmult = lazy (constant "Qmult") - let coq_Qpower = lazy (constant "Qpower") - let coq_Rgt = lazy (r_constant "Rgt") - let coq_Rge = lazy (r_constant "Rge") - let coq_Rle = lazy (r_constant "Rle") - let coq_Rlt = lazy (r_constant "Rlt") - let coq_Rplus = lazy (r_constant "Rplus") - let coq_Rminus = lazy (r_constant "Rminus") - let coq_Ropp = lazy (r_constant "Ropp") - let coq_Rmult = lazy (r_constant "Rmult") - let coq_Rinv = lazy (r_constant "Rinv") - let coq_Rpower = lazy (r_constant "pow") - let coq_powerZR = lazy (r_constant "powerRZ") - let coq_IZR = lazy (r_constant "IZR") - let coq_IQR = lazy (r_constant "Q2R") - let coq_PEX = lazy (constant "PEX") - let coq_PEc = lazy (constant "PEc") - let coq_PEadd = lazy (constant "PEadd") - let coq_PEopp = lazy (constant "PEopp") - let coq_PEmul = lazy (constant "PEmul") - let coq_PEsub = lazy (constant "PEsub") - let coq_PEpow = lazy (constant "PEpow") - let coq_PX = lazy (constant "PX") - let coq_Pc = lazy (constant "Pc") - let coq_Pinj = lazy (constant "Pinj") - let coq_OpEq = lazy (constant "OpEq") - let coq_OpNEq = lazy (constant "OpNEq") - let coq_OpLe = lazy (constant "OpLe") - let coq_OpLt = lazy (constant "OpLt") - let coq_OpGe = lazy (constant "OpGe") - let coq_OpGt = lazy (constant "OpGt") - let coq_PsatzIn = lazy (constant "PsatzIn") - let coq_PsatzSquare = lazy (constant "PsatzSquare") - let coq_PsatzMulE = lazy (constant "PsatzMulE") - let coq_PsatzMultC = lazy (constant "PsatzMulC") - let coq_PsatzAdd = lazy (constant "PsatzAdd") - let coq_PsatzC = lazy (constant "PsatzC") - let coq_PsatzZ = lazy (constant "PsatzZ") + let coq_None = lazy (constr_of_ref "core.option.None") + let coq_tt = lazy (constr_of_ref "core.unit.tt") + let coq_Inl = lazy (constr_of_ref "core.sum.inl") + let coq_Inr = lazy (constr_of_ref "core.sum.inr") + let coq_N0 = lazy (constr_of_ref "num.N.N0") + let coq_Npos = lazy (constr_of_ref "num.N.Npos") + let coq_xH = lazy (constr_of_ref "num.pos.xH") + let coq_xO = lazy (constr_of_ref "num.pos.xO") + let coq_xI = lazy (constr_of_ref "num.pos.xI") + let coq_Z = lazy (constr_of_ref "num.Z.type") + let coq_ZERO = lazy (constr_of_ref "num.Z.Z0") + let coq_POS = lazy (constr_of_ref "num.Z.Zpos") + let coq_NEG = lazy (constr_of_ref "num.Z.Zneg") + let coq_Q = lazy (constr_of_ref "rat.Q.type") + let coq_Qmake = lazy (constr_of_ref "rat.Q.Qmake") + let coq_R = lazy (constr_of_ref "reals.R.type") + let coq_Rcst = lazy (constr_of_ref "micromega.Rcst.type") + let coq_C0 = lazy (constr_of_ref "micromega.Rcst.C0") + let coq_C1 = lazy (constr_of_ref "micromega.Rcst.C1") + let coq_CQ = lazy (constr_of_ref "micromega.Rcst.CQ") + let coq_CZ = lazy (constr_of_ref "micromega.Rcst.CZ") + let coq_CPlus = lazy (constr_of_ref "micromega.Rcst.CPlus") + let coq_CMinus = lazy (constr_of_ref "micromega.Rcst.CMinus") + let coq_CMult = lazy (constr_of_ref "micromega.Rcst.CMult") + let coq_CPow = lazy (constr_of_ref "micromega.Rcst.CPow") + let coq_CInv = lazy (constr_of_ref "micromega.Rcst.CInv") + let coq_COpp = lazy (constr_of_ref "micromega.Rcst.COpp") + let coq_R0 = lazy (constr_of_ref "reals.R.R0") + let coq_R1 = lazy (constr_of_ref "reals.R.R1") + let coq_proofTerm = lazy (constr_of_ref "micromega.ZArithProof.type") + let coq_doneProof = lazy (constr_of_ref "micromega.ZArithProof.DoneProof") + let coq_ratProof = lazy (constr_of_ref "micromega.ZArithProof.RatProof") + let coq_cutProof = lazy (constr_of_ref "micromega.ZArithProof.CutProof") + let coq_enumProof = lazy (constr_of_ref "micromega.ZArithProof.EnumProof") + let coq_ExProof = lazy (constr_of_ref "micromega.ZArithProof.ExProof") + let coq_Zgt = lazy (constr_of_ref "num.Z.gt") + let coq_Zge = lazy (constr_of_ref "num.Z.ge") + let coq_Zle = lazy (constr_of_ref "num.Z.le") + let coq_Zlt = lazy (constr_of_ref "num.Z.lt") + let coq_Eq = lazy (constr_of_ref "core.eq.type") + let coq_Zplus = lazy (constr_of_ref "num.Z.add") + let coq_Zminus = lazy (constr_of_ref "num.Z.sub") + let coq_Zopp = lazy (constr_of_ref "num.Z.opp") + let coq_Zmult = lazy (constr_of_ref "num.Z.mul") + let coq_Zpower = lazy (constr_of_ref "num.Z.pow") + let coq_Qle = lazy (constr_of_ref "rat.Q.Qle") + let coq_Qlt = lazy (constr_of_ref "rat.Q.Qlt") + let coq_Qeq = lazy (constr_of_ref "rat.Q.Qeq") + let coq_Qplus = lazy (constr_of_ref "rat.Q.Qplus") + let coq_Qminus = lazy (constr_of_ref "rat.Q.Qminus") + let coq_Qopp = lazy (constr_of_ref "rat.Q.Qopp") + let coq_Qmult = lazy (constr_of_ref "rat.Q.Qmult") + let coq_Qpower = lazy (constr_of_ref "rat.Q.Qpower") + let coq_Rgt = lazy (constr_of_ref "reals.R.Rgt") + let coq_Rge = lazy (constr_of_ref "reals.R.Rge") + let coq_Rle = lazy (constr_of_ref "reals.R.Rle") + let coq_Rlt = lazy (constr_of_ref "reals.R.Rlt") + let coq_Rplus = lazy (constr_of_ref "reals.R.Rplus") + let coq_Rminus = lazy (constr_of_ref "reals.R.Rminus") + let coq_Ropp = lazy (constr_of_ref "reals.R.Ropp") + let coq_Rmult = lazy (constr_of_ref "reals.R.Rmult") + let coq_Rinv = lazy (constr_of_ref "reals.R.Rinv") + let coq_Rpower = lazy (constr_of_ref "reals.R.pow") + let coq_powerZR = lazy (constr_of_ref "reals.R.powerRZ") + let coq_IZR = lazy (constr_of_ref "reals.R.IZR") + let coq_IQR = lazy (constr_of_ref "reals.R.Q2R") + let coq_PEX = lazy (constr_of_ref "micromega.PExpr.PEX") + let coq_PEc = lazy (constr_of_ref "micromega.PExpr.PEc") + let coq_PEadd = lazy (constr_of_ref "micromega.PExpr.PEadd") + let coq_PEopp = lazy (constr_of_ref "micromega.PExpr.PEopp") + let coq_PEmul = lazy (constr_of_ref "micromega.PExpr.PEmul") + let coq_PEsub = lazy (constr_of_ref "micromega.PExpr.PEsub") + let coq_PEpow = lazy (constr_of_ref "micromega.PExpr.PEpow") + let coq_PX = lazy (constr_of_ref "micromega.Pol.PX") + let coq_Pc = lazy (constr_of_ref "micromega.Pol.Pc") + let coq_Pinj = lazy (constr_of_ref "micromega.Pol.Pinj") + let coq_OpEq = lazy (constr_of_ref "micromega.Op2.OpEq") + let coq_OpNEq = lazy (constr_of_ref "micromega.Op2.OpNEq") + let coq_OpLe = lazy (constr_of_ref "micromega.Op2.OpLe") + let coq_OpLt = lazy (constr_of_ref "micromega.Op2.OpLt") + let coq_OpGe = lazy (constr_of_ref "micromega.Op2.OpGe") + let coq_OpGt = lazy (constr_of_ref "micromega.Op2.OpGt") + let coq_PsatzIn = lazy (constr_of_ref "micromega.Psatz.PsatzIn") + let coq_PsatzSquare = lazy (constr_of_ref "micromega.Psatz.PsatzSquare") + let coq_PsatzMulE = lazy (constr_of_ref "micromega.Psatz.PsatzMulE") + let coq_PsatzMultC = lazy (constr_of_ref "micromega.Psatz.PsatzMulC") + let coq_PsatzAdd = lazy (constr_of_ref "micromega.Psatz.PsatzAdd") + let coq_PsatzC = lazy (constr_of_ref "micromega.Psatz.PsatzC") + let coq_PsatzZ = lazy (constr_of_ref "micromega.Psatz.PsatzZ") (* let coq_GT = lazy (m_constant "GT")*) - let coq_DeclaredConstant = lazy (m_constant "DeclaredConstant") - - let coq_TT = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "TT") - - let coq_FF = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "FF") - - let coq_And = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "Cj") + let coq_DeclaredConstant = + lazy (constr_of_ref "micromega.DeclaredConstant.type") - let coq_Or = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "D") - - let coq_Neg = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "N") - - let coq_Atom = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "A") - - let coq_X = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "X") - - let coq_Impl = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "I") - - let coq_Formula = - lazy - (gen_constant_in_modules "ZMicromega" - [["Coq"; "micromega"; "Tauto"]; ["Tauto"]] - "BFormula") + let coq_TT = lazy (constr_of_ref "micromega.GFormula.TT") + let coq_FF = lazy (constr_of_ref "micromega.GFormula.FF") + let coq_And = lazy (constr_of_ref "micromega.GFormula.Cj") + let coq_Or = lazy (constr_of_ref "micromega.GFormula.D") + let coq_Neg = lazy (constr_of_ref "micromega.GFormula.N") + let coq_Atom = lazy (constr_of_ref "micromega.GFormula.A") + let coq_X = lazy (constr_of_ref "micromega.GFormula.X") + let coq_Impl = lazy (constr_of_ref "micromega.GFormula.I") + let coq_Formula = lazy (constr_of_ref "micromega.BFormula.type") (** * Initialization : a few Caml symbols are derived from other libraries; * QMicromega, ZArithRing, RingMicromega. *) - let coq_QWitness = - lazy - (gen_constant_in_modules "QMicromega" - [["Coq"; "micromega"; "QMicromega"]] - "QWitness") - - let coq_Build = - lazy - (gen_constant_in_modules "RingMicromega" - [["Coq"; "micromega"; "RingMicromega"]; ["RingMicromega"]] - "Build_Formula") - - let coq_Cstr = - lazy - (gen_constant_in_modules "RingMicromega" - [["Coq"; "micromega"; "RingMicromega"]; ["RingMicromega"]] - "Formula") + let coq_QWitness = lazy (constr_of_ref "micromega.QWitness.type") + let coq_Build = lazy (constr_of_ref "micromega.Formula.Build_Formula") + let coq_Cstr = lazy (constr_of_ref "micromega.Formula.type") (** * Parsing and dumping : transformation functions between Caml and Coq @@ -1318,29 +1211,10 @@ end open M -let coq_Branch = - lazy - (gen_constant_in_modules "VarMap" - [["Coq"; "micromega"; "VarMap"]; ["VarMap"]] - "Branch") - -let coq_Elt = - lazy - (gen_constant_in_modules "VarMap" - [["Coq"; "micromega"; "VarMap"]; ["VarMap"]] - "Elt") - -let coq_Empty = - lazy - (gen_constant_in_modules "VarMap" - [["Coq"; "micromega"; "VarMap"]; ["VarMap"]] - "Empty") - -let coq_VarMap = - lazy - (gen_constant_in_modules "VarMap" - [["Coq"; "micromega"; "VarMap"]; ["VarMap"]] - "t") +let coq_Branch = lazy (constr_of_ref "micromega.VarMap.Branch") +let coq_Elt = lazy (constr_of_ref "micromega.VarMap.Elt") +let coq_Empty = lazy (constr_of_ref "micromega.VarMap.Empty") +let coq_VarMap = lazy (constr_of_ref "micromega.VarMap.type") let rec dump_varmap typ m = match m with @@ -1900,13 +1774,7 @@ let micromega_order_changer cert env ff = [ ( "__ff" , ff , EConstr.mkApp (Lazy.force coq_Formula, [|formula_typ|]) ) - ; ( "__varmap" - , vm - , EConstr.mkApp - ( gen_constant_in_modules "VarMap" - [["Coq"; "micromega"; "VarMap"]; ["VarMap"]] - "t" - , [|typ|] ) ) + ; ("__varmap", vm, EConstr.mkApp (Lazy.force coq_VarMap, [|typ|])) ; ("__wit", cert, cert_typ) ] (Tacmach.New.pf_concl gl)) (* Tacticals.New.tclTHENLIST (List.map (fun id -> (Tactics.introduction id)) ids)*) diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml index 0646af3552..633cdbd735 100644 --- a/plugins/setoid_ring/newring.ml +++ b/plugins/setoid_ring/newring.ml @@ -150,7 +150,7 @@ let decl_constant na univs c = let open Constr in let vars = CVars.universes_of_constr c in let univs = UState.restrict_universe_context ~lbound:(Global.universes_lbound ()) univs vars in - let () = Declare.declare_universe_context ~poly:false univs in + let () = DeclareUctx.declare_universe_context ~poly:false univs in let types = (Typeops.infer (Global.env ()) c).uj_type in let univs = Monomorphic_entry Univ.ContextSet.empty in mkConst(declare_constant ~name:(Id.of_string na) diff --git a/plugins/ssr/ssrbwd.ml b/plugins/ssr/ssrbwd.ml index 6a9a0657a3..42b9248979 100644 --- a/plugins/ssr/ssrbwd.ml +++ b/plugins/ssr/ssrbwd.ml @@ -55,18 +55,18 @@ let pf_pr_glob_constr gl = pr_glob_constr_env (pf_env gl) let interp_nbargs ist gl rc = try let rc6 = mkRApp rc (mkRHoles 6) in - let sigma, t = interp_open_constr ist gl (rc6, None) in + let sigma, t = interp_open_constr (pf_env gl) (project gl) ist (rc6, None) in let si = sig_it gl in let gl = re_sig si sigma in - 6 + Ssrcommon.nbargs_open_constr gl t + 6 + Ssrcommon.nbargs_open_constr (pf_env gl) t with _ -> 5 let interp_view_nbimps ist gl rc = try - let sigma, t = interp_open_constr ist gl (rc, None) in + let sigma, t = interp_open_constr (pf_env gl) (project gl) ist (rc, None) in let si = sig_it gl in let gl = re_sig si sigma in - let pl, c = splay_open_constr gl t in + let pl, c = splay_open_constr (pf_env gl) t in if Ssrcommon.isAppInd (pf_env gl) (project gl) c then List.length pl else (-(List.length pl)) with _ -> 0 @@ -88,7 +88,7 @@ let pf_match = pf_apply (fun e s c t -> understand_tcc e s ~expected_type:t c) let apply_rconstr ?ist t gl = (* ppdebug(lazy(str"sigma@apply_rconstr=" ++ pr_evar_map None (project gl))); *) let n = match ist, DAst.get t with - | None, (GVar id | GRef (Names.GlobRef.VarRef id,_)) -> pf_nbargs gl (EConstr.mkVar id) + | None, (GVar id | GRef (Names.GlobRef.VarRef id,_)) -> pf_nbargs (pf_env gl) (project gl) (EConstr.mkVar id) | Some ist, _ -> interp_nbargs ist gl t | _ -> anomaly "apply_rconstr without ist and not RVar" in let mkRlemma i = mkRApp t (mkRHoles i) in @@ -97,7 +97,7 @@ let apply_rconstr ?ist t gl = if i > n then errorstrm Pp.(str"Cannot apply lemma "++pf_pr_glob_constr gl t) else try pf_match gl (mkRlemma i) (OfType cl) with _ -> loop (i + 1) in - refine_with (loop 0) gl + Proofview.V82.of_tactic (refine_with (loop 0)) gl let mkRAppView ist gl rv gv = let nb_view_imps = interp_view_nbimps ist gl rv in @@ -112,18 +112,20 @@ let refine_interp_apply_view dbl ist gl gv = interp_refine ist gl (mkRApp hint (v :: mkRHoles i)) in let rec loop = function | [] -> (try apply_rconstr ~ist rv gl with _ -> view_error "apply" gv) - | h :: hs -> (try refine_with (snd (interp_with h)) gl with _ -> loop hs) in + | h :: hs -> (try Proofview.V82.of_tactic (refine_with (snd (interp_with h))) gl with _ -> loop hs) in loop (pair dbl (Ssrview.AdaptorDb.get dbl) @ if dbl = Ssrview.AdaptorDb.Equivalence then pair Ssrview.AdaptorDb.Backward (Ssrview.AdaptorDb.(get Backward)) else []) let apply_top_tac = - Tacticals.tclTHENLIST [ + Proofview.Goal.enter begin fun _ -> + Tacticals.New.tclTHENLIST [ introid top_id; - apply_rconstr (mkRVar top_id); - old_cleartac [SsrHyp(None,top_id)] + Proofview.V82.tactic (apply_rconstr (mkRVar top_id)); + cleartac [SsrHyp(None,top_id)] ] + end let inner_ssrapplytac gviews (ggenl, gclr) ist = Proofview.V82.tactic ~nf_evars:false (fun gl -> let _, clr = interp_hyps ist gl gclr in @@ -131,7 +133,7 @@ let inner_ssrapplytac gviews (ggenl, gclr) ist = Proofview.V82.tactic ~nf_evars: let ggenl, tclGENTAC = if gviews <> [] && ggenl <> [] then let ggenl= List.map (fun (x,g) -> x, cpattern_of_term g ist) (List.hd ggenl) in - [], Tacticals.tclTHEN (genstac (ggenl,[])) + [], Tacticals.tclTHEN (Proofview.V82.of_tactic (genstac (ggenl,[]))) else ggenl, Tacticals.tclTHEN Tacticals.tclIDTAC in tclGENTAC (fun gl -> match gviews, ggenl with @@ -148,9 +150,9 @@ let inner_ssrapplytac gviews (ggenl, gclr) ist = Proofview.V82.tactic ~nf_evars: | [], [agens] -> let clr', (sigma, lemma) = interp_agens ist gl agens in let gl = pf_merge_uc_of sigma gl in - Tacticals.tclTHENLIST [old_cleartac clr; refine_with ~beta:true lemma; old_cleartac clr'] gl + Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST [cleartac clr; refine_with ~beta:true lemma; cleartac clr']) gl | _, _ -> - Tacticals.tclTHENLIST [apply_top_tac; old_cleartac clr] gl) gl + Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST [apply_top_tac; cleartac clr]) gl) gl ) -let apply_top_tac = Proofview.V82.tactic ~nf_evars:false apply_top_tac +let apply_top_tac = apply_top_tac diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index e0b083a70a..e05c4c26dd 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -221,8 +221,8 @@ let intern_term ist env (_, c) = glob_constr ist env c (* FUNCLASS, which is probably just as well since these can *) (* lead to infinite arities. *) -let splay_open_constr gl (sigma, c) = - let env = pf_env gl in let t = Retyping.get_type_of env sigma c in +let splay_open_constr env (sigma, c) = + let t = Retyping.get_type_of env sigma c in Reductionops.splay_prod env sigma t let isAppInd env sigma c = @@ -253,11 +253,11 @@ let interp_refine ist gl rc = (sigma, (sigma, c)) -let interp_open_constr ist gl gc = - let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist (pf_env gl) (project gl) (gc, Tactypes.NoBindings) in - (project gl, (sigma, c)) +let interp_open_constr env sigma0 ist gc = + let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist env sigma0 (gc, Tactypes.NoBindings) in + (sigma0, (sigma, c)) -let interp_term ist gl (_, c) = snd (interp_open_constr ist gl c) +let interp_term env sigma ist (_, c) = snd (interp_open_constr env sigma ist c) let of_ftactic ftac gl = let r = ref None in @@ -322,10 +322,10 @@ let ssrdgens_of_parsed_dgens = function | _ -> assert false -let nbargs_open_constr gl oc = - let pl, _ = splay_open_constr gl oc in List.length pl +let nbargs_open_constr env oc = + let pl, _ = splay_open_constr env oc in List.length pl -let pf_nbargs gl c = nbargs_open_constr gl (project gl, c) +let pf_nbargs env sigma c = nbargs_open_constr env (sigma, c) let internal_names = ref [] let add_internal_name pt = internal_names := pt :: !internal_names @@ -521,10 +521,10 @@ let resolve_typeclasses ~where ~fail env sigma = let nf_evar sigma t = EConstr.Unsafe.to_constr (Evarutil.nf_evar sigma (EConstr.of_constr t)) -let pf_abs_evars2 gl rigid (sigma, c0) = +let abs_evars2 env sigma0 rigid (sigma, c0) = let c0 = EConstr.to_constr ~abort_on_undefined_evars:false sigma c0 in - let sigma0, ucst = project gl, Evd.evar_universe_context sigma in - let nenv = env_size (pf_env gl) in + let sigma0, ucst = sigma0, Evd.evar_universe_context sigma in + let nenv = env_size env in let abs_evar n k = let evi = Evd.find sigma k in let concl = EConstr.Unsafe.to_constr evi.evar_concl in @@ -537,7 +537,7 @@ let pf_abs_evars2 gl rigid (sigma, c0) = let rec put evlist c = match Constr.kind c with | Evar (k, a) -> if List.mem_assoc k evlist || Evd.mem sigma0 k || List.mem k rigid then evlist else - let n = max 0 (Array.length a - nenv) in + let n = max 0 (List.length a - nenv) in let t = abs_evar n k in (k, (n, t)) :: put evlist t | _ -> Constr.fold put evlist c in let evlist = put [] c0 in @@ -549,6 +549,7 @@ let pf_abs_evars2 gl rigid (sigma, c0) = | Evar (ev, a) -> let j, n = lookup ev i evlist in if j = 0 then Constr.map (get i) c else if n = 0 then mkRel j else + let a = Array.of_list a in mkApp (mkRel j, Array.init n (fun k -> get i a.(n - 1 - k))) | _ -> Constr.map_with_binders ((+) 1) get i c in let rec loop c i = function @@ -557,6 +558,11 @@ let pf_abs_evars2 gl rigid (sigma, c0) = | [] -> c in List.length evlist, EConstr.of_constr (loop (get 1 c0) 1 evlist), List.map fst evlist, ucst +let pf_abs_evars2 gl rigid c = + abs_evars2 (pf_env gl) (project gl) rigid c + +let abs_evars env sigma t = abs_evars2 env sigma [] t + let pf_abs_evars gl t = pf_abs_evars2 gl [] t @@ -568,7 +574,7 @@ let pf_abs_evars gl t = pf_abs_evars2 gl [] t * the corresponding lambda looks like (fun evar_i : T(c)) where c is * the solution found by ssrautoprop. *) -let ssrautoprop_tac = ref (fun gl -> assert false) +let ssrautoprop_tac = ref (Proofview.Goal.enter (fun gl -> assert false)) (* Thanks to Arnaud Spiwack for this snippet *) let call_on_evar tac e s = @@ -580,12 +586,11 @@ open Pp let pp _ = () (* FIXME *) module Intset = Evar.Set -let pf_abs_evars_pirrel gl (sigma, c0) = +let abs_evars_pirrel env sigma0 (sigma, c0) = pp(lazy(str"==PF_ABS_EVARS_PIRREL==")); - pp(lazy(str"c0= " ++ Printer.pr_constr_env (pf_env gl) sigma c0)); - let sigma0 = project gl in + pp(lazy(str"c0= " ++ Printer.pr_constr_env env sigma c0)); let c0 = nf_evar sigma0 (nf_evar sigma c0) in - let nenv = env_size (pf_env gl) in + let nenv = env_size env in let abs_evar n k = let evi = Evd.find sigma k in let concl = EConstr.Unsafe.to_constr evi.evar_concl in @@ -598,16 +603,16 @@ let pf_abs_evars_pirrel gl (sigma, c0) = let rec put evlist c = match Constr.kind c with | Evar (k, a) -> if List.mem_assoc k evlist || Evd.mem sigma0 k then evlist else - let n = max 0 (Array.length a - nenv) in + let n = max 0 (List.length a - nenv) in let k_ty = Retyping.get_sort_family_of - (pf_env gl) sigma (Evd.evar_concl (Evd.find sigma k)) in + env sigma (Evd.evar_concl (Evd.find sigma k)) in let is_prop = k_ty = InProp in let t = abs_evar n k in (k, (n, t, is_prop)) :: put evlist t | _ -> Constr.fold put evlist c in let evlist = put [] c0 in if evlist = [] then 0, c0 else - let pr_constr t = Printer.pr_econstr_env (pf_env gl) sigma (Reductionops.nf_beta (pf_env gl) (project gl) (EConstr.of_constr t)) in + let pr_constr t = Printer.pr_econstr_env env sigma (Reductionops.nf_beta env sigma0 (EConstr.of_constr t)) in pp(lazy(str"evlist=" ++ pr_list (fun () -> str";") (fun (k,_) -> Evar.print k) evlist)); let evplist = @@ -619,7 +624,7 @@ let pf_abs_evars_pirrel gl (sigma, c0) = if evplist = [] then evlist, [], sigma else List.fold_left (fun (ev, evp, sigma) (i, (_,t,_) as p) -> try - let ng, sigma = call_on_evar !ssrautoprop_tac i sigma in + let ng, sigma = call_on_evar (Proofview.V82.of_tactic !ssrautoprop_tac) i sigma in if (ng <> []) then errorstrm (str "Should we tell the user?"); List.filter (fun (j,_) -> j <> i) ev, evp, sigma with _ -> ev, p::evp, sigma) (evlist, [], sigma) (List.rev evplist) in @@ -636,6 +641,7 @@ let pf_abs_evars_pirrel gl (sigma, c0) = | Evar (ev, a) -> let j, n = lookup ev i evlist in if j = 0 then Constr.map (get evlist i) c else if n = 0 then mkRel j else + let a = Array.of_list a in mkApp (mkRel j, Array.init n (fun k -> get evlist i a.(n - 1 - k))) | _ -> Constr.map_with_binders ((+) 1) (get evlist) i c in let rec app extra_args i c = match decompose_app c with @@ -665,6 +671,9 @@ let pf_abs_evars_pirrel gl (sigma, c0) = pp(lazy(str"res= " ++ pr_constr res)); List.length evlist, res +let pf_abs_evars_pirrel gl c = + abs_evars_pirrel (pf_env gl) (project gl) c + (* Strip all non-essential dependencies from an abstracted term, generating *) (* standard names for the abstracted holes. *) @@ -676,7 +685,8 @@ let nb_evar_deps = function (try int_of_string (String.sub s m (String.length s - 1 - m)) with _ -> 0) | _ -> 0 -let pf_type_id gl t = Id.of_string (Namegen.hdchar (pf_env gl) (project gl) t) +let type_id env sigma t = Id.of_string (Namegen.hdchar env sigma t) +let pf_type_id gl t = type_id (pf_env gl) (project gl) t let pfe_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl) sigma, ty @@ -691,7 +701,7 @@ let pf_type_of gl t = let sigma, ty = pf_type_of gl (EConstr.of_constr t) in re_sig (sig_it gl) sigma, EConstr.Unsafe.to_constr ty -let pf_abs_cterm gl n c0 = +let abs_cterm env sigma n c0 = if n <= 0 then c0 else let c0 = EConstr.Unsafe.to_constr c0 in let noargs = [|0|] in @@ -723,13 +733,15 @@ let pf_abs_cterm gl n c0 = let na' = List.length dl in eva.(i) <- Array.of_list (na - na' :: dl); let x' = - if na' = 0 then Name (pf_type_id gl (EConstr.of_constr t2)) else mk_evar_name na' in + if na' = 0 then Name (type_id env sigma (EConstr.of_constr t2)) else mk_evar_name na' in mkLambda ({x with binder_name=x'}, t2, strip_evars (i + 1) c1) (* if noccurn 1 c2 then lift (-1) c2 else mkLambda (Name (pf_type_id gl t2), t2, c2) *) | _ -> strip i c in EConstr.of_constr (strip_evars 0 c0) +let pf_abs_cterm gl n c0 = abs_cterm (pf_env gl) (project gl) n c0 + (* }}} *) let pf_merge_uc uc gl = @@ -833,7 +845,7 @@ open Locus let rewritetac ?(under=false) dir c = (* Due to the new optional arg ?tac, application shouldn't be too partial *) let open Proofview.Notations in - Proofview.V82.of_tactic begin + Proofview.Goal.enter begin fun _ -> Equality.general_rewrite (dir = L2R) AllOccurrences true false c <*> if under then Proofview.cycle 1 else Proofview.tclUNIT () end @@ -843,7 +855,7 @@ let rewritetac ?(under=false) dir c = type name_hint = (int * EConstr.types array) option ref let pf_abs_ssrterm ?(resolve_typeclasses=false) ist gl t = - let sigma, ct as t = interp_term ist gl t in + let sigma, ct as t = interp_term (pf_env gl) (project gl) ist t in let sigma, _ as t = let env = pf_env gl in if not resolve_typeclasses then t @@ -855,7 +867,8 @@ let pf_abs_ssrterm ?(resolve_typeclasses=false) ist gl t = let top_id = mk_internal_id "top assumption" -let ssr_n_tac seed n gl = +let ssr_n_tac seed n = + Proofview.Goal.enter begin fun gl -> let name = if n = -1 then seed else ("ssr" ^ seed ^ string_of_int n) in let fail msg = CErrors.user_err (Pp.str msg) in let tacname = @@ -865,9 +878,10 @@ let ssr_n_tac seed n gl = if n = -1 then fail "The ssreflect library was not loaded" else fail ("The tactic "^name^" was not found") in let tacexpr = CAst.make @@ Tacexpr.Reference (ArgArg (Loc.tag @@ tacname)) in - Proofview.V82.of_tactic (Tacinterp.eval_tactic (Tacexpr.TacArg tacexpr)) gl + Tacinterp.eval_tactic (Tacexpr.TacArg tacexpr) + end -let donetac n gl = ssr_n_tac "done" n gl +let donetac n = ssr_n_tac "done" n open Constrexpr open Util @@ -888,7 +902,7 @@ let mkCCast ?loc t ty = CAst.make ?loc @@ CCast (t, CastConv ty) let rec isCHoles = function { CAst.v = CHole _ } :: cl -> isCHoles cl | cl -> cl = [] let rec isCxHoles = function ({ CAst.v = CHole _ }, None) :: ch -> isCxHoles ch | _ -> false -let pf_interp_ty ?(resolve_typeclasses=false) ist gl ty = +let pf_interp_ty ?(resolve_typeclasses=false) env sigma0 ist ty = let n_binders = ref 0 in let ty = match ty with | a, (t, None) -> @@ -913,15 +927,14 @@ let pf_interp_ty ?(resolve_typeclasses=false) ist gl ty = | LetInType(n,v,ty,t) -> decr n_binders; mkLetIn (n, v, ty, aux t) | _ -> anomaly "pf_interp_ty: ssr Type cast deleted by typecheck" in sigma, aux t in - let sigma, cty as ty = strip_cast (interp_term ist gl ty) in + let sigma, cty as ty = strip_cast (interp_term env sigma0 ist ty) in let ty = - let env = pf_env gl in if not resolve_typeclasses then ty else let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in sigma, Evarutil.nf_evar sigma cty in - let n, c, _, ucst = pf_abs_evars gl ty in - let lam_c = pf_abs_cterm gl n c in + let n, c, _, ucst = abs_evars env sigma0 ty in + let lam_c = abs_cterm env sigma0 n c in let ctx, c = EConstr.decompose_lam_n_assum sigma n lam_c in n, EConstr.it_mkProd_or_LetIn c ctx, lam_c, ucst ;; @@ -979,7 +992,8 @@ let dependent_apply_error = * * Refiner.refiner that does not handle metas with a non ground type but works * with dependently typed higher order metas. *) -let applyn ~with_evars ?beta ?(with_shelve=false) ?(first_goes_last=false) n t gl = +let applyn ~with_evars ?beta ?(with_shelve=false) ?(first_goes_last=false) n t = + Proofview.V82.tactic begin fun gl -> if with_evars then let refine gl = let t, ty, args, gl = pf_saturate ?beta ~bi_types:true gl t n in @@ -1012,16 +1026,22 @@ let applyn ~with_evars ?beta ?(with_shelve=false) ?(first_goes_last=false) n t g pp(lazy(str"Refiner.refiner " ++ Printer.pr_econstr_env (pf_env gl) (project gl) t)); Proofview.(V82.of_tactic (Tacticals.New.tclTHENLIST [ - V82.tactic (Refiner.refiner ~check:false EConstr.Unsafe.(to_constr t)); + Refiner.refiner ~check:false EConstr.Unsafe.(to_constr t); (if first_goes_last then cycle 1 else tclUNIT ()) ])) gl + end -let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc gl = +let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in let uct = Evd.evar_universe_context (fst oc) in - let n, oc = pf_abs_evars_pirrel gl (fst oc, EConstr.to_constr ~abort_on_undefined_evars:false (fst oc) (snd oc)) in - let gl = pf_unsafe_merge_uc uct gl in - try applyn ~with_evars ~first_goes_last ~with_shelve:true ?beta n (EConstr.of_constr oc) gl - with e when CErrors.noncritical e -> raise dependent_apply_error + let n, oc = abs_evars_pirrel env sigma (fst oc, EConstr.to_constr ~abort_on_undefined_evars:false (fst oc) (snd oc)) in + Proofview.Unsafe.tclEVARS (Evd.set_universe_context sigma uct) <*> + Proofview.tclOR (applyn ~with_evars ~first_goes_last ~with_shelve:true ?beta n (EConstr.of_constr oc)) + (fun _ -> Proofview.tclZERO dependent_apply_error) + end (* We wipe out all the keywords generated by the grammar rules we defined. *) (* The user is supposed to Require Import ssreflect or Require ssreflect *) @@ -1039,23 +1059,24 @@ let rec fst_prod red tac = Proofview.Goal.enter begin fun gl -> else Tacticals.New.tclTHEN Tactics.hnf_in_concl (fst_prod true tac) end -let introid ?(orig=ref Anonymous) name = tclTHEN (fun gl -> - let g, env = Tacmach.pf_concl gl, pf_env gl in - let sigma = project gl in +let introid ?(orig=ref Anonymous) name = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let sigma = Proofview.Goal.sigma gl in + let g = Proofview.Goal.concl gl in match EConstr.kind sigma g with | App (hd, _) when EConstr.isLambda sigma hd -> - Proofview.V82.of_tactic (convert_concl_no_check (Reductionops.whd_beta sigma g)) gl - | _ -> tclIDTAC gl) - (Proofview.V82.of_tactic - (fst_prod false (fun id -> orig := id; Tactics.intro_mustbe_force name))) -;; + convert_concl_no_check (Reductionops.whd_beta sigma g) + | _ -> Tacticals.New.tclIDTAC + end <*> + (fst_prod false (fun id -> orig := id; Tactics.intro_mustbe_force name)) let anontac decl gl = let id = match RelDecl.get_name decl with | Name id -> if is_discharged_id id then id else mk_anon_id (Id.to_string id) (Tacmach.pf_ids_of_hyps gl) | _ -> mk_anon_id ssr_anon_hyp (Tacmach.pf_ids_of_hyps gl) in - introid id gl + Proofview.V82.of_tactic (introid id) gl let rec intro_anon gl = try anontac (List.hd (fst (EConstr.decompose_prod_n_assum (project gl) 1 (Tacmach.pf_concl gl)))) gl @@ -1083,16 +1104,17 @@ let interp_clr sigma = function let tclID tac = tac let tclDOTRY n tac = + let open Tacticals.New in if n <= 0 then tclIDTAC else - let rec loop i gl = - if i = n then tclTRY tac gl else - tclTRY (tclTHEN tac (loop (i + 1))) gl in + let rec loop i = + if i = n then tclTRY tac else + tclTRY (tclTHEN tac (loop (i + 1))) in loop 1 let tclDO n tac = let prefix i = str"At iteration " ++ int i ++ str": " in let tac_err_at i gl = - try tac gl + try Proofview.V82.of_tactic tac gl with | CErrors.UserError (l, s) as e -> let _, info = Exninfo.capture e in @@ -1103,11 +1125,15 @@ let tclDO n tac = let rec loop i gl = if i = n then tac_err_at i gl else (tclTHEN (tac_err_at i) (loop (i + 1))) gl in - loop 1 + Proofview.V82.tactic ~nf_evars:false (loop 1) + +let tclAT_LEAST_ONCE t = + let open Tacticals.New in + tclTHEN t (tclREPEAT t) let tclMULT = function - | 0, May -> tclREPEAT - | 1, May -> tclTRY + | 0, May -> Tacticals.New.tclREPEAT + | 1, May -> Tacticals.New.tclTRY | n, May -> tclDOTRY n | 0, Must -> tclAT_LEAST_ONCE | n, Must when n > 1 -> tclDO n @@ -1122,7 +1148,7 @@ let cleartac clr = check_hyps_uniq [] clr; Tactics.clear (hyps_ids clr) (* XXX the k of the redex should percolate out *) let pf_interp_gen_aux gl to_ind ((oclr, occ), t) = - let pat = interp_cpattern gl t None in (* UGLY API *) + let pat = interp_cpattern (pf_env gl) (project gl) t None in (* UGLY API *) let gl = pf_merge_uc_of (fst pat) gl in let cl, env, sigma = Tacmach.pf_concl gl, pf_env gl, project gl in let (c, ucst), cl = @@ -1169,7 +1195,8 @@ let genclrtac cl cs clr = gl)) (old_cleartac clr) -let gentac gen gl = +let gentac gen = + Proofview.V82.tactic begin fun gl -> (* ppdebug(lazy(str"sigma@gentac=" ++ pr_evar_map None (project gl))); *) let conv, _, cl, c, clr, ucst,gl = pf_interp_gen_aux gl false gen in ppdebug(lazy(str"c@gentac=" ++ pr_econstr_env (pf_env gl) (project gl) c)); @@ -1177,9 +1204,10 @@ let gentac gen gl = if conv then tclTHEN (Proofview.V82.of_tactic (convert_concl ~check:true cl)) (old_cleartac clr) gl else genclrtac cl [c] clr gl + end let genstac (gens, clr) = - tclTHENLIST (old_cleartac clr :: List.rev_map gentac gens) + Tacticals.New.tclTHENLIST (cleartac clr :: List.rev_map gentac gens) let gen_tmp_ids ?(ist=Geninterp.({ lfun = Id.Map.empty; poly = false; extra = Tacinterp.TacStore.empty })) gl @@ -1189,7 +1217,7 @@ let gen_tmp_ids (tclTHENLIST (List.map (fun (id,orig_ref) -> tclTHEN - (gentac ((None,Some(false,[])),cpattern_of_id id)) + (Proofview.V82.of_tactic (gentac ((None,Some(false,[])),cpattern_of_id id))) (rename_hd_prod orig_ref)) ctx.tmp_ids) gl) ;; @@ -1212,24 +1240,6 @@ let pfLIFT f = Proofview.tclUNIT x ;; -(* TASSI: This version of unprotects inlines the unfold tactic definition, - * since we don't want to wipe out let-ins, and it seems there is no flag - * to change that behaviour in the standard unfold code *) -let unprotecttac gl = - let c, gl = pf_mkSsrConst "protect_term" gl in - let prot, _ = EConstr.destConst (project gl) c in - Tacticals.onClause (fun idopt -> - let hyploc = Option.map (fun id -> id, InHyp) idopt in - Proofview.V82.of_tactic (Tactics.reduct_option ~check:false - (Reductionops.clos_norm_flags - (CClosure.RedFlags.mkflags - [CClosure.RedFlags.fBETA; - CClosure.RedFlags.fCONST prot; - CClosure.RedFlags.fMATCH; - CClosure.RedFlags.fFIX; - CClosure.RedFlags.fCOFIX]), DEFAULTcast) hyploc)) - allHypsAndConcl gl - let is_protect hd env sigma = let _, protectC = mkSsrConst "protect_term" env sigma in EConstr.eq_constr_nounivs sigma hd protectC @@ -1257,7 +1267,7 @@ let abs_wgen keep_let f gen (gl,args,c) = gl, EConstr.mkVar x :: args, prod | _, Some ((x, "@"), Some p) -> let x = hoi_id x in - let cp = interp_cpattern gl p None in + let cp = interp_cpattern (pf_env gl) (project gl) p None in let gl = pf_merge_uc_of (fst cp) gl in let (t, ucst), c = try fill_occ_pattern ~raise_NoMatch:true env sigma (EConstr.Unsafe.to_constr c) cp None 1 @@ -1270,7 +1280,7 @@ let abs_wgen keep_let f gen (gl,args,c) = pf_merge_uc ucst gl, args, EConstr.mkLetIn(make_annot (Name (f x)) r, ut, ty, c) | _, Some ((x, _), Some p) -> let x = hoi_id x in - let cp = interp_cpattern gl p None in + let cp = interp_cpattern (pf_env gl) (project gl) p None in let gl = pf_merge_uc_of (fst cp) gl in let (t, ucst), c = try fill_occ_pattern ~raise_NoMatch:true env sigma (EConstr.Unsafe.to_constr c) cp None 1 @@ -1285,8 +1295,8 @@ let abs_wgen keep_let f gen (gl,args,c) = let clr_of_wgen gen clrs = match gen with | clr, Some ((x, _), None) -> let x = hoi_id x in - old_cleartac clr :: old_cleartac [SsrHyp(Loc.tag x)] :: clrs - | clr, _ -> old_cleartac clr :: clrs + cleartac clr :: cleartac [SsrHyp(Loc.tag x)] :: clrs + | clr, _ -> cleartac clr :: clrs let reduct_in_concl ~check t = Tactics.reduct_in_concl ~check (t, DEFAULTcast) @@ -1319,7 +1329,8 @@ end let tacREDUCE_TO_QUANTIFIED_IND ty = tacSIGMA >>= fun gl -> - tclUNIT (Tacmach.pf_reduce_to_quantified_ind gl ty) + try tclUNIT (Tacmach.pf_reduce_to_quantified_ind gl ty) + with e -> tclZERO e let tacTYPEOF c = Goal.enter_one ~__LOC__ (fun g -> let sigma, env = Goal.sigma g, Goal.env g in @@ -1458,7 +1469,7 @@ end let tacINTERP_CPATTERN cp = tacSIGMA >>= begin fun gl -> - tclUNIT (Ssrmatching.interp_cpattern gl cp None) + tclUNIT (Ssrmatching.interp_cpattern (pf_env gl) (project gl) cp None) end let tacUNIFY a b = @@ -1486,12 +1497,38 @@ let tclWITHTOP tac = Goal.enter begin fun gl -> Tactics.clear [top] end -let tacMK_SSR_CONST name = Goal.enter_one ~__LOC__ begin fun g -> - let sigma, env = Goal.(sigma g, env g) in - let sigma, c = mkSsrConst name env sigma in - Unsafe.tclEVARS sigma <*> - tclUNIT c -end +let tacMK_SSR_CONST name = + Proofview.tclENV >>= fun env -> + Proofview.tclEVARMAP >>= fun sigma -> + match mkSsrConst name env sigma with + | sigma, c -> Unsafe.tclEVARS sigma <*> tclUNIT c + | exception e when CErrors.noncritical e -> + tclLIFT (Proofview.NonLogical.raise (e, Exninfo.null)) + +let tacDEST_CONST c = + Proofview.tclEVARMAP >>= fun sigma -> + match EConstr.destConst sigma c with + | c, _ -> tclUNIT c + | exception e when CErrors.noncritical e -> + tclLIFT (Proofview.NonLogical.raise (e, Exninfo.null)) + +(* TASSI: This version of unprotects inlines the unfold tactic definition, + * since we don't want to wipe out let-ins, and it seems there is no flag + * to change that behaviour in the standard unfold code *) +let unprotecttac = + tacMK_SSR_CONST "protect_term" >>= tacDEST_CONST >>= fun prot -> + Tacticals.New.onClause (fun idopt -> + let hyploc = Option.map (fun id -> id, InHyp) idopt in + Tactics.reduct_option ~check:false + (Reductionops.clos_norm_flags + (CClosure.RedFlags.mkflags + [CClosure.RedFlags.fBETA; + CClosure.RedFlags.fCONST prot; + CClosure.RedFlags.fMATCH; + CClosure.RedFlags.fFIX; + CClosure.RedFlags.fCOFIX]), DEFAULTcast) hyploc) + allHypsAndConcl + module type StateType = sig type state diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli index 3f92eab0bd..d1ad24496e 100644 --- a/plugins/ssr/ssrcommon.mli +++ b/plugins/ssr/ssrcommon.mli @@ -131,7 +131,8 @@ val pf_intern_term : ssrterm -> Glob_term.glob_constr val interp_term : - Tacinterp.interp_sign -> Goal.goal Evd.sigma -> + Environ.env -> Evd.evar_map -> + Tacinterp.interp_sign -> ssrterm -> evar_map * EConstr.t val interp_wit : @@ -145,7 +146,8 @@ val interp_refine : Glob_term.glob_constr -> evar_map * (evar_map * EConstr.constr) val interp_open_constr : - Tacinterp.interp_sign -> Goal.goal Evd.sigma -> + Environ.env -> Evd.evar_map -> + Tacinterp.interp_sign -> Genintern.glob_constr_and_expr -> evar_map * (evar_map * EConstr.t) val pf_e_type_of : @@ -153,7 +155,7 @@ val pf_e_type_of : EConstr.constr -> Goal.goal Evd.sigma * EConstr.types val splay_open_constr : - Goal.goal Evd.sigma -> + Environ.env -> evar_map * EConstr.t -> (Names.Name.t Context.binder_annot * EConstr.t) list * EConstr.t val isAppInd : Environ.env -> Evd.evar_map -> EConstr.types -> bool @@ -179,8 +181,23 @@ val mk_internal_id : string -> Id.t val mk_tagged_id : string -> int -> Id.t val mk_evar_name : int -> Name.t val ssr_anon_hyp : string +val type_id : Environ.env -> Evd.evar_map -> EConstr.types -> Id.t val pf_type_id : Goal.goal Evd.sigma -> EConstr.types -> Id.t +val abs_evars : + Environ.env -> Evd.evar_map -> + evar_map * EConstr.t -> + int * EConstr.t * Evar.t list * + UState.t +val abs_evars2 : (* ssr2 *) + Environ.env -> Evd.evar_map -> Evar.t list -> + evar_map * EConstr.t -> + int * EConstr.t * Evar.t list * + UState.t +val abs_cterm : + Environ.env -> Evd.evar_map -> int -> EConstr.t -> EConstr.t + + val pf_abs_evars : Goal.goal Evd.sigma -> evar_map * EConstr.t -> @@ -216,15 +233,8 @@ val pf_abs_prod : EConstr.t -> Goal.goal Evd.sigma * EConstr.types val mkSsrRRef : string -> Glob_term.glob_constr * 'a option -val mkSsrConst : - string -> - env -> evar_map -> evar_map * EConstr.t -val pf_mkSsrConst : - string -> - Goal.goal Evd.sigma -> - EConstr.t * Goal.goal Evd.sigma -val new_wild_id : tac_ctx -> Names.Id.t * tac_ctx +val new_wild_id : tac_ctx -> Names.Id.t * tac_ctx val pf_fresh_global : GlobRef.t -> @@ -239,11 +249,14 @@ val ssrqid : string -> Libnames.qualid val new_tmp_id : tac_ctx -> (Names.Id.t * Name.t ref) * tac_ctx val mk_anon_id : string -> Id.t list -> Id.t +val abs_evars_pirrel : + Environ.env -> Evd.evar_map -> + evar_map * Constr.constr -> int * Constr.constr val pf_abs_evars_pirrel : Goal.goal Evd.sigma -> evar_map * Constr.constr -> int * Constr.constr -val nbargs_open_constr : Goal.goal Evd.sigma -> Evd.evar_map * EConstr.t -> int -val pf_nbargs : Goal.goal Evd.sigma -> EConstr.t -> int +val nbargs_open_constr : Environ.env -> Evd.evar_map * EConstr.t -> int +val pf_nbargs : Environ.env -> Evd.evar_map -> EConstr.t -> int val gen_tmp_ids : ?ist:Geninterp.interp_sign -> (Goal.goal * tac_ctx) Evd.sigma -> @@ -263,7 +276,7 @@ val red_product_skip_id : env -> evar_map -> EConstr.t -> EConstr.t val ssrautoprop_tac : - (Evar.t Evd.sigma -> Evar.t list Evd.sigma) ref + unit Proofview.tactic ref val mkProt : EConstr.t -> @@ -300,14 +313,15 @@ val pf_abs_ssrterm : val pf_interp_ty : ?resolve_typeclasses:bool -> + Environ.env -> + Evd.evar_map -> Tacinterp.interp_sign -> - Goal.goal Evd.sigma -> Ssrast.ssrtermkind * (Glob_term.glob_constr * Constrexpr.constr_expr option) -> int * EConstr.t * EConstr.t * UState.t -val ssr_n_tac : string -> int -> v82tac -val donetac : int -> v82tac +val ssr_n_tac : string -> int -> unit Proofview.tactic +val donetac : int -> unit Proofview.tactic val applyn : with_evars:bool -> @@ -315,7 +329,7 @@ val applyn : ?with_shelve:bool -> ?first_goes_last:bool -> int -> - EConstr.t -> v82tac + EConstr.t -> unit Proofview.tactic exception NotEnoughProducts val pf_saturate : ?beta:bool -> @@ -339,7 +353,7 @@ val refine_with : ?first_goes_last:bool -> ?beta:bool -> ?with_evars:bool -> - evar_map * EConstr.t -> v82tac + evar_map * EConstr.t -> unit Proofview.tactic val pf_resolve_typeclasses : where:EConstr.t -> @@ -350,18 +364,18 @@ val resolve_typeclasses : (*********************** Wrapped Coq tactics *****************************) -val rewritetac : ?under:bool -> ssrdir -> EConstr.t -> tactic +val rewritetac : ?under:bool -> ssrdir -> EConstr.t -> unit Proofview.tactic type name_hint = (int * EConstr.types array) option ref val gentac : - Ssrast.ssrdocc * Ssrmatching.cpattern -> v82tac + Ssrast.ssrdocc * Ssrmatching.cpattern -> unit Proofview.tactic val genstac : ((Ssrast.ssrhyp list option * Ssrmatching.occ) * Ssrmatching.cpattern) list * Ssrast.ssrhyp list -> - Tacmach.tactic + unit Proofview.tactic val pf_interp_gen : bool -> @@ -378,7 +392,7 @@ val pfLIFT (** Basic tactics *) -val introid : ?orig:Name.t ref -> Id.t -> v82tac +val introid : ?orig:Name.t ref -> Id.t -> unit Proofview.tactic val intro_anon : v82tac val interp_clr : @@ -390,9 +404,9 @@ val genclrtac : val old_cleartac : ssrhyps -> v82tac val cleartac : ssrhyps -> unit Proofview.tactic -val tclMULT : int * ssrmmod -> Tacmach.tactic -> Tacmach.tactic +val tclMULT : int * ssrmmod -> unit Proofview.tactic -> unit Proofview.tactic -val unprotecttac : Goal.goal Evd.sigma -> Goal.goal list Evd.sigma +val unprotecttac : unit Proofview.tactic val is_protect : EConstr.t -> Environ.env -> Evd.evar_map -> bool val abs_wgen : @@ -407,7 +421,7 @@ val abs_wgen : val clr_of_wgen : ssrhyps * ((ssrhyp_or_id * 'a) * 'b option) option -> - Proofview.V82.tac list -> Proofview.V82.tac list + unit Proofview.tactic list -> unit Proofview.tactic list val unfold : EConstr.t list -> unit Proofview.tactic diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml index b44600a8cf..8e75ba7a2b 100644 --- a/plugins/ssr/ssrelim.ml +++ b/plugins/ssr/ssrelim.ml @@ -183,7 +183,7 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = else let c = Option.get oc in let gl, c_ty = pfe_type_of gl c in let pc = match c_gen with - | Some p -> interp_cpattern orig_gl p None + | Some p -> interp_cpattern (pf_env orig_gl) (project orig_gl) p None | _ -> mkTpat gl c in Some(c, c_ty, pc), gl in seed, cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl @@ -233,7 +233,7 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in let pred = List.assoc pred_id elim_args in let pc = match n_c_args, c_gen with - | 0, Some p -> interp_cpattern orig_gl p None + | 0, Some p -> interp_cpattern (pf_env orig_gl) (project orig_gl) p None | _ -> mkTpat gl c in let cty = Some (c, c_ty, pc) in let elimty = Reductionops.whd_all env (project gl) elimty in @@ -312,7 +312,7 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = let rec loop patterns clr i = function | [],[] -> patterns, clr, gl | ((oclr, occ), t):: deps, inf_t :: inf_deps -> - let p = interp_cpattern orig_gl t None in + let p = interp_cpattern (pf_env orig_gl) (project orig_gl) t None in let clr_t = interp_clr (project gl) (oclr,(tag_of_cpattern t,EConstr.of_constr (fst (redex_of_pattern env p)))) in (* if we are the index for the equation we do not clear *) @@ -392,10 +392,15 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = let erefl = fire_subst gl erefl in let erefl_ty = Retyping.get_type_of (pf_env gl) (project gl) erefl in let eq_ty = Retyping.get_type_of (pf_env gl) (project gl) erefl_ty in - let gen_eq_tac s = + let gen_eq_tac = + let open Proofview.Notations in + Proofview.Goal.enter begin fun s -> + let sigma = Proofview.Goal.sigma s in let open Evd in - let sigma = merge_universe_context s.sigma (evar_universe_context (project gl)) in - apply_type new_concl [erefl] { s with sigma } + let sigma = merge_universe_context sigma (evar_universe_context (project gl)) in + Proofview.Unsafe.tclEVARS sigma <*> + Tactics.apply_type ~typecheck:true new_concl [erefl] + end in gen_eq_tac, eq_ty, gl in let rel = k + if c_is_head_p then 1 else 0 in @@ -403,7 +408,7 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = let concl = EConstr.mkArrow src Sorts.Relevant (EConstr.Vars.lift 1 concl) in let clr = if deps <> [] then clr else [] in concl, gen_eq_tac, clr, gl - | _ -> concl, Tacticals.tclIDTAC, clr, gl in + | _ -> concl, Tacticals.New.tclIDTAC, clr, gl in let mk_lam t r = EConstr.mkLambda_or_LetIn r t in let concl = List.fold_left mk_lam concl pred_rctx in let gl, concl = @@ -453,9 +458,8 @@ let ssrelim ?(is_case=false) deps what ?elim eqid elim_intro_tac = let elim_tac = Tacticals.New.tclTHENLIST [ - Proofview.V82.tactic (refine_with ~with_evars:false elim); + refine_with ~with_evars:false elim; cleartac clr] in - let gen_eq_tac = Proofview.V82.tactic gen_eq_tac in Tacticals.New.tclTHENLIST [gen_eq_tac; elim_intro_tac ?seed:(Some seed) what eqid elim_tac is_rec clr] ;; @@ -467,19 +471,22 @@ let casetac x k = let k ?seed _what _eqid elim_tac _is_rec _clr = k ?seed elim_tac in ssrelim ~is_case:true [] (`EConstr ([],None,x)) None k -let pf_nb_prod gl = nb_prod (project gl) (pf_concl gl) - let rev_id = mk_internal_id "rev concl" let injecteq_id = mk_internal_id "injection equation" -let revtoptac n0 gl = - let n = pf_nb_prod gl - n0 in - let dc, cl = EConstr.decompose_prod_n_assum (project gl) n (pf_concl gl) in +let revtoptac n0 = + Proofview.Goal.enter begin fun gl -> + let sigma = Proofview.Goal.sigma gl in + let concl = Proofview.Goal.concl gl in + let n = nb_prod sigma concl - n0 in + let dc, cl = EConstr.decompose_prod_n_assum sigma n concl in let dc' = dc @ [Context.Rel.Declaration.LocalAssum(make_annot (Name rev_id) Sorts.Relevant, EConstr.it_mkProd_or_LetIn cl (List.rev dc))] in let f = EConstr.it_mkLambda_or_LetIn (mkEtaApp (EConstr.mkRel (n + 1)) (-n) 1) dc' in - Refiner.refiner ~check:true EConstr.Unsafe.(to_constr (EConstr.mkApp (f, [|Evarutil.mk_new_meta ()|]))) gl + Refiner.refiner ~check:true EConstr.Unsafe.(to_constr (EConstr.mkApp (f, [|Evarutil.mk_new_meta ()|]))) + end -let equality_inj l b id c gl = +let equality_inj l b id c = + Proofview.V82.tactic begin fun gl -> let msg = ref "" in try Proofview.V82.of_tactic (Equality.inj None l b None c) gl with @@ -490,37 +497,53 @@ let equality_inj l b id c gl = !msg = "Nothing to inject." -> Feedback.msg_warning (Pp.str !msg); discharge_hyp (id, (id, "")) gl + end -let injectidl2rtac id c gl = - Tacticals.tclTHEN (equality_inj None true id c) (revtoptac (pf_nb_prod gl)) gl +let injectidl2rtac id c = + Proofview.Goal.enter begin fun gl -> + let sigma = Proofview.Goal.sigma gl in + let concl = Proofview.Goal.concl gl in + Tacticals.New.tclTHEN (equality_inj None true id c) (revtoptac (nb_prod sigma concl)) + end let injectl2rtac sigma c = match EConstr.kind sigma c with | Var id -> injectidl2rtac id (EConstr.mkVar id, NoBindings) | _ -> let id = injecteq_id in - let xhavetac id c = Proofview.V82.of_tactic (Tactics.pose_proof (Name id) c) in - Tacticals.tclTHENLIST [xhavetac id c; injectidl2rtac id (EConstr.mkVar id, NoBindings); Proofview.V82.of_tactic (Tactics.clear [id])] + let xhavetac id c = Tactics.pose_proof (Name id) c in + Tacticals.New.tclTHENLIST [xhavetac id c; injectidl2rtac id (EConstr.mkVar id, NoBindings); Tactics.clear [id]] -let is_injection_case c gl = - let gl, cty = pfe_type_of gl c in - let (mind,_), _ = pf_reduce_to_quantified_ind gl cty in +let is_injection_case env sigma c = + let sigma, cty = Typing.type_of env sigma c in + let (mind,_), _ = Tacred.reduce_to_quantified_ind env sigma cty in Coqlib.check_ind_ref "core.eq.type" mind -let perform_injection c gl = - let gl, cty = pfe_type_of gl c in - let mind, t = pf_reduce_to_quantified_ind gl cty in - let dc, eqt = EConstr.decompose_prod (project gl) t in - if dc = [] then injectl2rtac (project gl) c gl else - if not (EConstr.Vars.closed0 (project gl) eqt) then +let perform_injection c = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + let sigma, cty = Typing.type_of env sigma c in + let mind, t = Tacred.reduce_to_quantified_ind env sigma cty in + let dc, eqt = EConstr.decompose_prod sigma t in + if dc = [] then injectl2rtac sigma c else + if not (EConstr.Vars.closed0 sigma eqt) then CErrors.user_err (Pp.str "can't decompose a quantified equality") else - let cl = pf_concl gl in let n = List.length dc in + let cl = Proofview.Goal.concl gl in + let n = List.length dc in let c_eq = mkEtaApp c n 2 in let cl1 = EConstr.mkLambda EConstr.(make_annot Anonymous Sorts.Relevant, mkArrow eqt Sorts.Relevant cl, mkApp (mkRel 1, [|c_eq|])) in let id = injecteq_id in let id_with_ebind = (EConstr.mkVar id, NoBindings) in - let injtac = Tacticals.tclTHEN (introid id) (injectidl2rtac id id_with_ebind) in - Tacticals.tclTHENLAST (Proofview.V82.of_tactic (Tactics.apply (EConstr.compose_lam dc cl1))) injtac gl + let injtac = Tacticals.New.tclTHEN (introid id) (injectidl2rtac id id_with_ebind) in + Proofview.Unsafe.tclEVARS sigma <*> + Tacticals.New.tclTHENLAST (Tactics.apply (EConstr.compose_lam dc cl1)) injtac + end -let ssrscase_or_inj_tac c = Proofview.V82.tactic ~nf_evars:false (fun gl -> - if is_injection_case c gl then perform_injection c gl - else Proofview.V82.of_tactic (casetac c (fun ?seed:_ k -> k)) gl) +let ssrscase_or_inj_tac c = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + if is_injection_case env sigma c then perform_injection c + else casetac c (fun ?seed:_ k -> k) + end diff --git a/plugins/ssr/ssrelim.mli b/plugins/ssr/ssrelim.mli index 7b9cfed5ba..7f74fc78a2 100644 --- a/plugins/ssr/ssrelim.mli +++ b/plugins/ssr/ssrelim.mli @@ -41,10 +41,10 @@ val casetac : (?seed:Names.Name.t list array -> unit Proofview.tactic -> unit Proofview.tactic) -> unit Proofview.tactic -val is_injection_case : EConstr.t -> Goal.goal Evd.sigma -> bool +val is_injection_case : Environ.env -> Evd.evar_map -> EConstr.t -> bool val perform_injection : EConstr.constr -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic val ssrscase_or_inj_tac : EConstr.constr -> diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml index d4303e9e8b..ab07dd5be9 100644 --- a/plugins/ssr/ssrequality.ml +++ b/plugins/ssr/ssrequality.ml @@ -42,29 +42,36 @@ let () = (* We must avoid zeta-converting any "let"s created by the "in" tactical. *) -let tacred_simpl gl = +let tacred_simpl env = let simpl_expr = Genredexpr.( Simpl(Redops.make_red_flag[FBeta;FMatch;FZeta;FDeltaBut []],None)) in - let esimpl, _ = Redexpr.reduction_of_red_expr (pf_env gl) simpl_expr in + let esimpl, _ = Redexpr.reduction_of_red_expr env simpl_expr in let esimpl e sigma c = let (_,t) = esimpl e sigma c in t in let simpl env sigma c = (esimpl env sigma c) in simpl -let safe_simpltac n gl = +let safe_simpltac n = if n = ~-1 then - let cl= red_safe (tacred_simpl gl) (pf_env gl) (project gl) (pf_concl gl) in - Proofview.V82.of_tactic (convert_concl_no_check cl) gl + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + let concl = Proofview.Goal.concl gl in + let cl = red_safe (tacred_simpl env) env sigma concl in + convert_concl_no_check cl + end else - ssr_n_tac "simpl" n gl + ssr_n_tac "simpl" n let simpltac = function | Simpl n -> safe_simpltac n - | Cut n -> tclTRY (donetac n) - | SimplCut (n,m) -> tclTHEN (safe_simpltac m) (tclTRY (donetac n)) - | Nop -> tclIDTAC + | Cut n -> Tacticals.New.tclTRY (donetac n) + | SimplCut (n,m) -> Tacticals.New.tclTHEN (safe_simpltac m) (Tacticals.New.tclTRY (donetac n)) + | Nop -> Tacticals.New.tclIDTAC + +let simpltac s = Proofview.Goal.enter (fun _ -> simpltac s) (** The "congr" tactic *) @@ -87,13 +94,13 @@ let pattern_id = mk_internal_id "pattern value" let congrtac ((n, t), ty) ist gl = ppdebug(lazy (Pp.str"===congr===")); ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr_env (pf_env gl) (project gl) (Tacmach.pf_concl gl))); - let sigma, _ as it = interp_term ist gl t in + let sigma, _ as it = interp_term (pf_env gl) (project gl) ist t in let gl = pf_merge_uc_of sigma gl in let _, f, _, _ucst = pf_abs_evars gl it in let ist' = {ist with lfun = Id.Map.add pattern_id (Tacinterp.Value.of_constr f) Id.Map.empty } in let rf = mkRltacVar pattern_id in - let m = pf_nbargs gl f in + let m = pf_nbargs (pf_env gl) (project gl) f in let _, cf = if n > 0 then match interp_congrarg_at ist' gl n rf ty m with | Some cf -> cf @@ -105,14 +112,18 @@ let congrtac ((n, t), ty) ist gl = | Some cf -> cf | None -> loop (i + 1) in loop 1 in - tclTHEN (refine_with cf) (tclTRY (Proofview.V82.of_tactic Tactics.reflexivity)) gl + Proofview.V82.of_tactic Tacticals.New.(tclTHEN (refine_with cf) (tclTRY Tactics.reflexivity)) gl let pf_typecheck t gl = let it = sig_it gl in let sigma,_ = pf_type_of gl t in re_sig [it] sigma -let newssrcongrtac arg ist gl = +let newssrcongrtac arg ist = + let open Proofview.Notations in + Proofview.Goal.enter_one ~__LOC__ begin fun _g -> + (Ssrcommon.tacMK_SSR_CONST "ssr_congr_arrow") end >>= fun arr -> + Proofview.V82.tactic begin fun gl -> ppdebug(lazy Pp.(str"===newcongr===")); ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr_env (pf_env gl) (project gl) (pf_concl gl))); (* utils *) @@ -129,7 +140,6 @@ let newssrcongrtac arg ist gl = let sigma = Evd.create_evar_defs sigma in let (sigma, x) = Evarutil.new_evar env sigma ty in x, re_sig si sigma in - let arr, gl = pf_mkSsrConst "ssr_congr_arrow" gl in let ssr_congr lr = EConstr.mkApp (arr, lr) in let eq, gl = pf_fresh_global Coqlib.(lib_ref "core.eq.type") gl in (* here the two cases: simple equality or arrow *) @@ -150,6 +160,7 @@ let newssrcongrtac arg ist gl = ; congrtac (arg, mkRType) ist ]) (fun _ _ -> errorstrm Pp.(str"Conclusion is not an equality nor an arrow"))) gl + end (** 7. Rewriting tactics (rewrite, unlock) *) @@ -188,24 +199,28 @@ let mk_rwarg (d, (n, _ as m)) ((clr, occ as docc), rx) (rt, _ as r) : ssrrwarg = let norwmult = L2R, nomult let norwocc = noclr, None -let simplintac occ rdx sim gl = - let simptac m gl = +let simplintac occ rdx sim = + let simptac m = + Proofview.Goal.enter begin fun gl -> if m <> ~-1 then begin if rdx <> None then CErrors.user_err (Pp.str "Custom simpl tactic does not support patterns"); if occ <> None then CErrors.user_err (Pp.str "Custom simpl tactic does not support occurrence numbers"); - simpltac (Simpl m) gl + simpltac (Simpl m) end else - let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in + let sigma0, concl0, env0 = Proofview.Goal.(sigma gl, concl gl, env gl) in let simp env c _ _ = EConstr.Unsafe.to_constr (red_safe Tacred.simpl env sigma0 (EConstr.of_constr c)) in - Proofview.V82.of_tactic - (convert_concl_no_check (EConstr.of_constr (eval_pattern env0 sigma0 (EConstr.Unsafe.to_constr concl0) rdx occ simp))) - gl in + convert_concl_no_check (EConstr.of_constr (eval_pattern env0 sigma0 (EConstr.to_constr ~abort_on_undefined_evars:false sigma0 concl0) rdx occ simp)) + end + in + let open Tacticals.New in + Proofview.Goal.enter begin fun _ -> match sim with - | Simpl m -> simptac m gl - | SimplCut (n,m) -> tclTHEN (simptac m) (tclTRY (donetac n)) gl - | _ -> simpltac sim gl + | Simpl m -> simptac m + | SimplCut (n,m) -> tclTHEN (simptac m) (tclTRY (donetac n)) + | _ -> simpltac sim + end let rec get_evalref env sigma c = match EConstr.kind sigma c with | Var id -> EvalVarRef id @@ -233,7 +248,8 @@ let all_ok _ _ = true let fake_pmatcher_end () = mkProp, L2R, (Evd.empty, UState.empty, mkProp) -let unfoldintac occ rdx t (kt,_) gl = +let unfoldintac occ rdx t (kt,_) = + Proofview.V82.tactic begin fun gl -> let fs sigma x = Reductionops.nf_evar sigma x in let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in let (sigma, t), const = strip_unfold_term env0 t kt in @@ -286,9 +302,10 @@ let unfoldintac occ rdx t (kt,_) gl = with Option.IsNone -> errorstrm Pp.(str"Failed to unfold " ++ pr_econstr_pat env0 sigma t) in let _ = conclude () in Proofview.V82.of_tactic (convert_concl ~check:true concl) gl -;; + end -let foldtac occ rdx ft gl = +let foldtac occ rdx ft = + Proofview.V82.tactic begin fun gl -> let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in let sigma, t = ft in let t = EConstr.to_constr ~abort_on_undefined_evars:false sigma t in @@ -313,7 +330,7 @@ let foldtac occ rdx ft gl = let concl = eval_pattern env0 sigma0 concl0 rdx occ fold in let _ = conclude () in Proofview.V82.of_tactic (convert_concl ~check:true (EConstr.of_constr concl)) gl -;; + end let converse_dir = function L2R -> R2L | R2L -> L2R @@ -337,7 +354,8 @@ exception PRtype_error of (Environ.env * Evd.evar_map * Pretype_errors.pretype_e let id_map_redex _ sigma ~before:_ ~after = sigma, after -let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl = +let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty new_rdx dir (sigma, c) c_ty = + Proofview.V82.tactic begin fun gl -> (* ppdebug(lazy(str"sigma@pirrel_rewrite=" ++ pr_evar_map None sigma)); *) let env = pf_env gl in let beta = Reductionops.clos_norm_flags CClosure.beta env sigma in @@ -369,8 +387,8 @@ let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty new_ in ppdebug(lazy Pp.(str"pirrel_rewrite: proof term: " ++ pr_econstr_env env sigma proof)); ppdebug(lazy Pp.(str"pirrel_rewrite of type: " ++ pr_econstr_env env sigma proof_ty)); - try refine_with - ~first_goes_last:(not !ssroldreworder || under) ~with_evars:under (sigma, proof) gl + try Proofview.V82.of_tactic (refine_with + ~first_goes_last:(not !ssroldreworder || under) ~with_evars:under (sigma, proof)) gl with _ -> (* we generate a msg like: "Unable to find an instance for the variable" *) let hd_ty, miss = match EConstr.kind sigma c with @@ -393,62 +411,73 @@ let pirrel_rewrite ?(under=false) ?(map_redex=id_map_redex) pred rdx rdx_ty new_ | _ -> anomaly "rewrite rule not an application" in errorstrm Pp.(Himsg.explain_refiner_error env sigma (Logic.UnresolvedBindings miss)++ (Pp.fnl()++str"Rule's type:" ++ spc() ++ pr_econstr_env env sigma hd_ty)) -;; + end + +let pf_merge_uc_of s sigma = + Evd.merge_universe_context sigma (Evd.evar_universe_context s) -let rwcltac ?under ?map_redex cl rdx dir sr gl = +let rwcltac ?under ?map_redex cl rdx dir sr = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma0 = Proofview.Goal.sigma gl in let sr = let sigma, r = sr in - let sigma = resolve_typeclasses ~where:r ~fail:false (pf_env gl) sigma in + let sigma = resolve_typeclasses ~where:r ~fail:false env sigma in sigma, r in - let n, r_n,_, ucst = pf_abs_evars gl sr in - let r_n' = pf_abs_cterm gl n r_n in + let n, r_n,_, ucst = abs_evars env sigma0 sr in + let r_n' = abs_cterm env sigma0 n r_n in let r' = EConstr.Vars.subst_var pattern_id r_n' in - let gl = pf_unsafe_merge_uc ucst gl in - let rdxt = Retyping.get_type_of (pf_env gl) (fst sr) rdx in + let sigma0 = Evd.set_universe_context sigma0 ucst in + let rdxt = Retyping.get_type_of env (fst sr) rdx in (* ppdebug(lazy(str"sigma@rwcltac=" ++ pr_evar_map None (fst sr))); *) - ppdebug(lazy Pp.(str"r@rwcltac=" ++ pr_econstr_env (pf_env gl) (project gl) (snd sr))); - let cvtac, rwtac, gl = - if EConstr.Vars.closed0 (project gl) r' then - let env, sigma, c, c_eq = pf_env gl, fst sr, snd sr, Coqlib.(lib_ref "core.eq.type") in + ppdebug(lazy Pp.(str"r@rwcltac=" ++ pr_econstr_env env sigma0 (snd sr))); + let cvtac, rwtac, sigma0 = + if EConstr.Vars.closed0 sigma0 r' then + let sigma, c, c_eq = fst sr, snd sr, Coqlib.(lib_ref "core.eq.type") in let sigma, c_ty = Typing.type_of env sigma c in ppdebug(lazy Pp.(str"c_ty@rwcltac=" ++ pr_econstr_env env sigma c_ty)); let open EConstr in match kind_of_type sigma (Reductionops.whd_all env sigma c_ty) with | AtomicType(e, a) when Ssrcommon.is_ind_ref sigma e c_eq -> let new_rdx = if dir = L2R then a.(2) else a.(1) in - pirrel_rewrite ?under ?map_redex cl rdx rdxt new_rdx dir (sigma,c) c_ty, tclIDTAC, gl + pirrel_rewrite ?under ?map_redex cl rdx rdxt new_rdx dir (sigma,c) c_ty, Tacticals.New.tclIDTAC, sigma0 | _ -> let cl' = EConstr.mkApp (EConstr.mkNamedLambda (make_annot pattern_id Sorts.Relevant) rdxt cl, [|rdx|]) in let sigma, _ = Typing.type_of env sigma cl' in - let gl = pf_merge_uc_of sigma gl in - Proofview.V82.of_tactic (convert_concl ~check:true cl'), rewritetac ?under dir r', gl + let sigma0 = pf_merge_uc_of sigma sigma0 in + convert_concl ~check:true cl', rewritetac ?under dir r', sigma0 else - let dc, r2 = EConstr.decompose_lam_n_assum (project gl) n r' in + let dc, r2 = EConstr.decompose_lam_n_assum sigma0 n r' in let r3, _, r3t = - try EConstr.destCast (project gl) r2 with _ -> - errorstrm Pp.(str "no cast from " ++ pr_econstr_pat (pf_env gl) (project gl) (snd sr) - ++ str " to " ++ pr_econstr_env (pf_env gl) (project gl) r2) in + try EConstr.destCast sigma0 r2 with _ -> + errorstrm Pp.(str "no cast from " ++ pr_econstr_pat env sigma0 (snd sr) + ++ str " to " ++ pr_econstr_env env sigma0 r2) in let cl' = EConstr.mkNamedProd (make_annot rule_id Sorts.Relevant) (EConstr.it_mkProd_or_LetIn r3t dc) (EConstr.Vars.lift 1 cl) in let cl'' = EConstr.mkNamedProd (make_annot pattern_id Sorts.Relevant) rdxt cl' in let itacs = [introid pattern_id; introid rule_id] in - let cltac = Proofview.V82.of_tactic (Tactics.clear [pattern_id; rule_id]) in + let cltac = Tactics.clear [pattern_id; rule_id] in let rwtacs = [rewritetac ?under dir (EConstr.mkVar rule_id); cltac] in - apply_type cl'' [rdx; EConstr.it_mkLambda_or_LetIn r3 dc], tclTHENLIST (itacs @ rwtacs), gl + Tactics.apply_type ~typecheck:true cl'' [rdx; EConstr.it_mkLambda_or_LetIn r3 dc], Tacticals.New.tclTHENLIST (itacs @ rwtacs), sigma0 in - let cvtac' _ = - try cvtac gl with - | PRtype_error e -> + let cvtac' = + Proofview.tclOR cvtac begin function + | (PRtype_error e, _) -> let error = Option.cata (fun (env, sigma, te) -> Pp.(fnl () ++ str "Type error was: " ++ Himsg.explain_pretype_error env sigma te)) (Pp.mt ()) e in - if occur_existential (project gl) (Tacmach.pf_concl gl) - then errorstrm Pp.(str "Rewriting impacts evars" ++ error) - else errorstrm Pp.(str "Dependent type error in rewrite of " - ++ pr_econstr_env (pf_env gl) (project gl) + if occur_existential sigma0 (Tacmach.New.pf_concl gl) + then Tacticals.New.tclZEROMSG Pp.(str "Rewriting impacts evars" ++ error) + else Tacticals.New.tclZEROMSG Pp.(str "Dependent type error in rewrite of " + ++ pr_econstr_env env sigma0 (EConstr.mkNamedLambda (make_annot pattern_id Sorts.Relevant) rdxt cl) ++ error) + | (e, info) -> Proofview.tclZERO ~info e + end in - tclTHEN cvtac' rwtac gl + Proofview.Unsafe.tclEVARS sigma0 <*> + Tacticals.New.tclTHEN cvtac' rwtac + end [@@@ocaml.warning "-3"] let lz_coq_prod = @@ -474,14 +503,13 @@ let ssr_is_setoid env = Rewrite.is_applied_rewrite_relation env sigma [] (EConstr.mkApp (r, args)) <> None -let closed0_check cl p gl = +let closed0_check env sigma cl p = if closed0 cl then - errorstrm Pp.(str"No occurrence of redex "++ pr_constr_env (pf_env gl) (project gl) p) + errorstrm Pp.(str"No occurrence of redex "++ pr_constr_env env sigma p) let dir_org = function L2R -> 1 | R2L -> 2 -let rwprocess_rule dir rule gl = - let env = pf_env gl in +let rwprocess_rule env dir rule = let coq_prod = lz_coq_prod () in let is_setoid = ssr_is_setoid env in let r_sigma, rules = @@ -558,15 +586,17 @@ let rwprocess_rule dir rule gl = in r_sigma, rules -let rwrxtac ?under ?map_redex occ rdx_pat dir rule gl = - let env = pf_env gl in - let r_sigma, rules = rwprocess_rule dir rule gl in +let rwrxtac ?under ?map_redex occ rdx_pat dir rule = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma0 = Proofview.Goal.sigma gl in + let r_sigma, rules = rwprocess_rule env dir rule in let find_rule rdx = let rec rwtac = function | [] -> - errorstrm Pp.(str "pattern " ++ pr_econstr_pat env (project gl) rdx ++ + errorstrm Pp.(str "pattern " ++ pr_econstr_pat env sigma0 rdx ++ str " does not match " ++ pr_dir_side dir ++ - str " of " ++ pr_econstr_pat env (project gl) (snd rule)) + str " of " ++ pr_econstr_pat env sigma0 (snd rule)) | (d, r, lhs, rhs) :: rs -> try let ise = unify_HO env (Evd.create_evar_defs r_sigma) lhs rdx in @@ -574,7 +604,8 @@ let rwrxtac ?under ?map_redex occ rdx_pat dir rule gl = d, (ise, Evd.evar_universe_context ise, Reductionops.nf_evar ise r) with _ -> rwtac rs in rwtac rules in - let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in + let env0 = env in + let concl0 = Proofview.Goal.concl gl in let find_R, conclude = match rdx_pat with | Some (_, (In_T _ | In_X_In_T _)) | None -> let upats_origin = dir, EConstr.Unsafe.to_constr (snd rule) in @@ -586,23 +617,26 @@ let rwrxtac ?under ?map_redex occ rdx_pat dir rule gl = let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in let find_R, end_R = mk_tpattern_matcher sigma0 occ ~upats_origin rpats in (fun e c _ i -> find_R ~k:(fun _ _ _ h -> mkRel h) e c i), - fun cl -> let rdx,d,r = end_R () in closed0_check cl rdx gl; (d,r),rdx + fun cl -> let rdx,d,r = end_R () in closed0_check env0 sigma0 cl rdx; (d,r),rdx | Some(_, (T e | X_In_T (_,e) | E_As_X_In_T (e,_,_) | E_In_X_In_T (e,_,_))) -> let r = ref None in (fun env c _ h -> do_once r (fun () -> find_rule (EConstr.of_constr c), c); mkRel h), - (fun concl -> closed0_check concl e gl; + (fun concl -> closed0_check env0 sigma0 concl e; let (d,(ev,ctx,c)) , x = assert_done r in (d,(ev,ctx, EConstr.to_constr ~abort_on_undefined_evars:false ev c)) , x) in - let concl0 = EConstr.Unsafe.to_constr concl0 in + let concl0 = EConstr.to_constr ~abort_on_undefined_evars:false sigma0 concl0 in let concl = eval_pattern env0 sigma0 concl0 rdx_pat occ find_R in let (d, r), rdx = conclude concl in let r = Evd.merge_universe_context (pi1 r) (pi2 r), EConstr.of_constr (pi3 r) in - rwcltac ?under ?map_redex (EConstr.of_constr concl) (EConstr.of_constr rdx) d r gl -;; - -let ssrinstancesofrule ist dir arg gl = - let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in - let rule = interp_term ist gl arg in - let r_sigma, rules = rwprocess_rule dir rule gl in + rwcltac ?under ?map_redex (EConstr.of_constr concl) (EConstr.of_constr rdx) d r + end + +let ssrinstancesofrule ist dir arg = + Proofview.Goal.enter begin fun gl -> + let env0 = Proofview.Goal.env gl in + let sigma0 = Proofview.Goal.sigma gl in + let concl0 = Proofview.Goal.concl gl in + let rule = interp_term env0 sigma0 ist arg in + let r_sigma, rules = rwprocess_rule env0 dir rule in let find, conclude = let upats_origin = dir, EConstr.Unsafe.to_constr (snd rule) in let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) = @@ -619,33 +653,47 @@ let ssrinstancesofrule ist dir arg gl = Feedback.msg_info Pp.(str"BEGIN INSTANCES"); try while true do - ignore(find env0 (EConstr.Unsafe.to_constr concl0) 1 ~k:print) + ignore(find env0 (EConstr.to_constr ~abort_on_undefined_evars:false sigma0 concl0) 1 ~k:print) done; raise NoMatch - with NoMatch -> Feedback.msg_info Pp.(str"END INSTANCES"); tclIDTAC gl - -let ipat_rewrite occ dir c gl = rwrxtac occ None dir (project gl, c) gl - -let rwargtac ?under ?map_redex ist ((dir, mult), (((oclr, occ), grx), (kind, gt))) gl = + with NoMatch -> Feedback.msg_info Pp.(str"END INSTANCES"); Tacticals.New.tclIDTAC + end + +let ipat_rewrite occ dir c = Proofview.Goal.enter begin fun gl -> + rwrxtac occ None dir (Proofview.Goal.sigma gl, c) +end + +let rwargtac ?under ?map_redex ist ((dir, mult), (((oclr, occ), grx), (kind, gt))) = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in let fail = ref false in - let interp_rpattern gl gc = - try interp_rpattern gl gc - with _ when snd mult = May -> fail := true; project gl, T mkProp in - let interp gc gl = - try interp_term ist gl gc - with _ when snd mult = May -> fail := true; (project gl, EConstr.mkProp) in - let rwtac gl = - let rx = Option.map (interp_rpattern gl) grx in - let gl = match rx with - | None -> gl - | Some (s,_) -> pf_merge_uc_of s gl in - let t = interp gt gl in - let gl = pf_merge_uc_of (fst t) gl in + let interp_rpattern env sigma gc = + try interp_rpattern env sigma gc + with _ when snd mult = May -> fail := true; sigma, T mkProp in + let interp env sigma gc = + try interp_term env sigma ist gc + with _ when snd mult = May -> fail := true; (sigma, EConstr.mkProp) in + let rwtac = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + let rx = Option.map (interp_rpattern env sigma) grx in + let sigma = match rx with + | None -> sigma + | Some (s,_) -> pf_merge_uc_of s sigma in + let t = interp env sigma gt in + let sigma = pf_merge_uc_of (fst t) sigma in + Proofview.Unsafe.tclEVARS sigma <*> (match kind with | RWred sim -> simplintac occ rx sim | RWdef -> if dir = R2L then foldtac occ rx t else unfoldintac occ rx t gt - | RWeq -> rwrxtac ?under ?map_redex occ rx dir t) gl in - let ctac = old_cleartac (interp_clr (project gl) (oclr, (fst gt, snd (interp gt gl)))) in - if !fail then ctac gl else tclTHEN (tclMULT mult rwtac) ctac gl + | RWeq -> rwrxtac ?under ?map_redex occ rx dir t) + end + in + let ctac = cleartac (interp_clr sigma (oclr, (fst gt, snd (interp env sigma gt)))) in + if !fail then ctac else Tacticals.New.tclTHEN (tclMULT mult rwtac) ctac + end (** Rewrite argument sequence *) @@ -654,24 +702,37 @@ let rwargtac ?under ?map_redex ist ((dir, mult), (((oclr, occ), grx), (kind, gt) (** The "rewrite" tactic *) let ssrrewritetac ?under ?map_redex ist rwargs = - tclTHENLIST (List.map (rwargtac ?under ?map_redex ist) rwargs) + Proofview.Goal.enter begin fun _ -> + Tacticals.New.tclTHENLIST (List.map (rwargtac ?under ?map_redex ist) rwargs) + end (** The "unlock" tactic *) -let unfoldtac occ ko t kt gl = - let env = pf_env gl in - let cl, c = pf_fill_occ_term gl occ (fst (strip_unfold_term env t kt)) in - let cl' = EConstr.Vars.subst1 (pf_unfoldn [OnlyOccurrences [1], get_evalref env (project gl) c] gl c) cl in +let unfoldtac occ ko t kt = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + let concl = Proofview.Goal.concl gl in + let concl = Evarutil.nf_evar sigma concl in + let cl, c = fill_occ_term env sigma concl occ (fst (strip_unfold_term env t kt)) in + let cl' = EConstr.Vars.subst1 (Tacred.unfoldn [OnlyOccurrences [1], get_evalref env sigma c] env sigma c) cl in let f = if ko = None then CClosure.betaiotazeta else CClosure.betaiota in - Proofview.V82.of_tactic - (convert_concl ~check:true (pf_reduce (Reductionops.clos_norm_flags f) gl cl')) gl - -let unlocktac ist args gl = - let utac (occ, gt) gl = - unfoldtac occ occ (interp_term ist gl gt) (fst gt) gl in - let locked, gl = pf_mkSsrConst "locked" gl in - let key, gl = pf_mkSsrConst "master_key" gl in + convert_concl ~check:true (Reductionops.clos_norm_flags f env sigma cl') + end + +let unlocktac ist args = + let open Proofview.Notations in + let utac (occ, gt) = + Proofview.Goal.enter begin fun gl -> + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + unfoldtac occ occ (interp_term env sigma ist gt) (fst gt) + end + in + Ssrcommon.tacMK_SSR_CONST "locked" >>= fun locked -> + Ssrcommon.tacMK_SSR_CONST "master_key" >>= fun key -> let ktacs = [ - (fun gl -> unfoldtac None None (project gl,locked) xInParens gl); - Proofview.V82.of_tactic (Ssrelim.casetac key (fun ?seed:_ k -> k)) ] in - tclTHENLIST (List.map utac args @ ktacs) gl + (Proofview.tclEVARMAP >>= fun sigma -> unfoldtac None None (sigma, locked) xInParens); + Ssrelim.casetac key (fun ?seed:_ k -> k) + ] in + Tacticals.New.tclTHENLIST (List.map utac args @ ktacs) diff --git a/plugins/ssr/ssrequality.mli b/plugins/ssr/ssrequality.mli index 0bb67c99db..1c3b1bb018 100644 --- a/plugins/ssr/ssrequality.mli +++ b/plugins/ssr/ssrequality.mli @@ -26,12 +26,12 @@ val mkclr : ssrclear -> ssrdocc val nodocc : ssrdocc val noclr : ssrdocc -val simpltac : Ssrast.ssrsimpl -> Tacmach.tactic +val simpltac : Ssrast.ssrsimpl -> unit Proofview.tactic val newssrcongrtac : int * Ssrast.ssrterm -> Ltac_plugin.Tacinterp.interp_sign -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic val mk_rwarg : @@ -49,7 +49,7 @@ val ssrinstancesofrule : Ltac_plugin.Tacinterp.interp_sign -> Ssrast.ssrdir -> Ssrast.ssrterm -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic (* map_redex (by default the identity on after) is called on the * redex (before) and its replacement (after). It is used to @@ -59,11 +59,11 @@ val ssrrewritetac : ?map_redex:(Environ.env -> Evd.evar_map -> before:EConstr.t -> after:EConstr.t -> Evd.evar_map * EConstr.t) -> Ltac_plugin.Tacinterp.interp_sign -> - ssrrwarg list -> Tacmach.tactic + ssrrwarg list -> unit Proofview.tactic -val ipat_rewrite : ssrocc -> ssrdir -> EConstr.t -> Tacmach.tactic +val ipat_rewrite : ssrocc -> ssrdir -> EConstr.t -> unit Proofview.tactic val unlocktac : Ltac_plugin.Tacinterp.interp_sign -> (Ssrmatching.occ * Ssrast.ssrterm) list -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml index 43b527c32b..4961138190 100644 --- a/plugins/ssr/ssrfwd.ml +++ b/plugins/ssr/ssrfwd.ml @@ -28,19 +28,22 @@ module RelDecl = Context.Rel.Declaration let posetac id cl = Proofview.V82.of_tactic (Tactics.pose_tac (Name id) cl) -let ssrposetac (id, (_, t)) gl = +let ssrposetac (id, (_, t)) = + Proofview.V82.tactic begin fun gl -> let ist, t = match t.Ssrast.interp_env with | Some ist -> ist, Ssrcommon.ssrterm_of_ast_closure_term t | None -> assert false in let sigma, t, ucst, _ = pf_abs_ssrterm ist gl t in posetac id t (pf_merge_uc ucst gl) + end -let ssrsettac id ((_, (pat, pty)), (_, occ)) gl = +let ssrsettac id ((_, (pat, pty)), (_, occ)) = + Proofview.V82.tactic begin fun gl -> let pty = Option.map (fun { Ssrast.body; interp_env } -> let ist = Option.get interp_env in (mkRHole, Some body), ist) pty in - let pat = interp_cpattern gl pat pty in + let pat = interp_cpattern (pf_env gl) (project gl) pat pty in let cl, sigma, env = pf_concl gl, project gl, pf_env gl in let (c, ucst), cl = let cl = EConstr.Unsafe.to_constr cl in @@ -56,7 +59,8 @@ let ssrsettac id ((_, (pat, pty)), (_, occ)) gl = | Cast(t, DEFAULTcast, ty) -> t, (gl, ty) | _ -> c, pfe_type_of gl c in let cl' = EConstr.mkLetIn (make_annot (Name id) Sorts.Relevant, c, cty, cl) in - Tacticals.tclTHEN (Proofview.V82.of_tactic (convert_concl ~check:true cl')) (introid id) gl + Proofview.V82.of_tactic (Tacticals.New.tclTHEN (convert_concl ~check:true cl') (introid id)) gl + end open Util @@ -85,18 +89,30 @@ let combineCG t1 t2 f g = match t1, t2 with | _, (_, (_, None)) -> anomaly "have: mixed C-G constr" | _ -> anomaly "have: mixed G-C constr" -let basecuttac name c gl = - let hd, gl = pf_mkSsrConst name gl in - let t = EConstr.mkApp (hd, [|c|]) in - let gl, _ = pf_e_type_of gl t in - Proofview.V82.of_tactic (Tactics.apply t) gl +let basecuttac name t = + let open Proofview.Notations in + Ssrcommon.tacMK_SSR_CONST name >>= fun hd -> + let t = EConstr.mkApp (hd, [|t|]) in + Ssrcommon.tacTYPEOF t >>= fun _ty -> + Tactics.apply t -let introstac ipats = Proofview.V82.of_tactic (tclIPAT ipats) +let evarcuttac name cs = + let open Proofview.Notations in + Ssrcommon.tacMK_SSR_CONST name >>= fun hd -> + let t = EConstr.mkApp (hd, cs) in + Ssrcommon.tacTYPEOF t >>= fun _ty -> + applyn ~with_evars:true ~with_shelve:false (Array.length cs) t + +let introstac ipats = tclIPAT ipats let havetac ist (transp,((((clr, orig_pats), binders), simpl), (((fk, _), t), hint))) - suff namefst gl + suff namefst = + let open Proofview.Notations in + Ssrcommon.tacMK_SSR_CONST "abstract_key" >>= fun abstract_key -> + Ssrcommon.tacMK_SSR_CONST "abstract" >>= fun abstract -> + Proofview.V82.tactic begin fun gl -> let concl = pf_concl gl in let pats = tclCompileIPats orig_pats in let binders = tclCompileIPats binders in @@ -108,34 +124,30 @@ let havetac ist match clr with | None -> introstac pats, [] | Some clr -> introstac (tclCompileIPats (IPatClear clr :: orig_pats)), clr in - let itac, id, clr = introstac pats, Tacticals.tclIDTAC, old_cleartac clr in + let itac, id, clr = introstac pats, Tacticals.New.tclIDTAC, cleartac clr in let binderstac n = let rec aux = function 0 -> [] | n -> IOpInaccessible None :: aux (n-1) in - Tacticals.tclTHEN (if binders <> [] then introstac (aux n) else Tacticals.tclIDTAC) + Tacticals.New.tclTHEN (if binders <> [] then introstac (aux n) else Tacticals.New.tclIDTAC) (introstac binders) in let simpltac = introstac simpl in let fixtc = not !ssrhaveNOtcresolution && match fk with FwdHint(_,true) -> false | _ -> true in let hint = hinttac ist true hint in - let cuttac t gl = - if transp then - let have_let, gl = pf_mkSsrConst "ssr_have_let" gl in - let step = EConstr.mkApp (have_let, [|concl;t|]) in - let gl, _ = pf_e_type_of gl step in - applyn ~with_evars:true ~with_shelve:false 2 step gl - else basecuttac "ssr_have" t gl in + let cuttac t = Proofview.Goal.enter begin fun gl -> + if transp then evarcuttac "ssr_have_let" [|concl;t|] + else basecuttac "ssr_have" t + end in (* Introduce now abstract constants, so that everything sees them *) - let abstract_key, gl = pf_mkSsrConst "abstract_key" gl in let unlock_abs (idty,args_id) gl = let gl, _ = pf_e_type_of gl idty in pf_unify_HO gl args_id.(2) abstract_key in - Tacticals.tclTHENFIRST itac_mkabs (fun gl -> + Tacticals.tclTHENFIRST (Proofview.V82.of_tactic itac_mkabs) (fun gl -> let mkt t = mk_term xNoFlag t in let mkl t = (xNoFlag, (t, None)) in let interp gl rtc t = pf_abs_ssrterm ~resolve_typeclasses:rtc ist gl t in let interp_ty gl rtc t = - let a,b,_,u = pf_interp_ty ~resolve_typeclasses:rtc ist gl t in a,b,u in + let a,b,_,u = pf_interp_ty ~resolve_typeclasses:rtc (pf_env gl) (project gl) ist t in a,b,u in let open CAst in let ct, cty, hole, loc = match Ssrcommon.ssrterm_of_ast_closure_term t with | _, (_, Some { loc; v = CCast (ct, CastConv cty)}) -> @@ -163,7 +175,7 @@ let havetac ist try Proofview.V82.of_tactic (convert_concl ~check:true (EConstr.it_mkProd_or_LetIn concl ctx)) gl with _ -> errorstrm (str "Given proof term is not of type " ++ pr_econstr_env (pf_env gl) (project gl) (EConstr.mkArrow (EConstr.mkVar (Id.of_string "_")) Sorts.Relevant concl)) in - gl, ty, Tacticals.tclTHEN assert_is_conv (Proofview.V82.of_tactic (Tactics.apply t)), id, itac_c + gl, ty, Tacticals.New.tclTHEN (Proofview.V82.tactic assert_is_conv) (Tactics.apply t), id, itac_c | FwdHave, false, false -> let skols = List.flatten (List.map (function | IOpAbstractVars ids -> ids @@ -181,13 +193,12 @@ let havetac ist let gs = List.map (fun (_,a) -> Ssripats.Internal.pf_find_abstract_proof false gl (EConstr.Unsafe.to_constr a.(1))) skols_args in - let tacopen_skols gl = re_sig (gs @ [gl.Evd.it]) gl.Evd.sigma in + let tacopen_skols = Proofview.V82.tactic (fun gl -> re_sig (gs @ [gl.Evd.it]) gl.Evd.sigma) in let gl, ty = pf_e_type_of gl t in - gl, ty, Proofview.V82.of_tactic (Tactics.apply t), id, - Tacticals.tclTHEN (Tacticals.tclTHEN itac_c simpltac) - (Tacticals.tclTHEN tacopen_skols (fun gl -> - let abstract, gl = pf_mkSsrConst "abstract" gl in - Proofview.V82.of_tactic (unfold [abstract; abstract_key]) gl)) + gl, ty, Tactics.apply t, id, + Tacticals.New.tclTHEN (Tacticals.New.tclTHEN itac_c simpltac) + (Tacticals.New.tclTHEN tacopen_skols (Proofview.V82.tactic (fun gl -> + Proofview.V82.of_tactic (unfold [abstract; abstract_key]) gl))) | _,true,true -> let _, ty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in gl, EConstr.mkArrow ty Sorts.Relevant concl, hint, itac, clr @@ -196,11 +207,11 @@ let havetac ist gl, EConstr.mkArrow ty Sorts.Relevant concl, hint, id, itac_c | _, false, false -> let n, cty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in - gl, cty, Tacticals.tclTHEN (binderstac n) hint, id, Tacticals.tclTHEN itac_c simpltac + gl, cty, Tacticals.New.tclTHEN (binderstac n) hint, id, Tacticals.New.tclTHEN itac_c simpltac | _, true, false -> assert false in - Tacticals.tclTHENS (cuttac cut) [ Tacticals.tclTHEN sol itac1; itac2 ] gl) + Proofview.V82.of_tactic (Tacticals.New.tclTHENS (cuttac cut) [ Tacticals.New.tclTHEN sol itac1; itac2 ]) gl) gl -;; +end let destProd_or_LetIn sigma c = match EConstr.kind sigma c with @@ -208,7 +219,8 @@ let destProd_or_LetIn sigma c = | LetIn (n,bo,ty,c) -> RelDecl.LocalDef (n, bo, ty), c | _ -> raise DestKO -let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl = +let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave = + Proofview.V82.tactic begin fun gl -> let clr0 = Option.default [] clr0 in let pats = tclCompileIPats pats in let mkabs gen = abs_wgen false (fun x -> x) gen in @@ -243,7 +255,7 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl = let (sigma, ev) = Evarutil.new_evar env sigma EConstr.mkProp in let k, _ = EConstr.destEvar sigma ev in let fake_gl = {Evd.it = k; Evd.sigma = sigma} in - let _, ct, _, uc = pf_interp_ty ist fake_gl ct in + let _, ct, _, uc = pf_interp_ty (pf_env fake_gl) sigma ist ct in let rec var2rel c g s = match EConstr.kind sigma c, g with | Prod({binder_name=Anonymous} as x,_,c), [] -> EConstr.mkProd(x, EConstr.Vars.subst_vars s ct, c) | Sort _, [] -> EConstr.Vars.subst_vars s ct @@ -260,39 +272,40 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl = c, args, pired c args, pf_merge_uc uc gl in let tacipat pats = introstac pats in let tacigens = - Tacticals.tclTHEN - (Tacticals.tclTHENLIST(List.rev(List.fold_right mkclr gens [old_cleartac clr0]))) + Tacticals.New.tclTHEN + (Tacticals.New.tclTHENLIST(List.rev(List.fold_right mkclr gens [cleartac clr0]))) (introstac (List.fold_right mkpats gens [])) in let hinttac = hinttac ist true hint in let cut_kind, fst_goal_tac, snd_goal_tac = match suff, ghave with - | true, `NoGen -> "ssr_wlog", Tacticals.tclTHEN hinttac (tacipat pats), tacigens - | false, `NoGen -> "ssr_wlog", hinttac, Tacticals.tclTHEN tacigens (tacipat pats) + | true, `NoGen -> "ssr_wlog", Tacticals.New.tclTHEN hinttac (tacipat pats), tacigens + | false, `NoGen -> "ssr_wlog", hinttac, Tacticals.New.tclTHEN tacigens (tacipat pats) | true, `Gen _ -> assert false | false, `Gen id -> if gens = [] then errorstrm(str"gen have requires some generalizations"); - let clear0 = old_cleartac clr0 in + let clear0 = cleartac clr0 in let id, name_general_hyp, cleanup, pats = match id, pats with | None, (IOpId id as ip)::pats -> Some id, tacipat [ip], clear0, pats - | None, _ -> None, Tacticals.tclIDTAC, clear0, pats + | None, _ -> None, Tacticals.New.tclIDTAC, clear0, pats | Some (Some id),_ -> Some id, introid id, clear0, pats | Some _,_ -> let id = mk_anon_id "tmp" (Tacmach.pf_ids_of_hyps gl) in - Some id, introid id, Tacticals.tclTHEN clear0 (Proofview.V82.of_tactic (Tactics.clear [id])), pats in + Some id, introid id, Tacticals.New.tclTHEN clear0 (Tactics.clear [id]), pats in let tac_specialize = match id with - | None -> Tacticals.tclIDTAC + | None -> Tacticals.New.tclIDTAC | Some id -> - if pats = [] then Tacticals.tclIDTAC else + if pats = [] then Tacticals.New.tclIDTAC else let args = Array.of_list args in ppdebug(lazy(str"specialized="++ pr_econstr_env (pf_env gl) (project gl) EConstr.(mkApp (mkVar id,args)))); ppdebug(lazy(str"specialized_ty="++ pr_econstr_env (pf_env gl) (project gl) ct)); - Tacticals.tclTHENS (basecuttac "ssr_have" ct) - [Proofview.V82.of_tactic (Tactics.apply EConstr.(mkApp (mkVar id,args))); Tacticals.tclIDTAC] in + Tacticals.New.tclTHENS (basecuttac "ssr_have" ct) + [Tactics.apply EConstr.(mkApp (mkVar id,args)); Tacticals.New.tclIDTAC] in "ssr_have", (if hint = nohint then tacigens else hinttac), - Tacticals.tclTHENLIST [name_general_hyp; tac_specialize; tacipat pats; cleanup] + Tacticals.New.tclTHENLIST [name_general_hyp; tac_specialize; tacipat pats; cleanup] in - Tacticals.tclTHENS (basecuttac cut_kind c) [fst_goal_tac; snd_goal_tac] gl + Proofview.V82.of_tactic (Tacticals.New.tclTHENS (basecuttac cut_kind c) [fst_goal_tac; snd_goal_tac]) gl + end (** The "suffice" tactic *) @@ -301,7 +314,7 @@ let sufftac ist ((((clr, pats),binders),simpl), ((_, c), hint)) = let pats = tclCompileIPats pats in let binders = tclCompileIPats binders in let simpl = tclCompileIPats simpl in - let htac = Tacticals.tclTHEN (introstac pats) (hinttac ist true hint) in + let htac = Tacticals.New.tclTHEN (introstac pats) (hinttac ist true hint) in let c = match Ssrcommon.ssrterm_of_ast_closure_term c with | (a, (b, Some ct)) -> begin match ct.CAst.v with @@ -314,10 +327,12 @@ let sufftac ist ((((clr, pats),binders),simpl), ((_, c), hint)) = | _ -> anomaly "suff: ssr cast hole deleted by typecheck" end in - let ctac gl = - let _,ty,_,uc = pf_interp_ty ist gl c in let gl = pf_merge_uc uc gl in - basecuttac "ssr_suff" ty gl in - Tacticals.tclTHENS ctac [htac; Tacticals.tclTHEN (old_cleartac clr) (introstac (binders@simpl))] + let ctac = + Proofview.V82.tactic begin fun gl -> + let _,ty,_,uc = pf_interp_ty (pf_env gl) (project gl) ist c in let gl = pf_merge_uc uc gl in + Proofview.V82.of_tactic (basecuttac "ssr_suff" ty) gl + end in + Tacticals.New.tclTHENS ctac [htac; Tacticals.New.tclTHEN (cleartac clr) (introstac (binders@simpl))] open Proofview.Notations @@ -340,16 +355,14 @@ let intro_lock ipats = Proofview.tclDISPATCH (ncons (ng - 1) ssrsmovetac @ [Proofview.tclUNIT ()]) in let protect_subgoal env sigma hd args = + Ssrcommon.tacMK_SSR_CONST "Under_rel" >>= fun under_rel -> + Ssrcommon.tacMK_SSR_CONST "Under_rel_from_rel" >>= fun under_from_rel -> Tactics.New.refine ~typecheck:true (fun sigma -> let lm2 = Array.length args - 2 in let sigma, carrier = Typing.type_of env sigma args.(lm2) in let rel = EConstr.mkApp (hd, Array.sub args 0 lm2) in let rel_args = Array.sub args lm2 2 in - let sigma, under_rel = - Ssrcommon.mkSsrConst "Under_rel" env sigma in - let sigma, under_from_rel = - Ssrcommon.mkSsrConst "Under_rel_from_rel" env sigma in let under_rel_args = Array.append [|carrier; rel|] rel_args in let ty = EConstr.mkApp (under_rel, under_rel_args) in let sigma, t = Evarutil.new_evar env sigma ty in @@ -408,7 +421,7 @@ let pretty_rename evar_map term varnames = in aux term varnames -let overtac = Proofview.V82.tactic (ssr_n_tac "over" ~-1) +let overtac = ssr_n_tac "over" ~-1 let check_numgoals ?(minus = 0) nh = Proofview.numgoals >>= fun ng -> @@ -492,7 +505,6 @@ let undertac ?(pad_intro = false) ist ipats ((dir,_),_ as rule) hint = @ [betaiota]) in let rew = - Proofview.V82.tactic - (Ssrequality.ssrrewritetac ~under:true ~map_redex ist [rule]) + Ssrequality.ssrrewritetac ~under:true ~map_redex ist [rule] in rew <*> intro_lock ipats <*> undertacs diff --git a/plugins/ssr/ssrfwd.mli b/plugins/ssr/ssrfwd.mli index 8aacae39af..33bf56cfa9 100644 --- a/plugins/ssr/ssrfwd.mli +++ b/plugins/ssr/ssrfwd.mli @@ -16,9 +16,9 @@ open Ltac_plugin open Ssrast -val ssrsettac : Id.t -> ((ssrfwdfmt * (Ssrmatching_plugin.Ssrmatching.cpattern * ast_closure_term option)) * ssrdocc) -> v82tac +val ssrsettac : Id.t -> ((ssrfwdfmt * (Ssrmatching_plugin.Ssrmatching.cpattern * ast_closure_term option)) * ssrdocc) -> unit Proofview.tactic -val ssrposetac : Id.t * (ssrfwdfmt * ast_closure_term) -> v82tac +val ssrposetac : Id.t * (ssrfwdfmt * ast_closure_term) -> unit Proofview.tactic val havetac : ist -> bool * @@ -27,11 +27,9 @@ val havetac : ist -> (((Ssrast.ssrfwdkind * 'a) * ast_closure_term) * (bool * Tacinterp.Value.t option list))) -> bool -> - bool -> v82tac + bool -> unit Proofview.tactic -val basecuttac : - string -> - EConstr.t -> Goal.goal Evd.sigma -> Evar.t list Evd.sigma +val basecuttac : string -> EConstr.t -> unit Proofview.tactic val wlogtac : Ltac_plugin.Tacinterp.interp_sign -> @@ -46,7 +44,7 @@ val wlogtac : Ltac_plugin.Tacinterp.Value.t Ssrast.ssrhint -> bool -> [< `Gen of Names.Id.t option option | `NoGen > `NoGen ] -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic val sufftac : Ssrast.ist -> @@ -55,7 +53,7 @@ val sufftac : (('a * ast_closure_term) * (bool * Tacinterp.Value.t option list)) -> - Tacmach.tactic + unit Proofview.tactic (* pad_intro (by default false) indicates whether the intro-pattern "=> i..." must be turned into "=> [i...|i...|i...|]" (n+1 branches, diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml index 1edec8e8a0..46f90a7ee1 100644 --- a/plugins/ssr/ssripats.ml +++ b/plugins/ssr/ssripats.ml @@ -191,7 +191,7 @@ let isGEN_PUSH dg = (* generalize `id` as `new_name` *) let gen_astac id new_name = let gen = ((None,Some(false,[])),Ssrmatching.cpattern_of_id id) in - V82.tactic (Ssrcommon.gentac gen) + Ssrcommon.gentac gen <*> Ssrcommon.tclRENAME_HD_PROD new_name (* performs and resets all delayed generalizations *) @@ -337,7 +337,7 @@ let tac_case t = Ssrcommon.tacTYPEOF t >>= fun ty -> Ssrcommon.tacIS_INJECTION_CASE ~ty t >>= fun is_inj -> if is_inj then - V82.tactic ~nf_evars:false (Ssrelim.perform_injection t) + Ssrelim.perform_injection t else Goal.enter begin fun g -> (Ssrelim.casetac t (fun ?seed k -> @@ -384,13 +384,11 @@ end let tclMK_ABSTRACT_VAR id = Goal.enter begin fun gl -> let env, concl = Goal.(env gl, concl gl) in - let step = begin fun sigma -> + let step ablock abstract = begin fun sigma -> let (sigma, (abstract_proof, abstract_ty)) = let (sigma, (ty, _)) = Evarutil.new_type_evar env sigma Evd.univ_flexible_alg in - let (sigma, ablock) = Ssrcommon.mkSsrConst "abstract_lock" env sigma in let (sigma, lock) = Evarutil.new_evar env sigma ablock in - let (sigma, abstract) = Ssrcommon.mkSsrConst "abstract" env sigma in let (sigma, abstract_id) = mk_abstract_id env sigma in let abstract_ty = EConstr.mkApp(abstract, [|ty; abstract_id; lock|]) in let sigma, m = Evarutil.new_evar env sigma abstract_ty in @@ -405,7 +403,9 @@ let tclMK_ABSTRACT_VAR id = Goal.enter begin fun gl -> let sigma, _ = Typing.type_of env sigma term in sigma, term end in - Tactics.New.refine ~typecheck:false step <*> + Ssrcommon.tacMK_SSR_CONST "abstract_lock" >>= fun ablock -> + Ssrcommon.tacMK_SSR_CONST "abstract" >>= fun abstract -> + Tactics.New.refine ~typecheck:false (step ablock abstract) <*> tclFOCUS 1 3 Proofview.shelve end @@ -477,7 +477,7 @@ let rec ipat_tac1 ipat : bool tactic = | IOpInj ipatss -> tclIORPAT (Ssrcommon.tclWITHTOP - (fun t -> V82.tactic ~nf_evars:false (Ssrelim.perform_injection t))) + (fun t -> Ssrelim.perform_injection t)) ipatss <*> notTAC @@ -494,11 +494,11 @@ let rec ipat_tac1 ipat : bool tactic = notTAC | IOpSimpl x -> - V82.tactic ~nf_evars:false (Ssrequality.simpltac x) <*> notTAC + Ssrequality.simpltac x <*> notTAC | IOpRewrite (occ,dir) -> Ssrcommon.tclWITHTOP - (fun x -> V82.tactic ~nf_evars:false (Ssrequality.ipat_rewrite occ dir x)) <*> notTAC + (fun x -> Ssrequality.ipat_rewrite occ dir x) <*> notTAC | IOpAbstractVars ids -> tclMK_ABSTRACT_VARS ids <*> notTAC @@ -622,7 +622,7 @@ end let with_dgens { dgens; gens; clr } maintac = match gens with | [] -> with_defective maintac dgens clr | gen :: gens -> - V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, clr)) <*> maintac dgens gen + Ssrcommon.genstac (gens, clr) <*> maintac dgens gen let mkCoqEq env sigma = let eq = Coqlib.((build_coq_eq_data ()).eq) in @@ -647,7 +647,7 @@ let elim_intro_tac ipats ?seed what eqid ssrelim is_rec clr = | ProdType (_, src, tgt) -> begin match kind_of_type sigma src with | AtomicType (hd, _) when Ssrcommon.is_protect hd env sigma -> - V82.tactic ~nf_evars:false Ssrcommon.unprotecttac <*> + Ssrcommon.unprotecttac <*> Ssrcommon.tclINTRO_ID ipat | _ -> Ssrcommon.tclINTRO_ANON () <*> intro_eq () end @@ -700,7 +700,7 @@ let elim_intro_tac ipats ?seed what eqid ssrelim is_rec clr = | _ -> tclUNIT () in let unprotect = if eqid <> None && is_rec - then V82.tactic ~nf_evars:false Ssrcommon.unprotecttac else tclUNIT () in + then Ssrcommon.unprotecttac else tclUNIT () in begin match seed with | None -> ssrelim | Some s -> IpatMachine.tclSEED_SUBGOALS s ssrelim end <*> @@ -727,7 +727,7 @@ let mkEq dir cl c t n env sigma = let tclLAST_GEN ~to_ind ((oclr, occ), t) conclusion = tclINDEPENDENTL begin Ssrcommon.tacSIGMA >>= fun sigma0 -> Goal.enter_one begin fun g -> - let pat = Ssrmatching.interp_cpattern sigma0 t None in + let pat = Ssrmatching.interp_cpattern (Tacmach.pf_env sigma0) (Tacmach.project sigma0) t None in let cl0, env, sigma, hyps = Goal.(concl g, env g, sigma g, hyps g) in let cl = EConstr.to_constr ~abort_on_undefined_evars:false sigma cl0 in let (c, ucst), cl = @@ -816,7 +816,7 @@ let ssrcasetac (view, (eqid, (dgens, ipats))) = Ssrcommon.tacIS_INJECTION_CASE vc >>= fun inj -> let simple = (eqid = None && deps = [] && occ = None) in if simple && inj then - V82.tactic ~nf_evars:false (Ssrelim.perform_injection vc) <*> + Ssrelim.perform_injection vc <*> Tactics.clear (List.map Ssrcommon.hyp_id clear) <*> tclIPATssr ipats else @@ -870,7 +870,7 @@ let tclIPAT ip = let ssrmovetac = function | _::_ as view, (_, ({ gens = lastgen :: gens; clr }, ipats)) -> - let gentac = V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, [])) in + let gentac = Ssrcommon.genstac (gens, []) in let conclusion _ t clear ccl = Tactics.apply_type ~typecheck:true ccl [t] <*> Tactics.clear (List.map Ssrcommon.hyp_id clear) in @@ -884,7 +884,7 @@ let ssrmovetac = function let dgentac = with_dgens dgens eqmovetac in dgentac <*> tclIPAT (eqmoveipats (IpatMachine.tclCompileIPats [pat]) (IpatMachine.tclCompileIPats ipats)) | _, (_, ({ gens = (_ :: _ as gens); dgens = []; clr}, ipats)) -> - let gentac = V82.tactic ~nf_evars:false (Ssrcommon.genstac (gens, clr)) in + let gentac = Ssrcommon.genstac (gens, clr) in gentac <*> tclIPAT (IpatMachine.tclCompileIPats ipats) | _, (_, ({ clr }, ipats)) -> Tacticals.New.tclTHENLIST [ssrsmovetac; Tactics.clear (List.map Ssrcommon.hyp_id clr); tclIPAT (IpatMachine.tclCompileIPats ipats)] @@ -985,7 +985,7 @@ let ssrabstract dgens = Ssrcommon.tacSIGMA >>= fun gl0 -> let open Ssrmatching in let ipats = List.map (fun (_,cp) -> - match id_of_pattern (interp_cpattern gl0 cp None) with + match id_of_pattern (interp_cpattern (Tacmach.pf_env gl0) (Tacmach.project gl0) cp None) with | None -> IPatAnon (One None) | Some id -> IPatId id) (List.tl gens) in diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg index 442b40221b..0307728819 100644 --- a/plugins/ssr/ssrparser.mlg +++ b/plugins/ssr/ssrparser.mlg @@ -1611,17 +1611,6 @@ let tactic_expr = Pltac.tactic_expr (** 1. Utilities *) -(** Tactic-level diagnosis *) - -(* debug *) - -{ - -(* Let's play with the new proof engine API *) -let old_tac = V82.tactic - -} - (** Name generation *) (* Since Coq now does repeated internal checks of its external lexical *) @@ -1731,18 +1720,20 @@ END { -let ssrautoprop gl = +let ssrautoprop = + Proofview.Goal.enter begin fun gl -> try let tacname = try Tacenv.locate_tactic (qualid_of_ident (Id.of_string "ssrautoprop")) with Not_found -> Tacenv.locate_tactic (ssrqid "ssrautoprop") in let tacexpr = CAst.make @@ Tacexpr.Reference (ArgArg (Loc.tag @@ tacname)) in - V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl - with Not_found -> V82.of_tactic (Auto.full_trivial []) gl + eval_tactic (Tacexpr.TacArg tacexpr) + with Not_found -> Auto.full_trivial [] + end let () = ssrautoprop_tac := ssrautoprop -let tclBY tac = Tacticals.tclTHEN tac (donetac ~-1) +let tclBY tac = Tacticals.New.tclTHEN tac (donetac ~-1) (** Tactical arguments. *) @@ -1760,7 +1751,7 @@ open Ssrfwd } TACTIC EXTEND ssrtclby -| [ "by" ssrhintarg(tac) ] -> { V82.tactic (hinttac ist true tac) } +| [ "by" ssrhintarg(tac) ] -> { hinttac ist true tac } END (* We can't parse "by" in ARGUMENT EXTEND because it will only be made *) @@ -1778,7 +1769,7 @@ END let () = register_ssrtac "tcldo" begin fun args ist -> match args with | [arg] -> let arg = cast_arg wit_ssrdoarg arg in - V82.tactic (ssrdotac ist arg) + ssrdotac ist arg | _ -> assert false end @@ -1827,7 +1818,7 @@ let () = register_ssrtac "tclseq" begin fun args ist -> match args with let tac = cast_arg wit_ssrtclarg tac in let dir = cast_arg wit_ssrseqdir dir in let arg = cast_arg wit_ssrseqarg arg in - V82.tactic (tclSEQAT ist tac dir arg) + tclSEQAT ist tac dir arg | _ -> assert false end @@ -2191,9 +2182,9 @@ let vmexacttac pf = TACTIC EXTEND ssrexact | [ "exact" ssrexactarg(arg) ] -> { let views, (gens_clr, _) = arg in - V82.tactic (tclBY (V82.of_tactic (inner_ssrapplytac views gens_clr ist))) } + tclBY (inner_ssrapplytac views gens_clr ist) } | [ "exact" ] -> { - V82.tactic (Tacticals.tclORELSE (donetac ~-1) (tclBY (V82.of_tactic apply_top_tac))) } + Tacticals.New.tclORELSE (donetac ~-1) (tclBY apply_top_tac) } | [ "exact" "<:" lconstr(pf) ] -> { vmexacttac pf } END @@ -2220,9 +2211,9 @@ END TACTIC EXTEND ssrcongr | [ "congr" ssrcongrarg(arg) ] -> { let arg, dgens = arg in - V82.tactic begin + Proofview.Goal.enter begin fun _ -> match dgens with - | [gens], clr -> Tacticals.tclTHEN (genstac (gens,clr)) (newssrcongrtac arg ist) + | [gens], clr -> Tacticals.New.tclTHEN (genstac (gens,clr)) (newssrcongrtac arg ist) | _ -> errorstrm (str"Dependent family abstractions not allowed in congr") end } END @@ -2342,10 +2333,10 @@ ARGUMENT EXTEND ssrrwarg END TACTIC EXTEND ssrinstofruleL2R -| [ "ssrinstancesofruleL2R" ssrterm(arg) ] -> { V82.tactic (ssrinstancesofrule ist L2R arg) } +| [ "ssrinstancesofruleL2R" ssrterm(arg) ] -> { ssrinstancesofrule ist L2R arg } END TACTIC EXTEND ssrinstofruleR2L -| [ "ssrinstancesofruleR2L" ssrterm(arg) ] -> { V82.tactic (ssrinstancesofrule ist R2L arg) } +| [ "ssrinstancesofruleR2L" ssrterm(arg) ] -> { ssrinstancesofrule ist R2L arg } END (** Rewrite argument sequence *) @@ -2395,7 +2386,7 @@ END TACTIC EXTEND ssrrewrite | [ "rewrite" ssrrwargs(args) ssrclauses(clauses) ] -> - { tclCLAUSES (old_tac (ssrrewritetac ist args)) clauses } + { tclCLAUSES (ssrrewritetac ist args) clauses } END (** The "unlock" tactic *) @@ -2426,16 +2417,16 @@ END TACTIC EXTEND ssrunlock | [ "unlock" ssrunlockargs(args) ssrclauses(clauses) ] -> - { tclCLAUSES (old_tac (unlocktac ist args)) clauses } + { tclCLAUSES (unlocktac ist args) clauses } END (** 8. Forward chaining tactics (pose, set, have, suffice, wlog) *) TACTIC EXTEND ssrpose -| [ "pose" ssrfixfwd(ffwd) ] -> { V82.tactic (ssrposetac ffwd) } -| [ "pose" ssrcofixfwd(ffwd) ] -> { V82.tactic (ssrposetac ffwd) } -| [ "pose" ssrfwdid(id) ssrposefwd(fwd) ] -> { V82.tactic (ssrposetac (id, fwd)) } +| [ "pose" ssrfixfwd(ffwd) ] -> { ssrposetac ffwd } +| [ "pose" ssrcofixfwd(ffwd) ] -> { ssrposetac ffwd } +| [ "pose" ssrfwdid(id) ssrposefwd(fwd) ] -> { ssrposetac (id, fwd) } END (** The "set" tactic *) @@ -2444,7 +2435,7 @@ END TACTIC EXTEND ssrset | [ "set" ssrfwdid(id) ssrsetfwd(fwd) ssrclauses(clauses) ] -> - { tclCLAUSES (old_tac (ssrsettac id fwd)) clauses } + { tclCLAUSES (ssrsettac id fwd) clauses } END (** The "have" tactic *) @@ -2471,27 +2462,27 @@ END TACTIC EXTEND ssrhave | [ "have" ssrhavefwdwbinders(fwd) ] -> - { V82.tactic (havetac ist fwd false false) } + { havetac ist fwd false false } END TACTIC EXTEND ssrhavesuff | [ "have" "suff" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] -> - { V82.tactic (havetac ist (false,(pats,fwd)) true false) } + { havetac ist (false,(pats,fwd)) true false } END TACTIC EXTEND ssrhavesuffices | [ "have" "suffices" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] -> - { V82.tactic (havetac ist (false,(pats,fwd)) true false) } + { havetac ist (false,(pats,fwd)) true false } END TACTIC EXTEND ssrsuffhave | [ "suff" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] -> - { V82.tactic (havetac ist (false,(pats,fwd)) true true) } + { havetac ist (false,(pats,fwd)) true true } END TACTIC EXTEND ssrsufficeshave | [ "suffices" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] -> - { V82.tactic (havetac ist (false,(pats,fwd)) true true) } + { havetac ist (false,(pats,fwd)) true true } END (** The "suffice" tactic *) @@ -2515,11 +2506,11 @@ END TACTIC EXTEND ssrsuff -| [ "suff" ssrsufffwd(fwd) ] -> { V82.tactic (sufftac ist fwd) } +| [ "suff" ssrsufffwd(fwd) ] -> { sufftac ist fwd } END TACTIC EXTEND ssrsuffices -| [ "suffices" ssrsufffwd(fwd) ] -> { V82.tactic (sufftac ist fwd) } +| [ "suffices" ssrsufffwd(fwd) ] -> { sufftac ist fwd } END (** The "wlog" (Without Loss Of Generality) tactic *) @@ -2541,34 +2532,34 @@ END TACTIC EXTEND ssrwlog | [ "wlog" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> - { V82.tactic (wlogtac ist pats fwd hint false `NoGen) } + { wlogtac ist pats fwd hint false `NoGen } END TACTIC EXTEND ssrwlogs | [ "wlog" "suff" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> - { V82.tactic (wlogtac ist pats fwd hint true `NoGen) } + { wlogtac ist pats fwd hint true `NoGen } END TACTIC EXTEND ssrwlogss | [ "wlog" "suffices" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]-> - { V82.tactic (wlogtac ist pats fwd hint true `NoGen) } + { wlogtac ist pats fwd hint true `NoGen } END TACTIC EXTEND ssrwithoutloss | [ "without" "loss" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> - { V82.tactic (wlogtac ist pats fwd hint false `NoGen) } + { wlogtac ist pats fwd hint false `NoGen } END TACTIC EXTEND ssrwithoutlosss | [ "without" "loss" "suff" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> - { V82.tactic (wlogtac ist pats fwd hint true `NoGen) } + { wlogtac ist pats fwd hint true `NoGen } END TACTIC EXTEND ssrwithoutlossss | [ "without" "loss" "suffices" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]-> - { V82.tactic (wlogtac ist pats fwd hint true `NoGen) } + { wlogtac ist pats fwd hint true `NoGen } END { @@ -2617,14 +2608,14 @@ TACTIC EXTEND ssrgenhave | [ "gen" "have" ssrclear(clr) ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> { let pats = augment_preclr clr pats in - V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) } + wlogtac ist pats fwd hint false (`Gen id) } END TACTIC EXTEND ssrgenhave2 | [ "generally" "have" ssrclear(clr) ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] -> { let pats = augment_preclr clr pats in - V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) } + wlogtac ist pats fwd hint false (`Gen id) } END { diff --git a/plugins/ssr/ssrtacticals.ml b/plugins/ssr/ssrtacticals.ml index 00d1296291..cbc352126e 100644 --- a/plugins/ssr/ssrtacticals.ml +++ b/plugins/ssr/ssrtacticals.ml @@ -30,10 +30,12 @@ let get_index = function Locus.ArgArg i -> i | _ -> (** The "first" and "last" tacticals. *) -let tclPERM perm tac gls = - let subgls = tac gls in +let tclPERM perm tac = + Proofview.V82.tactic begin fun gls -> + let subgls = Proofview.V82.of_tactic tac gls in let subgll' = perm subgls.Evd.it in re_sig subgll' subgls.Evd.sigma + end let rot_hyps dir i hyps = let n = List.length hyps in @@ -46,17 +48,17 @@ let rot_hyps dir i hyps = let tclSEQAT ist atac1 dir (ivar, ((_, atacs2), atac3)) = let i = get_index ivar in - let evtac t = Proofview.V82.of_tactic (ssrevaltac ist t) in + let evtac t = ssrevaltac ist t in let tac1 = evtac atac1 in if atacs2 = [] && atac3 <> None then tclPERM (rot_hyps dir i) tac1 else - let evotac = function Some atac -> evtac atac | _ -> Tacticals.tclIDTAC in + let evotac = function Some atac -> evtac atac | _ -> Tacticals.New.tclIDTAC in let tac3 = evotac atac3 in let rec mk_pad n = if n > 0 then tac3 :: mk_pad (n - 1) else [] in match dir, mk_pad (i - 1), List.map evotac atacs2 with - | L2R, [], [tac2] when atac3 = None -> Tacticals.tclTHENFIRST tac1 tac2 - | L2R, [], [tac2] when atac3 = None -> Tacticals.tclTHENLAST tac1 tac2 - | L2R, pad, tacs2 -> Tacticals.tclTHENSFIRSTn tac1 (Array.of_list (pad @ tacs2)) tac3 - | R2L, pad, tacs2 -> Tacticals.tclTHENSLASTn tac1 tac3 (Array.of_list (tacs2 @ pad)) + | L2R, [], [tac2] when atac3 = None -> Tacticals.New.tclTHENFIRST tac1 tac2 + | L2R, [], [tac2] when atac3 = None -> Tacticals.New.tclTHENLAST tac1 tac2 + | L2R, pad, tacs2 -> Tacticals.New.tclTHENSFIRSTn tac1 (Array.of_list (pad @ tacs2)) tac3 + | R2L, pad, tacs2 -> Tacticals.New.tclTHENSLASTn tac1 tac3 (Array.of_list (tacs2 @ pad)) (** The "in" pseudo-tactical *)(* {{{ **********************************************) @@ -74,7 +76,7 @@ let check_wgen_uniq gens = | [] -> () in check [] ids -let pf_clauseids gl gens clseq = +let pf_clauseids gens clseq = let keep_clears = List.map (fun (x, _) -> x, None) in if gens <> [] then (check_wgen_uniq gens; gens) else if clseq <> InAll && clseq <> InAllHyps then keep_clears gens else @@ -82,14 +84,15 @@ let pf_clauseids gl gens clseq = let hidden_clseq = function InHyps | InHypsSeq | InAllHyps -> true | _ -> false -let posetac id cl = Proofview.V82.of_tactic (Tactics.pose_tac (Name id) cl) +let posetac id cl = Tactics.pose_tac (Name id) cl let hidetacs clseq idhide cl0 = if not (hidden_clseq clseq) then [] else [posetac idhide cl0; - Proofview.V82.of_tactic (convert_concl_no_check (EConstr.mkVar idhide))] + convert_concl_no_check (EConstr.mkVar idhide)] -let endclausestac id_map clseq gl_id cl0 gl = +let endclausestac id_map clseq gl_id cl0 = + Proofview.V82.tactic begin fun gl -> let not_hyp' id = not (List.mem_assoc id id_map) in let orig_id id = try List.assoc id id_map with Not_found -> id in let dc, c = EConstr.decompose_prod_assum (project gl) (pf_concl gl) in @@ -124,40 +127,45 @@ let endclausestac id_map clseq gl_id cl0 gl = let all_ids = ids_of_rel_context dc @ pf_ids_of_hyps gl in if List.for_all not_hyp' all_ids && not c_hidden then mktac [] gl else errorstrm Pp.(str "tampering with discharged assumptions of \"in\" tactical") - -let tclCLAUSES tac (gens, clseq) gl = - if clseq = InGoal || clseq = InSeqGoal then tac gl else - let clr_gens = pf_clauseids gl gens clseq in - let clear = Tacticals.tclTHENLIST (List.rev(List.fold_right clr_of_wgen clr_gens [])) in - let gl_id = mk_anon_id hidden_goal_tag (Tacmach.pf_ids_of_hyps gl) in - let cl0 = pf_concl gl in - let dtac gl = + end + +let tclCLAUSES tac (gens, clseq) = + Proofview.Goal.enter begin fun gl -> + if clseq = InGoal || clseq = InSeqGoal then tac else + let clr_gens = pf_clauseids gens clseq in + let clear = Tacticals.New.tclTHENLIST (List.rev(List.fold_right clr_of_wgen clr_gens [])) in + let gl_id = mk_anon_id hidden_goal_tag (Tacmach.New.pf_ids_of_hyps gl) in + let cl0 = Proofview.Goal.concl gl in + let dtac = + Proofview.V82.tactic begin fun gl -> let c = pf_concl gl in let gl, args, c = List.fold_right (abs_wgen true mk_discharged_id) gens (gl,[], c) in - apply_type c args gl in + apply_type c args gl + end + in let endtac = let id_map = CList.map_filter (function | _, Some ((x,_),_) -> let id = hoi_id x in Some (mk_discharged_id id, id) | _, None -> None) gens in endclausestac id_map clseq gl_id cl0 in - Tacticals.tclTHENLIST (hidetacs clseq gl_id cl0 @ [dtac; clear; tac; endtac]) gl + Tacticals.New.tclTHENLIST (hidetacs clseq gl_id cl0 @ [dtac; clear; tac; endtac]) + end (** The "do" tactical. ********************************************************) let hinttac ist is_by (is_or, atacs) = - let dtac = if is_by then donetac ~-1 else Tacticals.tclIDTAC in + Proofview.Goal.enter begin fun _ -> + let dtac = if is_by then donetac ~-1 else Tacticals.New.tclIDTAC in let mktac = function - | Some atac -> Tacticals.tclTHEN (Proofview.V82.of_tactic (ssrevaltac ist atac)) dtac + | Some atac -> Tacticals.New.tclTHEN (ssrevaltac ist atac) dtac | _ -> dtac in match List.map mktac atacs with - | [] -> if is_or then dtac else Tacticals.tclIDTAC + | [] -> if is_or then dtac else Tacticals.New.tclIDTAC | [tac] -> tac - | tacs -> Tacticals.tclFIRST tacs + | tacs -> Tacticals.New.tclFIRST tacs + end let ssrdotac ist (((n, m), tac), clauses) = let mul = get_index n, m in tclCLAUSES (tclMULT mul (hinttac ist false tac)) clauses - -let tclCLAUSES tac g_c = - Proofview.V82.(tactic (tclCLAUSES (of_tactic tac) g_c)) diff --git a/plugins/ssr/ssrtacticals.mli b/plugins/ssr/ssrtacticals.mli index c5b0deb752..f907ac3801 100644 --- a/plugins/ssr/ssrtacticals.mli +++ b/plugins/ssr/ssrtacticals.mli @@ -20,7 +20,7 @@ val tclSEQAT : int Locus.or_var * (('a * Tacinterp.Value.t option list) * Tacinterp.Value.t option) -> - Tacmach.tactic + unit Proofview.tactic val tclCLAUSES : unit Proofview.tactic -> @@ -33,7 +33,7 @@ val tclCLAUSES : val hinttac : Tacinterp.interp_sign -> - bool -> bool * Tacinterp.Value.t option list -> Ssrast.v82tac + bool -> bool * Tacinterp.Value.t option list -> unit Proofview.tactic val ssrdotac : Tacinterp.interp_sign -> @@ -44,5 +44,5 @@ val ssrdotac : Ssrmatching.cpattern option) option) list * Ssrast.ssrclseq) -> - Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + unit Proofview.tactic diff --git a/plugins/ssrmatching/g_ssrmatching.mlg b/plugins/ssrmatching/g_ssrmatching.mlg index 33e523a4a4..2252435658 100644 --- a/plugins/ssrmatching/g_ssrmatching.mlg +++ b/plugins/ssrmatching/g_ssrmatching.mlg @@ -107,7 +107,7 @@ ARGUMENT EXTEND ssrpatternarg TYPED AS rpattern PRINTED BY { pr_rpattern } END TACTIC EXTEND ssrinstoftpat -| [ "ssrinstancesoftpat" cpattern(arg) ] -> { Proofview.V82.tactic (ssrinstancesof arg) } +| [ "ssrinstancesoftpat" cpattern(arg) ] -> { ssrinstancesof arg } END { diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml index 1c776398e7..adaf7c8cc1 100644 --- a/plugins/ssrmatching/ssrmatching.ml +++ b/plugins/ssrmatching/ssrmatching.ml @@ -14,7 +14,6 @@ open Ltac_plugin open Names open Pp open Genarg -open Stdarg open Term open Context module CoqConstr = Constr @@ -22,7 +21,6 @@ open CoqConstr open Vars open Libnames open Tactics -open Tacticals open Termops open Recordops open Tacmach @@ -173,8 +171,6 @@ let loc_ofCG = function let mk_term k c ist = k, (mkRHole, Some c), ist let mk_lterm = mk_term ' ' -let pf_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl) sigma, ty - let nf_evar sigma c = EConstr.Unsafe.to_constr (Evarutil.nf_evar sigma (EConstr.of_constr c)) @@ -263,7 +259,7 @@ let nf_open_term sigma0 ise c = let rec nf c' = match kind c' with | Evar ex -> begin try nf (existential_value0 s ex) with _ -> - let k, a = ex in let a' = Array.map nf a in + let k, a = ex in let a' = List.map nf a in if not (Evd.mem !s' k) then s' := Evd.add !s' k (Evarutil.nf_evar_info s (Evd.find s k)); mkEvar (k, a') @@ -307,7 +303,7 @@ let pf_unify_HO gl t1 t2 = (* This is what the definition of iter_constr should be... *) let iter_constr_LR f c = match kind c with - | Evar (k, a) -> Array.iter f a + | Evar (k, a) -> List.iter f a | Cast (cc, _, t) -> f cc; f t | Prod (_, t, b) | Lambda (_, t, b) -> f t; f b | LetIn (_, v, t, b) -> f v; f t; f b @@ -387,7 +383,7 @@ let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 = with NotInstantiatedEvar -> if Evd.mem sigma0 k then map put c else let evi = Evd.find !sigma k in - let dc = List.firstn (max 0 (Array.length a - nenv)) (evar_filtered_context evi) in + let dc = List.firstn (max 0 (List.length a - nenv)) (evar_filtered_context evi) in let abs_dc (d, c) = function | Context.Named.Declaration.LocalDef (x, b, t) -> d, mkNamedLetIn x (put b) (put t) c @@ -601,7 +597,8 @@ let match_upats_HO ~on_instance upats env sigma0 ise c = | KpatFixed | KpatConst -> ise | KpatEvar _ -> let _, pka = destEvar u.up_f and _, ka = destEvar f in - unif_HO_args env ise pka 0 ka + let fold ise pk k = unif_HO env ise (EConstr.of_constr pk) (EConstr.of_constr k) in + List.fold_left2 fold ise pka ka | KpatLet -> let x, v, t, b = destLetIn f in let _, pv, _, pb = destLetIn u.up_f in @@ -931,31 +928,15 @@ let id_of_Cterm t = match id_of_cpattern t with | Some x -> x | None -> loc_error (loc_of_cpattern t) "Only identifiers are allowed here" -let of_ftactic ftac gl = - let r = ref None in - let tac = Ftactic.run ftac (fun ans -> r := Some ans; Proofview.tclUNIT ()) in - let tac = Proofview.V82.of_tactic tac in - let { sigma = sigma } = tac gl in - let ans = match !r with - | None -> assert false (* If the tactic failed we should not reach this point *) - | Some ans -> ans - in - (sigma, ans) - -let interp_wit wit ist gl x = - let globarg = in_gen (glbwit wit) x in - let arg = interp_genarg ist globarg in - let (sigma, arg) = of_ftactic arg gl in - sigma, Value.cast (topwit wit) arg -let interp_open_constr ist gl gc = - interp_wit wit_open_constr ist gl gc -let pf_intern_term gl (_, c, ist) = glob_constr ist (pf_env gl) (project gl) c +let interp_open_constr ist env sigma gc = + Tacinterp.interp_open_constr ist env sigma gc +let pf_intern_term env sigma (_, c, ist) = glob_constr ist env sigma c let interp_ssrterm ist gl t = Tacmach.project gl, interp_ssrterm ist t -let interp_term gl = function +let interp_term env sigma = function | (_, c, Some ist) -> - on_snd EConstr.Unsafe.to_constr (interp_open_constr ist gl c) + on_snd EConstr.Unsafe.to_constr (interp_open_constr ist env sigma c) | _ -> errorstrm (str"interpreting a term with no ist") let thin id sigma goal = @@ -981,7 +962,7 @@ let pr_ist { lfun= lfun } = pr_id id ++ str":" ++ Geninterp.Val.pr ty) (Id.Map.bindings lfun) *) -let interp_pattern ?wit_ssrpatternarg gl red redty = +let interp_pattern ?wit_ssrpatternarg env sigma0 red redty = pp(lazy(str"interpreting: " ++ pr_pattern red)); let xInT x y = X_In_T(x,y) and inXInT x y = In_X_In_T(x,y) in let inT x = In_T x and eInXInT e x t = E_In_X_In_T(e,x,t) in @@ -989,7 +970,7 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = let mkG ?(k=' ') x ist = k,(x,None), ist in let ist_of (_,_,ist) = ist in let decode (_,_,ist as t) ?reccall f g = - try match DAst.get (pf_intern_term gl t) with + try match DAst.get (pf_intern_term env sigma0 t) with | GCast(t,CastConv c) when isGHole t && isGLambda c-> let (x, c) = destGLambda c in f x (' ',(c,None),ist) @@ -1007,7 +988,7 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = let cleanup_XinE h x rp sigma = let h_k = match kind h with Evar (k,_) -> k | _ -> assert false in let to_clean, update = (* handle rename if x is already used *) - let ctx = pf_hyps gl in + let ctx = Environ.named_context env in let len = Context.Named.length ctx in let name = ref None in try ignore(Context.Named.lookup x ctx); (name, fun k -> @@ -1018,7 +999,6 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = name := Some (Context.Named.Declaration.get_id (List.nth nctx (nlen - len - 1))) end) with Not_found -> ref (Some x), fun _ -> () in - let sigma0 = project gl in let new_evars = let rec aux acc t = match kind t with | Evar (k,_) -> @@ -1071,13 +1051,13 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = match red with | T t -> T (combineCG t ty (mkCCast ?loc:(loc_ofCG t)) mkRCast) | X_In_T (x,t) -> - let gty = pf_intern_term gl ty in + let gty = pf_intern_term env sigma0 ty in E_As_X_In_T (mkG (mkRCast mkRHole gty) (ist_of ty), x, t) | E_In_X_In_T (e,x,t) -> - let ty = mkG (pf_intern_term gl ty) (ist_of ty) in + let ty = mkG (pf_intern_term env sigma0 ty) (ist_of ty) in E_In_X_In_T (combineCG e ty (mkCCast ?loc:(loc_ofCG t)) mkRCast, x, t) | E_As_X_In_T (e,x,t) -> - let ty = mkG (pf_intern_term gl ty) (ist_of ty) in + let ty = mkG (pf_intern_term env sigma0 ty) (ist_of ty) in E_As_X_In_T (combineCG e ty (mkCCast ?loc:(loc_ofCG t)) mkRCast, x, t) | red -> red in pp(lazy(str"typed as: " ++ pr_pattern_w_ids red)); @@ -1085,12 +1065,12 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = | Some b -> a,(g,Some (mkCLetIn ?loc x (mkCHole ~loc) b)), ist | None -> a,(DAst.make ?loc @@ GLetIn (x, DAst.make ?loc @@ GHole (BinderType x, IntroAnonymous, None), None, g), None), ist in match red with - | T t -> let sigma, t = interp_term gl t in sigma, T t - | In_T t -> let sigma, t = interp_term gl t in sigma, In_T t + | T t -> let sigma, t = interp_term env sigma0 t in sigma, T t + | In_T t -> let sigma, t = interp_term env sigma0 t in sigma, In_T t | X_In_T (x, rp) | In_X_In_T (x, rp) -> let mk x p = match red with X_In_T _ -> X_In_T(x,p) | _ -> In_X_In_T(x,p) in let rp = mkXLetIn (Name x) rp in - let sigma, rp = interp_term gl rp in + let sigma, rp = interp_term env sigma0 rp in let _, h, _, rp = destLetIn rp in let sigma = cleanup_XinE h x rp sigma in let rp = subst1 h (nf_evar sigma rp) in @@ -1099,15 +1079,15 @@ let interp_pattern ?wit_ssrpatternarg gl red redty = let mk e x p = match red with E_In_X_In_T _ ->E_In_X_In_T(e,x,p)|_->E_As_X_In_T(e,x,p) in let rp = mkXLetIn (Name x) rp in - let sigma, rp = interp_term gl rp in + let sigma, rp = interp_term env sigma0 rp in let _, h, _, rp = destLetIn rp in let sigma = cleanup_XinE h x rp sigma in let rp = subst1 h (nf_evar sigma rp) in - let sigma, e = interp_term (re_sig (sig_it gl) sigma) e in + let sigma, e = interp_term env sigma e in sigma, mk e h rp ;; -let interp_cpattern gl red redty = interp_pattern gl (T red) redty;; -let interp_rpattern ~wit_ssrpatternarg gl red = interp_pattern ~wit_ssrpatternarg gl red None;; +let interp_cpattern env sigma red redty = interp_pattern env sigma (T red) redty;; +let interp_rpattern ~wit_ssrpatternarg env sigma red = interp_pattern ~wit_ssrpatternarg env sigma red None;; let id_of_pattern = function | _, T t -> (match kind t with Var id -> Some id | _ -> None) @@ -1244,23 +1224,23 @@ let pf_fill_occ env concl occ sigma0 p (sigma, t) ok h = let rdx, _, (sigma, uc, p) = end_U () in sigma, uc, EConstr.of_constr p, EConstr.of_constr concl, EConstr.of_constr rdx -let fill_occ_term env cl occ sigma0 (sigma, t) = +let fill_occ_term env sigma0 cl occ (sigma, t) = try let sigma',uc,t',cl,_= pf_fill_occ env cl occ sigma0 t (sigma, t) all_ok 1 in if sigma' != sigma0 then CErrors.user_err Pp.(str "matching impacts evars") - else cl, (Evd.merge_universe_context sigma' uc, t') + else cl, t' with NoMatch -> try let sigma', uc, t' = unif_end env sigma0 (create_evar_defs sigma) t (fun _ -> true) in if sigma' != sigma0 then raise NoMatch - else cl, (Evd.merge_universe_context sigma' uc, t') + else cl, t' with _ -> errorstrm (str "partial term " ++ pr_econstr_pat env sigma t ++ str " does not match any subterm of the goal") let pf_fill_occ_term gl occ t = let sigma0 = project gl and env = pf_env gl and concl = pf_concl gl in - let cl,(_,t) = fill_occ_term env concl occ sigma0 t in + let cl, t = fill_occ_term env sigma0 concl occ t in cl, t let cpattern_of_id id = @@ -1285,18 +1265,23 @@ let wit_ssrpatternarg = wit_rpatternty let interp_rpattern = interp_rpattern ~wit_ssrpatternarg -let ssrpatterntac _ist arg gl = - let pat = interp_rpattern gl arg in - let sigma0 = project gl in - let concl0 = pf_concl gl in +let ssrpatterntac _ist arg = + let open Proofview.Notations in + Proofview.Goal.enter begin fun gl -> + let sigma0 = Proofview.Goal.sigma gl in + let concl0 = Proofview.Goal.concl gl in + let env = Proofview.Goal.env gl in + let pat = interp_rpattern env sigma0 arg in let concl0 = EConstr.Unsafe.to_constr concl0 in let (t, uc), concl_x = - fill_occ_pattern (pf_env gl) sigma0 concl0 pat noindex 1 in + fill_occ_pattern env sigma0 concl0 pat noindex 1 in let t = EConstr.of_constr t in let concl_x = EConstr.of_constr concl_x in - let gl, tty = pf_type_of gl t in + let sigma, tty = Typing.type_of env sigma0 t in let concl = EConstr.mkLetIn (make_annot (Name (Id.of_string "selected")) Sorts.Relevant, t, tty, concl_x) in - Proofview.V82.of_tactic (convert_concl ~check:true concl DEFAULTcast) gl + Proofview.Unsafe.tclEVARS sigma <*> + convert_concl ~check:true concl DEFAULTcast + end (* Register "ssrpattern" tactic *) let () = @@ -1304,7 +1289,7 @@ let () = let arg = let v = Id.Map.find (Names.Id.of_string "pattern") ist.lfun in Value.cast (topwit wit_ssrpatternarg) v in - Proofview.V82.tactic (ssrpatterntac ist arg) in + ssrpatterntac ist arg in let name = { mltac_plugin = "ssrmatching_plugin"; mltac_tactic = "ssrpattern"; } in let () = Tacenv.register_ml_tactic name [|mltac|] in let tac = @@ -1314,25 +1299,29 @@ let () = Tacenv.register_ltac true false (Id.of_string "ssrpattern") tac in Mltop.declare_cache_obj obj "ssrmatching_plugin" -let ssrinstancesof arg gl = +let ssrinstancesof arg = + Proofview.Goal.enter begin fun gl -> let ok rhs lhs ise = true in (* not (equal lhs (Evarutil.nf_evar ise rhs)) in *) - let env, sigma, concl = pf_env gl, project gl, pf_concl gl in - let concl = EConstr.Unsafe.to_constr concl in - let sigma0, cpat = interp_cpattern gl arg None in + let env = Proofview.Goal.env gl in + let sigma = Proofview.Goal.sigma gl in + let concl = Proofview.Goal.concl gl in + let concl = EConstr.to_constr ~abort_on_undefined_evars:false sigma concl in + let sigma0, cpat = interp_cpattern env sigma arg None in let pat = match cpat with T x -> x | _ -> errorstrm (str"Not supported") in let etpat, tpat = mk_tpattern env sigma (sigma0,pat) (ok pat) L2R pat in let find, conclude = mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true sigma None (etpat,[tpat]) in - let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr_env (pf_env gl) (gl.sigma) p ++ spc() - ++ str "matches:" ++ spc() ++ pr_constr_env (pf_env gl) (gl.sigma) c)); c in + let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr_env env (Proofview.Goal.sigma gl) p ++ spc() + ++ str "matches:" ++ spc() ++ pr_constr_env env (Proofview.Goal.sigma gl) c)); c in ppnl (str"BEGIN INSTANCES"); try while true do ignore(find env concl 1 ~k:print) done; raise NoMatch - with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl + with NoMatch -> ppnl (str"END INSTANCES"); Tacticals.New.tclIDTAC + end module Internal = struct diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli index 31b414cc42..17b47227cb 100644 --- a/plugins/ssrmatching/ssrmatching.mli +++ b/plugins/ssrmatching/ssrmatching.mli @@ -57,7 +57,7 @@ val redex_of_pattern : (** [interp_rpattern ise gl rpat] "internalizes" and "interprets" [rpat] in the current [Ltac] interpretation signature [ise] and tactic input [gl]*) val interp_rpattern : - goal sigma -> + Environ.env -> Evd.evar_map -> rpattern -> pattern @@ -65,7 +65,7 @@ val interp_rpattern : in the current [Ltac] interpretation signature [ise] and tactic input [gl]. [ty] is an optional type for the redex of [cpat] *) val interp_cpattern : - goal sigma -> + Environ.env -> Evd.evar_map -> cpattern -> (glob_constr_and_expr * Geninterp.interp_sign) option -> pattern @@ -191,6 +191,8 @@ val mk_tpattern_matcher : * by [Rel 1] and the instance of [t] *) val pf_fill_occ_term : goal sigma -> occ -> evar_map * EConstr.t -> EConstr.t * EConstr.t +val fill_occ_term : Environ.env -> Evd.evar_map -> EConstr.t -> occ -> evar_map * EConstr.t -> EConstr.t * EConstr.t + (* It may be handy to inject a simple term into the first form of cpattern *) val cpattern_of_term : char * glob_constr_and_expr -> Geninterp.interp_sign -> cpattern @@ -230,7 +232,7 @@ val pf_unsafe_merge_uc : UState.t -> goal Evd.sigma -> goal Evd.sigma (* One can also "Set SsrMatchingDebug" from a .v *) val debug : bool -> unit -val ssrinstancesof : cpattern -> Tacmach.tactic +val ssrinstancesof : cpattern -> unit Proofview.tactic (** Functions used for grammar extensions. Do not use. *) diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml index f816599a17..b39ec37cd1 100644 --- a/pretyping/cbv.ml +++ b/pretyping/cbv.ml @@ -446,7 +446,7 @@ let rec norm_head info env t stack = Some c -> norm_head info env c stack | None -> let e, xs = ev in - let xs' = Array.map (apply_env env) xs in + let xs' = List.map (apply_env env) xs in (VAL(0, mkEvar (e,xs')), stack)) (* non-neutral cases *) diff --git a/pretyping/constr_matching.ml b/pretyping/constr_matching.ml index f85635528d..25aa8915ba 100644 --- a/pretyping/constr_matching.ml +++ b/pretyping/constr_matching.ml @@ -404,7 +404,7 @@ let matches_core env sigma allow_bound_rels Array.fold_left2 (fun subst na1 na2 -> add_binders na1 na2 binding_vars subst) subst lna1 lna2 | PEvar (c1,args1), Evar (c2,args2) when Evar.equal c1 c2 -> - Array.fold_left2 (sorec ctx env) subst args1 args2 + List.fold_left2 (sorec ctx env) subst args1 args2 | PInt i1, Int i2 when Uint63.equal i1 i2 -> subst | PFloat f1, Float f2 when Float64.equal f1 f2 -> subst | (PRef _ | PVar _ | PRel _ | PApp _ | PProj _ | PLambda _ diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 857918c928..ff278baf9f 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -790,7 +790,7 @@ and detype_r d flags avoid env sigma t = id,l with Not_found -> Id.of_string ("X" ^ string_of_int (Evar.repr evk)), - (Array.map_to_list (fun c -> (Id.of_string "__",c)) cl) + (List.map (fun c -> (Id.of_string "__",c)) cl) in GEvar (id, List.map (on_snd (detype d flags avoid env sigma)) l) diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 3d887e1a95..f1506f5f59 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -195,7 +195,7 @@ let occur_rigidly flags env evd (evk,_) t = | Evar (evk',l as ev) -> if Evar.equal evk evk' then Rigid true else if is_frozen flags ev then - Rigid (Array.exists (fun x -> rigid_normal_occ (aux x)) l) + Rigid (List.exists (fun x -> rigid_normal_occ (aux x)) l) else Reducible | Cast (p, _, _) -> aux p | Lambda (na, t, b) -> aux b @@ -351,6 +351,14 @@ let ise_array2 evd f v1 v2 = if Int.equal lv1 (Array.length v2) then allrec evd (pred lv1) else UnifFailure (evd,NotSameArgSize) +let rec ise_inst2 evd f l1 l2 = match l1, l2 with +| [], [] -> Success evd +| [], (_ :: _) | (_ :: _), [] -> assert false +| c1 :: l1, c2 :: l2 -> + match ise_inst2 evd f l1 l2 with + | Success evd' -> f evd' c1 c2 + | UnifFailure _ as x -> x + (* Applicative node of stack are read from the outermost to the innermost but are unified the other way. *) let rec ise_app_stack2 env f evd sk1 sk2 = @@ -1019,7 +1027,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) flags env evd pbty if Evar.equal sp1 sp2 then match ise_stack2 false env evd (evar_conv_x flags) sk1 sk2 with |None, Success i' -> - ise_array2 i' (fun i' -> evar_conv_x flags env i' CONV) al1 al2 + ise_inst2 i' (fun i' -> evar_conv_x flags env i' CONV) al1 al2 |_, (UnifFailure _ as x) -> x |Some _, _ -> UnifFailure (evd,NotSameArgSize) else UnifFailure (evd,NotSameHead) @@ -1241,6 +1249,7 @@ let filter_possible_projections evd c ty ctxt args = (* Since args in the types will be replaced by holes, we count the fv of args to have a well-typed filter; don't know how necessary it is however to have a well-typed filter here *) + let args = Array.of_list args in let fv1 = free_rels evd (mkApp (c,args)) (* Hack: locally untyped *) in let fv2 = collect_vars evd (mkApp (c,args)) in let len = Array.length args in @@ -1309,8 +1318,8 @@ let thin_evars env sigma sign c = match kind !sigma t with | Evar (ev, args) -> let evi = Evd.find_undefined !sigma ev in - let filter = Array.map (fun c -> Id.Set.subset (collect_vars !sigma c) ctx) args in - let filter = Filter.make (Array.to_list filter) in + let filter = List.map (fun c -> Id.Set.subset (collect_vars !sigma c) ctx) args in + let filter = Filter.make filter in let candidates = Option.map (List.map EConstr.of_constr) (evar_candidates evi) in let evd, ev = restrict_evar !sigma ev filter candidates in sigma := evd; whd_evar !sigma t @@ -1336,9 +1345,9 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = if debug_ho_unification () then (Feedback.msg_debug Pp.(str"env rhs: " ++ Termops.Internal.print_env env_rhs); Feedback.msg_debug Pp.(str"env evars: " ++ Termops.Internal.print_env env_evar)); - let args = Array.map (nf_evar evd) args in + let args = List.map (nf_evar evd) args in let vars = List.map NamedDecl.get_id ctxt in - let argsubst = List.map2 (fun id c -> (id, c)) vars (Array.to_list args) in + let argsubst = List.map2 (fun id c -> (id, c)) vars args in let instance = List.map mkVar vars in let rhs = nf_evar evd rhs in if not (noccur_evar env_rhs evd evk rhs) then raise (TypingFailed evd); @@ -1416,7 +1425,7 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = set_holes env_rhs' evd rhs' subst | [] -> evd, rhs in - let subst = make_subst (ctxt,Array.to_list args,argoccs) in + let subst = make_subst (ctxt,args,argoccs) in let evd, rhs' = set_holes env_rhs evd rhs subst in let rhs' = nf_evar evd rhs' in @@ -1533,7 +1542,7 @@ let default_evar_selection flags evd (ev,args) = in spec :: aux args abs | l, [] -> List.map (fun _ -> default_occurrence_selection) l | [], _ :: _ -> assert false - in aux (Array.to_list args) evi.evar_abstract_arguments + in aux args evi.evar_abstract_arguments let second_order_matching_with_args flags env evd with_ho pbty ev l t = if with_ho then diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml index 50187d82cc..71edcaa231 100644 --- a/pretyping/evardefine.ml +++ b/pretyping/evardefine.ml @@ -113,7 +113,7 @@ let define_evar_as_product env evd (evk,args) = (* Quick way to compute the instantiation of evk with args *) let na,dom,rng = destProd evd prod in let evdom = mkEvar (fst (destEvar evd dom), args) in - let evrngargs = Array.cons (mkRel 1) (Array.map (lift 1) args) in + let evrngargs = mkRel 1 :: List.map (lift 1) args in let evrng = mkEvar (fst (destEvar evd rng), evrngargs) in evd, mkProd (na, evdom, evrng) @@ -152,7 +152,7 @@ let define_evar_as_lambda env evd (evk,args) = let evd,lam = define_pure_evar_as_lambda env evd evk in (* Quick way to compute the instantiation of evk with args *) let na,dom,body = destLambda evd lam in - let evbodyargs = Array.cons (mkRel 1) (Array.map (lift 1) args) in + let evbodyargs = mkRel 1 :: List.map (lift 1) args in let evbody = mkEvar (fst (destEvar evd body), evbodyargs) in evd, mkLambda (na, dom, evbody) @@ -163,7 +163,7 @@ let rec evar_absorb_arguments env evd (evk,args as ev) = function let evd,lam = define_pure_evar_as_lambda env evd evk in let _,_,body = destLambda evd lam in let evk = fst (destEvar evd body) in - evar_absorb_arguments env evd (evk, Array.cons a args) l + evar_absorb_arguments env evd (evk, a :: args) l (* Refining an evar to a sort *) diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index e475e4c52b..34684e4a34 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -217,7 +217,7 @@ type 'a update = | NoUpdate open Context.Named.Declaration -let inst_of_vars sign = Array.map_of_list (get_id %> mkVar) sign +let inst_of_vars sign = List.map (get_id %> mkVar) sign let restrict_evar_key evd evk filter candidates = match filter, candidates with @@ -247,7 +247,7 @@ let restrict_applied_evar evd (evk,argsv) filter candidates = | Some filter -> let evi = Evd.find evd evk in let subfilter = Filter.compose (evar_filter evi) filter in - Filter.filter_array subfilter argsv in + Filter.filter_list subfilter argsv in evd,(newevk,newargsv) (* Restrict an evar in the current evar_map *) @@ -258,7 +258,7 @@ let restrict_evar evd evk filter candidates = let restrict_instance evd evk filter argsv = match filter with None -> argsv | Some filter -> let evi = Evd.find evd evk in - Filter.filter_array (Filter.compose (evar_filter evi) filter) argsv + Filter.filter_list (Filter.compose (evar_filter evi) filter) argsv open Context.Rel.Declaration let noccur_evar env evd evk c = @@ -269,7 +269,7 @@ let noccur_evar env evd evk c = if Evar.equal evk evk' then raise Occur else (if check_types then occur_rec false acc (existential_type evd ev'); - Array.iter (occur_rec check_types acc) args') + List.iter (occur_rec check_types acc) args') | Rel i when i > k -> if not (Int.Set.mem (i-k) !cache) then let decl = Environ.lookup_rel i env in @@ -552,17 +552,13 @@ let get_actual_deps env evd aliases l t = open Context.Named.Declaration let remove_instance_local_defs evd evk args = let evi = Evd.find evd evk in - let len = Array.length args in - let rec aux sign i = match sign with - | [] -> - let () = assert (i = len) in [] - | LocalAssum _ :: sign -> - let () = assert (i < len) in - (Array.unsafe_get args i) :: aux sign (succ i) - | LocalDef _ :: sign -> - aux sign (succ i) + let rec aux sign args = match sign, args with + | [], [] -> [] + | LocalAssum _ :: sign, c :: args -> c :: aux sign args + | LocalDef _ :: sign, _ :: args -> aux sign args + | _ -> assert false in - aux (evar_filtered_context evi) 0 + aux (evar_filtered_context evi) args (* Check if an applied evar "?X[args] l" is a Miller's pattern *) @@ -688,7 +684,7 @@ let make_projectable_subst aliases sigma evi args = let all = Int.Map.add i [a, id] all in (rest,all,cstrs,revmap)) | _ -> anomaly (Pp.str "Instance does not match its signature.")) 0 - sign (Array.rev_to_list args,Int.Map.empty,Constrmap.empty,Id.Map.empty) in + sign (List.rev args,Int.Map.empty,Constrmap.empty,Id.Map.empty) in (full_subst,cstr_subst) (*------------------------------------* @@ -765,7 +761,7 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env = (mkRel 1)::(List.map (lift 1) inst_in_sign), push_rel d env,evd,Id.Set.add id.binder_name avoid)) rel_sign - (sign1,filter1,Array.to_list args1,inst_in_sign,env1,evd,avoid) + (sign1,filter1,args1,inst_in_sign,env1,evd,avoid) in let evd,ev2ty_in_sign = let s = Retyping.get_sort_of env evd ty_in_env in @@ -775,11 +771,12 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env = ty_t_in_sign sign2 filter2 inst2_in_env in let (evd, ev2_in_sign) = new_evar_instance sign2 evd ev2ty_in_sign ~filter:filter2 ~src inst2_in_sign in - let ev2_in_env = (fst (destEvar evd ev2_in_sign), Array.of_list inst2_in_env) in + let ev2_in_env = (fst (destEvar evd ev2_in_sign), inst2_in_env) in (evd, ev2_in_sign, ev2_in_env) let restrict_upon_filter evd evk p args = let oldfullfilter = evar_filter (Evd.find_undefined evd evk) in + let args = Array.of_list args in let len = Array.length args in Filter.restrict_upon oldfullfilter len (fun i -> p (Array.unsafe_get args i)) @@ -1034,7 +1031,7 @@ let invert_invertible_arg fullenv evd aliases k (evk,argsv) args' = let p = invert_arg fullenv evd aliases k evk subst arg in extract_unique_projection p in - Array.map invert args' + List.map invert args' (* Redefines an evar with a smaller context (i.e. it may depend on less * variables) such that c becomes closed. @@ -1390,9 +1387,9 @@ let solve_refl ?(can_drop=false) unify flags env evd pbty evk argsv1 argsv2 = try evdref := Evd.add_universe_constraints !evdref cstr; true with UniversesDiffer -> false in - if Array.equal eq_constr argsv1 argsv2 then !evdref else + if List.equal eq_constr argsv1 argsv2 then !evdref else (* Filter and restrict if needed *) - let args = Array.map2 (fun a1 a2 -> (a1, a2)) argsv1 argsv2 in + let args = List.map2 (fun a1 a2 -> (a1, a2)) argsv1 argsv2 in let untypedfilter = restrict_upon_filter evd evk (fun (a1,a2) -> unify flags TermUnification env evd Reduction.CONV a1 a2) args in @@ -1452,7 +1449,7 @@ let occur_evar_upto_types sigma n c = | Evar (sp,_) when Evar.equal sp n -> raise Occur | Evar (sp,args as e) -> if Evar.Set.mem sp !seen then - Array.iter occur_rec args + List.iter occur_rec args else ( seen := Evar.Set.add sp !seen; Option.iter occur_rec (existential_opt_value0 sigma e); @@ -1570,7 +1567,7 @@ let rec invert_definition unify flags choose imitate_defs (* Evar/Evar problem (but left evar is virtual) *) let aliases = lift_aliases k aliases in (try - let ev = (evk,Array.map (lift k) argsv) in + let ev = (evk,List.map (lift k) argsv) in let evd,body = project_evar_on_evar false unify flags env' !evdref aliases k None ev' ev in evdref := evd; body @@ -1648,7 +1645,7 @@ let rec invert_definition unify flags choose imitate_defs | [], [] -> true | _ -> false in - is_id_subst filter_ctxt (Array.to_list argsv) && + is_id_subst filter_ctxt argsv && closed0 evd rhs && Id.Set.subset (collect_vars evd rhs) !names in diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index 0a1b731e6b..3fb80432ad 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -99,7 +99,7 @@ val refresh_universes : env -> evar_map -> types -> evar_map * types val solve_refl : ?can_drop:bool -> conversion_check -> unify_flags -> env -> evar_map -> - bool option -> Evar.t -> constr array -> constr array -> evar_map + bool option -> Evar.t -> constr list -> constr list -> evar_map val solve_evar_evar : ?force:bool -> (env -> evar_map -> bool option -> existential -> constr -> evar_map) -> @@ -128,7 +128,7 @@ val check_evar_instance : unifier -> unify_flags -> env -> evar_map -> Evar.t -> constr -> evar_map val remove_instance_local_defs : - evar_map -> Evar.t -> 'a array -> 'a list + evar_map -> Evar.t -> 'a list -> 'a list val get_type_of_refresh : ?polyprop:bool -> ?lax:bool -> env -> evar_map -> constr -> evar_map * types diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml index 34498458a4..d672ddc906 100644 --- a/pretyping/nativenorm.ml +++ b/pretyping/nativenorm.ml @@ -423,8 +423,8 @@ and nf_evar env sigma evk args = let hyps = Environ.named_context_of_val (Evd.evar_filtered_hyps evi) in let ty = EConstr.to_constr ~abort_on_undefined_evars:false sigma @@ Evd.evar_concl evi in if List.is_empty hyps then begin - assert (Int.equal (Array.length args) 0); - mkEvar (evk, [||]), ty + assert (Array.is_empty args); + mkEvar (evk, []), ty end else (* Let-bound arguments are present in the evar arguments but not @@ -436,7 +436,7 @@ and nf_evar env sigma evk args = (* nf_args takes arguments in the reverse order but produces them in the correct one, so we have to reverse them again for the evar node *) - mkEvar (evk, Array.rev_of_list args), ty + mkEvar (evk, List.rev args), ty let evars_of_evar_map sigma = { Nativelambda.evars_val = Evd.existential_opt_value0 sigma; diff --git a/pretyping/pattern.ml b/pretyping/pattern.ml index 3f2e690da5..1dfb8b2cd1 100644 --- a/pretyping/pattern.ml +++ b/pretyping/pattern.ml @@ -24,7 +24,7 @@ type case_info_pattern = type constr_pattern = | PRef of GlobRef.t | PVar of Id.t - | PEvar of Evar.t * constr_pattern array + | PEvar of constr_pattern Constr.pexistential | PRel of int | PApp of constr_pattern * constr_pattern array | PSoApp of patvar * constr_pattern list diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml index b8635d03b7..6d30e0338e 100644 --- a/pretyping/patternops.ml +++ b/pretyping/patternops.ml @@ -31,7 +31,7 @@ let rec constr_pattern_eq p1 p2 = match p1, p2 with | PRef r1, PRef r2 -> GlobRef.equal r1 r2 | PVar v1, PVar v2 -> Id.equal v1 v2 | PEvar (ev1, ctx1), PEvar (ev2, ctx2) -> - Evar.equal ev1 ev2 && Array.equal constr_pattern_eq ctx1 ctx2 + Evar.equal ev1 ev2 && List.equal constr_pattern_eq ctx1 ctx2 | PRel i1, PRel i2 -> Int.equal i1 i2 | PApp (t1, arg1), PApp (t2, arg2) -> @@ -115,7 +115,7 @@ let rec occurn_pattern n = function (occurn_pattern n c) || (List.exists (fun (_,_,p) -> occurn_pattern n p) br) | PMeta _ | PSoApp _ -> true - | PEvar (_,args) -> Array.exists (occurn_pattern n) args + | PEvar (_,args) -> List.exists (occurn_pattern n) args | PVar _ | PRef _ | PSort _ | PInt _ | PFloat _ -> false | PFix (_,(_,tl,bl)) -> Array.exists (occurn_pattern n) tl || Array.exists (occurn_pattern (n+Array.length tl)) bl @@ -190,7 +190,7 @@ let pattern_of_constr env sigma t = (* These are the two evar kinds used for existing goals *) (* see Proofview.mark_in_evm *) if Evd.is_defined sigma evk then pattern_of_constr env (Evd.existential_value0 sigma ev) - else PEvar (evk,Array.map (pattern_of_constr env) ctxt) + else PEvar (evk,List.map (pattern_of_constr env) ctxt) | Evar_kinds.MatchingVar (Evar_kinds.SecondOrderPatVar ido) -> assert false | _ -> PMeta None) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 940150b15a..f7e3d651ff 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -607,7 +607,7 @@ let pretype_instance self ~program_mode ~poly resolve_tc env sigma loc hyps evk ((id,c)::subst, update, sigma) in let subst,inst,sigma = List.fold_right f hyps ([],update,sigma) in check_instance loc subst inst; - sigma, Array.map_of_list snd subst + sigma, List.map snd subst module Default = struct diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 70605d58ab..2c717b8774 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -86,7 +86,7 @@ let evaluable_reference_eq sigma r1 r2 = match r1, r2 with | EvalVar id1, EvalVar id2 -> Id.equal id1 id2 | EvalRel i1, EvalRel i2 -> Int.equal i1 i2 | EvalEvar (e1, ctx1), EvalEvar (e2, ctx2) -> - Evar.equal e1 e2 && Array.equal (EConstr.eq_constr sigma) ctx1 ctx2 + Evar.equal e1 e2 && List.equal (EConstr.eq_constr sigma) ctx1 ctx2 | _ -> false let mkEvalRef ref u = @@ -408,7 +408,7 @@ let substl_with_function subst sigma constr = let (sigma, evk) = Evarutil.new_pure_evar venv sigma dummy in evd := sigma; minargs := Evar.Map.add evk min !minargs; - Vars.lift k (mkEvar (evk, [|fx;ref|])) + Vars.lift k (mkEvar (evk, [fx; ref])) | (fx, None) -> Vars.lift k fx else mkRel (i - Array.length v) | _ -> @@ -455,7 +455,7 @@ let substl_checking_arity env subst sigma c = (* we propagate the constraints: solved problems are substituted; the other ones are replaced by the function symbol *) let rec nf_fix c = match EConstr.kind sigma c with - | Evar (i,[|fx;f|]) when Evar.Map.mem i minargs -> + | Evar (i,[fx;f]) when Evar.Map.mem i minargs -> (* FIXME: find a less hackish way of doing this *) begin match EConstr.kind sigma' c with | Evar _ -> f diff --git a/pretyping/unification.ml b/pretyping/unification.ml index e168f6d1b6..f5aaac315a 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -76,7 +76,7 @@ let occur_meta_or_undefined_evar evd c = | Evar (ev,args) -> (match evar_body (Evd.find evd ev) with | Evar_defined c -> - occrec (EConstr.Unsafe.to_constr c); Array.iter occrec args + occrec (EConstr.Unsafe.to_constr c); List.iter occrec args | Evar_empty -> raise Occur) | _ -> Constr.iter occrec c in try occrec c; false with Occur | Not_found -> true @@ -138,9 +138,9 @@ let abstract_list_all env evd typ c l = error_cannot_find_well_typed_abstraction env evd p l (Some (env',x)) in evd,(p,typp) -let set_occurrences_of_last_arg args = +let set_occurrences_of_last_arg n = Evarconv.AtOccurrences AllOccurrences :: - List.tl (Array.map_to_list (fun _ -> Evarconv.Unspecified Abstraction.Abstract) args) + List.tl (List.init n (fun _ -> Evarconv.Unspecified Abstraction.Abstract)) let occurrence_test _ _ _ env sigma _ c1 c2 = match EConstr.eq_constr_universes env sigma c1 c2 with @@ -153,7 +153,8 @@ let abstract_list_all_with_dependencies env evd typ c l = let (evd, ev) = new_evar env evd typ in let evd,ev' = evar_absorb_arguments env evd (destEvar evd ev) l in let n = List.length l in - let argoccs = set_occurrences_of_last_arg (Array.sub (snd ev') 0 n) in + let () = assert (n <= List.length (snd ev')) in + let argoccs = set_occurrences_of_last_arg n in let evd,b = Evarconv.second_order_matching (Evarconv.default_flags_of TransparentState.empty) @@ -623,7 +624,7 @@ let subst_defined_metas_evars sigma (bl,el) c = substrec (EConstr.Unsafe.to_constr (pi2 (List.find select bl))) | Evar (evk,args) -> let eq c1 c2 = Constr.equal c1 (EConstr.Unsafe.to_constr c2) in - let select (_,(evk',args'),_) = Evar.equal evk evk' && Array.for_all2 eq args args' in + let select (_,(evk',args'),_) = Evar.equal evk evk' && List.for_all2 eq args args' in (try substrec (EConstr.Unsafe.to_constr (pi3 (List.find select el))) with Not_found -> Constr.map substrec c) | _ -> Constr.map substrec c diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index d4da93cc5b..37c34d55cf 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -205,7 +205,7 @@ and nf_evar env sigma evk stk = let hyps = Environ.named_context_of_val (Evd.evar_filtered_hyps evi) in let concl = EConstr.to_constr ~abort_on_undefined_evars:false sigma @@ Evd.evar_concl evi in if List.is_empty hyps then - nf_stk env sigma (mkEvar (evk, [||])) concl stk + nf_stk env sigma (mkEvar (evk, [])) concl stk else match stk with | Zapp args :: stk -> (* We assume that there is no consecutive Zapp nodes in a VM stack. Is that @@ -217,6 +217,7 @@ and nf_evar env sigma evk stk = let t = List.fold_left fold concl hyps in let t, args = nf_args env sigma args t in let inst, args = Array.chop (List.length hyps) args in + let inst = Array.to_list inst in let c = mkApp (mkEvar (evk, inst), args) in nf_stk env sigma c t stk | _ -> diff --git a/printing/printer.ml b/printing/printer.ml index 81c0a36f53..c2f73715f0 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -989,4 +989,5 @@ let print_and_diff oldp newp = let pr_typing_flags flags = str "check_guarded: " ++ bool flags.check_guarded ++ fnl () ++ str "check_positive: " ++ bool flags.check_positive ++ fnl () - ++ str "check_universes: " ++ bool flags.check_universes + ++ str "check_universes: " ++ bool flags.check_universes ++ fnl () + ++ str "cumulative sprop: " ++ bool flags.cumulative_sprop diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml index 767f93787d..695e103082 100644 --- a/proofs/clenvtac.ml +++ b/proofs/clenvtac.ml @@ -61,10 +61,7 @@ let clenv_pose_dependent_evars ?(with_evars=false) clenv = clenv_pose_metas_as_evars clenv dep_mvs let clenv_refine ?(with_evars=false) ?(with_classes=true) clenv = - (* ppedrot: a Goal.enter here breaks things, because the tactic below may - solve goals by side effects, while the compatibility layer keeps those - useless goals. That deserves a FIXME. *) - Proofview.V82.tactic begin fun gl -> + Proofview.Goal.enter begin fun gl -> let clenv, evars = clenv_pose_dependent_evars ~with_evars clenv in let evd' = if with_classes then @@ -78,9 +75,9 @@ let clenv_refine ?(with_evars=false) ?(with_classes=true) clenv = else clenv.evd in let clenv = { clenv with evd = evd' } in - tclTHEN - (tclEVARS (Evd.clear_metas evd')) - (refiner ~check:false EConstr.Unsafe.(to_constr (clenv_cast_meta clenv (clenv_value clenv)))) gl + Proofview.tclTHEN + (Proofview.Unsafe.tclEVARS (Evd.clear_metas evd')) + (refiner ~check:false EConstr.Unsafe.(to_constr (clenv_cast_meta clenv (clenv_value clenv)))) end let clenv_pose_dependent_evars ?(with_evars=false) clenv = diff --git a/proofs/goal.ml b/proofs/goal.ml index b1f8fd3e97..53d3047bc7 100644 --- a/proofs/goal.ml +++ b/proofs/goal.ml @@ -69,7 +69,7 @@ module V82 = struct let (evars, evk) = Evarutil.new_pure_evar_full evars ~typeclass_candidate:false evi in let evars = Evd.restore_future_goals evars prev_future_goals in let ctxt = Environ.named_context_of_val hyps in - let inst = Array.map_of_list (NamedDecl.get_id %> EConstr.mkVar) ctxt in + let inst = List.map (NamedDecl.get_id %> EConstr.mkVar) ctxt in let ev = EConstr.mkEvar (evk,inst) in (evk, ev, evars) diff --git a/proofs/refiner.ml b/proofs/refiner.ml index 75c3436cf4..29a47c5acd 100644 --- a/proofs/refiner.ml +++ b/proofs/refiner.ml @@ -37,6 +37,8 @@ let refiner ~check = CProfile.profile2 refiner_key (refiner ~check) else refiner ~check +let refiner ~check c = Proofview.V82.tactic ~nf_evars:false (refiner ~check c) + (*********************) (* Tacticals *) (*********************) @@ -269,5 +271,3 @@ let tclAT_LEAST_ONCE t = (tclTHEN t (tclREPEAT t)) (* Change evars *) let tclEVARS sigma gls = tclIDTAC {gls with sigma=sigma} -let tclPUSHEVARUNIVCONTEXT ctx gl = - tclEVARS (Evd.merge_universe_context (project gl) ctx) gl diff --git a/proofs/refiner.mli b/proofs/refiner.mli index 66eae1db81..3471f38e9e 100644 --- a/proofs/refiner.mli +++ b/proofs/refiner.mli @@ -22,7 +22,7 @@ val project : 'a sigma -> evar_map val pf_env : Goal.goal sigma -> Environ.env val pf_hyps : Goal.goal sigma -> named_context -val refiner : check:bool -> Constr.t -> tactic +val refiner : check:bool -> Constr.t -> unit Proofview.tactic (** {6 Tacticals. } *) @@ -32,7 +32,6 @@ val tclIDTAC_MESSAGE : Pp.t -> tactic (** [tclEVARS sigma] changes the current evar map *) val tclEVARS : evar_map -> tactic -val tclPUSHEVARUNIVCONTEXT : UState.t -> tactic (** [tclTHEN tac1 tac2 gls] applies the tactic [tac1] to [gls] and applies diff --git a/stm/stm.ml b/stm/stm.ml index f3768e9b99..5790bfc07e 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -2023,12 +2023,16 @@ end = struct (* {{{ *) match Future.join f with | Some (pt, uc) -> let sigma, env = PG_compat.get_current_context () in + let push_state ctx = + Proofview.tclEVARMAP >>= fun sigma -> + Proofview.Unsafe.tclEVARS (Evd.merge_universe_context sigma ctx) + in stm_pperr_endline (fun () -> hov 0 ( str"g=" ++ int (Evar.repr gid) ++ spc () ++ str"t=" ++ (Printer.pr_constr_env env sigma pt) ++ spc () ++ str"uc=" ++ Termops.pr_evar_universe_context uc)); (if abstract then Abstract.tclABSTRACT None else (fun x -> x)) - (V82.tactic (Refiner.tclPUSHEVARUNIVCONTEXT uc) <*> + (push_state uc <*> Tactics.exact_no_check (EConstr.of_constr pt)) | None -> if solve then Tacticals.New.tclSOLVE [] else tclUNIT () diff --git a/tactics/abstract.ml b/tactics/abstract.ml index 0e78a03f45..6b575d0807 100644 --- a/tactics/abstract.ml +++ b/tactics/abstract.ml @@ -40,6 +40,9 @@ let name_op_to_name ~name_op ~name suffix = | Some s -> s | None -> Nameops.add_suffix name suffix +let declare_abstract = ref (fun ~name ~poly ~kind ~sign ~secsign ~opaque ~solve_tac sigma concl -> + CErrors.anomaly (Pp.str "Abstract declaration hook not registered")) + let cache_term_by_tactic_then ~opaque ~name_op ?(goal_type=None) tac tacK = let open Tacticals.New in let open Tacmach.New in @@ -77,7 +80,7 @@ let cache_term_by_tactic_then ~opaque ~name_op ?(goal_type=None) tac tacK = let concl = it_mkNamedProd_or_LetIn concl sign in let solve_tac = tclCOMPLETE (tclTHEN (tclDO (List.length sign) Tactics.intro) tac) in let effs, sigma, lem, args, safe = - Declare.declare_abstract ~name ~poly ~sign ~secsign ~kind ~opaque ~solve_tac sigma concl in + !declare_abstract ~name ~poly ~sign ~secsign ~kind ~opaque ~solve_tac sigma concl in let solve = Proofview.tclEFFECTS effs <*> tacK lem args diff --git a/tactics/abstract.mli b/tactics/abstract.mli index 5c936ff9d6..a138a457b3 100644 --- a/tactics/abstract.mli +++ b/tactics/abstract.mli @@ -20,3 +20,15 @@ val cache_term_by_tactic_then -> unit Proofview.tactic val tclABSTRACT : ?opaque:bool -> Id.t option -> unit Proofview.tactic -> unit Proofview.tactic + +val declare_abstract : + ( name:Names.Id.t + -> poly:bool + -> kind:Decls.logical_kind + -> sign:EConstr.named_context + -> secsign:Environ.named_context_val + -> opaque:bool + -> solve_tac:unit Proofview.tactic + -> Evd.evar_map + -> EConstr.t + -> Evd.side_effects * Evd.evar_map * EConstr.t * EConstr.t list * bool) ref diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 57eab7ddf8..a51fc8b347 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1188,7 +1188,7 @@ let resolve_one_typeclass env ?(sigma=Evd.from_env env) gl unique = with Refiner.FailError _ -> raise Not_found in let evd = sig_sig gls' in - let t' = mkEvar (ev, Array.of_list subst) in + let t' = mkEvar (ev, subst) in let term = Evarutil.nf_evar evd t' in term, evd end in diff --git a/tactics/declareUctx.ml b/tactics/declareUctx.ml new file mode 100644 index 0000000000..3f67ff20a4 --- /dev/null +++ b/tactics/declareUctx.ml @@ -0,0 +1,34 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(** Monomorphic universes need to survive sections. *) + +let name_instance inst = + let map lvl = match Univ.Level.name lvl with + | None -> (* Having Prop/Set/Var as section universes makes no sense *) + assert false + | Some na -> + try + let qid = Nametab.shortest_qualid_of_universe na in + Names.Name (Libnames.qualid_basename qid) + with Not_found -> + (* Best-effort naming from the string representation of the level. + See univNames.ml for a similar hack. *) + Names.Name (Names.Id.of_string_soft (Univ.Level.to_string lvl)) + in + Array.map map (Univ.Instance.to_array inst) + +let declare_universe_context ~poly ctx = + if poly then + let uctx = Univ.ContextSet.to_context ctx in + let nas = name_instance (Univ.UContext.instance uctx) in + Global.push_section_context (nas, uctx) + else + Global.push_context_set ~strict:true ctx diff --git a/tactics/declareUctx.mli b/tactics/declareUctx.mli new file mode 100644 index 0000000000..7ecfab04f2 --- /dev/null +++ b/tactics/declareUctx.mli @@ -0,0 +1,11 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +val declare_universe_context : poly:bool -> Univ.ContextSet.t -> unit diff --git a/tactics/eauto.ml b/tactics/eauto.ml index a89e5ef19a..28b5ed5811 100644 --- a/tactics/eauto.ml +++ b/tactics/eauto.ml @@ -430,29 +430,39 @@ let make_dimension n = function | None -> (true,make_depth n) | Some d -> (false,d) +let autounfolds ids csts gl cls = + let hyps = Tacmach.New.pf_ids_of_hyps gl in + let env = Tacmach.New.pf_env gl in + let ids = List.filter (fun id -> List.mem id hyps && Tacred.is_evaluable env (EvalVarRef id)) ids in + let csts = List.filter (fun cst -> Tacred.is_evaluable env (EvalConstRef cst)) csts in + let flags = + List.fold_left (fun flags cst -> CClosure.RedFlags.(red_add flags (fCONST cst))) + (List.fold_left (fun flags id -> CClosure.RedFlags.(red_add flags (fVAR id))) + CClosure.betaiotazeta ids) csts + in reduct_option ~check:false (Reductionops.clos_norm_flags flags, DEFAULTcast) cls + let cons a l = a :: l -let autounfolds db occs cls gl = - let unfolds = List.concat (List.map (fun dbname -> - let db = try searchtable_map dbname - with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname) - in - let (ids, csts) = Hint_db.unfolds db in - let hyps = pf_ids_of_hyps gl in - let ids = Id.Set.filter (fun id -> List.mem id hyps) ids in - Cset.fold (fun cst -> cons (AllOccurrences, EvalConstRef cst)) csts - (Id.Set.fold (fun id -> cons (AllOccurrences, EvalVarRef id)) ids [])) db) - in Proofview.V82.of_tactic (unfold_option unfolds cls) gl +exception UnknownDatabase of string let autounfold db cls = - Proofview.V82.tactic begin fun gl -> - let cls = concrete_clause_of (fun () -> pf_ids_of_hyps gl) cls in - let tac = autounfolds db in - tclMAP (function - | OnHyp (id,occs,where) -> tac occs (Some (id,where)) - | OnConcl occs -> tac occs None) - cls gl - end + if not (Locusops.clause_with_generic_occurrences cls) then + user_err ~hdr:"autounfold" (str "\"at\" clause not supported"); + match List.fold_left (fun (ids, csts) dbname -> + let db = try searchtable_map dbname + with Not_found -> raise (UnknownDatabase dbname) + in + let (db_ids, db_csts) = Hint_db.unfolds db in + (Id.Set.fold cons db_ids ids, Cset.fold cons db_csts csts)) ([], []) db + with + | (ids, csts) -> Proofview.Goal.enter begin fun gl -> + let cls = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cls in + let tac = autounfolds ids csts gl in + Tacticals.New.tclMAP (function + | OnHyp (id, _, where) -> tac (Some (id, where)) + | OnConcl _ -> tac None) cls + end + | exception UnknownDatabase dbname -> Tacticals.New.tclZEROMSG (str "Unknown database " ++ str dbname) let autounfold_tac db cls = Proofview.tclUNIT () >>= fun () -> diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml index 910e042e7a..9a517652a7 100644 --- a/tactics/elimschemes.ml +++ b/tactics/elimschemes.ml @@ -27,11 +27,11 @@ open Ind_tables let optimize_non_type_induction_scheme kind dep sort ind = let env = Global.env () in let sigma = Evd.from_env env in - if check_scheme kind ind then + match lookup_scheme kind ind with + | Some cte -> (* in case the inductive has a type elimination, generates only one induction scheme, the other ones share the same code with the appropriate type *) - let cte = lookup_scheme kind ind in let sigma, cte = Evd.fresh_constant_instance env sigma cte in let c = mkConstU cte in let t = type_of_constant_in (Global.env()) cte in @@ -48,7 +48,7 @@ let optimize_non_type_induction_scheme kind dep sort ind = let sigma, t', c' = weaken_sort_scheme env sigma false sort npars c t in let sigma = Evd.minimize_universes sigma in (Evarutil.nf_evars_universes sigma c', Evd.evar_universe_context sigma) - else + | None -> let sigma, pind = Evd.fresh_inductive_instance ~rigid:UState.univ_rigid env sigma ind in let sigma, c = build_induction_scheme env sigma pind dep sort in (c, Evd.evar_universe_context sigma) @@ -62,7 +62,7 @@ let build_induction_scheme_in_type dep sort ind = let declare_individual_scheme_object name ?aux f = let f : individual_scheme_object_function = - fun _ ind -> f ind, Evd.empty_side_effects + fun _ ind -> f ind in declare_individual_scheme_object name ?aux f diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml index 98da61781e..7c702eab3a 100644 --- a/tactics/eqschemes.ml +++ b/tactics/eqschemes.ml @@ -229,7 +229,7 @@ let sym_scheme_kind = declare_individual_scheme_object "_sym_internal" (fun _ ind -> let c, ctx = build_sym_scheme (Global.env() (* side-effect! *)) ind in - (c, ctx), Evd.empty_side_effects) + (c, ctx)) (**********************************************************************) (* Build the involutivity of symmetry for an inductive type *) @@ -248,17 +248,17 @@ let sym_scheme_kind = (**********************************************************************) let const_of_scheme kind env ind ctx = - let sym_scheme, eff = (find_scheme kind ind) in + let sym_scheme = match lookup_scheme kind ind with Some cst -> cst | None -> assert false in let sym, ctx = with_context_set ctx (UnivGen.fresh_constant_instance (Global.env()) sym_scheme) in - mkConstU sym, ctx, eff + mkConstU sym, ctx let build_sym_involutive_scheme env ind = let (ind,u as indu), ctx = UnivGen.fresh_inductive_instance env ind in let (mib,mip as specif),nrealargs,realsign,paramsctxt,paramsctxt1 = get_sym_eq_data env indu in let eq,eqrefl,ctx = get_coq_eq ctx in - let sym, ctx, eff = const_of_scheme sym_scheme_kind env ind ctx in + let sym, ctx = const_of_scheme sym_scheme_kind env ind ctx in let cstr n = mkApp (mkConstructUi (indu,1),Context.Rel.to_extended_vect mkRel n paramsctxt) in let inds = snd (mind_arity mip) in let indr = Sorts.relevance_of_sort_family inds in @@ -297,10 +297,11 @@ let build_sym_involutive_scheme env ind = mkRel 1|])), mkRel 1 (* varH *), [|mkApp(eqrefl,[|applied_ind_C;cstr (nrealargs+1)|])|])))) - in (c, UState.of_context_set ctx), eff + in (c, UState.of_context_set ctx) let sym_involutive_scheme_kind = declare_individual_scheme_object "_sym_involutive" + ~deps:(fun ind -> [SchemeIndividualDep (ind, sym_scheme_kind)]) (fun _ ind -> build_sym_involutive_scheme (Global.env() (* side-effect! *)) ind) @@ -368,8 +369,8 @@ let build_l2r_rew_scheme dep env ind kind = let (ind,u as indu), ctx = UnivGen.fresh_inductive_instance env ind in let (mib,mip as specif),nrealargs,realsign,paramsctxt,paramsctxt1 = get_sym_eq_data env indu in - let sym, ctx, eff = const_of_scheme sym_scheme_kind env ind ctx in - let sym_involutive, ctx, eff' = const_of_scheme sym_involutive_scheme_kind env ind ctx in + let sym, ctx = const_of_scheme sym_scheme_kind env ind ctx in + let sym_involutive, ctx = const_of_scheme sym_involutive_scheme_kind env ind ctx in let eq,eqrefl,ctx = get_coq_eq ctx in let cstr n p = mkApp (mkConstructUi(indu,1), @@ -454,8 +455,7 @@ let build_l2r_rew_scheme dep env ind kind = [|main_body|]) else main_body)))))) - in (c, UState.of_context_set ctx), - Evd.concat_side_effects eff' eff + in (c, UState.of_context_set ctx) (**********************************************************************) (* Build the left-to-right rewriting lemma for hypotheses associated *) @@ -698,6 +698,10 @@ let build_r2l_rew_scheme dep env ind k = (**********************************************************************) let rew_l2r_dep_scheme_kind = declare_individual_scheme_object "_rew_r_dep" + ~deps:(fun ind -> [ + SchemeIndividualDep (ind, sym_scheme_kind); + SchemeIndividualDep (ind, sym_involutive_scheme_kind); + ]) (fun _ ind -> build_l2r_rew_scheme true (Global.env()) ind InType) (**********************************************************************) @@ -708,7 +712,7 @@ let rew_l2r_dep_scheme_kind = (**********************************************************************) let rew_r2l_dep_scheme_kind = declare_individual_scheme_object "_rew_dep" - (fun _ ind -> build_r2l_rew_scheme true (Global.env()) ind InType,Evd.empty_side_effects) + (fun _ ind -> build_r2l_rew_scheme true (Global.env()) ind InType) (**********************************************************************) (* Dependent rewrite from right-to-left in hypotheses *) @@ -718,7 +722,7 @@ let rew_r2l_dep_scheme_kind = (**********************************************************************) let rew_r2l_forward_dep_scheme_kind = declare_individual_scheme_object "_rew_fwd_dep" - (fun _ ind -> build_r2l_forward_rew_scheme true (Global.env()) ind InType,Evd.empty_side_effects) + (fun _ ind -> build_r2l_forward_rew_scheme true (Global.env()) ind InType) (**********************************************************************) (* Dependent rewrite from left-to-right in hypotheses *) @@ -728,7 +732,7 @@ let rew_r2l_forward_dep_scheme_kind = (**********************************************************************) let rew_l2r_forward_dep_scheme_kind = declare_individual_scheme_object "_rew_fwd_r_dep" - (fun _ ind -> build_l2r_forward_rew_scheme true (Global.env()) ind InType,Evd.empty_side_effects) + (fun _ ind -> build_l2r_forward_rew_scheme true (Global.env()) ind InType) (**********************************************************************) (* Non-dependent rewrite from either left-to-right in conclusion or *) @@ -742,7 +746,7 @@ let rew_l2r_forward_dep_scheme_kind = let rew_l2r_scheme_kind = declare_individual_scheme_object "_rew_r" (fun _ ind -> fix_r2l_forward_rew_scheme - (build_r2l_forward_rew_scheme false (Global.env()) ind InType), Evd.empty_side_effects) + (build_r2l_forward_rew_scheme false (Global.env()) ind InType)) (**********************************************************************) (* Non-dependent rewrite from either right-to-left in conclusion or *) @@ -752,7 +756,7 @@ let rew_l2r_scheme_kind = (**********************************************************************) let rew_r2l_scheme_kind = declare_individual_scheme_object "_rew" - (fun _ ind -> build_r2l_rew_scheme false (Global.env()) ind InType, Evd.empty_side_effects) + (fun _ ind -> build_r2l_rew_scheme false (Global.env()) ind InType) (* End of rewriting schemes *) @@ -835,5 +839,4 @@ let build_congr env (eq,refl,ctx) ind = let congr_scheme_kind = declare_individual_scheme_object "_congr" (fun _ ind -> (* May fail if equality is not defined *) - build_congr (Global.env()) (get_coq_eq Univ.ContextSet.empty) ind, - Evd.empty_side_effects) + build_congr (Global.env()) (get_coq_eq Univ.ContextSet.empty) ind) diff --git a/tactics/eqschemes.mli b/tactics/eqschemes.mli index d1038f2655..6447708ace 100644 --- a/tactics/eqschemes.mli +++ b/tactics/eqschemes.mli @@ -27,7 +27,7 @@ val rew_r2l_scheme_kind : individual scheme_kind val build_r2l_rew_scheme : bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context val build_l2r_rew_scheme : bool -> env -> inductive -> Sorts.family -> - constr Evd.in_evar_universe_context * Evd.side_effects + constr Evd.in_evar_universe_context val build_r2l_forward_rew_scheme : bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context val build_l2r_forward_rew_scheme : @@ -39,7 +39,7 @@ val build_sym_scheme : env -> inductive -> constr Evd.in_evar_universe_context val sym_scheme_kind : individual scheme_kind val build_sym_involutive_scheme : env -> inductive -> - constr Evd.in_evar_universe_context * Evd.side_effects + constr Evd.in_evar_universe_context val sym_involutive_scheme_kind : individual scheme_kind (** Builds a congruence scheme for an equality type *) diff --git a/tactics/equality.ml b/tactics/equality.ml index 49645d82a4..e1d34af13e 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -411,8 +411,7 @@ let find_elim hdcncl lft2rgt dep cls ot = match EConstr.kind sigma hdcncl with | Ind (ind,u) -> - let c, eff = find_scheme scheme_name ind in - Proofview.tclEFFECTS eff <*> + find_scheme scheme_name ind >>= fun c -> pf_constr_of_global (GlobRef.ConstRef c) | _ -> assert false end @@ -1001,14 +1000,13 @@ let ind_scheme_of_eq lbeq to_kind = let from_kind = inductive_sort_family mip in (* use ind rather than case by compatibility *) let kind = Elimschemes.nondep_elim_scheme from_kind to_kind in - let c, eff = find_scheme kind (destIndRef lbeq.eq) in - GlobRef.ConstRef c, eff + find_scheme kind (destIndRef lbeq.eq) >>= fun c -> + Proofview.tclUNIT (GlobRef.ConstRef c) let discrimination_pf e (t,t1,t2) discriminator lbeq to_kind = build_coq_I () >>= fun i -> - let eq_elim, eff = ind_scheme_of_eq lbeq to_kind in - Proofview.tclEFFECTS eff <*> + ind_scheme_of_eq lbeq to_kind >>= fun eq_elim -> pf_constr_of_global eq_elim >>= fun eq_elim -> Proofview.tclUNIT (applist (eq_elim, [t;t1;mkNamedLambda (make_annot e Sorts.Relevant) t discriminator;i;t2])) @@ -1045,7 +1043,7 @@ let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn = let absurd_clause = apply_on_clause (pf,pf_ty) eq_clause in let pf = Clenvtac.clenv_value_cast_meta absurd_clause in tclTHENS (assert_after Anonymous false_0) - [onLastHypId gen_absurdity; (Proofview.V82.tactic (Refiner.refiner ~check:true EConstr.Unsafe.(to_constr pf)))] + [onLastHypId gen_absurdity; (Refiner.refiner ~check:true EConstr.Unsafe.(to_constr pf))] let discrEq (lbeq,_,(t,t1,t2) as u) eq_clause = let sigma = eq_clause.evd in @@ -1347,23 +1345,23 @@ let inject_if_homogenous_dependent_pair ty = (* and compare the fst arguments of the dep pair *) (* Note: should work even if not an inductive type, but the table only *) (* knows inductive types *) - if not (Ind_tables.check_scheme (!eq_dec_scheme_kind_name()) ind && + if not (Option.has_some (Ind_tables.lookup_scheme (!eq_dec_scheme_kind_name()) ind) && pf_apply is_conv gl ar1.(2) ar2.(2)) then raise Exit; check_required_library ["Coq";"Logic";"Eqdep_dec"]; let new_eq_args = [|pf_get_type_of gl ar1.(3);ar1.(3);ar2.(3)|] in let inj2 = lib_ref "core.eqdep_dec.inj_pair2" in - let c, eff = find_scheme (!eq_dec_scheme_kind_name()) ind in + find_scheme (!eq_dec_scheme_kind_name()) ind >>= fun c -> (* cut with the good equality and prove the requested goal *) tclTHENLIST - [Proofview.tclEFFECTS eff; + [ intro; onLastHyp (fun hyp -> Tacticals.New.pf_constr_of_global Coqlib.(lib_ref "core.eq.type") >>= fun ceq -> tclTHENS (cut (mkApp (ceq,new_eq_args))) [clear [destVar sigma hyp]; Tacticals.New.pf_constr_of_global inj2 >>= fun inj2 -> - Proofview.V82.tactic (Refiner.refiner ~check:true EConstr.Unsafe.(to_constr - (mkApp(inj2,[|ar1.(0);mkConst c;ar1.(1);ar1.(2);ar1.(3);ar2.(3);hyp|])))) + Refiner.refiner ~check:true EConstr.Unsafe.(to_constr + (mkApp(inj2,[|ar1.(0);mkConst c;ar1.(1);ar1.(2);ar1.(3);ar2.(3);hyp|]))) ])] with Exit -> Proofview.tclUNIT () @@ -1408,7 +1406,7 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac = (Proofview.tclIGNORE (Proofview.Monad.List.map (fun (pf,ty) -> tclTHENS (cut ty) [inject_if_homogenous_dependent_pair ty; - Proofview.V82.tactic (Refiner.refiner ~check:true EConstr.Unsafe.(to_constr pf))]) + Refiner.refiner ~check:true EConstr.Unsafe.(to_constr pf)]) (if l2r then List.rev injectors else injectors))) (tac (List.length injectors))) diff --git a/tactics/hints.ml b/tactics/hints.ml index ffb0e030db..5fb519cc4f 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -23,7 +23,6 @@ open Globnames open Libobject open Namegen open Libnames -open Smartlocate open Termops open Inductiveops open Typeclasses @@ -100,8 +99,6 @@ let empty_hint_info = (* The Type of Constructions Autotactic Hints *) (************************************************************************) -type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen - type 'a hint_ast = | Res_pf of 'a (* Hint Apply *) | ERes_pf of 'a (* Hint EApply *) @@ -164,10 +161,6 @@ type full_hint = hint with_metadata type hint_entry = GlobRef.t option * raw_hint hint_ast with_uid with_metadata -type reference_or_constr = - | HintsReference of qualid - | HintsConstr of Constrexpr.constr_expr - type hint_mode = | ModeInput (* No evars *) | ModeNoHeadEvar (* No evar at the head *) @@ -178,16 +171,6 @@ type 'a hints_transparency_target = | HintsConstants | HintsReferences of 'a list -type hints_expr = - | HintsResolve of (hint_info_expr * bool * reference_or_constr) list - | HintsResolveIFF of bool * qualid list * int option - | HintsImmediate of reference_or_constr list - | HintsUnfold of qualid list - | HintsTransparency of qualid hints_transparency_target * bool - | HintsMode of qualid * hint_mode list - | HintsConstructors of qualid list - | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument - type import_level = HintLax | HintWarn | HintStrict let warn_hint_to_string = function @@ -895,7 +878,7 @@ let fresh_global_or_constr env sigma poly cr = else begin if isgr then warn_polymorphic_hint (pr_hint_term env sigma ctx cr); - Declare.declare_universe_context ~poly:false ctx; + DeclareUctx.declare_universe_context ~poly:false ctx; (c, Univ.ContextSet.empty) end @@ -1310,114 +1293,6 @@ let prepare_hint check env init (sigma,c) = let diff = Univ.ContextSet.diff (Evd.universe_context_set sigma) (Evd.universe_context_set init) in (c', diff) -let project_hint ~poly pri l2r r = - let open EConstr in - let open Coqlib in - let gr = Smartlocate.global_with_alias r in - let env = Global.env() in - let sigma = Evd.from_env env in - let sigma, c = Evd.fresh_global env sigma gr in - let t = Retyping.get_type_of env sigma c in - let t = - Tacred.reduce_to_quantified_ref env sigma (lib_ref "core.iff.type") t in - let sign,ccl = decompose_prod_assum sigma t in - let (a,b) = match snd (decompose_app sigma ccl) with - | [a;b] -> (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 sigma (mkApp (c, Context.Rel.to_extended_vect mkRel 0 sign)) in - let c = it_mkLambda_or_LetIn - (mkApp (p,[|mkArrow a Sorts.Relevant (lift 1 b);mkArrow b Sorts.Relevant (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:Declare.ImportDefaultBehavior - ~name ~kind:Decls.(IsDefinition Definition) cb - in - let info = {Typeclasses.hint_priority = pri; hint_pattern = None} in - (info,false,true,PathAny, IsGlobRef (GlobRef.ConstRef c)) - -let warn_deprecated_hint_constr = - CWarnings.create ~name:"deprecated-hint-constr" ~category:"deprecated" - (fun () -> - Pp.strbrk - "Declaring arbitrary terms as hints is deprecated; declare a global reference instead" - ) - -let interp_hints ~poly = - fun h -> - let env = Global.env () in - let sigma = Evd.from_env env in - let f poly c = - let evd,c = Constrintern.interp_open_constr env sigma c in - let env = Global.env () in - let sigma = Evd.from_env env in - let (c, diff) = prepare_hint true env sigma (evd,c) in - if poly then IsConstr (c, diff) - else - let () = Declare.declare_universe_context ~poly:false diff in - IsConstr (c, Univ.ContextSet.empty) - in - let fref r = - let gr = global_with_alias r in - Dumpglob.add_glob ?loc:r.CAst.loc gr; - gr in - let fr r = evaluable_of_global_reference env (fref r) in - let fi c = - match c with - | HintsReference c -> - let gr = global_with_alias c in - (PathHints [gr], poly, IsGlobRef gr) - | HintsConstr c -> - let () = warn_deprecated_hint_constr () in - (PathAny, poly, f poly c) - in - let fp = Constrintern.intern_constr_pattern env sigma in - let fres (info, b, r) = - let path, poly, gr = fi r in - let info = { info with hint_pattern = Option.map fp info.hint_pattern } in - (info, poly, b, path, gr) - in - let ft = function - | HintsVariables -> HintsVariables - | HintsConstants -> HintsConstants - | 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 = global_inductive_with_alias qid in - let mib,_ = Global.lookup_inductive ind in - Dumpglob.dump_reference ?loc:qid.CAst.loc "<>" (string_of_qualid qid) "ind"; - List.init (nconstructors env ind) - (fun i -> let c = (ind,i+1) in - let gr = GlobRef.ConstructRef c in - empty_hint_info, - (Declareops.inductive_is_polymorphic mib), true, - PathHints [gr], IsGlobRef 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 l = match pat with None -> [] | Some (l, _) -> l in - let ltacvars = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in - let env = Genintern.({ (empty_glob_sign env) with ltacvars }) in - let _, tacexp = Genintern.generic_intern env tacexp in - HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp) - let add_hints ~locality dbnames h = let local, superglobal = match locality with | Goptions.OptDefault | Goptions.OptGlobal -> false, true @@ -1562,8 +1437,7 @@ let pr_hint_term env sigma cl = (* print all hints that apply to the concl of the current goal *) let pr_applicable_hint pf = let env = Global.env () in - let pts = Declare.Proof.get_proof pf in - let Proof.{goals;sigma} = Proof.data pts in + let Proof.{goals;sigma} = Proof.data pf in match goals with | [] -> CErrors.user_err Pp.(str "No focused goal.") | g::_ -> diff --git a/tactics/hints.mli b/tactics/hints.mli index eed0e37fac..f5fd3348e4 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -32,8 +32,6 @@ val empty_hint_info : 'a Typeclasses.hint_info_gen (** Pre-created hint databases *) -type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen - type 'a hint_ast = | Res_pf of 'a (* Hint Apply *) | ERes_pf of 'a (* Hint EApply *) @@ -78,10 +76,6 @@ type search_entry type hint_entry -type reference_or_constr = - | HintsReference of Libnames.qualid - | HintsConstr of Constrexpr.constr_expr - type hint_mode = | ModeInput (* No evars *) | ModeNoHeadEvar (* No evar at the head *) @@ -92,16 +86,6 @@ type 'a hints_transparency_target = | HintsConstants | HintsReferences of 'a list -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_transparency_target * bool - | HintsMode of Libnames.qualid * hint_mode list - | HintsConstructors of Libnames.qualid list - | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument - type 'a hints_path_gen = | PathAtom of 'a hints_path_atom_gen | PathStar of 'a hints_path_gen @@ -217,8 +201,6 @@ val current_db_names : unit -> String.Set.t val current_pure_db : unit -> hint_db list -val interp_hints : poly:bool -> hints_expr -> hints_entry - val add_hints : locality:Goptions.option_locality -> hint_db_name list -> hints_entry -> unit val prepare_hint : bool (* Check no remaining evars *) -> @@ -306,7 +288,7 @@ val wrap_hint_warning_fun : env -> evar_map -> (** Printing hints *) val pr_searchtable : env -> evar_map -> Pp.t -val pr_applicable_hint : Declare.Proof.t -> Pp.t +val pr_applicable_hint : Proof.t -> Pp.t val pr_hint_ref : env -> evar_map -> GlobRef.t -> Pp.t val pr_hint_db_by_name : env -> evar_map -> hint_db_name -> Pp.t val pr_hint_db_env : env -> evar_map -> Hint_db.t -> Pp.t diff --git a/tactics/ind_tables.ml b/tactics/ind_tables.ml index 8336fae02f..9164a4ff26 100644 --- a/tactics/ind_tables.ml +++ b/tactics/ind_tables.ml @@ -32,9 +32,9 @@ type internal_flag = | UserIndividualRequest (* user action, a message is displayed *) type mutual_scheme_object_function = - internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Evd.side_effects + internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context type individual_scheme_object_function = - internal_flag -> inductive -> constr Evd.in_evar_universe_context * Evd.side_effects + internal_flag -> inductive -> constr Evd.in_evar_universe_context type 'a scheme_kind = string @@ -46,9 +46,13 @@ let pr_scheme_kind = Pp.str type individual type mutual +type scheme_dependency = +| SchemeMutualDep of MutInd.t * mutual scheme_kind +| SchemeIndividualDep of inductive * individual scheme_kind + type scheme_object_function = - | MutualSchemeFunction of mutual_scheme_object_function - | IndividualSchemeFunction of individual_scheme_object_function + | MutualSchemeFunction of mutual_scheme_object_function * (MutInd.t -> scheme_dependency list) option + | IndividualSchemeFunction of individual_scheme_object_function * (inductive -> scheme_dependency list) option let scheme_object_table = (Hashtbl.create 17 : (string, string * scheme_object_function) Hashtbl.t) @@ -68,11 +72,11 @@ let declare_scheme_object s aux f = Hashtbl.add scheme_object_table key (s,f); key -let declare_mutual_scheme_object s ?(aux="") f = - declare_scheme_object s aux (MutualSchemeFunction f) +let declare_mutual_scheme_object s ?deps ?(aux="") f = + declare_scheme_object s aux (MutualSchemeFunction (f, deps)) -let declare_individual_scheme_object s ?(aux="") f = - declare_scheme_object s aux (IndividualSchemeFunction f) +let declare_individual_scheme_object s ?deps ?(aux="") f = + declare_scheme_object s aux (IndividualSchemeFunction (f, deps)) (**********************************************************************) (* Defining/retrieving schemes *) @@ -86,18 +90,24 @@ let compute_name internal id = Namegen.next_ident_away_from (add_prefix "internal_" id) is_visible_name else id +let declare_definition_scheme = ref (fun ~internal ~univs ~role ~name c -> + CErrors.anomaly (Pp.str "scheme declaration not registered")) + +let lookup_scheme kind ind = + try Some (DeclareScheme.lookup_scheme kind ind) with Not_found -> None + +let check_scheme kind ind = Option.has_some (lookup_scheme kind ind) + let define internal role id c poly univs = let id = compute_name internal id in let ctx = UState.minimize univs in let c = UnivSubst.nf_evars_and_universes_opt_subst (fun _ -> None) (UState.subst ctx) c in let univs = UState.univ_entry ~poly ctx in - let entry = Declare.pure_definition_entry ~univs c in - let kn, eff = Declare.declare_private_constant ~role ~kind:Decls.(IsDefinition Scheme) ~name:id entry in - let () = if internal then () else Declare.definition_message id in - kn, eff + !declare_definition_scheme ~internal ~univs ~role ~name:id c -let define_individual_scheme_base kind suff f mode idopt (mind,i as ind) = - let (c, ctx), eff = f mode ind in +(* Assumes that dependencies are already defined *) +let rec define_individual_scheme_base kind suff f mode idopt (mind,i as ind) eff = + let (c, ctx) = f mode ind in let mib = Global.lookup_mind mind in let id = match idopt with | Some id -> id @@ -105,17 +115,21 @@ let define_individual_scheme_base kind suff f mode idopt (mind,i as ind) = let role = Evd.Schema (ind, kind) in let internal = mode == InternalTacticRequest in let const, neff = define internal role id c (Declareops.inductive_is_polymorphic mib) ctx in + let eff = Evd.concat_side_effects neff eff in DeclareScheme.declare_scheme kind [|ind,const|]; - const, Evd.concat_side_effects neff eff + const, eff -let define_individual_scheme kind mode names (mind,i as ind) = +and define_individual_scheme kind mode names (mind,i as ind) = match Hashtbl.find scheme_object_table kind with - | _,MutualSchemeFunction f -> assert false - | s,IndividualSchemeFunction f -> - define_individual_scheme_base kind s f mode names ind - -let define_mutual_scheme_base kind suff f mode names mind = - let (cl, ctx), eff = f mode mind in + | _,MutualSchemeFunction _ -> assert false + | s,IndividualSchemeFunction (f, deps) -> + let deps = match deps with None -> [] | Some deps -> deps ind in + let eff = List.fold_left (fun eff dep -> declare_scheme_dependence mode eff dep) Evd.empty_side_effects deps in + define_individual_scheme_base kind s f mode names ind eff + +(* Assumes that dependencies are already defined *) +and define_mutual_scheme_base kind suff f mode names mind eff = + let (cl, ctx) = f mode mind in let mib = Global.lookup_mind mind in let ids = Array.init (Array.length mib.mind_packets) (fun i -> try Int.List.assoc i names @@ -131,34 +145,49 @@ let define_mutual_scheme_base kind suff f mode names mind = DeclareScheme.declare_scheme kind schemes; consts, eff -let define_mutual_scheme kind mode names mind = +and define_mutual_scheme kind mode names mind = match Hashtbl.find scheme_object_table kind with | _,IndividualSchemeFunction _ -> assert false - | s,MutualSchemeFunction f -> - define_mutual_scheme_base kind s f mode names mind - -let find_scheme_on_env_too kind ind = - let s = DeclareScheme.lookup_scheme kind ind in - s, Evd.empty_side_effects + | s,MutualSchemeFunction (f, deps) -> + let deps = match deps with None -> [] | Some deps -> deps mind in + let eff = List.fold_left (fun eff dep -> declare_scheme_dependence mode eff dep) Evd.empty_side_effects deps in + define_mutual_scheme_base kind s f mode names mind eff + +and declare_scheme_dependence mode eff = function +| SchemeIndividualDep (ind, kind) -> + if check_scheme kind ind then eff + else + let _, eff' = define_individual_scheme kind mode None ind in + Evd.concat_side_effects eff' eff +| SchemeMutualDep (mind, kind) -> + if check_scheme kind (mind, 0) then eff + else + let _, eff' = define_mutual_scheme kind mode [] mind in + Evd.concat_side_effects eff' eff let find_scheme ?(mode=InternalTacticRequest) kind (mind,i as ind) = - try find_scheme_on_env_too kind ind - with Not_found -> + let open Proofview.Notations in + match lookup_scheme kind ind with + | Some s -> + (* FIXME: we need to perform this call to reset the environment, since the + imperative scheme table is desynchronized from the monadic interface. *) + Proofview.tclEFFECTS Evd.empty_side_effects <*> + Proofview.tclUNIT s + | None -> match Hashtbl.find scheme_object_table kind with - | s,IndividualSchemeFunction f -> - define_individual_scheme_base kind s f mode None ind - | s,MutualSchemeFunction f -> - let ca, eff = define_mutual_scheme_base kind s f mode [] mind in - ca.(i), eff + | s,IndividualSchemeFunction (f, deps) -> + let deps = match deps with None -> [] | Some deps -> deps ind in + let eff = List.fold_left (fun eff dep -> declare_scheme_dependence mode eff dep) Evd.empty_side_effects deps in + let c, eff = define_individual_scheme_base kind s f mode None ind eff in + Proofview.tclEFFECTS eff <*> Proofview.tclUNIT c + | s,MutualSchemeFunction (f, deps) -> + let deps = match deps with None -> [] | Some deps -> deps mind in + let eff = List.fold_left (fun eff dep -> declare_scheme_dependence mode eff dep) Evd.empty_side_effects deps in + let ca, eff = define_mutual_scheme_base kind s f mode [] mind eff in + Proofview.tclEFFECTS eff <*> Proofview.tclUNIT ca.(i) let define_individual_scheme kind mode names ind = ignore (define_individual_scheme kind mode names ind) let define_mutual_scheme kind mode names mind = ignore (define_mutual_scheme kind mode names mind) - -let check_scheme kind ind = - try let _ = find_scheme_on_env_too kind ind in true - with Not_found -> false - -let lookup_scheme = DeclareScheme.lookup_scheme diff --git a/tactics/ind_tables.mli b/tactics/ind_tables.mli index dad2036c64..09fb051194 100644 --- a/tactics/ind_tables.mli +++ b/tactics/ind_tables.mli @@ -25,19 +25,27 @@ type internal_flag = | InternalTacticRequest | UserIndividualRequest +type scheme_dependency = +| SchemeMutualDep of MutInd.t * mutual scheme_kind +| SchemeIndividualDep of inductive * individual scheme_kind + type mutual_scheme_object_function = - internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Evd.side_effects + internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context type individual_scheme_object_function = - internal_flag -> inductive -> constr Evd.in_evar_universe_context * Evd.side_effects + internal_flag -> inductive -> constr Evd.in_evar_universe_context (** Main functions to register a scheme builder. Note these functions are not safe to be used by plugins as their effects won't be undone on backtracking *) -val declare_mutual_scheme_object : string -> ?aux:string -> +val declare_mutual_scheme_object : string -> + ?deps:(MutInd.t -> scheme_dependency list) -> + ?aux:string -> mutual_scheme_object_function -> mutual scheme_kind -val declare_individual_scheme_object : string -> ?aux:string -> +val declare_individual_scheme_object : string -> + ?deps:(inductive -> scheme_dependency list) -> + ?aux:string -> individual_scheme_object_function -> individual scheme_kind @@ -51,11 +59,17 @@ val define_mutual_scheme : mutual scheme_kind -> internal_flag (** internal *) - (int * Id.t) list -> MutInd.t -> unit (** Main function to retrieve a scheme in the cache or to generate it *) -val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> Constant.t * Evd.side_effects - -val check_scheme : 'a scheme_kind -> inductive -> bool +val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> Constant.t Proofview.tactic -(** Like [find_scheme] but fails when the scheme is not already in the cache *) -val lookup_scheme : 'a scheme_kind -> inductive -> Constant.t +(** Like [find_scheme] but does not generate a constant on the fly *) +val lookup_scheme : 'a scheme_kind -> inductive -> Constant.t option val pr_scheme_kind : 'a scheme_kind -> Pp.t + +val declare_definition_scheme : + (internal : bool + -> univs:Entries.universes_entry + -> role:Evd.side_effect_role + -> name:Id.t + -> Constr.t + -> Constant.t * Evd.side_effects) ref diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml index 8f6844079b..07f9def2c8 100644 --- a/tactics/tacticals.ml +++ b/tactics/tacticals.ml @@ -368,6 +368,9 @@ module New = struct Proofview.Unsafe.tclNEWGOALS tl <*> Proofview.tclUNIT ans + let tclTHENSLASTn t1 repeat l = + tclTHENS3PARTS t1 [||] repeat l + let tclTHENLASTn t1 l = tclTHENS3PARTS t1 [||] (tclUNIT()) l let tclTHENLAST t1 t2 = tclTHENLASTn t1 [|t2|] diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli index 9ec558f1ad..01565169ca 100644 --- a/tactics/tacticals.mli +++ b/tactics/tacticals.mli @@ -180,6 +180,7 @@ module New : sig middle. Raises an error if the number of resulting subgoals is strictly less than [n+m] *) val tclTHENS3PARTS : unit tactic -> unit tactic array -> unit tactic -> unit tactic array -> unit tactic + val tclTHENSLASTn : unit tactic -> unit tactic -> unit tactic array -> unit tactic val tclTHENSFIRSTn : unit tactic -> unit tactic array -> unit tactic -> unit tactic val tclTHENFIRSTn : unit tactic -> unit tactic array -> unit tactic diff --git a/tactics/tactics.ml b/tactics/tactics.ml index c79aca3d3c..e4809332c5 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1368,7 +1368,7 @@ let clenv_refine_in with_evars targetid id sigma0 clenv tac = if not with_evars && occur_meta clenv.evd new_hyp_typ then error_uninstantiated_metas new_hyp_typ clenv; let new_hyp_prf = clenv_value clenv in - let exact_tac = Proofview.V82.tactic (Refiner.refiner ~check:false EConstr.Unsafe.(to_constr new_hyp_prf)) in + let exact_tac = Refiner.refiner ~check:false EConstr.Unsafe.(to_constr new_hyp_prf) in let naming = NamingMustBe (CAst.make targetid) in let with_clear = do_replace (Some id) naming in Tacticals.New.tclTHEN @@ -1670,7 +1670,7 @@ let descend_in_conjunctions avoid tac (err, info) c = | Some (p,pt) -> Tacticals.New.tclTHENS (assert_before_gen false (NamingAvoid avoid) pt) - [Proofview.V82.tactic (refiner ~check:true EConstr.Unsafe.(to_constr p)); + [refiner ~check:true EConstr.Unsafe.(to_constr p); (* Might be ill-typed due to forbidden elimination. *) Tacticals.New.onLastHypId (tac (not isrec))] end))) @@ -2763,8 +2763,8 @@ let pose_tac na c = let id = make_annot id Sorts.Relevant in let nhyps = EConstr.push_named_context_val (NamedDecl.LocalDef (id, c, t)) hyps in let (sigma, ev) = Evarutil.new_pure_evar nhyps sigma concl in - let inst = Array.map_of_list (fun d -> mkVar (get_id d)) (named_context env) in - let body = mkEvar (ev, Array.append [|mkRel 1|] inst) in + let inst = List.map (fun d -> mkVar (get_id d)) (named_context env) in + let body = mkEvar (ev, mkRel 1 :: inst) in (sigma, mkLetIn (map_annot Name.mk_name id, c, t, body)) end end @@ -4499,7 +4499,7 @@ let check_expected_type env sigma (elimc,bl) elimt = if n == 0 then error "Scheme cannot be applied."; let sigma,cl = make_evar_clause env sigma ~len:(n - 1) elimt in let sigma = solve_evar_clause env sigma true cl bl in - let (_,u,_) = destProd sigma cl.cl_concl in + let (_,u,_) = destProd sigma (whd_all env sigma cl.cl_concl) in fun t -> match Evarconv.unify_leq_delay env sigma t u with | _sigma -> true | exception Evarconv.UnableToUnify _ -> false diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib index 537d111f23..36d61feed1 100644 --- a/tactics/tactics.mllib +++ b/tactics/tactics.mllib @@ -1,5 +1,4 @@ DeclareScheme -Declare Dnet Dn Btermdn @@ -18,7 +17,7 @@ Elim Equality Contradiction Inv -Leminv +DeclareUctx Hints Auto Eauto diff --git a/test-suite/Makefile b/test-suite/Makefile index 954a922c8c..dece21885c 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -62,6 +62,10 @@ coqtopbyte := $(BIN)coqtop.byte -q coqc_interactive := $(coqc) -test-mode -async-proofs-cache force coqdep := $(BIN)coqdep +# This is the convention for coq_makefile +OPT=-$(BEST) +export OPT + VERBOSE?= SHOW := $(if $(VERBOSE),@true,@echo) HIDE := $(if $(VERBOSE),,@) diff --git a/test-suite/bugs/closed/HoTT_coq_107.v b/test-suite/bugs/closed/HoTT_coq_107.v index fa4072a8f6..91f5c423a5 100644 --- a/test-suite/bugs/closed/HoTT_coq_107.v +++ b/test-suite/bugs/closed/HoTT_coq_107.v @@ -2,6 +2,7 @@ (* File reduced by coq-bug-finder from 4897 lines to 2605 lines, then from 2297 lines to 236 lines, then from 239 lines to 137 lines, then from 118 lines to 67 lines, then from 520 lines to 76 lines. *) (** Note: The bug here is the same as the #113, that is, HoTT_coq_113.v *) Require Import Coq.Init.Logic. +Require Import Coq.Init.Ltac. Global Set Universe Polymorphism. Global Set Asymmetric Patterns. Set Implicit Arguments. diff --git a/test-suite/bugs/closed/bug_12045.v b/test-suite/bugs/closed/bug_12045.v new file mode 100644 index 0000000000..4e416778a9 --- /dev/null +++ b/test-suite/bugs/closed/bug_12045.v @@ -0,0 +1,19 @@ +(* Check enough reduction happens in the conclusion of an induction scheme *) + +Lemma foo : + forall (P : nat -> Prop), + (forall n, P (S n)) -> + forall n, + (fun e => + IsSucc e -> + P e) n. +Proof. +Admitted. + +Theorem bar : forall n, + IsSucc n -> + True. +Proof. + intros. + Fail induction n using foo. (* was an anomaly *) +Admitted. diff --git a/test-suite/bugs/closed/bug_12196.v b/test-suite/bugs/closed/bug_12196.v new file mode 100644 index 0000000000..c0851b3204 --- /dev/null +++ b/test-suite/bugs/closed/bug_12196.v @@ -0,0 +1,46 @@ +(** TODO: Figure out how to test "sanity" for the ltac profiler output *) +Fixpoint fact (n : nat) := match n with 0 => 1 | S n' => n * fact n' end. +Fixpoint walk (n : nat) := match n with 0 => tt | S n => walk n end. +Ltac slow := idtac + (do 2 (let x := eval lazy in (walk (fact 9)) in idtac)). +Ltac slow2 := idtac + (do 2 (let x := eval lazy in (walk (fact 9)) in idtac)). +Ltac multi := idtac + slow + slow2. +Set Ltac Profiling. +Goal True. + Time try (multi; fail). + (* Warning: Ltac Profiler cannot yet handle backtracking into multi-success + tactics; profiling results may be wildly inaccurate. + [profile-backtracking,ltac] *) + Show Ltac Profile. + (* Used to be: +total time: 0.000s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─multi --------------------------------- 47.1% 47.1% 1 0.000s +─slow ---------------------------------- 35.3% 35.3% 1 0.000s +─slow2 --------------------------------- 17.6% 17.6% 1 0.000s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─multi --------------------------------- 47.1% 47.1% 1 0.000s +─slow ---------------------------------- 35.3% 35.3% 1 0.000s +─slow2 --------------------------------- 17.6% 17.6% 1 0.000s + + *) + (* Now: +total time: 2.074s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─multi --------------------------------- 0.0% 100.0% 6 1.119s +─slow ---------------------------------- 54.0% 54.0% 3 1.119s +─slow2 --------------------------------- 46.0% 46.0% 3 0.955s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─multi --------------------------------- 0.0% 100.0% 6 1.119s + ├─slow -------------------------------- 54.0% 54.0% 3 1.119s + └─slow2 ------------------------------- 46.0% 46.0% 3 0.955s + +*) +Abort. diff --git a/test-suite/bugs/closed/bug_12257.v b/test-suite/bugs/closed/bug_12257.v new file mode 100644 index 0000000000..4962048a42 --- /dev/null +++ b/test-suite/bugs/closed/bug_12257.v @@ -0,0 +1,3 @@ +(* Test that ExtrHaskellString transitively requires ExtrHaskellBasic *) +Require Coq.extraction.ExtrHaskellString. +Import Coq.extraction.ExtrHaskellBasic. diff --git a/test-suite/bugs/closed/bug_3881.v b/test-suite/bugs/closed/bug_3881.v index d7e097e326..50e9de60e5 100644 --- a/test-suite/bugs/closed/bug_3881.v +++ b/test-suite/bugs/closed/bug_3881.v @@ -4,6 +4,7 @@ coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *) Generalizable All Variables. Require Import Coq.Init.Notations. +Require Import Coq.Init.Ltac. Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). Notation "A -> B" := (forall (_ : A), B) : type_scope. Axiom admit : forall {T}, T. diff --git a/test-suite/bugs/closed/bug_4527.v b/test-suite/bugs/closed/bug_4527.v index dfb07520f1..cf802eb89b 100644 --- a/test-suite/bugs/closed/bug_4527.v +++ b/test-suite/bugs/closed/bug_4527.v @@ -5,7 +5,7 @@ then from 269 lines to 255 lines *) (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0 coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". +Require Import Coq.Init.Ltac. Inductive False := . Axiom proof_admitted : False. Tactic Notation "admit" := case proof_admitted. diff --git a/test-suite/bugs/closed/bug_4533.v b/test-suite/bugs/closed/bug_4533.v index d2f9fb9099..2d628f414d 100644 --- a/test-suite/bugs/closed/bug_4533.v +++ b/test-suite/bugs/closed/bug_4533.v @@ -5,7 +5,7 @@ then from 285 lines to 271 lines *) (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0 coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". +Require Import Coq.Init.Ltac. Inductive False := . Axiom proof_admitted : False. Tactic Notation "admit" := case proof_admitted. diff --git a/test-suite/bugs/closed/bug_4544.v b/test-suite/bugs/closed/bug_4544.v index e9e9c552f6..213c91bfa0 100644 --- a/test-suite/bugs/closed/bug_4544.v +++ b/test-suite/bugs/closed/bug_4544.v @@ -2,7 +2,7 @@ (* File reduced by coq-bug-finder from original input, then from 2553 lines to 1932 lines, then from 1946 lines to 1932 lines, then from 2467 lines to 1002 lines, then from 1016 lines to 1002 lines *) (* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 4.01.0 coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". +Require Import Coq.Init.Ltac. Inductive False := . Axiom proof_admitted : False. Tactic Notation "admit" := case proof_admitted. diff --git a/test-suite/bugs/closed/bug_5359.v b/test-suite/bugs/closed/bug_5359.v index 1f202e4396..36f2ec5891 100644 --- a/test-suite/bugs/closed/bug_5359.v +++ b/test-suite/bugs/closed/bug_5359.v @@ -90,7 +90,7 @@ Goal False. (Ring_polynom.PEX Z 2))) (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute + NsatzTactic.nsatz_compute (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). let sugar := constr:( 0%Z ) in @@ -214,6 +214,6 @@ Goal False. (Ring_polynom.PEX Z 2))) (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute + NsatzTactic.nsatz_compute (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). Abort. diff --git a/test-suite/bugs/closed/bug_5445.v b/test-suite/bugs/closed/bug_5445.v new file mode 100644 index 0000000000..deaf174661 --- /dev/null +++ b/test-suite/bugs/closed/bug_5445.v @@ -0,0 +1,11 @@ +Require Import Coq.nsatz.NsatzTactic. +(** Ensure that loading the nsatz tactic doesn't load the reals *) +Fail Module M := Coq.Reals.Rdefinitions. +(** Ensure that loading the nsatz tactic doesn't load classic *) +Fail Check Coq.Logic.Classical_Prop.classic. +(** Ensure that this test-case hasn't messed up about the location of the reals / how to check for them *) +Require Coq.Reals.Rdefinitions. +Module M := Coq.Reals.Rdefinitions. +(** Ensure that this test-case hasn't messed up about the location of classic / how to check for it *) +Require Coq.Logic.Classical_Prop. +Check Coq.Logic.Classical_Prop.classic. diff --git a/test-suite/bugs/closed/bug_6378.v b/test-suite/bugs/closed/bug_6378.v index 68ae7961dd..453924d587 100644 --- a/test-suite/bugs/closed/bug_6378.v +++ b/test-suite/bugs/closed/bug_6378.v @@ -7,11 +7,20 @@ Ltac profile_constr tac := Ltac slow _ := eval vm_compute in (Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl). +Ltac manipulate_ltac_prof := + start ltac profiling; + reset ltac profile; + try ((idtac + reset ltac profile + idtac); fail); + try ((idtac + start ltac profiling + idtac); fail); + try ((idtac + stop ltac profiling + idtac); fail). + Goal True. start ltac profiling. reset ltac profile. + manipulate_ltac_prof. reset ltac profile. stop ltac profiling. + Set Warnings Append "+profile-invalid-stack-no-self". time profile_constr slow. show ltac profile cutoff 0. show ltac profile "slow". diff --git a/test-suite/bugs/closed/bug_6661.v b/test-suite/bugs/closed/bug_6661.v index 28a9ffc7bd..0f4ae2b4c5 100644 --- a/test-suite/bugs/closed/bug_6661.v +++ b/test-suite/bugs/closed/bug_6661.v @@ -7,6 +7,7 @@ Require Export Coq.Init.Notations. +Require Export Coq.Init.Ltac. Notation "'∏' x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity) : type_scope. Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..) diff --git a/test-suite/bugs/closed/bug_7812.v b/test-suite/bugs/closed/bug_7812.v new file mode 100644 index 0000000000..a714eea81d --- /dev/null +++ b/test-suite/bugs/closed/bug_7812.v @@ -0,0 +1,30 @@ +Module Foo. + Definition binary A := A -> A -> Prop. + + Definition inter A (R1 R2 : binary A): binary A := + fun (x y:A) => R1 x y /\ R2 x y. +End Foo. + +Module Simple_sparse_proof. + Parameter node : Type. + Parameter graph : Type. + Parameter has_edge : graph -> node -> node -> Prop. + Implicit Types x y z : node. + Implicit Types G : graph. + + Parameter mem : forall A, A -> list A -> Prop. + Hypothesis mem_nil : forall x, mem node x nil = False. + + Definition notin (l: list node): node -> node -> Prop := + fun x y => ~ mem node x l /\ ~ mem node y l. + + Definition edge_notin G l : node -> node -> Prop := + Foo.inter node (has_edge G) (notin l). + + Hint Unfold Foo.inter notin edge_notin : rel_crush. + + Lemma edge_notin_nil G : forall x y, edge_notin G nil x y <-> has_edge G x y. + Proof. + intros. autounfold with rel_crush. rewrite !mem_nil. tauto. + Qed. +End Simple_sparse_proof. diff --git a/test-suite/complexity/ConstructiveCauchyRealsPerformance.v b/test-suite/complexity/ConstructiveCauchyRealsPerformance.v new file mode 100644 index 0000000000..f3bc1767da --- /dev/null +++ b/test-suite/complexity/ConstructiveCauchyRealsPerformance.v @@ -0,0 +1,149 @@ +(* Here we give some functions that compute non-rational reals, + to measure the computation speed. *) +(* Expected time < 5.00s *) + +Require Import QArith Qabs. +Require Import ConstructiveCauchyRealsMult. + +Local Open Scope CReal_scope. + +Definition approx_sqrt_Q (q : Q) (n : positive) : Q + := let (k,j) := q in + match k with + | Z0 => 0 + | Z.pos i => Z.pos (Pos.sqrt (i*j*n*n)) # (j*n) + | Z.neg i => 0 (* unused *) + end. + +(* Approximation of the square root from below, + improves the convergence modulus. *) +Lemma approx_sqrt_Q_le_below : forall (q : Q) (n : positive), + Qle 0 q -> Qle (approx_sqrt_Q q n * approx_sqrt_Q q n) q. +Proof. + intros. destruct q as [k j]. unfold approx_sqrt_Q. + destruct k as [|i|i]. apply Z.le_refl. + pose proof (Pos.sqrt_spec (i * j * n * n)). simpl in H0. + destruct H0 as [H0 _]. + unfold Qle, Qmult, Qnum, Qden. + rewrite <- Pos2Z.inj_mul, <- Pos2Z.inj_mul, <- Pos2Z.inj_mul. + apply Pos2Z.pos_le_pos. rewrite (Pos.mul_comm i (j * n * (j * n))). + rewrite <- (Pos.mul_comm j), <- (Pos.mul_assoc j), <- (Pos.mul_assoc j). + apply Pos.mul_le_mono_l. + apply (Pos.le_trans _ _ _ H0). + rewrite <- (Pos.mul_comm n), <- (Pos.mul_assoc n). + apply Pos.mul_le_mono_l. + rewrite (Pos.mul_comm i j), <- Pos.mul_assoc, <- Pos.mul_assoc. + apply Pos.mul_le_mono_l. rewrite Pos.mul_comm. apply Pos.le_refl. + exfalso. unfold Qle, Z.le in H; simpl in H. exact (H eq_refl). +Qed. + +Require Import Lia. + +Lemma approx_sqrt_Q_le_below_lia : forall (q : Q) (n : positive), + (0 <= q)%Q -> (approx_sqrt_Q q n * approx_sqrt_Q q n <= q)%Q. +Proof. + intros. destruct q as [k j]. unfold approx_sqrt_Q. + destruct k as [|i|i]. + - apply Z.le_refl. + - unfold Qle, Qmult, Qnum, Qden. + pose proof (Pos.sqrt_spec (i * j * n * n)) as Hsqrt; simpl in Hsqrt. + destruct Hsqrt as [Hsqrt _]; apply (Pos.mul_le_mono_l j) in Hsqrt. + lia. + - unfold Qle, Qnum, Qden in H; lia. +Qed. + +Print Assumptions approx_sqrt_Q_le_below_lia. + +Lemma approx_sqrt_Q_lt_above : forall (q : Q) (n : positive), + Qle 0 q -> Qlt q ((approx_sqrt_Q q n + (1#n)) * (approx_sqrt_Q q n + (1#n))). +Proof. + intros. destruct q as [k j]. unfold approx_sqrt_Q. + destruct k as [|i|i]. reflexivity. + 2: exfalso; unfold Qle, Z.le in H; simpl in H; exact (H eq_refl). + pose proof (Pos.sqrt_spec (i * j * n * n)). simpl in H0. + destruct H0 as [_ H0]. + apply (Qlt_le_trans + _ (((Z.pos ((Pos.sqrt (i * j * n * n)) + 1) # j * n)) + * ((Z.pos ((Pos.sqrt (i * j * n * n)) + 1) # j * n)))). + unfold Qlt, Qmult, Qnum, Qden. + rewrite <- Pos2Z.inj_mul, <- Pos2Z.inj_mul, <- Pos2Z.inj_mul. + apply Pos2Z.pos_lt_pos. + rewrite Pos.mul_comm, <- Pos.mul_assoc, <- Pos.mul_assoc, Pos.mul_comm. + apply Pos.mul_lt_mono_r. rewrite Pplus_one_succ_r in H0. + refine (Pos.le_lt_trans _ _ _ _ H0). rewrite Pos.mul_comm. + apply Pos.mul_le_mono_r. + rewrite <- Pos.mul_assoc, (Pos.mul_comm i), <- Pos.mul_assoc. + apply Pos.mul_le_mono_l. rewrite Pos.mul_comm. apply Pos.le_refl. + setoid_replace (1#n)%Q with (Z.pos j#j*n)%Q. 2: reflexivity. + rewrite Qinv_plus_distr. + unfold Qle, Qmult, Qnum, Qden. apply Z.mul_le_mono_nonneg_r. + discriminate. apply Z.mul_le_mono_nonneg. + discriminate. 2: discriminate. + rewrite Pos2Z.inj_add. apply Z.add_le_mono_l. + apply Pos2Z.pos_le_pos. destruct j; discriminate. + rewrite Pos2Z.inj_add. apply Z.add_le_mono_l. + apply Pos2Z.pos_le_pos. destruct j; discriminate. +Qed. + +Lemma approx_sqrt_Q_pos : forall (q : Q) (n : positive), + Qle 0 q -> Qle 0 (approx_sqrt_Q q n). +Proof. + intros. unfold approx_sqrt_Q. destruct q, Qnum. + apply Qle_refl. discriminate. apply Qle_refl. +Qed. + +Lemma Qsqrt_lt : forall q r :Q, + (0 <= r -> q*q < r*r -> q < r)%Q. +Proof. + intros. destruct (Q_dec q r). destruct s. exact q0. + - exfalso. apply (Qlt_not_le _ _ H0). apply (Qle_trans _ (q * r)). + apply Qmult_le_compat_r. apply Qlt_le_weak, q0. exact H. + rewrite Qmult_comm. + apply Qmult_le_compat_r. apply Qlt_le_weak, q0. + apply (Qle_trans _ r _ H). apply Qlt_le_weak, q0. + - exfalso. rewrite q0 in H0. exact (Qlt_irrefl _ H0). +Qed. + +Lemma approx_sqrt_Q_cauchy : + forall q:Q, QCauchySeq (approx_sqrt_Q q). +Proof. + intro q. destruct q as [k j]. destruct k. + - intros n a b H H0. reflexivity. + - assert (forall n a b, Pos.le n b -> + (approx_sqrt_Q (Z.pos p # j) a - approx_sqrt_Q (Z.pos p # j) b + < 1 # n)%Q). + { intros. rewrite <- (Qplus_lt_r _ _ (approx_sqrt_Q (Z.pos p # j) b)). + ring_simplify. apply Qsqrt_lt. + apply (Qle_trans _ (0+(1#n))). rewrite Qplus_0_l. discriminate. + apply Qplus_le_l. apply approx_sqrt_Q_pos. discriminate. + apply (Qle_lt_trans _ (Z.pos p # j)). + apply approx_sqrt_Q_le_below. discriminate. + apply (Qlt_le_trans _ ((approx_sqrt_Q (Z.pos p # j) b + (1 # b)) * + (approx_sqrt_Q (Z.pos p # j) b + (1 # b)))). + apply approx_sqrt_Q_lt_above. discriminate. + apply (Qle_trans _ ((approx_sqrt_Q (Z.pos p # j) b + (1 # n)) * + (approx_sqrt_Q (Z.pos p # j) b + (1 # b)))). + apply Qmult_le_r. + apply (Qlt_le_trans _ (0+(1#b))). rewrite Qplus_0_l. reflexivity. + apply Qplus_le_l. apply approx_sqrt_Q_pos. discriminate. + apply Qplus_le_r. unfold Qle; simpl. + apply Pos2Z.pos_le_pos, H. + apply Qmult_le_l. + apply (Qlt_le_trans _ (0+(1#n))). rewrite Qplus_0_l. reflexivity. + apply Qplus_le_l. apply approx_sqrt_Q_pos. discriminate. + apply Qplus_le_r. unfold Qle; simpl. + apply Pos2Z.pos_le_pos, H. } + intros n a b H0 H1. apply Qabs_case. + intros. apply H, H1. + intros. + setoid_replace (- (approx_sqrt_Q (Z.pos p # j) a - approx_sqrt_Q (Z.pos p # j) b))%Q + with (approx_sqrt_Q (Z.pos p # j) b - approx_sqrt_Q (Z.pos p # j) a)%Q. + 2: ring. apply H, H0. + - intros n a b H H0. reflexivity. +Qed. + +Definition CReal_sqrt_Q (q : Q) : CReal + := exist _ (approx_sqrt_Q q) (approx_sqrt_Q_cauchy q). + + +Time Eval vm_compute in (proj1_sig (CReal_sqrt_Q 2) (10 ^ 400)%positive). diff --git a/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired index 7900c034da..ebe44f3548 100644 --- a/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired +++ b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired @@ -1,15 +1,5 @@ -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' COQDEP VFILES -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' COQC Slow.v -Slow (real: 0.04, user: 0.02, sys: 0.01, mem: 45512 ko) +Slow.vo (real: 0.04, user: 0.02, sys: 0.01, mem: 45512 ko) COQC Fast.v -Fast (real: 0.41, user: 0.37, sys: 0.04, mem: 395200 ko) -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' +Fast.vo (real: 0.41, user: 0.37, sys: 0.04, mem: 395200 ko) diff --git a/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired index 7ab0bc75d9..bf17a3e95c 100644 --- a/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired +++ b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired @@ -1,15 +1,5 @@ -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' COQDEP VFILES -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' COQC Slow.v -Slow (real: 0.40, user: 0.35, sys: 0.04, mem: 394968 ko) +Slow.vo (real: 0.40, user: 0.35, sys: 0.04, mem: 394968 ko) COQC Fast.v -Fast (real: 0.04, user: 0.03, sys: 0.00, mem: 46564 ko) -Makefile:69: warning: undefined variable '*' -Makefile:204: warning: undefined variable 'DSTROOT' +Fast.vo (real: 0.04, user: 0.03, sys: 0.00, mem: 46564 ko) diff --git a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired index 72c520218c..541b307b5e 100644 --- a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired +++ b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired @@ -1,6 +1,6 @@ -After | File Name | Before || Change | % Change --------------------------------------------------------- -0m00.34s | Total | 0m00.49s || -0m00.14s | -30.61% --------------------------------------------------------- -0m00.32s | Fast | 0m00.02s || +0m00.30s | +1500.00% -0m00.02s | Slow | 0m00.47s || -0m00.44s | -95.74%
\ No newline at end of file + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +----------------------------------------------------------------------------------------------------------------------------- +0m00.47s | 394716 ko | Total Time / Peak Mem | 0m00.45s | 394392 ko || +0m00.01s || 324 ko | +4.44% | +0.08% +----------------------------------------------------------------------------------------------------------------------------- +0m00.42s | 394716 ko | Fast.vo | 0m00.02s | 57164 ko || +0m00.40s || 337552 ko | +1999.99% | +590.49% +0m00.05s | 57124 ko | Slow.vo | 0m00.43s | 394392 ko || -0m00.38s || -337268 ko | -88.37% | -85.51%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired index 74dad73332..71e4ee0b32 100644 --- a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired +++ b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired @@ -1,9 +1,9 @@ -After | Code | Before || Change | % Change + After | Code | Before || Change | % Change ---------------------------------------------------------------------------------------------------- -0m04.35s | Total | 0m00.58s || +0m03.77s | +649.05% + 0m14.06s | Total | 0m00.72s || +0m13.34s | +1854.02% ---------------------------------------------------------------------------------------------------- -0m03.87s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m00.246s || +0m03.62s | +1473.17% -0m00.322s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.189s || +0m00.13s | +70.37% -0m00.16s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.146s || +0m00.01s | +9.58% -0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | N/A || +0m00.00s | N/A - N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | 0m00.s || +0m00.00s | N/A
\ No newline at end of file +0m13.582s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m00.353s || +0m13.22s | +3747.59% +0m00.335s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.225s || +0m00.11s | +48.88% +0m00.152s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.142s || +0m00.01s | +7.04% + 0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | N/A || +0m00.00s | N/A + N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | 0m00.s || +0m00.00s | N/A
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh index a6f35db17c..9078d21e3b 100755 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh @@ -12,3 +12,13 @@ diff -u time-of-build-both-user.log.expected time-of-build-both-user.log || exit "$COQLIB"/tools/make-both-time-files.py --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 + "$COQLIB"/tools/make-both-time-files.py 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 $? + + "$COQLIB"/tools/make-both-time-files.py --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 diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-absolute.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-absolute.log.expected new file mode 100644 index 0000000000..e7d289858b --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-absolute.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -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.43s || -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.25s || -14176 ko | -7.58% | -1.68% + 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.28s || 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.14s || -3156 ko | -6.10% | -0.39% + 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.07s || -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.39s || -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.19s || -1940 ko | +11.56% | -0.35% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.19s || 648 ko | +16.94% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-auto.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-auto.log.expected new file mode 100644 index 0000000000..36f86e0e1e --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-auto.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -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.25s || -14176 ko | -7.58% | -1.68% + 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.28s || 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.14s || -3156 ko | -6.10% | -0.39% + 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.07s || -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.39s || -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.43s || -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.19s || -1940 ko | +11.56% | -0.35% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.19s || 648 ko | +16.94% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-diff.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-diff.log.expected new file mode 100644 index 0000000000..6415223693 --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real-diff.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.19s || 648 ko | +16.94% | +0.12% + 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.19s || -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.09s || -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.43s || -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.07s || -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.39s || -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.14s || -3156 ko | -6.10% | -0.39% + 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.28s || 1272 ko | -5.65% | +0.15% + 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.25s || -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.16s || -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%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real.log.expected index ea600b000e..36f86e0e1e 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real.log.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-real.log.expected @@ -1,26 +1,26 @@ -After | File Name | Before || Change | % Change ----------------------------------------------------------------------------------------------- -20m46.07s | Total | 23m06.30s || -2m20.23s | -10.11% ----------------------------------------------------------------------------------------------- -4m16.77s | Specific/X25519/C64/ladderstep | 5m16.83s || -1m00.06s | -18.95% -3m01.77s | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s || -0m26.16s | -12.58% -2m35.79s | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s || -0m23.42s | -13.06% -3m22.96s | Specific/NISTP256/AMD64/femul | 3m37.80s || -0m14.84s | -6.81% -0m39.72s | Specific/X25519/C64/femul | 0m42.98s || -0m03.25s | -7.58% -0m38.19s | Specific/NISTP256/AMD64/feadd | 0m40.48s || -0m02.28s | -5.65% -0m34.35s | Specific/X25519/C64/freeze | 0m36.42s || -0m02.07s | -5.68% -0m33.08s | Specific/X25519/C64/fesquare | 0m35.23s || -0m02.14s | -6.10% -0m31.00s | Specific/NISTP256/AMD64/feopp | 0m32.08s || -0m01.07s | -3.36% -0m27.81s | Specific/NISTP256/AMD64/fenz | 0m28.91s || -0m01.10s | -3.80% -0m27.11s | Specific/X25519/C64/fecarry | 0m28.85s || -0m01.74s | -6.03% -0m24.71s | Specific/X25519/C64/fesub | 0m26.11s || -0m01.39s | -5.36% -0m49.44s | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s || -0m00.06s | -0.12% -0m43.34s | Specific/NISTP256/AMD64/fesub | 0m43.78s || -0m00.43s | -1.00% -0m40.13s | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s || +0m00.60s | +1.51% -0m22.81s | Specific/X25519/C64/feadd | 0m23.43s || -0m00.62s | -2.64% -0m13.45s | Specific/NISTP256/AMD64/Synthesis | 0m13.74s || -0m00.29s | -2.11% -0m11.15s | Specific/X25519/C64/Synthesis | 0m11.23s || -0m00.08s | -0.71% -0m07.33s | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s || -0m00.07s | -0.94% -0m01.93s | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s || +0m00.19s | +11.56% -0m01.85s | Specific/Framework/SynthesisFramework | 0m01.95s || -0m00.09s | -5.12% -0m01.38s | Compilers/Z/Bounds/Pipeline | 0m01.18s || +0m00.19s | +16.94%
\ No newline at end of file + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -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.25s || -14176 ko | -7.58% | -1.68% + 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.28s || 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.14s || -3156 ko | -6.10% | -0.39% + 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.07s || -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.39s || -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.43s || -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.19s || -1940 ko | +11.56% | -0.35% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.19s || 648 ko | +16.94% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-absolute.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-absolute.log.expected new file mode 100644 index 0000000000..84d20f484a --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-absolute.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -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.17s || -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.94s || -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.06s || -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.13s || -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.14s || 648 ko | +14.42% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-auto.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-auto.log.expected new file mode 100644 index 0000000000..7576dca88b --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-auto.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -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.17s || -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.94s || -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.06s || -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.13s || -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.14s || 648 ko | +14.42% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-diff.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-diff.log.expected new file mode 100644 index 0000000000..1173a6fe29 --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user-diff.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.14s || 648 ko | +14.42% | +0.12% + 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.13s || -1940 ko | +8.86% | -0.35% + 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.06s || -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.94s || -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.17s || -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.42s || -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%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user.log.expected index 159e645512..7576dca88b 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user.log.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both-user.log.expected @@ -1,26 +1,26 @@ -After | File Name | Before || Change | % Change ----------------------------------------------------------------------------------------------- -19m16.04s | Total | 21m25.27s || -2m09.23s | -10.05% ----------------------------------------------------------------------------------------------- -4m01.34s | Specific/X25519/C64/ladderstep | 4m59.49s || -0m58.15s | -19.41% -2m48.52s | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s || -0m24.42s | -12.66% -2m23.70s | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s || -0m20.41s | -12.43% -3m09.62s | Specific/NISTP256/AMD64/femul | 3m22.52s || -0m12.90s | -6.36% -0m36.32s | Specific/X25519/C64/femul | 0m39.50s || -0m03.17s | -8.05% -0m30.13s | Specific/X25519/C64/fesquare | 0m32.24s || -0m02.11s | -6.54% -0m35.40s | Specific/NISTP256/AMD64/feadd | 0m37.21s || -0m01.81s | -4.86% -0m31.50s | Specific/X25519/C64/freeze | 0m33.24s || -0m01.74s | -5.23% -0m24.99s | Specific/X25519/C64/fecarry | 0m26.31s || -0m01.32s | -5.01% -0m22.65s | Specific/X25519/C64/fesub | 0m23.72s || -0m01.07s | -4.51% -0m45.75s | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s || +0m00.17s | +0.37% -0m39.59s | Specific/NISTP256/AMD64/fesub | 0m40.09s || -0m00.50s | -1.24% -0m36.92s | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s || +0m00.28s | +0.76% -0m28.51s | Specific/NISTP256/AMD64/feopp | 0m29.46s || -0m00.94s | -3.22% -0m25.50s | Specific/NISTP256/AMD64/fenz | 0m26.41s || -0m00.91s | -3.44% -0m20.93s | Specific/X25519/C64/feadd | 0m21.41s || -0m00.48s | -2.24% -0m12.55s | Specific/NISTP256/AMD64/Synthesis | 0m12.54s || +0m00.01s | +0.07% -0m10.37s | Specific/X25519/C64/Synthesis | 0m10.30s || +0m00.06s | +0.67% -0m07.18s | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s || -0m00.04s | -0.55% -0m01.72s | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s || +0m00.13s | +8.86% -0m01.67s | Specific/Framework/SynthesisFramework | 0m01.72s || -0m00.05s | -2.90% -0m01.19s | Compilers/Z/Bounds/Pipeline | 0m01.04s || +0m00.14s | +14.42%
\ No newline at end of file + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -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.17s || -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.94s || -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.06s || -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.13s || -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.14s || 648 ko | +14.42% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-real.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-real.log.expected index b9739ddb1d..94122d8190 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-real.log.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-real.log.expected @@ -1,26 +1,26 @@ -Time | File Name ----------------------------------------------------------- -19m16.04s | Total ----------------------------------------------------------- -4m01.34s | Specific/X25519/C64/ladderstep -3m09.62s | Specific/NISTP256/AMD64/femul -2m48.52s | Specific/solinas32_2e255m765_13limbs/femul -2m23.70s | Specific/solinas32_2e255m765_12limbs/femul -0m45.75s | Specific/solinas32_2e255m765_13limbs/Synthesis -0m39.59s | Specific/NISTP256/AMD64/fesub -0m36.92s | Specific/solinas32_2e255m765_12limbs/Synthesis -0m36.32s | Specific/X25519/C64/femul -0m35.40s | Specific/NISTP256/AMD64/feadd -0m31.50s | Specific/X25519/C64/freeze -0m30.13s | Specific/X25519/C64/fesquare -0m28.51s | Specific/NISTP256/AMD64/feopp -0m25.50s | Specific/NISTP256/AMD64/fenz -0m24.99s | Specific/X25519/C64/fecarry -0m22.65s | Specific/X25519/C64/fesub -0m20.93s | Specific/X25519/C64/feadd -0m12.55s | Specific/NISTP256/AMD64/Synthesis -0m10.37s | Specific/X25519/C64/Synthesis -0m07.18s | Compilers/Z/Bounds/Pipeline/Definition -0m01.72s | Compilers/Z/Bounds/Pipeline/ReflectiveTactics -0m01.67s | Specific/Framework/SynthesisFramework -0m01.19s | Compilers/Z/Bounds/Pipeline
\ No newline at end of file + Time | Peak Mem | File Name +----------------------------------------------------------------------- +19m16.04s | 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
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-user.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-user.log.expected index b9739ddb1d..94122d8190 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-user.log.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty-user.log.expected @@ -1,26 +1,26 @@ -Time | File Name ----------------------------------------------------------- -19m16.04s | Total ----------------------------------------------------------- -4m01.34s | Specific/X25519/C64/ladderstep -3m09.62s | Specific/NISTP256/AMD64/femul -2m48.52s | Specific/solinas32_2e255m765_13limbs/femul -2m23.70s | Specific/solinas32_2e255m765_12limbs/femul -0m45.75s | Specific/solinas32_2e255m765_13limbs/Synthesis -0m39.59s | Specific/NISTP256/AMD64/fesub -0m36.92s | Specific/solinas32_2e255m765_12limbs/Synthesis -0m36.32s | Specific/X25519/C64/femul -0m35.40s | Specific/NISTP256/AMD64/feadd -0m31.50s | Specific/X25519/C64/freeze -0m30.13s | Specific/X25519/C64/fesquare -0m28.51s | Specific/NISTP256/AMD64/feopp -0m25.50s | Specific/NISTP256/AMD64/fenz -0m24.99s | Specific/X25519/C64/fecarry -0m22.65s | Specific/X25519/C64/fesub -0m20.93s | Specific/X25519/C64/feadd -0m12.55s | Specific/NISTP256/AMD64/Synthesis -0m10.37s | Specific/X25519/C64/Synthesis -0m07.18s | Compilers/Z/Bounds/Pipeline/Definition -0m01.72s | Compilers/Z/Bounds/Pipeline/ReflectiveTactics -0m01.67s | Specific/Framework/SynthesisFramework -0m01.19s | Compilers/Z/Bounds/Pipeline
\ No newline at end of file + Time | Peak Mem | File Name +----------------------------------------------------------------------- +19m16.04s | 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
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/003-non-utf8/time-of-build-pretty.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/003-non-utf8/time-of-build-pretty.log.expected index 05c1687002..6104c78380 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/003-non-utf8/time-of-build-pretty.log.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/003-non-utf8/time-of-build-pretty.log.expected @@ -1,307 +1,307 @@ -Time | File Name ------------------------------------------------------------------------ -39m02.51s | Total ------------------------------------------------------------------------ -3m26.96s | Kami/Ex/Multiplier64 -3m22.44s | bedrock2/compiler/src/FlatToRiscv -2m19.56s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI -2m11.59s | Kami/Ex/Divider64 -1m44.22s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeCSR -1m44.11s | Kami/Ex/Multiplier32 -1m41.50s | bedrock2/bedrock2/src/Examples/bsearch -1m08.57s | Kami/Ex/ProcFDInl -1m07.92s | bedrock2/deps/riscv-coq/src/Platform/MinimalMMIO -1m01.07s | Kami/Ex/FifoCorrect -1m00.73s | Kami/Ex/Divider32 -0m50.15s | bedrock2/deps/riscv-coq/src/Proofs/EncodeBound -0m40.64s | bedrock2/bedrock2/src/Examples/FE310CompilerDemo -0m40.29s | Kami/InlineFacts -0m39.12s | Kami/Renaming -0m37.44s | Kami/Ex/SimpleFifoCorrect -0m37.08s | Kami/SemFacts -0m36.08s | ─preprbedrock2/deps/coqutil/src/Map/TestGoals -0m32.76s | Kami/ModularFacts -0m28.68s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA -0m26.60s | Kami/Lib/Word -0m26.55s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_SB -0m26.45s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA64 -0m25.80s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI64 -0m25.47s | bedrock2/processor/src/KamiRiscv -0m23.66s | bedrock2/compiler/src/EmitsValid -0m22.68s | Kami/Ex/InDepthTutorial -0m22.60s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM -0m21.68s | Kami/Specialize -0m21.59s | bedrock2/bedrock2/src/Examples/lightbulb -0m19.20s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_66 -0m19.19s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_UJ -0m17.33s | Kami/Ex/ProcDecInl -0m15.63s | bedrock2/compiler/src/examples/MMIO -0m14.78s | Kami/ParametricSyntax -0m12.11s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_S -0m11.74s | bedrock2/deps/riscv-coq/src/Platform/MetricMinimal -0m09.95s | bedrock2/deps/coqutil/src/Word/Properties -0m09.77s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM64 -0m09.56s | Kami/Lib/FMap -0m09.35s | bedrock2/bedrock2/src/Examples/ipow -0m09.26s | Kami/StepDet -0m09.19s | bedrock2/bedrock2/src/WeakestPreconditionProperties -0m09.16s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_Fence -0m08.98s | Kami/RefinementFacts -0m08.68s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R_atomic -0m08.26s | bedrock2/compiler/src/FlatToRiscv32 -0m07.55s | Kami/Ex/Fifo -0m07.54s | ─ensbedrock2/deps/coqutil/src/Map/SlowGoals -0m06.99s | bedrock2/deps/riscv-coq/src/Platform/Minimal -0m06.89s | bedrock2/compiler/src/GoFlatToRiscv -0m06.82s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I -0m06.72s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_FenceI -0m06.50s | Kami/Semantics -0m06.36s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_57 -0m06.32s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R -0m06.24s | Kami/PartialInlineFacts -0m06.02s | bedrock2/deps/coqutil/src/Map/Properties -0m05.62s | Kami/Ex/ProcThreeStage -0m05.56s | Kami/Decomposition -0m05.12s | Kami/Amortization -0m05.07s | Kami/Ex/SCMMInl -0m04.71s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_system -0m04.46s | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_U -0m04.19s | Kami/ParametricInline -0m04.13s | Kami/Ex/ProcDec -0m03.88s | bedrock2/bedrock2/src/Examples/swap -0m03.81s | Kami/Ex/SC -0m03.64s | bedrock2/bedrock2/src/FE310CSemantics -0m03.39s | Kami/Tutorial -0m03.30s | bedrock2/compiler/src/examples/Fibonacci -0m03.17s | Kami/Label -0m03.17s | Kami/ModuleBoundEx -0m03.10s | Kami/ParametricEquiv -0m03.06s | Kami/Wf -0m02.50s | bedrock2/compiler/src/Pipeline -0m02.42s | Kami/Ex/ProcFDInv -0m02.42s | Kami/ParamDup -0m02.39s | Kami/Duplicate -0m02.19s | Kami/ParametricWf -0m02.11s | Kami/Ex/ProcFetchDecode -0m02.06s | bedrock2/bedrock2/src/Examples/ARPResponder -0m01.94s | Kami/MapReifyEx -0m01.89s | Kami/Syntax -0m01.88s | Kami/Ex/IsaRv32/PgmGcd -0m01.87s | Kami/Ex/IsaRv32/PgmBankerWorker1 -0m01.87s | Kami/Ex/IsaRv32/PgmMatMulReport -0m01.85s | Kami/Ex/IsaRv32/PgmBankerWorker3 -0m01.83s | Kami/Ex/IsaRv32/PgmDekker2 -0m01.83s | Kami/Ex/IsaRv32/PgmFact -0m01.83s | Kami/Ex/IsaRv32/PgmMatMulNormal1 -0m01.81s | Kami/Ex/IsaRv32/PgmBankerInit -0m01.81s | Kami/Ex/IsaRv32/PgmMatMulInit -0m01.81s | Kami/Ex/IsaRv32/PgmMatMulNormal2 -0m01.81s | Kami/Ex/RegFile -0m01.80s | Kami/Ex/IsaRv32/PgmBankerWorker2 -0m01.80s | Kami/Ex/IsaRv32/PgmPeterson1 -0m01.80s | Kami/Ex/IsaRv32/PgmPeterson2 -0m01.80s | bedrock2/bedrock2/src/ptsto_bytes -0m01.78s | Kami/Ex/IsaRv32/PgmDekker1 -0m01.78s | Kami/Ex/ProcDecInv -0m01.76s | bedrock2/bedrock2/src/Map/SeparationLogic -0m01.75s | Kami/Ex/IsaRv32/PgmBsort -0m01.74s | Kami/Ex/IsaRv32/PgmHanoi -0m01.70s | Kami/Ex/NativeFifo -0m01.52s | Kami/Lib/NatLib -0m01.51s | bedrock2/processor/src/Test -0m01.48s | Kami/SymEval -0m01.47s | Kami/Ex/MemAtomic -0m01.44s | Kami/Ex/ProcThreeStInv -0m01.35s | bedrock2/bedrock2/src/Array -0m01.34s | bedrock2/bedrock2/src/TailRecursion -0m01.30s | Kami/Ex/IsaRv32 -0m01.29s | Kami/ModuleBound -0m01.29s | bedrock2/bedrock2/src/Byte -0m01.25s | bedrock2/bedrock2/src/Examples/chacha20 -0m01.19s | Kami/Ex/ProcThreeStDec -0m01.18s | bedrock2/bedrock2/src/Scalars -0m01.17s | bedrock2/deps/riscv-coq/src/Utility/ListLib -0m01.15s | Kami/Ex/OneEltFifo -0m01.14s | bedrock2/bedrock2/src/Examples/Trace -0m01.13s | bedrock2/bedrock2/src/TODO_absint -0m01.10s | bedrock2/compiler/lib/LibTactics -0m01.08s | Kami/Lib/StringAsList -0m01.00s | bedrock2/deps/coqutil/src/Z/ZLib -0m00.99s | Kami/Lib/Struct -0m00.98s | bedrock2/compiler/src/examples/toposort -0m00.95s | bedrock2/deps/riscv-coq/src/Utility/prove_Zeq_bitwise -0m00.94s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeProver -0m00.94s | bedrock2/deps/riscv-coq/src/Spec/ExecuteI -0m00.93s | Kami/Ex/ProcDecSC -0m00.92s | Kami/Ex/IsaRv32PgmExt -0m00.90s | Kami/Lib/Indexer -0m00.89s | Kami/Tactics -0m00.88s | bedrock2/compiler/src/util/ListLib -0m00.87s | Kami/Notations -0m00.84s | bedrock2/bedrock2/src/Memory -0m00.83s | Kami/Ex/ProcFDCorrect -0m00.83s | bedrock2/deps/riscv-coq/src/Utility/ZBitOps -0m00.82s | Kami/Ex/IsaRv32Pgm -0m00.82s | Kami/Lib/ilist -0m00.81s | Kami/Ex/ProcDecSCN -0m00.81s | bedrock2/deps/coqutil/src/Z/BitOps -0m00.80s | Kami/Ex/ProcFourStDec -0m00.80s | bedrock2/compiler/src/examples/EditDistExample -0m00.79s | Kami/Ext/BSyntax -0m00.79s | Kami/Ext/Extraction -0m00.77s | Kami/ParametricInlineLtac -0m00.76s | bedrock2/deps/riscv-coq/src/Platform/Example64Literal -0m00.76s | bedrock2/deps/riscv-coq/src/Spec/MetricPrimitives -0m00.75s | Kami/Ex/ProcThreeStInl -0m00.74s | Kami/Kami -0m00.74s | bedrock2/compiler/src/examples/CompileExamples -0m00.74s | bedrock2/compiler/src/examples/swap_bytes_over_uart_hexdump -0m00.74s | bedrock2/deps/riscv-coq/src/Platform/MinimalLogging -0m00.72s | Kami/Substitute -0m00.72s | bedrock2/compiler/src/examples/TestExprImp -0m00.72s | bedrock2/deps/riscv-coq/src/Spec/Primitives -0m00.71s | Kami/Ex/MemTypes -0m00.71s | bedrock2/compiler/src/examples/InlineAssemblyMacro -0m00.71s | bedrock2/compiler/src/examples/TestFlatImp -0m00.71s | bedrock2/deps/riscv-coq/src/Platform/Memory -0m00.71s | bedrock2/deps/riscv-coq/src/Spec/Decode -0m00.70s | Kami/Inline -0m00.70s | Kami/Lib/StringAsOT -0m00.69s | bedrock2/compiler/src/FlatToRiscvDef -0m00.68s | bedrock2/compiler/src/Rem4 -0m00.67s | Kami/SymEvalTac -0m00.67s | bedrock2/compiler/src/SimplWordExpr -0m00.67s | bedrock2/deps/riscv-coq/src/Utility/Encode -0m00.66s | bedrock2/bedrock2/src/Semantics -0m00.63s | Kami/Lib/StringStringAsOT -0m00.63s | bedrock2/deps/coqutil/src/Datatypes/PropSet -0m00.61s | bedrock2/compiler/src/UnmappedMemForExtSpec -0m00.61s | bedrock2/deps/riscv-coq/src/Utility/Monads -0m00.60s | bedrock2/deps/coqutil/src/Map/SortedList -0m00.59s | Kami/Synthesize -0m00.59s | bedrock2/compiler/src/util/Common -0m00.59s | bedrock2/deps/coqutil/src/Map/SortedListWord -0m00.58s | bedrock2/deps/coqutil/src/Word/Naive -0m00.58s | bedrock2/deps/riscv-coq/src/Utility/runsToNonDet_Run -0m00.57s | bedrock2/bedrock2/src/BasicC64Semantics -0m00.57s | bedrock2/deps/riscv-coq/src/Utility/Utility -0m00.56s | Kami/Lib/WordSupport -0m00.56s | bedrock2/bedrock2/src/WeakestPrecondition -0m00.55s | Kami/Lib/StringEq -0m00.55s | bedrock2/bedrock2/src/BasicC32Semantics -0m00.55s | bedrock2/compiler/src/examples/highlevel/FuncMut -0m00.55s | bedrock2/deps/riscv-coq/src/Spec/ExecuteI64 -0m00.55s | bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl32 -0m00.54s | bedrock2/bedrock2/src/Examples/MultipleReturnValues -0m00.53s | bedrock2/compiler/src/RegAlloc2 -0m00.53s | bedrock2/deps/riscv-coq/src/Spec/ExecuteM -0m00.52s | bedrock2/bedrock2/src/ProgramLogic -0m00.52s | bedrock2/deps/riscv-coq/src/Platform/Run -0m00.52s | bedrock2/deps/riscv-coq/src/Spec/ExecuteM64 -0m00.52s | bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl64 -0m00.52s | bedrock2/deps/riscv-coq/src/Utility/Words32Naive -0m00.50s | bedrock2/bedrock2/src/BasicCSyntax -0m00.50s | bedrock2/compiler/src/Basic32Semantics -0m00.50s | bedrock2/compiler/src/RegAlloc3 -0m00.49s | bedrock2/bedrock2/src/BytedumpTest -0m00.49s | bedrock2/bedrock2/src/BytedumpTestα -0m00.49s | bedrock2/deps/coqutil/src/Map/Z_keyed_SortedListMap -0m00.49s | bedrock2/deps/riscv-coq/src/Spec/Machine -0m00.49s | bedrock2/deps/riscv-coq/src/Utility/MkMachineWidth -0m00.49s | bedrock2/deps/riscv-coq/src/Utility/Words64Naive -0m00.48s | bedrock2/bedrock2/src/ToCString -0m00.48s | bedrock2/compiler/src/SeparationLogic -0m00.48s | bedrock2/deps/coqutil/src/Decidable -0m00.48s | bedrock2/deps/riscv-coq/src/Platform/MetricRiscvMachine -0m00.48s | bedrock2/deps/riscv-coq/src/Platform/RiscvMachine -0m00.47s | bedrock2/bedrock2/src/BasicC64Syntax -0m00.47s | bedrock2/deps/riscv-coq/src/Spec/PseudoInstructions -0m00.46s | bedrock2/compiler/src/ZNameGen -0m00.46s | bedrock2/deps/riscv-coq/src/Platform/MetricLogging -0m00.45s | bedrock2/compiler/src/RegAllocAnnotatedNotations -0m00.45s | bedrock2/processor/src/KamiWord -0m00.44s | bedrock2/deps/coqutil/src/Map/SortedListString_test -0m00.44s | bedrock2/deps/coqutil/src/Tactics/Tactics -0m00.44s | bedrock2/deps/riscv-coq/src/Spec/Execute -0m00.44s | bedrock2/deps/riscv-coq/src/Utility/InstructionNotations -0m00.43s | bedrock2/bedrock2/src/Map/Separation -0m00.43s | bedrock2/compiler/src/RiscvWordProperties -0m00.43s | bedrock2/deps/riscv-coq/src/Spec/VirtualMemory -0m00.43s | bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions -0m00.42s | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncode -0m00.40s | bedrock2/compiler/src/util/Tactics -0m00.40s | bedrock2/deps/coqutil/src/Map/Interface -0m00.39s | bedrock2/deps/coqutil/src/Z/HexNotation -0m00.38s | Kami/Lib/CommonTactics -0m00.38s | Kami/Lib/Nomega -0m00.38s | bedrock2/bedrock2/src/ZNamesSyntax -0m00.37s | bedrock2/deps/coqutil/src/Map/Funext -0m00.37s | bedrock2/deps/riscv-coq/src/Utility/div_mod_to_quot_rem -0m00.36s | Kami/Ex/Names -0m00.36s | Kami/Lib/Concat -0m00.36s | bedrock2/bedrock2/src/string2ident -0m00.36s | bedrock2/compiler/src/Simp -0m00.36s | bedrock2/deps/coqutil/src/Map/Solver -0m00.36s | bedrock2/deps/riscv-coq/src/Utility/nat_div_mod_to_quot_rem -0m00.35s | Kami/Lib/Misc -0m00.35s | bedrock2/bedrock2/src/Examples/StructAccess -0m00.35s | bedrock2/bedrock2/src/StructNotations -0m00.35s | bedrock2/deps/coqutil/src/Map/Empty_set_keyed_map -0m00.35s | bedrock2/deps/coqutil/src/Map/SortedListString -0m00.34s | Kami/Lib/Reflection -0m00.34s | bedrock2/bedrock2/src/Bytedump -0m00.34s | bedrock2/deps/riscv-coq/src/Utility/Tactics -0m00.33s | bedrock2/bedrock2/src/NotationsCustomEntry -0m00.33s | bedrock2/compiler/src/util/MyOmega -0m00.32s | bedrock2/bedrock2/src/Hexdump -0m00.32s | bedrock2/compiler/src/NameGen -0m00.31s | bedrock2/compiler/lib/LibTacticsMin -0m00.30s | bedrock2/bedrock2/src/StringNamesSyntax -0m00.30s | bedrock2/compiler/src/util/Set -0m00.30s | bedrock2/compiler/src/util/SetSolverTests -0m00.29s | bedrock2/deps/coqutil/src/Datatypes/String -0m00.27s | bedrock2/deps/coqutil/src/Word/LittleEndian -0m00.27s | bedrock2/deps/riscv-coq/src/Utility/MonadTests -0m00.26s | bedrock2/deps/coqutil/src/Z/div_mod_to_equations -0m00.23s | bedrock2/deps/riscv-coq/src/Utility/MonadT -0m00.19s | bedrock2/bedrock2/src/NotationsInConstr -0m00.19s | bedrock2/deps/coqutil/src/Datatypes/HList -0m00.17s | Kami/Lib/VectorFacts -0m00.17s | bedrock2/deps/riscv-coq/src/Utility/JMonad -0m00.14s | Kami/Lib/DepEq -0m00.13s | Kami/Lib/FinNotations -0m00.13s | bedrock2/bedrock2/src/ListPred -0m00.13s | bedrock2/bedrock2/src/Variables -0m00.13s | bedrock2/deps/coqutil/src/Datatypes/List -0m00.12s | bedrock2/deps/riscv-coq/src/Utility/MonadNotations -0m00.09s | bedrock2/bedrock2/src/Lift1Prop -0m00.09s | bedrock2/deps/coqutil/src/Datatypes/Option -0m00.09s | bedrock2/deps/coqutil/src/Datatypes/Prod -0m00.07s | Kami/Lib/BasicLogic -0m00.07s | bedrock2/bedrock2/src/Syntax -0m00.06s | Kami/Lib/DepEqNat -0m00.06s | bedrock2/deps/coqutil/src/Macros/symmetry -0m00.05s | bedrock2/compiler/lib/fiat_crypto_tactics/Not -0m00.05s | bedrock2/compiler/src/util/Misc -0m00.05s | bedrock2/deps/riscv-coq/src/Utility/PowerFunc -0m00.05s | bedrock2/deps/riscv-coq/src/Utility/runsToNonDet -0m00.04s | bedrock2/bedrock2/src/Markers -0m00.04s | bedrock2/bedrock2/src/Notations -0m00.04s | bedrock2/compiler/lib/fiat_crypto_tactics/Test -0m00.04s | bedrock2/compiler/lib/fiat_crypto_tactics/UniquePose -0m00.04s | bedrock2/compiler/src/NoActionSyntaxParams -0m00.04s | bedrock2/compiler/src/eqexact -0m00.04s | bedrock2/compiler/src/examples/highlevel/For -0m00.04s | bedrock2/compiler/src/on_hyp_containing -0m00.04s | bedrock2/compiler/src/util/Learning -0m00.04s | bedrock2/deps/coqutil/src/Datatypes/PrimitivePair -0m00.04s | bedrock2/deps/coqutil/src/Macros/subst -0m00.04s | bedrock2/deps/coqutil/src/Macros/unique -0m00.04s | bedrock2/deps/coqutil/src/Tactics/eabstract -0m00.04s | bedrock2/deps/coqutil/src/Tactics/letexists -0m00.04s | bedrock2/deps/coqutil/src/Tactics/rdelta -0m00.04s | bedrock2/deps/coqutil/src/Tactics/syntactic_unify -0m00.04s | bedrock2/deps/coqutil/src/dlet -0m00.04s | bedrock2/deps/coqutil/src/sanity -0m00.04s | bedrock2/deps/riscv-coq/src/Utility/MMIOTrace -0m00.03s | bedrock2/compiler/src/util/LogGoal
\ No newline at end of file + Time | Peak Mem | File Name +------------------------------------------------------------------------------------ +39m02.51s | 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
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-real.v.timing.diff.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-real.v.timing.diff.expected index 726c19a2e2..76b0a35cb2 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-real.v.timing.diff.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-real.v.timing.diff.expected @@ -1,29 +1,29 @@ -After | Code | Before || Change | % Change + After | Code | Before || Change | % Change ----------------------------------------------------------------------------------------------------------- -0m01.23s | Total | 0m01.28s || -0m00.04s | -3.50% + 0m01.23s | Total | 0m01.28s || -0m00.04s | -3.50% ----------------------------------------------------------------------------------------------------------- -0m00.53s | Chars 260-284 ~ 280-304 [(vm_compute;~reflexivity).] | 0m00.566s || -0m00.03s | -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
\ No newline at end of file + 0m00.53s | Chars 260-284 ~ 280-304 [(vm_compute;~reflexivity).] | 0m00.566s || -0m00.03s | -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
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-user.v.timing.diff.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-user.v.timing.diff.expected index f6be1d936d..1e27d5d12b 100644 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-user.v.timing.diff.expected +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/004-per-file-fuzz/foo-user.v.timing.diff.expected @@ -1,29 +1,29 @@ -After | Code | Before || Change | % Change + After | Code | Before || Change | % Change ----------------------------------------------------------------------------------------------------------- -0m01.14s | Total | 0m01.15s || -0m00.00s | -0.77% + 0m01.14s | Total | 0m01.15s || -0m00.00s | -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.01s | -4.00% -0m00.172s | Chars 031-064 ~ 031-064 [Require~Import~Coq.ZArith.ZArith.] | 0m00.156s || +0m00.01s | +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
\ No newline at end of file +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.01s | -4.00% +0m00.172s | Chars 031-064 ~ 031-064 [Require~Import~Coq.ZArith.ZArith.] | 0m00.156s || +0m00.01s | +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
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/run.sh new file mode 100755 index 0000000000..f2c5b56ebb --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/run.sh @@ -0,0 +1,24 @@ +#!/usr/bin/env bash + +set -x +set -e + +cd "$(dirname "${BASH_SOURCE[0]}")" + +"$COQLIB"/tools/make-both-time-files.py 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 $? + +"$COQLIB"/tools/make-both-time-files.py --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 + "$COQLIB"/tools/make-both-time-files.py 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 $? + + "$COQLIB"/tools/make-both-time-files.py --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 diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-after.log.in b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-after.log.in new file mode 100644 index 0000000000..5757018e9b --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-after.log.in @@ -0,0 +1,1760 @@ +COQDEP 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 +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.9% 4.6% 3 0.368s +─ReflectiveTactics.unify_abstract_cbv_in 3.3% 4.5% 1 0.368s +─Glue.zrange_to_reflective_goal -------- 2.6% 4.0% 1 0.324s +─k ------------------------------------- 3.5% 3.6% 1 0.296s +─unify (constr) (constr) --------------- 3.3% 3.3% 8 0.092s +─rewrite H ----------------------------- 2.6% 2.6% 2 0.196s +─eexact -------------------------------- 2.6% 2.6% 95 0.024s +─prove_interp_compile_correct ---------- 0.0% 2.5% 1 0.204s +─apply (fun f => 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 + └<Crypto.Util.Tactics.MoveLetIn.with 0.9% 4.6% 3 0.368s + └k --------------------------------- 3.5% 3.6% 1 0.296s + +Finished transaction in 13.363 secs (12.516u,0.008s) (successful) +Closed under the global context +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 +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.9% 4.6% 3 0.368s +─ReflectiveTactics.unify_abstract_cbv_in 3.3% 4.5% 1 0.368s +─Glue.zrange_to_reflective_goal -------- 2.6% 4.0% 1 0.324s +─k ------------------------------------- 3.5% 3.6% 1 0.296s +─unify (constr) (constr) --------------- 3.3% 3.3% 8 0.092s +─rewrite H ----------------------------- 2.6% 2.6% 2 0.196s +─eexact -------------------------------- 2.6% 2.6% 95 0.024s +─prove_interp_compile_correct ---------- 0.0% 2.5% 1 0.204s +─apply (fun f => 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 + └<Crypto.Util.Tactics.MoveLetIn.with 0.9% 4.6% 3 0.368s + └k --------------------------------- 3.5% 3.6% 1 0.296s + +src/Specific/NISTP256/AMD64/feadd (real: 38.19, user: 35.40, sys: 0.30, mem: 799216 ko) +COQC src/Specific/NISTP256/AMD64/fenz.v +Finished transaction in 6.356 secs (5.82u,0.004s) (successful) +total time: 5.800s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 5.800s +─IntegrationTestTemporaryMiscCommon.nonz 0.2% 85.5% 1 4.960s +─destruct (Decidable.dec x), (Decidable. 37.4% 37.4% 1 2.168s +─destruct (Decidable.dec x) as [H| H] -- 22.0% 22.0% 1 1.276s +─Pipeline.refine_reflectively_gen ------ 0.0% 14.5% 1 0.840s +─ReflectiveTactics.do_reflective_pipelin 0.0% 10.9% 1 0.632s +─ReflectiveTactics.solve_side_conditions 0.0% 10.6% 1 0.612s +─ReflectiveTactics.solve_post_reified_si 0.3% 8.5% 1 0.492s +─IntegrationTestTemporaryMiscCommon.op_s 0.1% 8.1% 2 0.368s +─rewrite <- (ZRange.is_bounded_by_None_r 5.2% 5.2% 2 0.288s +─UnifyAbstractReflexivity.unify_transfor 3.4% 4.3% 7 0.076s +─ReflectiveTactics.unify_abstract_cbv_in 2.8% 3.8% 1 0.220s +─Glue.refine_to_reflective_glue' ------- 0.1% 3.6% 1 0.208s +─rewrite H' ---------------------------- 3.4% 3.4% 1 0.200s +─generalize dependent (constr) --------- 3.0% 3.0% 4 0.060s +─congruence ---------------------------- 2.8% 2.8% 1 0.160s +─do_tac -------------------------------- 0.0% 2.6% 4 0.044s +─destruct H ---------------------------- 2.6% 2.6% 4 0.044s +─IntegrationTestTemporaryMiscCommon.do_s 0.1% 2.6% 1 0.152s +─DestructHyps.do_one_match_then -------- 0.0% 2.6% 6 0.044s +─DestructHyps.do_all_matches_then ------ 0.0% 2.6% 2 0.076s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.4% 2.5% 3 0.140s +─Glue.zrange_to_reflective ------------- 0.0% 2.2% 1 0.128s +─rewrite H ----------------------------- 1.9% 2.1% 3 0.112s +─ReflectiveTactics.do_reify ------------ 0.0% 2.1% 1 0.120s +─k ------------------------------------- 1.9% 2.0% 1 0.116s +─Reify.Reify_rhs_gen ------------------- 0.1% 2.0% 1 0.116s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 5.800s + ├─IntegrationTestTemporaryMiscCommon.no 0.2% 85.5% 1 4.960s + │ ├─destruct (Decidable.dec x), (Decida 37.4% 37.4% 1 2.168s + │ ├─destruct (Decidable.dec x) as [H| H 22.0% 22.0% 1 1.276s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 8.1% 2 0.368s + │ │ ├─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 2 0.288s + │ │ └─DestructHyps.do_all_matches_then 0.0% 2.6% 2 0.076s + │ │ └DestructHyps.do_one_match_then -- 0.0% 2.6% 6 0.044s + │ │ └do_tac -------------------------- 0.0% 2.6% 4 0.044s + │ │ └destruct H ---------------------- 2.6% 2.6% 4 0.044s + │ ├─rewrite H' ------------------------ 3.4% 3.4% 1 0.200s + │ ├─generalize dependent (constr) ----- 3.0% 3.0% 4 0.060s + │ ├─congruence ------------------------ 2.8% 2.8% 1 0.160s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 2.6% 1 0.152s + │ │└<Crypto.Util.Tactics.MoveLetIn.with 0.4% 2.5% 3 0.140s + │ │└k --------------------------------- 1.9% 2.0% 1 0.116s + │ └─rewrite H ------------------------- 1.7% 2.0% 2 0.112s + └─Pipeline.refine_reflectively_gen ---- 0.0% 14.5% 1 0.840s + ├─ReflectiveTactics.do_reflective_pip 0.0% 10.9% 1 0.632s + │└ReflectiveTactics.solve_side_condit 0.0% 10.6% 1 0.612s + │ ├─ReflectiveTactics.solve_post_reif 0.3% 8.5% 1 0.492s + │ │ ├─UnifyAbstractReflexivity.unify_ 3.4% 4.3% 7 0.076s + │ │ └─ReflectiveTactics.unify_abstrac 2.8% 3.8% 1 0.220s + │ └─ReflectiveTactics.do_reify ------ 0.0% 2.1% 1 0.120s + │ └Reify.Reify_rhs_gen ------------- 0.1% 2.0% 1 0.116s + └─Glue.refine_to_reflective_glue' --- 0.1% 3.6% 1 0.208s + └Glue.zrange_to_reflective --------- 0.0% 2.2% 1 0.128s + +Finished transaction in 6.657 secs (6.299u,0.s) (successful) +Closed under the global context +total time: 5.800s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 5.800s +─IntegrationTestTemporaryMiscCommon.nonz 0.2% 85.5% 1 4.960s +─destruct (Decidable.dec x), (Decidable. 37.4% 37.4% 1 2.168s +─destruct (Decidable.dec x) as [H| H] -- 22.0% 22.0% 1 1.276s +─Pipeline.refine_reflectively_gen ------ 0.0% 14.5% 1 0.840s +─ReflectiveTactics.do_reflective_pipelin 0.0% 10.9% 1 0.632s +─ReflectiveTactics.solve_side_conditions 0.0% 10.6% 1 0.612s +─ReflectiveTactics.solve_post_reified_si 0.3% 8.5% 1 0.492s +─IntegrationTestTemporaryMiscCommon.op_s 0.1% 8.1% 2 0.368s +─rewrite <- (ZRange.is_bounded_by_None_r 5.2% 5.2% 2 0.288s +─UnifyAbstractReflexivity.unify_transfor 3.4% 4.3% 7 0.076s +─ReflectiveTactics.unify_abstract_cbv_in 2.8% 3.8% 1 0.220s +─Glue.refine_to_reflective_glue' ------- 0.1% 3.6% 1 0.208s +─rewrite H' ---------------------------- 3.4% 3.4% 1 0.200s +─generalize dependent (constr) --------- 3.0% 3.0% 4 0.060s +─congruence ---------------------------- 2.8% 2.8% 1 0.160s +─do_tac -------------------------------- 0.0% 2.6% 4 0.044s +─destruct H ---------------------------- 2.6% 2.6% 4 0.044s +─IntegrationTestTemporaryMiscCommon.do_s 0.1% 2.6% 1 0.152s +─DestructHyps.do_one_match_then -------- 0.0% 2.6% 6 0.044s +─DestructHyps.do_all_matches_then ------ 0.0% 2.6% 2 0.076s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.4% 2.5% 3 0.140s +─Glue.zrange_to_reflective ------------- 0.0% 2.2% 1 0.128s +─rewrite H ----------------------------- 1.9% 2.1% 3 0.112s +─ReflectiveTactics.do_reify ------------ 0.0% 2.1% 1 0.120s +─k ------------------------------------- 1.9% 2.0% 1 0.116s +─Reify.Reify_rhs_gen ------------------- 0.1% 2.0% 1 0.116s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 5.800s + ├─IntegrationTestTemporaryMiscCommon.no 0.2% 85.5% 1 4.960s + │ ├─destruct (Decidable.dec x), (Decida 37.4% 37.4% 1 2.168s + │ ├─destruct (Decidable.dec x) as [H| H 22.0% 22.0% 1 1.276s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 8.1% 2 0.368s + │ │ ├─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 2 0.288s + │ │ └─DestructHyps.do_all_matches_then 0.0% 2.6% 2 0.076s + │ │ └DestructHyps.do_one_match_then -- 0.0% 2.6% 6 0.044s + │ │ └do_tac -------------------------- 0.0% 2.6% 4 0.044s + │ │ └destruct H ---------------------- 2.6% 2.6% 4 0.044s + │ ├─rewrite H' ------------------------ 3.4% 3.4% 1 0.200s + │ ├─generalize dependent (constr) ----- 3.0% 3.0% 4 0.060s + │ ├─congruence ------------------------ 2.8% 2.8% 1 0.160s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 2.6% 1 0.152s + │ │└<Crypto.Util.Tactics.MoveLetIn.with 0.4% 2.5% 3 0.140s + │ │└k --------------------------------- 1.9% 2.0% 1 0.116s + │ └─rewrite H ------------------------- 1.7% 2.0% 2 0.112s + └─Pipeline.refine_reflectively_gen ---- 0.0% 14.5% 1 0.840s + ├─ReflectiveTactics.do_reflective_pip 0.0% 10.9% 1 0.632s + │└ReflectiveTactics.solve_side_condit 0.0% 10.6% 1 0.612s + │ ├─ReflectiveTactics.solve_post_reif 0.3% 8.5% 1 0.492s + │ │ ├─UnifyAbstractReflexivity.unify_ 3.4% 4.3% 7 0.076s + │ │ └─ReflectiveTactics.unify_abstrac 2.8% 3.8% 1 0.220s + │ └─ReflectiveTactics.do_reify ------ 0.0% 2.1% 1 0.120s + │ └Reify.Reify_rhs_gen ------------- 0.1% 2.0% 1 0.116s + └─Glue.refine_to_reflective_glue' --- 0.1% 3.6% 1 0.208s + └Glue.zrange_to_reflective --------- 0.0% 2.2% 1 0.128s + +src/Specific/NISTP256/AMD64/fenz (real: 27.81, user: 25.50, sys: 0.22, mem: 756080 ko) +COQC src/Specific/NISTP256/AMD64/feopp.v +Finished transaction in 7.73 secs (7.112u,0.008s) (successful) +total time: 7.072s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 62.5% 1 4.420s +─IntegrationTestTemporaryMiscCommon.fact 18.7% 51.6% 1 3.648s +─Pipeline.refine_reflectively_gen ------ 0.0% 37.5% 1 2.652s +─ReflectiveTactics.do_reflective_pipelin 0.0% 32.6% 1 2.308s +─ReflectiveTactics.solve_side_conditions 0.0% 32.2% 1 2.276s +─reflexivity --------------------------- 24.8% 24.8% 8 1.700s +─ReflectiveTactics.solve_post_reified_si 0.5% 18.5% 1 1.308s +─ReflectiveTactics.do_reify ------------ 0.0% 13.7% 1 0.968s +─UnifyAbstractReflexivity.unify_transfor 11.2% 13.6% 7 0.284s +─Reify.Reify_rhs_gen ------------------- 0.6% 13.4% 1 0.948s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 9.7% 1 0.684s +─rewrite <- (ZRange.is_bounded_by_None_r 9.0% 9.0% 4 0.328s +─op_sig_side_conditions_t -------------- 0.0% 7.8% 1 0.552s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 7.4% 1 0.520s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 7.4% 1 0.520s +─by_tac -------------------------------- 0.0% 7.2% 2 0.404s +─Reify.do_reify_abs_goal --------------- 7.1% 7.2% 2 0.512s +─Reify.do_reifyf_goal ------------------ 6.6% 6.7% 62 0.472s +─DestructHyps.do_one_match_then -------- 0.2% 5.8% 14 0.048s +─DestructHyps.do_all_matches_then ------ 0.0% 5.8% 4 0.124s +─do_tac -------------------------------- 0.0% 5.6% 10 0.048s +─destruct H ---------------------------- 5.6% 5.6% 10 0.048s +─Glue.refine_to_reflective_glue' ------- 0.0% 4.9% 1 0.344s +─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.2% 1 0.300s +─Glue.zrange_to_reflective ------------- 0.0% 3.3% 1 0.232s +─unify (constr) (constr) --------------- 3.2% 3.2% 7 0.088s +─Glue.zrange_to_reflective_goal -------- 1.9% 2.6% 1 0.184s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.3% 1 0.164s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.4% 2.2% 3 0.152s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 62.5% 1 4.420s + ├─IntegrationTestTemporaryMiscCommon.fa 18.7% 51.6% 1 3.648s + │ ├─reflexivity ----------------------- 24.0% 24.0% 1 1.700s + │ └─op_sig_side_conditions_t ---------- 0.0% 7.8% 1 0.552s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.2% 4.2% 2 0.284s + │ └─DestructHyps.do_all_matches_then 0.0% 3.5% 2 0.124s + │ └DestructHyps.do_one_match_then -- 0.2% 3.5% 8 0.044s + │ └do_tac -------------------------- 0.0% 3.3% 6 0.040s + │ └destruct H ---------------------- 3.3% 3.3% 6 0.040s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 9.7% 1 0.684s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 7.4% 1 0.520s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 7.4% 1 0.520s + │└by_tac ---------------------------- 0.0% 7.2% 2 0.404s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.8% 4.8% 2 0.328s + │ └─DestructHyps.do_all_matches_then 0.0% 2.3% 2 0.088s + │ └DestructHyps.do_one_match_then -- 0.0% 2.3% 6 0.048s + │ └do_tac -------------------------- 0.0% 2.3% 4 0.048s + │ └destruct H ---------------------- 2.3% 2.3% 4 0.048s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.3% 1 0.164s + └<Crypto.Util.Tactics.MoveLetIn.with 0.4% 2.2% 3 0.152s +─Pipeline.refine_reflectively_gen ------ 0.0% 37.5% 1 2.652s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 32.6% 1 2.308s + │└ReflectiveTactics.solve_side_conditio 0.0% 32.2% 1 2.276s + │ ├─ReflectiveTactics.solve_post_reifie 0.5% 18.5% 1 1.308s + │ │ ├─UnifyAbstractReflexivity.unify_tr 11.2% 13.6% 7 0.284s + │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.2% 1 0.300s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.7% 1 0.968s + │ └Reify.Reify_rhs_gen --------------- 0.6% 13.4% 1 0.948s + │ └Reify.do_reify_abs_goal ----------- 7.1% 7.2% 2 0.512s + │ └Reify.do_reifyf_goal -------------- 6.6% 6.7% 62 0.472s + └─Glue.refine_to_reflective_glue' ----- 0.0% 4.9% 1 0.344s + └Glue.zrange_to_reflective ----------- 0.0% 3.3% 1 0.232s + └Glue.zrange_to_reflective_goal ------ 1.9% 2.6% 1 0.184s + +Finished transaction in 7.732 secs (7.1u,0.003s) (successful) +Closed under the global context +total time: 7.072s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 62.5% 1 4.420s +─IntegrationTestTemporaryMiscCommon.fact 18.7% 51.6% 1 3.648s +─Pipeline.refine_reflectively_gen ------ 0.0% 37.5% 1 2.652s +─ReflectiveTactics.do_reflective_pipelin 0.0% 32.6% 1 2.308s +─ReflectiveTactics.solve_side_conditions 0.0% 32.2% 1 2.276s +─reflexivity --------------------------- 24.8% 24.8% 8 1.700s +─ReflectiveTactics.solve_post_reified_si 0.5% 18.5% 1 1.308s +─ReflectiveTactics.do_reify ------------ 0.0% 13.7% 1 0.968s +─UnifyAbstractReflexivity.unify_transfor 11.2% 13.6% 7 0.284s +─Reify.Reify_rhs_gen ------------------- 0.6% 13.4% 1 0.948s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 9.7% 1 0.684s +─rewrite <- (ZRange.is_bounded_by_None_r 9.0% 9.0% 4 0.328s +─op_sig_side_conditions_t -------------- 0.0% 7.8% 1 0.552s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 7.4% 1 0.520s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 7.4% 1 0.520s +─by_tac -------------------------------- 0.0% 7.2% 2 0.404s +─Reify.do_reify_abs_goal --------------- 7.1% 7.2% 2 0.512s +─Reify.do_reifyf_goal ------------------ 6.6% 6.7% 62 0.472s +─DestructHyps.do_one_match_then -------- 0.2% 5.8% 14 0.048s +─DestructHyps.do_all_matches_then ------ 0.0% 5.8% 4 0.124s +─do_tac -------------------------------- 0.0% 5.6% 10 0.048s +─destruct H ---------------------------- 5.6% 5.6% 10 0.048s +─Glue.refine_to_reflective_glue' ------- 0.0% 4.9% 1 0.344s +─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.2% 1 0.300s +─Glue.zrange_to_reflective ------------- 0.0% 3.3% 1 0.232s +─unify (constr) (constr) --------------- 3.2% 3.2% 7 0.088s +─Glue.zrange_to_reflective_goal -------- 1.9% 2.6% 1 0.184s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.3% 1 0.164s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.4% 2.2% 3 0.152s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 62.5% 1 4.420s + ├─IntegrationTestTemporaryMiscCommon.fa 18.7% 51.6% 1 3.648s + │ ├─reflexivity ----------------------- 24.0% 24.0% 1 1.700s + │ └─op_sig_side_conditions_t ---------- 0.0% 7.8% 1 0.552s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.2% 4.2% 2 0.284s + │ └─DestructHyps.do_all_matches_then 0.0% 3.5% 2 0.124s + │ └DestructHyps.do_one_match_then -- 0.2% 3.5% 8 0.044s + │ └do_tac -------------------------- 0.0% 3.3% 6 0.040s + │ └destruct H ---------------------- 3.3% 3.3% 6 0.040s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 9.7% 1 0.684s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 7.4% 1 0.520s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 7.4% 1 0.520s + │└by_tac ---------------------------- 0.0% 7.2% 2 0.404s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.8% 4.8% 2 0.328s + │ └─DestructHyps.do_all_matches_then 0.0% 2.3% 2 0.088s + │ └DestructHyps.do_one_match_then -- 0.0% 2.3% 6 0.048s + │ └do_tac -------------------------- 0.0% 2.3% 4 0.048s + │ └destruct H ---------------------- 2.3% 2.3% 4 0.048s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.3% 1 0.164s + └<Crypto.Util.Tactics.MoveLetIn.with 0.4% 2.2% 3 0.152s +─Pipeline.refine_reflectively_gen ------ 0.0% 37.5% 1 2.652s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 32.6% 1 2.308s + │└ReflectiveTactics.solve_side_conditio 0.0% 32.2% 1 2.276s + │ ├─ReflectiveTactics.solve_post_reifie 0.5% 18.5% 1 1.308s + │ │ ├─UnifyAbstractReflexivity.unify_tr 11.2% 13.6% 7 0.284s + │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.2% 1 0.300s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.7% 1 0.968s + │ └Reify.Reify_rhs_gen --------------- 0.6% 13.4% 1 0.948s + │ └Reify.do_reify_abs_goal ----------- 7.1% 7.2% 2 0.512s + │ └Reify.do_reifyf_goal -------------- 6.6% 6.7% 62 0.472s + └─Glue.refine_to_reflective_glue' ----- 0.0% 4.9% 1 0.344s + └Glue.zrange_to_reflective ----------- 0.0% 3.3% 1 0.232s + └Glue.zrange_to_reflective_goal ------ 1.9% 2.6% 1 0.184s + +src/Specific/NISTP256/AMD64/feopp (real: 31.00, user: 28.51, sys: 0.20, mem: 765208 ko) +COQC src/Specific/NISTP256/AMD64/fesub.v +Finished transaction in 12.996 secs (12.091u,0.004s) (successful) +total time: 12.048s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 66.1% 1 7.964s +─IntegrationTestTemporaryMiscCommon.fact 16.2% 50.9% 1 6.128s +─Pipeline.refine_reflectively_gen ------ 0.0% 33.9% 1 4.084s +─ReflectiveTactics.do_reflective_pipelin 0.0% 28.3% 1 3.404s +─ReflectiveTactics.solve_side_conditions 0.0% 27.8% 1 3.352s +─reflexivity --------------------------- 21.7% 21.7% 8 2.480s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 14.1% 1 1.704s +─ReflectiveTactics.solve_post_reified_si 0.4% 14.1% 1 1.696s +─ReflectiveTactics.do_reify ------------ 0.0% 13.7% 1 1.656s +─Reify.Reify_rhs_gen ------------------- 0.9% 13.2% 1 1.592s +─DestructHyps.do_all_matches_then ------ 0.0% 12.9% 8 0.232s +─DestructHyps.do_one_match_then -------- 0.6% 12.9% 44 0.052s +─op_sig_side_conditions_t -------------- 0.0% 12.7% 1 1.528s +─do_tac -------------------------------- 0.0% 12.3% 36 0.048s +─destruct H ---------------------------- 12.3% 12.3% 36 0.048s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 11.2% 1 1.352s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 11.2% 1 1.352s +─by_tac -------------------------------- 0.0% 11.1% 4 0.476s +─UnifyAbstractReflexivity.unify_transfor 8.8% 10.6% 7 0.344s +─rewrite <- (ZRange.is_bounded_by_None_r 10.5% 10.5% 8 0.316s +─Reify.do_reify_abs_goal --------------- 6.0% 6.1% 2 0.732s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.6% 1 0.680s +─Reify.do_reifyf_goal ------------------ 5.4% 5.5% 80 0.660s +─Glue.zrange_to_reflective ------------- 0.0% 3.6% 1 0.428s +─ReflectiveTactics.unify_abstract_cbv_in 2.2% 3.0% 1 0.360s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.9% 1 0.348s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.8% 3 0.332s +─Glue.zrange_to_reflective_goal -------- 1.7% 2.6% 1 0.316s +─k ------------------------------------- 2.1% 2.2% 1 0.268s +─unify (constr) (constr) --------------- 2.1% 2.1% 8 0.092s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 66.1% 1 7.964s + ├─IntegrationTestTemporaryMiscCommon.fa 16.2% 50.9% 1 6.128s + │ ├─reflexivity ----------------------- 20.6% 20.6% 1 2.480s + │ └─op_sig_side_conditions_t ---------- 0.0% 12.7% 1 1.528s + │ ├─DestructHyps.do_all_matches_then 0.0% 7.3% 4 0.232s + │ │└DestructHyps.do_one_match_then -- 0.3% 7.3% 24 0.052s + │ │└do_tac -------------------------- 0.0% 7.0% 20 0.048s + │ │└destruct H ---------------------- 6.9% 6.9% 20 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 4 0.300s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 14.1% 1 1.704s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 11.2% 1 1.352s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 11.2% 1 1.352s + │└by_tac ---------------------------- 0.0% 11.1% 4 0.476s + │ ├─DestructHyps.do_all_matches_then 0.0% 5.6% 4 0.176s + │ │└DestructHyps.do_one_match_then -- 0.2% 5.6% 20 0.052s + │ │└do_tac -------------------------- 0.0% 5.3% 16 0.048s + │ │└destruct H ---------------------- 5.3% 5.3% 16 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.3% 5.3% 4 0.316s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.9% 1 0.348s + └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.8% 3 0.332s + └k --------------------------------- 2.1% 2.2% 1 0.268s +─Pipeline.refine_reflectively_gen ------ 0.0% 33.9% 1 4.084s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 28.3% 1 3.404s + │└ReflectiveTactics.solve_side_conditio 0.0% 27.8% 1 3.352s + │ ├─ReflectiveTactics.solve_post_reifie 0.4% 14.1% 1 1.696s + │ │ ├─UnifyAbstractReflexivity.unify_tr 8.8% 10.6% 7 0.344s + │ │ └─ReflectiveTactics.unify_abstract_ 2.2% 3.0% 1 0.360s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.7% 1 1.656s + │ └Reify.Reify_rhs_gen --------------- 0.9% 13.2% 1 1.592s + │ └Reify.do_reify_abs_goal ----------- 6.0% 6.1% 2 0.732s + │ └Reify.do_reifyf_goal -------------- 5.4% 5.5% 80 0.660s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.6% 1 0.680s + └Glue.zrange_to_reflective ----------- 0.0% 3.6% 1 0.428s + └Glue.zrange_to_reflective_goal ------ 1.7% 2.6% 1 0.316s + +Finished transaction in 13.895 secs (12.78u,0.02s) (successful) +Closed under the global context +total time: 12.048s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 66.1% 1 7.964s +─IntegrationTestTemporaryMiscCommon.fact 16.2% 50.9% 1 6.128s +─Pipeline.refine_reflectively_gen ------ 0.0% 33.9% 1 4.084s +─ReflectiveTactics.do_reflective_pipelin 0.0% 28.3% 1 3.404s +─ReflectiveTactics.solve_side_conditions 0.0% 27.8% 1 3.352s +─reflexivity --------------------------- 21.7% 21.7% 8 2.480s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 14.1% 1 1.704s +─ReflectiveTactics.solve_post_reified_si 0.4% 14.1% 1 1.696s +─ReflectiveTactics.do_reify ------------ 0.0% 13.7% 1 1.656s +─Reify.Reify_rhs_gen ------------------- 0.9% 13.2% 1 1.592s +─DestructHyps.do_all_matches_then ------ 0.0% 12.9% 8 0.232s +─DestructHyps.do_one_match_then -------- 0.6% 12.9% 44 0.052s +─op_sig_side_conditions_t -------------- 0.0% 12.7% 1 1.528s +─do_tac -------------------------------- 0.0% 12.3% 36 0.048s +─destruct H ---------------------------- 12.3% 12.3% 36 0.048s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 11.2% 1 1.352s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 11.2% 1 1.352s +─by_tac -------------------------------- 0.0% 11.1% 4 0.476s +─UnifyAbstractReflexivity.unify_transfor 8.8% 10.6% 7 0.344s +─rewrite <- (ZRange.is_bounded_by_None_r 10.5% 10.5% 8 0.316s +─Reify.do_reify_abs_goal --------------- 6.0% 6.1% 2 0.732s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.6% 1 0.680s +─Reify.do_reifyf_goal ------------------ 5.4% 5.5% 80 0.660s +─Glue.zrange_to_reflective ------------- 0.0% 3.6% 1 0.428s +─ReflectiveTactics.unify_abstract_cbv_in 2.2% 3.0% 1 0.360s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.9% 1 0.348s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.8% 3 0.332s +─Glue.zrange_to_reflective_goal -------- 1.7% 2.6% 1 0.316s +─k ------------------------------------- 2.1% 2.2% 1 0.268s +─unify (constr) (constr) --------------- 2.1% 2.1% 8 0.092s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 66.1% 1 7.964s + ├─IntegrationTestTemporaryMiscCommon.fa 16.2% 50.9% 1 6.128s + │ ├─reflexivity ----------------------- 20.6% 20.6% 1 2.480s + │ └─op_sig_side_conditions_t ---------- 0.0% 12.7% 1 1.528s + │ ├─DestructHyps.do_all_matches_then 0.0% 7.3% 4 0.232s + │ │└DestructHyps.do_one_match_then -- 0.3% 7.3% 24 0.052s + │ │└do_tac -------------------------- 0.0% 7.0% 20 0.048s + │ │└destruct H ---------------------- 6.9% 6.9% 20 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 4 0.300s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 14.1% 1 1.704s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 11.2% 1 1.352s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 11.2% 1 1.352s + │└by_tac ---------------------------- 0.0% 11.1% 4 0.476s + │ ├─DestructHyps.do_all_matches_then 0.0% 5.6% 4 0.176s + │ │└DestructHyps.do_one_match_then -- 0.2% 5.6% 20 0.052s + │ │└do_tac -------------------------- 0.0% 5.3% 16 0.048s + │ │└destruct H ---------------------- 5.3% 5.3% 16 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.3% 5.3% 4 0.316s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.9% 1 0.348s + └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.8% 3 0.332s + └k --------------------------------- 2.1% 2.2% 1 0.268s +─Pipeline.refine_reflectively_gen ------ 0.0% 33.9% 1 4.084s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 28.3% 1 3.404s + │└ReflectiveTactics.solve_side_conditio 0.0% 27.8% 1 3.352s + │ ├─ReflectiveTactics.solve_post_reifie 0.4% 14.1% 1 1.696s + │ │ ├─UnifyAbstractReflexivity.unify_tr 8.8% 10.6% 7 0.344s + │ │ └─ReflectiveTactics.unify_abstract_ 2.2% 3.0% 1 0.360s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.7% 1 1.656s + │ └Reify.Reify_rhs_gen --------------- 0.9% 13.2% 1 1.592s + │ └Reify.do_reify_abs_goal ----------- 6.0% 6.1% 2 0.732s + │ └Reify.do_reifyf_goal -------------- 5.4% 5.5% 80 0.660s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.6% 1 0.680s + └Glue.zrange_to_reflective ----------- 0.0% 3.6% 1 0.428s + └Glue.zrange_to_reflective_goal ------ 1.7% 2.6% 1 0.316s + +src/Specific/NISTP256/AMD64/fesub (real: 43.34, user: 39.59, sys: 0.26, mem: 793376 ko) +COQC src/Specific/NISTP256/AMD64/feaddDisplay > 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 diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-before.log.in b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-before.log.in new file mode 100644 index 0000000000..14102902b1 --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-before.log.in @@ -0,0 +1,1662 @@ +COQDEP 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 +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.8% 3.6% 3 0.300s +─k ------------------------------------- 2.6% 2.8% 1 0.232s +─rewrite H ----------------------------- 2.4% 2.4% 2 0.192s +─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.200s +─rewrite ?EtaInterp.InterpExprEta ------ 2.2% 2.2% 1 0.188s +─apply (fun f => 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 + └<Crypto.Util.Tactics.MoveLetIn.with 0.8% 3.6% 3 0.300s + └k --------------------------------- 2.6% 2.8% 1 0.232s + +Finished transaction in 15.052 secs (13.947u,0.003s) (successful) +Closed under the global context +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 +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.8% 3.6% 3 0.300s +─k ------------------------------------- 2.6% 2.8% 1 0.232s +─rewrite H ----------------------------- 2.4% 2.4% 2 0.192s +─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.200s +─rewrite ?EtaInterp.InterpExprEta ------ 2.2% 2.2% 1 0.188s +─apply (fun f => 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 + └<Crypto.Util.Tactics.MoveLetIn.with 0.8% 3.6% 3 0.300s + └k --------------------------------- 2.6% 2.8% 1 0.232s + +src/Specific/NISTP256/AMD64/feadd (real: 40.48, user: 37.21, sys: 0.27, mem: 797944 ko) +COQC src/Specific/NISTP256/AMD64/fenz.v +Finished transaction in 6.724 secs (6.196u,0.007s) (successful) +total time: 6.180s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 6.180s +─IntegrationTestTemporaryMiscCommon.nonz 0.1% 84.5% 1 5.224s +─destruct (Decidable.dec x), (Decidable. 36.7% 36.7% 1 2.268s +─destruct (Decidable.dec x) as [H| H] -- 21.6% 21.6% 1 1.336s +─Pipeline.refine_reflectively_gen ------ 0.1% 15.5% 1 0.956s +─ReflectiveTactics.do_reflective_pipelin 0.0% 11.9% 1 0.736s +─ReflectiveTactics.solve_side_conditions 0.0% 11.6% 1 0.716s +─ReflectiveTactics.solve_post_reified_si 0.3% 9.6% 1 0.592s +─IntegrationTestTemporaryMiscCommon.op_s 0.1% 7.9% 2 0.392s +─rewrite <- (ZRange.is_bounded_by_None_r 5.2% 5.2% 2 0.308s +─UnifyAbstractReflexivity.unify_transfor 4.2% 5.2% 8 0.076s +─ReflectiveTactics.unify_abstract_cbv_in 3.0% 4.0% 1 0.248s +─Glue.refine_to_reflective_glue' ------- 0.0% 3.5% 1 0.216s +─rewrite H' ---------------------------- 3.4% 3.4% 1 0.208s +─generalize dependent (constr) --------- 3.1% 3.1% 4 0.068s +─congruence ---------------------------- 2.8% 2.8% 1 0.176s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.7% 1 0.164s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.6% 3 0.156s +─DestructHyps.do_one_match_then -------- 0.1% 2.5% 6 0.048s +─DestructHyps.do_all_matches_then ------ 0.0% 2.5% 2 0.084s +─do_tac -------------------------------- 0.0% 2.5% 7 0.044s +─destruct H ---------------------------- 2.5% 2.5% 4 0.044s +─Glue.zrange_to_reflective ------------- 0.1% 2.1% 1 0.132s +─rewrite H ----------------------------- 1.9% 2.1% 3 0.116s +─k ------------------------------------- 1.9% 2.0% 1 0.124s +─ReflectiveTactics.do_reify ------------ 0.0% 2.0% 1 0.124s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 6.180s + ├─IntegrationTestTemporaryMiscCommon.no 0.1% 84.5% 1 5.224s + │ ├─destruct (Decidable.dec x), (Decida 36.7% 36.7% 1 2.268s + │ ├─destruct (Decidable.dec x) as [H| H 21.6% 21.6% 1 1.336s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 7.9% 2 0.392s + │ │ ├─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 2 0.308s + │ │ └─DestructHyps.do_all_matches_then 0.0% 2.5% 2 0.084s + │ │ └DestructHyps.do_one_match_then -- 0.1% 2.5% 6 0.048s + │ │ └do_tac -------------------------- 0.0% 2.5% 4 0.044s + │ │ └destruct H ---------------------- 2.5% 2.5% 4 0.044s + │ ├─rewrite H' ------------------------ 3.4% 3.4% 1 0.208s + │ ├─generalize dependent (constr) ----- 3.1% 3.1% 4 0.068s + │ ├─congruence ------------------------ 2.8% 2.8% 1 0.176s + │ └─IntegrationTestTemporaryMiscCommon. 0.0% 2.7% 1 0.164s + │ └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.6% 3 0.156s + │ └k --------------------------------- 1.9% 2.0% 1 0.124s + └─Pipeline.refine_reflectively_gen ---- 0.1% 15.5% 1 0.956s + ├─ReflectiveTactics.do_reflective_pip 0.0% 11.9% 1 0.736s + │└ReflectiveTactics.solve_side_condit 0.0% 11.6% 1 0.716s + │ ├─ReflectiveTactics.solve_post_reif 0.3% 9.6% 1 0.592s + │ │ ├─UnifyAbstractReflexivity.unify_ 4.2% 5.2% 8 0.076s + │ │ └─ReflectiveTactics.unify_abstrac 3.0% 4.0% 1 0.248s + │ └─ReflectiveTactics.do_reify ------ 0.0% 2.0% 1 0.124s + └─Glue.refine_to_reflective_glue' --- 0.0% 3.5% 1 0.216s + └Glue.zrange_to_reflective --------- 0.1% 2.1% 1 0.132s + +Finished transaction in 7.301 secs (6.731u,0.s) (successful) +Closed under the global context +total time: 6.180s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 6.180s +─IntegrationTestTemporaryMiscCommon.nonz 0.1% 84.5% 1 5.224s +─destruct (Decidable.dec x), (Decidable. 36.7% 36.7% 1 2.268s +─destruct (Decidable.dec x) as [H| H] -- 21.6% 21.6% 1 1.336s +─Pipeline.refine_reflectively_gen ------ 0.1% 15.5% 1 0.956s +─ReflectiveTactics.do_reflective_pipelin 0.0% 11.9% 1 0.736s +─ReflectiveTactics.solve_side_conditions 0.0% 11.6% 1 0.716s +─ReflectiveTactics.solve_post_reified_si 0.3% 9.6% 1 0.592s +─IntegrationTestTemporaryMiscCommon.op_s 0.1% 7.9% 2 0.392s +─rewrite <- (ZRange.is_bounded_by_None_r 5.2% 5.2% 2 0.308s +─UnifyAbstractReflexivity.unify_transfor 4.2% 5.2% 8 0.076s +─ReflectiveTactics.unify_abstract_cbv_in 3.0% 4.0% 1 0.248s +─Glue.refine_to_reflective_glue' ------- 0.0% 3.5% 1 0.216s +─rewrite H' ---------------------------- 3.4% 3.4% 1 0.208s +─generalize dependent (constr) --------- 3.1% 3.1% 4 0.068s +─congruence ---------------------------- 2.8% 2.8% 1 0.176s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.7% 1 0.164s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.6% 3 0.156s +─DestructHyps.do_one_match_then -------- 0.1% 2.5% 6 0.048s +─DestructHyps.do_all_matches_then ------ 0.0% 2.5% 2 0.084s +─do_tac -------------------------------- 0.0% 2.5% 7 0.044s +─destruct H ---------------------------- 2.5% 2.5% 4 0.044s +─Glue.zrange_to_reflective ------------- 0.1% 2.1% 1 0.132s +─rewrite H ----------------------------- 1.9% 2.1% 3 0.116s +─k ------------------------------------- 1.9% 2.0% 1 0.124s +─ReflectiveTactics.do_reify ------------ 0.0% 2.0% 1 0.124s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_nonzero -------------------- 0.0% 100.0% 1 6.180s + ├─IntegrationTestTemporaryMiscCommon.no 0.1% 84.5% 1 5.224s + │ ├─destruct (Decidable.dec x), (Decida 36.7% 36.7% 1 2.268s + │ ├─destruct (Decidable.dec x) as [H| H 21.6% 21.6% 1 1.336s + │ ├─IntegrationTestTemporaryMiscCommon. 0.1% 7.9% 2 0.392s + │ │ ├─rewrite <- (ZRange.is_bounded_by_ 5.2% 5.2% 2 0.308s + │ │ └─DestructHyps.do_all_matches_then 0.0% 2.5% 2 0.084s + │ │ └DestructHyps.do_one_match_then -- 0.1% 2.5% 6 0.048s + │ │ └do_tac -------------------------- 0.0% 2.5% 4 0.044s + │ │ └destruct H ---------------------- 2.5% 2.5% 4 0.044s + │ ├─rewrite H' ------------------------ 3.4% 3.4% 1 0.208s + │ ├─generalize dependent (constr) ----- 3.1% 3.1% 4 0.068s + │ ├─congruence ------------------------ 2.8% 2.8% 1 0.176s + │ └─IntegrationTestTemporaryMiscCommon. 0.0% 2.7% 1 0.164s + │ └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.6% 3 0.156s + │ └k --------------------------------- 1.9% 2.0% 1 0.124s + └─Pipeline.refine_reflectively_gen ---- 0.1% 15.5% 1 0.956s + ├─ReflectiveTactics.do_reflective_pip 0.0% 11.9% 1 0.736s + │└ReflectiveTactics.solve_side_condit 0.0% 11.6% 1 0.716s + │ ├─ReflectiveTactics.solve_post_reif 0.3% 9.6% 1 0.592s + │ │ ├─UnifyAbstractReflexivity.unify_ 4.2% 5.2% 8 0.076s + │ │ └─ReflectiveTactics.unify_abstrac 3.0% 4.0% 1 0.248s + │ └─ReflectiveTactics.do_reify ------ 0.0% 2.0% 1 0.124s + └─Glue.refine_to_reflective_glue' --- 0.0% 3.5% 1 0.216s + └Glue.zrange_to_reflective --------- 0.1% 2.1% 1 0.132s + +src/Specific/NISTP256/AMD64/fenz (real: 28.91, user: 26.41, sys: 0.19, mem: 756216 ko) +COQC src/Specific/NISTP256/AMD64/feopp.v +Finished transaction in 7.716 secs (7.216u,0.s) (successful) +total time: 7.168s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 59.8% 1 4.284s +─IntegrationTestTemporaryMiscCommon.fact 17.6% 49.1% 1 3.516s +─Pipeline.refine_reflectively_gen ------ 0.0% 40.2% 1 2.884s +─ReflectiveTactics.do_reflective_pipelin 0.0% 35.3% 1 2.528s +─ReflectiveTactics.solve_side_conditions 0.0% 34.8% 1 2.492s +─reflexivity --------------------------- 23.8% 23.8% 8 1.660s +─ReflectiveTactics.solve_post_reified_si 0.4% 21.0% 1 1.504s +─UnifyAbstractReflexivity.unify_transfor 13.8% 16.4% 8 0.268s +─ReflectiveTactics.do_reify ------------ 0.1% 13.8% 1 0.988s +─Reify.Reify_rhs_gen ------------------- 0.8% 13.6% 1 0.972s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 9.5% 1 0.680s +─rewrite <- (ZRange.is_bounded_by_None_r 8.7% 8.7% 4 0.332s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 7.3% 1 0.520s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 7.3% 1 0.520s +─op_sig_side_conditions_t -------------- 0.0% 7.2% 1 0.516s +─by_tac -------------------------------- 0.0% 7.1% 2 0.412s +─Reify.do_reify_abs_goal --------------- 6.9% 7.0% 2 0.500s +─Reify.do_reifyf_goal ------------------ 6.3% 6.5% 62 0.460s +─DestructHyps.do_one_match_then -------- 0.3% 5.4% 14 0.044s +─DestructHyps.do_all_matches_then ------ 0.0% 5.4% 4 0.116s +─do_tac -------------------------------- 0.0% 5.1% 13 0.044s +─destruct H ---------------------------- 5.1% 5.1% 10 0.044s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.0% 1 0.356s +─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.1% 1 0.292s +─Glue.zrange_to_reflective ------------- 0.0% 3.4% 1 0.244s +─unify (constr) (constr) --------------- 3.1% 3.1% 8 0.072s +─Glue.zrange_to_reflective_goal -------- 2.1% 2.7% 1 0.196s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.2% 1 0.160s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.3% 2.2% 3 0.152s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 59.8% 1 4.284s + ├─IntegrationTestTemporaryMiscCommon.fa 17.6% 49.1% 1 3.516s + │ ├─reflexivity ----------------------- 23.2% 23.2% 1 1.660s + │ └─op_sig_side_conditions_t ---------- 0.0% 7.2% 1 0.516s + │ ├─rewrite <- (ZRange.is_bounded_by_ 3.9% 3.9% 2 0.272s + │ └─DestructHyps.do_all_matches_then 0.0% 3.2% 2 0.116s + │ └DestructHyps.do_one_match_then -- 0.2% 3.2% 8 0.044s + │ └do_tac -------------------------- 0.0% 3.0% 6 0.040s + │ └destruct H ---------------------- 3.0% 3.0% 6 0.040s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 9.5% 1 0.680s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 7.3% 1 0.520s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 7.3% 1 0.520s + │└by_tac ---------------------------- 0.0% 7.1% 2 0.412s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.8% 4.8% 2 0.332s + │ └─DestructHyps.do_all_matches_then 0.0% 2.2% 2 0.080s + │ └DestructHyps.do_one_match_then -- 0.1% 2.2% 6 0.044s + │ └do_tac -------------------------- 0.0% 2.2% 4 0.044s + │ └destruct H ---------------------- 2.2% 2.2% 4 0.044s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.2% 1 0.160s + └<Crypto.Util.Tactics.MoveLetIn.with 0.3% 2.2% 3 0.152s +─Pipeline.refine_reflectively_gen ------ 0.0% 40.2% 1 2.884s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 35.3% 1 2.528s + │└ReflectiveTactics.solve_side_conditio 0.0% 34.8% 1 2.492s + │ ├─ReflectiveTactics.solve_post_reifie 0.4% 21.0% 1 1.504s + │ │ ├─UnifyAbstractReflexivity.unify_tr 13.8% 16.4% 8 0.268s + │ │ │└unify (constr) (constr) --------- 2.1% 2.1% 6 0.048s + │ │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.1% 1 0.292s + │ └─ReflectiveTactics.do_reify -------- 0.1% 13.8% 1 0.988s + │ └Reify.Reify_rhs_gen --------------- 0.8% 13.6% 1 0.972s + │ └Reify.do_reify_abs_goal ----------- 6.9% 7.0% 2 0.500s + │ └Reify.do_reifyf_goal -------------- 6.3% 6.5% 62 0.460s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.0% 1 0.356s + └Glue.zrange_to_reflective ----------- 0.0% 3.4% 1 0.244s + └Glue.zrange_to_reflective_goal ------ 2.1% 2.7% 1 0.196s + +Finished transaction in 8.918 secs (8.116u,0.004s) (successful) +Closed under the global context +total time: 7.168s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 59.8% 1 4.284s +─IntegrationTestTemporaryMiscCommon.fact 17.6% 49.1% 1 3.516s +─Pipeline.refine_reflectively_gen ------ 0.0% 40.2% 1 2.884s +─ReflectiveTactics.do_reflective_pipelin 0.0% 35.3% 1 2.528s +─ReflectiveTactics.solve_side_conditions 0.0% 34.8% 1 2.492s +─reflexivity --------------------------- 23.8% 23.8% 8 1.660s +─ReflectiveTactics.solve_post_reified_si 0.4% 21.0% 1 1.504s +─UnifyAbstractReflexivity.unify_transfor 13.8% 16.4% 8 0.268s +─ReflectiveTactics.do_reify ------------ 0.1% 13.8% 1 0.988s +─Reify.Reify_rhs_gen ------------------- 0.8% 13.6% 1 0.972s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 9.5% 1 0.680s +─rewrite <- (ZRange.is_bounded_by_None_r 8.7% 8.7% 4 0.332s +─rewrite <- (lem : lemT) by by_tac ltac: 0.1% 7.3% 1 0.520s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 7.3% 1 0.520s +─op_sig_side_conditions_t -------------- 0.0% 7.2% 1 0.516s +─by_tac -------------------------------- 0.0% 7.1% 2 0.412s +─Reify.do_reify_abs_goal --------------- 6.9% 7.0% 2 0.500s +─Reify.do_reifyf_goal ------------------ 6.3% 6.5% 62 0.460s +─DestructHyps.do_one_match_then -------- 0.3% 5.4% 14 0.044s +─DestructHyps.do_all_matches_then ------ 0.0% 5.4% 4 0.116s +─do_tac -------------------------------- 0.0% 5.1% 13 0.044s +─destruct H ---------------------------- 5.1% 5.1% 10 0.044s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.0% 1 0.356s +─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.1% 1 0.292s +─Glue.zrange_to_reflective ------------- 0.0% 3.4% 1 0.244s +─unify (constr) (constr) --------------- 3.1% 3.1% 8 0.072s +─Glue.zrange_to_reflective_goal -------- 2.1% 2.7% 1 0.196s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.2% 1 0.160s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.3% 2.2% 3 0.152s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 59.8% 1 4.284s + ├─IntegrationTestTemporaryMiscCommon.fa 17.6% 49.1% 1 3.516s + │ ├─reflexivity ----------------------- 23.2% 23.2% 1 1.660s + │ └─op_sig_side_conditions_t ---------- 0.0% 7.2% 1 0.516s + │ ├─rewrite <- (ZRange.is_bounded_by_ 3.9% 3.9% 2 0.272s + │ └─DestructHyps.do_all_matches_then 0.0% 3.2% 2 0.116s + │ └DestructHyps.do_one_match_then -- 0.2% 3.2% 8 0.044s + │ └do_tac -------------------------- 0.0% 3.0% 6 0.040s + │ └destruct H ---------------------- 3.0% 3.0% 6 0.040s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 9.5% 1 0.680s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 7.3% 1 0.520s + │└rewrite <- (lem : lemT) by by_tac l 0.1% 7.3% 1 0.520s + │└by_tac ---------------------------- 0.0% 7.1% 2 0.412s + │ ├─rewrite <- (ZRange.is_bounded_by_ 4.8% 4.8% 2 0.332s + │ └─DestructHyps.do_all_matches_then 0.0% 2.2% 2 0.080s + │ └DestructHyps.do_one_match_then -- 0.1% 2.2% 6 0.044s + │ └do_tac -------------------------- 0.0% 2.2% 4 0.044s + │ └destruct H ---------------------- 2.2% 2.2% 4 0.044s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.2% 1 0.160s + └<Crypto.Util.Tactics.MoveLetIn.with 0.3% 2.2% 3 0.152s +─Pipeline.refine_reflectively_gen ------ 0.0% 40.2% 1 2.884s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 35.3% 1 2.528s + │└ReflectiveTactics.solve_side_conditio 0.0% 34.8% 1 2.492s + │ ├─ReflectiveTactics.solve_post_reifie 0.4% 21.0% 1 1.504s + │ │ ├─UnifyAbstractReflexivity.unify_tr 13.8% 16.4% 8 0.268s + │ │ │└unify (constr) (constr) --------- 2.1% 2.1% 6 0.048s + │ │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.1% 1 0.292s + │ └─ReflectiveTactics.do_reify -------- 0.1% 13.8% 1 0.988s + │ └Reify.Reify_rhs_gen --------------- 0.8% 13.6% 1 0.972s + │ └Reify.do_reify_abs_goal ----------- 6.9% 7.0% 2 0.500s + │ └Reify.do_reifyf_goal -------------- 6.3% 6.5% 62 0.460s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.0% 1 0.356s + └Glue.zrange_to_reflective ----------- 0.0% 3.4% 1 0.244s + └Glue.zrange_to_reflective_goal ------ 2.1% 2.7% 1 0.196s + +src/Specific/NISTP256/AMD64/feopp (real: 32.08, user: 29.46, sys: 0.25, mem: 765212 ko) +COQC src/Specific/NISTP256/AMD64/fesub.v +Finished transaction in 12.83 secs (11.988u,0.019s) (successful) +total time: 11.956s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 63.2% 1 7.560s +─IntegrationTestTemporaryMiscCommon.fact 15.6% 48.5% 1 5.796s +─Pipeline.refine_reflectively_gen ------ 0.0% 36.8% 1 4.396s +─ReflectiveTactics.do_reflective_pipelin 0.0% 31.0% 1 3.712s +─ReflectiveTactics.solve_side_conditions 0.0% 30.6% 1 3.656s +─reflexivity --------------------------- 20.3% 20.3% 8 2.312s +─ReflectiveTactics.solve_post_reified_si 0.5% 17.3% 1 2.064s +─UnifyAbstractReflexivity.unify_transfor 11.8% 13.9% 8 0.452s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 13.7% 1 1.636s +─ReflectiveTactics.do_reify ------------ 0.0% 13.3% 1 1.592s +─Reify.Reify_rhs_gen ------------------- 0.9% 12.8% 1 1.536s +─DestructHyps.do_all_matches_then ------ 0.1% 12.6% 8 0.224s +─DestructHyps.do_one_match_then -------- 0.5% 12.5% 44 0.056s +─op_sig_side_conditions_t -------------- 0.0% 12.2% 1 1.456s +─do_tac -------------------------------- 0.0% 12.0% 43 0.052s +─destruct H ---------------------------- 11.9% 11.9% 36 0.052s +─rewrite <- (lem : lemT) by by_tac ltac: 0.2% 11.1% 1 1.324s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 11.1% 1 1.324s +─by_tac -------------------------------- 0.0% 10.9% 4 0.488s +─rewrite <- (ZRange.is_bounded_by_None_r 10.1% 10.2% 8 0.328s +─Reify.do_reify_abs_goal --------------- 6.0% 6.1% 2 0.724s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.7% 1 0.680s +─Reify.do_reifyf_goal ------------------ 5.5% 5.6% 80 0.660s +─Glue.zrange_to_reflective ------------- 0.0% 3.6% 1 0.432s +─ReflectiveTactics.unify_abstract_cbv_in 2.0% 2.8% 1 0.340s +─Glue.zrange_to_reflective_goal -------- 1.7% 2.7% 1 0.324s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.6% 1 0.312s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.5% 3 0.300s +─unify (constr) (constr) --------------- 2.4% 2.4% 9 0.100s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 63.2% 1 7.560s + ├─IntegrationTestTemporaryMiscCommon.fa 15.6% 48.5% 1 5.796s + │ ├─reflexivity ----------------------- 19.3% 19.3% 1 2.312s + │ └─op_sig_side_conditions_t ---------- 0.0% 12.2% 1 1.456s + │ ├─DestructHyps.do_all_matches_then 0.1% 7.1% 4 0.224s + │ │└DestructHyps.do_one_match_then -- 0.3% 7.1% 24 0.056s + │ │└do_tac -------------------------- 0.0% 6.7% 20 0.052s + │ │└destruct H ---------------------- 6.7% 6.7% 20 0.052s + │ └─rewrite <- (ZRange.is_bounded_by_ 4.9% 4.9% 4 0.292s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 13.7% 1 1.636s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 11.1% 1 1.324s + │└rewrite <- (lem : lemT) by by_tac l 0.2% 11.1% 1 1.324s + │└by_tac ---------------------------- 0.0% 10.9% 4 0.488s + │ ├─DestructHyps.do_all_matches_then 0.0% 5.5% 4 0.176s + │ │└DestructHyps.do_one_match_then -- 0.2% 5.5% 20 0.048s + │ │└do_tac -------------------------- 0.0% 5.3% 16 0.048s + │ │└destruct H ---------------------- 5.2% 5.2% 16 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.3% 5.3% 4 0.328s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.6% 1 0.312s + └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.5% 3 0.300s +─Pipeline.refine_reflectively_gen ------ 0.0% 36.8% 1 4.396s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 31.0% 1 3.712s + │└ReflectiveTactics.solve_side_conditio 0.0% 30.6% 1 3.656s + │ ├─ReflectiveTactics.solve_post_reifie 0.5% 17.3% 1 2.064s + │ │ ├─UnifyAbstractReflexivity.unify_tr 11.8% 13.9% 8 0.452s + │ │ └─ReflectiveTactics.unify_abstract_ 2.0% 2.8% 1 0.340s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.3% 1 1.592s + │ └Reify.Reify_rhs_gen --------------- 0.9% 12.8% 1 1.536s + │ └Reify.do_reify_abs_goal ----------- 6.0% 6.1% 2 0.724s + │ └Reify.do_reifyf_goal -------------- 5.5% 5.6% 80 0.660s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.7% 1 0.680s + └Glue.zrange_to_reflective ----------- 0.0% 3.6% 1 0.432s + └Glue.zrange_to_reflective_goal ------ 1.7% 2.7% 1 0.324s + +Finished transaction in 14.576 secs (13.372u,0.004s) (successful) +Closed under the global context +total time: 11.956s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 63.2% 1 7.560s +─IntegrationTestTemporaryMiscCommon.fact 15.6% 48.5% 1 5.796s +─Pipeline.refine_reflectively_gen ------ 0.0% 36.8% 1 4.396s +─ReflectiveTactics.do_reflective_pipelin 0.0% 31.0% 1 3.712s +─ReflectiveTactics.solve_side_conditions 0.0% 30.6% 1 3.656s +─reflexivity --------------------------- 20.3% 20.3% 8 2.312s +─ReflectiveTactics.solve_post_reified_si 0.5% 17.3% 1 2.064s +─UnifyAbstractReflexivity.unify_transfor 11.8% 13.9% 8 0.452s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 13.7% 1 1.636s +─ReflectiveTactics.do_reify ------------ 0.0% 13.3% 1 1.592s +─Reify.Reify_rhs_gen ------------------- 0.9% 12.8% 1 1.536s +─DestructHyps.do_all_matches_then ------ 0.1% 12.6% 8 0.224s +─DestructHyps.do_one_match_then -------- 0.5% 12.5% 44 0.056s +─op_sig_side_conditions_t -------------- 0.0% 12.2% 1 1.456s +─do_tac -------------------------------- 0.0% 12.0% 43 0.052s +─destruct H ---------------------------- 11.9% 11.9% 36 0.052s +─rewrite <- (lem : lemT) by by_tac ltac: 0.2% 11.1% 1 1.324s +─IntegrationTestTemporaryMiscCommon.do_r 0.0% 11.1% 1 1.324s +─by_tac -------------------------------- 0.0% 10.9% 4 0.488s +─rewrite <- (ZRange.is_bounded_by_None_r 10.1% 10.2% 8 0.328s +─Reify.do_reify_abs_goal --------------- 6.0% 6.1% 2 0.724s +─Glue.refine_to_reflective_glue' ------- 0.0% 5.7% 1 0.680s +─Reify.do_reifyf_goal ------------------ 5.5% 5.6% 80 0.660s +─Glue.zrange_to_reflective ------------- 0.0% 3.6% 1 0.432s +─ReflectiveTactics.unify_abstract_cbv_in 2.0% 2.8% 1 0.340s +─Glue.zrange_to_reflective_goal -------- 1.7% 2.7% 1 0.324s +─IntegrationTestTemporaryMiscCommon.do_s 0.0% 2.6% 1 0.312s +─<Crypto.Util.Tactics.MoveLetIn.with_uco 0.5% 2.5% 3 0.300s +─unify (constr) (constr) --------------- 2.4% 2.4% 9 0.100s + + tactic local total calls max +────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ +─synthesize_montgomery ----------------- 0.0% 63.2% 1 7.560s + ├─IntegrationTestTemporaryMiscCommon.fa 15.6% 48.5% 1 5.796s + │ ├─reflexivity ----------------------- 19.3% 19.3% 1 2.312s + │ └─op_sig_side_conditions_t ---------- 0.0% 12.2% 1 1.456s + │ ├─DestructHyps.do_all_matches_then 0.1% 7.1% 4 0.224s + │ │└DestructHyps.do_one_match_then -- 0.3% 7.1% 24 0.056s + │ │└do_tac -------------------------- 0.0% 6.7% 20 0.052s + │ │└destruct H ---------------------- 6.7% 6.7% 20 0.052s + │ └─rewrite <- (ZRange.is_bounded_by_ 4.9% 4.9% 4 0.292s + └─IntegrationTestTemporaryMiscCommon.do 0.0% 13.7% 1 1.636s + ├─IntegrationTestTemporaryMiscCommon. 0.0% 11.1% 1 1.324s + │└rewrite <- (lem : lemT) by by_tac l 0.2% 11.1% 1 1.324s + │└by_tac ---------------------------- 0.0% 10.9% 4 0.488s + │ ├─DestructHyps.do_all_matches_then 0.0% 5.5% 4 0.176s + │ │└DestructHyps.do_one_match_then -- 0.2% 5.5% 20 0.048s + │ │└do_tac -------------------------- 0.0% 5.3% 16 0.048s + │ │└destruct H ---------------------- 5.2% 5.2% 16 0.048s + │ └─rewrite <- (ZRange.is_bounded_by_ 5.3% 5.3% 4 0.328s + └─IntegrationTestTemporaryMiscCommon. 0.0% 2.6% 1 0.312s + └<Crypto.Util.Tactics.MoveLetIn.with 0.5% 2.5% 3 0.300s +─Pipeline.refine_reflectively_gen ------ 0.0% 36.8% 1 4.396s + ├─ReflectiveTactics.do_reflective_pipel 0.0% 31.0% 1 3.712s + │└ReflectiveTactics.solve_side_conditio 0.0% 30.6% 1 3.656s + │ ├─ReflectiveTactics.solve_post_reifie 0.5% 17.3% 1 2.064s + │ │ ├─UnifyAbstractReflexivity.unify_tr 11.8% 13.9% 8 0.452s + │ │ └─ReflectiveTactics.unify_abstract_ 2.0% 2.8% 1 0.340s + │ └─ReflectiveTactics.do_reify -------- 0.0% 13.3% 1 1.592s + │ └Reify.Reify_rhs_gen --------------- 0.9% 12.8% 1 1.536s + │ └Reify.do_reify_abs_goal ----------- 6.0% 6.1% 2 0.724s + │ └Reify.do_reifyf_goal -------------- 5.5% 5.6% 80 0.660s + └─Glue.refine_to_reflective_glue' ----- 0.0% 5.7% 1 0.680s + └Glue.zrange_to_reflective ----------- 0.0% 3.6% 1 0.432s + └Glue.zrange_to_reflective_goal ------ 1.7% 2.7% 1 0.324s + +src/Specific/NISTP256/AMD64/fesub (real: 43.78, user: 40.09, sys: 0.30, mem: 799668 ko) +COQC src/Specific/NISTP256/AMD64/feaddDisplay > 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 diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-absolute.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-absolute.log.expected new file mode 100644 index 0000000000..2a2d2c1b2f --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-absolute.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -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.25s || -14176 ko | -7.58% | -1.68% + 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.14s || -3156 ko | -6.10% | -0.39% + 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.28s || 1272 ko | -5.65% | +0.15% + 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.43s || -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.39s || -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.07s || -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.09s || -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.19s || -1940 ko | +11.56% | -0.35% + 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.19s || 648 ko | +16.94% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-auto.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-auto.log.expected new file mode 100644 index 0000000000..7e4cfaec1c --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-auto.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -67396 ko | -12.58% | -4.06% + 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.25s || -14176 ko | -7.58% | -1.68% + 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.43s || -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.14s || -3156 ko | -6.10% | -0.39% + 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.39s || -3016 ko | -5.36% | -0.38% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.19s || -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.28s || 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.19s || 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.07s || -4 ko | -3.36% | -0.00%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-diff.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-diff.log.expected new file mode 100644 index 0000000000..7842f91f1f --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real-diff.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.28s || 1272 ko | -5.65% | +0.15% + 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.19s || 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.07s || -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.19s || -1940 ko | +11.56% | -0.35% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.39s || -3016 ko | -5.36% | -0.38% + 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.14s || -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.43s || -6292 ko | -1.00% | -0.78% + 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.25s || -14176 ko | -7.58% | -1.68% + 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.16s || -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%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real.log.expected new file mode 100644 index 0000000000..7e4cfaec1c --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-real.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.30s | 3307052 ko || -2m20.23s || -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.16s || -67396 ko | -12.58% | -4.06% + 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.25s || -14176 ko | -7.58% | -1.68% + 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.43s || -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.14s || -3156 ko | -6.10% | -0.39% + 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.39s || -3016 ko | -5.36% | -0.38% + 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.09s || -2332 ko | -5.12% | -0.35% + 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.19s || -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.28s || 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.19s || 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.07s || -4 ko | -3.36% | -0.00%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-absolute.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-absolute.log.expected new file mode 100644 index 0000000000..ea116a804f --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-absolute.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -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.17s || -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.94s || -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.06s || -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.13s || -1940 ko | +8.86% | -0.35% + 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.14s || 648 ko | +14.42% | +0.12%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-auto.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-auto.log.expected new file mode 100644 index 0000000000..128f140662 --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-auto.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -67396 ko | -12.66% | -4.06% + 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.17s || -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.13s || -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.14s || 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.06s || -52 ko | +0.67% | -0.00% + 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.94s || -4 ko | -3.22% | -0.00%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-diff.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-diff.log.expected new file mode 100644 index 0000000000..79dc49892f --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user-diff.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.14s || 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.94s || -4 ko | -3.22% | -0.00% + 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.06s || -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.13s || -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.17s || -14176 ko | -8.05% | -1.68% + 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.42s || -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%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user.log.expected new file mode 100644 index 0000000000..128f140662 --- /dev/null +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/005-correct-diff-sorting-order-mem/time-of-build-both-user.log.expected @@ -0,0 +1,26 @@ + After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) +--------------------------------------------------------------------------------------------------------------------------------------------------------- +19m16.04s | 3302508 ko | Total Time / Peak Mem | 21m25.27s | 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.42s || -67396 ko | -12.66% | -4.06% + 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.17s || -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.13s || -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.14s || 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.06s || -52 ko | +0.67% | -0.00% + 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.94s || -4 ko | -3.22% | -0.00%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh index 4b5acb9168..8935759705 100755 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh @@ -11,3 +11,4 @@ export COQLIB ./002-single-file-sorting/run.sh ./003-non-utf8/run.sh ./004-per-file-fuzz/run.sh +./005-correct-diff-sorting-order-mem/run.sh diff --git a/test-suite/coq-makefile/timing/run.sh b/test-suite/coq-makefile/timing/run.sh index 4ee4aae36c..ed5a4f93f5 100755 --- a/test-suite/coq-makefile/timing/run.sh +++ b/test-suite/coq-makefile/timing/run.sh @@ -55,15 +55,17 @@ TO_SED_IN_BOTH=( TO_SED_IN_PER_FILE=( -e s'/ */ /g' # unclear whether this is actually needed for per-file timing; it's been here from the start -e s'/\(Total.*\)-\(.*\)-/\1+\2+/g' # Overall time in the per-file timing diff should be around 0; if it comes out negative, we remove the sign + -e s'/- ko/ko/g' # for small amounts of memory, signs can flip, so we remove mem signs ) TO_SED_IN_PER_LINE=( -e s'/ */ /g' # Sometimes 0 will show up as 0m00.s, sometimes it'll end up being more like 0m00.001s; we must strip out the spaces that result from left-aligning numbers of different widths based on how many digits Coq's [-time] gives + -e s'/^ *//g' # the number of leading spaces can differ, e.g., as in the difference between ' 0m13.53s' vs '0m13.582s' ) for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do for ext in "" .desired; do - grep -v 'warning: undefined variable' < ${file}${ext} | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_FILE[@]}" > ${file}${ext}.processed + sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_FILE[@]}" ${file}${ext} > ${file}${ext}.processed done echo "cat $file" cat "$file" diff --git a/test-suite/coqdoc/Record.html.out b/test-suite/coqdoc/Record.html.out new file mode 100644 index 0000000000..371188dfbe --- /dev/null +++ b/test-suite/coqdoc/Record.html.out @@ -0,0 +1,34 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" +"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> +<link href="coqdoc.css" rel="stylesheet" type="text/css" /> +<title>Coqdoc.Record</title> +</head> + +<body> + +<div id="page"> + +<div id="header"> +</div> + +<div id="main"> + +<h1 class="libtitle">Library Coqdoc.Record</h1> + +<div class="code"> +<span class="id" title="keyword">Record</span> <a id="a" class="idref" href="#a"><span class="id" title="record">a</span></a> := { <a id="b" class="idref" href="#b"><span class="id" title="projection">b</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> ; <a id="c" class="idref" href="#c"><span class="id" title="projection">c</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#bool"><span class="id" title="inductive">bool</span></a> }.<br/> +<span class="id" title="keyword">Definition</span> <a id="d" class="idref" href="#d"><span class="id" title="definition">d</span></a> := {| <a class="idref" href="Coqdoc.Record.html#b"><span class="id" title="projection">b</span></a> := 0 ; <a class="idref" href="Coqdoc.Record.html#c"><span class="id" title="projection">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#true"><span class="id" title="constructor">true</span></a> |}.<br/> +</div> +</div> + +<div id="footer"> +<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://coq.inria.fr/">coqdoc</a> +</div> + +</div> + +</body> +</html>
\ No newline at end of file diff --git a/test-suite/coqdoc/Record.tex.out b/test-suite/coqdoc/Record.tex.out new file mode 100644 index 0000000000..4130ea9472 --- /dev/null +++ b/test-suite/coqdoc/Record.tex.out @@ -0,0 +1,27 @@ +\documentclass[12pt]{report} +\usepackage[utf8x]{inputenc} + +%Warning: tipa declares many non-standard macros used by utf8x to +%interpret utf8 characters but extra packages might have to be added +%such as "textgreek" for Greek letters not already in tipa +%or "stmaryrd" for mathematical symbols. +%Utf8 codes missing a LaTeX interpretation can be defined by using +%\DeclareUnicodeCharacter{code}{interpretation}. +%Use coqdoc's option -p to add new packages or declarations. +\usepackage{tipa} + +\usepackage[T1]{fontenc} +\usepackage{fullpage} +\usepackage{coqdoc} +\usepackage{amsmath,amssymb} +\usepackage{url} +\begin{document} +\coqlibrary{Coqdoc.Record}{Library }{Coqdoc.Record} + +\begin{coqdoccode} +\coqdocnoindent +\coqdockw{Record} \coqdef{Coqdoc.Record.a}{a}{\coqdocrecord{a}} := \{ \coqdef{Coqdoc.Record.b}{b}{\coqdocprojection{b}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} ; \coqdef{Coqdoc.Record.c}{c}{\coqdocprojection{c}} : \coqexternalref{bool}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{bool}} \}.\coqdoceol +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.Record.d}{d}{\coqdocdefinition{d}} := \{| \coqref{Coqdoc.Record.b}{\coqdocprojection{b}} := 0 ; \coqref{Coqdoc.Record.c}{\coqdocprojection{c}} := \coqexternalref{true}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{true}} |\}.\coqdoceol +\end{coqdoccode} +\end{document} diff --git a/test-suite/coqdoc/Record.v b/test-suite/coqdoc/Record.v new file mode 100644 index 0000000000..f362aade98 --- /dev/null +++ b/test-suite/coqdoc/Record.v @@ -0,0 +1,2 @@ +Record a := { b : nat ; c : bool }. +Definition d := {| b := 0 ; c := true |}. diff --git a/test-suite/coqdoc/binder.html.out b/test-suite/coqdoc/binder.html.out new file mode 100644 index 0000000000..af8eb46845 --- /dev/null +++ b/test-suite/coqdoc/binder.html.out @@ -0,0 +1,41 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" +"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> +<link href="coqdoc.css" rel="stylesheet" type="text/css" /> +<title>Coqdoc.binder</title> +</head> + +<body> + +<div id="page"> + +<div id="header"> +</div> + +<div id="main"> + +<h1 class="libtitle">Library Coqdoc.binder</h1> + +<div class="code"> +</div> + +<div class="doc"> +Link binders +</div> +<div class="code"> + +<br/> +<span class="id" title="keyword">Definition</span> <a id="foo" class="idref" href="#foo"><span class="id" title="definition">foo</span></a> <a id="alpha:1" class="idref" href="#alpha:1"><span class="id" title="binder">alpha</span></a> <a id="beta:2" class="idref" href="#beta:2"><span class="id" title="binder">beta</span></a> := <a class="idref" href="Coqdoc.binder.html#alpha:1"><span class="id" title="variable">alpha</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.binder.html#beta:2"><span class="id" title="variable">beta</span></a>.<br/> +</div> +</div> + +<div id="footer"> +<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://coq.inria.fr/">coqdoc</a> +</div> + +</div> + +</body> +</html>
\ No newline at end of file diff --git a/test-suite/coqdoc/binder.tex.out b/test-suite/coqdoc/binder.tex.out new file mode 100644 index 0000000000..2b5648aee6 --- /dev/null +++ b/test-suite/coqdoc/binder.tex.out @@ -0,0 +1,28 @@ +\documentclass[12pt]{report} +\usepackage[utf8x]{inputenc} + +%Warning: tipa declares many non-standard macros used by utf8x to +%interpret utf8 characters but extra packages might have to be added +%such as "textgreek" for Greek letters not already in tipa +%or "stmaryrd" for mathematical symbols. +%Utf8 codes missing a LaTeX interpretation can be defined by using +%\DeclareUnicodeCharacter{code}{interpretation}. +%Use coqdoc's option -p to add new packages or declarations. +\usepackage{tipa} + +\usepackage[T1]{fontenc} +\usepackage{fullpage} +\usepackage{coqdoc} +\usepackage{amsmath,amssymb} +\usepackage{url} +\begin{document} +\coqlibrary{Coqdoc.binder}{Library }{Coqdoc.binder} + +\begin{coqdoccode} +\end{coqdoccode} +Link binders \begin{coqdoccode} +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.binder.foo}{foo}{\coqdocdefinition{foo}} \coqdef{Coqdoc.binder.alpha:1}{alpha}{\coqdocbinder{alpha}} \coqdef{Coqdoc.binder.beta:2}{beta}{\coqdocbinder{beta}} := \coqref{Coqdoc.binder.alpha:1}{\coqdocvariable{alpha}} \coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.binder.beta:2}{\coqdocvariable{beta}}.\coqdoceol +\end{coqdoccode} +\end{document} diff --git a/test-suite/coqdoc/binder.v b/test-suite/coqdoc/binder.v new file mode 100644 index 0000000000..283ef64ac5 --- /dev/null +++ b/test-suite/coqdoc/binder.v @@ -0,0 +1,3 @@ +(** Link binders *) + +Definition foo alpha beta := alpha + beta. diff --git a/test-suite/coqdoc/bug11194.html.out b/test-suite/coqdoc/bug11194.html.out index 304d041033..56bf6eaaca 100644 --- a/test-suite/coqdoc/bug11194.html.out +++ b/test-suite/coqdoc/bug11194.html.out @@ -19,11 +19,11 @@ <h1 class="libtitle">Library Coqdoc.bug11194</h1> <div class="code"> -<span class="id" title="keyword">Record</span> <a name="a_struct"><span class="id" title="record">a_struct</span></a> := { <a name="anum"><span class="id" title="projection">anum</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> }.<br/> -<span class="id" title="keyword">Canonical</span> <span class="id" title="keyword">Structure</span> <a name="a_struct_0"><span class="id" title="definition">a_struct_0</span></a> := {| <a class="idref" href="Coqdoc.bug11194.html#Build_a_struct"><span class="id" title="constructor">anum</span></a> <a class="idref" href="Coqdoc.bug11194.html#Build_a_struct"><span class="id" title="constructor">:=</span></a> <a class="idref" href="Coqdoc.bug11194.html#Build_a_struct"><span class="id" title="constructor">0</span></a>|}.<br/> -<span class="id" title="keyword">Definition</span> <a name="rename_a_s_0"><span class="id" title="definition">rename_a_s_0</span></a> := <a class="idref" href="Coqdoc.bug11194.html#a_struct_0"><span class="id" title="definition">a_struct_0</span></a>.<br/> -<span class="id" title="keyword">Coercion</span> <a name="some_nat"><span class="id" title="definition">some_nat</span></a> := (@<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#Some"><span class="id" title="constructor">Some</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>).<br/> -<span class="id" title="keyword">Definition</span> <a name="rename_some_nat"><span class="id" title="definition">rename_some_nat</span></a> := <a class="idref" href="Coqdoc.bug11194.html#some_nat"><span class="id" title="definition">some_nat</span></a>.<br/> +<span class="id" title="keyword">Record</span> <a id="a_struct" class="idref" href="#a_struct"><span class="id" title="record">a_struct</span></a> := { <a id="anum" class="idref" href="#anum"><span class="id" title="projection">anum</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> }.<br/> +<span class="id" title="keyword">Canonical</span> <span class="id" title="keyword">Structure</span> <a id="a_struct_0" class="idref" href="#a_struct_0"><span class="id" title="definition">a_struct_0</span></a> := {| <a class="idref" href="Coqdoc.bug11194.html#anum"><span class="id" title="projection">anum</span></a> := 0|}.<br/> +<span class="id" title="keyword">Definition</span> <a id="rename_a_s_0" class="idref" href="#rename_a_s_0"><span class="id" title="definition">rename_a_s_0</span></a> := <a class="idref" href="Coqdoc.bug11194.html#a_struct_0"><span class="id" title="definition">a_struct_0</span></a>.<br/> +<span class="id" title="keyword">Coercion</span> <a id="some_nat" class="idref" href="#some_nat"><span class="id" title="definition">some_nat</span></a> := (@<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#Some"><span class="id" title="constructor">Some</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>).<br/> +<span class="id" title="keyword">Definition</span> <a id="rename_some_nat" class="idref" href="#rename_some_nat"><span class="id" title="definition">rename_some_nat</span></a> := <a class="idref" href="Coqdoc.bug11194.html#some_nat"><span class="id" title="definition">some_nat</span></a>.<br/> </div> </div> diff --git a/test-suite/coqdoc/bug11194.tex.out b/test-suite/coqdoc/bug11194.tex.out index 243dc20e8f..a262b45fc8 100644 --- a/test-suite/coqdoc/bug11194.tex.out +++ b/test-suite/coqdoc/bug11194.tex.out @@ -22,7 +22,7 @@ \coqdocnoindent \coqdockw{Record} \coqdef{Coqdoc.bug11194.a struct}{a\_struct}{\coqdocrecord{a\_struct}} := \{ \coqdef{Coqdoc.bug11194.anum}{anum}{\coqdocprojection{anum}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \}.\coqdoceol \coqdocnoindent -\coqdockw{Canonical} \coqdockw{Structure} \coqdef{Coqdoc.bug11194.a struct 0}{a\_struct\_0}{\coqdocdefinition{a\_struct\_0}} := \{| \coqref{Coqdoc.bug11194.Build a struct}{\coqdocconstructor{anum}} \coqref{Coqdoc.bug11194.Build a struct}{\coqdocconstructor{:=}} \coqref{Coqdoc.bug11194.Build a struct}{\coqdocconstructor{0}}|\}.\coqdoceol +\coqdockw{Canonical} \coqdockw{Structure} \coqdef{Coqdoc.bug11194.a struct 0}{a\_struct\_0}{\coqdocdefinition{a\_struct\_0}} := \{| \coqref{Coqdoc.bug11194.anum}{\coqdocprojection{anum}} := 0|\}.\coqdoceol \coqdocnoindent \coqdockw{Definition} \coqdef{Coqdoc.bug11194.rename a s 0}{rename\_a\_s\_0}{\coqdocdefinition{rename\_a\_s\_0}} := \coqref{Coqdoc.bug11194.a struct 0}{\coqdocdefinition{a\_struct\_0}}.\coqdoceol \coqdocnoindent diff --git a/test-suite/coqdoc/bug11353.html.out b/test-suite/coqdoc/bug11353.html.out index 0b4b4b6e37..f9d6a79906 100644 --- a/test-suite/coqdoc/bug11353.html.out +++ b/test-suite/coqdoc/bug11353.html.out @@ -19,13 +19,13 @@ <h1 class="libtitle">Library Coqdoc.bug11353</h1> <div class="code"> -<span class="id" title="keyword">Definition</span> <a name="a"><span class="id" title="definition">a</span></a> := 0. #[ <span class="id" title="var">universes</span>( <span class="id" title="var">template</span>) ]<br/> -<span class="id" title="keyword">Inductive</span> <a name="mysum"><span class="id" title="inductive">mysum</span></a> (<span class="id" title="var">A</span> <span class="id" title="var">B</span>:<span class="id" title="keyword">Type</span>) : <span class="id" title="keyword">Type</span> :=<br/> - | <a name="myinl"><span class="id" title="constructor">myinl</span></a> : <a class="idref" href="Coqdoc.bug11353.html#A"><span class="id" title="variable">A</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#1c93e43e07fbeaeb6a625cb6614beb5d"><span class="id" title="notation">→</span></a> <a class="idref" href="Coqdoc.bug11353.html#mysum"><span class="id" title="inductive">mysum</span></a> <a class="idref" href="Coqdoc.bug11353.html#A"><span class="id" title="variable">A</span></a> <a class="idref" href="Coqdoc.bug11353.html#B"><span class="id" title="variable">B</span></a><br/> - | <a name="myinr"><span class="id" title="constructor">myinr</span></a> : <a class="idref" href="Coqdoc.bug11353.html#B"><span class="id" title="variable">B</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#1c93e43e07fbeaeb6a625cb6614beb5d"><span class="id" title="notation">→</span></a> <a class="idref" href="Coqdoc.bug11353.html#mysum"><span class="id" title="inductive">mysum</span></a> <a class="idref" href="Coqdoc.bug11353.html#A"><span class="id" title="variable">A</span></a> <a class="idref" href="Coqdoc.bug11353.html#B"><span class="id" title="variable">B</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a id="a" class="idref" href="#a"><span class="id" title="definition">a</span></a> := 0. #[ <span class="id" title="var">universes</span>( <span class="id" title="var">template</span>) ]<br/> +<span class="id" title="keyword">Inductive</span> <a id="mysum" class="idref" href="#mysum"><span class="id" title="inductive">mysum</span></a> (<a id="A:1" class="idref" href="#A:1"><span class="id" title="binder">A</span></a> <a id="B:2" class="idref" href="#B:2"><span class="id" title="binder">B</span></a>:<span class="id" title="keyword">Type</span>) : <span class="id" title="keyword">Type</span> :=<br/> + | <a id="myinl" class="idref" href="#myinl"><span class="id" title="constructor">myinl</span></a> : <a class="idref" href="Coqdoc.bug11353.html#A:1"><span class="id" title="variable">A</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#::type_scope:x_'->'_x"><span class="id" title="notation">→</span></a> <a class="idref" href="Coqdoc.bug11353.html#mysum:3"><span class="id" title="inductive">mysum</span></a> <a class="idref" href="Coqdoc.bug11353.html#A:1"><span class="id" title="variable">A</span></a> <a class="idref" href="Coqdoc.bug11353.html#B:2"><span class="id" title="variable">B</span></a><br/> + | <a id="myinr" class="idref" href="#myinr"><span class="id" title="constructor">myinr</span></a> : <a class="idref" href="Coqdoc.bug11353.html#B:2"><span class="id" title="variable">B</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#::type_scope:x_'->'_x"><span class="id" title="notation">→</span></a> <a class="idref" href="Coqdoc.bug11353.html#mysum:3"><span class="id" title="inductive">mysum</span></a> <a class="idref" href="Coqdoc.bug11353.html#A:1"><span class="id" title="variable">A</span></a> <a class="idref" href="Coqdoc.bug11353.html#B:2"><span class="id" title="variable">B</span></a>.<br/> <br/> -#[<span class="id" title="var">local</span>]<span class="id" title="keyword">Definition</span> <a name="b"><span class="id" title="definition">b</span></a> := 1.<br/> +#[<span class="id" title="var">local</span>]<span class="id" title="keyword">Definition</span> <a id="b" class="idref" href="#b"><span class="id" title="definition">b</span></a> := 1.<br/> </div> </div> diff --git a/test-suite/coqdoc/bug11353.tex.out b/test-suite/coqdoc/bug11353.tex.out index a6478682d8..12ea109d0e 100644 --- a/test-suite/coqdoc/bug11353.tex.out +++ b/test-suite/coqdoc/bug11353.tex.out @@ -22,11 +22,11 @@ \coqdocnoindent \coqdockw{Definition} \coqdef{Coqdoc.bug11353.a}{a}{\coqdocdefinition{a}} := 0. \#[ \coqdocvar{universes}( \coqdocvar{template}) ]\coqdoceol \coqdocnoindent -\coqdockw{Inductive} \coqdef{Coqdoc.bug11353.mysum}{mysum}{\coqdocinductive{mysum}} (\coqdocvar{A} \coqdocvar{B}:\coqdockw{Type}) : \coqdockw{Type} :=\coqdoceol +\coqdockw{Inductive} \coqdef{Coqdoc.bug11353.mysum}{mysum}{\coqdocinductive{mysum}} (\coqdef{Coqdoc.bug11353.A:1}{A}{\coqdocbinder{A}} \coqdef{Coqdoc.bug11353.B:2}{B}{\coqdocbinder{B}}:\coqdockw{Type}) : \coqdockw{Type} :=\coqdoceol \coqdocindent{1.00em} -\ensuremath{|} \coqdef{Coqdoc.bug11353.myinl}{myinl}{\coqdocconstructor{myinl}} : \coqdocvariable{A} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqref{Coqdoc.bug11353.mysum}{\coqdocinductive{mysum}} \coqdocvariable{A} \coqdocvariable{B}\coqdoceol +\ensuremath{|} \coqdef{Coqdoc.bug11353.myinl}{myinl}{\coqdocconstructor{myinl}} : \coqref{Coqdoc.bug11353.A:1}{\coqdocvariable{A}} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqref{Coqdoc.bug11353.mysum:3}{\coqdocinductive{mysum}} \coqref{Coqdoc.bug11353.A:1}{\coqdocvariable{A}} \coqref{Coqdoc.bug11353.B:2}{\coqdocvariable{B}}\coqdoceol \coqdocindent{1.00em} -\ensuremath{|} \coqdef{Coqdoc.bug11353.myinr}{myinr}{\coqdocconstructor{myinr}} : \coqdocvariable{B} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqref{Coqdoc.bug11353.mysum}{\coqdocinductive{mysum}} \coqdocvariable{A} \coqdocvariable{B}.\coqdoceol +\ensuremath{|} \coqdef{Coqdoc.bug11353.myinr}{myinr}{\coqdocconstructor{myinr}} : \coqref{Coqdoc.bug11353.B:2}{\coqdocvariable{B}} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqref{Coqdoc.bug11353.mysum:3}{\coqdocinductive{mysum}} \coqref{Coqdoc.bug11353.A:1}{\coqdocvariable{A}} \coqref{Coqdoc.bug11353.B:2}{\coqdocvariable{B}}.\coqdoceol \coqdocemptyline \coqdocnoindent \#[\coqdocvar{local}]\coqdockw{Definition} \coqdef{Coqdoc.bug11353.b}{b}{\coqdocdefinition{b}} := 1.\coqdoceol diff --git a/test-suite/coqdoc/bug5648.html.out b/test-suite/coqdoc/bug5648.html.out index 5c5a2dc299..e1d1c1313e 100644 --- a/test-suite/coqdoc/bug5648.html.out +++ b/test-suite/coqdoc/bug5648.html.out @@ -19,18 +19,18 @@ <h1 class="libtitle">Library Coqdoc.bug5648</h1> <div class="code"> -<span class="id" title="keyword">Lemma</span> <a name="a"><span class="id" title="lemma">a</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a>.<br/> +<span class="id" title="keyword">Lemma</span> <a id="a" class="idref" href="#a"><span class="id" title="lemma">a</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a>.<br/> <span class="id" title="keyword">Proof</span>.<br/> <span class="id" title="tactic">auto</span>.<br/> <span class="id" title="keyword">Qed</span>.<br/> <br/> -<span class="id" title="keyword">Variant</span> <a name="t"><span class="id" title="inductive">t</span></a> :=<br/> -| <a name="A"><span class="id" title="constructor">A</span></a> | <a name="Add"><span class="id" title="constructor">Add</span></a> | <a name="G"><span class="id" title="constructor">G</span></a> | <a name="Goal"><span class="id" title="constructor">Goal</span></a> | <a name="L"><span class="id" title="constructor">L</span></a> | <a name="Lemma"><span class="id" title="constructor">Lemma</span></a> | <a name="P"><span class="id" title="constructor">P</span></a> | <a name="Proof"><span class="id" title="constructor">Proof</span></a> .<br/> +<span class="id" title="keyword">Variant</span> <a id="t" class="idref" href="#t"><span class="id" title="inductive">t</span></a> :=<br/> +| <a id="A" class="idref" href="#A"><span class="id" title="constructor">A</span></a> | <a id="Add" class="idref" href="#Add"><span class="id" title="constructor">Add</span></a> | <a id="G" class="idref" href="#G"><span class="id" title="constructor">G</span></a> | <a id="Goal" class="idref" href="#Goal"><span class="id" title="constructor">Goal</span></a> | <a id="L" class="idref" href="#L"><span class="id" title="constructor">L</span></a> | <a id="Lemma" class="idref" href="#Lemma"><span class="id" title="constructor">Lemma</span></a> | <a id="P" class="idref" href="#P"><span class="id" title="constructor">P</span></a> | <a id="Proof" class="idref" href="#Proof"><span class="id" title="constructor">Proof</span></a> .<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> <span class="id" title="var">x</span> :=<br/> - <span class="id" title="keyword">match</span> <a class="idref" href="Coqdoc.bug5648.html#x"><span class="id" title="variable">x</span></a> <span class="id" title="keyword">with</span><br/> +<span class="id" title="keyword">Definition</span> <a id="d" class="idref" href="#d"><span class="id" title="definition">d</span></a> <a id="x:3" class="idref" href="#x:3"><span class="id" title="binder">x</span></a> :=<br/> + <span class="id" title="keyword">match</span> <a class="idref" href="Coqdoc.bug5648.html#x:3"><span class="id" title="variable">x</span></a> <span class="id" title="keyword">with</span><br/> | <a class="idref" href="Coqdoc.bug5648.html#A"><span class="id" title="constructor">A</span></a> ⇒ 0<br/> | <a class="idref" href="Coqdoc.bug5648.html#Add"><span class="id" title="constructor">Add</span></a> ⇒ 1<br/> | <a class="idref" href="Coqdoc.bug5648.html#G"><span class="id" title="constructor">G</span></a> ⇒ 2<br/> diff --git a/test-suite/coqdoc/bug5648.tex.out b/test-suite/coqdoc/bug5648.tex.out index 82f7da2309..c221d7ca8a 100644 --- a/test-suite/coqdoc/bug5648.tex.out +++ b/test-suite/coqdoc/bug5648.tex.out @@ -34,9 +34,9 @@ \ensuremath{|} \coqdef{Coqdoc.bug5648.A}{A}{\coqdocconstructor{A}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Add}{Add}{\coqdocconstructor{Add}} \ensuremath{|} \coqdef{Coqdoc.bug5648.G}{G}{\coqdocconstructor{G}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Goal}{Goal}{\coqdocconstructor{Goal}} \ensuremath{|} \coqdef{Coqdoc.bug5648.L}{L}{\coqdocconstructor{L}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Lemma}{Lemma}{\coqdocconstructor{Lemma}} \ensuremath{|} \coqdef{Coqdoc.bug5648.P}{P}{\coqdocconstructor{P}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Proof}{Proof}{\coqdocconstructor{Proof}} .\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.bug5648.d}{d}{\coqdocdefinition{d}} \coqdocvar{x} :=\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.bug5648.d}{d}{\coqdocdefinition{d}} \coqdef{Coqdoc.bug5648.x:3}{x}{\coqdocbinder{x}} :=\coqdoceol \coqdocindent{1.00em} -\coqdockw{match} \coqdocvariable{x} \coqdockw{with}\coqdoceol +\coqdockw{match} \coqref{Coqdoc.bug5648.x:3}{\coqdocvariable{x}} \coqdockw{with}\coqdoceol \coqdocindent{1.00em} \ensuremath{|} \coqref{Coqdoc.bug5648.A}{\coqdocconstructor{A}} \ensuremath{\Rightarrow} 0\coqdoceol \coqdocindent{1.00em} diff --git a/test-suite/coqdoc/bug5700.html.out b/test-suite/coqdoc/bug5700.html.out index b96fc6281d..286e8bba4d 100644 --- a/test-suite/coqdoc/bug5700.html.out +++ b/test-suite/coqdoc/bug5700.html.out @@ -26,7 +26,7 @@ </div> <div class="code"> -<span class="id" title="keyword">Definition</span> <a name="const1"><span class="id" title="definition">const1</span></a> := 1.<br/> +<span class="id" title="keyword">Definition</span> <a id="const1" class="idref" href="#const1"><span class="id" title="definition">const1</span></a> := 1.<br/> <br/> </div> @@ -36,7 +36,7 @@ </div> <div class="code"> -<span class="id" title="keyword">Definition</span> <a name="const2"><span class="id" title="definition">const2</span></a> := 2.<br/> +<span class="id" title="keyword">Definition</span> <a id="const2" class="idref" href="#const2"><span class="id" title="definition">const2</span></a> := 2.<br/> </div> </div> diff --git a/test-suite/coqdoc/links.html.out b/test-suite/coqdoc/links.html.out index d2d4d5d764..12d284dc54 100644 --- a/test-suite/coqdoc/links.html.out +++ b/test-suite/coqdoc/links.html.out @@ -51,93 +51,93 @@ Various checks for coqdoc <span class="id" title="keyword">Require</span> <span class="id" title="keyword">Import</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Strings.String.html#"><span class="id" title="library">String</span></a>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="g"><span class="id" title="definition">g</span></a> := "dfjkh""sdfhj forall <> * ~"%<span class="id" title="var">string</span>.<br/> +<span class="id" title="keyword">Definition</span> <a id="g" class="idref" href="#g"><span class="id" title="definition">g</span></a> := "dfjkh""sdfhj forall <> * ~"%<span class="id" title="var">string</span>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="a"><span class="id" title="definition">a</span></a> (<span class="id" title="var">b</span>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>) := <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a id="a" class="idref" href="#a"><span class="id" title="definition">a</span></a> (<a id="b:1" class="idref" href="#b:1"><span class="id" title="binder">b</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>) := <a class="idref" href="Coqdoc.links.html#b:1"><span class="id" title="variable">b</span></a>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">∀</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a id="f" class="idref" href="#f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">∀</span> <a id="C:2" class="idref" href="#C:2"><span class="id" title="binder">C</span></a>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C:2"><span class="id" title="variable">C</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> +<span class="id" title="keyword">Notation</span> <a id="f03f7a04ef75ff3ac66ca5c23554e52e" class="idref" href="#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). +<span class="id" title="keyword">Notation</span> <a id="f03f7a04ef75ff3ac66ca5c23554e52e" class="idref" href="#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). <br/> -<span class="id" title="keyword">Notation</span> <a name="f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a id="f07b3676d96b68749d342542fd80e2b0" class="idref" href="#f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a id="a647c51c9816a1b44fcfa5312db8344a" class="idref" href="#a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> +<span class="id" title="keyword">Notation</span> <a id="3dd9eae9daa65efe5444f5fc3529a2e7" class="idref" href="#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> <br/> -<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#1c93e43e07fbeaeb6a625cb6614beb5d"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> +<span class="id" title="keyword">Inductive</span> <a id="eq" class="idref" href="#eq"><span class="id" title="inductive">eq</span></a> (<a id="A:3" class="idref" href="#A:3"><span class="id" title="binder">A</span></a>:<span class="id" title="keyword">Type</span>) (<a id="x:4" class="idref" href="#x:4"><span class="id" title="binder">x</span></a>:<a class="idref" href="Coqdoc.links.html#A:3"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#::type_scope:x_'->'_x"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a id="eq_refl" class="idref" href="#eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x:4"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x:4"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A:3"><span class="id" title="variable">A</span></a><br/> <br/> -<span class="id" title="keyword">where</span> <a name="b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> +<span class="id" title="keyword">where</span> <a id="b8b2ebc8e1a8b9aa935c0702efb5dccf" class="idref" href="#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq:6"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a id="eq0" class="idref" href="#eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> +<span class="id" title="keyword">Notation</span> <a id="2c0c193cd2aedf7ecdb713db64dbfce6" class="idref" href="#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">))</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a id="9f5a1d89cbd4d38f5e289576db7123d1" class="idref" href="#9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">))</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/> +<span class="id" title="keyword">Notation</span> <a id="h" class="idref" href="#h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/> <br/> - <span class="id" title="keyword">Section</span> <a name="test"><span class="id" title="section">test</span></a>.<br/> + <span class="id" title="keyword">Section</span> <a id="test" class="idref" href="#test"><span class="id" title="section">test</span></a>.<br/> <br/> - <span class="id" title="keyword">Variables</span> <a name="test.b'"><span class="id" title="variable">b'</span></a> <a name="test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Variables</span> <a id="test.b'" class="idref" href="#test.b'"><span class="id" title="variable">b'</span></a> <a id="test.b2" class="idref" href="#test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Notation</span> <a name="2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> + <span class="id" title="keyword">Notation</span> <a id="2158f15740ce05a939b657be222c26d6" class="idref" href="#2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> <br/> <span class="id" title="keyword">Delimit</span> <span class="id" title="keyword">Scope</span> <span class="id" title="var">my_scope</span> <span class="id" title="keyword">with</span> <span class="id" title="var">my</span>.<br/> <br/> - <span class="id" title="keyword">Notation</span> <a name="l"><span class="id" title="abbreviation">l</span></a> := 0.<br/> + <span class="id" title="keyword">Notation</span> <a id="l" class="idref" href="#l"><span class="id" title="abbreviation">l</span></a> := 0.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> + <span class="id" title="keyword">Definition</span> <a id="ab410a966ac148e9b78c65c6cdf301fd" class="idref" href="#ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a id="a'" class="idref" href="#a'"><span class="id" title="definition">a'</span></a> <a id="b:9" class="idref" href="#b:9"><span class="id" title="binder">b</span></a> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b:9"><span class="id" title="variable">b</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a id="c" class="idref" href="#c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> + <span class="id" title="keyword">Definition</span> <a id="d" class="idref" href="#d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> <br/> - <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e03f39daf98516fa530d3f6f5a1b4d92"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Lemma</span> <a id="e" class="idref" href="#e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e03f39daf98516fa530d3f6f5a1b4d92"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <span class="id" title="var">Admitted</span>.<br/> <br/> <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test"><span class="id" title="section">test</span></a>.<br/> <br/> - <span class="id" title="keyword">Section</span> <a name="test2"><span class="id" title="section">test2</span></a>.<br/> + <span class="id" title="keyword">Section</span> <a id="test2" class="idref" href="#test2"><span class="id" title="section">test2</span></a>.<br/> <br/> - <span class="id" title="keyword">Variables</span> <a name="test2.b'"><span class="id" title="variable">b'</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Variables</span> <a id="test2.b'" class="idref" href="#test2.b'"><span class="id" title="variable">b'</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Section</span> <a name="test2.test"><span class="id" title="section">test</span></a>.<br/> + <span class="id" title="keyword">Section</span> <a id="test2.test" class="idref" href="#test2.test"><span class="id" title="section">test</span></a>.<br/> <br/> - <span class="id" title="keyword">Variables</span> <a name="test2.test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Variables</span> <a id="test2.test.b2" class="idref" href="#test2.test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> + <span class="id" title="keyword">Definition</span> <a id="a''" class="idref" href="#a''"><span class="id" title="definition">a''</span></a> <a id="b:12" class="idref" href="#b:12"><span class="id" title="binder">b</span></a> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b:12"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> <br/> <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2.test"><span class="id" title="section">test</span></a>.<br/> diff --git a/test-suite/coqdoc/links.tex.out b/test-suite/coqdoc/links.tex.out index 24f96ff1e6..2304f5ecc1 100644 --- a/test-suite/coqdoc/links.tex.out +++ b/test-suite/coqdoc/links.tex.out @@ -45,10 +45,10 @@ Various checks for coqdoc \coqdockw{Definition} \coqdef{Coqdoc.links.g}{g}{\coqdocdefinition{g}} := "dfjkh""sdfhj forall <> * \~{}"\%\coqdocvar{string}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.a}{a}{\coqdocdefinition{a}} (\coqdocvar{b}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}) := \coqdocvariable{b}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a}{a}{\coqdocdefinition{a}} (\coqdef{Coqdoc.links.b:1}{b}{\coqdocbinder{b}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}) := \coqref{Coqdoc.links.b:1}{\coqdocvariable{b}}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdocvar{C}:\coqdockw{Prop}, \coqdocvariable{C}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdef{Coqdoc.links.C:2}{C}{\coqdocbinder{C}}:\coqdockw{Prop}, \coqref{Coqdoc.links.C:2}{\coqdocvariable{C}}.\coqdoceol \coqdocemptyline \coqdocnoindent \coqdockw{Notation} \coqdef{Coqdoc.links.:::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol @@ -65,11 +65,11 @@ Various checks for coqdoc \coqdockw{Notation} \coqdef{Coqdoc.links.:::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol +\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdef{Coqdoc.links.A:3}{A}{\coqdocbinder{A}}:\coqdockw{Type}) (\coqdef{Coqdoc.links.x:4}{x}{\coqdocbinder{x}}:\coqref{Coqdoc.links.A:3}{\coqdocvariable{A}}) : \coqdocvar{A} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqref{Coqdoc.links.x:4}{\coqdocvariable{x}} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqref{Coqdoc.links.x:4}{\coqdocvariable{x}} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqref{Coqdoc.links.A:3}{\coqdocvariable{A}}\coqdoceol \coqdocnoindent \coqdoceol \coqdocnoindent -\coqdockw{where} \coqdef{Coqdoc.links.::type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol +\coqdockw{where} \coqdef{Coqdoc.links.::type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq:6}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol \coqdocemptyline \coqdocnoindent \coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol @@ -102,7 +102,7 @@ Various checks for coqdoc \coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.::my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdef{Coqdoc.links.b:9}{b}{\coqdocbinder{b}} := \coqref{Coqdoc.links.test.b'}{\coqdocvariable{b'}}\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.test.b2}{\coqdocvariable{b2}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqref{Coqdoc.links.b:9}{\coqdocvariable{b}}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol @@ -131,7 +131,7 @@ Various checks for coqdoc \coqdockw{Variables} \coqdef{Coqdoc.links.test2.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocindent{3.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdef{Coqdoc.links.b:12}{b}{\coqdocbinder{b}} := \coqref{Coqdoc.links.test2.b'}{\coqdocvariable{b'}} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.test2.test.b2}{\coqdocvariable{b2}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqref{Coqdoc.links.b:12}{\coqdocvariable{b}} \coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{End} \coqref{Coqdoc.links.test2.test}{\coqdocsection{test}}.\coqdoceol diff --git a/test-suite/micromega/bug_12210.v b/test-suite/micromega/bug_12210.v new file mode 100644 index 0000000000..ca011def09 --- /dev/null +++ b/test-suite/micromega/bug_12210.v @@ -0,0 +1,19 @@ +Require Import PeanoNat Lia. + +Goal forall x, Nat.le x x. +Proof. +intros. +lia. +Qed. + +Goal forall x, Nat.lt x x -> False. +Proof. +intros. +lia. +Qed. + +Goal forall x, Nat.eq x x. +Proof. +intros. +lia. +Qed. diff --git a/test-suite/output/BadOptionValueType.out b/test-suite/output/BadOptionValueType.out index 34d8518a75..7388982e7f 100644 --- a/test-suite/output/BadOptionValueType.out +++ b/test-suite/output/BadOptionValueType.out @@ -1,8 +1,14 @@ The command has indeed failed with message: Bad type of value for this option: expected int, got string. The command has indeed failed with message: -Bad type of value for this option: expected bool, got string. +This is an option. A value must be provided. The command has indeed failed with message: -Bad type of value for this option: expected bool, got int. +Bad type of value for this option: expected string, got int. The command has indeed failed with message: -Bad type of value for this option: expected bool, got int. +This is an option. A value must be provided. +The command has indeed failed with message: +This is a flag. It does not take a value. +The command has indeed failed with message: +This is a flag. It does not take a value. +The command has indeed failed with message: +This option does not support the "Unset" command. diff --git a/test-suite/output/BadOptionValueType.v b/test-suite/output/BadOptionValueType.v index b61c3757ba..12ca7bae21 100644 --- a/test-suite/output/BadOptionValueType.v +++ b/test-suite/output/BadOptionValueType.v @@ -1,4 +1,7 @@ Fail 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 Set Implicit Arguments 1. +Fail Unset Warnings. diff --git a/test-suite/output/Extraction_Haskell_String_12258.out b/test-suite/output/Extraction_Haskell_String_12258.out new file mode 100644 index 0000000000..615abaa3e8 --- /dev/null +++ b/test-suite/output/Extraction_Haskell_String_12258.out @@ -0,0 +1,73 @@ +{-# 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 +#else +-- HUGS +import qualified IOExts +#endif + +#ifdef __GLASGOW_HASKELL__ +unsafeCoerce :: a -> b +unsafeCoerce = GHC.Base.unsafeCoerce# +#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 ())) + + diff --git a/test-suite/output/Extraction_Haskell_String_12258.v b/test-suite/output/Extraction_Haskell_String_12258.v new file mode 100644 index 0000000000..063ff64337 --- /dev/null +++ b/test-suite/output/Extraction_Haskell_String_12258.v @@ -0,0 +1,52 @@ +Require 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. diff --git a/test-suite/output/Fixpoint.out b/test-suite/output/Fixpoint.out index 60bc9cbf55..ff7918b4e6 100644 --- a/test-suite/output/Fixpoint.out +++ b/test-suite/output/Fixpoint.out @@ -12,3 +12,27 @@ let fix f (m : nat) : nat := match m with Ltac f id1 id2 := fix id1 2 with (id2 (n:_) (H:odd n) {struct H} : n >= 1) = cofix inf : Inf := {| projS := inf |} : Inf +File "stdin", line 57, characters 0-51: +Warning: Not a truly recursive fixpoint. [non-recursive,fixpoints] +File "stdin", 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] +File "stdin", 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] +File "stdin", 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] +File "stdin", line 72, characters 0-25: +Warning: Not a truly recursive fixpoint. [non-recursive,fixpoints] +File "stdin", line 75, characters 0-48: +Warning: Not a fully mutually defined fixpoint +(a2 and a1 are not mutually dependent). +Well-foundedness check may fail unexpectedly. + [non-full-mutual,fixpoints] diff --git a/test-suite/output/Fixpoint.v b/test-suite/output/Fixpoint.v index 398528de72..26c276b68b 100644 --- a/test-suite/output/Fixpoint.v +++ b/test-suite/output/Fixpoint.v @@ -44,7 +44,39 @@ fix even_pos_odd_pos 2 with (odd_pos_even_pos n (H:odd n) {struct H} : n >= 1). lia. Qed. -CoInductive Inf := S { projS : Inf }. -Definition expand_Inf (x : Inf) := S (projS x). -CoFixpoint inf := S inf. +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. diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out index e121b5e86c..f48eaac4c9 100644 --- a/test-suite/output/Notations4.out +++ b/test-suite/output/Notations4.out @@ -14,6 +14,10 @@ Entry constr:myconstr is : nat [<< # 0 >>] : option nat +[b + c] + : nat +fun a : nat => [a + a] + : nat -> nat [1 {f 1}] : Expr fun (x : nat) (y z : Expr) => [1 + y z + {f x}] @@ -81,18 +85,18 @@ fun x : nat => [x] : nat -> nat ∀ x : nat, x = x : Prop -File "stdin", line 219, characters 0-160: +File "stdin", line 226, characters 0-160: Warning: Notation "∀ _ .. _ , _" was already defined with a different format in scope type_scope. [notation-incompatible-format,parsing] ∀x : nat,x = x : Prop -File "stdin", line 232, characters 0-60: +File "stdin", line 239, characters 0-60: Warning: Notation "_ %%% _" was already defined with a different format. [notation-incompatible-format,parsing] -File "stdin", line 236, characters 0-64: +File "stdin", line 243, characters 0-64: Warning: Notation "_ %%% _" was already defined with a different format. [notation-incompatible-format,parsing] -File "stdin", line 241, characters 0-62: +File "stdin", line 248, characters 0-62: Warning: Lonely notation "_ %%%% _" was already defined with a different format. [notation-incompatible-format,parsing] 3 %% 4 @@ -101,9 +105,9 @@ format. [notation-incompatible-format,parsing] : nat 3 %% 4 : nat -File "stdin", line 269, characters 0-61: +File "stdin", line 276, characters 0-61: Warning: The format modifier is irrelevant for only parsing rules. [irrelevant-format-only-parsing,parsing] -File "stdin", line 273, characters 0-63: +File "stdin", line 280, characters 0-63: Warning: The only parsing modifier has no effect in Reserved Notation. [irrelevant-reserved-notation-only-parsing,parsing] diff --git a/test-suite/output/Notations4.v b/test-suite/output/Notations4.v index 1cf0d919b1..4d4b37a8b2 100644 --- a/test-suite/output/Notations4.v +++ b/test-suite/output/Notations4.v @@ -22,6 +22,13 @@ Notation "<< x >>" := x (in custom myconstr at level 3, x custom anotherconstr a 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 ]. + End A. Module B. diff --git a/test-suite/output/undeclared_key.out b/test-suite/output/undeclared_key.out new file mode 100644 index 0000000000..ed768751fc --- /dev/null +++ b/test-suite/output/undeclared_key.out @@ -0,0 +1,13 @@ +The command has indeed failed with message: +There is no flag, option or table with this name: "Search Blacklists". +The command has indeed failed with message: +There is no qualid-valued table with this name: "Search Blacklist". +File "stdin", line 3, characters 0-22: +Warning: There is no flag or option with this name: "Search Blacklists". +[unknown-option,option] +The command has indeed failed with message: +There is no string-valued table with this name: "Search Blacklists". +The command has indeed failed with message: +There is no qualid-valued table with this name: "Search Blacklist". +The command has indeed failed with message: +There is no qualid-valued table with this name: "Search Blacklist". diff --git a/test-suite/output/undeclared_key.v b/test-suite/output/undeclared_key.v new file mode 100644 index 0000000000..4134bc8bfa --- /dev/null +++ b/test-suite/output/undeclared_key.v @@ -0,0 +1,6 @@ +Fail 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. diff --git a/test-suite/ssr/simpl_done.v b/test-suite/ssr/simpl_done.v new file mode 100644 index 0000000000..f5c766209a --- /dev/null +++ b/test-suite/ssr/simpl_done.v @@ -0,0 +1,28 @@ +Require 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. diff --git a/test-suite/ssr/try_case.v b/test-suite/ssr/try_case.v new file mode 100644 index 0000000000..114bf2cecf --- /dev/null +++ b/test-suite/ssr/try_case.v @@ -0,0 +1,11 @@ +From 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. diff --git a/test-suite/success/Scheme.v b/test-suite/success/Scheme.v index 4b928007cf..273cb48295 100644 --- a/test-suite/success/Scheme.v +++ b/test-suite/success/Scheme.v @@ -18,7 +18,7 @@ Check myeq_rew. Check myeq_rew_dep. Check myeq_rew_fwd_dep. Check myeq_rew_r. -Check internal_myeq_sym_involutive. +Check myeq_sym_involutive. Check myeq_rew_r_dep. Check myeq_rew_fwd_r_dep. diff --git a/test-suite/success/ltacprof.v b/test-suite/success/ltacprof.v index d5552695c4..f40f40c2bb 100644 --- a/test-suite/success/ltacprof.v +++ b/test-suite/success/ltacprof.v @@ -6,3 +6,20 @@ 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. diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index 1d5e3e54ff..57cc8c4e90 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -9,9 +9,12 @@ (************************************************************************) (** The type [bool] is defined in the prelude as - [Inductive bool : Set := true : bool | false : bool] *) +[[ +Inductive bool : Set := true : bool | false : bool +]] + *) -(** Most of the lemmas in this file are trivial after breaking all booleans *) +(** Most of the lemmas in this file are trivial by case analysis *) Ltac destr_bool := intros; destruct_all bool; simpl in *; trivial; try discriminate. @@ -75,9 +78,9 @@ Proof. destr_bool; intuition. Qed. -(**********************) +(************************) (** * Order on booleans *) -(**********************) +(************************) Definition leb (b1 b2:bool) := match b1 with @@ -91,11 +94,28 @@ Proof. destr_bool; intuition. Qed. -(* Infix "<=" := leb : bool_scope. *) +Definition ltb (b1 b2:bool) := + match b1 with + | true => False + | false => b2 = true + end. +Hint Unfold ltb: bool. + +Definition compareb (b1 b2 : bool) := + match b1, b2 with + | false, true => Lt + | true, false => Gt + | _, _ => Eq + end. + +Lemma compareb_spec : forall b1 b2, + CompareSpec (b1 = b2) (ltb b1 b2) (ltb b2 b1) (compareb b1 b2). +Proof. destr_bool; auto. Qed. + -(*************) +(***************) (** * Equality *) -(*************) +(***************) Definition eqb (b1 b2:bool) : bool := match b1, b2 with @@ -131,9 +151,9 @@ Proof. destr_bool; intuition. Qed. -(************************) +(**********************************) (** * A synonym of [if] on [bool] *) -(************************) +(**********************************) Definition ifb (b1 b2 b3:bool) : bool := match b1 with @@ -143,9 +163,9 @@ Definition ifb (b1 b2 b3:bool) : bool := Open Scope bool_scope. -(****************************) -(** * De Morgan laws *) -(****************************) +(*********************) +(** * De Morgan laws *) +(*********************) Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2. Proof. @@ -157,9 +177,9 @@ Proof. destr_bool. Qed. -(********************************) -(** * Properties of [negb] *) -(********************************) +(***************************) +(** * Properties of [negb] *) +(***************************) Lemma negb_involutive : forall b:bool, negb (negb b) = b. Proof. @@ -212,9 +232,9 @@ Proof. Qed. -(********************************) -(** * Properties of [orb] *) -(********************************) +(**************************) +(** * Properties of [orb] *) +(**************************) Lemma orb_true_iff : forall b1 b2, b1 || b2 = true <-> b1 = true \/ b2 = true. @@ -305,6 +325,11 @@ Proof. Qed. 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 *) @@ -322,9 +347,9 @@ Proof. Qed. Hint Resolve orb_comm orb_assoc: bool. -(*******************************) -(** * Properties of [andb] *) -(*******************************) +(***************************) +(** * Properties of [andb] *) +(***************************) Lemma andb_true_iff : forall b1 b2:bool, b1 && b2 = true <-> b1 = true /\ b2 = true. @@ -404,6 +429,11 @@ Proof. Qed. 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 *) @@ -422,9 +452,9 @@ Qed. Hint Resolve andb_comm andb_assoc: bool. -(*******************************************) +(*****************************************) (** * Properties mixing [andb] and [orb] *) -(*******************************************) +(*****************************************) (** Distributivity *) @@ -476,9 +506,88 @@ Notation absoption_andb := absorption_andb (only parsing). Notation absoption_orb := absorption_orb (only parsing). (* end hide *) -(*********************************) -(** * Properties of [xorb] *) -(*********************************) +(****************************) +(** * 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] *) @@ -632,9 +741,9 @@ Proof. Qed. Hint Resolve trans_eq_bool : core. -(*****************************************) +(***************************************) (** * Reflection of [bool] into [Prop] *) -(*****************************************) +(***************************************) (** [Is_true] and equality *) @@ -752,10 +861,10 @@ Proof. destr_bool. Qed. -(*****************************************) +(***********************************************) (** * Alternative versions of [andb] and [orb] - with lazy behavior (for vm_compute) *) -(*****************************************) + with lazy behavior (for vm_compute) *) +(***********************************************) Declare Scope lazy_bool_scope. @@ -776,11 +885,11 @@ Proof. reflexivity. Qed. -(*****************************************) +(************************************************) (** * Reflect: a specialized inductive type for relating propositions and booleans, - as popularized by the Ssreflect library. *) -(*****************************************) + as popularized by the Ssreflect library. *) +(************************************************) Inductive reflect (P : Prop) : bool -> Set := | ReflectT : P -> reflect P true @@ -823,3 +932,11 @@ Lemma eqb_spec (b b' : bool) : reflect (b = b') (eqb b b'). Proof. destruct b, b'; now constructor. Defined. + +(** Notations *) +Module BoolNotations. +Infix "<=" := leb : bool_scope. +Infix "<" := ltb : bool_scope. +Infix "?=" := compareb (at level 70) : bool_scope. +Infix "=?" := eqb (at level 70) : bool_scope. +End BoolNotations. diff --git a/theories/Bool/BoolOrder.v b/theories/Bool/BoolOrder.v new file mode 100644 index 0000000000..61aab607a9 --- /dev/null +++ b/theories/Bool/BoolOrder.v @@ -0,0 +1,105 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(** The order relations [le] [lt] and [compare] are defined in [Bool.v] *) + +(** Order properties of [bool] *) + +Require Export Bool. +Require Import Orders. + +Local Notation le := Bool.leb. +Local Notation lt := Bool.ltb. +Local Notation compare := Bool.compareb. +Local Notation compare_spec := Bool.compareb_spec. + +(** * Order [le] *) + +Lemma le_refl : forall b, le b b. +Proof. destr_bool. Qed. + +Lemma le_trans : forall b1 b2 b3, + le b1 b2 -> le b2 b3 -> le b1 b3. +Proof. destr_bool. Qed. + +Lemma le_true : forall b, le b true. +Proof. destr_bool. Qed. + +Lemma false_le : forall b, le false b. +Proof. intros; constructor. Qed. + +Instance le_compat : Proper (eq ==> eq ==> iff) le. +Proof. intuition. Qed. + +(** * Strict order [lt] *) + +Lemma lt_irrefl : forall b, ~ lt b b. +Proof. destr_bool; auto. Qed. + +Lemma lt_trans : forall b1 b2 b3, + lt b1 b2 -> lt b2 b3 -> lt b1 b3. +Proof. destr_bool; auto. Qed. + +Instance lt_compat : Proper (eq ==> eq ==> iff) lt. +Proof. intuition. Qed. + +Lemma lt_trichotomy : forall b1 b2, { lt b1 b2 } + { b1 = b2 } + { lt b2 b1 }. +Proof. destr_bool; auto. Qed. + +Lemma lt_total : forall b1 b2, lt b1 b2 \/ b1 = b2 \/ lt b2 b1. +Proof. destr_bool; auto. Qed. + +Lemma lt_le_incl : forall b1 b2, lt b1 b2 -> le b1 b2. +Proof. destr_bool; auto. Qed. + +Lemma le_lteq_dec : forall b1 b2, le b1 b2 -> { lt b1 b2 } + { b1 = b2 }. +Proof. destr_bool; auto. Qed. + +Lemma le_lteq : forall b1 b2, le b1 b2 <-> lt b1 b2 \/ b1 = b2. +Proof. destr_bool; intuition. Qed. + + +(** * Order structures *) + +(* Class structure *) +Instance le_preorder : PreOrder le. +Proof. +split. +- intros b; apply le_refl. +- intros b1 b2 b3; apply le_trans. +Qed. + +Instance lt_strorder : StrictOrder 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 := lt. + Definition lt_strorder := lt_strorder. + Definition lt_compat := lt_compat. + Definition le := le. + Definition le_lteq := le_lteq. + Definition lt_total := lt_total. + Definition compare := 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. diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v index f78c0ecc1e..ad0124db6d 100644 --- a/theories/FSets/FMapAVL.v +++ b/theories/FSets/FMapAVL.v @@ -123,7 +123,7 @@ Definition create l x e r := Definition assert_false := create. -Fixpoint bal l x d r := +Definition bal l x d r := let hl := height l in let hr := height r in if gt_le_dec hl (hr+2) then @@ -191,7 +191,7 @@ Fixpoint remove_min l x d r : t*(key*elt) := [|height t1 - height t2| <= 2]. *) -Fixpoint merge s1 s2 := match s1,s2 with +Definition merge s1 s2 := match s1,s2 with | Leaf, _ => s2 | _, Leaf => s1 | _, Node l2 x2 d2 r2 h2 => diff --git a/theories/Init/Byte.v b/theories/Init/Byte.v index 33eabb20d9..7449b52d76 100644 --- a/theories/Init/Byte.v +++ b/theories/Init/Byte.v @@ -10,6 +10,7 @@ (** * Bytes *) +Require Import Coq.Init.Ltac. Require Import Coq.Init.Datatypes. Require Import Coq.Init.Logic. Require Import Coq.Init.Specif. diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 50d4314a6b..9f77221d5a 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -11,6 +11,7 @@ Set Implicit Arguments. Require Import Notations. +Require Import Ltac. Require Import Logic. (********************************************************************) @@ -25,6 +26,8 @@ Inductive Empty_set : Set :=. Inductive unit : Set := tt : unit. +Register unit as core.unit.type. +Register tt as core.unit.tt. (********************************************************************) (** * The boolean datatype *) @@ -197,6 +200,10 @@ 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)] *) diff --git a/theories/Init/Decimal.v b/theories/Init/Decimal.v index 855db8bc3f..2a84456500 100644 --- a/theories/Init/Decimal.v +++ b/theories/Init/Decimal.v @@ -179,7 +179,7 @@ Definition del_head_int n d := (** [del_tail n d] removes [n] digits at end of [d] or returns [zero] if [d] has less than [n] digits. *) -Fixpoint del_tail n d := rev (del_head n (rev d)). +Definition del_tail n d := rev (del_head n (rev d)). Definition del_tail_int n d := match d with diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index ae48febc49..8f9f68a292 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -11,6 +11,7 @@ Set Implicit Arguments. Require Export Notations. +Require Import Ltac. Notation "A -> B" := (forall (_ : A), B) : type_scope. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index d07fe68715..3d9937ae89 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -13,6 +13,7 @@ Set Implicit Arguments. +Require Import Ltac. Require Import Datatypes. Require Export Logic. diff --git a/theories/Init/Ltac.v b/theories/Init/Ltac.v new file mode 100644 index 0000000000..ac5a69a38a --- /dev/null +++ b/theories/Init/Ltac.v @@ -0,0 +1,13 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Declare ML Module "ltac_plugin". + +Export Set Default Proof Mode "Classic". diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v index a5e4178b93..da540cb099 100644 --- a/theories/Init/Notations.v +++ b/theories/Init/Notations.v @@ -129,9 +129,3 @@ Bind Scope type_scope with Sortclass. Open Scope core_scope. Open Scope function_scope. Open Scope type_scope. - -(** ML Tactic Notations *) - -Declare ML Module "ltac_plugin". - -Global Set Default Proof Mode "Classic". diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index 394fa879c4..02903643d4 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -26,6 +26,7 @@ *) Require Import Notations. +Require Import Ltac. Require Import Datatypes. Require Import Logic. Require Coq.Init.Nat. diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index 71ba3e645d..6a81517d7e 100644 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -18,10 +18,11 @@ Require Coq.Init.Decimal. Require Coq.Init.Nat. Require Export Peano. Require Export Coq.Init.Wf. +Require Export Coq.Init.Ltac. Require Export Coq.Init.Tactics. Require Export Coq.Init.Tauto. (* Some initially available plugins. See also: - - ltac_plugin (in Notations) + - ltac_plugin (in Ltac) - tauto_plugin (in Tauto). *) Declare ML Module "cc_plugin". diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 59ee252d35..4ff007570e 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -14,6 +14,7 @@ Set Implicit Arguments. Set Reversible Pattern Implicit. Require Import Notations. +Require Import Ltac. Require Import Datatypes. Require Import Logic. diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index a4347bbe62..b13206db94 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -9,6 +9,7 @@ (************************************************************************) Require Import Notations. +Require Import Ltac. Require Import Logic. Require Import Specif. diff --git a/theories/Init/Tauto.v b/theories/Init/Tauto.v index 87b7a9a3be..2fc6f3cfa6 100644 --- a/theories/Init/Tauto.v +++ b/theories/Init/Tauto.v @@ -1,4 +1,17 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(** * The tauto and intuition tactics *) + Require Import Notations. +Require Import Ltac. Require Import Datatypes. Require Import Logic. diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index 06afd9bac0..a305626eb3 100644 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -16,6 +16,7 @@ Set Implicit Arguments. Require Import Notations. +Require Import Ltac. Require Import Logic. Require Import Datatypes. diff --git a/theories/Lists/List.v b/theories/Lists/List.v index f050f11170..638e8e8308 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -1141,7 +1141,7 @@ Section Map. Qed. Lemma map_eq_cons : forall l l' b, - map l = b :: l' -> exists a tl, l = a :: tl /\ b = f a /\ l' = map tl. + map l = b :: l' -> exists a tl, l = a :: tl /\ f a = b /\ map tl = l'. Proof. intros l l' b Heq. destruct l; inversion_clear Heq. @@ -1149,7 +1149,7 @@ Section Map. Qed. Lemma map_eq_app : forall l l1 l2, - map l = l1 ++ l2 -> exists l1' l2', l = l1' ++ l2' /\ l1 = map l1' /\ l2 = map l2'. + map l = l1 ++ l2 -> exists l1' l2', l = l1' ++ l2' /\ map l1' = l1 /\ map l2' = l2. Proof. induction l; simpl; intros l1 l2 Heq. - symmetry in Heq; apply app_eq_nil in Heq; destruct Heq; subst. @@ -2559,6 +2559,33 @@ Section ReDun. * 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; 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 app_length. + rewrite app_length in Hlen; simpl in Hlen; rewrite Nat.add_succ_r in Hlen. + now apply Nat.succ_le_mono. + * apply incl_Add_inv with (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 app_length. + simpl in Hlen; rewrite Nat.add_succ_r in Hlen. + now transitivity (S (length l)). + Qed. + End ReDun. (** NoDup and map *) diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index ea53618acb..04685cc3eb 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -126,7 +126,7 @@ Infix "?=" := compare (at level 70, no associativity) : N_scope. (** Boolean equality and comparison *) -Fixpoint eqb n m := +Definition eqb n m := match n, m with | 0, 0 => true | pos p, pos q => Pos.eqb p q @@ -313,7 +313,7 @@ Definition land n m := (** Logical [diff] *) -Fixpoint ldiff n m := +Definition ldiff n m := match n, m with | 0, _ => 0 | _, 0 => n diff --git a/theories/Numbers/Cyclic/Int63/Int63.v b/theories/Numbers/Cyclic/Int63/Int63.v index bccc245ded..2c112c3469 100644 --- a/theories/Numbers/Cyclic/Int63/Int63.v +++ b/theories/Numbers/Cyclic/Int63/Int63.v @@ -978,7 +978,7 @@ Proof. case (leb_spec digits j); rewrite H; auto with zarith. intros _ HH; generalize (HH H1); discriminate. clear H. - generalize (ltb_spec j i); case ltb; intros H2; unfold bit; simpl. + generalize (ltb_spec j i); case Int63.ltb; intros H2; unfold bit; simpl. 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. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index bd5225d9ef..74cdd1797c 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -22,6 +22,10 @@ Declare Scope Q_scope. Delimit Scope Q_scope with Q. Bind Scope Q_scope with Q. Arguments Qmake _%Z _%positive. + +Register Q as rat.Q.type. +Register Qmake as rat.Q.Qmake. + Open Scope Q_scope. Ltac simpl_mult := rewrite ?Pos2Z.inj_mul. @@ -101,6 +105,10 @@ Notation "x > 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. +Register Qeq as rat.Q.Qeq. +Register Qle as rat.Q.Qle. +Register Qlt as rat.Q.Qlt. + (** injection from Z is injective. *) Lemma inject_Z_injective (a b: Z): inject_Z a == inject_Z b <-> a = b. @@ -278,6 +286,11 @@ 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. + (** A light notation for [Zpos] *) Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z (Zpos b). @@ -1053,6 +1066,8 @@ Definition Qpower (q:Q) (z:Z) := Notation " q ^ z " := (Qpower q z) : Q_scope. +Register Qpower as rat.Q.Qpower. + Instance Qpower_comp : Proper (Qeq==>eq==>Qeq) Qpower. Proof. intros x x' Hx y y' Hy. rewrite <- Hy; clear y' Hy. diff --git a/theories/Reals/Cauchy/ConstructiveCauchyAbs.v b/theories/Reals/Cauchy/ConstructiveCauchyAbs.v index 7e51b575ba..f8c6429982 100644 --- a/theories/Reals/Cauchy/ConstructiveCauchyAbs.v +++ b/theories/Reals/Cauchy/ConstructiveCauchyAbs.v @@ -31,9 +31,9 @@ Local Open Scope CReal_scope. uniquely extends to a uniformly continuous function CReal_abs : CReal -> CReal *) -Lemma CauchyAbsStable : forall xn : nat -> Q, - QCauchySeq xn Pos.to_nat - -> QCauchySeq (fun n => Qabs (xn n)) Pos.to_nat. +Lemma CauchyAbsStable : forall xn : positive -> Q, + QCauchySeq xn + -> QCauchySeq (fun n => Qabs (xn n)). Proof. intros xn cau n p q H H0. specialize (cau n p q H H0). @@ -53,23 +53,22 @@ Definition CReal_abs (x : CReal) : CReal exist _ (fun n => Qabs (xn n)) (CauchyAbsStable xn cau). Lemma CReal_neg_nth : forall (x : CReal) (n : positive), - (proj1_sig x (Pos.to_nat n) < -1#n)%Q + (proj1_sig x n < -1#n)%Q -> x < 0. Proof. intros. destruct x as [xn cau]; unfold proj1_sig in H. apply Qlt_minus_iff in H. - setoid_replace ((-1 # n) + - xn (Pos.to_nat n))%Q - with (- ((1 # n) + xn (Pos.to_nat n)))%Q in H. - destruct (Qarchimedean (2 / (-((1#n) + xn (Pos.to_nat n))))) as [k kmaj]. + setoid_replace ((-1 # n) + - xn n)%Q + with (- ((1 # n) + xn n))%Q in H. + destruct (Qarchimedean (2 / (-((1#n) + xn n)))) as [k kmaj]. exists (Pos.max k n). simpl. unfold Qminus; rewrite Qplus_0_l. - specialize (cau n (Pos.to_nat n) (max (Pos.to_nat k) (Pos.to_nat n)) - (le_refl _) (Nat.le_max_r _ _)). + specialize (cau n n (Pos.max k n) + (Pos.le_refl _) (Pos.le_max_r _ _)). apply (Qle_lt_trans _ (2#k)). unfold Qle, Qnum, Qden. apply Z.mul_le_mono_nonneg_l. discriminate. apply Pos2Z.pos_le_pos, Pos.le_max_l. - rewrite <- Pos2Nat.inj_max in cau. - apply (Qmult_lt_l _ _ (-((1 # n) + xn (Pos.to_nat n)))) in kmaj. + apply (Qmult_lt_l _ _ (-((1 # n) + xn n))) in kmaj. rewrite Qmult_div_r in kmaj. apply (Qmult_lt_r _ _ (1 # k)) in kmaj. rewrite <- Qmult_assoc in kmaj. @@ -77,13 +76,13 @@ Proof. rewrite Qmult_1_r in kmaj. setoid_replace (2#k)%Q with (2 * (1 # k))%Q. 2: reflexivity. apply (Qlt_trans _ _ _ kmaj). clear kmaj. - apply (Qplus_lt_l _ _ ((1#n) + xn (Pos.to_nat (Pos.max k n)))). + apply (Qplus_lt_l _ _ ((1#n) + xn (Pos.max k n))). ring_simplify. rewrite Qplus_comm. - apply (Qle_lt_trans _ (Qabs (xn (Pos.to_nat n) - xn (Pos.to_nat (Pos.max k n))))). + apply (Qle_lt_trans _ (Qabs (xn n - xn (Pos.max k n)))). 2: exact cau. rewrite <- Qabs_opp. - setoid_replace (- (xn (Pos.to_nat n) - xn (Pos.to_nat (Pos.max k n))))%Q - with (xn (Pos.to_nat (Pos.max k n)) + -1 * xn (Pos.to_nat n))%Q. + setoid_replace (- (xn n - xn (Pos.max k n)))%Q + with (xn (Pos.max k n) + -1 * xn n)%Q. apply Qle_Qabs. ring. 2: reflexivity. unfold Qmult, Qeq, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r, Z.mul_1_l. reflexivity. @@ -92,10 +91,10 @@ Proof. Qed. Lemma CReal_nonneg : forall (x : CReal) (n : positive), - 0 <= x -> (-1#n <= proj1_sig x (Pos.to_nat n))%Q. + 0 <= x -> (-1#n <= proj1_sig x n)%Q. Proof. intros. destruct x as [xn cau]; unfold proj1_sig. - destruct (Qlt_le_dec (xn (Pos.to_nat n)) (-1#n)). + destruct (Qlt_le_dec (xn n) (-1#n)). 2: exact q. exfalso. apply H. clear H. apply (CReal_neg_nth _ n). exact q. Qed. @@ -107,13 +106,13 @@ Proof. apply (CReal_nonneg _ n) in H. simpl in H. rewrite Qabs_pos. 2: unfold Qminus; rewrite <- Qle_minus_iff; apply Qle_Qabs. - destruct (Qlt_le_dec (xn (Pos.to_nat n)) 0). + destruct (Qlt_le_dec (xn n) 0). - rewrite Qabs_neg. 2: apply Qlt_le_weak, q. apply Qopp_le_compat in H. apply (Qmult_le_l _ _ (1#2)). reflexivity. ring_simplify. setoid_replace ((1 # 2) * (2 # n))%Q with (-(-1#n))%Q. 2: reflexivity. - setoid_replace ((-2 # 2) * xn (Pos.to_nat n))%Q with (- xn (Pos.to_nat n))%Q. + setoid_replace ((-2 # 2) * xn n)%Q with (- xn n)%Q. exact H. ring. - rewrite Qabs_pos. unfold Qminus. rewrite Qplus_opp_r. discriminate. exact q. Qed. @@ -121,7 +120,7 @@ Qed. Lemma CReal_le_abs : forall x : CReal, x <= CReal_abs x. Proof. intros. intros [n nmaj]. destruct x as [xn cau]; simpl in nmaj. - apply (Qle_not_lt _ _ (Qle_Qabs (xn (Pos.to_nat n)))). + apply (Qle_not_lt _ _ (Qle_Qabs (xn n))). apply Qlt_minus_iff. apply (Qlt_trans _ (2#n)). reflexivity. exact nmaj. Qed. @@ -129,7 +128,7 @@ Qed. Lemma CReal_abs_pos : forall x : CReal, 0 <= CReal_abs x. Proof. intros. intros [n nmaj]. destruct x as [xn cau]; simpl in nmaj. - apply (Qle_not_lt _ _ (Qabs_nonneg (xn (Pos.to_nat n)))). + apply (Qle_not_lt _ _ (Qabs_nonneg (xn n))). apply Qlt_minus_iff. apply (Qlt_trans _ (2#n)). reflexivity. exact nmaj. Qed. @@ -153,7 +152,7 @@ Lemma CReal_abs_appart_0 : forall x : CReal, 0 < CReal_abs x -> x # 0. Proof. intros x [n nmaj]. destruct x as [xn cau]; simpl in nmaj. - destruct (Qlt_le_dec (xn (Pos.to_nat n)) 0). + destruct (Qlt_le_dec (xn n) 0). - left. exists n. simpl. rewrite Qabs_neg in nmaj. apply (Qlt_le_trans _ _ _ nmaj). ring_simplify. apply Qle_refl. apply Qlt_le_weak, q. @@ -189,7 +188,7 @@ Qed. Lemma CReal_abs_le : forall a b:CReal, -b <= a <= b -> CReal_abs a <= b. Proof. intros a b H [n nmaj]. destruct a as [an cau]; simpl in nmaj. - destruct (Qlt_le_dec (an (Pos.to_nat n)) 0). + destruct (Qlt_le_dec (an n) 0). - rewrite Qabs_neg in nmaj. destruct H. apply H. clear H H0. exists n. simpl. destruct b as [bn caub]; simpl; simpl in nmaj. @@ -250,14 +249,14 @@ Lemma CReal_abs_gt : forall x : CReal, x < CReal_abs x -> x < 0. Proof. intros x [n nmaj]. destruct x as [xn cau]; simpl in nmaj. - assert (xn (Pos.to_nat n) < 0)%Q. - { destruct (Qlt_le_dec (xn (Pos.to_nat n)) 0). exact q. + assert (xn n < 0)%Q. + { destruct (Qlt_le_dec (xn n) 0). exact q. exfalso. rewrite Qabs_pos in nmaj. unfold Qminus in nmaj. rewrite Qplus_opp_r in nmaj. inversion nmaj. exact q. } rewrite Qabs_neg in nmaj. 2: apply Qlt_le_weak, H. apply (CReal_neg_nth _ n). simpl. ring_simplify in nmaj. - apply (Qplus_lt_l _ _ ((1#n) - xn (Pos.to_nat n))). + apply (Qplus_lt_l _ _ ((1#n) - xn n)). apply (Qmult_lt_l _ _ 2). reflexivity. ring_simplify. setoid_replace (2 * (1 # n))%Q with (2 # n)%Q. 2: reflexivity. rewrite <- Qplus_assoc. @@ -274,7 +273,7 @@ Proof. destruct H as [i imaj]. destruct H0 as [j jmaj]. exists (Pos.max i j). destruct x as [xn caux], y as [yn cauy]; simpl. simpl in imaj, jmaj. - destruct (Qlt_le_dec (xn (Pos.to_nat (Pos.max i j))) 0). + destruct (Qlt_le_dec (xn (Pos.max i j)) 0). - rewrite Qabs_neg. specialize (jmaj (Pos.max i j) (Pos.le_max_r _ _)). apply (Qle_lt_trans _ (2#j)). 2: exact jmaj. diff --git a/theories/Reals/Cauchy/ConstructiveCauchyReals.v b/theories/Reals/Cauchy/ConstructiveCauchyReals.v index 167f8d41c9..70574f6135 100644 --- a/theories/Reals/Cauchy/ConstructiveCauchyReals.v +++ b/theories/Reals/Cauchy/ConstructiveCauchyReals.v @@ -33,167 +33,23 @@ Require CMorphisms. The double quantification on p q is needed to avoid forall un, QSeqEquiv un (fun _ => un O) (fun q => O) which says nothing about the limit of un. - *) -Definition QSeqEquiv (un vn : nat -> Q) (cvmod : positive -> nat) - : Prop - := forall (k : positive) (p q : nat), - le (cvmod k) p - -> le (cvmod k) q - -> Qlt (Qabs (un p - vn q)) (1 # k). - -(* A Cauchy sequence is a sequence equivalent to itself. - If sequences are equivalent, they are both Cauchy and have the same limit. *) -Definition QCauchySeq (un : nat -> Q) (cvmod : positive -> nat) : Prop - := QSeqEquiv un un cvmod. -Lemma QSeqEquiv_sym : forall (un vn : nat -> Q) (cvmod : positive -> nat), - QSeqEquiv un vn cvmod - -> QSeqEquiv vn un cvmod. -Proof. - intros. intros k p q H0 H1. - rewrite Qabs_Qminus. apply H; assumption. -Qed. + We define sequences as positive -> Q instead of nat -> Q, + so that we can compute arguments like 2^n fast. -Lemma factorDenom : forall (a:Z) (b d:positive), (a # (d * b)) == (1#d) * (a#b). -Proof. - intros. unfold Qeq. simpl. destruct a; reflexivity. -Qed. - -Lemma QSeqEquiv_trans : forall (un vn wn : nat -> Q) - (cvmod cvmodw : positive -> nat), - QSeqEquiv un vn cvmod - -> QSeqEquiv vn wn cvmodw - -> QSeqEquiv un wn (fun q => max (cvmod (2 * q)%positive) (cvmodw (2 * q)%positive)). -Proof. - intros. intros k p q H1 H2. - setoid_replace (un p - wn q) with (un p - vn p + (vn p - wn q)). - apply (Qle_lt_trans - _ (Qabs (un p - vn p) + Qabs (vn p - wn q))). - apply Qabs_triangle. apply (Qlt_le_trans _ ((1 # (2*k)) + (1 # (2*k)))). - apply Qplus_lt_le_compat. - - assert ((cvmod (2 * k)%positive <= p)%nat). - { apply (le_trans _ (max (cvmod (2 * k)%positive) (cvmodw (2 * k)%positive))). - apply Nat.le_max_l. assumption. } - apply H. assumption. assumption. - - apply Qle_lteq. left. apply H0. - apply (le_trans _ (max (cvmod (2 * k)%positive) (cvmodw (2 * k)%positive))). - apply Nat.le_max_r. assumption. - apply (le_trans _ (max (cvmod (2 * k)%positive) (cvmodw (2 * k)%positive))). - apply Nat.le_max_r. assumption. - - rewrite (factorDenom _ _ 2). ring_simplify. apply Qle_refl. - - ring. -Qed. - -Definition QSeqEquivEx (un vn : nat -> Q) : Prop - := exists (cvmod : positive -> nat), QSeqEquiv un vn cvmod. - -Lemma QSeqEquivEx_sym : forall (un vn : nat -> Q), QSeqEquivEx un vn -> QSeqEquivEx vn un. -Proof. - intros. destruct H. exists x. apply QSeqEquiv_sym. apply H. -Qed. - -Lemma QSeqEquivEx_trans : forall un vn wn : nat -> Q, - QSeqEquivEx un vn - -> QSeqEquivEx vn wn - -> QSeqEquivEx un wn. -Proof. - intros. destruct H,H0. - exists (fun q => max (x (2 * q)%positive) (x0 (2 * q)%positive)). - apply (QSeqEquiv_trans un vn wn); assumption. -Qed. - -Lemma QSeqEquiv_cau_r : forall (un vn : nat -> Q) (cvmod : positive -> nat), - QSeqEquiv un vn cvmod - -> QCauchySeq vn (fun k => cvmod (2 * k)%positive). -Proof. - intros. intros k p q H0 H1. - setoid_replace (vn p - vn q) - with (vn p - - un (cvmod (2 * k)%positive) - + (un (cvmod (2 * k)%positive) - vn q)). - - apply (Qle_lt_trans - _ (Qabs (vn p - - un (cvmod (2 * k)%positive)) - + Qabs (un (cvmod (2 * k)%positive) - vn q))). - apply Qabs_triangle. - apply (Qlt_le_trans _ ((1 # (2 * k)) + (1 # (2 * k)))). - apply Qplus_lt_le_compat. - + rewrite Qabs_Qminus. apply H. apply le_refl. assumption. - + apply Qle_lteq. left. apply H. apply le_refl. assumption. - + rewrite (factorDenom _ _ 2). ring_simplify. apply Qle_refl. - - ring. -Qed. - -Fixpoint increasing_modulus (modulus : positive -> nat) (n : nat) - := match n with - | O => modulus xH - | S p => max (modulus (Pos.of_nat n)) (increasing_modulus modulus p) - end. - -Lemma increasing_modulus_inc : forall (modulus : positive -> nat) (n p : nat), - le (increasing_modulus modulus n) - (increasing_modulus modulus (p + n)). -Proof. - induction p. - - apply le_refl. - - apply (le_trans _ (increasing_modulus modulus (p + n))). - apply IHp. simpl. destruct (plus p n). apply Nat.le_max_r. apply Nat.le_max_r. -Qed. - -Lemma increasing_modulus_max : forall (modulus : positive -> nat) (p n : nat), - le n p -> le (modulus (Pos.of_nat n)) - (increasing_modulus modulus p). -Proof. - induction p. - - intros. inversion H. subst n. apply le_refl. - - intros. simpl. destruct p. simpl. - + destruct n. apply Nat.le_max_l. apply le_S_n in H. - inversion H. apply Nat.le_max_l. - + apply Nat.le_succ_r in H. destruct H. - apply (le_trans _ (increasing_modulus modulus (S p))). - 2: apply Nat.le_max_r. apply IHp. apply H. - subst n. apply (le_trans _ (modulus (Pos.succ (Pos.of_nat (S p))))). - apply le_refl. apply Nat.le_max_l. -Qed. - -(* Choice of a standard element in each QSeqEquiv class. *) -Lemma standard_modulus : forall (un : nat -> Q) (cvmod : positive -> nat), - QCauchySeq un cvmod - -> (QCauchySeq (fun n => un (increasing_modulus cvmod n)) Pos.to_nat - /\ QSeqEquiv un (fun n => un (increasing_modulus cvmod n)) - (fun p => max (cvmod p) (Pos.to_nat p))). -Proof. - intros. split. - - intros k p q H0 H1. apply H. - + apply (le_trans _ (increasing_modulus cvmod (Pos.to_nat k))). - apply (le_trans _ (cvmod (Pos.of_nat (Pos.to_nat k)))). - rewrite Pos2Nat.id. apply le_refl. - destruct (Pos.to_nat k). apply le_refl. apply Nat.le_max_l. - destruct (Nat.le_exists_sub (Pos.to_nat k) p H0) as [i [H2 H3]]. subst p. - apply increasing_modulus_inc. - + apply (le_trans _ (increasing_modulus cvmod (Pos.to_nat k))). - apply (le_trans _ (cvmod (Pos.of_nat (Pos.to_nat k)))). - rewrite Pos2Nat.id. apply le_refl. - destruct (Pos.to_nat k). apply le_refl. apply Nat.le_max_l. - destruct (Nat.le_exists_sub (Pos.to_nat k) q H1) as [i [H2 H3]]. subst q. - apply increasing_modulus_inc. - - intros k p q H0 H1. apply H. - + apply (le_trans _ (Init.Nat.max (cvmod k) (Pos.to_nat k))). - apply Nat.le_max_l. assumption. - + apply (le_trans _ (increasing_modulus cvmod (Pos.to_nat k))). - apply (le_trans _ (cvmod (Pos.of_nat (Pos.to_nat k)))). - rewrite Pos2Nat.id. apply le_refl. - destruct (Pos.to_nat k). apply le_refl. apply Nat.le_max_l. - assert (le (Pos.to_nat k) q). - { apply (le_trans _ (Init.Nat.max (cvmod k) (Pos.to_nat k))). - apply Nat.le_max_r. assumption. } - destruct (Nat.le_exists_sub (Pos.to_nat k) q H2) as [i [H3 H4]]. subst q. - apply increasing_modulus_inc. -Qed. + WARNING: this module is not meant to be imported directly, + please import `Reals.Abstract.ConstructiveReals` instead. + *) +Definition QCauchySeq (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). (* A Cauchy real is a Cauchy sequence with the standard modulus *) Definition CReal : Set - := { x : (nat -> Q) | QCauchySeq x Pos.to_nat }. + := { x : (positive -> Q) | QCauchySeq x }. Declare Scope CReal_scope. @@ -208,12 +64,10 @@ Local Open Scope CReal_scope. (* So QSeqEquiv is the equivalence relation of this constructive pre-order *) Definition CRealLt (x y : CReal) : Set - := { n : positive | Qlt (2 # n) - (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n)) }. + := { n : positive | Qlt (2 # n) (proj1_sig y n - proj1_sig x n) }. Definition CRealLtProp (x y : CReal) : Prop - := exists n : positive, Qlt (2 # n) - (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n)). + := exists n : positive, Qlt (2 # n) (proj1_sig y n - proj1_sig x n). Definition CRealGt (x y : CReal) := CRealLt y x. Definition CReal_appart (x y : CReal) := sum (CRealLt x y) (CRealLt y x). @@ -226,23 +80,23 @@ Infix "#" := CReal_appart : CReal_scope. Lemma CRealLtEpsilon : forall x y : CReal, CRealLtProp x y -> x < y. Proof. - intros. - assert (exists n : nat, n <> O - /\ Qlt (2 # Pos.of_nat n) (proj1_sig y n - proj1_sig x n)). - { destruct H as [n maj]. exists (Pos.to_nat n). split. - intro abs. destruct (Pos2Nat.is_succ n). rewrite H in abs. - inversion abs. rewrite Pos2Nat.id. apply maj. } + intros. unfold CRealLtProp in H. + (* Convert to nat to use indefinite description. *) + assert (exists n : nat, lt O n /\ Qlt (2 # Pos.of_nat n) + (proj1_sig y (Pos.of_nat n) - proj1_sig x (Pos.of_nat n))). + { destruct H as [n maj]. exists (Pos.to_nat n). split. apply Pos2Nat.is_pos. + rewrite Pos2Nat.id. exact maj. } + clear H. apply constructive_indefinite_ground_description_nat in H0. - destruct H0 as [n maj]. exists (Pos.of_nat n). - rewrite Nat2Pos.id. apply maj. apply maj. + destruct H0 as [n maj]. exists (Pos.of_nat n). exact (proj2 maj). intro n. destruct n. right. - intros [abs _]. exact (abs (eq_refl O)). + intros [abs _]. inversion abs. destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) - (proj1_sig y (S n) - proj1_sig x (S n))). - left. split. discriminate. apply q. + (proj1_sig y (Pos.of_nat (S n)) - proj1_sig x (Pos.of_nat (S n)))). + left. split. apply le_n_S, le_0_n. apply q. right. intros [_ abs]. apply (Qlt_not_le (2 # Pos.of_nat (S n)) - (proj1_sig y (S n) - proj1_sig x (S n))); assumption. + (proj1_sig y (Pos.of_nat (S n)) - proj1_sig x (Pos.of_nat (S n)))); assumption. Qed. Lemma CRealLtForget : forall x y : CReal, @@ -254,18 +108,18 @@ 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, {P n} + {~P n}) + (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 => Qle (proj1_sig y (S n) - proj1_sig x (S n)) + destruct (lpo (fun n:nat => Qle (proj1_sig y (Pos.of_nat (S n)) - proj1_sig x (Pos.of_nat (S n))) (2 # Pos.of_nat (S n)))). - intro n. destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) - (proj1_sig y (S n) - proj1_sig x (S n))). + (proj1_sig y (Pos.of_nat (S n)) - proj1_sig x (Pos.of_nat (S n)))). right. apply Qlt_not_le. exact q. left. exact q. - left. destruct s as [n nmaj]. exists (Pos.of_nat (S n)). - rewrite Nat2Pos.id. apply Qnot_le_lt. exact nmaj. discriminate. + apply Qnot_le_lt. exact nmaj. - right. intro abs. destruct abs as [n majn]. specialize (q (pred (Pos.to_nat n))). replace (S (pred (Pos.to_nat n))) with (Pos.to_nat n) in q. @@ -296,154 +150,73 @@ Definition CRealEq (x y : CReal) : Prop Infix "==" := CRealEq : CReal_scope. Lemma CRealLe_not_lt : forall x y : CReal, - (forall n:positive, Qle (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n)) - (2 # n)) + (forall n:positive, Qle (proj1_sig x n - proj1_sig y n) (2 # n)) <-> x <= y. Proof. intros. split. - intros. intro H0. destruct H0 as [n H0]. specialize (H n). apply (Qle_not_lt (2 # n) (2 # n)). apply Qle_refl. - apply (Qlt_le_trans _ (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n))). + apply (Qlt_le_trans _ (proj1_sig x n - proj1_sig y n)). assumption. assumption. - intros. - destruct (Qlt_le_dec (2 # n) (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n))). + destruct (Qlt_le_dec (2 # n) (proj1_sig x n - proj1_sig y n)). exfalso. apply H. exists n. assumption. assumption. Qed. Lemma CRealEq_diff : forall (x y : CReal), CRealEq x y - <-> forall n:positive, Qle (Qabs (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n))) - (2 # n). + <-> forall n:positive, Qle (Qabs (proj1_sig x n - proj1_sig y n)) (2 # n). Proof. intros. split. - intros. destruct H. apply Qabs_case. intro. pose proof (CRealLe_not_lt x y) as [_ H2]. apply H2. assumption. intro. pose proof (CRealLe_not_lt y x) as [_ H2]. - setoid_replace (- (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n))) - with (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n)). + setoid_replace (- (proj1_sig x n - proj1_sig y n)) + with (proj1_sig y n - proj1_sig x n). apply H2. assumption. ring. - intros. split. + apply CRealLe_not_lt. intro n. specialize (H n). rewrite Qabs_Qminus in H. - apply (Qle_trans _ (Qabs (proj1_sig y (Pos.to_nat n) - - proj1_sig x (Pos.to_nat n)))). + apply (Qle_trans _ (Qabs (proj1_sig y n - proj1_sig x n))). apply Qle_Qabs. apply H. + apply CRealLe_not_lt. intro n. specialize (H n). - apply (Qle_trans _ (Qabs (proj1_sig x (Pos.to_nat n) - - proj1_sig y (Pos.to_nat n)))). + apply (Qle_trans _ (Qabs (proj1_sig x n - proj1_sig y n))). apply Qle_Qabs. apply H. Qed. -(* The equality on Cauchy reals is just QSeqEquiv, - which is independant of the convergence modulus. *) -Lemma CRealEq_modindep : forall (x y : CReal), - QSeqEquivEx (proj1_sig x) (proj1_sig y) - <-> forall n:positive, - Qle (Qabs (proj1_sig x (Pos.to_nat n) - proj1_sig y (Pos.to_nat n))) (2 # n). -Proof. - assert (forall x y: CReal, QSeqEquivEx (proj1_sig x) (proj1_sig y) -> x <= y ). - { intros [xn limx] [yn limy] [cvmod H] [n abs]. simpl in abs, H. - pose (xn (Pos.to_nat n) - yn (Pos.to_nat n) - (2#n)) as eps. - destruct (Qarchimedean (/eps)) as [k maj]. - remember (max (cvmod k) (Pos.to_nat n)) as p. - assert (le (cvmod k) p). - { rewrite Heqp. apply Nat.le_max_l. } - assert (Pos.to_nat n <= p)%nat. - { rewrite Heqp. apply Nat.le_max_r. } - specialize (H k p p H0 H0). - setoid_replace (Z.pos k #1)%Q with (/ (1#k)) in maj. 2: reflexivity. - apply Qinv_lt_contravar in maj. 2: reflexivity. unfold eps in maj. - clear abs. (* less precise majoration *) - apply (Qplus_lt_r _ _ (2#n)) in maj. ring_simplify in maj. - apply (Qlt_not_le _ _ maj). clear maj. - setoid_replace (xn (Pos.to_nat n) + -1 * yn (Pos.to_nat n)) - with (xn (Pos.to_nat n) - xn p + (xn p - yn p + (yn p - yn (Pos.to_nat n)))). - 2: ring. - setoid_replace (2 # n)%Q with ((1 # n) + (1#n)). - rewrite <- Qplus_assoc. - apply Qplus_le_compat. apply (Qle_trans _ _ _ (Qle_Qabs _)). - apply Qlt_le_weak. apply limx. apply le_refl. assumption. - rewrite (Qplus_comm (1#n)). - apply Qplus_le_compat. apply (Qle_trans _ _ _ (Qle_Qabs _)). - apply Qlt_le_weak. exact H. - apply (Qle_trans _ _ _ (Qle_Qabs _)). apply Qlt_le_weak. apply limy. - assumption. apply le_refl. ring_simplify. reflexivity. - unfold eps. unfold Qminus. rewrite <- Qlt_minus_iff. exact abs. } - split. - - rewrite <- CRealEq_diff. intros. split. - apply H, QSeqEquivEx_sym. exact H0. apply H. exact H0. - - clear H. intros. destruct x as [xn limx], y as [yn limy]. - exists (fun q => Pos.to_nat (2 * (3 * q))). intros k p q H0 H1. - unfold proj1_sig. specialize (H (2 * (3 * k))%positive). - assert ((Pos.to_nat (3 * k) <= Pos.to_nat (2 * (3 * k)))%nat). - { generalize (3 * k)%positive. intros. rewrite Pos2Nat.inj_mul. - rewrite <- (mult_1_l (Pos.to_nat p0)). apply Nat.mul_le_mono_nonneg. - auto. unfold Pos.to_nat. simpl. auto. - apply (le_trans 0 1). auto. apply Pos2Nat.is_pos. rewrite mult_1_l. - apply le_refl. } - setoid_replace (xn p - yn q) - with (xn p - xn (Pos.to_nat (2 * (3 * k))) - + (xn (Pos.to_nat (2 * (3 * k))) - yn (Pos.to_nat (2 * (3 * k))) - + (yn (Pos.to_nat (2 * (3 * k))) - yn q))). - setoid_replace (1 # k)%Q with ((1 # 3 * k) + ((1 # 3 * k) + (1 # 3 * k))). - apply (Qle_lt_trans - _ (Qabs (xn p - xn (Pos.to_nat (2 * (3 * k)))) - + (Qabs (xn (Pos.to_nat (2 * (3 * k))) - yn (Pos.to_nat (2 * (3 * k))) - + (yn (Pos.to_nat (2 * (3 * k))) - yn q))))). - apply Qabs_triangle. apply Qplus_lt_le_compat. - apply limx. apply (le_trans _ (Pos.to_nat (2 * (3 * k)))). assumption. assumption. - assumption. - apply (Qle_trans - _ (Qabs (xn (Pos.to_nat (2 * (3 * k))) - yn (Pos.to_nat (2 * (3 * k)))) - + Qabs (yn (Pos.to_nat (2 * (3 * k))) - yn q))). - apply Qabs_triangle. apply Qplus_le_compat. - setoid_replace (1 # 3 * k)%Q with (2 # 2 * (3 * k))%Q. apply H. - rewrite (factorDenom _ _ 3). rewrite (factorDenom _ _ 2). rewrite (factorDenom _ _ 3). - rewrite Qmult_assoc. rewrite (Qmult_comm (1#2)). - rewrite <- Qmult_assoc. apply Qmult_comp. reflexivity. - unfold Qeq. reflexivity. - apply Qle_lteq. left. apply limy. assumption. - apply (le_trans _ (Pos.to_nat (2 * (3 * k)))). assumption. assumption. - rewrite (factorDenom _ _ 3). ring_simplify. reflexivity. field. -Qed. - (* Extend separation to all indices above *) Lemma CRealLt_aboveSig : forall (x y : CReal) (n : positive), (Qlt (2 # n) - (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n))) - -> let (k, _) := Qarchimedean (/(proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n) - (2#n))) + (proj1_sig y n - proj1_sig x n)) + -> let (k, _) := Qarchimedean (/(proj1_sig y n - proj1_sig x n - (2#n))) in forall p:positive, Pos.le (Pos.max n (2*k)) p -> Qlt (2 # (Pos.max n (2*k))) - (proj1_sig y (Pos.to_nat p) - proj1_sig x (Pos.to_nat p)). + (proj1_sig y p - proj1_sig x p). Proof. intros [xn limx] [yn limy] n maj. unfold proj1_sig; unfold proj1_sig in maj. - pose (yn (Pos.to_nat n) - xn (Pos.to_nat n)) as dn. - destruct (Qarchimedean (/(yn (Pos.to_nat n) - xn (Pos.to_nat n) - (2#n)))) as [k kmaj]. - assert (0 < yn (Pos.to_nat n) - xn (Pos.to_nat n) - (2 # n))%Q as H0. + pose (yn n - xn n) as dn. + destruct (Qarchimedean (/(yn n - xn n - (2#n)))) as [k kmaj]. + assert (0 < yn n - xn n - (2 # n))%Q as H0. { rewrite <- (Qplus_opp_r (2#n)). apply Qplus_lt_l. assumption. } - intros. - remember (yn (Pos.to_nat p) - xn (Pos.to_nat p)) as dp. - + intros. remember (yn p - xn p) as dp. rewrite <- (Qplus_0_r dp). rewrite <- (Qplus_opp_r dn). rewrite (Qplus_comm dn). rewrite Qplus_assoc. assert (Qlt (Qabs (dp - dn)) (2#n)). { rewrite Heqdp. unfold dn. - setoid_replace (yn (Pos.to_nat p) - xn (Pos.to_nat p) - (yn (Pos.to_nat n) - xn (Pos.to_nat n))) - with (yn (Pos.to_nat p) - yn (Pos.to_nat n) - + (xn (Pos.to_nat n) - xn (Pos.to_nat p))). - apply (Qle_lt_trans _ (Qabs (yn (Pos.to_nat p) - yn (Pos.to_nat n)) - + Qabs (xn (Pos.to_nat n) - xn (Pos.to_nat p)))). + setoid_replace (yn p - xn p - (yn n - xn n)) + with (yn p - yn n + (xn n - xn p)). + apply (Qle_lt_trans _ (Qabs (yn p - yn n) + Qabs (xn n - xn p))). apply Qabs_triangle. setoid_replace (2#n)%Q with ((1#n) + (1#n))%Q. apply Qplus_lt_le_compat. apply limy. - apply Pos2Nat.inj_le. apply (Pos.le_trans _ (Pos.max n (2 * k))). + apply (Pos.le_trans _ (Pos.max n (2 * k))). apply Pos.le_max_l. assumption. - apply le_refl. apply Qlt_le_weak. apply limx. apply le_refl. - apply Pos2Nat.inj_le. apply (Pos.le_trans _ (Pos.max n (2 * k))). + apply Pos.le_refl. apply Qlt_le_weak. apply limx. apply Pos.le_refl. + apply (Pos.le_trans _ (Pos.max n (2 * k))). apply Pos.le_max_l. assumption. - rewrite Qinv_plus_distr. reflexivity. field. } + rewrite Qinv_plus_distr. reflexivity. ring. } apply (Qle_lt_trans _ (-(2#n) + dn)). rewrite Qplus_comm. unfold dn. apply Qlt_le_weak. apply (Qle_lt_trans _ (2 # (2 * k))). apply Pos.le_max_r. @@ -463,12 +236,11 @@ Qed. Lemma CRealLt_above : forall (x y : CReal), CRealLt x y -> { k : positive | forall p:positive, - Pos.le k p -> Qlt (2 # k) (proj1_sig y (Pos.to_nat p) - - proj1_sig x (Pos.to_nat p)) }. + Pos.le k p -> Qlt (2 # k) (proj1_sig y p - proj1_sig x p) }. Proof. intros x y [n maj]. pose proof (CRealLt_aboveSig x y n maj). - destruct (Qarchimedean (/ (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n) - (2 # n)))) + destruct (Qarchimedean (/ (proj1_sig y n - proj1_sig x n - (2 # n)))) as [k kmaj]. exists (Pos.max n (2*k)). apply H. Qed. @@ -476,28 +248,26 @@ Qed. (* The CRealLt index separates the Cauchy sequences *) Lemma CRealLt_above_same : forall (x y : CReal) (n : positive), Qlt (2 # n) - (proj1_sig y (Pos.to_nat n) - proj1_sig x (Pos.to_nat n)) - -> forall p:positive, Pos.le n p - -> Qlt (proj1_sig x (Pos.to_nat p)) (proj1_sig y (Pos.to_nat p)). + (proj1_sig y n - proj1_sig x n) + -> forall p:positive, Pos.le n p -> Qlt (proj1_sig x p) (proj1_sig y p). Proof. intros [xn limx] [yn limy] n inf p H. simpl. simpl in inf. - apply (Qplus_lt_l _ _ (- xn (Pos.to_nat n))). - apply (Qle_lt_trans _ (Qabs (xn (Pos.to_nat p) + - xn (Pos.to_nat n)))). + apply (Qplus_lt_l _ _ (- xn n)). + apply (Qle_lt_trans _ (Qabs (xn p + - xn n))). apply Qle_Qabs. apply (Qlt_trans _ (1#n)). - apply limx. apply Pos2Nat.inj_le. assumption. apply le_refl. - rewrite <- (Qplus_0_r (yn (Pos.to_nat p))). - rewrite <- (Qplus_opp_r (yn (Pos.to_nat n))). - rewrite (Qplus_comm (yn (Pos.to_nat n))). rewrite Qplus_assoc. + apply limx. exact H. apply Pos.le_refl. + rewrite <- (Qplus_0_r (yn p)). + rewrite <- (Qplus_opp_r (yn n)). + rewrite (Qplus_comm (yn n)). rewrite Qplus_assoc. rewrite <- Qplus_assoc. setoid_replace (1#n)%Q with (-(1#n) + (2#n))%Q. apply Qplus_lt_le_compat. apply (Qplus_lt_l _ _ (1#n)). rewrite Qplus_opp_r. - apply (Qplus_lt_r _ _ (yn (Pos.to_nat n) + - yn (Pos.to_nat p))). + apply (Qplus_lt_r _ _ (yn n + - yn p)). ring_simplify. - setoid_replace (yn (Pos.to_nat n) + (-1 # 1) * yn (Pos.to_nat p)) - with (yn (Pos.to_nat n) - yn (Pos.to_nat p)). - apply (Qle_lt_trans _ (Qabs (yn (Pos.to_nat n) - yn (Pos.to_nat p)))). - apply Qle_Qabs. apply limy. apply le_refl. apply Pos2Nat.inj_le. assumption. + setoid_replace (yn n + (-1 # 1) * yn p) with (yn n - yn p). + apply (Qle_lt_trans _ (Qabs (yn n - yn p))). + apply Qle_Qabs. apply limy. apply Pos.le_refl. assumption. field. apply Qle_lteq. left. assumption. rewrite Qplus_comm. rewrite Qinv_minus_distr. reflexivity. @@ -508,10 +278,10 @@ 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 (proj1_sig y (Pos.to_nat (Pos.max n p))) - (proj1_sig x (Pos.to_nat (Pos.max n p)))). + apply (Qlt_not_le (proj1_sig y (Pos.max n p)) + (proj1_sig x (Pos.max n p))). apply H0. apply Pos.le_max_l. - apply Qlt_le_weak. apply (Qplus_lt_l _ _ (-proj1_sig x (Pos.to_nat (Pos.max n p)))). + apply Qlt_le_weak. apply (Qplus_lt_l _ _ (-proj1_sig x (Pos.max n p))). rewrite Qplus_opp_r. apply (Qlt_trans _ (2#p)). unfold Qlt. simpl. unfold Z.lt. auto. apply H. apply Pos.le_max_r. Qed. @@ -542,31 +312,24 @@ Lemma CRealLt_dec : forall x y z : CReal, Proof. intros [xn limx] [yn limy] [zn limz] [n inf]. unfold proj1_sig in inf. - remember (yn (Pos.to_nat n) - xn (Pos.to_nat n) - (2 # n)) as eps. + remember (yn n - xn n - (2 # n)) as eps. assert (Qlt 0 eps) as epsPos. { subst eps. unfold Qminus. apply (Qlt_minus_iff (2#n)). assumption. } - assert (forall n p, Pos.to_nat n <= Pos.to_nat (Pos.max n p))%nat. - { intros. apply Pos2Nat.inj_le. unfold Pos.max. unfold Pos.le. - destruct (n0 ?= p)%positive eqn:des. - rewrite des. discriminate. rewrite des. discriminate. - unfold Pos.compare. rewrite Pos.compare_cont_refl. discriminate. } destruct (Qarchimedean (/eps)) as [k kmaj]. - destruct (Qlt_le_dec ((yn (Pos.to_nat n) + xn (Pos.to_nat n)) / (2#1)) - (zn (Pos.to_nat (Pos.max n (4 * k))))) + destruct (Qlt_le_dec ((yn n + xn n) / (2#1)) + (zn (Pos.max n (4 * k)))) as [decMiddle|decMiddle]. - left. exists (Pos.max n (4 * k)). unfold proj1_sig. unfold Qminus. - rewrite <- (Qplus_0_r (zn (Pos.to_nat (Pos.max n (4 * k))))). - rewrite <- (Qplus_opp_r (xn (Pos.to_nat n))). - rewrite (Qplus_comm (xn (Pos.to_nat n))). rewrite Qplus_assoc. + rewrite <- (Qplus_0_r (zn (Pos.max n (4 * k)))). + rewrite <- (Qplus_opp_r (xn n)). + rewrite (Qplus_comm (xn n)). rewrite Qplus_assoc. rewrite <- Qplus_assoc. rewrite <- Qplus_0_r. rewrite <- (Qplus_opp_r (1#n)). rewrite Qplus_assoc. apply Qplus_lt_le_compat. - + apply (Qplus_lt_l _ _ (- xn (Pos.to_nat n))) in decMiddle. - apply (Qlt_trans _ ((yn (Pos.to_nat n) + xn (Pos.to_nat n)) / (2 # 1) - + - xn (Pos.to_nat n))). - setoid_replace ((yn (Pos.to_nat n) + xn (Pos.to_nat n)) / (2 # 1) - - xn (Pos.to_nat n)) - with ((yn (Pos.to_nat n) - xn (Pos.to_nat n)) / (2 # 1)). + + apply (Qplus_lt_l _ _ (- xn n)) in decMiddle. + apply (Qlt_trans _ ((yn n + xn n) / (2 # 1) + - xn n)). + setoid_replace ((yn n + xn n) / (2 # 1) - xn n) + with ((yn n - xn n) / (2 # 1)). apply Qlt_shift_div_l. unfold Qlt. simpl. unfold Z.lt. auto. rewrite Qmult_plus_distr_l. setoid_replace ((1 # n) * (2 # 1))%Q with (2#n)%Q. @@ -580,31 +343,30 @@ Proof. apply Qinv_lt_contravar. reflexivity. apply epsPos. apply kmaj. unfold Qeq. simpl. rewrite Pos.mul_1_r. reflexivity. field. assumption. - + setoid_replace (xn (Pos.to_nat n) + - xn (Pos.to_nat (Pos.max n (4 * k)))) - with (-(xn (Pos.to_nat (Pos.max n (4 * k))) - xn (Pos.to_nat n))). + + setoid_replace (xn n + - xn (Pos.max n (4 * k))) + with (-(xn (Pos.max n (4 * k)) - xn n)). apply Qopp_le_compat. - apply (Qle_trans _ (Qabs (xn (Pos.to_nat (Pos.max n (4 * k))) - xn (Pos.to_nat n)))). - apply Qle_Qabs. apply Qle_lteq. left. apply limx. apply H. - apply le_refl. field. + apply (Qle_trans _ (Qabs (xn (Pos.max n (4 * k)) - xn n))). + apply Qle_Qabs. apply Qle_lteq. left. apply limx. apply Pos.le_max_l. + apply Pos.le_refl. ring. - right. exists (Pos.max n (4 * k)). unfold proj1_sig. unfold Qminus. - rewrite <- (Qplus_0_r (yn (Pos.to_nat (Pos.max n (4 * k))))). - rewrite <- (Qplus_opp_r (yn (Pos.to_nat n))). - rewrite (Qplus_comm (yn (Pos.to_nat n))). rewrite Qplus_assoc. + rewrite <- (Qplus_0_r (yn (Pos.max n (4 * k)))). + rewrite <- (Qplus_opp_r (yn n)). + rewrite (Qplus_comm (yn n)). rewrite Qplus_assoc. rewrite <- Qplus_assoc. rewrite <- Qplus_0_l. rewrite <- (Qplus_opp_r (1#n)). rewrite (Qplus_comm (1#n)). rewrite <- Qplus_assoc. apply Qplus_lt_le_compat. - + apply (Qplus_lt_r _ _ (yn (Pos.to_nat n) - yn (Pos.to_nat (Pos.max n (4 * k))) + (1#n))) + + apply (Qplus_lt_r _ _ (yn n - yn (Pos.max n (4 * k)) + (1#n))) ; ring_simplify. - setoid_replace (-1 * yn (Pos.to_nat (Pos.max n (4 * k)))) - with (- yn (Pos.to_nat (Pos.max n (4 * k)))). 2: ring. - apply (Qle_lt_trans _ (Qabs (yn (Pos.to_nat n) - - yn (Pos.to_nat (Pos.max n (4 * k)))))). - apply Qle_Qabs. apply limy. apply le_refl. apply H. + setoid_replace (-1 * yn (Pos.max n (4 * k))) + with (- yn (Pos.max n (4 * k))). 2: ring. + apply (Qle_lt_trans _ (Qabs (yn n - yn (Pos.max n (4 * k))))). + apply Qle_Qabs. apply limy. apply Pos.le_refl. apply Pos.le_max_l. + apply Qopp_le_compat in decMiddle. - apply (Qplus_le_r _ _ (yn (Pos.to_nat n))) in decMiddle. - apply (Qle_trans _ (yn (Pos.to_nat n) + - ((yn (Pos.to_nat n) + xn (Pos.to_nat n)) / (2 # 1)))). - setoid_replace (yn (Pos.to_nat n) + - ((yn (Pos.to_nat n) + xn (Pos.to_nat n)) / (2 # 1))) - with ((yn (Pos.to_nat n) - xn (Pos.to_nat n)) / (2 # 1)). + apply (Qplus_le_r _ _ (yn n)) in decMiddle. + apply (Qle_trans _ (yn n + - ((yn n + xn n) / (2 # 1)))). + setoid_replace (yn n + - ((yn n + xn n) / (2 # 1))) + with ((yn n - xn n) / (2 # 1)). apply Qle_shift_div_l. unfold Qlt. simpl. unfold Z.lt. auto. rewrite Qmult_plus_distr_l. setoid_replace ((1 # n) * (2 # 1))%Q with (2#n)%Q. @@ -765,8 +527,7 @@ Qed. (* Injection of Q into CReal *) -Lemma ConstCauchy : forall q : Q, - QCauchySeq (fun _ => q) Pos.to_nat. +Lemma ConstCauchy : forall q : Q, QCauchySeq (fun _ => q). Proof. intros. intros k p r H H0. unfold Qminus. rewrite Qplus_opp_r. unfold Qlt. simpl. @@ -811,64 +572,64 @@ Qed. by a factor 2. *) Lemma CRealLtQ : forall (x : CReal) (q : Q), CRealLt x (inject_Q q) - -> forall p:positive, Qlt (proj1_sig x (Pos.to_nat p)) (q + (1#p)). + -> forall p:positive, Qlt (proj1_sig x p) (q + (1#p)). Proof. intros [xn cau] q maj p. simpl. - destruct (Qlt_le_dec (xn (Pos.to_nat p)) (q + (1 # p))). assumption. + destruct (Qlt_le_dec (xn p) (q + (1 # p))). assumption. exfalso. apply CRealLt_above in maj. destruct maj as [k maj]; simpl in maj. specialize (maj (Pos.max k p) (Pos.le_max_l _ _)). - specialize (cau p (Pos.to_nat p) (Pos.to_nat (Pos.max k p)) (le_refl _)). - pose proof (Qplus_lt_le_compat (2#k) (q - xn (Pos.to_nat (Pos.max k p))) - (q + (1 # p)) (xn (Pos.to_nat p)) maj q0). + specialize (cau p p (Pos.max k p) (Pos.le_refl _)). + pose proof (Qplus_lt_le_compat (2#k) (q - xn (Pos.max k p)) + (q + (1 # p)) (xn p) maj q0). rewrite Qplus_comm in H. unfold Qminus in H. rewrite <- Qplus_assoc in H. rewrite <- Qplus_assoc in H. apply Qplus_lt_r in H. - rewrite <- (Qplus_lt_r _ _ (xn (Pos.to_nat p))) in maj. + rewrite <- (Qplus_lt_r _ _ (xn p)) in maj. apply (Qlt_not_le (1#p) ((1 # p) + (2 # k))). rewrite <- (Qplus_0_r (1#p)). rewrite <- Qplus_assoc. apply Qplus_lt_r. reflexivity. apply Qlt_le_weak. - apply (Qlt_trans _ (- xn (Pos.to_nat (Pos.max k p)) + xn (Pos.to_nat p)) _ H). + apply (Qlt_trans _ (- xn (Pos.max k p) + xn p) _ H). rewrite Qplus_comm. - apply (Qle_lt_trans _ (Qabs (xn (Pos.to_nat p) - xn (Pos.to_nat (Pos.max k p))))). - apply Qle_Qabs. apply cau. apply Pos2Nat.inj_le. apply Pos.le_max_r. + apply (Qle_lt_trans _ (Qabs (xn p - xn (Pos.max k p)))). + apply Qle_Qabs. apply cau. apply Pos.le_max_r. Qed. Lemma CRealLtQopp : forall (x : CReal) (q : Q), CRealLt (inject_Q q) x - -> forall p:positive, Qlt (q - (1#p)) (proj1_sig x (Pos.to_nat p)). + -> forall p:positive, Qlt (q - (1#p)) (proj1_sig x p). Proof. intros [xn cau] q maj p. simpl. - destruct (Qlt_le_dec (q - (1 # p)) (xn (Pos.to_nat p))). assumption. + destruct (Qlt_le_dec (q - (1 # p)) (xn p)). assumption. exfalso. apply CRealLt_above in maj. destruct maj as [k maj]; simpl in maj. specialize (maj (Pos.max k p) (Pos.le_max_l _ _)). - specialize (cau p (Pos.to_nat (Pos.max k p)) (Pos.to_nat p)). - pose proof (Qplus_lt_le_compat (2#k) (xn (Pos.to_nat (Pos.max k p)) - q) - (xn (Pos.to_nat p)) (q - (1 # p)) maj q0). + specialize (cau p (Pos.max k p) p). + pose proof (Qplus_lt_le_compat (2#k) (xn (Pos.max k p) - q) + (xn p) (q - (1 # p)) maj q0). unfold Qminus in H. rewrite <- Qplus_assoc in H. rewrite (Qplus_assoc (-q)) in H. rewrite (Qplus_comm (-q)) in H. rewrite Qplus_opp_r in H. rewrite Qplus_0_l in H. apply (Qplus_lt_l _ _ (1#p)) in H. - rewrite <- (Qplus_assoc (xn (Pos.to_nat (Pos.max k p)))) in H. + rewrite <- (Qplus_assoc (xn (Pos.max k p))) in H. rewrite (Qplus_comm (-(1#p))) in H. rewrite Qplus_opp_r in H. rewrite Qplus_0_r in H. rewrite Qplus_comm in H. - rewrite Qplus_assoc in H. apply (Qplus_lt_l _ _ (- xn (Pos.to_nat p))) in H. + rewrite Qplus_assoc in H. apply (Qplus_lt_l _ _ (- xn p)) in H. rewrite <- Qplus_assoc in H. rewrite Qplus_opp_r in H. rewrite Qplus_0_r in H. apply (Qlt_not_le (1#p) ((1 # p) + (2 # k))). rewrite <- (Qplus_0_r (1#p)). rewrite <- Qplus_assoc. apply Qplus_lt_r. reflexivity. apply Qlt_le_weak. - apply (Qlt_trans _ (xn (Pos.to_nat (Pos.max k p)) - xn (Pos.to_nat p)) _ H). - apply (Qle_lt_trans _ (Qabs (xn (Pos.to_nat (Pos.max k p)) - xn (Pos.to_nat p)))). - apply Qle_Qabs. apply cau. apply Pos2Nat.inj_le. - apply Pos.le_max_r. apply le_refl. + apply (Qlt_trans _ (xn (Pos.max k p) - xn p) _ H). + apply (Qle_lt_trans _ (Qabs (xn (Pos.max k p) - xn p))). + apply Qle_Qabs. apply cau. + apply Pos.le_max_r. apply Pos.le_refl. Qed. Lemma inject_Q_compare : forall (x : CReal) (p : positive), - x <= inject_Q (proj1_sig x (Pos.to_nat p) + (1#p)). + x <= inject_Q (proj1_sig x p + (1#p)). Proof. intros. intros [n nmaj]. destruct x as [xn xcau]; simpl in nmaj. @@ -876,18 +637,17 @@ Proof. ring_simplify in nmaj. destruct (Pos.max_dec p n). - apply Pos.max_l_iff in e. - apply Pos2Nat.inj_le in e. - specialize (xcau n (Pos.to_nat n) (Pos.to_nat p) (le_refl _) e). - apply (Qlt_le_trans _ _ (Qabs (xn (Pos.to_nat n) + -1 * xn (Pos.to_nat p)))) in nmaj. + specialize (xcau n n p (Pos.le_refl _) e). + apply (Qlt_le_trans _ _ (Qabs (xn n + -1 * xn p))) in nmaj. 2: apply Qle_Qabs. apply (Qlt_trans _ _ _ nmaj) in xcau. apply (Qplus_lt_l _ _ (-(1#n)-(1#p))) in xcau. ring_simplify in xcau. setoid_replace ((2 # n) + -1 * (1 # n)) with (1#n)%Q in xcau. discriminate xcau. setoid_replace (-1 * (1 # n)) with (-1#n)%Q. 2: reflexivity. rewrite Qinv_plus_distr. reflexivity. - - apply Pos.max_r_iff, Pos2Nat.inj_le in e. - specialize (xcau p (Pos.to_nat n) (Pos.to_nat p) e (le_refl _)). - apply (Qlt_le_trans _ _ (Qabs (xn (Pos.to_nat n) + -1 * xn (Pos.to_nat p)))) in nmaj. + - apply Pos.max_r_iff in e. + specialize (xcau p n p e (Pos.le_refl _)). + apply (Qlt_le_trans _ _ (Qabs (xn n + -1 * xn p))) in nmaj. 2: apply Qle_Qabs. apply (Qlt_trans _ _ _ nmaj) in xcau. apply (Qplus_lt_l _ _ (-(1#p))) in xcau. ring_simplify in xcau. discriminate. @@ -921,85 +681,41 @@ Qed. (* Algebraic operations *) Lemma CReal_plus_cauchy - : forall (xn yn zn : nat -> Q) (cvmod : positive -> nat), - QSeqEquiv xn yn cvmod - -> QCauchySeq zn Pos.to_nat - -> QSeqEquiv (fun n:nat => xn n + zn n) (fun n:nat => yn n + zn n) - (fun p => max (cvmod (2 * p)%positive) - (Pos.to_nat (2 * p)%positive)). -Proof. - intros. intros p n k H1 H2. - setoid_replace (xn n + zn n - (yn k + zn k)) - with (xn n - yn k + (zn n - zn k)). - 2: field. - apply (Qle_lt_trans _ (Qabs (xn n - yn k) + Qabs (zn n - zn k))). - apply Qabs_triangle. - setoid_replace (1#p)%Q with ((1#2*p) + (1#2*p))%Q. + : forall (x y : CReal), + QCauchySeq (fun n : positive => Qred (proj1_sig x (2 * n)%positive + + proj1_sig y (2 * n)%positive)). +Proof. + destruct x as [xn limx], y as [yn limy]; unfold proj1_sig. + intros n p q H H0. + rewrite Qred_correct, Qred_correct. + setoid_replace (xn (2 * p)%positive + yn (2 * p)%positive + - (xn (2 * q)%positive + yn (2 * q)%positive)) + with (xn (2 * p)%positive - xn (2 * q)%positive + + (yn (2 * p)%positive - yn (2 * q)%positive)). + 2: ring. + apply (Qle_lt_trans _ _ _ (Qabs_triangle _ _)). + setoid_replace (1#n)%Q with ((1#2*n) + (1#2*n))%Q. apply Qplus_lt_le_compat. - - apply H. apply (le_trans _ (Init.Nat.max (cvmod (2 * p)%positive) (Pos.to_nat (2 * p)))). - apply Nat.le_max_l. apply H1. - apply (le_trans _ (Init.Nat.max (cvmod (2 * p)%positive) (Pos.to_nat (2 * p)))). - apply Nat.le_max_l. apply H2. - - apply Qle_lteq. left. apply H0. - apply (le_trans _ (Init.Nat.max (cvmod (2 * p)%positive) (Pos.to_nat (2 * p)))). - apply Nat.le_max_r. apply H1. - apply (le_trans _ (Init.Nat.max (cvmod (2 * p)%positive) (Pos.to_nat (2 * p)))). - apply Nat.le_max_r. apply H2. + - apply limx. unfold id. apply Pos.mul_le_mono_l, H. + unfold id. apply Pos.mul_le_mono_l, H0. + - apply Qlt_le_weak, limy. + unfold id. apply Pos.mul_le_mono_l, H. + unfold id. apply Pos.mul_le_mono_l, H0. - rewrite Qinv_plus_distr. unfold Qeq. reflexivity. Qed. -Definition CReal_plus (x y : CReal) : CReal. -Proof. - destruct x as [xn limx], y as [yn limy]. - pose proof (CReal_plus_cauchy xn xn yn Pos.to_nat limx limy). - exists (fun n : nat => xn (2 * n)%nat + yn (2 * n)%nat). - intros p k n H0 H1. apply H. - - rewrite max_l. rewrite Pos2Nat.inj_mul. - apply Nat.mul_le_mono_nonneg. apply le_0_n. apply le_refl. - apply le_0_n. apply H0. apply le_refl. - - rewrite Pos2Nat.inj_mul. rewrite max_l. - apply Nat.mul_le_mono_nonneg. apply le_0_n. apply le_refl. - apply le_0_n. apply H1. apply le_refl. -Defined. +(* We reduce the rational numbers to accelerate calculations. *) +Definition CReal_plus (x y : CReal) : CReal + := exist _ (fun n : positive => Qred (proj1_sig x (2 * n)%positive + + proj1_sig y (2 * n)%positive)) + (CReal_plus_cauchy x y). Infix "+" := CReal_plus : CReal_scope. -Lemma CReal_plus_nth : forall (x y : CReal) (n : nat), - proj1_sig (x + y) n = Qplus (proj1_sig x (2*n)%nat) (proj1_sig y (2*n)%nat). -Proof. - intros. destruct x,y; reflexivity. -Qed. - -Lemma CReal_plus_unfold : forall (x y : CReal), - QSeqEquiv (proj1_sig (CReal_plus x y)) - (fun n : nat => proj1_sig x n + proj1_sig y n)%Q - (fun p => Pos.to_nat (2 * p)). -Proof. - intros [xn limx] [yn limy]. - unfold CReal_plus; simpl. - intros p n k H H0. - setoid_replace (xn (2 * n)%nat + yn (2 * n)%nat - (xn k + yn k))%Q - with (xn (2 * n)%nat - xn k + (yn (2 * n)%nat - yn k))%Q. - 2: field. - apply (Qle_lt_trans _ (Qabs (xn (2 * n)%nat - xn k) + Qabs (yn (2 * n)%nat - yn k))). - apply Qabs_triangle. - setoid_replace (1#p)%Q with ((1#2*p) + (1#2*p))%Q. - apply Qplus_lt_le_compat. - - apply limx. apply (le_trans _ n). apply H. - rewrite <- (mult_1_l n). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. simpl. auto. - apply le_0_n. apply le_refl. apply H0. - - apply Qlt_le_weak. apply limy. apply (le_trans _ n). apply H. - rewrite <- (mult_1_l n). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. simpl. auto. - apply le_0_n. apply le_refl. apply H0. - - rewrite Qinv_plus_distr. unfold Qeq. reflexivity. -Qed. - Definition CReal_opp (x : CReal) : CReal. Proof. destruct x as [xn limx]. - exists (fun n : nat => - xn n). + exists (fun n : positive => - xn n). intros k p q H H0. unfold Qminus. rewrite Qopp_involutive. rewrite Qplus_comm. apply limx; assumption. Defined. @@ -1011,73 +727,74 @@ Definition CReal_minus (x y : CReal) : CReal Infix "-" := CReal_minus : CReal_scope. -Lemma belowMultiple : forall n p : nat, lt 0 p -> le n (p * n). +Lemma belowMultiple : forall n p : positive, Pos.le n (p * n). Proof. - intros. rewrite <- (mult_1_l n). apply Nat.mul_le_mono_nonneg. - auto. assumption. apply le_0_n. rewrite mult_1_l. apply le_refl. + intros. apply (Pos.le_trans _ (1*n)). apply Pos.le_refl. + apply Pos.mul_le_mono_r. destruct p; discriminate. Qed. Lemma CReal_plus_assoc : forall (x y z : CReal), - CRealEq (CReal_plus (CReal_plus x y) z) - (CReal_plus x (CReal_plus y z)). + (x + y) + z == x + (y + z). Proof. intros. apply CRealEq_diff. intro n. destruct x as [xn limx], y as [yn limy], z as [zn limz]. unfold CReal_plus; unfold proj1_sig. - setoid_replace (xn (2 * (2 * Pos.to_nat n))%nat + yn (2 * (2 * Pos.to_nat n))%nat - + zn (2 * Pos.to_nat n)%nat - - (xn (2 * Pos.to_nat n)%nat + (yn (2 * (2 * Pos.to_nat n))%nat - + zn (2 * (2 * Pos.to_nat n))%nat)))%Q - with (xn (2 * (2 * Pos.to_nat n))%nat - xn (2 * Pos.to_nat n)%nat - + (zn (2 * Pos.to_nat n)%nat - zn (2 * (2 * Pos.to_nat n))%nat))%Q. - apply (Qle_trans _ (Qabs (xn (2 * (2 * Pos.to_nat n))%nat - xn (2 * Pos.to_nat n)%nat) - + Qabs (zn (2 * Pos.to_nat n)%nat - zn (2 * (2 * Pos.to_nat n))%nat))). + rewrite Qred_correct, Qred_correct, Qred_correct, Qred_correct. + setoid_replace (xn (2 * (2 * n))%positive + yn (2 * (2 * n))%positive + + zn (2 * n)%positive + - (xn (2 * n)%positive + (yn (2 * (2 * n))%positive + + zn (2 * (2 * n))%positive)))%Q + with (xn (2 * (2 * n))%positive - xn (2 * n)%positive + + (zn (2 * n)%positive - zn (2 * (2 * n))%positive))%Q. + apply (Qle_trans _ (Qabs (xn (2 * (2 * n))%positive - xn (2 * n)%positive) + + Qabs (zn (2 * n)%positive - zn (2 * (2 * n))%positive))). apply Qabs_triangle. rewrite <- (Qinv_plus_distr 1 1 n). apply Qplus_le_compat. - apply Qle_lteq. left. apply limx. rewrite mult_assoc. - apply belowMultiple. simpl. auto. apply belowMultiple. auto. - apply Qle_lteq. left. apply limz. apply belowMultiple. auto. - rewrite mult_assoc. apply belowMultiple. simpl. auto. field. + apply Qle_lteq. left. apply limx. rewrite Pos.mul_assoc. + apply belowMultiple. apply belowMultiple. + apply Qle_lteq. left. apply limz. apply belowMultiple. + rewrite Pos.mul_assoc. apply belowMultiple. simpl. field. Qed. Lemma CReal_plus_comm : forall x y : CReal, x + y == y + x. Proof. intros [xn limx] [yn limy]. apply CRealEq_diff. intros. - unfold CReal_plus, proj1_sig. - setoid_replace (xn (2 * Pos.to_nat n)%nat + yn (2 * Pos.to_nat n)%nat - - (yn (2 * Pos.to_nat n)%nat + xn (2 * Pos.to_nat n)%nat))%Q + unfold CReal_plus, proj1_sig. rewrite Qred_correct, Qred_correct. + setoid_replace (xn (2 * n)%positive + yn (2 * n)%positive + - (yn (2 * n)%positive + xn (2 * n)%positive))%Q with 0%Q. unfold Qle. simpl. unfold Z.le. intro absurd. inversion absurd. - field. + ring. Qed. Lemma CReal_plus_0_l : forall r : CReal, - CRealEq (CReal_plus (inject_Q 0) r) r. -Proof. - intro r. assert (forall n:nat, le n (2 * n)). - { intro n. simpl. rewrite <- (plus_0_r n). rewrite <- plus_assoc. - apply Nat.add_le_mono_l. apply le_0_n. } - split. - - intros [n maj]. destruct r as [xn q]; unfold CReal_plus, proj1_sig, inject_Q in maj. - rewrite Qplus_0_l in maj. - specialize (q n (Pos.to_nat n) (mult 2 (Pos.to_nat n)) (le_refl _)). - apply (Qlt_not_le (2#n) (xn (Pos.to_nat n) - xn (2 * Pos.to_nat n)%nat)). + inject_Q 0 + r == r. +Proof. + intro r. split. + - intros [n maj]. + destruct r as [xn q]; unfold CReal_plus, proj1_sig, inject_Q in maj. + rewrite Qplus_0_l, Qred_correct in maj. + specialize (q n n (Pos.mul 2 n) (Pos.le_refl _)). + apply (Qlt_not_le (2#n) (xn n - xn (2 * n)%positive)). assumption. - apply (Qle_trans _ (Qabs (xn (Pos.to_nat n) - xn (2 * Pos.to_nat n)%nat))). + apply (Qle_trans _ (Qabs (xn n - xn (2 * n)%positive))). apply Qle_Qabs. apply (Qle_trans _ (1#n)). apply Qlt_le_weak. apply q. - apply H. unfold Qle, Z.le; simpl. apply Pos2Nat.inj_le. rewrite Pos2Nat.inj_xO. - apply H. - - intros [n maj]. destruct r as [xn q]; unfold CReal_plus, proj1_sig, inject_Q in maj. - rewrite Qplus_0_l in maj. - specialize (q n (Pos.to_nat n) (mult 2 (Pos.to_nat n)) (le_refl _)). + apply belowMultiple. + unfold Qle, Qnum, Qden. apply Z.mul_le_mono_nonneg_r. + discriminate. discriminate. + - intros [n maj]. + destruct r as [xn q]; unfold CReal_plus, proj1_sig, inject_Q in maj. + rewrite Qplus_0_l, Qred_correct in maj. + specialize (q n n (Pos.mul 2 n) (Pos.le_refl _)). rewrite Qabs_Qminus in q. - apply (Qlt_not_le (2#n) (xn (mult 2 (Pos.to_nat n)) - xn (Pos.to_nat n))). + apply (Qlt_not_le (2#n) (xn (Pos.mul 2 n) - xn n)). assumption. - apply (Qle_trans _ (Qabs (xn (mult 2 (Pos.to_nat n)) - xn (Pos.to_nat n)))). + apply (Qle_trans _ (Qabs (xn (Pos.mul 2 n) - xn n))). apply Qle_Qabs. apply (Qle_trans _ (1#n)). apply Qlt_le_weak. apply q. - apply H. unfold Qle, Z.le; simpl. apply Pos2Nat.inj_le. rewrite Pos2Nat.inj_xO. - apply H. + apply belowMultiple. + unfold Qle, Qnum, Qden. apply Z.mul_le_mono_nonneg_r. + discriminate. discriminate. Qed. Lemma CReal_plus_0_r : forall r : CReal, @@ -1091,16 +808,14 @@ Lemma CReal_plus_lt_compat_l : Proof. intros. apply CRealLt_above in H. destruct H as [n maj]. - exists n. specialize (maj (xO n)). - rewrite Pos2Nat.inj_xO in maj. - setoid_replace (proj1_sig (CReal_plus x z) (Pos.to_nat n) - - proj1_sig (CReal_plus x y) (Pos.to_nat n))%Q - with (proj1_sig z (2 * Pos.to_nat n)%nat - proj1_sig y (2 * Pos.to_nat n)%nat)%Q. - apply maj. apply Pos2Nat.inj_le. - rewrite <- (plus_0_r (Pos.to_nat n)). rewrite Pos2Nat.inj_xO. - simpl. apply Nat.add_le_mono_l. apply le_0_n. - simpl. destruct x as [xn limx], y as [yn limy], z as [zn limz]. - simpl; ring. + exists n. specialize (maj (2 * n)%positive). + setoid_replace (proj1_sig (CReal_plus x z) n + - proj1_sig (CReal_plus x y) n)%Q + with (proj1_sig z (2 * n)%positive - proj1_sig y (2 * n)%positive)%Q. + apply maj. apply belowMultiple. + destruct x as [xn limx], y as [yn limy], z as [zn limz]; + unfold CReal_plus, proj1_sig. + rewrite Qred_correct, Qred_correct. ring. Qed. Lemma CReal_plus_lt_compat_r : @@ -1114,14 +829,16 @@ Lemma CReal_plus_lt_reg_l : forall x y z : CReal, x + y < x + z -> y < z. Proof. intros. destruct H as [n maj]. exists (2*n)%positive. - setoid_replace (proj1_sig z (Pos.to_nat (2 * n)) - proj1_sig y (Pos.to_nat (2 * n)))%Q - with (proj1_sig (CReal_plus x z) (Pos.to_nat n) - proj1_sig (CReal_plus x y) (Pos.to_nat n))%Q. - apply (Qle_lt_trans _ (2#n)). unfold Qle, Z.le; simpl. apply Pos2Nat.inj_le. - rewrite <- (plus_0_r (Pos.to_nat n~0)). rewrite (Pos2Nat.inj_xO (n~0)). - simpl. apply Nat.add_le_mono_l. apply le_0_n. - apply maj. rewrite Pos2Nat.inj_xO. - destruct x as [xn limx], y as [yn limy], z as [zn limz]. - simpl; ring. + setoid_replace (proj1_sig z (2 * n)%positive - proj1_sig y (2 * n)%positive)%Q + with (proj1_sig (CReal_plus x z) n - proj1_sig (CReal_plus x y) n)%Q. + apply (Qle_lt_trans _ (2#n)). + setoid_replace (2 # 2 * n)%Q with (1 # n)%Q. 2: reflexivity. + unfold Qle, Qnum, Qden. apply Z.mul_le_mono_nonneg_r. + discriminate. discriminate. + apply maj. + destruct x as [xn limx], y as [yn limy], z as [zn limz]; + unfold CReal_plus, proj1_sig. + rewrite Qred_correct, Qred_correct. ring. Qed. Lemma CReal_plus_lt_reg_r : @@ -1173,9 +890,10 @@ Lemma CReal_plus_opp_r : forall x : CReal, Proof. intros [xn limx]. apply CRealEq_diff. intros. unfold CReal_plus, CReal_opp, inject_Q, proj1_sig. - setoid_replace (xn (2 * Pos.to_nat n)%nat + - xn (2 * Pos.to_nat n)%nat - 0)%Q + rewrite Qred_correct. + setoid_replace (xn (2 * n)%positive + - xn (2 * n)%positive - 0)%Q with 0%Q. - unfold Qle. simpl. unfold Z.le. intro absurd. inversion absurd. field. + unfold Qle. simpl. unfold Z.le. intro absurd. inversion absurd. ring. Qed. Lemma CReal_plus_opp_l : forall x : CReal, @@ -1275,9 +993,11 @@ Lemma inject_Q_plus : forall q r : Q, inject_Q (q + r) == inject_Q q + inject_Q r. Proof. split. - - intros [n nmaj]. simpl in nmaj. + - intros [n nmaj]. unfold CReal_plus, inject_Q, proj1_sig in nmaj. + rewrite Qred_correct in nmaj. ring_simplify in nmaj. discriminate. - - intros [n nmaj]. simpl in nmaj. + - intros [n nmaj]. unfold CReal_plus, inject_Q, proj1_sig in nmaj. + rewrite Qred_correct in nmaj. ring_simplify in nmaj. discriminate. Qed. diff --git a/theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v b/theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v index fa24bd988e..f4daedcb97 100644 --- a/theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v +++ b/theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v @@ -11,480 +11,448 @@ (* The multiplication and division of Cauchy reals. *) -Require Import QArith. -Require Import Qabs. -Require Import Qround. +Require Import QArith Qabs Qround. Require Import Logic.ConstructiveEpsilon. Require Export ConstructiveCauchyReals. Require CMorphisms. Local Open Scope CReal_scope. -Fixpoint BoundFromZero (qn : nat -> Q) (k : nat) (A : positive) { struct k } - : (forall n:nat, le k n -> Qlt (Qabs (qn n)) (Z.pos A # 1)) - -> { B : positive | forall n:nat, Qlt (Qabs (qn n)) (Z.pos B # 1) }. -Proof. - intro H. destruct k. - - exists A. intros. apply H. apply le_0_n. - - destruct (Qarchimedean (Qabs (qn k))) as [a maj]. - apply (BoundFromZero qn k (Pos.max A a)). - intros n H0. destruct (Nat.le_gt_cases n k). - + pose proof (Nat.le_antisymm n k H1 H0). subst k. - apply (Qlt_le_trans _ (Z.pos a # 1)). apply maj. - unfold Qle; simpl. rewrite Pos.mul_1_r. rewrite Pos.mul_1_r. - apply Pos.le_max_r. - + apply (Qlt_le_trans _ (Z.pos A # 1)). apply H. - apply H1. unfold Qle; simpl. rewrite Pos.mul_1_r. rewrite Pos.mul_1_r. - apply Pos.le_max_l. +Definition QCauchySeq_bound (qn : positive -> Q) (cvmod : positive -> positive) + : positive + := match Qnum (qn (cvmod 1%positive)) with + | Z0 => 1%positive + | Z.pos p => p + 1 + | Z.neg p => p + 1 + end. + +Lemma QCauchySeq_bounded_prop (qn : positive -> Q) + : QCauchySeq qn + -> forall n:positive, Qlt (Qabs (qn n)) (Z.pos (QCauchySeq_bound qn id) # 1). +Proof. + intros H n. unfold QCauchySeq_bound. + assert (1 <= n)%positive as H0. { destruct n; discriminate. } + specialize (H 1%positive (1%positive) n (Pos.le_refl _) H0). + unfold id. + destruct (qn (1%positive)) as [a b]. unfold Qnum. + rewrite Qabs_Qminus in H. + apply (Qplus_lt_l _ _ (-Qabs (a#b))). + apply (Qlt_le_trans _ 1). + exact (Qle_lt_trans _ _ _ (Qabs_triangle_reverse (qn n) (a#b)) H). + assert (forall p : positive, + (1 <= (Z.pos (p + 1) # 1) + - (Z.pos p # b))%Q). + { intro p. unfold Qle, Qopp, Qplus, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_add, Pos.mul_1_l. + apply (Z.add_le_mono_l _ _ (Z.pos p -Z.pos b)). + ring_simplify. apply (Z.le_trans _ (Z.pos p * 1)). + rewrite Z.mul_1_r. apply Z.le_refl. + apply Z.mul_le_mono_nonneg_l. discriminate. destruct b; discriminate. } + destruct a. + - setoid_replace (Qabs (0#b)) with 0%Q. 2: reflexivity. + rewrite Qplus_0_r. apply Qle_refl. + - apply H1. + - apply H1. Qed. -Lemma QCauchySeq_bounded (qn : nat -> Q) (cvmod : positive -> nat) - : QCauchySeq qn cvmod - -> { A : positive | forall n:nat, Qlt (Qabs (qn n)) (Z.pos A # 1) }. +Lemma factorDenom : forall (a:Z) (b d:positive), ((a # (d * b)) == (1#d) * (a#b))%Q. Proof. - intros. remember (Zplus (Qnum (Qabs (qn (cvmod xH)))) 1) as z. - assert (Z.lt 0 z) as zPos. - { subst z. assert (Qle 0 (Qabs (qn (cvmod 1%positive)))). - apply Qabs_nonneg. destruct (Qabs (qn (cvmod 1%positive))). simpl. - unfold Qle in H0. simpl in H0. rewrite Zmult_1_r in H0. - apply (Z.lt_le_trans 0 1). unfold Z.lt. auto. - rewrite <- (Zplus_0_l 1). rewrite Zplus_assoc. apply Zplus_le_compat_r. - rewrite Zplus_0_r. assumption. } - assert { A : positive | forall n:nat, - le (cvmod xH) n -> Qlt ((Qabs (qn n)) * (1#A)) 1 }. - destruct z eqn:des. - - exfalso. apply (Z.lt_irrefl 0). assumption. - - exists p. intros. specialize (H xH (cvmod xH) n (le_refl _) H0). - assert (Qlt (Qabs (qn n)) (Qabs (qn (cvmod 1%positive)) + 1)). - { apply (Qplus_lt_l _ _ (-Qabs (qn (cvmod 1%positive)))). - rewrite <- (Qplus_comm 1). rewrite <- Qplus_assoc. rewrite Qplus_opp_r. - rewrite Qplus_0_r. apply (Qle_lt_trans _ (Qabs (qn n - qn (cvmod 1%positive)))). - apply Qabs_triangle_reverse. rewrite Qabs_Qminus. assumption. } - apply (Qlt_le_trans _ ((Qabs (qn (cvmod 1%positive)) + 1) * (1#p))). - apply Qmult_lt_r. unfold Qlt. simpl. unfold Z.lt. auto. assumption. - unfold Qle. simpl. rewrite Zmult_1_r. rewrite Zmult_1_r. rewrite Zmult_1_r. - rewrite Pos.mul_1_r. rewrite Pos2Z.inj_mul. rewrite Heqz. - destruct (Qabs (qn (cvmod 1%positive))) eqn:desAbs. - rewrite Z.mul_add_distr_l. rewrite Zmult_1_r. - apply Zplus_le_compat_r. rewrite <- (Zmult_1_l (QArith_base.Qnum (Qnum # Qden))). - rewrite Zmult_assoc. apply Zmult_le_compat_r. rewrite Zmult_1_r. - simpl. unfold Z.le. rewrite <- Pos2Z.inj_compare. - unfold Pos.compare. destruct Qden; discriminate. - simpl. assert (Qle 0 (Qnum # Qden)). rewrite <- desAbs. - apply Qabs_nonneg. unfold Qle in H2. simpl in H2. rewrite Zmult_1_r in H2. - assumption. - - exfalso. inversion zPos. - - destruct H0. apply (BoundFromZero _ (cvmod xH) x). intros n H0. - specialize (q n H0). setoid_replace (Z.pos x # 1)%Q with (/(1#x))%Q. - rewrite <- (Qmult_1_l (/(1#x))). apply Qlt_shift_div_l. - reflexivity. apply q. reflexivity. + intros. unfold Qeq. simpl. destruct a; reflexivity. Qed. Lemma CReal_mult_cauchy - : forall (xn yn zn : nat -> Q) (Ay Az : positive) (cvmod : positive -> nat), - QSeqEquiv xn yn cvmod - -> QCauchySeq zn Pos.to_nat - -> (forall n:nat, Qlt (Qabs (yn n)) (Z.pos Ay # 1)) - -> (forall n:nat, Qlt (Qabs (zn n)) (Z.pos Az # 1)) - -> QSeqEquiv (fun n:nat => xn n * zn n) (fun n:nat => yn n * zn n) - (fun p => max (cvmod (2 * (Pos.max Ay Az) * p)%positive) - (Pos.to_nat (2 * (Pos.max Ay Az) * p)%positive)). -Proof. - intros xn yn zn Ay Az cvmod limx limz majy majz. - remember (Pos.mul 2 (Pos.max Ay Az)) as z. - intros k p q H H0. - assert (Pos.to_nat k <> O) as kPos. - { intro absurd. pose proof (Pos2Nat.is_pos k). - rewrite absurd in H1. inversion H1. } - setoid_replace (xn p * zn p - yn q * zn q)%Q - with ((xn p - yn q) * zn p + yn q * (zn p - zn q))%Q. + : forall (x y : CReal) (A : positive), + (forall n : positive, (Qabs (proj1_sig x n) < Z.pos A # 1)%Q) + -> (forall n : positive, (Qabs (proj1_sig y n) < Z.pos A # 1)%Q) + -> QCauchySeq (fun n : positive => proj1_sig x (2 * A * n)%positive + * proj1_sig y (2 * A * n)%positive). +Proof. + intros [xn limx] [yn limy] A. unfold proj1_sig. + intros majx majy k p q H H0. + setoid_replace (xn (2*A*p)%positive * yn (2*A*p)%positive + - xn (2*A*q)%positive * yn (2*A*q)%positive)%Q + with ((xn (2*A*p)%positive - xn (2*A*q)%positive) * yn (2*A*p)%positive + + xn (2*A*q)%positive * (yn (2*A*p)%positive - yn (2*A*q)%positive))%Q. 2: ring. - apply (Qle_lt_trans _ (Qabs ((xn p - yn q) * zn p) - + Qabs (yn q * (zn p - zn q)))). - apply Qabs_triangle. rewrite Qabs_Qmult. rewrite Qabs_Qmult. + apply (Qle_lt_trans _ _ _ (Qabs_triangle _ _)). + rewrite Qabs_Qmult, Qabs_Qmult. setoid_replace (1#k)%Q with ((1#2*k) + (1#2*k))%Q. + 2: rewrite Qinv_plus_distr; reflexivity. apply Qplus_lt_le_compat. - - apply (Qle_lt_trans _ ((1#z * k) * Qabs (zn p)%nat)). - + apply Qmult_le_compat_r. apply Qle_lteq. left. apply limx. - apply (le_trans _ (Init.Nat.max (cvmod (z * k)%positive) (Pos.to_nat (z * k)))). - apply Nat.le_max_l. assumption. - apply (le_trans _ (Init.Nat.max (cvmod (z * k)%positive) (Pos.to_nat (z * k)))). - apply Nat.le_max_l. assumption. apply Qabs_nonneg. - + subst z. rewrite <- (Qmult_1_r (1 # 2 * k)). + - apply (Qle_lt_trans _ ((1#2*A * k) * Qabs (yn (2*A*p)%positive))). + + apply Qmult_le_compat_r. apply Qlt_le_weak. apply limx. + apply Pos.mul_le_mono_l, H. apply Pos.mul_le_mono_l, H0. + apply Qabs_nonneg. + + rewrite <- (Qmult_1_r (1 # 2 * k)). rewrite <- Pos.mul_assoc. rewrite <- (Pos.mul_comm k). rewrite Pos.mul_assoc. rewrite (factorDenom _ _ (2 * k)). rewrite <- Qmult_assoc. - apply Qmult_lt_l. unfold Qlt. simpl. unfold Z.lt. auto. - apply (Qle_lt_trans _ (Qabs (zn p)%nat * (1 # Az))). - rewrite <- (Qmult_comm (1 # Az)). apply Qmult_le_compat_r. - unfold Qle. simpl. rewrite Pos2Z.inj_max. apply Z.le_max_r. - apply Qabs_nonneg. rewrite <- (Qmult_inv_r (1#Az)). + apply Qmult_lt_l. reflexivity. + apply (Qle_lt_trans _ (Qabs (yn (2 * A * p)%positive) * (1 # A))). + rewrite <- (Qmult_comm (1 # A)). apply Qmult_le_compat_r. + unfold Qle. simpl. apply Z.le_refl. + apply Qabs_nonneg. rewrite <- (Qmult_inv_r (1#A)). + 2: intro abs; inversion abs. rewrite Qmult_comm. apply Qmult_lt_l. reflexivity. - setoid_replace (/(1#Az))%Q with (Z.pos Az # 1)%Q. apply majz. - reflexivity. intro abs. inversion abs. - - apply (Qle_trans _ ((1 # z * k) * Qabs (yn q)%nat)). - + rewrite Qmult_comm. apply Qmult_le_compat_r. apply Qle_lteq. - left. apply limz. - apply (le_trans _ (max (cvmod (z * k)%positive) - (Pos.to_nat (z * k)%positive))). - apply Nat.le_max_r. assumption. - apply (le_trans _ (max (cvmod (z * k)%positive) - (Pos.to_nat (z * k)%positive))). - apply Nat.le_max_r. assumption. apply Qabs_nonneg. - + subst z. rewrite <- (Qmult_1_r (1 # 2 * k)). + setoid_replace (/(1#A))%Q with (Z.pos A # 1)%Q. + 2: reflexivity. + apply majy. + - apply (Qle_trans _ ((1 # 2 * A * k) * Qabs (xn (2*A*q)%positive))). + + rewrite Qmult_comm. apply Qmult_le_compat_r. + apply Qlt_le_weak. apply limy. + apply Pos.mul_le_mono_l, H. apply Pos.mul_le_mono_l, H0. + apply Qabs_nonneg. + + rewrite <- (Qmult_1_r (1 # 2 * k)). rewrite <- Pos.mul_assoc. rewrite <- (Pos.mul_comm k). rewrite Pos.mul_assoc. rewrite (factorDenom _ _ (2 * k)). rewrite <- Qmult_assoc. - apply Qle_lteq. left. - apply Qmult_lt_l. unfold Qlt. simpl. unfold Z.lt. auto. - apply (Qle_lt_trans _ (Qabs (yn q)%nat * (1 # Ay))). - rewrite <- (Qmult_comm (1 # Ay)). apply Qmult_le_compat_r. - unfold Qle. simpl. rewrite Pos2Z.inj_max. apply Z.le_max_l. - apply Qabs_nonneg. rewrite <- (Qmult_inv_r (1#Ay)). + apply Qlt_le_weak. + apply Qmult_lt_l. reflexivity. + apply (Qle_lt_trans _ (Qabs (xn (2 * A * q)%positive) * (1 # A))). + rewrite <- (Qmult_comm (1 # A)). apply Qmult_le_compat_r. + apply Qle_refl. + apply Qabs_nonneg. rewrite <- (Qmult_inv_r (1#A)). + 2: intro abs; inversion abs. rewrite Qmult_comm. apply Qmult_lt_l. reflexivity. - setoid_replace (/(1#Ay))%Q with (Z.pos Ay # 1)%Q. apply majy. - reflexivity. intro abs. inversion abs. - - rewrite Qinv_plus_distr. unfold Qeq. reflexivity. -Qed. - -Lemma linear_max : forall (p Ax Ay : positive) (i : nat), - le (Pos.to_nat p) i - -> (Init.Nat.max (Pos.to_nat (2 * Pos.max Ax Ay * p)) - (Pos.to_nat (2 * Pos.max Ax Ay * p)) <= Pos.to_nat (2 * Pos.max Ax Ay) * i)%nat. -Proof. - intros. rewrite max_l. 2: apply le_refl. - rewrite Pos2Nat.inj_mul. apply Nat.mul_le_mono_nonneg. - apply le_0_n. apply le_refl. apply le_0_n. apply H. + setoid_replace (/(1#A))%Q with (Z.pos A # 1)%Q. 2: reflexivity. + apply majx. Qed. Definition CReal_mult (x y : CReal) : CReal. Proof. - destruct x as [xn limx]. destruct y as [yn limy]. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - pose proof (CReal_mult_cauchy xn xn yn Ax Ay Pos.to_nat limx limy majx majy). - exists (fun n : nat => xn (Pos.to_nat (2 * Pos.max Ax Ay)* n)%nat - * yn (Pos.to_nat (2 * Pos.max Ax Ay) * n)%nat). - intros p n k H0 H1. - apply H; apply linear_max; assumption. + exists (fun n : positive => proj1_sig x ((2 * Pos.max (QCauchySeq_bound (proj1_sig x) id) (QCauchySeq_bound (proj1_sig y) id)) * n)%positive + * proj1_sig y ((2 * Pos.max (QCauchySeq_bound (proj1_sig x) id) + (QCauchySeq_bound (proj1_sig y) id)) * n)%positive). + apply (CReal_mult_cauchy x y). + - intro n. destruct x as [xn caux]. unfold proj1_sig. + pose proof (QCauchySeq_bounded_prop xn caux). + apply (Qlt_le_trans _ (Z.pos (QCauchySeq_bound xn id) # 1)). + apply H. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_max. apply Z.le_max_l. + - intro n. destruct y as [yn cauy]. unfold proj1_sig. + pose proof (QCauchySeq_bounded_prop yn cauy). + apply (Qlt_le_trans _ (Z.pos (QCauchySeq_bound yn id) # 1)). + apply H. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_max. apply Z.le_max_r. Defined. Infix "*" := CReal_mult : CReal_scope. -Lemma CReal_mult_unfold : forall x y : CReal, - QSeqEquivEx (proj1_sig (CReal_mult x y)) - (fun n : nat => proj1_sig x n * proj1_sig y n)%Q. +Lemma CReal_mult_comm : forall x y : CReal, x * y == y * x. Proof. - intros [xn limx] [yn limy]. unfold CReal_mult ; simpl. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - simpl. - pose proof (CReal_mult_cauchy xn xn yn Ax Ay Pos.to_nat limx limy majx majy). - exists (fun p : positive => - Init.Nat.max (Pos.to_nat (2 * Pos.max Ax Ay * p)) - (Pos.to_nat (2 * Pos.max Ax Ay * p))). - intros p n k H0 H1. rewrite max_l in H0, H1. - 2: apply le_refl. 2: apply le_refl. - apply H. apply linear_max. - apply (le_trans _ (Pos.to_nat (2 * Pos.max Ax Ay * p))). - rewrite <- (mult_1_l (Pos.to_nat p)). rewrite Pos2Nat.inj_mul. - apply Nat.mul_le_mono_nonneg. auto. apply Pos2Nat.is_pos. - apply le_0_n. apply le_refl. apply H0. rewrite max_l. - apply H1. apply le_refl. + 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, proj1_sig. + destruct x as [xn limx], y as [yn limy]. + rewrite Pos.max_comm, Qmult_comm. ring_simplify. discriminate. } + split; apply H. Qed. -Lemma CReal_mult_assoc_bounded_r : forall (xn yn zn : nat -> Q), - QSeqEquivEx xn yn (* both are Cauchy with same limit *) - -> QSeqEquiv zn zn Pos.to_nat - -> QSeqEquivEx (fun n => xn n * zn n)%Q (fun n => yn n * zn n)%Q. +Lemma CReal_mult_proper_0_l : forall x y : CReal, + y == 0 -> x * y == 0. Proof. - intros. destruct H as [cvmod cveq]. - destruct (QCauchySeq_bounded yn (fun k => cvmod (2 * k)%positive) - (QSeqEquiv_cau_r xn yn cvmod cveq)) - as [Ay majy]. - destruct (QCauchySeq_bounded zn Pos.to_nat H0) as [Az majz]. - exists (fun p => max (cvmod (2 * (Pos.max Ay Az) * p)%positive) - (Pos.to_nat (2 * (Pos.max Ay Az) * p)%positive)). - apply CReal_mult_cauchy; assumption. + assert (forall a:Q, a-0 == a)%Q as Qmin0. + { intros. ring. } + intros. apply CRealEq_diff. intros n. + destruct x as [xn limx], y as [yn limy]. + unfold CReal_mult, proj1_sig, inject_Q. + rewrite CRealEq_diff in H; unfold proj1_sig, inject_Q in H. + specialize (H (2 * Pos.max (QCauchySeq_bound xn id) + (QCauchySeq_bound yn id) * n))%positive. + rewrite Qmin0 in H. rewrite Qmin0, Qabs_Qmult, Qmult_comm. + apply (Qle_trans + _ ((2 # (2 * Pos.max (QCauchySeq_bound xn id) (QCauchySeq_bound yn id) * n)%positive) * + (Qabs (xn (2 * Pos.max (QCauchySeq_bound xn id) (QCauchySeq_bound yn id) * n)%positive) ))). + apply Qmult_le_compat_r. + 2: apply Qabs_nonneg. exact H. clear H. rewrite Qmult_comm. + apply (Qle_trans _ ((Z.pos (QCauchySeq_bound xn id) # 1) + * (2 # (2 * Pos.max (QCauchySeq_bound xn id) (QCauchySeq_bound yn id) * n)%positive))). + apply Qmult_le_compat_r. + apply Qlt_le_weak, (QCauchySeq_bounded_prop xn limx). + discriminate. + unfold Qle, Qmult, Qnum, Qden. + rewrite Pos.mul_1_l. rewrite <- (Z.mul_comm 2), <- Z.mul_assoc. + apply Z.mul_le_mono_nonneg_l. discriminate. + rewrite <- Pos2Z.inj_mul. apply Pos2Z.pos_le_pos, Pos.mul_le_mono_r. + apply (Pos.le_trans _ (2 * QCauchySeq_bound xn id)). + apply (Pos.le_trans _ (1 * QCauchySeq_bound xn id)). + apply Pos.le_refl. apply Pos.mul_le_mono_r. discriminate. + apply Pos.mul_le_mono_l. apply Pos.le_max_l. Qed. -Lemma CReal_mult_assoc : forall x y z : CReal, - CRealEq (CReal_mult (CReal_mult x y) z) - (CReal_mult x (CReal_mult y z)). +Lemma CReal_mult_0_r : forall r, r * 0 == 0. Proof. - intros. apply CRealEq_diff. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n * proj1_sig y n * proj1_sig z n)%Q). - - apply (QSeqEquivEx_trans _ (fun n => proj1_sig (CReal_mult x y) n * proj1_sig z n)%Q). - apply CReal_mult_unfold. - destruct x as [xn limx], y as [yn limy], z as [zn limz]; unfold CReal_mult; simpl. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - destruct (QCauchySeq_bounded zn Pos.to_nat limz) as [Az majz]. - apply CReal_mult_assoc_bounded_r. 2: apply limz. - simpl. - pose proof (CReal_mult_cauchy xn xn yn Ax Ay Pos.to_nat limx limy majx majy). - exists (fun p : positive => - Init.Nat.max (Pos.to_nat (2 * Pos.max Ax Ay * p)) - (Pos.to_nat (2 * Pos.max Ax Ay * p))). - intros p n k H0 H1. rewrite max_l in H0, H1. - 2: apply le_refl. 2: apply le_refl. - apply H. apply linear_max. - apply (le_trans _ (Pos.to_nat (2 * Pos.max Ax Ay * p))). - rewrite <- (mult_1_l (Pos.to_nat p)). rewrite Pos2Nat.inj_mul. - apply Nat.mul_le_mono_nonneg. auto. apply Pos2Nat.is_pos. - apply le_0_n. apply le_refl. apply H0. rewrite max_l. - apply H1. apply le_refl. - - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n * proj1_sig (CReal_mult y z) n)%Q). - 2: apply QSeqEquivEx_sym; apply CReal_mult_unfold. - destruct x as [xn limx], y as [yn limy], z as [zn limz]; unfold CReal_mult; simpl. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - destruct (QCauchySeq_bounded zn Pos.to_nat limz) as [Az majz]. - simpl. - pose proof (CReal_mult_assoc_bounded_r (fun n0 : nat => yn n0 * zn n0)%Q (fun n : nat => - yn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat - * zn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat)%Q xn) - as [cvmod cveq]. - - pose proof (CReal_mult_cauchy yn yn zn Ay Az Pos.to_nat limy limz majy majz). - exists (fun p : positive => - Init.Nat.max (Pos.to_nat (2 * Pos.max Ay Az * p)) - (Pos.to_nat (2 * Pos.max Ay Az * p))). - intros p n k H0 H1. rewrite max_l in H0, H1. - 2: apply le_refl. 2: apply le_refl. - apply H. rewrite max_l. apply H0. apply le_refl. - apply linear_max. - apply (le_trans _ (Pos.to_nat (2 * Pos.max Ay Az * p))). - rewrite <- (mult_1_l (Pos.to_nat p)). rewrite Pos2Nat.inj_mul. - apply Nat.mul_le_mono_nonneg. auto. apply Pos2Nat.is_pos. - apply le_0_n. apply le_refl. apply H1. - apply limx. - exists cvmod. intros p k n H1 H2. specialize (cveq p k n H1 H2). - setoid_replace (xn k * yn k * zn k - - xn n * - (yn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat * - zn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat))%Q - with ((fun n : nat => yn n * zn n * xn n) k - - (fun n : nat => - yn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat * - zn (Pos.to_nat (Pos.max Ay Az)~0 * n)%nat * - xn n) n)%Q. - apply cveq. ring. + intros. apply CReal_mult_proper_0_l. reflexivity. Qed. -Lemma CReal_mult_comm : forall x y : CReal, - CRealEq (CReal_mult x y) (CReal_mult y x). +Lemma CReal_mult_0_l : forall r, 0 * r == 0. Proof. - intros. apply CRealEq_diff. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig y n * proj1_sig x n)%Q). - destruct x as [xn limx], y as [yn limy]; simpl. - 2: apply QSeqEquivEx_sym; apply CReal_mult_unfold. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]; simpl. - apply QSeqEquivEx_sym. - - pose proof (CReal_mult_cauchy yn yn xn Ay Ax Pos.to_nat limy limx majy majx). - exists (fun p : positive => - Init.Nat.max (Pos.to_nat (2 * Pos.max Ay Ax * p)) - (Pos.to_nat (2 * Pos.max Ay Ax * p))). - intros p n k H0 H1. rewrite max_l in H0, H1. - 2: apply le_refl. 2: apply le_refl. - rewrite (Qmult_comm (xn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat)). - apply (H p n). rewrite max_l. apply H0. apply le_refl. - rewrite max_l. apply (le_trans _ k). apply H1. - rewrite <- (mult_1_l k). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. rewrite mult_1_r. - apply Pos2Nat.is_pos. apply le_0_n. apply le_refl. - apply le_refl. + intros. rewrite CReal_mult_comm. apply CReal_mult_0_r. Qed. -Lemma CReal_mult_proper_l : forall x y z : CReal, - CRealEq y z -> CRealEq (CReal_mult x y) (CReal_mult x z). -Proof. - intros. apply CRealEq_diff. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n * proj1_sig y n)%Q). - apply CReal_mult_unfold. - rewrite CRealEq_diff in H. rewrite <- CRealEq_modindep in H. - apply QSeqEquivEx_sym. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n * proj1_sig z n)%Q). - apply CReal_mult_unfold. - destruct x as [xn limx], y as [yn limy], z as [zn limz]; simpl. - destruct H. simpl in H. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded zn Pos.to_nat limz) as [Az majz]. - pose proof (CReal_mult_cauchy yn zn xn Az Ax x H limx majz majx). - apply QSeqEquivEx_sym. - exists (fun p : positive => - Init.Nat.max (x (2 * Pos.max Az Ax * p)%positive) - (Pos.to_nat (2 * Pos.max Az Ax * p))). - intros p n k H1 H2. specialize (H0 p n k H1 H2). - setoid_replace (xn n * yn n - xn k * zn k)%Q - with (yn n * xn n - zn k * xn k)%Q. - apply H0. ring. +Lemma CRealLt_0_aboveSig : forall (x : CReal) (n : positive), + Qlt (2 # n) (proj1_sig x n) + -> forall p:positive, + Pos.le n p -> Qlt (1 # n) (proj1_sig x p). +Proof. + intros. destruct x as [xn caux]. + unfold proj1_sig. unfold proj1_sig in H. + specialize (caux n n p (Pos.le_refl n) H0). + apply (Qplus_lt_l _ _ (xn n-xn p)). + apply (Qlt_trans _ ((1#n) + (1#n))). + apply Qplus_lt_r. exact (Qle_lt_trans _ _ _ (Qle_Qabs _) caux). + rewrite Qinv_plus_distr. ring_simplify. exact H. Qed. -Lemma CReal_mult_lt_0_compat : forall x y : CReal, - CRealLt (inject_Q 0) x - -> CRealLt (inject_Q 0) y - -> CRealLt (inject_Q 0) (CReal_mult x y). +(* Correctness lemma for the Definition CReal_mult_lt_0_compat below. *) +Lemma CReal_mult_lt_0_compat_correct + : forall (x y : CReal) (H : 0 < x) (H0 : 0 < y), + (2 # 2 * proj1_sig H * proj1_sig H0 < + proj1_sig (x * y)%CReal (2 * proj1_sig H * proj1_sig H0)%positive - + proj1_sig (inject_Q 0) (2 * proj1_sig H * proj1_sig H0)%positive)%Q. Proof. - intros. destruct H as [x0 H], H0 as [x1 H0]. - pose proof (CRealLt_aboveSig (inject_Q 0) x x0 H). - pose proof (CRealLt_aboveSig (inject_Q 0) y x1 H0). - destruct x as [xn limx], y as [yn limy]. - simpl in H, H1, H2. simpl. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - destruct (Qarchimedean (/ (xn (Pos.to_nat x0) - 0 - (2 # x0)))). - destruct (Qarchimedean (/ (yn (Pos.to_nat x1) - 0 - (2 # x1)))). - exists (Pos.max x0 x~0 * Pos.max x1 x2~0)%positive. - simpl. unfold Qminus. rewrite Qplus_0_r. - rewrite <- Pos2Nat.inj_mul. - unfold Qminus in H1, H2. - specialize (H1 ((Pos.max Ax Ay)~0 * (Pos.max x0 x~0 * Pos.max x1 x2~0))%positive). - assert (Pos.max x1 x2~0 <= (Pos.max Ax Ay)~0 * (Pos.max x0 x~0 * Pos.max x1 x2~0))%positive. - { apply Pos2Nat.inj_le. - rewrite Pos.mul_assoc. rewrite Pos2Nat.inj_mul. - rewrite <- (mult_1_l (Pos.to_nat (Pos.max x1 x2~0))). - rewrite mult_assoc. apply Nat.mul_le_mono_nonneg. auto. - rewrite mult_1_r. apply Pos2Nat.is_pos. apply le_0_n. - apply le_refl. } - specialize (H2 ((Pos.max Ax Ay)~0 * (Pos.max x0 x~0 * Pos.max x1 x2~0))%positive H3). - rewrite Qplus_0_r in H1, H2. - apply (Qlt_trans _ ((2 # Pos.max x0 x~0) * (2 # Pos.max x1 x2~0))). - unfold Qlt; simpl. assert (forall p : positive, (Z.pos p < Z.pos p~0)%Z). - intro p. rewrite <- (Z.mul_1_l (Z.pos p)). - replace (Z.pos p~0) with (2 * Z.pos p)%Z. apply Z.mul_lt_mono_pos_r. - apply Pos2Z.is_pos. reflexivity. reflexivity. - apply H4. - apply (Qlt_trans _ ((2 # Pos.max x0 x~0) * (yn (Pos.to_nat ((Pos.max Ax Ay)~0 * (Pos.max x0 x~0 * Pos.max x1 x2~0)))))). - apply Qmult_lt_l. reflexivity. apply H2. apply Qmult_lt_r. - apply (Qlt_trans 0 (2 # Pos.max x1 x2~0)). reflexivity. apply H2. - apply H1. rewrite Pos.mul_comm. apply Pos2Nat.inj_le. - rewrite <- Pos.mul_assoc. rewrite Pos2Nat.inj_mul. - rewrite <- (mult_1_r (Pos.to_nat (Pos.max x0 x~0))). - rewrite <- mult_assoc. apply Nat.mul_le_mono_nonneg. - apply le_0_n. apply le_refl. auto. - rewrite mult_1_l. apply Pos2Nat.is_pos. + intros. + destruct H as [x0 H], H0 as [x1 H0]. unfold proj1_sig. + unfold inject_Q, proj1_sig, Qminus in H. rewrite Qplus_0_r in H. + pose proof (CRealLt_0_aboveSig x x0 H) as H1. + unfold inject_Q, proj1_sig, Qminus in H0. rewrite Qplus_0_r in H0. + pose proof (CRealLt_0_aboveSig y x1 H0) as H2. + destruct x as [xn limx], y as [yn limy]; simpl in H, H1, H2, H0. + unfold CReal_mult, inject_Q, proj1_sig. + remember (QCauchySeq_bound xn id) as Ax. + remember (QCauchySeq_bound yn id) as Ay. + unfold Qminus. rewrite Qplus_0_r. + specialize (H2 (2 * (Pos.max Ax Ay) * (2 * x0 * x1))%positive). + setoid_replace (2 # 2 * x0 * x1)%Q with ((1#x0) * (1#x1))%Q. + assert (x0 <= 2 * Pos.max Ax Ay * (2 * x0 * x1))%positive. + { apply (Pos.le_trans _ (2 * Pos.max Ax Ay * x0)). + apply belowMultiple. apply Pos.mul_le_mono_l. + rewrite (Pos.mul_comm 2 x0), <- Pos.mul_assoc, Pos.mul_comm. + apply belowMultiple. } + apply (Qlt_trans _ (xn (2 * Pos.max Ax Ay * (2 * x0 * x1))%positive * (1#x1))). + - apply Qmult_lt_compat_r. reflexivity. apply H1, H3. + - apply Qmult_lt_l. + apply (Qlt_trans _ (1#x0)). reflexivity. apply H1, H3. + apply H2. apply (Pos.le_trans _ (2 * Pos.max Ax Ay * x1)). + apply belowMultiple. apply Pos.mul_le_mono_l. apply belowMultiple. + - unfold Qeq, Qmult, Qnum, Qden. + rewrite Z.mul_1_l, <- Pos2Z.inj_mul. reflexivity. +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 H H0 => exist _ (2 * proj1_sig H * proj1_sig H0)%positive + (CReal_mult_lt_0_compat_correct + x y H H0). + +Lemma CReal_mult_bound_indep + : forall (x y : CReal) (A : positive) + (xbound : forall n : positive, (Qabs (proj1_sig x n) < Z.pos A # 1)%Q) + (ybound : forall n : positive, (Qabs (proj1_sig y n) < Z.pos A # 1)%Q), + x * y == exist _ + (fun n : positive => proj1_sig x (2 * A * n)%positive + * proj1_sig y (2 * A * n)%positive)%Q + (CReal_mult_cauchy x y A xbound ybound). +Proof. + intros. apply CRealEq_diff. + pose proof (CReal_mult_cauchy x y) as xycau. intro n. + destruct x as [xn caux], y as [yn cauy]; + unfold CReal_mult, CReal_plus, proj1_sig; unfold proj1_sig in xycau. + pose proof (xycau A xbound ybound). + remember (QCauchySeq_bound xn id) as Ax. + remember (QCauchySeq_bound yn id) as Ay. + remember (Pos.max Ax Ay) as B. + setoid_replace (xn (2*B*n)%positive * yn (2*B*n)%positive + - xn (2*A*n)%positive * yn (2*A*n)%positive)%Q + with ((xn (2*B*n)%positive - xn (2*A*n)%positive) * yn (2*B*n)%positive + + xn (2*A*n)%positive * (yn (2*B*n)%positive - yn (2*A*n)%positive))%Q. + 2: ring. + apply (Qle_trans _ _ _ (Qabs_triangle _ _)). + rewrite Qabs_Qmult, Qabs_Qmult. + setoid_replace (2#n)%Q with ((1#n) + (1#n))%Q. + 2: rewrite Qinv_plus_distr; reflexivity. + apply Qplus_le_compat. + - apply (Qle_trans _ ((1#2*Pos.min A B * n) * Qabs (yn (2*B*n)%positive))). + + apply Qmult_le_compat_r. apply Qlt_le_weak. apply caux. + apply Pos.mul_le_mono_r, Pos.mul_le_mono_l, Pos.le_min_r. + apply Pos.mul_le_mono_r, Pos.mul_le_mono_l, Pos.le_min_l. + apply Qabs_nonneg. + + unfold proj1_sig in ybound. clear xbound. + apply (Qmult_le_l _ _ (Z.pos (2*Pos.min A B *n) # 1)). + reflexivity. rewrite Qmult_assoc. + setoid_replace ((Z.pos (2 * Pos.min A B * n) # 1) * (1 # 2 * Pos.min A B * n))%Q + with 1%Q. + rewrite Qmult_1_l. + setoid_replace ((Z.pos (2 * Pos.min A B * n) # 1) * (1 # n))%Q + with (Z.pos (2 * Pos.min A B) # 1)%Q. + apply (Qle_trans _ (Z.pos (Pos.min A B) # 1)). + destruct (Pos.lt_total A B). rewrite Pos.min_l. + apply Qlt_le_weak, ybound. apply Pos.lt_le_incl, H0. + destruct H0. rewrite Pos.min_l. + apply Qlt_le_weak, ybound. rewrite H0. apply Pos.le_refl. + rewrite Pos.min_r. subst B. apply (Qle_trans _ (Z.pos Ay #1)). subst Ay. + apply Qlt_le_weak, (QCauchySeq_bounded_prop yn cauy). + unfold Qle, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_max. apply Z.le_max_r. + apply Pos.lt_le_incl, H0. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply belowMultiple. + unfold Qeq, Qmult, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_mul. reflexivity. + unfold Qeq, Qmult, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_mul. reflexivity. + - rewrite Qmult_comm. + apply (Qle_trans _ ((1#2*Pos.min A B * n) * Qabs (xn (2*A*n)%positive))). + + apply Qmult_le_compat_r. apply Qlt_le_weak. apply cauy. + apply Pos.mul_le_mono_r, Pos.mul_le_mono_l, Pos.le_min_r. + apply Pos.mul_le_mono_r, Pos.mul_le_mono_l, Pos.le_min_l. + apply Qabs_nonneg. + + unfold proj1_sig in xbound. clear ybound. + apply (Qmult_le_l _ _ (Z.pos (2*Pos.min A B *n) # 1)). + reflexivity. rewrite Qmult_assoc. + setoid_replace ((Z.pos (2 * Pos.min A B * n) # 1) * (1 # 2 * Pos.min A B * n))%Q + with 1%Q. + rewrite Qmult_1_l. + setoid_replace ((Z.pos (2 * Pos.min A B * n) # 1) * (1 # n))%Q + with (Z.pos (2 * Pos.min A B) # 1)%Q. + apply (Qle_trans _ (Z.pos (Pos.min A B) # 1)). + destruct (Pos.lt_total A B). rewrite Pos.min_l. + apply Qlt_le_weak, xbound. apply Pos.lt_le_incl, H0. + destruct H0. rewrite Pos.min_l. + apply Qlt_le_weak, xbound. rewrite H0. apply Pos.le_refl. + rewrite Pos.min_r. subst B. apply (Qle_trans _ (Z.pos Ax #1)). subst Ax. + apply Qlt_le_weak, (QCauchySeq_bounded_prop xn caux). + unfold Qle, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_max. apply Z.le_max_l. + apply Pos.lt_le_incl, H0. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply belowMultiple. + unfold Qeq, Qmult, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_mul. reflexivity. + unfold Qeq, Qmult, Qnum, Qden. + rewrite Z.mul_1_r, Z.mul_1_r, Pos2Z.inj_mul. reflexivity. Qed. 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. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n - * (proj1_sig (CReal_plus y z) n))%Q). - apply CReal_mult_unfold. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig (CReal_mult x y) n - + proj1_sig (CReal_mult x z) n))%Q. - 2: apply QSeqEquivEx_sym; exists (fun p => Pos.to_nat (2 * p)) - ; apply CReal_plus_unfold. - apply (QSeqEquivEx_trans _ (fun n => proj1_sig x n - * (proj1_sig y n + proj1_sig z n))%Q). - - pose proof (CReal_plus_unfold y z). - destruct x as [xn limx], y as [yn limy], z as [zn limz]; simpl; simpl in H. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - destruct (QCauchySeq_bounded zn Pos.to_nat limz) as [Az majz]. - pose proof (CReal_mult_cauchy (fun n => yn (n + (n + 0))%nat + zn (n + (n + 0))%nat)%Q - (fun n => yn n + zn n)%Q - xn (Ay + Az) Ax - (fun p => Pos.to_nat (2 * p)) H limx). - exists (fun p : positive => (Pos.to_nat (2 * (2 * Pos.max (Ay + Az) Ax * p)))). - intros p n k H1 H2. - setoid_replace (xn n * (yn (n + (n + 0))%nat + zn (n + (n + 0))%nat) - xn k * (yn k + zn k))%Q - with ((yn (n + (n + 0))%nat + zn (n + (n + 0))%nat) * xn n - (yn k + zn k) * xn k)%Q. - 2: ring. - assert (Pos.to_nat (2 * Pos.max (Ay + Az) Ax * p) <= - Pos.to_nat 2 * Pos.to_nat (2 * Pos.max (Ay + Az) Ax * p))%nat. - { rewrite (Pos2Nat.inj_mul 2). - rewrite <- (mult_1_l (Pos.to_nat (2 * Pos.max (Ay + Az) Ax * p))). - rewrite mult_assoc. apply Nat.mul_le_mono_nonneg. auto. - simpl. auto. apply le_0_n. apply le_refl. } - apply H0. intro n0. apply (Qle_lt_trans _ (Qabs (yn n0) + Qabs (zn n0))). - apply Qabs_triangle. rewrite Pos2Z.inj_add. - rewrite <- Qinv_plus_distr. apply Qplus_lt_le_compat. - apply majy. apply Qlt_le_weak. apply majz. - apply majx. rewrite max_l. - apply H1. rewrite (Pos2Nat.inj_mul 2). apply H3. - rewrite max_l. apply H2. rewrite (Pos2Nat.inj_mul 2). - apply H3. - - destruct x as [xn limx], y as [yn limy], z as [zn limz]; simpl. - destruct (QCauchySeq_bounded xn Pos.to_nat limx) as [Ax majx]. - destruct (QCauchySeq_bounded yn Pos.to_nat limy) as [Ay majy]. - destruct (QCauchySeq_bounded zn Pos.to_nat limz) as [Az majz]. - simpl. - exists (fun p : positive => (Pos.to_nat (2 * (Pos.max (Pos.max Ax Ay) Az) * (2 * p)))). - intros p n k H H0. - setoid_replace (xn n * (yn n + zn n) - - (xn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat * - yn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat + - xn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat * - zn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat))%Q - with (xn n * yn n - (xn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat * - yn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat) - + (xn n * zn n - xn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat * - zn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat))%Q. - 2: ring. - apply (Qle_lt_trans _ (Qabs (xn n * yn n - (xn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat * - yn (Pos.to_nat (Pos.max Ax Ay)~0 * k)%nat)) - + Qabs (xn n * zn n - xn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat * - zn (Pos.to_nat (Pos.max Ax Az)~0 * k)%nat))). - apply Qabs_triangle. - setoid_replace (1#p)%Q with ((1#2*p) + (1#2*p))%Q. - apply Qplus_lt_le_compat. - + pose proof (CReal_mult_cauchy xn xn yn Ax Ay Pos.to_nat limx limy). - apply H1. apply majx. apply majy. rewrite max_l. - apply (le_trans _ (Pos.to_nat (2 * Pos.max (Pos.max Ax Ay) Az * (2 * p)))). - rewrite (Pos.mul_comm 2). rewrite <- Pos.mul_assoc. - rewrite <- (Pos.mul_comm (Pos.max (Pos.max Ax Ay) Az)). - rewrite <- Pos.mul_assoc. - rewrite Pos2Nat.inj_mul. - rewrite (Pos2Nat.inj_mul (Pos.max (Pos.max Ax Ay) Az)). - apply Nat.mul_le_mono_nonneg. apply le_0_n. - apply Pos2Nat.inj_le. apply Pos.le_max_l. - apply le_0_n. apply le_refl. apply H. apply le_refl. - rewrite max_l. apply (le_trans _ k). - apply (le_trans _ (Pos.to_nat (2 * Pos.max (Pos.max Ax Ay) Az * (2 * p)))). - rewrite (Pos.mul_comm 2). rewrite <- Pos.mul_assoc. - rewrite <- (Pos.mul_comm (Pos.max (Pos.max Ax Ay) Az)). - rewrite <- Pos.mul_assoc. - rewrite Pos2Nat.inj_mul. - rewrite (Pos2Nat.inj_mul (Pos.max (Pos.max Ax Ay) Az)). - apply Nat.mul_le_mono_nonneg. apply le_0_n. - apply Pos2Nat.inj_le. apply Pos.le_max_l. - apply le_0_n. apply le_refl. apply H0. - rewrite <- (mult_1_l k). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. - rewrite mult_1_r. apply Pos2Nat.is_pos. apply le_0_n. - apply le_refl. apply le_refl. - + apply Qlt_le_weak. - pose proof (CReal_mult_cauchy xn xn zn Ax Az Pos.to_nat limx limz). - apply H1. apply majx. apply majz. rewrite max_l. 2: apply le_refl. - apply (le_trans _ (Pos.to_nat (2 * Pos.max (Pos.max Ax Ay) Az * (2 * p)))). - rewrite (Pos.mul_comm 2). rewrite <- Pos.mul_assoc. - rewrite <- (Pos.mul_comm (Pos.max (Pos.max Ax Ay) Az)). - rewrite <- Pos.mul_assoc. - rewrite Pos2Nat.inj_mul. - rewrite (Pos2Nat.inj_mul (Pos.max (Pos.max Ax Ay) Az)). - apply Nat.mul_le_mono_nonneg. apply le_0_n. - rewrite <- Pos.max_assoc. rewrite (Pos.max_comm Ay Az). - rewrite Pos.max_assoc. apply Pos2Nat.inj_le. apply Pos.le_max_l. - apply le_0_n. apply le_refl. apply H. - rewrite max_l. apply (le_trans _ k). - apply (le_trans _ (Pos.to_nat (2 * Pos.max (Pos.max Ax Ay) Az * (2 * p)))). - rewrite (Pos.mul_comm 2). rewrite <- Pos.mul_assoc. - rewrite <- (Pos.mul_comm (Pos.max (Pos.max Ax Ay) Az)). - rewrite <- Pos.mul_assoc. - rewrite Pos2Nat.inj_mul. - rewrite (Pos2Nat.inj_mul (Pos.max (Pos.max Ax Ay) Az)). - apply Nat.mul_le_mono_nonneg. apply le_0_n. - rewrite <- Pos.max_assoc. rewrite (Pos.max_comm Ay Az). - rewrite Pos.max_assoc. apply Pos2Nat.inj_le. apply Pos.le_max_l. - apply le_0_n. apply le_refl. apply H0. - rewrite <- (mult_1_l k). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. - rewrite mult_1_r. apply Pos2Nat.is_pos. apply le_0_n. - apply le_refl. apply le_refl. - + rewrite Qinv_plus_distr. unfold Qeq. reflexivity. + (* Use same bound, max of the 3 bounds for every product. *) + intros x y z. + remember (QCauchySeq_bound (proj1_sig x) id) as Ax. + remember (QCauchySeq_bound (proj1_sig y) id) as Ay. + remember (QCauchySeq_bound (proj1_sig z) id) as Az. + pose (Pos.max Ax (Pos.add Ay Az)) as B. + assert (forall n : positive, (Qabs (proj1_sig x n) < Z.pos B # 1)%Q) as xbound. + { intro n. subst B. apply (Qlt_le_trans _ (Z.pos Ax #1)). + rewrite HeqAx. + apply (QCauchySeq_bounded_prop (proj1_sig x)). + destruct x. exact q. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply Pos.le_max_l. } + assert (forall n : positive, (Qlt (Qabs (proj1_sig (y+z) n)) (Z.pos B # 1))) + as sumbound. + { intro n. destruct y as [yn cauy], z as [zn cauz]. + unfold CReal_plus, proj1_sig. rewrite Qred_correct. + subst B. apply (Qlt_le_trans _ ((Z.pos Ay#1) + (Z.pos Az#1))). + apply (Qle_lt_trans _ _ _ (Qabs_triangle _ _)). + apply Qplus_lt_le_compat. rewrite HeqAy. + unfold proj1_sig. apply (QCauchySeq_bounded_prop yn cauy). + rewrite HeqAz. + unfold proj1_sig. apply Qlt_le_weak, (QCauchySeq_bounded_prop zn cauz). + unfold Qplus, Qle, Qnum, Qden. + apply Pos2Z.pos_le_pos. simpl. repeat rewrite Pos.mul_1_r. + apply Pos.le_max_r. } + rewrite (CReal_mult_bound_indep x (y+z) B xbound sumbound). + assert (forall n : positive, (Qabs (proj1_sig y n) < Z.pos B # 1)%Q) as ybound. + { intro n. subst B. apply (Qlt_le_trans _ (Z.pos Ay #1)). + rewrite HeqAy. + apply (QCauchySeq_bounded_prop (proj1_sig y)). + destruct y; exact q. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (Ay + Az)). + apply Pos2Nat.inj_le. rewrite <- (Nat.add_0_r (Pos.to_nat Ay)). + rewrite Pos2Nat.inj_add. apply Nat.add_le_mono_l, le_0_n. + apply Pos.le_max_r. } + rewrite (CReal_mult_bound_indep x y B xbound ybound). + assert (forall n : positive, (Qabs (proj1_sig z n) < Z.pos B # 1)%Q) as zbound. + { intro n. subst B. apply (Qlt_le_trans _ (Z.pos Az #1)). + rewrite HeqAz. + apply (QCauchySeq_bounded_prop (proj1_sig z)). + destruct z; exact q. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (Ay + Az)). + apply Pos2Nat.inj_le. rewrite <- (Nat.add_0_l (Pos.to_nat Az)). + rewrite Pos2Nat.inj_add. apply Nat.add_le_mono_r, le_0_n. + apply Pos.le_max_r. } + rewrite (CReal_mult_bound_indep x z B xbound zbound). + apply CRealEq_diff. + pose proof (CReal_mult_cauchy x y) as xycau. intro n. + destruct x as [xn caux], y as [yn cauy], z as [zn cauz]; + unfold CReal_mult, CReal_plus, proj1_sig; unfold proj1_sig in xycau. + rewrite Qred_correct, Qred_correct. + assert (forall a b c d e : Q, + c * (d + e) - (a+b) == c*d-a + (c*e-b))%Q. + { intros. ring. } + rewrite H. clear H. + setoid_replace (2#n)%Q with ((1#n) + (1#n))%Q. + 2: rewrite Qinv_plus_distr; reflexivity. + apply (Qle_trans _ _ _ (Qabs_triangle _ _)). + apply Qplus_le_compat. + - rewrite Qabs_Qminus. + replace (2 * B * (2 * n))%positive with (2 * (2 * B * n))%positive. + setoid_replace (xn (2 * (2 * B * n))%positive * yn (2 * (2 * B * n))%positive - + xn (2 * B * n)%positive * yn (2 * (2 * B * n))%positive)%Q + with ((xn (2 * (2 * B * n))%positive - xn (2 * B * n)%positive) + * yn (2 * (2 * B * n))%positive)%Q. + 2: ring. rewrite Qabs_Qmult. + apply (Qle_trans _ ((1 # 2*B*n) * Qabs (yn (2 * (2 * B * n))%positive))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply Qlt_le_weak, caux. apply belowMultiple. apply Pos.le_refl. + apply (Qmult_le_l _ _ (Z.pos (2* B *n) # 1)). + reflexivity. rewrite Qmult_assoc. + setoid_replace ((Z.pos (2 * B * n) # 1) * (1 # 2 * B * n))%Q + with 1%Q. + rewrite Qmult_1_l. + setoid_replace ((Z.pos (2 * B * n) # 1) * (1 # n))%Q + with (Z.pos (2 * B) # 1)%Q. + apply (Qle_trans _ (Z.pos B # 1)). + apply Qlt_le_weak, ybound. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply belowMultiple. + unfold Qeq, Qmult, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_mul. reflexivity. + unfold Qeq, Qmult, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_mul. reflexivity. + rewrite <- (Pos.mul_assoc 2 B (2*n)%positive). + apply f_equal. rewrite Pos.mul_assoc, (Pos.mul_comm 2 B). reflexivity. + - rewrite Qabs_Qminus. + replace (2 * B * (2 * n))%positive with (2 * (2 * B * n))%positive. + setoid_replace (xn (2 * (2 * B * n))%positive * zn (2 * (2 * B * n))%positive - + xn (2 * B * n)%positive * zn (2 * (2 * B * n))%positive)%Q + with ((xn (2 * (2 * B * n))%positive - xn (2 * B * n)%positive) + * zn (2 * (2 * B * n))%positive)%Q. + 2: ring. rewrite Qabs_Qmult. + apply (Qle_trans _ ((1 # 2*B*n) * Qabs (zn (2 * (2 * B * n))%positive))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply Qlt_le_weak, caux. apply belowMultiple. apply Pos.le_refl. + apply (Qmult_le_l _ _ (Z.pos (2* B *n) # 1)). + reflexivity. rewrite Qmult_assoc. + setoid_replace ((Z.pos (2 * B * n) # 1) * (1 # 2 * B * n))%Q + with 1%Q. + rewrite Qmult_1_l. + setoid_replace ((Z.pos (2 * B * n) # 1) * (1 # n))%Q + with (Z.pos (2 * B) # 1)%Q. + apply (Qle_trans _ (Z.pos B # 1)). + apply Qlt_le_weak, zbound. + unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply belowMultiple. + unfold Qeq, Qmult, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_mul. reflexivity. + unfold Qeq, Qmult, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + rewrite Pos2Z.inj_mul. reflexivity. + rewrite <- (Pos.mul_assoc 2 B (2*n)%positive). + apply f_equal. rewrite Pos.mul_assoc, (Pos.mul_comm 2 B). reflexivity. Qed. Lemma CReal_mult_plus_distr_r : forall r1 r2 r3 : CReal, @@ -496,38 +464,213 @@ Proof. 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. + remember (QCauchySeq_bound (proj1_sig x) id) as Ax. + remember (QCauchySeq_bound (proj1_sig y) id) as Ay. + remember (QCauchySeq_bound (proj1_sig z) id) as Az. + pose (Pos.add (Ax * Ay) (Ay * Az)) as B. + assert (forall n : positive, (Qabs (proj1_sig x n) < Z.pos B # 1)%Q) as xbound. + { intro n. + destruct x as [xn limx]; unfold CReal_mult, proj1_sig. + apply (Qlt_le_trans _ (Z.pos Ax#1)). + rewrite HeqAx. + apply (QCauchySeq_bounded_prop xn limx). + subst B. unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (Ax*Ay)). + rewrite Pos.mul_comm. apply belowMultiple. + apply Pos.lt_le_incl, Pos.lt_add_r. } + assert (forall n : positive, (Qabs (proj1_sig y n) < Z.pos B # 1)%Q) as ybound. + { intro n. + destruct y as [xn limx]; unfold CReal_mult, proj1_sig. + apply (Qlt_le_trans _ (Z.pos Ay#1)). + rewrite HeqAy. + apply (QCauchySeq_bounded_prop xn limx). + subst B. unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (Ax*Ay)). + apply belowMultiple. apply Pos.lt_le_incl, Pos.lt_add_r. } + assert (forall n : positive, (Qabs (proj1_sig z n) < Z.pos B # 1)%Q) as zbound. + { intro n. + destruct z as [xn limx]; unfold CReal_mult, proj1_sig. + apply (Qlt_le_trans _ (Z.pos Az#1)). + rewrite HeqAz. + apply (QCauchySeq_bounded_prop xn limx). + subst B. unfold Qle, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. + apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (Ay*Az)). + apply belowMultiple. rewrite Pos.add_comm. + apply Pos.lt_le_incl, Pos.lt_add_r. } + pose (exist (fun x0 : positive -> Q => QCauchySeq x0) + (fun n : positive => + (proj1_sig x (2 * B * n)%positive * proj1_sig y (2 * B * n)%positive)%Q) + (CReal_mult_cauchy x y B xbound ybound)) as xy. + rewrite (CReal_mult_proper_r + z (x*y) xy + (CReal_mult_bound_indep x y B xbound ybound)). + pose (exist (fun x0 : positive -> Q => QCauchySeq x0) + (fun n : positive => + (proj1_sig y (2 * B * n)%positive * proj1_sig z (2 * B * n)%positive)%Q) + (CReal_mult_cauchy y z B ybound zbound)) as yz. + rewrite (CReal_mult_proper_l + x (y*z) yz + (CReal_mult_bound_indep y z B ybound zbound)). + assert (forall n : positive, (Qabs (proj1_sig xy n) < Z.pos B # 1)%Q) as xybound. + { intro n. unfold xy, proj1_sig. clear xy yz. + destruct x as [xn limx], y as [yn limy]; unfold CReal_mult, proj1_sig. + rewrite Qabs_Qmult. + apply (Qle_lt_trans _ ((Z.pos Ax#1) * (Qabs (yn (2 * B * n)%positive)))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + rewrite HeqAx. + apply Qlt_le_weak, (QCauchySeq_bounded_prop xn limx). + rewrite Qmult_comm. + apply (Qle_lt_trans _ ((Z.pos Ay#1) * (Z.pos Ax#1))). + apply Qmult_le_compat_r. 2: discriminate. rewrite HeqAy. + apply Qlt_le_weak, (QCauchySeq_bounded_prop yn limy). + subst B. unfold Qmult, Qlt, Qnum, Qden. + rewrite Pos.mul_1_r, Z.mul_1_r, Z.mul_1_r, <- Pos2Z.inj_mul. + apply Pos2Z.pos_lt_pos. rewrite Pos.mul_comm. apply Pos.lt_add_r. } + rewrite (CReal_mult_bound_indep _ z B xybound zbound). + assert (forall n : positive, (Qabs (proj1_sig yz n) < Z.pos B # 1)%Q) as yzbound. + { intro n. unfold yz, proj1_sig. clear xybound xy yz. + destruct z as [zn limz], y as [yn limy]; unfold CReal_mult, proj1_sig. + rewrite Qabs_Qmult. + apply (Qle_lt_trans _ ((Z.pos Ay#1) * (Qabs (zn (2 * B * n)%positive)))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + rewrite HeqAy. + apply Qlt_le_weak, (QCauchySeq_bounded_prop yn limy). + rewrite Qmult_comm. + apply (Qle_lt_trans _ ((Z.pos Az#1) * (Z.pos Ay#1))). + apply Qmult_le_compat_r. 2: discriminate. rewrite HeqAz. + apply Qlt_le_weak, (QCauchySeq_bounded_prop zn limz). + subst B. unfold Qmult, Qlt, Qnum, Qden. + rewrite Pos.mul_1_r, Z.mul_1_r, Z.mul_1_r, <- Pos2Z.inj_mul. + apply Pos2Z.pos_lt_pos. rewrite Pos.add_comm, Pos.mul_comm. + apply Pos.lt_add_r. } + rewrite (CReal_mult_bound_indep x yz B xbound yzbound). + apply CRealEq_diff. intro n. unfold proj1_sig, xy, yz. + destruct x as [xn limx], y as [yn limy], z as [zn limz]; + unfold CReal_mult, proj1_sig. + clear xybound yzbound xy yz. + assert (forall a b c d e : Q, a*b*c - d*(b*e) == b*(a*c - d*e))%Q. + { intros. ring. } + rewrite H. clear H. rewrite Qabs_Qmult, Qmult_comm. + setoid_replace (xn (2 * B * (2 * B * n))%positive * zn (2 * B * n)%positive - + xn (2 * B * n)%positive * zn (2 * B * (2 * B * n))%positive)%Q + with ((xn (2 * B * (2 * B * n))%positive - xn (2 * B * n)%positive) + * zn (2 * B * n)%positive + + xn (2 * B * n)%positive * + (zn (2*B*n)%positive - zn (2 * B * (2 * B * n))%positive))%Q. + 2: ring. + apply (Qle_trans _ ( (Qabs ((1 # (2 * B * n)) * zn (2 * B * n)%positive) + + Qabs (xn (2 * B * n)%positive * (1 # (2 * B * n)))) + * Qabs (yn (2 * B * (2 * B * n))%positive))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply (Qle_trans _ _ _ (Qabs_triangle _ _)). + apply Qplus_le_compat. + rewrite Qabs_Qmult, Qabs_Qmult. + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply Qlt_le_weak, limx. apply belowMultiple. apply Pos.le_refl. + rewrite Qabs_Qmult, Qabs_Qmult, Qmult_comm, <- (Qmult_comm (Qabs (1 # 2 * B * n))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply Qlt_le_weak, limz. apply Pos.le_refl. apply belowMultiple. + rewrite Qabs_Qmult, Qabs_Qmult. + rewrite (Qmult_comm (Qabs (1 # 2 * B * n))). + rewrite <- Qmult_plus_distr_l. + rewrite (Qabs_pos (1 # 2 * B * n)). 2: discriminate. + rewrite <- (Qmult_comm (1 # 2 * B * n)), <- Qmult_assoc. + apply (Qmult_le_l _ _ (Z.pos (2* B *n) # 1)). + reflexivity. rewrite Qmult_assoc. + setoid_replace ((Z.pos (2 * B * n) # 1) * (1 # 2 * B * n))%Q + with 1%Q. + rewrite Qmult_1_l. + setoid_replace ((Z.pos (2 * B * n) # 1) * (2 # n))%Q + with (Z.pos (2 * 2 * B) # 1)%Q. + apply (Qle_trans _ (((Z.pos Az#1) + (Z.pos Ax#1)) * + Qabs (yn (2 * B * (2 * B * n))%positive))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. + apply Qplus_le_compat. rewrite HeqAz. + apply Qlt_le_weak, (QCauchySeq_bounded_prop zn limz). + rewrite HeqAx. + apply Qlt_le_weak, (QCauchySeq_bounded_prop xn limx). + rewrite Qmult_comm. + apply (Qle_trans _ ((Z.pos Ay#1)* ((Z.pos Az # 1) + (Z.pos Ax # 1)))). + apply Qmult_le_compat_r. + rewrite HeqAy. + apply Qlt_le_weak, (QCauchySeq_bounded_prop yn limy). discriminate. + rewrite Qinv_plus_distr. subst B. + unfold Qle, Qmult, Qplus, Qnum, Qden. + repeat rewrite Pos.mul_1_r. repeat rewrite Z.mul_1_r. + rewrite <- Pos2Z.inj_add, <- Pos2Z.inj_mul. + apply Pos2Z.pos_le_pos. rewrite Pos.mul_add_distr_l. + rewrite Pos.add_comm, Pos.mul_comm. apply belowMultiple. + unfold Qeq, Qmult, Qnum, Qden. + simpl. rewrite Pos.mul_1_r. rewrite Pos.mul_comm. reflexivity. + unfold Qeq, Qmult, Qnum, Qden. + simpl. rewrite Pos.mul_1_r, Pos.mul_1_r. reflexivity. +Qed. + + Lemma CReal_mult_1_l : forall r: CReal, 1 * r == r. Proof. intros [rn limr]. split. - intros [m maj]. simpl in maj. - destruct (QCauchySeq_bounded (fun _ : nat => 1%Q) Pos.to_nat (ConstCauchy 1)). - destruct (QCauchySeq_bounded rn Pos.to_nat limr). - simpl in maj. rewrite Qmult_1_l in maj. + rewrite Qmult_1_l in maj. + pose proof (QCauchySeq_bounded_prop (fun _ : positive => 1%Q) (ConstCauchy 1)). + pose proof (QCauchySeq_bounded_prop rn limr). + remember (QCauchySeq_bound (fun _ : positive => 1%Q) id) as x. + remember (QCauchySeq_bound rn id) as x0. specialize (limr m). apply (Qlt_not_le (2 # m) (1 # m)). - apply (Qlt_trans _ (rn (Pos.to_nat m) - rn (Pos.to_nat (Pos.max x x0)~0 * Pos.to_nat m)%nat)). + apply (Qlt_trans _ (rn m + - rn ((Pos.max x x0)~0 * m)%positive)). apply maj. - apply (Qle_lt_trans _ (Qabs (rn (Pos.to_nat m) - rn (Pos.to_nat (Pos.max x x0)~0 * Pos.to_nat m)%nat))). - apply Qle_Qabs. apply limr. apply le_refl. - rewrite <- (mult_1_l (Pos.to_nat m)). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. rewrite mult_1_r. - apply Pos2Nat.is_pos. apply le_0_n. apply le_refl. + apply (Qle_lt_trans _ (Qabs (rn m - rn ((Pos.max x x0)~0 * m)%positive))). + apply Qle_Qabs. apply limr. apply Pos.le_refl. + rewrite <- (Pos.mul_1_l m). rewrite Pos.mul_assoc. unfold id. + apply Pos.mul_le_mono_r. discriminate. apply Z.mul_le_mono_nonneg. discriminate. discriminate. discriminate. apply Z.le_refl. - intros [m maj]. simpl in maj. - destruct (QCauchySeq_bounded (fun _ : nat => 1%Q) Pos.to_nat (ConstCauchy 1)). - destruct (QCauchySeq_bounded rn Pos.to_nat limr). + pose proof (QCauchySeq_bounded_prop (fun _ : positive => 1%Q) (ConstCauchy 1)). + pose proof (QCauchySeq_bounded_prop rn limr). + remember (QCauchySeq_bound (fun _ : positive => 1%Q) id) as x. + remember (QCauchySeq_bound rn id) as x0. simpl in maj. rewrite Qmult_1_l in maj. specialize (limr m). apply (Qlt_not_le (2 # m) (1 # m)). - apply (Qlt_trans _ (rn (Pos.to_nat (Pos.max x x0)~0 * Pos.to_nat m)%nat - rn (Pos.to_nat m))). + apply (Qlt_trans _ (rn ((Pos.max x x0)~0 * m)%positive - rn m)). apply maj. - apply (Qle_lt_trans _ (Qabs (rn (Pos.to_nat (Pos.max x x0)~0 * Pos.to_nat m)%nat - rn (Pos.to_nat m)))). + apply (Qle_lt_trans _ (Qabs (rn ((Pos.max x x0)~0 * m)%positive - rn m))). apply Qle_Qabs. apply limr. - rewrite <- (mult_1_l (Pos.to_nat m)). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg. auto. rewrite mult_1_r. - apply Pos2Nat.is_pos. apply le_0_n. apply le_refl. - apply le_refl. apply Z.mul_le_mono_nonneg. discriminate. discriminate. + rewrite <- (Pos.mul_1_l m). rewrite Pos.mul_assoc. unfold id. + apply Pos.mul_le_mono_r. discriminate. + apply Pos.le_refl. + apply Z.mul_le_mono_nonneg. discriminate. discriminate. discriminate. apply Z.le_refl. Qed. @@ -613,17 +756,6 @@ Qed. Add Ring CRealRing : CReal_isRing. (**********) -Lemma CReal_mult_0_l : forall r, 0 * r == 0. -Proof. - intro; ring. -Qed. - -Lemma CReal_mult_0_r : forall r, r * 0 == 0. -Proof. - intro; ring. -Qed. - -(**********) Lemma CReal_mult_1_r : forall r, r * 1 == r. Proof. intro; ring. @@ -635,12 +767,6 @@ Proof. intros. ring. Qed. -Lemma CReal_opp_mult_distr_r - : 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. @@ -665,30 +791,30 @@ Qed. Lemma CReal_mult_eq_reg_l : forall (r r1 r2 : CReal), r # 0 - -> CRealEq (CReal_mult r r1) (CReal_mult r r2) - -> CRealEq r1 r2. + -> 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 (CRealLt_irrefl _ abs). apply (CReal_plus_lt_reg_l r). + 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 (CRealLt_irrefl _ abs). apply (CReal_plus_lt_reg_l r). + 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 (CRealLt_irrefl _ abs). exact c. + exact (CRealLe_refl _ abs). exact c. - intro abs. apply (CReal_mult_lt_compat_l r) in abs. rewrite H0 in abs. - exact (CRealLt_irrefl _ abs). exact c. + exact (CRealLe_refl _ abs). exact c. Qed. Lemma CReal_abs_appart_zero : forall (x : CReal) (n : positive), - Qlt (2#n) (Qabs (proj1_sig x (Pos.to_nat n))) + Qlt (2#n) (Qabs (proj1_sig x n)) -> 0 # x. Proof. intros. destruct x as [xn xcau]. simpl in H. - destruct (Qlt_le_dec 0 (xn (Pos.to_nat n))). + destruct (Qlt_le_dec 0 (xn n)). - left. exists n; simpl. rewrite Qabs_pos in H. ring_simplify. exact H. apply Qlt_le_weak. exact q. - right. exists n; simpl. rewrite Qabs_neg in H. @@ -705,39 +831,41 @@ Lemma CRealArchimedean Proof. (* Locate x within 1/4 and pick the first integer above this interval. *) intros [xn limx]. - pose proof (Qlt_floor (xn 4%nat + (1#4))). unfold inject_Z in H. - pose proof (Qfloor_le (xn 4%nat + (1#4))). unfold inject_Z in H0. - remember (Qfloor (xn 4%nat + (1#4)))%Z as n. + pose proof (Qlt_floor (xn 4%positive + (1#4))). unfold inject_Z in H. + pose proof (Qfloor_le (xn 4%positive + (1#4))). unfold inject_Z in H0. + remember (Qfloor (xn 4%positive + (1#4)))%Z as n. exists (n+1)%Z. split. - - assert (Qlt 0 ((n + 1 # 1) - (xn 4%nat + (1 # 4)))) as epsPos. + - assert (Qlt 0 ((n + 1 # 1) - (xn 4%positive + (1 # 4)))) as epsPos. { unfold Qminus. rewrite <- Qlt_minus_iff. exact H. } - destruct (Qarchimedean (/((1#2)*((n + 1 # 1) - (xn 4%nat + (1 # 4)))))) as [k kmaj]. + destruct (Qarchimedean (/((1#2)*((n + 1 # 1) - (xn 4%positive + (1 # 4)))))) as [k kmaj]. exists (Pos.max 4 k). simpl. - apply (Qlt_trans _ ((n + 1 # 1) - (xn 4%nat + (1 # 4)))). + apply (Qlt_trans _ ((n + 1 # 1) - (xn 4%positive + (1 # 4)))). + setoid_replace (Z.pos k # 1)%Q with (/(1#k))%Q in kmaj. 2: reflexivity. rewrite <- Qinv_lt_contravar in kmaj. 2: reflexivity. apply (Qle_lt_trans _ (2#k)). rewrite <- (Qmult_le_l _ _ (1#2)). setoid_replace ((1 # 2) * (2 # k))%Q with (1#k)%Q. 2: reflexivity. - setoid_replace ((1 # 2) * (2 # Pos.max 4 k))%Q with (1#Pos.max 4 k)%Q. 2: reflexivity. + setoid_replace ((1 # 2) * (2 # Pos.max 4 k))%Q with (1#Pos.max 4 k)%Q. + 2: reflexivity. unfold Qle; simpl. apply Pos2Z.pos_le_pos. apply Pos.le_max_r. reflexivity. rewrite <- (Qmult_lt_l _ _ (1#2)). setoid_replace ((1 # 2) * (2 # k))%Q with (1#k)%Q. exact kmaj. reflexivity. reflexivity. rewrite <- (Qmult_0_r (1#2)). rewrite Qmult_lt_l. exact epsPos. reflexivity. - + rewrite <- (Qplus_lt_r _ _ (xn (Pos.to_nat (Pos.max 4 k)) - (n + 1 # 1) + (1#4))). + + rewrite <- (Qplus_lt_r _ _ (xn (Pos.max 4 k) - (n + 1 # 1) + (1#4))). ring_simplify. - apply (Qle_lt_trans _ (Qabs (xn (Pos.to_nat (Pos.max 4 k)) - xn 4%nat))). + apply (Qle_lt_trans _ (Qabs (xn (Pos.max 4 k) - xn 4%positive))). apply Qle_Qabs. apply limx. - rewrite Pos2Nat.inj_max. apply Nat.le_max_l. apply le_refl. + apply Pos.le_max_l. apply Pos.le_refl. - apply (CReal_plus_lt_reg_l (-(2))). ring_simplify. - exists 4%positive. simpl. + exists 4%positive. unfold inject_Q, CReal_minus, CReal_plus, proj1_sig. + rewrite Qred_correct. simpl. rewrite <- Qinv_plus_distr. rewrite <- (Qplus_lt_r _ _ ((n#1) - (1#2))). ring_simplify. - apply (Qle_lt_trans _ (xn 4%nat + (1 # 4)) _ H0). + apply (Qle_lt_trans _ (xn 4%positive + (1 # 4)) _ H0). unfold Pos.to_nat; simpl. - rewrite <- (Qplus_lt_r _ _ (-xn 4%nat)). ring_simplify. + rewrite <- (Qplus_lt_r _ _ (-xn 4%positive)). ring_simplify. reflexivity. Defined. @@ -757,9 +885,10 @@ Lemma CRealLtDisjunctEpsilon : forall a b c d : CReal, (CRealLtProp a b \/ CRealLtProp c d) -> CRealLt a b + CRealLt c d. Proof. intros. + (* Convert to nat to use indefinite description. *) assert (exists n : nat, n <> O /\ - (Qlt (2 # Pos.of_nat n) (proj1_sig b n - proj1_sig a n) - \/ Qlt (2 # Pos.of_nat n) (proj1_sig d n - proj1_sig c n))). + (Qlt (2 # Pos.of_nat n) (proj1_sig b (Pos.of_nat n) - proj1_sig a (Pos.of_nat n)) + \/ Qlt (2 # Pos.of_nat n) (proj1_sig d (Pos.of_nat n) - proj1_sig c (Pos.of_nat n)))). { destruct H. destruct H as [n maj]. exists (Pos.to_nat n). split. intro abs. destruct (Pos2Nat.is_succ n). rewrite H in abs. inversion abs. left. rewrite Pos2Nat.id. apply maj. @@ -769,251 +898,80 @@ Proof. apply constructive_indefinite_ground_description_nat in H0. - destruct H0 as [n [nPos maj]]. destruct (Qlt_le_dec (2 # Pos.of_nat n) - (proj1_sig b n - proj1_sig a n)). - left. exists (Pos.of_nat n). rewrite Nat2Pos.id. apply q. apply nPos. - assert (2 # Pos.of_nat n < proj1_sig d n - proj1_sig c n)%Q. + (proj1_sig b (Pos.of_nat n) - proj1_sig a (Pos.of_nat n))). + left. exists (Pos.of_nat n). apply q. + assert (2 # Pos.of_nat n < proj1_sig d (Pos.of_nat n) - proj1_sig c (Pos.of_nat n))%Q. destruct maj. exfalso. - apply (Qlt_not_le (2 # Pos.of_nat n) (proj1_sig b n - proj1_sig a n)); assumption. - assumption. clear maj. right. exists (Pos.of_nat n). rewrite Nat2Pos.id. - apply H0. apply nPos. + apply (Qlt_not_le (2 # Pos.of_nat n) (proj1_sig b (Pos.of_nat n) - proj1_sig a (Pos.of_nat n))); assumption. + assumption. clear maj. right. exists (Pos.of_nat n). + apply H0. - clear H0. clear H. intro n. destruct n. right. intros [abs _]. exact (abs (eq_refl O)). - destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) (proj1_sig b (S n) - proj1_sig a (S n))). + destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) (proj1_sig b (Pos.of_nat (S n)) - proj1_sig a (Pos.of_nat (S n)))). left. split. discriminate. left. apply q. - destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) (proj1_sig d (S n) - proj1_sig c (S n))). + destruct (Qlt_le_dec (2 # Pos.of_nat (S n)) (proj1_sig d (Pos.of_nat (S n)) - proj1_sig c (Pos.of_nat (S n)))). left. split. discriminate. right. apply q0. right. intros [_ [abs|abs]]. apply (Qlt_not_le (2 # Pos.of_nat (S n)) - (proj1_sig b (S n) - proj1_sig a (S n))); assumption. + (proj1_sig b (Pos.of_nat (S n)) - proj1_sig a (Pos.of_nat (S n)))); assumption. apply (Qlt_not_le (2 # Pos.of_nat (S n)) - (proj1_sig d (S n) - proj1_sig c (S n))); assumption. -Qed. - -Lemma CRealShiftReal : forall (x : CReal) (k : nat), - QCauchySeq (fun n => proj1_sig x (plus n k)) Pos.to_nat. -Proof. - intros x k n p q H H0. - destruct x as [xn cau]; unfold proj1_sig. - destruct k. rewrite plus_0_r. rewrite plus_0_r. apply cau; assumption. - specialize (cau (n + Pos.of_nat (S k))%positive (p + S k)%nat (q + S k)%nat). - apply (Qlt_trans _ (1 # n + Pos.of_nat (S k))). - apply cau. rewrite Pos2Nat.inj_add. rewrite Nat2Pos.id. - apply Nat.add_le_mono_r. apply H. discriminate. - rewrite Pos2Nat.inj_add. rewrite Nat2Pos.id. - apply Nat.add_le_mono_r. apply H0. discriminate. - apply Pos2Nat.inj_lt; simpl. rewrite Pos2Nat.inj_add. - rewrite <- (plus_0_r (Pos.to_nat n)). rewrite <- plus_assoc. - apply Nat.add_lt_mono_l. apply Pos2Nat.is_pos. -Qed. - -Lemma CRealShiftEqual : forall (x : CReal) (k : nat), - CRealEq x (exist _ (fun n => proj1_sig x (plus n k)) (CRealShiftReal x k)). -Proof. - intros. split. - - intros [n maj]. destruct x as [xn cau]; simpl in maj. - specialize (cau n (Pos.to_nat n + k)%nat (Pos.to_nat n)). - apply Qlt_not_le in maj. apply maj. clear maj. - apply (Qle_trans _ (Qabs (xn (Pos.to_nat n + k)%nat - xn (Pos.to_nat n)))). - apply Qle_Qabs. apply (Qle_trans _ (1#n)). apply Zlt_le_weak. - apply cau. rewrite <- (plus_0_r (Pos.to_nat n)). - rewrite <- plus_assoc. apply Nat.add_le_mono_l. apply le_0_n. - apply le_refl. apply Z.mul_le_mono_pos_r. apply Pos2Z.is_pos. - discriminate. - - intros [n maj]. destruct x as [xn cau]; simpl in maj. - specialize (cau n (Pos.to_nat n) (Pos.to_nat n + k)%nat). - apply Qlt_not_le in maj. apply maj. clear maj. - apply (Qle_trans _ (Qabs (xn (Pos.to_nat n) - xn (Pos.to_nat n + k)%nat))). - apply Qle_Qabs. apply (Qle_trans _ (1#n)). apply Zlt_le_weak. - apply cau. apply le_refl. rewrite <- (plus_0_r (Pos.to_nat n)). - rewrite <- plus_assoc. apply Nat.add_le_mono_l. apply le_0_n. - apply Z.mul_le_mono_pos_r. apply Pos2Z.is_pos. discriminate. -Qed. - -(* Find an equal negative real number, which rational sequence - stays below 0, so that it can be inversed. *) -Definition CRealNegShift (x : CReal) - : CRealLt x (inject_Q 0) - -> { y : prod positive CReal | CRealEq x (snd y) - /\ forall n:nat, Qlt (proj1_sig (snd y) n) (-1 # fst y) }. -Proof. - intro xNeg. - pose proof (CRealLt_aboveSig x (inject_Q 0)). - pose proof (CRealShiftReal x). - pose proof (CRealShiftEqual x). - destruct xNeg as [n maj], x as [xn cau]; simpl in maj. - specialize (H n maj); simpl in H. - destruct (Qarchimedean (/ (0 - xn (Pos.to_nat n) - (2 # n)))) as [a _]. - remember (Pos.max n a~0) as k. - clear Heqk. clear maj. clear n. - exists (pair k - (exist _ (fun n => xn (plus n (Pos.to_nat k))) (H0 (Pos.to_nat k)))). - split. apply H1. intro n. simpl. apply Qlt_minus_iff. - destruct n. - - specialize (H k). - unfold Qminus in H. rewrite Qplus_0_l in H. apply Qlt_minus_iff in H. - unfold Qminus. rewrite Qplus_comm. - apply (Qlt_trans _ (- xn (Pos.to_nat k)%nat - (2 #k))). apply H. - unfold Qminus. simpl. apply Qplus_lt_r. - apply Z.mul_lt_mono_pos_r. simpl. apply Pos2Z.is_pos. - reflexivity. apply Pos.le_refl. - - apply (Qlt_trans _ (-(2 # k) - xn (S n + Pos.to_nat k)%nat)). - rewrite <- (Nat2Pos.id (S n)). rewrite <- Pos2Nat.inj_add. - specialize (H (Pos.of_nat (S n) + k)%positive). - unfold Qminus in H. rewrite Qplus_0_l in H. apply Qlt_minus_iff in H. - unfold Qminus. rewrite Qplus_comm. apply H. apply Pos2Nat.inj_le. - rewrite <- (plus_0_l (Pos.to_nat k)). rewrite Pos2Nat.inj_add. - apply Nat.add_le_mono_r. apply le_0_n. discriminate. - apply Qplus_lt_l. - apply Z.mul_lt_mono_pos_r. simpl. apply Pos2Z.is_pos. - reflexivity. + (proj1_sig d (Pos.of_nat (S n)) - proj1_sig c (Pos.of_nat (S n)))); assumption. Qed. -Definition CRealPosShift (x : CReal) - : inject_Q 0 < x - -> { y : prod positive CReal | CRealEq x (snd y) - /\ forall n:nat, Qlt (1 # fst y) (proj1_sig (snd y) n) }. -Proof. - intro xPos. - pose proof (CRealLt_aboveSig (inject_Q 0) x). - pose proof (CRealShiftReal x). - pose proof (CRealShiftEqual x). - destruct xPos as [n maj], x as [xn cau]; simpl in maj. - simpl in H. specialize (H n). - destruct (Qarchimedean (/ (xn (Pos.to_nat n) - 0 - (2 # n)))) as [a _]. - specialize (H maj); simpl in H. - remember (Pos.max n a~0) as k. - clear Heqk. clear maj. clear n. - exists (pair k - (exist _ (fun n => xn (plus n (Pos.to_nat k))) (H0 (Pos.to_nat k)))). - split. apply H1. intro n. simpl. apply Qlt_minus_iff. - destruct n. - - specialize (H k). - unfold Qminus in H. rewrite Qplus_0_r in H. - simpl. rewrite <- Qlt_minus_iff. - apply (Qlt_trans _ (2 #k)). - apply Z.mul_lt_mono_pos_r. simpl. apply Pos2Z.is_pos. - reflexivity. apply H. apply Pos.le_refl. - - rewrite <- Qlt_minus_iff. apply (Qlt_trans _ (2 # k)). - apply Z.mul_lt_mono_pos_r. simpl. apply Pos2Z.is_pos. - reflexivity. specialize (H (Pos.of_nat (S n) + k)%positive). - unfold Qminus in H. rewrite Qplus_0_r in H. - rewrite Pos2Nat.inj_add in H. rewrite Nat2Pos.id in H. - apply H. apply Pos2Nat.inj_le. - rewrite <- (plus_0_l (Pos.to_nat k)). rewrite Pos2Nat.inj_add. - apply Nat.add_le_mono_r. apply le_0_n. discriminate. +(* Find a positive index after which the Cauchy sequence proj1_sig x + stays above 0, so that it can be inverted. *) +Lemma CRealPosShift_correct + : forall (x : CReal) (xPos : 0 < x) (n : positive), + Pos.le (proj1_sig xPos) n + -> Qlt (1 # proj1_sig xPos) (proj1_sig x n). +Proof. + intros x xPos p pmaj. + destruct xPos as [n maj]; simpl in maj. + apply (CRealLt_0_aboveSig x n). + unfold proj1_sig in pmaj. + apply (Qlt_le_trans _ _ _ maj). + ring_simplify. apply Qle_refl. apply pmaj. Qed. -Lemma CReal_inv_neg : forall (yn : nat -> Q) (k : positive), - (QCauchySeq yn Pos.to_nat) - -> (forall n : nat, yn n < -1 # k)%Q - -> QCauchySeq (fun n : nat => / yn (Pos.to_nat k ^ 2 * n)%nat) Pos.to_nat. -Proof. - (* Prove the inverse sequence is Cauchy *) - intros yn k cau maj n p q H0 H1. - setoid_replace (/ yn (Pos.to_nat k ^ 2 * p)%nat - - / yn (Pos.to_nat k ^ 2 * q)%nat)%Q - with ((yn (Pos.to_nat k ^ 2 * q)%nat - - yn (Pos.to_nat k ^ 2 * p)%nat) - / (yn (Pos.to_nat k ^ 2 * q)%nat * - yn (Pos.to_nat k ^ 2 * p)%nat)). - + apply (Qle_lt_trans _ (Qabs (yn (Pos.to_nat k ^ 2 * q)%nat - - yn (Pos.to_nat k ^ 2 * p)%nat) +Lemma CReal_inv_pos_cauchy + : forall (x : CReal) (xPos : 0 < x) (k : positive), + (forall n:positive, Pos.le k n -> Qlt (1 # k) (proj1_sig x n)) + -> QCauchySeq (fun n : positive => / proj1_sig x (k ^ 2 * n)%positive). +Proof. + intros [xn xcau] xPos k maj. unfold proj1_sig. + intros n p q H0 H1. + setoid_replace (/ xn (k ^ 2 * p)%positive - / xn (k ^ 2 * q)%positive)%Q + with ((xn (k ^ 2 * q)%positive - + xn (k ^ 2 * p)%positive) + / (xn (k ^ 2 * q)%positive * + xn (k ^ 2 * p)%positive)). + + apply (Qle_lt_trans _ (Qabs (xn (k ^ 2 * q)%positive + - xn (k ^ 2 * p)%positive) / (1 # (k^2)))). assert (1 # k ^ 2 - < Qabs (yn (Pos.to_nat k ^ 2 * q)%nat * yn (Pos.to_nat k ^ 2 * p)%nat))%Q. + < Qabs (xn (k ^ 2 * q)%positive * xn (k ^ 2 * p)%positive))%Q. { rewrite Qabs_Qmult. unfold "^"%positive; simpl. rewrite factorDenom. rewrite Pos.mul_1_r. - apply (Qlt_trans _ ((1#k) * Qabs (yn (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat))). - apply Qmult_lt_l. reflexivity. rewrite Qabs_neg. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat). - apply Qlt_minus_iff in maj. apply Qlt_minus_iff. - rewrite Qplus_comm. setoid_replace (-(1#k))%Q with (-1 # k)%Q. apply maj. - reflexivity. apply (Qle_trans _ (-1 # k)). apply Zlt_le_weak. - apply maj. discriminate. - apply Qmult_lt_r. apply (Qlt_trans 0 (1#k)). reflexivity. - rewrite Qabs_neg. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat). - apply Qlt_minus_iff in maj. apply Qlt_minus_iff. - rewrite Qplus_comm. setoid_replace (-(1#k))%Q with (-1 # k)%Q. apply maj. - reflexivity. apply (Qle_trans _ (-1 # k)). apply Zlt_le_weak. - apply maj. discriminate. - rewrite Qabs_neg. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * q)%nat). - apply Qlt_minus_iff in maj. apply Qlt_minus_iff. - rewrite Qplus_comm. setoid_replace (-(1#k))%Q with (-1 # k)%Q. apply maj. - reflexivity. apply (Qle_trans _ (-1 # k)). apply Zlt_le_weak. - apply maj. discriminate. } - unfold Qdiv. rewrite Qabs_Qmult. rewrite Qabs_Qinv. - rewrite Qmult_comm. rewrite <- (Qmult_comm (/ (1 # k ^ 2))). - apply Qmult_le_compat_r. apply Qlt_le_weak. - rewrite <- Qmult_1_l. apply Qlt_shift_div_r. - apply (Qlt_trans 0 (1 # k ^ 2)). reflexivity. apply H. - rewrite Qmult_comm. apply Qlt_shift_div_l. - reflexivity. rewrite Qmult_1_l. apply H. - apply Qabs_nonneg. simpl in maj. - specialize (cau (n * (k^2))%positive - (Pos.to_nat k ^ 2 * q)%nat - (Pos.to_nat k ^ 2 * p)%nat). - apply Qlt_shift_div_r. reflexivity. - apply (Qlt_le_trans _ (1 # n * k ^ 2)). apply cau. - rewrite Pos2Nat.inj_mul. rewrite mult_comm. - unfold "^"%positive. simpl. rewrite Pos2Nat.inj_mul. - rewrite <- mult_assoc. rewrite <- mult_assoc. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - rewrite (mult_1_r). rewrite Pos.mul_1_r. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - apply (le_trans _ (q+0)). rewrite plus_0_r. assumption. - rewrite plus_0_r. apply le_refl. - rewrite Pos2Nat.inj_mul. rewrite mult_comm. - unfold "^"%positive; simpl. rewrite Pos2Nat.inj_mul. - rewrite <- mult_assoc. rewrite <- mult_assoc. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - rewrite (mult_1_r). rewrite Pos.mul_1_r. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - apply (le_trans _ (p+0)). rewrite plus_0_r. assumption. - rewrite plus_0_r. apply le_refl. - rewrite factorDenom. apply Qle_refl. - + field. split. intro abs. - specialize (maj (Pos.to_nat k ^ 2 * p)%nat). - rewrite abs in maj. inversion maj. - intro abs. - specialize (maj (Pos.to_nat k ^ 2 * q)%nat). - rewrite abs in maj. inversion maj. -Qed. - -Lemma CReal_inv_pos : forall (yn : nat -> Q) (k : positive), - (QCauchySeq yn Pos.to_nat) - -> (forall n : nat, 1 # k < yn n)%Q - -> QCauchySeq (fun n : nat => / yn (Pos.to_nat k ^ 2 * n)%nat) Pos.to_nat. -Proof. - intros yn k cau maj n p q H0 H1. - setoid_replace (/ yn (Pos.to_nat k ^ 2 * p)%nat - - / yn (Pos.to_nat k ^ 2 * q)%nat)%Q - with ((yn (Pos.to_nat k ^ 2 * q)%nat - - yn (Pos.to_nat k ^ 2 * p)%nat) - / (yn (Pos.to_nat k ^ 2 * q)%nat * - yn (Pos.to_nat k ^ 2 * p)%nat)). - + apply (Qle_lt_trans _ (Qabs (yn (Pos.to_nat k ^ 2 * q)%nat - - yn (Pos.to_nat k ^ 2 * p)%nat) - / (1 # (k^2)))). - assert (1 # k ^ 2 - < Qabs (yn (Pos.to_nat k ^ 2 * q)%nat * yn (Pos.to_nat k ^ 2 * p)%nat))%Q. - { rewrite Qabs_Qmult. unfold "^"%positive; simpl. - rewrite factorDenom. rewrite Pos.mul_1_r. - apply (Qlt_trans _ ((1#k) * Qabs (yn (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat))). + apply (Qlt_trans _ ((1#k) * Qabs (xn (k * k * p)%positive))). apply Qmult_lt_l. reflexivity. rewrite Qabs_pos. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat). - apply maj. apply (Qle_trans _ (1 # k)). + specialize (maj (k * k * p)%positive). + apply maj. rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. + apply (Qle_trans _ (1 # k)). discriminate. apply Zlt_le_weak. apply maj. + rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. apply Qmult_lt_r. apply (Qlt_trans 0 (1#k)). reflexivity. rewrite Qabs_pos. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * p)%nat). - apply maj. apply (Qle_trans _ (1 # k)). discriminate. + specialize (maj (k * k * p)%positive). + apply maj. rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. + apply (Qle_trans _ (1 # k)). discriminate. apply Zlt_le_weak. apply maj. + rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. rewrite Qabs_pos. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) * q)%nat). - apply maj. apply (Qle_trans _ (1 # k)). discriminate. - apply Zlt_le_weak. apply maj. } + specialize (maj (k * k * q)%positive). + apply maj. rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. + apply (Qle_trans _ (1 # k)). discriminate. + apply Zlt_le_weak. + apply maj. rewrite Pos.mul_comm, Pos.mul_assoc. apply belowMultiple. } unfold Qdiv. rewrite Qabs_Qmult. rewrite Qabs_Qinv. rewrite Qmult_comm. rewrite <- (Qmult_comm (/ (1 # k ^ 2))). apply Qmult_le_compat_r. apply Qlt_le_weak. @@ -1022,49 +980,47 @@ Proof. rewrite Qmult_comm. apply Qlt_shift_div_l. reflexivity. rewrite Qmult_1_l. apply H. apply Qabs_nonneg. simpl in maj. - specialize (cau (n * (k^2))%positive - (Pos.to_nat k ^ 2 * q)%nat - (Pos.to_nat k ^ 2 * p)%nat). + pose proof (xcau (n * (k^2))%positive + (k ^ 2 * q)%positive + (k ^ 2 * p)%positive). apply Qlt_shift_div_r. reflexivity. - apply (Qlt_le_trans _ (1 # n * k ^ 2)). apply cau. - rewrite Pos2Nat.inj_mul. rewrite mult_comm. - unfold "^"%positive. simpl. rewrite Pos2Nat.inj_mul. - rewrite <- mult_assoc. rewrite <- mult_assoc. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - rewrite (mult_1_r). rewrite Pos.mul_1_r. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - apply (le_trans _ (q+0)). rewrite plus_0_r. assumption. - rewrite plus_0_r. apply le_refl. - rewrite Pos2Nat.inj_mul. rewrite mult_comm. - unfold "^"%positive; simpl. rewrite Pos2Nat.inj_mul. - rewrite <- mult_assoc. rewrite <- mult_assoc. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - rewrite (mult_1_r). rewrite Pos.mul_1_r. - apply Nat.mul_le_mono_nonneg_l. apply le_0_n. - apply (le_trans _ (p+0)). rewrite plus_0_r. assumption. - rewrite plus_0_r. apply le_refl. + apply (Qlt_le_trans _ (1 # n * k ^ 2)). apply xcau. + rewrite Pos.mul_comm. unfold id. + apply Pos.mul_le_mono_l. exact H1. + unfold id. rewrite Pos.mul_comm. + apply Pos.mul_le_mono_l. exact H0. rewrite factorDenom. apply Qle_refl. + field. split. intro abs. - specialize (maj (Pos.to_nat k ^ 2 * p)%nat). - rewrite abs in maj. inversion maj. + specialize (maj (k ^ 2 * p)%positive). + rewrite abs in maj. apply (Qlt_not_le (1#k) 0). + apply maj. unfold "^"%positive; simpl. rewrite <- Pos.mul_assoc. + rewrite Pos.mul_comm. apply belowMultiple. discriminate. intro abs. - specialize (maj (Pos.to_nat k ^ 2 * q)%nat). - rewrite abs in maj. inversion maj. + specialize (maj (k ^ 2 * q)%positive). + rewrite abs in maj. apply (Qlt_not_le (1#k) 0). + apply maj. unfold "^"%positive; simpl. rewrite <- Pos.mul_assoc. + rewrite Pos.mul_comm. apply belowMultiple. discriminate. Qed. -Definition CReal_inv (x : CReal) (xnz : x # 0) : CReal. +Definition CReal_inv_pos (x : CReal) (xPos : 0 < x) : CReal + := exist _ + (fun n : positive => / proj1_sig x (proj1_sig xPos ^ 2 * n)%positive) + (CReal_inv_pos_cauchy + x xPos (proj1_sig xPos) (CRealPosShift_correct x xPos)). + +Definition CReal_neg_lt_pos : forall x : CReal, x < 0 -> 0 < -x. Proof. - destruct xnz as [xNeg | xPos]. - - destruct (CRealNegShift x xNeg) as [[k y] [_ maj]]. - destruct y as [yn cau]; unfold proj1_sig, snd, fst in maj. - exists (fun n => Qinv (yn (mult (Pos.to_nat k^2) n))). - apply (CReal_inv_neg yn). apply cau. apply maj. - - destruct (CRealPosShift x xPos) as [[k y] [_ maj]]. - destruct y as [yn cau]; unfold proj1_sig, snd, fst in maj. - exists (fun n => Qinv (yn (mult (Pos.to_nat k^2) n))). - apply (CReal_inv_pos yn). apply cau. apply maj. + intros x [n nmaj]. exists n. + apply (Qlt_le_trans _ _ _ nmaj). destruct x. simpl. + unfold Qminus. rewrite Qplus_0_l, Qplus_0_r. apply Qle_refl. 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 @@ -1074,148 +1030,101 @@ Proof. intros. unfold CReal_inv. simpl. destruct rnz. - exfalso. apply CRealLt_asym in H. contradiction. - - destruct (CRealPosShift r c) as [[k rpos] [req maj]]. - clear req. destruct rpos as [rn cau]; simpl in maj. + - unfold CReal_inv_pos. + pose proof (CRealPosShift_correct r c) as maj. + destruct r as [xn cau]. unfold CRealLt; simpl. - destruct (Qarchimedean (rn 1%nat)) as [A majA]. + destruct (Qarchimedean (xn 1%positive)) as [A majA]. exists (2 * (A + 1))%positive. unfold Qminus. rewrite Qplus_0_r. - rewrite <- (Qmult_1_l (Qinv (rn (Pos.to_nat k * (Pos.to_nat k * 1) * Pos.to_nat (2 * (A + 1)))%nat))). - apply Qlt_shift_div_l. apply (Qlt_trans 0 (1#k)). reflexivity. - apply maj. rewrite <- (Qmult_inv_r (Z.pos A + 1 # 1)). + rewrite <- (Qmult_1_l (/ xn (proj1_sig c ^ 2 * (2 * (A + 1)))%positive)). + apply Qlt_shift_div_l. apply (Qlt_trans 0 (1# proj1_sig c)). reflexivity. + apply maj. unfold "^"%positive, Pos.iter. + rewrite <- Pos.mul_assoc, Pos.mul_comm. apply belowMultiple. + rewrite <- (Qmult_inv_r (Z.pos A + 1 # 1)). setoid_replace (2 # 2 * (A + 1))%Q with (Qinv (Z.pos A + 1 # 1)). 2: reflexivity. rewrite Qmult_comm. apply Qmult_lt_r. reflexivity. - rewrite mult_1_r. rewrite <- Pos2Nat.inj_mul. rewrite <- Pos2Nat.inj_mul. - rewrite <- (Qplus_lt_l _ _ (- rn 1%nat)). - apply (Qle_lt_trans _ (Qabs (rn (Pos.to_nat (k * k * (2 * (A + 1)))) + - rn 1%nat))). + rewrite <- (Qplus_lt_l _ _ (- xn 1%positive)). + apply (Qle_lt_trans _ (Qabs (xn (proj1_sig c ^ 2 * (2 * (A + 1)))%positive + - xn 1%positive))). apply Qle_Qabs. apply (Qlt_le_trans _ 1). apply cau. - apply Pos2Nat.is_pos. apply le_refl. + apply Pos.le_1_l. apply Pos.le_1_l. rewrite <- Qinv_plus_distr. rewrite <- (Qplus_comm 1). rewrite <- Qplus_0_r. rewrite <- Qplus_assoc. rewrite <- Qplus_assoc. rewrite Qplus_le_r. rewrite Qplus_0_l. apply Qlt_le_weak. apply Qlt_minus_iff in majA. apply majA. intro abs. inversion abs. -Qed. +Defined. -Lemma CReal_linear_shift : forall (x : CReal) (k : nat), - le 1 k -> QCauchySeq (fun n => proj1_sig x (k * n)%nat) Pos.to_nat. +Lemma CReal_linear_shift : forall (x : CReal) (k : positive), + QCauchySeq (fun n => proj1_sig x (k * n)%positive). Proof. - intros [xn limx] k lek p n m H H0. unfold proj1_sig. - apply limx. apply (le_trans _ n). apply H. - rewrite <- (mult_1_l n). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg_r. apply le_0_n. - rewrite mult_1_r. apply lek. apply (le_trans _ m). apply H0. - rewrite <- (mult_1_l m). rewrite mult_assoc. - apply Nat.mul_le_mono_nonneg_r. apply le_0_n. - rewrite mult_1_r. apply lek. + intros [xn limx] k p n m H H0. unfold proj1_sig. + apply limx. apply (Pos.le_trans _ n). apply H. + rewrite <- (Pos.mul_1_l n). rewrite Pos.mul_assoc. + apply Pos.mul_le_mono_r. destruct (k*1)%positive; discriminate. + apply (Pos.le_trans _ (1*m)). exact H0. + apply Pos.mul_le_mono_r. destruct k; discriminate. Qed. -Lemma CReal_linear_shift_eq : forall (x : CReal) (k : nat) (kPos : le 1 k), - CRealEq x - (exist (fun n : nat -> Q => QCauchySeq n Pos.to_nat) - (fun n : nat => proj1_sig x (k * n)%nat) (CReal_linear_shift x k kPos)). +Lemma CReal_linear_shift_eq : forall (x : CReal) (k : positive), + x == + (exist (fun n : positive -> Q => QCauchySeq n) + (fun n : positive => proj1_sig x (k * n)%positive) (CReal_linear_shift x k)). Proof. intros. apply CRealEq_diff. intro n. destruct x as [xn limx]; unfold proj1_sig. - specialize (limx n (Pos.to_nat n) (k * Pos.to_nat n)%nat). + specialize (limx n n (k * n)%positive). apply (Qle_trans _ (1 # n)). apply Qlt_le_weak. apply limx. - apply le_refl. rewrite <- (mult_1_l (Pos.to_nat n)). - rewrite mult_assoc. apply Nat.mul_le_mono_nonneg_r. apply le_0_n. - rewrite mult_1_r. apply kPos. apply Z.mul_le_mono_nonneg_r. - discriminate. discriminate. + apply Pos.le_refl. rewrite <- (Pos.mul_1_l n). + rewrite Pos.mul_assoc. apply Pos.mul_le_mono_r. + destruct (k*1)%positive; discriminate. + apply Z.mul_le_mono_nonneg_r. discriminate. discriminate. +Qed. + +Lemma CReal_inv_l_pos : forall (r:CReal) (rnz : 0 < r), + (CReal_inv_pos r rnz) * r == 1. +Proof. + intros r c. + unfold CReal_inv_pos. + pose proof (CRealPosShift_correct r c) as maj. + rewrite (CReal_mult_proper_l + _ r (exist _ (fun n => proj1_sig r (proj1_sig c ^ 2 * n)%positive) + (CReal_linear_shift r _))). + 2: rewrite <- CReal_linear_shift_eq; apply reflexivity. + apply CRealEq_diff. intro n. + destruct r as [rn limr]. + unfold CReal_mult, inject_Q, proj1_sig. + rewrite Qmult_comm, Qmult_inv_r. + unfold Qminus. rewrite Qplus_opp_r, Qabs_pos. + discriminate. apply Qle_refl. + unfold proj1_sig in maj. + intro abs. + specialize (maj ((let (a, _) := c in a) ^ 2 * + (2 * + Pos.max + (QCauchySeq_bound + (fun n : positive => Qinv (rn ((let (a, _) := c in a) ^ 2 * n))) id) + (QCauchySeq_bound + (fun n : positive => rn ((let (a, _) := c in a) ^ 2 * n)) id) * n))%positive). + simpl in maj. unfold proj1_sig in maj, abs. + rewrite abs in maj. clear abs. + apply (Qlt_not_le (1 # (let (a, _) := c in a)) 0). + apply maj. unfold "^"%positive, Pos.iter. + rewrite <- Pos.mul_assoc, Pos.mul_comm. apply belowMultiple. + discriminate. Qed. Lemma CReal_inv_l : forall (r:CReal) (rnz : r # 0), ((/ r) rnz) * r == 1. Proof. - intros. unfold CReal_inv; simpl. - destruct rnz. - - (* r < 0 *) destruct (CRealNegShift r c) as [[k rneg] [req maj]]. - simpl in req. apply CRealEq_diff. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ - (proj1_sig (CReal_mult ((let - (yn, cau) as s - return ((forall n : nat, proj1_sig s n < -1 # k) -> CReal) := rneg in - fun maj0 : forall n : nat, yn n < -1 # k => - exist (fun x : nat -> Q => QCauchySeq x Pos.to_nat) - (fun n : nat => Qinv (yn (Pos.to_nat k * (Pos.to_nat k * 1) * n))%nat) - (CReal_inv_neg yn k cau maj0)) maj) rneg)))%Q. - + apply CRealEq_modindep. apply CRealEq_diff. - apply CReal_mult_proper_l. apply req. - + assert (le 1 (Pos.to_nat k * (Pos.to_nat k * 1))%nat). rewrite mult_1_r. - rewrite <- Pos2Nat.inj_mul. apply Pos2Nat.is_pos. - apply (QSeqEquivEx_trans _ - (proj1_sig (CReal_mult ((let - (yn, cau) as s - return ((forall n : nat, proj1_sig s n < -1 # k) -> CReal) := rneg in - fun maj0 : forall n : nat, yn n < -1 # k => - exist (fun x : nat -> Q => QCauchySeq x Pos.to_nat) - (fun n : nat => Qinv (yn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat)) - (CReal_inv_neg yn k cau maj0)) maj) - (exist _ (fun n => proj1_sig rneg (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat) (CReal_linear_shift rneg _ H)))))%Q. - apply CRealEq_modindep. apply CRealEq_diff. - apply CReal_mult_proper_l. apply CReal_linear_shift_eq. - destruct r as [rn limr], rneg as [rnn limneg]; simpl. - destruct (QCauchySeq_bounded - (fun n : nat => Qinv (rnn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat)) - Pos.to_nat (CReal_inv_neg rnn k limneg maj)). - destruct (QCauchySeq_bounded - (fun n : nat => rnn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat) - Pos.to_nat - (CReal_linear_shift - (exist (fun x0 : nat -> Q => QCauchySeq x0 Pos.to_nat) rnn limneg) - (Pos.to_nat k * (Pos.to_nat k * 1)) H)) ; simpl. - exists (fun n => 1%nat). intros p n m H0 H1. rewrite Qmult_comm. - rewrite Qmult_inv_r. unfold Qminus. rewrite Qplus_opp_r. - reflexivity. intro abs. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) - * (Pos.to_nat (Pos.max x x0)~0 * n))%nat). - simpl in maj. rewrite abs in maj. inversion maj. - - (* r > 0 *) destruct (CRealPosShift r c) as [[k rneg] [req maj]]. - simpl in req. apply CRealEq_diff. apply CRealEq_modindep. - apply (QSeqEquivEx_trans _ - (proj1_sig (CReal_mult ((let - (yn, cau) as s - return ((forall n : nat, 1 # k < proj1_sig s n) -> CReal) := rneg in - fun maj0 : forall n : nat, 1 # k < yn n => - exist (fun x : nat -> Q => QCauchySeq x Pos.to_nat) - (fun n : nat => Qinv (yn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat)) - (CReal_inv_pos yn k cau maj0)) maj) rneg)))%Q. - + apply CRealEq_modindep. apply CRealEq_diff. - apply CReal_mult_proper_l. apply req. - + assert (le 1 (Pos.to_nat k * (Pos.to_nat k * 1))%nat). rewrite mult_1_r. - rewrite <- Pos2Nat.inj_mul. apply Pos2Nat.is_pos. - apply (QSeqEquivEx_trans _ - (proj1_sig (CReal_mult ((let - (yn, cau) as s - return ((forall n : nat, 1 # k < proj1_sig s n) -> CReal) := rneg in - fun maj0 : forall n : nat, 1 # k < yn n => - exist (fun x : nat -> Q => QCauchySeq x Pos.to_nat) - (fun n : nat => Qinv (yn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat)) - (CReal_inv_pos yn k cau maj0)) maj) - (exist _ (fun n => proj1_sig rneg (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat) (CReal_linear_shift rneg _ H)))))%Q. - apply CRealEq_modindep. apply CRealEq_diff. - apply CReal_mult_proper_l. apply CReal_linear_shift_eq. - destruct r as [rn limr], rneg as [rnn limneg]; simpl. - destruct (QCauchySeq_bounded - (fun n : nat => Qinv (rnn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat)) - Pos.to_nat (CReal_inv_pos rnn k limneg maj)). - destruct (QCauchySeq_bounded - (fun n : nat => rnn (Pos.to_nat k * (Pos.to_nat k * 1) * n)%nat) - Pos.to_nat - (CReal_linear_shift - (exist (fun x0 : nat -> Q => QCauchySeq x0 Pos.to_nat) rnn limneg) - (Pos.to_nat k * (Pos.to_nat k * 1)) H)) ; simpl. - exists (fun n => 1%nat). intros p n m H0 H1. rewrite Qmult_comm. - rewrite Qmult_inv_r. unfold Qminus. rewrite Qplus_opp_r. - reflexivity. intro abs. - specialize (maj (Pos.to_nat k * (Pos.to_nat k * 1) - * (Pos.to_nat (Pos.max x x0)~0 * n))%nat). - simpl in maj. rewrite abs in maj. inversion maj. + 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. + r * ((/ r) rnz) == 1. Proof. intros. rewrite CReal_mult_comm, CReal_inv_l. reflexivity. @@ -1293,12 +1202,13 @@ Proof. apply CRealLt_above in c. destruct c as [i imaj]. simpl in imaj. apply CRealLt_above in c0. destruct c0 as [j jmaj]. simpl in jmaj. pose proof (CReal_abs_appart_zero y). - destruct x as [xn xcau], y as [yn ycau]. simpl in kmaj. - destruct (QCauchySeq_bounded xn Pos.to_nat xcau) as [a amaj], - (QCauchySeq_bounded yn Pos.to_nat ycau) as [b bmaj]; simpl in kmaj. - clear amaj bmaj. simpl in imaj, jmaj. simpl in H0. + destruct x as [xn xcau], y as [yn ycau]. + unfold CReal_mult, proj1_sig in kmaj. + remember (QCauchySeq_bound xn id) as a. + remember (QCauchySeq_bound yn id) as b. + simpl in imaj, jmaj. simpl in H0. specialize (kmaj (Pos.max k (Pos.max i j)) (Pos.le_max_l _ _)). - destruct (H0 ((Pos.max a b)~0 * (Pos.max k (Pos.max i j)))%positive). + destruct (H0 (2*(Pos.max a b) * (Pos.max k (Pos.max i j)))%positive). - apply (Qlt_trans _ (2#k)). + unfold Qlt. rewrite <- Z.mul_lt_mono_pos_l. 2: reflexivity. unfold Qden. apply Pos2Z.pos_lt_pos. @@ -1309,31 +1219,28 @@ Proof. fold (2*Pos.max a b)%positive. rewrite Pos2Nat.inj_mul. apply Nat.lt_1_mul_pos. auto. apply Pos2Nat.is_pos. + apply (Qlt_le_trans _ _ _ kmaj). unfold Qminus. rewrite Qplus_0_r. - rewrite <- (Qmult_1_l (Qabs (yn (Pos.to_nat ((Pos.max a b)~0 * Pos.max k (Pos.max i j)))))). + rewrite <- (Qmult_1_l (Qabs (yn (2*(Pos.max a b) * Pos.max k (Pos.max i j))%positive))). apply (Qle_trans _ _ _ (Qle_Qabs _)). rewrite Qabs_Qmult. - replace (Pos.to_nat (Pos.max a b)~0 * Pos.to_nat (Pos.max k (Pos.max i j)))%nat - with (Pos.to_nat ((Pos.max a b)~0 * Pos.max k (Pos.max i j))). - 2: apply Pos2Nat.inj_mul. apply Qmult_le_compat_r. 2: apply Qabs_nonneg. apply Qabs_Qle_condition. split. apply Qlt_le_weak. apply Qlt_minus_iff, (Qlt_trans _ (2#j)). reflexivity. apply jmaj. + apply (Pos.le_trans _ (2*j)). apply belowMultiple. + apply Pos.mul_le_mono_l. apply (Pos.le_trans _ (1 * Pos.max k (Pos.max i j))). rewrite Pos.mul_1_l. apply (Pos.le_trans _ (Pos.max i j) _ (Pos.le_max_r _ _)). apply Pos.le_max_r. - apply Pos2Nat.inj_le. do 2 rewrite Pos2Nat.inj_mul. - rewrite <- Nat.mul_le_mono_pos_r. 2: apply Pos2Nat.is_pos. - apply Pos2Nat.is_pos. + rewrite <- Pos.mul_le_mono_r. destruct (Pos.max a b); discriminate. apply Qlt_le_weak. apply Qlt_minus_iff, (Qlt_trans _ (2#i)). reflexivity. apply imaj. + apply (Pos.le_trans _ (2*i)). apply belowMultiple. + apply Pos.mul_le_mono_l. apply (Pos.le_trans _ (1 * Pos.max k (Pos.max i j))). rewrite Pos.mul_1_l. apply (Pos.le_trans _ (Pos.max i j) _ (Pos.le_max_l _ _)). apply Pos.le_max_r. - apply Pos2Nat.inj_le. do 2 rewrite Pos2Nat.inj_mul. - rewrite <- Nat.mul_le_mono_pos_r. 2: apply Pos2Nat.is_pos. - apply Pos2Nat.is_pos. + rewrite <- Pos.mul_le_mono_r. destruct (Pos.max a b); discriminate. - left. apply (CReal_mult_lt_reg_r (exist _ yn ycau) _ _ c). rewrite CReal_mult_0_l. exact H. - right. apply (CReal_mult_lt_reg_r (CReal_opp (exist _ yn ycau))). @@ -1357,16 +1264,14 @@ Proof. Qed. Lemma CReal_invQ : forall (b : positive) (pos : Qlt 0 (Z.pos b # 1)), - CRealEq (CReal_inv (inject_Q (Z.pos b # 1)) (inr (CReal_injectQPos (Z.pos b # 1) pos))) - (inject_Q (1 # b)). + 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; - destruct (QCauchySeq_bounded (fun _ : nat => 1 # b)%Q Pos.to_nat (ConstCauchy (1 # b))), - (QCauchySeq_bounded (fun _ : nat => Z.pos b # 1)%Q Pos.to_nat (ConstCauchy (Z.pos b # 1))); simpl. + apply CRealEq_diff. intro n. simpl. do 2 rewrite Pos.mul_1_r. rewrite Z.pos_sub_diag. discriminate. Qed. @@ -1376,11 +1281,11 @@ Proof. (* Locate a and b at the index given by a<b, and pick the middle rational number. *) intros [p pmaj]. - exists ((proj1_sig a (Pos.to_nat p) + proj1_sig b (Pos.to_nat p)) * (1#2))%Q. + exists ((proj1_sig a p + proj1_sig b p) * (1#2))%Q. split. - apply (CReal_le_lt_trans _ _ _ (inject_Q_compare a p)). apply inject_Q_lt. apply (Qmult_lt_l _ _ 2). reflexivity. - apply (Qplus_lt_l _ _ (-2*proj1_sig a (Pos.to_nat p))). + apply (Qplus_lt_l _ _ (-2*proj1_sig a p)). field_simplify. field_simplify in pmaj. setoid_replace (-2#2)%Q with (-1)%Q. 2: reflexivity. setoid_replace (2*(1#p))%Q with (2#p)%Q. 2: reflexivity. @@ -1388,12 +1293,12 @@ Proof. - apply (CReal_plus_lt_reg_l (-b)). rewrite CReal_plus_opp_l. apply (CReal_plus_lt_reg_r - (-inject_Q ((proj1_sig a (Pos.to_nat p) + proj1_sig b (Pos.to_nat p)) * (1 # 2)))). + (-inject_Q ((proj1_sig a p + proj1_sig b p) * (1 # 2)))). rewrite CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_r, CReal_plus_0_l. rewrite <- opp_inject_Q. apply (CReal_le_lt_trans _ _ _ (inject_Q_compare (-b) p)). apply inject_Q_lt. apply (Qmult_lt_l _ _ 2). reflexivity. - apply (Qplus_lt_l _ _ (2*proj1_sig b (Pos.to_nat p))). + apply (Qplus_lt_l _ _ (2*proj1_sig b p)). destruct b as [bn bcau]; simpl. simpl in pmaj. field_simplify. field_simplify in pmaj. setoid_replace (-2#2)%Q with (-1)%Q. 2: reflexivity. @@ -1405,12 +1310,8 @@ Lemma inject_Q_mult : forall q r : Q, Proof. split. - intros [n maj]. simpl in maj. - destruct (QCauchySeq_bounded (fun _ : nat => q) Pos.to_nat (ConstCauchy q)). - destruct (QCauchySeq_bounded (fun _ : nat => r) Pos.to_nat (ConstCauchy r)). simpl in maj. ring_simplify in maj. discriminate maj. - intros [n maj]. simpl in maj. - destruct (QCauchySeq_bounded (fun _ : nat => q) Pos.to_nat (ConstCauchy q)). - destruct (QCauchySeq_bounded (fun _ : nat => r) Pos.to_nat (ConstCauchy r)). simpl in maj. ring_simplify in maj. discriminate maj. Qed. diff --git a/theories/Reals/Cauchy/ConstructiveRcomplete.v b/theories/Reals/Cauchy/ConstructiveRcomplete.v index 51fd0dd7f9..be844c413a 100644 --- a/theories/Reals/Cauchy/ConstructiveRcomplete.v +++ b/theories/Reals/Cauchy/ConstructiveRcomplete.v @@ -47,44 +47,6 @@ Proof. intros. apply (seq_cv_proper un y). exact H0. symmetry. exact H. Qed. -Lemma growing_transit : forall un : nat -> CReal, - (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 CRealLe_refl. - - intros. apply Nat.le_succ_r in H0. destruct H0. - apply (CReal_le_trans _ (un p)). apply IHp, H0. apply H. - subst n. apply CRealLe_refl. -Qed. - -Lemma growing_infinite : forall un : nat -> nat, - (forall n:nat, lt (un n) (un (S n))) - -> forall n : nat, le n (un n). -Proof. - induction n. - - apply le_0_n. - - specialize (H n). unfold lt in H. - apply (le_trans _ (S (un n))). apply le_n_S, IHn. exact H. -Qed. - -Lemma Un_cv_growing : forall (un : nat -> CReal) (l : CReal), - (forall n:nat, un n <= un (S n)) - -> (forall n:nat, un n <= l) - -> (forall p : positive, { n : nat | l - un n <= inject_Q (1#p) }) - -> seq_cv un l. -Proof. - intros. intro p. - specialize (H1 p) as [n nmaj]. exists n. - intros. rewrite CReal_abs_minus_sym, CReal_abs_right. - apply (CReal_le_trans _ (l - un n)). apply CReal_plus_le_compat_l. - apply CReal_opp_ge_le_contravar. - exact (growing_transit _ H n i H1). exact nmaj. - rewrite <- (CReal_plus_opp_r (un i)). apply CReal_plus_le_compat. - apply H0. apply CRealLe_refl. -Qed. - - (* Sharpen the archimedean property : constructive versions of the usual floor and ceiling functions. *) @@ -157,15 +119,6 @@ Proof. unfold Qeq; simpl. rewrite Pos.mul_1_r, Z.mul_1_r. reflexivity. Qed. -Definition RQ_limit : forall (x : CReal) (n:nat), - { q:Q & x < inject_Q q < x + inject_Q (1 # Pos.of_nat n) }. -Proof. - intros x n. apply (FQ_dense x (x + inject_Q (1 # Pos.of_nat n))). - rewrite <- (CReal_plus_0_r x). rewrite CReal_plus_assoc. - apply CReal_plus_lt_compat_l. rewrite CReal_plus_0_l. apply inject_Q_lt. - reflexivity. -Qed. - Lemma Qabs_Rabs : forall q : Q, inject_Q (Qabs q) == CReal_abs (inject_Q q). Proof. @@ -176,173 +129,86 @@ Proof. apply inject_Q_le, H. Qed. -Definition Un_cauchy_Q (xn : nat -> Q) : Set - := forall n : positive, - { k : nat | forall p q : nat, le k p -> le k q - -> (Qabs (xn p - xn q) <= 1#n)%Q }. - -Lemma CReal_smaller_interval : forall a b c d : CReal, - a <= c -> c <= b - -> a <= d -> d <= b - -> CReal_abs (d - c) <= b-a. -Proof. - intros. apply CReal_abs_le. split. - - apply (CReal_plus_le_reg_l (b+c)). ring_simplify. - apply CReal_plus_le_compat; assumption. - - apply (CReal_plus_le_reg_l (a+c)). ring_simplify. - apply CReal_plus_le_compat; assumption. -Qed. - -Lemma Rdiag_cauchy_sequence : forall (xn : nat -> CReal), - Un_cauchy_mod xn - -> Un_cauchy_Q (fun n:nat => let (l,_) := RQ_limit (xn n) n in l). -Proof. - intros xn H p. specialize (H (2 * p)%positive) as [k cv]. - exists (max k (2 * Pos.to_nat p)). intros. - specialize (cv p0 q - (le_trans _ _ _ (Nat.le_max_l _ _) H) - (le_trans _ _ _ (Nat.le_max_l _ _) H0)). - destruct (RQ_limit (xn p0) p0) as [r rmaj]. - destruct (RQ_limit (xn q) q) as [s smaj]. - apply Qabs_Qle_condition. split. - - apply le_inject_Q. unfold Qminus. - apply (CReal_le_trans _ (xn p0 - (xn q + inject_Q (1 # 2 * p)))). - + unfold CReal_minus. rewrite CReal_opp_plus_distr. - rewrite <- CReal_plus_assoc. - apply (CReal_plus_le_reg_r (xn q - xn p0 - inject_Q (-(1#p)))). - ring_simplify. unfold CReal_minus. do 2 rewrite <- opp_inject_Q. - rewrite <- inject_Q_plus. - setoid_replace (- - (1 # p) + - (1 # 2 * p))%Q with (1 # 2 * p)%Q. - rewrite CReal_abs_minus_sym in cv. - exact (CReal_le_trans _ _ _ (CReal_le_abs _ ) cv). - rewrite Qopp_involutive. - setoid_replace (1#p)%Q with (2 # 2 *p)%Q. rewrite Qinv_minus_distr. - reflexivity. reflexivity. - + rewrite inject_Q_plus. apply CReal_plus_le_compat. - apply CRealLt_asym. - destruct (RQ_limit (xn p0) p0); simpl. apply rmaj. - apply CRealLt_asym. - rewrite opp_inject_Q. apply CReal_opp_gt_lt_contravar. - destruct smaj. apply (CReal_lt_le_trans _ _ _ c0). - apply CReal_plus_le_compat_l. apply inject_Q_le. - apply Z2Nat.inj_le. discriminate. discriminate. - simpl. assert ((Pos.to_nat p~0 <= q)%nat). - { apply (le_trans _ (Init.Nat.max k (2 * Pos.to_nat p))). - 2: apply H0. replace (p~0)%positive with (2*p)%positive. - 2: reflexivity. rewrite Pos2Nat.inj_mul. - apply Nat.le_max_r. } - rewrite Nat2Pos.id. apply H1. intro abs. subst q. - inversion H1. pose proof (Pos2Nat.is_pos (p~0)). - rewrite H3 in H2. inversion H2. - - apply le_inject_Q. unfold Qminus. - apply (CReal_le_trans _ (xn p0 + inject_Q (1 # 2 * p) - xn q)). - + rewrite inject_Q_plus. apply CReal_plus_le_compat. - apply CRealLt_asym. - destruct (RQ_limit (xn p0) p0); unfold proj1_sig. - apply (CReal_lt_le_trans _ (xn p0 + inject_Q (1 # Pos.of_nat p0))). - apply rmaj. apply CReal_plus_le_compat_l. apply inject_Q_le. - apply Z2Nat.inj_le. discriminate. discriminate. - simpl. assert ((Pos.to_nat p~0 <= p0)%nat). - { apply (le_trans _ (Init.Nat.max k (2 * Pos.to_nat p))). - 2: apply H. replace (p~0)%positive with (2*p)%positive. - 2: reflexivity. rewrite Pos2Nat.inj_mul. - apply Nat.le_max_r. } - rewrite Nat2Pos.id. apply H1. intro abs. subst p0. - inversion H1. pose proof (Pos2Nat.is_pos (p~0)). - rewrite H3 in H2. inversion H2. - apply CRealLt_asym. - rewrite opp_inject_Q. apply CReal_opp_gt_lt_contravar. - destruct (RQ_limit (xn q) q); simpl. apply smaj. - + unfold CReal_minus. rewrite (CReal_plus_comm (xn p0)). - rewrite CReal_plus_assoc. - apply (CReal_plus_le_reg_l (- inject_Q (1 # 2 * p))). - rewrite <- CReal_plus_assoc. rewrite CReal_plus_opp_l. rewrite CReal_plus_0_l. - rewrite <- opp_inject_Q. rewrite <- inject_Q_plus. - setoid_replace (- (1 # 2 * p) + (1 # p))%Q with (1 # 2 * p)%Q. - exact (CReal_le_trans _ _ _ (CReal_le_abs _) cv). - rewrite Qplus_comm. - setoid_replace (1#p)%Q with (2 # 2*p)%Q. rewrite Qinv_minus_distr. - reflexivity. reflexivity. -Qed. - -Lemma CReal_absSmall : forall (x y : CReal) (n : positive), - (Qlt (2 # n) - (proj1_sig x (Pos.to_nat n) - Qabs (proj1_sig y (Pos.to_nat n)))) - -> CReal_abs y <= x. -Proof. - intros x y n maj. apply CReal_abs_le. split. - - apply CRealLt_asym. exists n. destruct x as [xn caux], y as [yn cauy]; simpl. - simpl in maj. unfold Qminus. rewrite Qopp_involutive. - rewrite Qplus_comm. - apply (Qlt_le_trans _ (xn (Pos.to_nat n) - Qabs (yn (Pos.to_nat n)))). - apply maj. apply Qplus_le_r. - rewrite <- (Qopp_involutive (yn (Pos.to_nat n))). - apply Qopp_le_compat. rewrite Qabs_opp. apply Qle_Qabs. - - apply CRealLt_asym. exists n. destruct x as [xn caux], y as [yn cauy]; simpl. - simpl in maj. - apply (Qlt_le_trans _ (xn (Pos.to_nat n) - Qabs (yn (Pos.to_nat n)))). - apply maj. apply Qplus_le_r. apply Qopp_le_compat. apply Qle_Qabs. -Qed. - -(* An element of CReal is a Cauchy sequence of rational numbers, - show that it converges to itself in CReal. *) -Lemma CReal_cv_self : forall (qn : nat -> Q) (x : CReal) (cvmod : positive -> nat), - QSeqEquiv qn (fun n => proj1_sig x n) cvmod - -> seq_cv (fun n => inject_Q (qn n)) x. +(* For instance the rational sequence 1/n converges to 0. *) +Lemma CReal_cv_self : forall (x : CReal) (n : positive), + CReal_abs (x - inject_Q (proj1_sig x n)) <= inject_Q (1#n). Proof. - intros qn x cvmod H p. - specialize (H (2*p)%positive). exists (cvmod (2*p)%positive). - intros p0 H0. - apply (CReal_absSmall - _ _ (Pos.max (4 * p)%positive (Pos.of_nat (cvmod (2 * p)%positive)))). - setoid_replace (proj1_sig (inject_Q (1 # p)) (Pos.to_nat (Pos.max (4 * p) (Pos.of_nat (cvmod (2 * p)%positive))))) - with (1 # p)%Q. - 2: reflexivity. - setoid_replace (proj1_sig (CReal_plus (inject_Q (qn p0)) (CReal_opp x)) (Pos.to_nat (Pos.max (4 * p) (Pos.of_nat (cvmod (2 * p)%positive))))) - with (qn p0 - proj1_sig x (2 * (Pos.to_nat (Pos.max (4 * p) (Pos.of_nat (cvmod (2 * p)%positive)))))%nat)%Q. - 2: destruct x; reflexivity. - apply (Qle_lt_trans _ (1 # 2 * p)). - unfold Qle; simpl. rewrite Pos2Z.inj_max. apply Z.le_max_l. - rewrite <- (Qplus_lt_r - _ _ (Qabs - (qn p0 - - proj1_sig x - (2 * Pos.to_nat (Pos.max (4 * p) (Pos.of_nat (cvmod (2 * p)%positive))))%nat) - -(1#2*p))). - ring_simplify. - setoid_replace (-1 * (1 # 2 * p) + (1 # p))%Q with (1 # 2 * p)%Q. - apply H. apply H0. rewrite Pos2Nat.inj_max. - apply (le_trans _ (1 * Nat.max (Pos.to_nat (4 * p)) (Pos.to_nat (Pos.of_nat (cvmod (2 * p)%positive))))). - destruct (cvmod (2*p)%positive). apply le_0_n. rewrite mult_1_l. - rewrite Nat2Pos.id. 2: discriminate. apply Nat.le_max_r. - apply Nat.mul_le_mono_nonneg_r. apply le_0_n. auto. - setoid_replace (1 # p)%Q with (2 # 2 * p)%Q. - rewrite Qplus_comm. rewrite Qinv_minus_distr. - reflexivity. reflexivity. + intros x n [k kmaj]. + destruct x as [xn cau]. + unfold CReal_abs, CReal_minus, CReal_plus, CReal_opp, inject_Q, proj1_sig in kmaj. + apply (Qlt_not_le _ _ kmaj). clear kmaj. + unfold QCauchySeq in cau. + rewrite <- (Qplus_le_l _ _ (1#n)). ring_simplify. unfold id in cau. + destruct (Pos.lt_total (2*k) n). 2: destruct H. + - specialize (cau k (2*k)%positive n). + assert (k <= 2 * k)%positive. + { apply (Pos.le_trans _ (1*k)). apply Pos.le_refl. + apply Pos.mul_le_mono_r. discriminate. } + apply (Qle_trans _ (1#k)). rewrite Qred_correct. apply Qlt_le_weak, cau. + exact H0. apply (Pos.le_trans _ _ _ H0). apply Pos.lt_le_incl, H. + rewrite <- (Qinv_plus_distr 1 1). + apply (Qplus_le_l _ _ (-(1#k))). ring_simplify. discriminate. + - subst n. rewrite Qplus_opp_r. discriminate. + - specialize (cau n (2*k)%positive n). + apply (Qle_trans _ (1#n)). rewrite Qred_correct. apply Qlt_le_weak, cau. + apply Pos.lt_le_incl, H. apply Pos.le_refl. + apply (Qplus_le_l _ _ (-(1#n))). ring_simplify. discriminate. Qed. -(* Q is dense in Archimedean fields, so all real numbers - are limits of rational sequences. - The biggest computable such field has all rational limits. *) -Lemma R_has_all_rational_limits : forall qn : nat -> Q, - Un_cauchy_Q qn - -> { r : CReal & seq_cv (fun n:nat => inject_Q (qn n)) r }. +(* We can probably reduce the factor 4. *) +Lemma Rcauchy_limit : forall (xn : nat -> CReal) (xcau : Un_cauchy_mod xn), + QCauchySeq + (fun n : positive => + let (p, _) := xcau (4 * n)%positive in proj1_sig (xn p) (4 * n)%positive). Proof. - (* qn is an element of CReal. Show that inject_Q qn - converges to it in CReal. *) - intros. - destruct (standard_modulus qn (fun p => proj1_sig (H (Pos.succ p)))). - - intros p n k H0 H1. destruct (H (Pos.succ p)%positive) as [x a]; simpl in H0,H1. - specialize (a n k H0 H1). - apply (Qle_lt_trans _ (1#Pos.succ p) _ a). - apply Pos2Z.pos_lt_pos. simpl. apply Pos.lt_succ_diag_r. - - exists (exist _ (fun n : nat => - qn (increasing_modulus (fun p : positive => proj1_sig (H (Pos.succ p))) n)) H0). - apply (CReal_cv_self qn (exist _ (fun n : nat => - qn (increasing_modulus (fun p : positive => proj1_sig (H (Pos.succ p))) n)) H0) - (fun p : positive => Init.Nat.max (proj1_sig (H (Pos.succ p))) (Pos.to_nat p))). - apply H1. + intros xn xcau n p q H0 H1. + 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 (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, H0. apply le_S, le_S_n in l. + apply (CReal_le_trans _ _ _ (jmaj i j l (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, H1. } + 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 (proj1_sig (xn i) (4 * p)%positive) - xn i) + CReal_abs (xn i - inject_Q(proj1_sig (xn j) (4 * q)%positive)))). + unfold Qminus. + rewrite inject_Q_plus, opp_inject_Q. + setoid_replace (inject_Q (proj1_sig (xn i) (4 * p)%positive) + + - inject_Q (proj1_sig (xn j) (4 * q)%positive)) + with (inject_Q (proj1_sig (xn i) (4 * p)%positive) - xn i + + (xn i - inject_Q (proj1_sig (xn j) (4 * q)%positive))). + 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 H0. + apply (CReal_le_lt_trans + _ (CReal_abs (xn i - xn j + (xn j - inject_Q (proj1_sig (xn j) (4 * q)%positive))))). + 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 H1. Qed. Lemma Rcauchy_complete : forall (xn : nat -> CReal), @@ -350,49 +216,57 @@ Lemma Rcauchy_complete : forall (xn : nat -> CReal), -> { l : CReal & seq_cv xn l }. Proof. intros xn cau. - destruct (R_has_all_rational_limits (fun n => let (l,_) := RQ_limit (xn n) n in l) - (Rdiag_cauchy_sequence xn cau)) - as [l cv]. - exists l. intro p. specialize (cv (2*p)%positive) as [k cv]. - exists (max k (2 * Pos.to_nat p)). intros p0 H. - specialize (cv p0 (le_trans _ _ _ (Nat.le_max_l _ _) H)). - destruct (RQ_limit (xn p0) p0) as [q maj]. - apply CReal_abs_le. split. - - apply (CReal_le_trans _ (inject_Q q - inject_Q (1 # 2 * p) - l)). - + unfold CReal_minus. rewrite (CReal_plus_comm (inject_Q q)). - apply (CReal_plus_le_reg_r (inject_Q (1 # p) + l - inject_Q q)). - ring_simplify. unfold CReal_minus. - rewrite <- (opp_inject_Q (1# 2*p)), <- inject_Q_plus. - setoid_replace ((1 # p) + - (1 # 2* p))%Q with (1#2*p)%Q. - rewrite CReal_abs_minus_sym in cv. - exact (CReal_le_trans _ _ _ (CReal_le_abs _) cv). - setoid_replace (1#p)%Q with (2 # 2*p)%Q. - rewrite Qinv_minus_distr. reflexivity. reflexivity. - + unfold CReal_minus. - do 2 rewrite <- (CReal_plus_comm (-l)). apply CReal_plus_le_compat_l. - apply (CReal_plus_le_reg_r (inject_Q (1 # 2 * p))). - ring_simplify. rewrite CReal_plus_comm. - apply (CReal_le_trans _ (xn p0 + inject_Q (1 # Pos.of_nat p0))). - apply CRealLt_asym, maj. apply CReal_plus_le_compat_l. - apply inject_Q_le. - apply Z2Nat.inj_le. discriminate. discriminate. - simpl. assert ((Pos.to_nat p~0 <= p0)%nat). - { apply (le_trans _ (Init.Nat.max k (2 * Pos.to_nat p))). - 2: apply H. replace (p~0)%positive with (2*p)%positive. - 2: reflexivity. rewrite Pos2Nat.inj_mul. - apply Nat.le_max_r. } - rewrite Nat2Pos.id. apply H0. intro abs. subst p0. - inversion H0. pose proof (Pos2Nat.is_pos (p~0)). - rewrite H2 in H1. inversion H1. - - apply (CReal_le_trans _ (inject_Q q - l)). - + unfold CReal_minus. do 2 rewrite <- (CReal_plus_comm (-l)). - apply CReal_plus_le_compat_l. apply CRealLt_asym, maj. - + apply (CReal_le_trans _ (inject_Q (1 # 2 * p))). - exact (CReal_le_trans _ _ _ (CReal_le_abs _) cv). - apply inject_Q_le. rewrite <- Qplus_0_r. - setoid_replace (1#p)%Q with ((1#2*p)+(1#2*p))%Q. - apply Qplus_le_r. discriminate. - rewrite Qinv_plus_distr. reflexivity. + exists (exist _ (fun n : positive => + let (p, _) := cau (4 * n)%positive in + proj1_sig (xn p) (4 * n)%positive) + (Rcauchy_limit xn cau)). + intro p. + pose proof (CReal_cv_self (exist _ (fun n : positive => + let (p, _) := cau (4 * n)%positive in + proj1_sig (xn p) (4 * n)%positive) + (Rcauchy_limit xn cau)) (2*p)) as H. + unfold proj1_sig in H. + pose proof (cau (2*p)%positive) as [k cv]. + destruct (cau (4 * (2 * p))%positive) as [i imaj]. + (* The convergence modulus does not matter here, because a converging Cauchy + sequence always converges to its limit with twice the Cauchy modulus. *) + exists (max k i). + intros j H0. + setoid_replace (xn j - + exist (fun x : positive -> Q => QCauchySeq x) + (fun n : positive => + let (p0, _) := cau (4 * n)%positive in proj1_sig (xn p0) (4 * n)%positive) + (Rcauchy_limit xn cau)) + with (xn j - inject_Q (proj1_sig (xn i) (p~0~0~0)%positive) + + (inject_Q (proj1_sig (xn i) (p~0~0~0)%positive) - + exist (fun x : positive -> Q => QCauchySeq x) + (fun n : positive => + let (p0, _) := cau (4 * n)%positive in proj1_sig (xn p0) (4 * n)%positive) + (Rcauchy_limit 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. unfold proj1_sig in H. + 2: rewrite CReal_abs_minus_sym; exact H. + specialize (imaj j i (le_trans _ _ _ (Nat.le_max_r _ _) H0) (le_refl _)). + apply (CReal_le_trans _ (inject_Q (1 # 4 * p) + inject_Q (1 # 4 * p))). + setoid_replace (xn j - inject_Q (proj1_sig (xn i) (p~0~0~0)%positive)) + with (xn j - xn i + + (xn i - inject_Q (proj1_sig (xn i) (p~0~0~0)%positive))). + 2: ring. apply (CReal_le_trans _ _ _ (CReal_abs_triang _ _)). + apply CReal_plus_le_compat. apply (CReal_le_trans _ _ _ imaj). + 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 p 4 8). discriminate. + apply (CReal_le_trans _ _ _ (CReal_cv_self (xn i) (8*p))). + 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 p 4 8). discriminate. + 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. diff --git a/theories/Reals/ClassicalDedekindReals.v b/theories/Reals/ClassicalDedekindReals.v index bb1ee93610..21f3a9cfca 100644 --- a/theories/Reals/ClassicalDedekindReals.v +++ b/theories/Reals/ClassicalDedekindReals.v @@ -149,32 +149,31 @@ Definition DRealAbstr : CReal -> DReal. Proof. intro x. assert (forall (q : Q) (n : nat), - {(fun n0 : nat => (proj1_sig x (S n0) <= q + (1 # Pos.of_nat (S n0)))%Q) n} + - {~ (fun n0 : nat => (proj1_sig x (S n0) <= q + (1 # Pos.of_nat (S n0)))%Q) n}). - { intros. destruct (Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (proj1_sig x (S n))). + {(fun n0 : nat => (proj1_sig x (Pos.of_nat (S n0)) <= q + (1 # Pos.of_nat (S n0)))%Q) n} + + {~ (fun n0 : nat => (proj1_sig x (Pos.of_nat (S n0)) <= q + (1 # Pos.of_nat (S n0)))%Q) n}). + { intros. destruct (Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (proj1_sig x (Pos.of_nat (S n)))). right. apply (Qlt_not_le _ _ q0). left. exact q0. } - exists (fun q:Q => if sig_forall_dec (fun n:nat => Qle (proj1_sig x (S n)) (q + (1#Pos.of_nat (S n)))) (H q) + exists (fun q:Q => if sig_forall_dec (fun n:nat => Qle (proj1_sig x (Pos.of_nat (S n))) (q + (1#Pos.of_nat (S n)))) (H q) then true else false). repeat split. - intros. - destruct (sig_forall_dec (fun n : nat => (proj1_sig x (S n) <= q + (1 # Pos.of_nat (S n)))%Q) + destruct (sig_forall_dec (fun n : nat => (proj1_sig x (Pos.of_nat (S n)) <= q + (1 # Pos.of_nat (S n)))%Q) (H q)). reflexivity. exfalso. - destruct (sig_forall_dec (fun n : nat => (proj1_sig x (S n) <= r + (1 # Pos.of_nat (S n)))%Q) + destruct (sig_forall_dec (fun n : nat => (proj1_sig x (Pos.of_nat (S n)) <= r + (1 # Pos.of_nat (S 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 => (proj1_sig x (S n) <= (z+3 # 1) + (1 # Pos.of_nat (S n)))%Q) + destruct (sig_forall_dec (fun n : nat => (proj1_sig x (Pos.of_nat (S n)) <= (z+3 # 1) + (1 # Pos.of_nat (S 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 (Pos.of_nat (S n))). unfold inject_Q, proj1_sig in zmaj. - rewrite Nat2Pos.id in zmaj. 2: discriminate. destruct x as [xn xcau]; unfold proj1_sig. rewrite Qinv_plus_distr in zmaj. apply (Qplus_le_l _ _ (-(z + 2 # 1))). apply (Qle_trans _ _ _ zmaj). @@ -187,7 +186,7 @@ Proof. replace (z + 3 + - (z + 2))%Z with 1%Z. apply Qle_refl. ring. - intro abs. destruct (Rfloor x) as [z [zmaj _]]. specialize (abs (z-4 # 1)%Q). - destruct (sig_forall_dec (fun n : nat => (proj1_sig x (S n) <= (z-4 # 1) + (1 # Pos.of_nat (S n)))%Q) + destruct (sig_forall_dec (fun n : nat => (proj1_sig x (Pos.of_nat (S n)) <= (z-4 # 1) + (1 # Pos.of_nat (S n)))%Q) (H (z-4 # 1)%Q)). exfalso; discriminate. clear abs. apply CRealLt_asym in zmaj. apply zmaj. clear zmaj. @@ -195,30 +194,30 @@ Proof. specialize (q O). destruct x as [xn xcau]; unfold proj1_sig; unfold proj1_sig in q. unfold Pos.of_nat in q. rewrite Qinv_plus_distr in q. - unfold Pos.to_nat; simpl. apply (Qplus_lt_l _ _ (xn 1%nat - 2)). + apply (Qplus_lt_l _ _ (xn 1%positive - 2)). ring_simplify. rewrite Qinv_plus_distr. apply (Qle_lt_trans _ _ _ q). apply Qlt_minus_iff. unfold Qopp, Qnum, Qden. rewrite Qinv_plus_distr. replace (z + -2 + - (z - 4 + 1))%Z with 1%Z. 2: ring. reflexivity. - intros q H0 abs. - destruct (sig_forall_dec (fun n : nat => (proj1_sig x (S n) <= q + (1 # Pos.of_nat (S n)))%Q) (H q)). + destruct (sig_forall_dec (fun n : nat => (proj1_sig x (Pos.of_nat (S n)) <= q + (1 # Pos.of_nat (S n)))%Q) (H q)). 2: exfalso; discriminate. clear H0. destruct x as [xn xcau]; unfold proj1_sig in abs, s. 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 + xn (S n) - (1 # Pos.of_nat (S n))%Q)/2)%Q). + specialize (abs ((q + xn (Pos.of_nat (S n)) - (1 # Pos.of_nat (S n))%Q)/2)%Q). destruct abs. + apply (Qmult_le_r _ _ 2) in H0. field_simplify in H0. apply (Qplus_le_r _ _ ((1 # Pos.of_nat (S n)) - q)) in H0. ring_simplify in H0. apply nmaj. rewrite Qplus_comm. exact H0. reflexivity. + destruct (sig_forall_dec (fun n0 : nat => - (xn (S n0) <= (q + xn (S n) - (1 # Pos.of_nat (S n))) / 2 + (1 # Pos.of_nat (S n0)))%Q) - (H ((q + xn (S n) - (1 # Pos.of_nat (S n))) / 2)%Q)). + (xn (Pos.of_nat (S n0)) <= (q + xn (Pos.of_nat (S n)) - (1 # Pos.of_nat (S n))) / 2 + (1 # Pos.of_nat (S n0)))%Q) + (H ((q + xn (Pos.of_nat (S n)) - (1 # Pos.of_nat (S n))) / 2)%Q)). discriminate. clear H0. specialize (q0 n). apply (Qmult_le_l _ _ 2) in q0. field_simplify in q0. - apply (Qplus_le_l _ _ (-xn (S n))) in q0. ring_simplify in q0. + apply (Qplus_le_l _ _ (-xn (Pos.of_nat (S n)))) in q0. ring_simplify in q0. contradiction. reflexivity. Defined. @@ -234,23 +233,24 @@ Qed. Definition DRealRepr : DReal -> CReal. Proof. - intro x. exists (fun n => proj1_sig (DRealQlim x n)). + intro x. exists (fun n:positive => proj1_sig (DRealQlim x (Pos.to_nat n))). intros n p q H H0. - destruct (DRealQlim x p), (DRealQlim x q); unfold proj1_sig. + destruct (DRealQlim x (Pos.to_nat p)), (DRealQlim x (Pos.to_nat q)) + ; unfold proj1_sig. destruct x as [f low]; unfold proj1_sig in a0, a. apply Qabs_case. - - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (S q))). + - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (S (Pos.to_nat q)))). apply (Qplus_lt_l _ _ x1). ring_simplify. apply (UpperAboveLower f). exact low. apply a. apply a0. 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_trans _ _ _ H0), le_S, le_refl. - discriminate. - - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (S p))). + apply Pos2Nat.inj_le. rewrite Nat2Pos.id. + apply le_S, Pos2Nat.inj_le, H0. discriminate. + - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (S (Pos.to_nat p)))). apply (Qplus_lt_l _ _ x0). ring_simplify. apply (UpperAboveLower f). exact low. apply a0. apply a. 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_trans _ _ _ H), le_S, le_refl. - discriminate. + apply Pos2Nat.inj_le. rewrite Nat2Pos.id. + apply le_S, Pos2Nat.inj_le, H. discriminate. Defined. Definition Rle (x y : DReal) @@ -390,15 +390,15 @@ Qed. Lemma DRealAbstrFalse : forall (x : CReal) (q : Q) (n : nat), proj1_sig (DRealAbstr x) q = false - -> (proj1_sig x (S n) <= q + (1 # Pos.of_nat (S n)))%Q. + -> (proj1_sig x (Pos.of_nat (S n)) <= q + (1 # Pos.of_nat (S n)))%Q. Proof. intros. destruct x as [xn xcau]. unfold DRealAbstr, proj1_sig in H. destruct ( - sig_forall_dec (fun n : nat => (xn (S n) <= q + (1 # Pos.of_nat (S n)))%Q) + sig_forall_dec (fun n : nat => (xn (Pos.of_nat (S n)) <= q + (1 # Pos.of_nat (S n)))%Q) (fun n : nat => - match Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (xn (S n)) with - | left q0 => right (Qlt_not_le (q + (1 # Pos.of_nat (S n))) (xn (S n)) q0) + match Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (xn (Pos.of_nat (S n))) with + | left q0 => right (Qlt_not_le (q + (1 # Pos.of_nat (S n))) (xn (Pos.of_nat (S n))) q0) | right q0 => left q0 end)). discriminate. apply q0. @@ -417,9 +417,10 @@ Proof. unfold proj1_sig in qmaj. rewrite Nat.succ_pred in qmaj. apply (Qlt_not_le _ _ pmaj), (Qplus_le_l _ _ q). - ring_simplify. apply (Qle_trans _ _ _ qmaj). + ring_simplify. rewrite Pos2Nat.id in qmaj. + apply (Qle_trans _ _ _ qmaj). rewrite <- Qplus_assoc. apply Qplus_le_r. - rewrite Pos2Nat.id. apply (Qle_trans _ ((1#p)+(1#p))). + apply (Qle_trans _ ((1#p)+(1#p))). apply Qplus_le_l. unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. @@ -434,30 +435,32 @@ Proof. (* By pmaj, x < q - 1/p *) unfold DRealAbstr, proj1_sig in qmaj. destruct ( - sig_forall_dec (fun n : nat => (xn (S n) <= q + (1 # Pos.of_nat (S n)))%Q) + sig_forall_dec (fun n : nat => (xn (Pos.of_nat (S n)) <= q + (1 # Pos.of_nat (S n)))%Q) (fun n : nat => - match Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (xn (S n)) with + match Qlt_le_dec (q + (1 # Pos.of_nat (S n))) (xn (Pos.of_nat (S n))) with | left q0 => - right (Qlt_not_le (q + (1 # Pos.of_nat (S n))) (xn (S n)) q0) + right (Qlt_not_le (q + (1 # Pos.of_nat (S n))) (xn (Pos.of_nat (S n))) q0) | right q0 => left q0 end)). 2: discriminate. clear qmaj. destruct s as [n nmaj]. apply nmaj. - apply (Qplus_lt_l _ _ (xn (Pos.to_nat p) + (1#Pos.of_nat (S n)))) in pmaj. + apply (Qplus_lt_l _ _ (xn p + (1#Pos.of_nat (S n)))) in pmaj. ring_simplify in pmaj. apply Qlt_le_weak. rewrite Qplus_comm. - apply (Qlt_trans _ ((2 # p) + xn (Pos.to_nat p) + (1 # Pos.of_nat (S n)))). + apply (Qlt_trans _ ((2 # p) + xn p + (1 # Pos.of_nat (S n)))). 2: exact pmaj. - apply (Qplus_lt_l _ _ (-xn (Pos.to_nat p))). + apply (Qplus_lt_l _ _ (-xn p)). apply (Qle_lt_trans _ _ _ (Qle_Qabs _)). destruct (le_lt_dec (S n) (Pos.to_nat p)). - + specialize (xcau (Pos.of_nat (S n)) (S n) (Pos.to_nat p)). + + specialize (xcau (Pos.of_nat (S n)) (Pos.of_nat (S n)) p). apply (Qlt_trans _ (1# Pos.of_nat (S n))). apply xcau. - rewrite Nat2Pos.id. apply le_refl. discriminate. + apply Pos.le_refl. unfold id. apply Pos2Nat.inj_le. rewrite Nat2Pos.id. exact l. discriminate. apply (Qplus_lt_l _ _ (-(1#Pos.of_nat (S n)))). ring_simplify. reflexivity. + apply (Qlt_trans _ (1#p)). apply xcau. - apply le_S_n in l. apply le_S, l. apply le_refl. + apply le_S_n in l. unfold id. apply Pos2Nat.inj_le. + rewrite Nat2Pos.id. + apply le_S, l. discriminate. apply Pos.le_refl. ring_simplify. apply (Qlt_trans _ (2#p)). unfold Qlt, Qnum, Qden. apply Z.mul_lt_mono_pos_r. reflexivity. reflexivity. diff --git a/theories/Reals/Rregisternames.v b/theories/Reals/Rregisternames.v index f09edef600..8b078f2cf3 100644 --- a/theories/Reals/Rregisternames.v +++ b/theories/Reals/Rregisternames.v @@ -8,7 +8,7 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -Require Import Reals. +Require Import Raxioms Rfunctions Qreals. (*****************************************************************) (** Register names for use in plugins *) @@ -18,6 +18,9 @@ Register R as reals.R.type. Register R0 as reals.R.R0. Register R1 as reals.R.R1. Register Rle as reals.R.Rle. +Register Rgt as reals.R.Rgt. +Register Rlt as reals.R.Rlt. +Register Rge as reals.R.Rge. Register Rplus as reals.R.Rplus. Register Ropp as reals.R.Ropp. Register Rminus as reals.R.Rminus. @@ -26,5 +29,6 @@ Register Rinv as reals.R.Rinv. Register Rdiv as reals.R.Rdiv. Register IZR as reals.R.IZR. Register Rabs as reals.R.Rabs. -Register sqrt as reals.R.sqrt. Register powerRZ as reals.R.powerRZ. +Register pow as reals.R.pow. +Register Qreals.Q2R as reals.R.Q2R. diff --git a/theories/Sorting/CPermutation.v b/theories/Sorting/CPermutation.v new file mode 100644 index 0000000000..31d9f7f0ed --- /dev/null +++ b/theories/Sorting/CPermutation.v @@ -0,0 +1,282 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(** * Circular Shifts (aka Cyclic Permutations) *) + +(** The main inductive [CPermutation] relates lists up to circular shifts of their elements. + +For example: [CPermutation [a1;a2;a3;a4;a5] [a4;a5;a1;a2;a3]] + +Note: Terminology does not seem to be strongly fixed in English. For the record, it is "permutations circulaires" in French. +*) + +Require Import List Permutation Morphisms PeanoNat. +Import ListNotations. (* For notations [] and [a;b;c] *) +Set Implicit Arguments. + +Section CPermutation. + +Variable A:Type. + +(** Definition *) + +Inductive CPermutation : list A -> 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. + +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. + +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. + +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. + +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. diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index 86eebc6b4f..1dd9285412 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -499,11 +499,13 @@ Proof. rewrite (NoDup_Add AD) in Hl'. tauto. Qed. -Lemma NoDup_Permutation_bis l l' : NoDup l -> NoDup l' -> +Lemma NoDup_Permutation_bis l l' : NoDup l -> length l' <= length l -> incl l l' -> Permutation l l'. Proof. intros. apply NoDup_Permutation; auto. - split; auto. apply NoDup_length_incl; trivial. + - 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'. @@ -550,7 +552,6 @@ Proof. - 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. - symmetry in Heq3. destruct (map_eq_cons _ _ Heq3) as [b [l1'' [Heq1' [Heq2' Heq3']]]]; subst. rewrite map_app in HP; simpl in HP. symmetry in HP. diff --git a/theories/Structures/OrdersEx.v b/theories/Structures/OrdersEx.v index 0ad79825d2..adffa1ded4 100644 --- a/theories/Structures/OrdersEx.v +++ b/theories/Structures/OrdersEx.v @@ -13,14 +13,15 @@ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -Require Import Orders PeanoNat POrderedType BinNat BinInt +Require Import Orders BoolOrder PeanoNat POrderedType BinNat BinInt RelationPairs EqualitiesFacts. (** * Examples of Ordered Type structures. *) -(** Ordered Type for [nat], [Positive], [N], [Z] with the usual order. *) +(** Ordered Type for [bool], [nat], [Positive], [N], [Z] with the usual order. *) +Module Bool_as_OT := BoolOrder.BoolOrd. Module Nat_as_OT := PeanoNat.Nat. Module Positive_as_OT := BinPos.Pos. Module N_as_OT := BinNat.N. @@ -30,8 +31,9 @@ Module Z_as_OT := BinInt.Z. Module OT_as_DT (O:OrderedType) <: DecidableType := O. -(** (Usual) Decidable Type for [nat], [positive], [N], [Z] *) +(** (Usual) Decidable Type for [bool], [nat], [positive], [N], [Z] *) +Module Bool_as_DT <: UsualDecidableType := Bool_as_OT. Module Nat_as_DT <: UsualDecidableType := Nat_as_OT. Module Positive_as_DT <: UsualDecidableType := Positive_as_OT. Module N_as_DT <: UsualDecidableType := N_as_OT. diff --git a/theories/Vectors/VectorSpec.v b/theories/Vectors/VectorSpec.v index 466e2bf994..443931e5bb 100644 --- a/theories/Vectors/VectorSpec.v +++ b/theories/Vectors/VectorSpec.v @@ -15,7 +15,7 @@ *) Require Fin. -Require Import VectorDef. +Require Import VectorDef PeanoNat Eqdep_dec. Import VectorNotations. Definition cons_inj {A} {a1 a2} {n} {v1 v2 : t A n} @@ -32,6 +32,8 @@ Defined. (** Lemmas are done for functions that use [Fin.t] but thanks to [Peano_dec.le_unique], all is true for the one that use [lt] *) +(** ** Properties of [nth] and [nth_order] *) + Lemma eq_nth_iff A n (v1 v2: t A n): (forall p1 p2, p1 = p2 -> v1 [@ p1 ] = v2 [@ p2 ]) <-> v1 = v2. Proof. @@ -44,12 +46,35 @@ split. - intros; now f_equal. Qed. +Lemma nth_order_hd A: forall n (v : t A (S n)) (H : 0 < S n), + nth_order v H = hd v. +Proof. intros; now rewrite (eta v). Qed. + +Lemma nth_order_tl A: forall n k (v : t A (S n)) (H : k < n) (HS : S k < S n), + nth_order (tl v) H = nth_order v HS. +Proof. +induction n; intros. +- inversion H. +- rewrite (eta v). + unfold nth_order; simpl. + now rewrite (Fin.of_nat_ext H (Lt.lt_S_n _ _ HS)). +Qed. + Lemma nth_order_last A: forall n (v: t A (S n)) (H: n < S n), nth_order v H = last v. Proof. unfold nth_order; refine (@rectS _ _ _ _); now simpl. Qed. +Lemma nth_order_ext A: forall n k (v : t A n) (H1 H2 : k < n), + nth_order v H1 = nth_order v H2. +Proof. +intros; unfold nth_order. +now rewrite (Fin.of_nat_ext H1 H2). +Qed. + +(** ** Properties of [shiftin] and [shiftrepeat] *) + Lemma shiftin_nth A a n (v: t A n) k1 k2 (eq: k1 = k2): nth (shiftin a v) (Fin.L_R 1 k1) = nth v k2. Proof. @@ -82,11 +107,99 @@ Proof. refine (@rectS _ _ _ _); now simpl. Qed. +(** ** Properties of [replace] *) + +Lemma nth_order_replace_eq A: forall n k (v : t A n) a (H1 : k < n) (H2 : k < n), + nth_order (replace v (Fin.of_nat_lt H2) a) H1 = a. +Proof. +intros n k; revert n; induction k; intros; + (destruct n; [ inversion H1 | subst ]). +- now rewrite nth_order_hd, (eta v). +- rewrite <- (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) H1)), (eta v). + apply IHk. +Qed. + +Lemma nth_order_replace_neq A: forall n k1 k2, k1 <> k2 -> + forall (v : t A n) a (H1 : k1 < n) (H2 : k2 < n), + nth_order (replace v (Fin.of_nat_lt H2) a) H1 = nth_order v H1. +Proof. +intros n k1; revert n; induction k1; intros; + (destruct n ; [ inversion H1 | subst ]). +- rewrite 2 nth_order_hd. + destruct k2; intuition. + now rewrite 2 (eta v). +- rewrite <- 2 (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) H1)), (eta v). + destruct k2; auto. + apply IHk1. + intros Hk; apply H; now subst. +Qed. + +Lemma replace_id A: forall n p (v : t A n), + replace v p (nth v p) = v. +Proof. +induction p; intros; rewrite 2 (eta v); simpl; auto. +now rewrite IHp. +Qed. + +Lemma replace_replace_eq A: forall n p (v : t A n) a b, + replace (replace v p a) p b = replace v p b. +Proof. +intros. +induction p; rewrite 2 (eta v); simpl; auto. +now rewrite IHp. +Qed. + +Lemma replace_replace_neq A: forall n p1 p2 (v : t A n) a b, p1 <> p2 -> + replace (replace v p1 a) p2 b = replace (replace v p2 b) p1 a. +Proof. +apply (Fin.rect2 (fun n p1 p2 => forall v a b, + p1 <> p2 -> replace (replace v p1 a) p2 b = replace (replace v p2 b) p1 a)). +- intros n v a b Hneq. + now contradiction Hneq. +- intros n p2 v; revert n v p2. + refine (@rectS _ _ _ _); auto. +- intros n p1 v; revert n v p1. + refine (@rectS _ _ _ _); auto. +- intros n p1 p2 IH v; revert n v p1 p2 IH. + refine (@rectS _ _ _ _); simpl; do 6 intro; [ | do 3 intro ]; intro Hneq; + f_equal; apply IH; intros Heq; apply Hneq; now subst. +Qed. + +(** ** Properties of [const] *) + Lemma const_nth A (a: A) n (p: Fin.t n): (const a n)[@ p] = a. Proof. now induction p. Qed. +(** ** Properties of [map] *) + +Lemma map_id A: forall n (v : t A n), + map (fun x => x) v = v. +Proof. +induction v; simpl; [ | rewrite IHv ]; auto. +Qed. + +Lemma map_map A B C: forall (f:A->B) (g:B->C) n (v : t A n), + map g (map f v) = map (fun x => g (f x)) v. +Proof. +induction v; simpl; [ | rewrite IHv ]; auto. +Qed. + +Lemma map_ext_in A B: forall (f g:A->B) n (v : t A n), + (forall a, In a v -> f a = g a) -> map f v = map g v. +Proof. +induction v; simpl; auto. +intros; rewrite H by constructor; rewrite IHv; intuition. +apply H; now constructor. +Qed. + +Lemma map_ext A B: forall (f g:A->B), (forall a, f a = g a) -> + forall n (v : t A n), map f v = map g v. +Proof. +intros; apply map_ext_in; auto. +Qed. + Lemma nth_map {A B} (f: A -> B) {n} v (p1 p2: Fin.t n) (eq: p1 = p2): (map f v) [@ p1] = f (v [@ p2]). Proof. @@ -105,6 +218,8 @@ refine (@rect2 _ _ _ _ _); simpl. now simpl. Qed. +(** ** Properties of [fold_left] *) + Lemma fold_left_right_assoc_eq {A B} {f: A -> B -> A} (assoc: forall a b c, f (f a b) c = f (f a c) b) {n} (v: t B n): forall a, fold_left f a v = fold_right (fun x y => f y x) v a. @@ -118,6 +233,8 @@ assert (forall n h (v: t B n) a, fold_left f (f a h) v = f (fold_left f a v) h). + simpl. intros; now rewrite<- (IHv). Qed. +(** ** Properties of [to_list] *) + Lemma to_list_of_list_opp {A} (l: list A): to_list (of_list l) = l. Proof. induction l. @@ -125,6 +242,8 @@ induction l. - unfold to_list; simpl. now f_equal. Qed. +(** ** Properties of [take] *) + Lemma take_O : forall {A} {n} le (v:t A n), take 0 le v = []. Proof. reflexivity. @@ -153,10 +272,14 @@ Proof. - destruct v. inversion le. simpl. apply f_equal. apply IHp. Qed. +(** ** Properties of [uncons] and [splitat] *) + Lemma uncons_cons {A} : forall {n : nat} (a : A) (v : t A n), uncons (a::v) = (a,v). Proof. reflexivity. Qed. +(* [append] *) + Lemma append_comm_cons {A} : forall {n m : nat} (v : t A n) (w : t A m) (a : A), a :: (v ++ w) = (a :: v) ++ w. Proof. reflexivity. Qed. @@ -187,3 +310,80 @@ Proof with auto. f_equal... apply IHv... Qed. + +(** ** Properties of [Forall] and [Forall2] *) + +Lemma Forall_impl A: forall (P Q : A -> Prop), (forall a, P a -> Q a) -> + forall n (v : t A n), Forall P v -> Forall Q v. +Proof. +induction v; intros HP; constructor; inversion HP as [| ? ? ? ? ? Heq1 [Heq2 He]]; + apply (inj_pair2_eq_dec _ Nat.eq_dec) in He; subst; intuition. +Qed. + +Lemma Forall_forall A: forall P n (v : t A n), + Forall P v <-> forall a, In a v -> P a. +Proof. +intros P n v; split. +- intros HP a Hin. + revert HP; induction Hin; intros HP; + inversion HP as [| ? ? ? ? ? Heq1 [Heq2 He]]; subst; auto. + apply (inj_pair2_eq_dec _ Nat.eq_dec) in He; subst; auto. +- induction v; intros Hin; constructor. + + apply Hin; constructor. + + apply IHv; intros a Ha. + apply Hin; now constructor. +Qed. + +Lemma Forall_nth_order A: forall P n (v : t A n), + Forall P v <-> forall i (Hi : i < n), P (nth_order v Hi). +Proof. +split; induction n. +- intros HF i Hi; inversion Hi. +- intros HF i Hi. + rewrite (eta v). + rewrite (eta v) in HF. + inversion HF as [| ? ? ? ? ? Heq1 [Heq2 He]]; subst. + apply (inj_pair2_eq_dec _ Nat.eq_dec) in He ; subst. + destruct i. + + now rewrite nth_order_hd. + + rewrite <- (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) Hi) Hi). + now apply IHn. +- intros HP; apply case0; constructor. +- intros HP. + rewrite (eta v) in HP. + rewrite (eta v); constructor. + + specialize HP with 0 (Nat.lt_0_succ n). + now rewrite nth_order_hd in HP. + + apply IHn; intros. + specialize HP with (S i) (proj1 (Nat.succ_lt_mono _ _) Hi). + now rewrite <- (nth_order_tl _ _ _ _ Hi) in HP. +Qed. + +Lemma Forall2_nth_order A: forall P n (v1 v2 : t A n), + Forall2 P v1 v2 + <-> forall i (Hi1 : i < n) (Hi2 : i < n), P (nth_order v1 Hi1) (nth_order v2 Hi2). +Proof. +split; induction n. +- intros HF i Hi1 Hi2; inversion Hi1. +- intros HF i Hi1 Hi2. + rewrite (eta v1), (eta v2). + rewrite (eta v1), (eta v2) in HF. + inversion HF as [| ? ? ? ? ? ? ? Heq [Heq1 He1] [Heq2 He2]]. + apply (inj_pair2_eq_dec _ Nat.eq_dec) in He1. + apply (inj_pair2_eq_dec _ Nat.eq_dec) in He2; subst. + destruct i. + + now rewrite nth_order_hd. + + rewrite <- (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) Hi1) Hi1). + rewrite <- (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) Hi2) Hi2). + now apply IHn. +- intros _; revert v1; apply case0; revert v2; apply case0; constructor. +- intros HP. + rewrite (eta v1), (eta v2) in HP. + rewrite (eta v1), (eta v2); constructor. + + specialize HP with 0 (Nat.lt_0_succ _) (Nat.lt_0_succ _). + now rewrite nth_order_hd in HP. + + apply IHn; intros. + specialize HP with (S i) (proj1 (Nat.succ_lt_mono _ _) Hi1) + (proj1 (Nat.succ_lt_mono _ _) Hi2). + now rewrite <- (nth_order_tl _ _ _ _ Hi1), <- (nth_order_tl _ _ _ _ Hi2) in HP. +Qed. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 0b3656f586..78b26c83ea 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -44,6 +44,7 @@ Register succ as num.Z.succ. Register pred as num.Z.pred. Register sub as num.Z.sub. Register mul as num.Z.mul. +Register pow as num.Z.pow. Register of_nat as num.Z.of_nat. (** When including property functors, only inline t eq zero one two *) diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v index 55b9ec4a44..c05ed9ebf4 100644 --- a/theories/ZArith/BinIntDef.v +++ b/theories/ZArith/BinIntDef.v @@ -208,7 +208,7 @@ Definition gtb x y := | _ => false end. -Fixpoint eqb x y := +Definition eqb x y := match x, y with | 0, 0 => true | pos p, pos q => Pos.eqb p q diff --git a/theories/extraction/ExtrHaskellString.v b/theories/extraction/ExtrHaskellString.v index 8c61f4e96b..80f527f51b 100644 --- a/theories/extraction/ExtrHaskellString.v +++ b/theories/extraction/ExtrHaskellString.v @@ -8,6 +8,8 @@ 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 @@ -35,19 +37,19 @@ Extract Inductive ascii => "Prelude.Char" (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.==)". -Extract Inlined Constant Ascii.eqb => "(Prelude.==)". +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.==)". -Extract Inlined Constant String.eqb => "(Prelude.==)". +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.==)". -Extract Inlined Constant Byte.byte_eq_dec => "(Prelude.==)". +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)". diff --git a/theories/extraction/ExtrOCamlFloats.v b/theories/extraction/ExtrOCamlFloats.v index 02f4b2898b..8d01620ef2 100644 --- a/theories/extraction/ExtrOCamlFloats.v +++ b/theories/extraction/ExtrOCamlFloats.v @@ -14,10 +14,10 @@ Note: the extraction of primitive floats relies on Coq's internal file kernel/float64.ml, so make sure the corresponding binary is available when linking the extracted OCaml code. -For example, if you build a (_CoqProject + coq_makefile)-based project +For example, if you build a ("_CoqProject" + coq_makefile)-based project and if you created an empty subfolder "extracted" and a file "test.v" containing [Cd "extracted". Separate Extraction function_to_extract.], -you will just need to add in the _CoqProject: [test.v], [-I extracted] +you will just need to add in the "_CoqProject" file: [test.v], [-I extracted] and the list of [extracted/*.ml] and [extracted/*.mli] files, then add [CAMLFLAGS += -w -33] in the Makefile.local file. *) diff --git a/theories/extraction/ExtrOcamlBigIntConv.v b/theories/extraction/ExtrOcamlBigIntConv.v index 7740bb41d9..29bd732c78 100644 --- a/theories/extraction/ExtrOcamlBigIntConv.v +++ b/theories/extraction/ExtrOcamlBigIntConv.v @@ -45,14 +45,14 @@ Fixpoint bigint_of_pos p := | xI p => bigint_succ (bigint_twice (bigint_of_pos p)) end. -Fixpoint bigint_of_z z := +Definition bigint_of_z z := match z with | Z0 => bigint_zero | Zpos p => bigint_of_pos p | Zneg p => bigint_opp (bigint_of_pos p) end. -Fixpoint bigint_of_n n := +Definition bigint_of_n n := match n with | N0 => bigint_zero | Npos p => bigint_of_pos p diff --git a/theories/extraction/ExtrOcamlIntConv.v b/theories/extraction/ExtrOcamlIntConv.v index a5be08ece4..d9c88defa5 100644 --- a/theories/extraction/ExtrOcamlIntConv.v +++ b/theories/extraction/ExtrOcamlIntConv.v @@ -42,14 +42,14 @@ Fixpoint int_of_pos p := | xI p => int_succ (int_twice (int_of_pos p)) end. -Fixpoint int_of_z z := +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. -Fixpoint int_of_n n := +Definition int_of_n n := match n with | N0 => int_zero | Npos p => int_of_pos p diff --git a/theories/ltac/Ltac.v b/theories/ltac/Ltac.v deleted file mode 100644 index e69de29bb2..0000000000 --- a/theories/ltac/Ltac.v +++ /dev/null diff --git a/theories/micromega/DeclConstant.v b/theories/micromega/DeclConstant.v index bd8490d796..2e50481b13 100644 --- a/theories/micromega/DeclConstant.v +++ b/theories/micromega/DeclConstant.v @@ -35,6 +35,7 @@ Require Import List. (** Ground terms (see [GT] below) are built inductively from declared constants. *) Class DeclaredConstant {T : Type} (F : T). +Register DeclaredConstant as micromega.DeclaredConstant.type. Class GT {T : Type} (F : T). diff --git a/theories/micromega/EnvRing.v b/theories/micromega/EnvRing.v index 28c7e8c554..7bef11e89a 100644 --- a/theories/micromega/EnvRing.v +++ b/theories/micromega/EnvRing.v @@ -31,6 +31,14 @@ Inductive PExpr {C} : Type := | 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 @@ -60,6 +68,10 @@ Inductive Pol {C} : Type := | 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 *) diff --git a/theories/micromega/Lra.v b/theories/micromega/Lra.v index 22cef50e0d..5c8cece845 100644 --- a/theories/micromega/Lra.v +++ b/theories/micromega/Lra.v @@ -20,6 +20,7 @@ Require Import Rdefinitions. Require Import RingMicromega. Require Import VarMap. Require Coq.micromega.Tauto. +Require Import Rregisternames. Declare ML Module "micromega_plugin". Ltac rchange := diff --git a/theories/micromega/QMicromega.v b/theories/micromega/QMicromega.v index e28de1a620..1fbc5a648a 100644 --- a/theories/micromega/QMicromega.v +++ b/theories/micromega/QMicromega.v @@ -154,6 +154,9 @@ 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. diff --git a/theories/micromega/RMicromega.v b/theories/micromega/RMicromega.v index a67c273c7f..fd8903eac9 100644 --- a/theories/micromega/RMicromega.v +++ b/theories/micromega/RMicromega.v @@ -150,7 +150,17 @@ Inductive Rcst := | 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 diff --git a/theories/micromega/RingMicromega.v b/theories/micromega/RingMicromega.v index 04de9509ac..fb7fbcf80b 100644 --- a/theories/micromega/RingMicromega.v +++ b/theories/micromega/RingMicromega.v @@ -298,6 +298,15 @@ Inductive Psatz : Type := | PsatzC : C -> Psatz | PsatzZ : Psatz. +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. @@ -672,6 +681,13 @@ Inductive Op2 : Set := (* binary relations *) | 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 @@ -686,12 +702,15 @@ Definition eval_pexpr : PolEnv -> PExpr C -> R := PEeval rplus rtimes rminus ropp phi pow_phi rpow. #[universes(template)] -Record Formula (T:Type) : Type := { +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). diff --git a/theories/micromega/Tauto.v b/theories/micromega/Tauto.v index a3e3cc3e9d..6e89089355 100644 --- a/theories/micromega/Tauto.v +++ b/theories/micromega/Tauto.v @@ -37,6 +37,16 @@ Section S. | N : GFormula -> GFormula | I : GFormula -> option AF -> GFormula -> GFormula. + 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 Cj as micromega.GFormula.Cj. + Register D as micromega.GFormula.D. + Register N as micromega.GFormula.N. + Register I as micromega.GFormula.I. + + Section MAPX. Variable F : TX -> TX. @@ -137,6 +147,8 @@ End S. (** Typical boolean formulae *) Definition BFormula (A : Type) := @GFormula A Prop unit unit. +Register BFormula as micromega.BFormula.type. + Section MAPATOMS. Context {TA TA':Type}. Context {TX : Type}. diff --git a/theories/micromega/VarMap.v b/theories/micromega/VarMap.v index c2472f6303..e28c27f400 100644 --- a/theories/micromega/VarMap.v +++ b/theories/micromega/VarMap.v @@ -33,6 +33,11 @@ Inductive t {A} : Type := | 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. diff --git a/theories/micromega/ZMicromega.v b/theories/micromega/ZMicromega.v index efb263faf3..bff9671fee 100644 --- a/theories/micromega/ZMicromega.v +++ b/theories/micromega/ZMicromega.v @@ -564,10 +564,14 @@ Inductive ZArithProof := . (*| SplitProof : PolC Z -> ZArithProof -> ZArithProof -> ZArithProof.*) +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 EnumProof as micromega.ZArithProof.EnumProof. +Register ExProof as micromega.ZArithProof.ExProof. -(* n/d <= x -> d*x - n >= 0 *) - (* In order to compute the 'cut', we need to express a polynomial P as a * Q + b. - b is the constant diff --git a/theories/micromega/ZifyInst.v b/theories/micromega/ZifyInst.v index 521ac61e18..5b15dc072a 100644 --- a/theories/micromega/ZifyInst.v +++ b/theories/micromega/ZifyInst.v @@ -42,6 +42,9 @@ Instance Op_lt : BinRel lt := {| TR := Z.lt; TRInj := Nat2Z.inj_lt |}. Add BinRel Op_lt. +Instance Op_Nat_lt : BinRel Nat.lt := Op_lt. +Add BinRel Op_Nat_lt. + Instance Op_gt : BinRel gt := {| TR := Z.gt; TRInj := Nat2Z.inj_gt |}. Add BinRel Op_gt. @@ -50,10 +53,16 @@ Instance Op_le : BinRel le := {| TR := Z.le; TRInj := Nat2Z.inj_le |}. Add BinRel Op_le. +Instance Op_Nat_le : BinRel Nat.le := Op_le. +Add BinRel Op_Nat_le. + Instance Op_eq_nat : BinRel (@eq nat) := {| TR := @eq Z ; TRInj := fun x y : nat => iff_sym (Nat2Z.inj_iff x y) |}. Add BinRel Op_eq_nat. +Instance Op_Nat_eq : BinRel (Nat.eq) := Op_eq_nat. +Add BinRel Op_Nat_eq. + (* zify_nat_op *) Instance Op_plus : BinOp Nat.add := {| TBOp := Z.add; TBOpInj := Nat2Z.inj_add |}. diff --git a/theories/nsatz/Nsatz.v b/theories/nsatz/Nsatz.v index 93b84f3a02..70180f47c7 100644 --- a/theories/nsatz/Nsatz.v +++ b/theories/nsatz/Nsatz.v @@ -9,9 +9,9 @@ (************************************************************************) (* - Tactic nsatz: proofs of polynomials equalities in an integral domain + Tactic nsatz: proofs of polynomials equalities in an integral domain (commutative ring without zero divisor). - + Examples: see test-suite/success/Nsatz.v Reification is done using type classes, defined in Ncring_tac.v @@ -33,416 +33,9 @@ Require Import DiscrR. Require Import ZArith. Require Import Lia. -Declare ML Module "nsatz_plugin". - -Section nsatz1. - -Context {R:Type}`{Rid:Integral_domain R}. - -Lemma psos_r1b: forall x y:R, x - y == 0 -> 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. - -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 (match lvar with - |(@nil _) => - match lparam with - |(@nil _) => - let r := eval red in (list_reifyl (lterm:=lb)) in r - |_ => - match eval red in (list_reifyl (lterm:=lb)) with - |(?fv, ?le) => - let fv := parametres_en_tete fv lparam in - (* we reify a second time, with the good order - for variables *) - let r := eval red in - (list_reifyl (lterm:=lb) (lvar:=fv)) in r - end - end - |_ => - let fv := parametres_en_tete lvar lparam in - let r := eval red in (list_reifyl (lterm:=lb) (lvar:=fv)) in r - 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; - 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. +Require Export NsatzTactic. +(** Make use of [discrR] in [nsatz] *) +Ltac nsatz_internal_discrR ::= discrR. (* Real numbers *) Require Import Reals. @@ -462,7 +55,7 @@ try (try apply Rsth; intros; try rewrite H; try rewrite H0; reflexivity)). exact Rplus_0_l. exact Rplus_comm. symmetry. apply Rplus_assoc. exact Rmult_1_l. exact Rmult_1_r. symmetry. apply Rmult_assoc. - exact Rmult_plus_distr_r. intros; apply Rmult_plus_distr_l. + exact Rmult_plus_distr_r. intros; apply Rmult_plus_distr_l. exact Rplus_opp_r. Defined. @@ -479,8 +72,8 @@ Qed. Instance Rcri: (Cring (Rr:=Rri)). red. exact Rmult_comm. Defined. -Instance Rdi : (Integral_domain (Rcr:=Rcri)). -constructor. +Instance Rdi : (Integral_domain (Rcr:=Rcri)). +constructor. exact Rmult_integral. exact R_one_zero. Defined. (* Rational numbers *) @@ -491,14 +84,14 @@ Defined. Instance Qri : (Ring (Ro:=Qops)). constructor. -try apply Q_Setoid. -apply Qplus_comp. -apply Qmult_comp. -apply Qminus_comp. +try 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. + apply Qmult_plus_distr_l. intros. apply Qmult_plus_distr_r. reflexivity. exact Qplus_opp_r. Defined. @@ -508,8 +101,8 @@ Proof. unfold Qeq. simpl. lia. Qed. Instance Qcri: (Cring (Rr:=Qri)). red. exact Qmult_comm. Defined. -Instance Qdi : (Integral_domain (Rcr:=Qcri)). -constructor. +Instance Qdi : (Integral_domain (Rcr:=Qcri)). +constructor. exact Qmult_integral. exact Q_one_zero. Defined. (* Integers *) @@ -519,7 +112,6 @@ Proof. lia. Qed. Instance Zcri: (Cring (Rr:=Zr)). red. exact Z.mul_comm. Defined. -Instance Zdi : (Integral_domain (Rcr:=Zcri)). -constructor. +Instance Zdi : (Integral_domain (Rcr:=Zcri)). +constructor. exact Zmult_integral. exact Z_one_zero. Defined. - diff --git a/theories/nsatz/NsatzTactic.v b/theories/nsatz/NsatzTactic.v new file mode 100644 index 0000000000..db7dab2c46 --- /dev/null +++ b/theories/nsatz/NsatzTactic.v @@ -0,0 +1,449 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* + Tactic nsatz: proofs of polynomials equalities in an integral domain +(commutative ring without zero divisor). + +Examples: see test-suite/success/Nsatz.v + +Reification is done using type classes, defined in Ncring_tac.v + +*) + +Require Import List. +Require Import Setoid. +Require Import BinPos. +Require Import BinList. +Require Import Znumtheory. +Require Export Morphisms Setoid Bool. +Require Export Algebra_syntax. +Require Export Ncring. +Require Export Ncring_initial. +Require Export Ncring_tac. +Require Export Integral_domain. +Require Import ZArith. +Require Import Lia. + +Declare ML Module "nsatz_plugin". + +Section nsatz1. + +Context {R:Type}`{Rid:Integral_domain R}. + +Lemma psos_r1b: forall x y:R, x - y == 0 -> 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 (match lvar with + |(@nil _) => + match lparam with + |(@nil _) => + let r := eval red in (list_reifyl (lterm:=lb)) in r + |_ => + match eval red in (list_reifyl (lterm:=lb)) with + |(?fv, ?le) => + let fv := parametres_en_tete fv lparam in + (* we reify a second time, with the good order + for variables *) + let r := eval red in + (list_reifyl (lterm:=lb) (lvar:=fv)) in r + end + end + |_ => + let fv := parametres_en_tete lvar lparam in + let r := eval red in (list_reifyl (lterm:=lb) (lvar:=fv)) in r + 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. diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in index 597351db9b..a26eb9dfbe 100644 --- a/tools/CoqMakefile.in +++ b/tools/CoqMakefile.in @@ -66,12 +66,12 @@ VERBOSE ?= TIMED?= TIMECMD?= # Use command time on linux, gtime on Mac OS -TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)" +TIMEFMT?="$@ (real: %e, user: %U, sys: %S, mem: %M ko)" ifneq (,$(TIMED)) -ifeq (0,$(shell command time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +ifeq (0,$(shell command time -f "" true >/dev/null 2>/dev/null; echo $$?)) STDTIME?=command time -f $(TIMEFMT) else -ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +ifeq (0,$(shell gtime -f "" true >/dev/null 2>/dev/null; echo $$?)) STDTIME?=gtime -f $(TIMEFMT) else STDTIME?=command time @@ -132,6 +132,10 @@ TIMING_SORT_BY ?= auto 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 @@ -355,6 +359,18 @@ 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:: @@ -362,9 +378,9 @@ make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: $(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_REAL_ARG) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(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_REAL_ARG) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) + $(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' @@ -631,7 +647,7 @@ archclean:: $(MLIFILES:.mli=.cmi): %.cmi: %.mli $(SHOW)'CAMLC -c $<' - $(HIDE)$(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< + $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< $(MLGFILES:.mlg=.ml): %.ml: %.mlg $(SHOW)'COQPP $<' @@ -640,53 +656,53 @@ $(MLGFILES:.mlg=.ml): %.ml: %.mlg # 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)$(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< + $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $< # Same hack $(filter %.cmx, $(MLFILES:.ml=.cmx) $(MLGFILES:.mlg=.cmx)): %.cmx: %.ml $(SHOW)'CAMLOPT -c $(FOR_PACK) $<' - $(HIDE)$(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(FOR_PACK) $< + $(HIDE)$(TIMER) $(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) $(FOR_PACK) $< $(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa $(SHOW)'CAMLOPT -shared -o $@' - $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ -linkall -shared -o $@ $< $(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib $(SHOW)'CAMLC -a -o $@' - $(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ + $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ $(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib $(SHOW)'CAMLOPT -a -o $@' - $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $^ + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $^ $(MLPACKFILES:.mlpack=.cmxs): %.cmxs: %.cmxa $(SHOW)'CAMLOPT -shared -o $@' - $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ -shared -linkall -o $@ $< $(MLPACKFILES:.mlpack=.cmxa): %.cmxa: %.cmx $(SHOW)'CAMLOPT -a -o $@' - $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $< + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -a -o $@ $< $(MLPACKFILES:.mlpack=.cma): %.cma: %.cmo | %.mlpack $(SHOW)'CAMLC -a -o $@' - $(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ + $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) -a -o $@ $^ $(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack $(SHOW)'CAMLC -pack -o $@' - $(HIDE)$(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^ + $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^ $(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack $(SHOW)'CAMLOPT -pack -o $@' - $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -pack -o $@ $^ + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -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)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ + $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(CAMLPKGS) \ -shared -o $@ $< ifneq (,$(TIMING)) diff --git a/tools/TimeFileMaker.py b/tools/TimeFileMaker.py index 210901f8a7..c4620f5b50 100644 --- a/tools/TimeFileMaker.py +++ b/tools/TimeFileMaker.py @@ -15,6 +15,9 @@ STRIP_REG = re.compile('^(coq/|contrib/|)(?:theories/|src/)?') 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) @@ -37,6 +40,11 @@ def add_sort_by(parser): '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, @@ -55,9 +63,9 @@ def add_real(parser, single_timing=False): 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...) +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...)''' if not single_timing else +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...)'''))) @@ -67,12 +75,17 @@ def add_user(parser, single_timing=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...) +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...)''' if not single_timing else +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) @@ -113,14 +126,24 @@ def get_file_lines(file_name): def get_file(file_name): return ''.join(get_file_lines(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. - ''' - lines = get_file(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 @@ -130,7 +153,31 @@ def get_times(file_name, use_real=False): 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, reformat_time_string(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): ''' @@ -144,7 +191,7 @@ def get_single_file_times(file_name, use_real=False): 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), reformat_time_string(real if use_real else user)) for start, stop, name, real, user, extra in times) + 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 @@ -215,20 +262,30 @@ def adjust_fuzz(left_dict, right_dict, fuzz): def fix_sign_for_sorting(num, descending=True): return -num if descending else num -def make_sorting_key(times_dict, descending=True): - def get_key(name): - minutes, seconds = times_dict[name].replace('s', '').split('m') - return (fix_sign_for_sorting(int(minutes), descending=descending), - fix_sign_for_sorting(float(seconds), descending=descending), - name) +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_times_dict(times_dict, descending=True): +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(times_dict.keys(), key=make_sorting_key(times_dict, descending=descending)) + return sorted(stats_dict.keys(), key=make_sorting_key(stats_dict, descending=descending, sort_by_mem=sort_by_mem)) def to_seconds(time): ''' @@ -265,85 +322,149 @@ def format_percentage(num, signed=True): frac_part = int(100 * (num * 100 - whole_part)) return sign + '%d.%02d%%' % (whole_part, frac_part) -def make_diff_table_string(left_times_dict, right_times_dict, +def make_diff_table_string(left_dict, right_dict, sort_by='auto', - descending=True, - left_tag="After", tag="File Name", right_tag="Before", with_percent=True, - change_tag="Change", percent_change_tag="% Change"): + 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_times_dict) - all_names_dict.update(left_times_dict) # do the left (after) last, so that we give precedence to those ones + 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' - prediff_times = tuple((name, to_seconds(left_times_dict.get(name,'0m0.0s')), to_seconds(right_times_dict.get(name,'0m0.0s'))) + 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 - get_key_abs = make_sorting_key(all_names_dict, descending=descending) - get_key_diff_float = (lambda name: fix_sign_for_sorting(to_seconds(diff_times_dict[name]), descending=descending)) - get_key_diff_absint = (lambda name: fix_sign_for_sorting(int(abs(to_seconds(diff_times_dict[name]))), descending=descending)) + 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_abs + get_key = get_key_with_name(get_key_abs) elif sort_by == 'diff': - get_key = get_key_diff_float + get_key = get_key_with_name(get_key_diff_float) else: # sort_by == 'auto' - get_key = (lambda name: (get_key_diff_absint(name), get_key_abs(name))) + 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_times_dict(all_names_dict, descending=descending) + #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(left_times_dict.values()) - right_sum = sum_times(right_times_dict.values()) - left_sum_float = sum(sorted(map(to_seconds, left_times_dict.values()))) - right_sum_float = sum(sorted(map(to_seconds, right_times_dict.values()))) + 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'] + list(left_times_dict.values()))), len(left_sum)) - right_width = max(max(map(len, ['N/A'] + list(right_times_dict.values()))), len(right_sum)) + + 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)) - middle_width = max(map(len, names + [tag, "Total"])) - format_string = ("%%(left)-%ds | %%(middle)-%ds | %%(right)-%ds || %%(far_right)-%ds" - % (left_width, middle_width, right_width, far_right_width)) + total_string = 'Total' if not include_mem else 'Total Time / Peak Mem' + middle_width = max(map(len, names + [tag, total_string])) + + left_peak = max(v.get(MEM_KEY, 0) for v in left_dict.values()) + right_peak = max(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 - header = format_string % {'left': left_tag, 'middle': tag, 'right': right_tag, 'far_right': change_tag, 'far_far_right': percent_change_tag} - total = format_string % {'left': left_sum, 'middle': "Total", 'right': right_sum, 'far_right': diff_sum, 'far_far_right': percent_diff_sum} + 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) % 0, (" | %%-%ds || " % right_width) % 0, ("|| %%-%ds" % far_right_width) % 0, ("| %%-%ds" % far_far_right_width) % 0 + 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_times_dict.get(name, 0), + [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_times_dict.get(name, 0), - 'far_right': diff_times_dict.get(name, 0), - 'far_far_right': percent_diff_times_dict.get(name, 0)} - for name in names]).replace(left_rep, 'N/A'.center(len(left_rep) - 3) + ' | ').replace(right_rep, ' | ' + 'N/A'.center(len(right_rep) - 7) + ' || ').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)) - -def make_table_string(times_dict, - descending=True, - tag="Time"): - if len(times_dict.keys()) == 0: return 'No timing data' + '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_times_dict(times_dict, descending=descending) + 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(max(map(len, times_dict.values())), len(sum_times(times_dict.values()))) - names_width = max(map(len, names + ["File Name", "Total"])) - format_string = "%%-%ds | %%-%ds" % (times_width, names_width) - header = format_string % (tag, "File Name") - total = format_string % (sum_times(times_dict.values()), - "Total") + 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 % (times_dict[name], - name) + [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): diff --git a/tools/coqdoc/coqdoc.css b/tools/coqdoc/coqdoc.css index dbc930f5ec..48096e555a 100644 --- a/tools/coqdoc/coqdoc.css +++ b/tools/coqdoc/coqdoc.css @@ -230,6 +230,10 @@ tr.infrulemiddle hr { color: rgb(40%,0%,40%); } +.id[title="binder"] { + color: rgb(40%,0%,40%); +} + .id[type="definition"] { color: rgb(0%,40%,0%); } @@ -327,3 +331,8 @@ ul.doclist { margin-top: 0em; margin-bottom: 0em; } + +.code :target { + border: 2px solid #D4D4D4; + background-color: #e5eecc; +} diff --git a/tools/coqdoc/coqdoc.sty b/tools/coqdoc/coqdoc.sty index f49f9f0066..aa9c414761 100644 --- a/tools/coqdoc/coqdoc.sty +++ b/tools/coqdoc/coqdoc.sty @@ -72,6 +72,7 @@ \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}} diff --git a/tools/coqdoc/cpretty.mll b/tools/coqdoc/cpretty.mll index 86d213453b..aa3c5b9d3b 100644 --- a/tools/coqdoc/cpretty.mll +++ b/tools/coqdoc/cpretty.mll @@ -316,7 +316,7 @@ let identifier = (* 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 nonidentchar = [^ 'A'-'Z' 'a'-'z' '_' '[' ']' '\'' '0'-'9' '@' '\"' '\'' '`'] let printing_token = [^ ' ' '\t']* diff --git a/tools/coqdoc/index.ml b/tools/coqdoc/index.ml index 4cc82726f1..723918525d 100644 --- a/tools/coqdoc/index.ml +++ b/tools/coqdoc/index.ml @@ -31,6 +31,7 @@ type entry_type = | Abbreviation | Notation | Section + | Binder type index_entry = | Def of string * entry_type @@ -177,6 +178,7 @@ let type_name = function | Abbreviation -> "abbreviation" | Notation -> "notation" | Section -> "section" + | Binder -> "binder" let prepare_entry s = function | Notation -> @@ -268,6 +270,7 @@ let type_of_string = function | "mod" | "modtype" -> Module | "tac" -> TacticDefinition | "sec" -> Section + | "binder" -> Binder | s -> invalid_arg ("type_of_string:" ^ s) let ill_formed_glob_file f = diff --git a/tools/coqdoc/index.mli b/tools/coqdoc/index.mli index 3426fdd3d3..7a3d401fd7 100644 --- a/tools/coqdoc/index.mli +++ b/tools/coqdoc/index.mli @@ -30,6 +30,7 @@ type entry_type = | Abbreviation | Notation | Section + | Binder val type_name : entry_type -> string diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml index dd1b65d294..def1cbbcf8 100644 --- a/tools/coqdoc/output.ml +++ b/tools/coqdoc/output.ml @@ -337,11 +337,8 @@ module Latex = struct let id = if fid <> "" then (m ^ "." ^ fid) else m in match find_module m with | Local -> - if typ = Variable then - printf "\\coqdoc%s{%s}" (type_name typ) s - else - (printf "\\coqref{"; label_ident id; - printf "}{\\coqdoc%s{%s}}" (type_name typ) s) + printf "\\coqref{"; label_ident id; + printf "}{\\coqdoc%s{%s}}" (type_name typ) s | External m when !externals -> printf "\\coqexternalref{"; label_ident fid; printf "}{%s}{\\coqdoc%s{%s}}" (escaped m) (type_name typ) s @@ -615,6 +612,7 @@ module Html = struct 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. *) @@ -661,7 +659,8 @@ module Html = struct let reference s r = match r with | Def (fullid,ty) -> - printf "<a name=\"%s\">" (sanitize_name fullid); + let s' = sanitize_name fullid in + printf "<a id=\"%s\" class=\"idref\" href=\"#%s\">" s' s'; printf "<span class=\"id\" title=\"%s\">%s</span></a>" (type_name ty) s | Ref (m,fullid,ty) -> ident_ref m fullid (type_name ty) s @@ -822,7 +821,7 @@ module Html = struct | Some n -> if lev <= n then add_toc_entry (Toc_section (lev, f, r)) else ()); stop_item (); - printf "<a name=\"%s\"></a><h%d class=\"section\">" lab lev; + printf "<a id=\"%s\"></a><h%d class=\"section\">" lab lev; f (); printf "</h%d>\n" lev @@ -836,7 +835,7 @@ module Html = struct let letter_index category idx (c,l) = if l <> [] then begin let cat = if category && idx <> "global" then "(" ^ idx ^ ")" else "" in - printf "<a name=\"%s_%c\"></a><h2>%s %s</h2>\n" idx c (display_letter c) cat; + printf "<a id=\"%s_%c\"></a><h2>%s %s</h2>\n" idx c (display_letter c) cat; List.iter (fun (id,(text,link,t)) -> let id' = prepare_entry id t in diff --git a/tools/make-both-time-files.py b/tools/make-both-time-files.py index 5d88548bba..3959ff5c2a 100755 --- a/tools/make-both-time-files.py +++ b/tools/make-both-time-files.py @@ -5,11 +5,13 @@ 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(args.AFTER_FILE_NAME, use_real=args.real) - right_dict = get_times(args.BEFORE_FILE_NAME, use_real=args.real) - table = make_diff_table_string(left_dict, right_dict, sort_by=args.sort_by) + 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) diff --git a/tools/make-one-time-file.py b/tools/make-one-time-file.py index 3df7d7e584..df02383724 100755 --- a/tools/make-one-time-file.py +++ b/tools/make-one-time-file.py @@ -7,7 +7,9 @@ if __name__ == '__main__': 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() - times_dict = get_times(args.FILE_NAME, use_real=args.real) - table = make_table_string(times_dict) + 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) diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml index cfc89782a1..17435c051e 100644 --- a/toplevel/coqargs.ml +++ b/toplevel/coqargs.ml @@ -44,7 +44,6 @@ type coqargs_logic_config = { impredicative_set : Declarations.set_predicativity; indices_matter : bool; toplevel_name : Stm.interactive_top; - cumulative_sprop : bool; } type coqargs_config = { @@ -110,7 +109,6 @@ let default_logic_config = { impredicative_set = Declarations.PredicativeSet; indices_matter = false; toplevel_name = Stm.TopLogical default_toplevel; - cumulative_sprop = false; } let default_config = { @@ -198,6 +196,10 @@ let set_query opts q = | Queries queries -> Queries (queries@[q]) } +let warn_deprecated_sprop_cumul = + CWarnings.create ~name:"deprecated-spropcumul" ~category:"deprecated" + (fun () -> Pp.strbrk "Use the \"Cumulative StrictProp\" flag instead.") + let warn_deprecated_inputstate = CWarnings.create ~name:"deprecated-inputstate" ~category:"deprecated" (fun () -> Pp.strbrk "The inputstate option is deprecated and discouraged.") @@ -520,7 +522,9 @@ let parse_args ~help ~init arglist : t * string list = add_set_option oval Vernacentries.allow_sprop_opt_name (OptionSet None) |"-disallow-sprop" -> add_set_option oval Vernacentries.allow_sprop_opt_name OptionUnset - |"-sprop-cumulative" -> set_logic (fun o -> { o with cumulative_sprop = true }) oval + |"-sprop-cumulative" -> + warn_deprecated_sprop_cumul(); + add_set_option oval Vernacentries.cumul_sprop_opt_name (OptionSet None) |"-indices-matter" -> set_logic (fun o -> { o with indices_matter = true }) oval |"-m"|"--memory" -> { oval with post = { oval.post with memory_stat = true }} |"-noinit"|"-nois" -> { oval with pre = { oval.pre with load_init = false }} diff --git a/toplevel/coqargs.mli b/toplevel/coqargs.mli index 8723d21bb4..a51ed6766a 100644 --- a/toplevel/coqargs.mli +++ b/toplevel/coqargs.mli @@ -20,7 +20,6 @@ type coqargs_logic_config = { impredicative_set : Declarations.set_predicativity; indices_matter : bool; toplevel_name : Stm.interactive_top; - cumulative_sprop : bool; } type coqargs_config = { diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 1175494bad..7aad856d0a 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -199,7 +199,6 @@ let init_execution opts custom_init = Global.set_VM opts.config.enable_VM; Flags.set_native_compiler (match opts.config.native_compiler with NativeOff -> false | NativeOn _ -> true); Global.set_native_compiler (match opts.config.native_compiler with NativeOff -> false | NativeOn _ -> true); - if opts.config.logic.cumulative_sprop then Global.make_sprop_cumulative (); (* Native output dir *) Nativelib.output_dir := opts.config.native_output_dir; diff --git a/user-contrib/Ltac2/g_ltac2.mlg b/user-contrib/Ltac2/g_ltac2.mlg index 57d59fc2ef..13c4d667a0 100644 --- a/user-contrib/Ltac2/g_ltac2.mlg +++ b/user-contrib/Ltac2/g_ltac2.mlg @@ -145,10 +145,10 @@ GRAMMAR EXTEND Gram { CAst.make ~loc @@ CTacCse (e, bl) } ] | "4" LEFTA [ ] - | [ e0 = SELF; ","; el = LIST1 NEXT SEP "," -> + | "3" [ e0 = SELF; ","; el = LIST1 NEXT SEP "," -> { let el = e0 :: el in CAst.make ~loc @@ CTacApp (CAst.make ~loc @@ CTacCst (AbsKn (Tuple (List.length el))), el) } ] - | "::" RIGHTA + | "2" RIGHTA [ e1 = tac2expr; "::"; e2 = tac2expr -> { CAst.make ~loc @@ CTacApp (CAst.make ~loc @@ CTacCst (AbsKn (Other Tac2core.Core.c_cons)), [e1; e2]) } ] diff --git a/user-contrib/Ltac2/tac2core.ml b/user-contrib/Ltac2/tac2core.ml index 2102cd1172..e77040a8db 100644 --- a/user-contrib/Ltac2/tac2core.ml +++ b/user-contrib/Ltac2/tac2core.ml @@ -375,7 +375,7 @@ let () = define1 "constr_kind" constr begin fun c -> | Evar (evk, args) -> v_blk 3 [| Value.of_int (Evar.repr evk); - Value.of_array Value.of_constr args; + Value.of_array Value.of_constr (Array.of_list args); |] | Sort s -> v_blk 4 [|Value.of_ext Value.val_sort s|] @@ -469,7 +469,7 @@ let () = define1 "constr_make" valexpr begin fun knd -> | (3, [|evk; args|]) -> let evk = Evar.unsafe_of_int (Value.to_int evk) in let args = Value.to_array Value.to_constr args in - EConstr.mkEvar (evk, args) + EConstr.mkEvar (evk, Array.to_list args) | (4, [|s|]) -> let s = Value.to_ext Value.val_sort s in EConstr.mkSort (EConstr.Unsafe.to_sorts s) @@ -603,7 +603,7 @@ let () = define3 "constr_in_context" ident constr closure begin fun id t c -> thaw c >>= fun _ -> Proofview.Unsafe.tclSETGOALS [Proofview.with_empty_state (Proofview.Goal.goal gl)] >>= fun () -> let args = List.map (fun d -> EConstr.mkVar (get_id d)) (EConstr.named_context env) in - let args = Array.of_list (EConstr.mkRel 1 :: args) in + let args = EConstr.mkRel 1 :: args in let ans = EConstr.mkEvar (evk, args) in let ans = EConstr.mkLambda (Context.make_annot (Name id) Sorts.Relevant, t, ans) in return (Value.of_constr ans) diff --git a/vernac/.ocamlformat-enable b/vernac/.ocamlformat-enable new file mode 100644 index 0000000000..ffaa7e70f4 --- /dev/null +++ b/vernac/.ocamlformat-enable @@ -0,0 +1 @@ +comHints.ml diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml index 215d5d97a0..743d1d2026 100644 --- a/vernac/auto_ind_decl.ml +++ b/vernac/auto_ind_decl.ml @@ -122,6 +122,53 @@ let check_no_indices mib = let beq_scheme_kind_aux = ref (fun _ -> failwith "Undefined") +let build_beq_scheme_deps kn = + (* fetching global env *) + let env = Global.env() in + (* fetching the mutual inductive body *) + let mib = Global.lookup_mind kn in + (* number of inductives in the mutual *) + let nb_ind = Array.length mib.mind_packets in + (* number of params in the type *) + let nparrec = mib.mind_nparams_rec in + check_no_indices mib; + let make_one_eq accu i = + (* 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 + perfomed 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 accu c = + let (c,a) = Reductionops.whd_betaiota_stack Evd.empty EConstr.(of_constr c) in + let (c,a) = EConstr.Unsafe.(to_constr c, List.map to_constr a) in + match Constr.kind c with + | Cast (x,_,_) -> aux accu (Term.applist (x,a)) + | App _ -> assert false + | Ind ((kn', _), _) -> + if MutInd.equal kn kn' then accu + else + let eff = SchemeMutualDep (kn', !beq_scheme_kind_aux ()) in + List.fold_left aux (eff :: accu) a + | Const (kn, u) -> + (match Environ.constant_opt_value_in env (kn, u) with + | Some c -> aux accu (Term.applist (c,a)) + | None -> accu) + | Rel _ | Var _ | Sort _ | Prod _ | Lambda _ | LetIn _ | Proj _ + | Construct _ | Case _ | CoFix _ | Fix _ | Meta _ | Evar _ | Int _ + | Float _ -> accu + in + let u = Univ.Instance.empty in + let constrs n = get_constructors env (make_ind_family (((kn, i), u), + Context.Rel.to_extended_list mkRel (n+nb_ind-1) mib.mind_params_ctxt)) in + let constrsi = constrs (3+nparrec) in + let fold i accu arg = + let fold accu c = aux accu (RelDecl.get_type c) in + List.fold_left fold accu arg.cs_args + in + Array.fold_left_i fold accu constrsi + in + Array.fold_left_i (fun i accu _ -> make_one_eq accu i) [] mib.mind_packets + let build_beq_scheme mode kn = check_bool_is_defined (); (* fetching global env *) @@ -194,7 +241,7 @@ let build_beq_scheme mode kn = let (c,a) = Reductionops.whd_betaiota_stack Evd.empty EConstr.(of_constr c) in let (c,a) = EConstr.Unsafe.(to_constr c, List.map to_constr a) in match Constr.kind c with - | Rel x -> mkRel (x-nlist+ndx), Evd.empty_side_effects + | Rel x -> mkRel (x-nlist+ndx) | Var x -> (* Support for working in a context with "eq_x : x -> x -> bool" *) let eid = Id.of_string ("eq_"^(Id.to_string x)) in @@ -202,26 +249,23 @@ let build_beq_scheme mode kn = try ignore (Environ.lookup_named eid env) with Not_found -> raise (ParameterWithoutEquality (GlobRef.VarRef x)) in - mkVar eid, Evd.empty_side_effects + mkVar eid | Cast (x,_,_) -> aux (Term.applist (x,a)) | App _ -> assert false | Ind ((kn',i as ind'),u) (*FIXME: universes *) -> - if MutInd.equal kn kn' then mkRel(eqA-nlist-i+nb_ind-1), Evd.empty_side_effects + if MutInd.equal kn kn' then mkRel(eqA-nlist-i+nb_ind-1) else begin try - let eq, eff = - let c, eff = find_scheme ~mode (!beq_scheme_kind_aux()) (kn',i) in - mkConst c, eff in - let eqa, eff = - let eqa, effs = List.split (List.map aux a) in - Array.of_list eqa, - List.fold_left Evd.concat_side_effects eff (List.rev effs) - in + let eq = match lookup_scheme (!beq_scheme_kind_aux()) ind' with + | Some c -> mkConst c + | None -> assert false + in + let eqa = Array.of_list @@ List.map aux a in let args = Array.append (Array.of_list (List.map (fun x -> lift lifti x) a)) eqa in - if Int.equal (Array.length args) 0 then eq, eff - else mkApp (eq, args), eff + if Int.equal (Array.length args) 0 then eq + else mkApp (eq, args) with Not_found -> raise(EqNotFound (ind', fst ind)) end | Sort _ -> raise InductiveWithSort @@ -238,8 +282,7 @@ let build_beq_scheme mode kn = 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 - Term.applist (mkConst kneq,a), - Evd.empty_side_effects + Term.applist (mkConst kneq,a) else raise (ParameterWithoutEquality (GlobRef.ConstRef kn))) | Proj _ -> raise (EqUnknown "projection") | Construct _ -> raise (EqUnknown "constructor") @@ -271,7 +314,6 @@ let build_beq_scheme mode kn = let constrsi = constrs (3+nparrec) in let n = Array.length constrsi in let ar = Array.make n (ff ()) in - let eff = ref Evd.empty_side_effects in for i=0 to n-1 do let nb_cstr_args = List.length constrsi.(i).cs_args in let ar2 = Array.make n (ff ()) in @@ -283,13 +325,12 @@ let build_beq_scheme mode kn = | _ -> let eqs = Array.make nb_cstr_args (tt ()) in for ndx = 0 to nb_cstr_args-1 do let cc = RelDecl.get_type (List.nth constrsi.(i).cs_args ndx) in - let eqA, eff' = compute_A_equality rel_list + let eqA = compute_A_equality rel_list nparrec (nparrec+3+2*nb_cstr_args) (nb_cstr_args+ndx+1) cc in - eff := Evd.concat_side_effects eff' !eff; Array.set eqs ndx (mkApp (eqA, [|mkRel (ndx+1+nb_cstr_args);mkRel (ndx+1)|] @@ -315,21 +356,18 @@ let build_beq_scheme mode kn = done; mkNamedLambda (make_annot (Id.of_string "X") Sorts.Relevant) (mkFullInd ind (nb_ind-1+1)) ( mkNamedLambda (make_annot (Id.of_string "Y") Sorts.Relevant) (mkFullInd ind (nb_ind-1+2)) ( - mkCase (ci, do_predicate rel_list 0,mkVar (Id.of_string "X"),ar))), - !eff + mkCase (ci, do_predicate rel_list 0,mkVar (Id.of_string "X"),ar))) in (* build_beq_scheme *) let names = Array.make nb_ind (make_annot Anonymous Sorts.Relevant) and types = Array.make nb_ind mkSet and cores = Array.make nb_ind mkSet in - let eff = ref Evd.empty_side_effects in let u = Univ.Instance.empty in for i=0 to (nb_ind-1) do names.(i) <- make_annot (Name (Id.of_string (rec_name i))) Sorts.Relevant; types.(i) <- mkArrow (mkFullInd ((kn,i),u) 0) Sorts.Relevant (mkArrow (mkFullInd ((kn,i),u) 1) Sorts.Relevant (bb ())); - let c, eff' = make_one_eq i in + let c = make_one_eq i in cores.(i) <- c; - eff := Evd.concat_side_effects eff' !eff done; (Array.init nb_ind (fun i -> let kelim = Inductive.elim_sort (mib,mib.mind_packets.(i)) in @@ -347,10 +385,12 @@ let build_beq_scheme mode kn = Vars.substl subst cores.(i) in create_input fix), - UState.make ~lbound:(Global.universes_lbound ()) (Global.universes ())), - !eff + UState.make ~lbound:(Global.universes_lbound ()) (Global.universes ())) -let beq_scheme_kind = declare_mutual_scheme_object "_beq" build_beq_scheme +let beq_scheme_kind = + declare_mutual_scheme_object "_beq" + ~deps:build_beq_scheme_deps + build_beq_scheme let _ = beq_scheme_kind_aux := fun () -> beq_scheme_kind @@ -401,24 +441,9 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q = let type_of_pq = Tacmach.New.pf_get_type_of gl p in let sigma = Tacmach.New.project gl in let env = Tacmach.New.pf_env gl in - let u,v = destruct_ind env sigma type_of_pq - in let lb_type_of_p = - try - let c, eff = find_scheme ~mode lb_scheme_key (fst u) (*FIXME*) in - Proofview.tclUNIT (mkConst c, eff) - with Not_found -> - (* spiwack: the format of this error message should probably - be improved. *) - let err_msg = - (str "Leibniz->boolean:" ++ - str "You have to declare the" ++ - str "decidability over " ++ - Printer.pr_econstr_env env sigma type_of_pq ++ - str " first.") - in - Tacticals.New.tclZEROMSG err_msg - in - lb_type_of_p >>= fun (lb_type_of_p,eff) -> + let u,v = destruct_ind env sigma type_of_pq in + find_scheme ~mode lb_scheme_key (fst u) (*FIXME*) >>= fun c -> + let lb_type_of_p = mkConst c in Proofview.tclEVARMAP >>= fun sigma -> let lb_args = Array.append (Array.append v @@ -428,7 +453,6 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q = then lb_type_of_p else mkApp (lb_type_of_p,lb_args) in Tacticals.New.tclTHENLIST [ - Proofview.tclEFFECTS eff; Equality.replace p q ; apply app ; Auto.default_auto] end @@ -474,22 +498,9 @@ let do_replace_bl bl_scheme_key (ind,u as indu) aavoid narg lft rgt = in if eq_ind (fst u) ind then Tacticals.New.tclTHENLIST [Equality.replace t1 t2; Auto.default_auto ; aux q1 q2 ] else ( - let bl_t1, eff = - try - let c, eff = find_scheme bl_scheme_key (fst u) (*FIXME*) in - mkConst c, eff - with Not_found -> - (* spiwack: the format of this error message should probably - be improved. *) - let err_msg = - (str "boolean->Leibniz:" ++ - str "You have to declare the" ++ - str "decidability over " ++ - Printer.pr_econstr_env env sigma tt1 ++ - str " first.") - in - user_err err_msg - in let bl_args = + find_scheme bl_scheme_key (fst u) (*FIXME*) >>= fun c -> + let bl_t1 = mkConst c in + let bl_args = Array.append (Array.append v (Array.Smart.map (fun x -> do_arg env sigma u x 1) v)) @@ -499,7 +510,6 @@ let do_replace_bl bl_scheme_key (ind,u as indu) aavoid narg lft rgt = then bl_t1 else mkApp (bl_t1,bl_args) in Tacticals.New.tclTHENLIST [ - Proofview.tclEFFECTS eff; Equality.replace_by t1 t2 (Tacticals.New.tclTHEN (apply app) (Auto.default_auto)) ; aux q1 q2 ] @@ -552,11 +562,12 @@ let eqI ind l = let list_id = list_id l in let eA = Array.of_list((List.map (fun (s,_,_,_) -> mkVar s) list_id)@ (List.map (fun (_,seq,_,_)-> mkVar seq) list_id )) - and e, eff = - try let c, eff = find_scheme beq_scheme_kind ind in mkConst c, eff - with Not_found -> user_err ~hdr:"AutoIndDecl.eqI" + and e = match lookup_scheme beq_scheme_kind ind with + | Some c -> mkConst c + | None -> + user_err ~hdr:"AutoIndDecl.eqI" (str "The boolean equality on " ++ Printer.pr_inductive (Global.env ()) ind ++ str " is needed."); - in (if Array.equal Constr.equal eA [||] then e else mkApp(e,eA)), eff + in (if Array.equal Constr.equal eA [||] then e else mkApp(e,eA)) (**********************************************************************) (* Boolean->Leibniz *) @@ -564,7 +575,7 @@ let eqI ind l = open Namegen let compute_bl_goal ind lnamesparrec nparrec = - let eqI, eff = eqI ind lnamesparrec in + let eqI = eqI ind lnamesparrec in let list_id = list_id lnamesparrec in let avoid = List.fold_right (Nameops.Name.fold_right (fun id l -> Id.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in let create_input c = @@ -605,7 +616,7 @@ let compute_bl_goal ind lnamesparrec nparrec = (mkApp(eq (),[|bb ();mkApp(eqI,[|mkVar n;mkVar m|]);tt ()|])) Sorts.Relevant (mkApp(eq (),[|mkFullInd (ind,u) (nparrec+3);mkVar n;mkVar m|])) - ))), eff + ))) let compute_bl_tact mode bl_scheme_key ind lnamesparrec nparrec = let list_id = list_id lnamesparrec in @@ -695,16 +706,19 @@ let make_bl_scheme mode mind = let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = (* TODO subst *) context_chop (nparams-nparrec) mib.mind_params_ctxt in - let bl_goal, eff = compute_bl_goal ind lnamesparrec nparrec in + let bl_goal = compute_bl_goal ind lnamesparrec nparrec in let uctx = UState.make ~lbound:(Global.universes_lbound ()) (Global.universes ()) in let side_eff = side_effect_of_mode mode in let bl_goal = EConstr.of_constr bl_goal in - let (ans, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx ~typ:bl_goal + let (ans, _, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx ~typ:bl_goal (compute_bl_tact mode (!bl_scheme_kind_aux()) (ind, EConstr.EInstance.empty) lnamesparrec nparrec) in - ([|ans|], ctx), eff + ([|ans|], ctx) -let bl_scheme_kind = declare_mutual_scheme_object "_dec_bl" make_bl_scheme +let bl_scheme_kind = + declare_mutual_scheme_object "_dec_bl" + ~deps:(fun ind -> [SchemeMutualDep (ind, beq_scheme_kind)]) + make_bl_scheme let _ = bl_scheme_kind_aux := fun () -> bl_scheme_kind @@ -715,7 +729,7 @@ let compute_lb_goal ind lnamesparrec nparrec = let list_id = list_id lnamesparrec in let eq = eq () and tt = tt () and bb = bb () in let avoid = List.fold_right (Nameops.Name.fold_right (fun id l -> Id.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in - let eqI, eff = eqI ind lnamesparrec in + let eqI = eqI ind lnamesparrec in let create_input c = let x = next_ident_away (Id.of_string "x") avoid and y = next_ident_away (Id.of_string "y") avoid in @@ -755,7 +769,7 @@ let compute_lb_goal ind lnamesparrec nparrec = (mkApp(eq,[|mkFullInd (ind,u) (nparrec+2);mkVar n;mkVar m|])) Sorts.Relevant (mkApp(eq,[|bb;mkApp(eqI,[|mkVar n;mkVar m|]);tt|])) - ))), eff + ))) let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec = let list_id = list_id lnamesparrec in @@ -825,16 +839,19 @@ let make_lb_scheme mode mind = let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = context_chop (nparams-nparrec) mib.mind_params_ctxt in - let lb_goal, eff = compute_lb_goal ind lnamesparrec nparrec in + let lb_goal = compute_lb_goal ind lnamesparrec nparrec in let uctx = UState.make ~lbound:(Global.universes_lbound ()) (Global.universes ()) in let side_eff = side_effect_of_mode mode in let lb_goal = EConstr.of_constr lb_goal in - let (ans, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx ~typ:lb_goal + let (ans, _, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx ~typ:lb_goal (compute_lb_tact mode (!lb_scheme_kind_aux()) ind lnamesparrec nparrec) in - ([|ans|], ctx), eff + ([|ans|], ctx) -let lb_scheme_kind = declare_mutual_scheme_object "_dec_lb" make_lb_scheme +let lb_scheme_kind = + declare_mutual_scheme_object "_dec_lb" + ~deps:(fun ind -> [SchemeMutualDep (ind, beq_scheme_kind)]) + make_lb_scheme let _ = lb_scheme_kind_aux := fun () -> lb_scheme_kind @@ -909,7 +926,8 @@ let compute_dec_tact ind lnamesparrec nparrec = let eq = eq () and tt = tt () and ff = ff () and bb = bb () in let list_id = list_id lnamesparrec in - let eqI, eff = eqI ind lnamesparrec in + find_scheme beq_scheme_kind ind >>= fun _ -> + let eqI = eqI ind lnamesparrec in let avoid = ref [] in let eqtrue x = mkApp(eq,[|bb;x;tt|]) in let eqfalse x = mkApp(eq,[|bb;x;ff|]) in @@ -931,21 +949,11 @@ let compute_dec_tact ind lnamesparrec nparrec = 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 - begin try - let c, eff = find_scheme bl_scheme_kind ind in - Proofview.tclUNIT (mkConst c,eff) with - Not_found -> - Tacticals.New.tclZEROMSG (str "Error during the decidability part, boolean to leibniz equality is required.") - end >>= fun (blI,eff') -> - begin try - let c, eff = find_scheme lb_scheme_kind ind in - Proofview.tclUNIT (mkConst c,eff) with - Not_found -> - Tacticals.New.tclZEROMSG (str "Error during the decidability part, leibniz to boolean equality is required.") - end >>= fun (lbI,eff'') -> - let eff = (Evd.concat_side_effects eff'' (Evd.concat_side_effects eff' eff)) in + find_scheme bl_scheme_kind ind >>= fun c -> + let blI = mkConst c in + find_scheme lb_scheme_kind ind >>= fun c -> + let lbI = mkConst c in Tacticals.New.tclTHENLIST [ - Proofview.tclEFFECTS eff; intros_using fresh_first_intros; intros_using [freshn;freshm]; (*we do this so we don't have to prove the same goal twice *) @@ -1006,11 +1014,11 @@ let make_eq_decidability mode mind = let lnonparrec,lnamesparrec = context_chop (nparams-nparrec) mib.mind_params_ctxt in let side_eff = side_effect_of_mode mode in - let (ans, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx + let (ans, _, _, _, ctx) = Declare.build_by_tactic ~poly:false ~side_eff (Global.env()) ~uctx ~typ:(EConstr.of_constr (compute_dec_goal (ind,u) lnamesparrec nparrec)) (compute_dec_tact ind lnamesparrec nparrec) in - ([|ans|], ctx), Evd.empty_side_effects + ([|ans|], ctx) let eq_dec_scheme_kind = declare_mutual_scheme_object "_eq_dec" make_eq_decidability diff --git a/vernac/classes.mli b/vernac/classes.mli index 9698c14452..f410cddfef 100644 --- a/vernac/classes.mli +++ b/vernac/classes.mli @@ -22,7 +22,7 @@ val declare_instance : ?warn:bool -> env -> Evd.evar_map -> 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 : bool -> qualid -> Hints.hint_info_expr option -> unit +val existing_instance : bool -> qualid -> ComHints.hint_info_expr option -> unit (** globality, reference, optional priority and pattern information *) val new_instance_interactive @@ -34,7 +34,7 @@ val new_instance_interactive -> ?generalize:bool -> ?tac:unit Proofview.tactic -> ?hook:(GlobRef.t -> unit) - -> Hints.hint_info_expr + -> ComHints.hint_info_expr -> (bool * constr_expr) option -> Id.t * Lemmas.t @@ -47,7 +47,7 @@ val new_instance -> (bool * constr_expr) -> ?generalize:bool -> ?hook:(GlobRef.t -> unit) - -> Hints.hint_info_expr + -> ComHints.hint_info_expr -> Id.t val new_instance_program @@ -59,7 +59,7 @@ val new_instance_program -> (bool * constr_expr) option -> ?generalize:bool -> ?hook:(GlobRef.t -> unit) - -> Hints.hint_info_expr + -> ComHints.hint_info_expr -> Id.t val declare_new_instance @@ -69,7 +69,7 @@ val declare_new_instance -> ident_decl -> local_binder_expr list -> constr_expr - -> Hints.hint_info_expr + -> ComHints.hint_info_expr -> unit (** {6 Low level interface used by Add Morphism, do not use } *) diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index 1e2e2e53e2..776ffd6b9f 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -91,7 +91,7 @@ let declare_assumptions ~poly ~scope ~kind univs nl l = let () = match scope with | Discharge -> (* declare universes separately for variables *) - Declare.declare_universe_context ~poly (context_set_of_entry (fst univs)) + DeclareUctx.declare_universe_context ~poly (context_set_of_entry (fst univs)) | Global _ -> () in let _, _ = List.fold_left (fun (subst,univs) ((is_coe,idl),typ,imps) -> @@ -161,7 +161,7 @@ let do_assumptions ~program_mode ~poly ~scope ~kind nl l = let env = EConstr.push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (make_annot id r,t)) idl) env in let ienv = List.fold_right (fun {CAst.v=id} ienv -> - let impls = compute_internalization_data env sigma Variable t imps in + let impls = compute_internalization_data env sigma id Variable t imps in Id.Map.add id impls ienv) idl ienv in ((sigma,env,ienv),((is_coe,idl),t,imps))) (sigma,env,empty_internalization_env) l @@ -191,7 +191,7 @@ let context_subst subst (name,b,t,impl) = let context_insection sigma ~poly ctx = let uctx = Evd.universe_context_set sigma in - let () = Declare.declare_universe_context ~poly uctx in + let () = DeclareUctx.declare_universe_context ~poly uctx in let fn subst (name,_,_,_ as d) = let d = context_subst subst d in let () = match d with @@ -226,7 +226,7 @@ let context_nosection sigma ~poly ctx = (* Multiple monomorphic axioms: declare universes separately to avoid redeclaring them. *) let uctx = Evd.universe_context_set sigma in - let () = Declare.declare_universe_context ~poly uctx in + let () = DeclareUctx.declare_universe_context ~poly uctx in Monomorphic_entry Univ.ContextSet.empty in let fn subst d = diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml index e4fa212a23..d3c1d2e767 100644 --- a/vernac/comFixpoint.ml +++ b/vernac/comFixpoint.ml @@ -53,7 +53,7 @@ let rec partial_order cmp = function (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 (List.remove cmp x yge)) + 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 @@ -82,16 +82,25 @@ let warn_non_full_mutual = (fun (x,xge,y,yge,isfix,rest) -> non_full_mutual_message x xge y yge isfix rest) -let check_mutuality env evd isfix fixl = +let warn_non_recursive = + CWarnings.create ~name:"non-recursive" ~category:"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' -> not (Id.equal id id') && Termops.occur_var env evd id' def) names)) + (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) | _ -> () let interp_fix_context ~program_mode ~cofix env sigma fix = @@ -222,7 +231,7 @@ let interp_recursive ~program_mode ~cofix (fixl : 'a Vernacexpr.fix_expr_gen lis 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_mutuality env evd isfix (List.combine fixnames fixdefs) + check_true_recursivity env evd isfix (List.combine fixnames fixdefs) end let ground_fixpoint env evd (fixnames,fixrs,fixdefs,fixtypes) = @@ -232,12 +241,12 @@ let ground_fixpoint env evd (fixnames,fixrs,fixdefs,fixtypes) = Evd.evar_universe_context evd, (fixnames,fixrs,fixdefs,fixtypes) (* XXX: Unify with interp_recursive *) -let interp_fixpoint ~cofix l : +let interp_fixpoint ?(check_recursivity=true) ~cofix l : ( (Constr.t, Constr.types) recursive_preentry * UState.universe_decl * UState.t * (EConstr.rel_context * Impargs.manual_implicits * int option) list) = let (env,_,pl,evd),fix,info = interp_recursive ~program_mode:false ~cofix l in - check_recursive true env evd fix; + if check_recursivity then check_recursive true env evd fix; let uctx,fix = ground_fixpoint env evd fix in (fix,pl,uctx,info) diff --git a/vernac/comFixpoint.mli b/vernac/comFixpoint.mli index a19b96f0f3..dcb61d38d9 100644 --- a/vernac/comFixpoint.mli +++ b/vernac/comFixpoint.mli @@ -58,7 +58,8 @@ val interp_recursive : (** Exported for Funind *) val interp_fixpoint - : cofix:bool + : ?check_recursivity:bool -> + cofix:bool -> lident option fix_expr_gen list -> (Constr.t, Constr.types) recursive_preentry * UState.universe_decl * UState.t * diff --git a/vernac/comHints.ml b/vernac/comHints.ml new file mode 100644 index 0000000000..5a48e9c16c --- /dev/null +++ b/vernac/comHints.ml @@ -0,0 +1,174 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +open Util + +(** (Partial) implementation of the [Hint] command; some more + functionality still lives in tactics/hints.ml *) + +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 + +let project_hint ~poly pri l2r r = + let open EConstr in + let open Coqlib in + let gr = Smartlocate.global_with_alias r in + let env = Global.env () in + let sigma = Evd.from_env env in + let sigma, c = Evd.fresh_global env sigma gr in + let t = Retyping.get_type_of env sigma c in + let t = + Tacred.reduce_to_quantified_ref env sigma (lib_ref "core.iff.type") t + in + let sign, ccl = decompose_prod_assum sigma t in + let a, b = + match snd (decompose_app sigma ccl) with + | [a; b] -> (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 sigma + (mkApp (c, Context.Rel.to_extended_vect mkRel 0 sign)) + in + let c = + it_mkLambda_or_LetIn + (mkApp + ( p + , [| mkArrow a Sorts.Relevant (Vars.lift 1 b) + ; mkArrow b Sorts.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:Declare.ImportDefaultBehavior ~name + ~kind:Decls.(IsDefinition Definition) + cb + in + let info = {Typeclasses.hint_priority = pri; hint_pattern = None} in + (info, false, true, Hints.PathAny, Hints.IsGlobRef (Names.GlobRef.ConstRef c)) + +let warn_deprecated_hint_constr = + CWarnings.create ~name:"deprecated-hint-constr" ~category:"deprecated" + (fun () -> + Pp.strbrk + "Declaring arbitrary terms as hints is deprecated; declare a global \ + reference instead") + +let interp_hints ~poly h = + let env = Global.env () in + let sigma = Evd.from_env env in + let f poly c = + let evd, c = Constrintern.interp_open_constr env sigma c in + let env = Global.env () in + let sigma = Evd.from_env env in + let c, diff = Hints.prepare_hint true env sigma (evd, c) in + if poly then (Hints.IsConstr (c, diff) [@ocaml.warning "-3"]) + else + let () = DeclareUctx.declare_universe_context ~poly:false diff in + (Hints.IsConstr (c, Univ.ContextSet.empty) [@ocaml.warning "-3"]) + 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 = Tacred.evaluable_of_global_reference env (fref r) in + let fi c = + let open Hints in + match c with + | HintsReference c -> + let gr = Smartlocate.global_with_alias c in + (PathHints [gr], poly, IsGlobRef gr) + | HintsConstr c -> + let () = warn_deprecated_hint_constr () in + (PathAny, poly, f poly c) + in + let fp = Constrintern.intern_constr_pattern env sigma in + let fres (info, b, r) = + let path, poly, gr = fi r in + let info = + { info with + Typeclasses.hint_pattern = Option.map fp info.Typeclasses.hint_pattern + } + in + (info, poly, b, path, gr) + in + let ft = + let open Hints in + function + | HintsVariables -> HintsVariables + | HintsConstants -> HintsConstants + | HintsReferences lhints -> HintsReferences (List.map fr lhints) + in + let fp = Constrintern.intern_constr_pattern (Global.env ()) in + let open Hints 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 + let mib, _ = Global.lookup_inductive ind 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 = Names.GlobRef.ConstructRef c in + ( empty_hint_info + , Declareops.inductive_is_polymorphic mib + , true + , PathHints [gr] + , IsGlobRef 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 l = match pat with None -> [] | Some (l, _) -> l in + let ltacvars = + List.fold_left + (fun accu x -> Names.Id.Set.add x accu) + Names.Id.Set.empty l + in + let env = Genintern.{(empty_glob_sign env) with ltacvars} in + let _, tacexp = Genintern.generic_intern env tacexp in + HintsExternEntry + ({Typeclasses.hint_priority = Some pri; hint_pattern = pat}, tacexp) diff --git a/vernac/comHints.mli b/vernac/comHints.mli new file mode 100644 index 0000000000..77fbef5387 --- /dev/null +++ b/vernac/comHints.mli @@ -0,0 +1,29 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* <O___,, * (see version control and CREDITS file for authors & dates) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +open Typeclasses + +type hint_info_expr = Constrexpr.constr_pattern_expr 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 + +val interp_hints : poly:bool -> hints_expr -> Hints.hints_entry diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml index 80e7e6ab96..bf38088f71 100644 --- a/vernac/comProgramFixpoint.ml +++ b/vernac/comProgramFixpoint.ml @@ -195,13 +195,14 @@ let build_wellfounded (recname,pl,bl,arityc,body) poly r measure notation = let lift_lets = lift_rel_context 1 letbinders in let sigma, intern_body = let ctx = LocalAssum (make_annot (Name recname) Sorts.Relevant, get_type curry_fun) :: binders_rel in - let (r, impls, scopes) = - Constrintern.compute_internalization_data env sigma + let interning_data = + Constrintern.compute_internalization_data env sigma recname Constrintern.Recursive full_arity impls in let newimpls = Id.Map.singleton recname - (r, impls @ [Some (ExplByName (Id.of_string "recproof"), Impargs.Manual, (true, false))], - scopes @ [None]) in + (Constrintern.extend_internalization_data interning_data + (Some (ExplByName (Id.of_string "recproof"), Impargs.Manual, (true, false))) + None) in interp_casted_constr_evars ~program_mode:true (push_rel_context ctx env) sigma ~impls:newimpls body (lift 1 top_arity) in diff --git a/tactics/declare.ml b/vernac/declare.ml index cce43e833e..f4636c5724 100644 --- a/tactics/declare.ml +++ b/vernac/declare.ml @@ -133,38 +133,8 @@ let _ = CErrors.register_handler (function type import_status = ImportDefaultBehavior | ImportNeedQualified -(** Monomorphic universes need to survive sections. *) - -let name_instance inst = - let map lvl = match Univ.Level.name lvl with - | None -> (* Having Prop/Set/Var as section universes makes no sense *) - assert false - | Some na -> - try - let qid = Nametab.shortest_qualid_of_universe na in - Name (Libnames.qualid_basename qid) - with Not_found -> - (* Best-effort naming from the string representation of the level. - See univNames.ml for a similar hack. *) - Name (Id.of_string_soft (Univ.Level.to_string lvl)) - in - Array.map map (Univ.Instance.to_array inst) - -let declare_universe_context ~poly ctx = - if poly then - let uctx = Univ.ContextSet.to_context ctx in - let nas = name_instance (Univ.UContext.instance uctx) in - Global.push_section_context (nas, uctx) - else - Global.push_context_set ~strict:true ctx - (** Declaration of constants and parameters *) -type constant_obj = { - cst_kind : Decls.logical_kind; - cst_locl : import_status; -} - type 'a proof_entry = { proof_entry_body : 'a Entries.const_entry_body; (* List of section variables *) @@ -290,8 +260,11 @@ type 'a constant_entry = | ParameterEntry of Entries.parameter_entry | PrimitiveEntry of Entries.primitive_entry -(* At load-time, the segment starting from the module name to the discharge *) -(* section (if Remark or Fact) is needed to access a construction *) +type constant_obj = { + cst_kind : Decls.logical_kind; + cst_locl : import_status; +} + let load_constant i ((sp,kn), obj) = if Nametab.exists_cci sp then raise (AlreadyDeclared (None, Libnames.basename sp)); @@ -317,8 +290,7 @@ let check_exists id = raise (AlreadyDeclared (None, id)) let cache_constant ((sp,kn), obj) = - (* Invariant: the constant must exist in the logical environment, except when - redefining it when exiting a section. See [discharge_constant]. *) + (* Invariant: the constant must exist in the logical environment *) let kn' = if Global.exists_objlabel (Label.of_id (Libnames.basename sp)) then Constant.make1 kn @@ -331,13 +303,7 @@ let cache_constant ((sp,kn), obj) = let discharge_constant ((sp, kn), obj) = Some obj -(* Hack to reduce the size of .vo: we keep only what load/open needs *) -let dummy_constant cst = { - cst_kind = cst.cst_kind; - cst_locl = cst.cst_locl; -} - -let classify_constant cst = Libobject.Substitute (dummy_constant cst) +let classify_constant cst = Libobject.Substitute cst let (objConstant : constant_obj Libobject.Dyn.tag) = let open Libobject in @@ -589,7 +555,7 @@ let declare_variable ~name ~kind d = let univs = Univ.ContextSet.union body_ui entry_ui in (* We must declare the universe constraints before type-checking the term. *) - let () = declare_universe_context ~poly univs in + let () = DeclareUctx.declare_universe_context ~poly univs in let se = { Entries.secdef_body = body; secdef_secctx = de.proof_entry_secctx; @@ -614,12 +580,12 @@ let fixpoint_message indexes l = | [] -> CErrors.anomaly (Pp.str "no recursive definition.") | [id] -> Id.print id ++ str " is recursively defined" ++ (match indexes with - | Some [|i|] -> str " (decreasing on "++pr_rank i++str " argument)" + | 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 "(decreasing respectively on " ++ + | Some a -> spc () ++ str "(guarded respectively on " ++ prvect_with_sep pr_comma pr_rank a ++ str " arguments)" | None -> mt ())) @@ -796,7 +762,7 @@ let build_constant_by_tactic ~name ?(opaque=Transparent) ~uctx ~sign ~poly typ t let build_by_tactic ?(side_eff=true) 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 ce, status, univs = build_constant_by_tactic ~name ~uctx ~sign ~poly typ tac in + let ce, status, uctx = build_constant_by_tactic ~name ~uctx ~sign ~poly typ tac in let cb, uctx = if side_eff then inline_private_constants ~uctx env ce else @@ -804,7 +770,7 @@ let build_by_tactic ?(side_eff=true) env ~uctx ~poly ~typ tac = let (cb, ctx), _eff = Future.force ce.proof_entry_body in cb, UState.merge ~sideff:false Evd.univ_rigid uctx ctx in - cb, ce.proof_entry_type, status, univs + cb, ce.proof_entry_type, ce.proof_entry_universes, status, uctx let declare_abstract ~name ~poly ~kind ~sign ~secsign ~opaque ~solve_tac sigma concl = (* EJGA: flush_and_check_evars is only used in abstract, could we @@ -899,3 +865,15 @@ module Proof = struct let update_global_env = update_global_env let get_open_goals = get_open_goals end + +let declare_definition_scheme ~internal ~univs ~role ~name 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 + let () = if internal then () else definition_message name in + kn, eff + +let _ = Ind_tables.declare_definition_scheme := declare_definition_scheme +let _ = Abstract.declare_abstract := declare_abstract + +let declare_universe_context = DeclareUctx.declare_universe_context diff --git a/tactics/declare.mli b/vernac/declare.mli index 1fabf80b2a..a297f25868 100644 --- a/tactics/declare.mli +++ b/vernac/declare.mli @@ -135,8 +135,6 @@ type 'a constant_entry = | ParameterEntry of parameter_entry | PrimitiveEntry of primitive_entry -val declare_universe_context : poly:bool -> Univ.ContextSet.t -> unit - val declare_variable : name:variable -> kind:Decls.logical_kind @@ -162,16 +160,6 @@ val definition_entry -> constr -> Evd.side_effects proof_entry -(** XXX: Scheduled for removal from public API, use `DeclareDef` instead *) -val pure_definition_entry - : ?fix_exn:Future.fix_exn - -> ?opaque:bool - -> ?inline:bool - -> ?types:types - -> ?univs:Entries.universes_entry - -> constr - -> unit proof_entry - type import_status = ImportDefaultBehavior | ImportNeedQualified (** [declare_constant id cd] declares a global declaration @@ -189,14 +177,6 @@ val declare_constant -> Evd.side_effects constant_entry -> Constant.t -val declare_private_constant - : ?role:Evd.side_effect_role - -> ?local:import_status - -> name:Id.t - -> kind:Decls.logical_kind - -> unit proof_entry - -> Constant.t * Evd.side_effects - (** [inline_private_constants ~sideff ~uctx env ce] will inline the constants in [ce]'s body and return the body plus the updated [UState.t]. @@ -262,19 +242,6 @@ val close_future_proof : feedback_id:Stateid.t -> Proof.t -> closed_proof_output Returns [false] if an unsafe tactic has been used. *) val by : unit Proofview.tactic -> Proof.t -> Proof.t * bool -(** Declare abstract constant; will check no evars are possible; *) -val declare_abstract : - name:Names.Id.t - -> poly:bool - -> kind:Decls.logical_kind - -> sign:EConstr.named_context - -> secsign:Environ.named_context_val - -> opaque:bool - -> solve_tac:unit Proofview.tactic - -> Evd.evar_map - -> EConstr.t - -> Evd.side_effects * Evd.evar_map * EConstr.t * EConstr.t list * bool - val build_by_tactic : ?side_eff:bool -> Environ.env @@ -282,7 +249,7 @@ val build_by_tactic -> poly:bool -> typ:EConstr.types -> unit Proofview.tactic - -> Constr.constr * Constr.types option * bool * UState.t + -> Constr.constr * Constr.types option * Entries.universes_entry * bool * UState.t (** {6 Helpers to obtain proof state when in an interactive proof } *) @@ -312,3 +279,6 @@ val build_constant_by_tactic : EConstr.types -> unit Proofview.tactic -> Evd.side_effects proof_entry * bool * UState.t + +val declare_universe_context : poly:bool -> Univ.ContextSet.t -> unit +[@@ocaml.deprecated "Use DeclareUctx.declare_universe_context"] diff --git a/vernac/declareDef.ml b/vernac/declareDef.ml index 601e7e060c..1809c2bc91 100644 --- a/vernac/declareDef.ml +++ b/vernac/declareDef.ml @@ -112,7 +112,7 @@ let declare_mutually_recursive ~opaque ~scope ~kind ~poly ~uctx ~udecl ~ntns ~re declare_entry ~name ~scope ~kind ~impargs ~uctx entry) fixitems fixdecls in - let isfix = Option.is_empty possible_indexes in + let isfix = Option.has_some possible_indexes in let fixnames = List.map (fun { Recthm.name } -> name) fixitems in Declare.recursive_message isfix indexes fixnames; List.iter (Metasyntax.add_notation_interpretation (Global.env())) ntns; diff --git a/vernac/declareUniv.ml b/vernac/declareUniv.ml index 20fa43c8e7..89f3503f4d 100644 --- a/vernac/declareUniv.ml +++ b/vernac/declareUniv.ml @@ -94,7 +94,7 @@ let do_universe ~poly l = in let src = if poly then BoundUniv else UnqualifiedUniv in let () = Lib.add_anonymous_leaf (input_univ_names (src, l)) in - Declare.declare_universe_context ~poly ctx + DeclareUctx.declare_universe_context ~poly ctx let do_constraint ~poly l = let open Univ in @@ -107,4 +107,4 @@ let do_constraint ~poly l = Constraint.empty l in let uctx = ContextSet.add_constraints constraints ContextSet.empty in - Declare.declare_universe_context ~poly uctx + DeclareUctx.declare_universe_context ~poly uctx diff --git a/vernac/declaremods.ml b/vernac/declaremods.ml index 438509e28a..50fa6052f6 100644 --- a/vernac/declaremods.ml +++ b/vernac/declaremods.ml @@ -651,26 +651,28 @@ let mk_params_entry args = let mk_funct_type env args seb0 = List.fold_left - (fun seb (arg_id,arg_t,arg_inl) -> + (fun (seb,cst) (arg_id,arg_t,arg_inl) -> let mp = MPbound arg_id in - let arg_t = Mod_typing.translate_modtype env mp arg_inl ([],arg_t) in - MoreFunctor(arg_id,arg_t,seb)) + let arg_t, cst' = Mod_typing.translate_modtype env mp arg_inl ([],arg_t) in + MoreFunctor(arg_id,arg_t,seb), Univ.Constraint.union cst cst') seb0 args (** Prepare the module type list for check of subtypes *) let build_subtypes env mp args mtys = - let (cst, ans) = List.fold_left_map - (fun cst (m,ann) -> + let (ctx, ans) = List.fold_left_map + (fun ctx (m,ann) -> let inl = inl2intopt ann in - let mte, _, cst' = Modintern.interp_module_ast env Modintern.ModType m in - let env = Environ.push_context_set ~strict:true cst' env in - let cst = Univ.ContextSet.union cst cst' in - let mtb = Mod_typing.translate_modtype env mp inl ([],mte) in - cst, { mtb with mod_type = mk_funct_type env args mtb.mod_type }) + let mte, _, ctx' = Modintern.interp_module_ast env Modintern.ModType m in + let env = Environ.push_context_set ~strict:true ctx' env in + let ctx = Univ.ContextSet.union ctx ctx' in + let mtb, cst = Mod_typing.translate_modtype env mp inl ([],mte) in + let mod_type, cst = mk_funct_type env args (mtb.mod_type,cst) in + let ctx = Univ.ContextSet.add_constraints cst ctx in + ctx, { mtb with mod_type }) Univ.ContextSet.empty mtys in - (ans, cst) + (ans, ctx) (** {6 Current module information} @@ -703,23 +705,23 @@ module RawModOps = struct let start_module export id args res fs = let mp = Global.start_module id in - let arg_entries_r, cst = intern_args args in - let () = Global.push_context_set ~strict:true cst in + let arg_entries_r, ctx = intern_args args in + let () = Global.push_context_set ~strict:true ctx in let env = Global.env () in - let res_entry_o, subtyps, cst = match res with + let res_entry_o, subtyps, ctx = match res with | Enforce (res,ann) -> let inl = inl2intopt ann in - let (mte, _, cst) = Modintern.interp_module_ast env Modintern.ModType res in - let env = Environ.push_context_set ~strict:true cst env in + let (mte, _, ctx) = Modintern.interp_module_ast env Modintern.ModType res in + let env = Environ.push_context_set ~strict:true ctx env in (* We check immediately that mte is well-formed *) - let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in - let cst = Univ.ContextSet.union cst cst' in - Some (mte, inl), [], cst + let _, _, _, cst = Mod_typing.translate_mse env None inl mte in + let ctx = Univ.ContextSet.add_constraints cst ctx in + Some (mte, inl), [], ctx | Check resl -> - let typs, cst = build_subtypes env mp arg_entries_r resl in - None, typs, cst + let typs, ctx = build_subtypes env mp arg_entries_r resl in + None, typs, ctx in - let () = Global.push_context_set ~strict:true cst in + let () = Global.push_context_set ~strict:true ctx in openmod_info := { cur_typ = res_entry_o; cur_typs = subtyps }; let prefix = Lib.start_module export id mp fs in Nametab.(push_dir (Until 1) (prefix.obj_dir) (GlobDirRef.DirOpenModule prefix)); @@ -763,37 +765,38 @@ let end_module () = mp +(* TODO cleanup push universes directly to global env *) let declare_module id args res mexpr_o fs = (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp = Global.start_module id in - let arg_entries_r, cst = intern_args args in + let arg_entries_r, ctx = intern_args args in let params = mk_params_entry arg_entries_r in let env = Global.env () in - let env = Environ.push_context_set ~strict:true cst env in - let mty_entry_o, subs, inl_res, cst' = match res with + let env = Environ.push_context_set ~strict:true ctx env in + let mty_entry_o, subs, inl_res, ctx' = match res with | Enforce (mty,ann) -> let inl = inl2intopt ann in - let (mte, _, cst) = Modintern.interp_module_ast env Modintern.ModType mty in - let env = Environ.push_context_set ~strict:true cst env in + let (mte, _, ctx) = Modintern.interp_module_ast env Modintern.ModType mty in + let env = Environ.push_context_set ~strict:true ctx env in (* We check immediately that mte is well-formed *) - let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in - let cst = Univ.ContextSet.union cst cst' in - Some mte, [], inl, cst + let _, _, _, cst = Mod_typing.translate_mse env None inl mte in + let ctx = Univ.ContextSet.add_constraints cst ctx in + Some mte, [], inl, ctx | Check mtys -> - let typs, cst = build_subtypes env mp arg_entries_r mtys in - None, typs, default_inline (), cst + let typs, ctx = build_subtypes env mp arg_entries_r mtys in + None, typs, default_inline (), ctx in - let env = Environ.push_context_set ~strict:true cst' env in - let cst = Univ.ContextSet.union cst cst' in - let mexpr_entry_o, inl_expr, cst' = match mexpr_o with + let env = Environ.push_context_set ~strict:true ctx' env in + let ctx = Univ.ContextSet.union ctx ctx' in + let mexpr_entry_o, inl_expr, ctx' = match mexpr_o with | None -> None, default_inline (), Univ.ContextSet.empty | Some (mexpr,ann) -> - let (mte, _, cst) = Modintern.interp_module_ast env Modintern.Module mexpr in - Some mte, inl2intopt ann, cst + let (mte, _, ctx) = Modintern.interp_module_ast env Modintern.Module mexpr in + Some mte, inl2intopt ann, ctx in - let env = Environ.push_context_set ~strict:true cst' env in - let cst = Univ.ContextSet.union cst cst' in + let env = Environ.push_context_set ~strict:true ctx' env in + let ctx = Univ.ContextSet.union ctx ctx' in let entry = match mexpr_entry_o, mty_entry_o with | None, None -> assert false (* No body, no type ... *) | None, Some typ -> MType (params, typ) @@ -812,7 +815,7 @@ let declare_module id args res mexpr_o fs = | None -> None | _ -> inl_res in - let () = Global.push_context_set ~strict:true cst in + let () = Global.push_context_set ~strict:true ctx in let mp_env,resolver = Global.add_module id entry inl in (* Name consistency check : kernel vs. library *) @@ -864,20 +867,20 @@ let declare_modtype id args mtys (mty,ann) fs = (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp = Global.start_modtype id in - let arg_entries_r, cst = intern_args args in - let () = Global.push_context_set ~strict:true cst in + let arg_entries_r, ctx = intern_args args in + let () = Global.push_context_set ~strict:true ctx in let params = mk_params_entry arg_entries_r in let env = Global.env () in - let mte, _, cst = Modintern.interp_module_ast env Modintern.ModType mty in - let () = Global.push_context_set ~strict:true cst in + let mte, _, ctx = Modintern.interp_module_ast env Modintern.ModType mty in + let () = Global.push_context_set ~strict:true ctx in let env = Global.env () in (* We check immediately that mte is well-formed *) let _, _, _, cst = Mod_typing.translate_mse env None inl mte in - let () = Global.push_context_set ~strict:true cst in + let () = Global.push_context_set ~strict:true (Univ.LSet.empty,cst) in let env = Global.env () in let entry = params, mte in - let sub_mty_l, cst = build_subtypes env mp arg_entries_r mtys in - let () = Global.push_context_set ~strict:true cst in + let sub_mty_l, ctx = build_subtypes env mp arg_entries_r mtys in + let () = Global.push_context_set ~strict:true ctx in let env = Global.env () in let sobjs = get_functor_sobjs false env inl entry in let subst = map_mp (get_module_path (snd entry)) mp empty_delta_resolver in diff --git a/vernac/g_proofs.mlg b/vernac/g_proofs.mlg index 058fa691ee..e84fce5504 100644 --- a/vernac/g_proofs.mlg +++ b/vernac/g_proofs.mlg @@ -14,6 +14,7 @@ open Glob_term open Constrexpr open Vernacexpr open Hints +open ComHints open Pcoq open Pcoq.Prim diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg index 75d329e77c..3cb10364b5 100644 --- a/vernac/g_vernac.mlg +++ b/vernac/g_vernac.mlg @@ -889,23 +889,23 @@ GRAMMAR EXTEND Gram | IDENT "Print"; IDENT "Table"; table = option_table -> { VernacPrintOption table } - | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value + | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 table_value -> { 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 option_ref_value -> + | IDENT "Add"; table = IDENT; v = LIST1 table_value -> { VernacAddOption ([table], v) } - | IDENT "Test"; table = option_table; "for"; v = LIST1 option_ref_value + | IDENT "Test"; table = option_table; "for"; v = LIST1 table_value -> { VernacMemOption (table, v) } | IDENT "Test"; table = option_table -> { VernacPrintOption table } - | IDENT "Remove"; table = IDENT; field = IDENT; v= LIST1 option_ref_value + | IDENT "Remove"; table = IDENT; field = IDENT; v= LIST1 table_value -> { VernacRemoveOption ([table;field], v) } - | IDENT "Remove"; table = IDENT; v = LIST1 option_ref_value -> + | IDENT "Remove"; table = IDENT; v = LIST1 table_value -> { VernacRemoveOption ([table], v) } ]] ; query_command: (* TODO: rapprocher Eval et Check *) @@ -998,9 +998,9 @@ GRAMMAR EXTEND Gram | n = integer -> { OptionSetInt n } | s = STRING -> { OptionSetString s } ] ] ; - option_ref_value: - [ [ id = global -> { QualidRefValue id } - | s = STRING -> { StringRefValue s } ] ] + table_value: + [ [ id = global -> { Goptions.QualidRefValue id } + | s = STRING -> { Goptions.StringRefValue s } ] ] ; option_table: [ [ fl = LIST1 [ x = IDENT -> { x } ] -> { fl } ]] diff --git a/vernac/himsg.ml b/vernac/himsg.ml index 5555a2c68e..41f2ab9c63 100644 --- a/vernac/himsg.ml +++ b/vernac/himsg.ml @@ -57,16 +57,16 @@ let contract3 env sigma a b c = match contract env sigma [a;b;c] with 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_vect env sigma a v = - match contract env sigma (a :: Array.to_list v) with - | env, a::l -> env,a,Array.of_list l +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 env',d,args = contract1_vect env' sigma d args in + let env',d,args = contract1 env' sigma d 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 @@ -299,9 +299,9 @@ let explain_unification_error env sigma p1 p2 = function [str "cannot instantiate " ++ quote (pr_existential_key sigma evk) ++ strbrk " because " ++ pr_leconstr_env env sigma c ++ strbrk " is not in its scope" ++ - (if Array.is_empty args then mt() else + (if List.is_empty args then mt() else strbrk ": available arguments are " ++ - pr_sequence (pr_leconstr_env env sigma) (List.rev (Array.to_list args)))] + pr_sequence (pr_leconstr_env env sigma) (List.rev args))] | NotSameArgSize | NotSameHead | NoCanonicalStructure -> (* Error speaks from itself *) [] | ConversionFailed (env,t1,t2) -> @@ -729,9 +729,9 @@ let explain_undeclared_universe env sigma l = spc () ++ str "(maybe a bugged tactic)." let explain_disallowed_sprop () = - Pp.(strbrk "SProp not allowed, you need to " - ++ str "Set Allow StrictProp" - ++ strbrk " or to use the -allow-sprop command-line-flag.") + Pp.(strbrk "SProp is disallowed because the " + ++ str "\"Allow StrictProp\"" + ++ strbrk " flag is off.") let explain_bad_relevance env = strbrk "Bad relevance (maybe a bugged tactic)." diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml index 7260b13ff6..6ffa88874b 100644 --- a/vernac/indschemes.ml +++ b/vernac/indschemes.ml @@ -91,12 +91,11 @@ let () = optwrite = (fun b -> rewriting_flag := b) } (* Util *) - let define ~poly name sigma c types = - let f = declare_constant ~kind:Decls.(IsDefinition Scheme) in let univs = Evd.univ_entry ~poly sigma in let entry = Declare.definition_entry ~univs ?types c in - let kn = f ~name (DefinitionEntry entry) in + let kind = Decls.(IsDefinition Scheme) in + let kn = declare_constant ~kind ~name (DefinitionEntry entry) in definition_message name; kn diff --git a/vernac/library.ml b/vernac/library.ml index 01f5101764..85db501e84 100644 --- a/vernac/library.ml +++ b/vernac/library.ml @@ -20,11 +20,11 @@ open Libobject (*s Low-level interning/externing of libraries to files *) let raw_extern_library f = - System.raw_extern_state Coq_config.vo_magic_number f + ObjFile.open_out ~file:f let raw_intern_library f = System.with_magic_number_check - (System.raw_intern_state Coq_config.vo_magic_number) f + (fun file -> ObjFile.open_in ~file) f (************************************************************************) (** Serialized objects loaded on-the-fly *) @@ -35,7 +35,7 @@ module Delayed : sig type 'a delayed -val in_delayed : string -> in_channel -> 'a delayed * Digest.t +val in_delayed : string -> ObjFile.in_handle -> segment:string -> 'a delayed * Digest.t val fetch_delayed : 'a delayed -> 'a end = @@ -43,28 +43,32 @@ struct type 'a delayed = { del_file : string; - del_off : int; + del_off : int64; del_digest : Digest.t; } -let in_delayed f ch = - let pos = pos_in ch in - let _, digest = System.skip_in_segment f ch in - ({ del_file = f; del_digest = digest; del_off = pos; }, digest) +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 - try - let ch = raw_intern_library f in - let () = seek_in ch pos in - let obj, _, digest' = System.marshal_in_segment f ch in - let () = close_in ch in - if not (String.equal digest digest') then raise (Faulty f); - obj - with e when CErrors.noncritical e -> raise (Faulty f) + 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 @@ -92,7 +96,7 @@ type summary_disk = { type library_t = { library_name : compilation_unit_name; - library_data : library_disk delayed; + library_data : library_disk; library_deps : (compilation_unit_name * Safe_typing.vodigest) array; library_digests : Safe_typing.vodigest; library_extra_univs : Univ.ContextSet.t; @@ -200,7 +204,7 @@ let access_table what tables dp i = with Faulty f -> user_err ~hdr:"Library.access_table" (str "The file " ++ str f ++ str " (bound to " ++ str dir_path ++ - str ") is inaccessible or corrupted,\ncannot load some " ++ + str ") is corrupted,\ncannot load some " ++ str what ++ str " in it.\n") in tables := DPmap.add dp (Fetched t) !tables; @@ -242,12 +246,11 @@ let mk_summary m = { let intern_from_file f = let ch = raw_intern_library f in - let (lsd : seg_sum), _, digest_lsd = System.marshal_in_segment f ch in - let ((lmd : seg_lib delayed), digest_lmd) = in_delayed f ch in - let (univs : seg_univ option), _, digest_u = System.marshal_in_segment f ch in - let _ = System.skip_in_segment f ch in - let ((del_opaque : seg_proofs delayed),_) = in_delayed f ch in - close_in ch; + let (lsd : seg_sum), digest_lsd = ObjFile.marshal_in_segment ch ~segment:"summary" in + let ((lmd : seg_lib), digest_lmd) = ObjFile.marshal_in_segment ch ~segment:"library" in + let (univs : seg_univ option), digest_u = ObjFile.marshal_in_segment ch ~segment:"universes" in + let ((del_opaque : seg_proofs delayed),_) = in_delayed f ch ~segment:"opaques" in + ObjFile.close_in ch; register_library_filename lsd.md_name f; add_opaque_table lsd.md_name (ToFetch del_opaque); let open Safe_typing in @@ -297,7 +300,7 @@ let rec_intern_library ~lib_resolver libs (dir, f) = let native_name_from_filename f = let ch = raw_intern_library f in - let (lmd : seg_sum), pos, digest_lmd = System.marshal_in_segment f ch in + let (lmd : seg_sum), digest_lmd = ObjFile.marshal_in_segment ch ~segment:"summary" in Nativecode.mod_uid_of_dirpath lmd.md_name (**********************************************************************) @@ -318,7 +321,7 @@ let native_name_from_filename f = *) let register_library m = - let l = fetch_delayed m.library_data in + let l = m.library_data in Declaremods.register_library m.library_name l.md_compiled @@ -392,12 +395,12 @@ let require_library_from_dirpath ~lib_resolver modrefl export = let load_library_todo f = let ch = raw_intern_library f in - let (s0 : seg_sum), _, _ = System.marshal_in_segment f ch in - let (s1 : seg_lib), _, _ = System.marshal_in_segment f ch in - let (s2 : seg_univ option), _, _ = System.marshal_in_segment f ch in - let tasks, _, _ = System.marshal_in_segment f ch in - let (s4 : seg_proofs), _, _ = System.marshal_in_segment f ch in - close_in ch; + let (s0 : seg_sum), _ = ObjFile.marshal_in_segment ch ~segment:"summary" in + let (s1 : seg_lib), _ = ObjFile.marshal_in_segment ch ~segment:"library" in + let (s2 : seg_univ option), _ = ObjFile.marshal_in_segment ch ~segment:"universes" in + let tasks, _ = ObjFile.marshal_in_segment ch ~segment:"tasks" in + let (s4 : seg_proofs), _ = ObjFile.marshal_in_segment ch ~segment:"opaques" in + ObjFile.close_in ch; if tasks = None then user_err ~hdr:"restart" (str"not a .vio file"); if s2 = None then user_err ~hdr:"restart" (str"not a .vio file"); if snd (Option.get s2) then user_err ~hdr:"restart" (str"not a .vio file"); @@ -433,15 +436,15 @@ let error_recursively_dependent_library dir = let save_library_base f sum lib univs tasks proofs = let ch = raw_extern_library f in try - System.marshal_out_segment f ch (sum : seg_sum); - System.marshal_out_segment f ch (lib : seg_lib); - System.marshal_out_segment f ch (univs : seg_univ option); - System.marshal_out_segment f ch (tasks : 'tasks option); - System.marshal_out_segment f ch (proofs : seg_proofs); - close_out ch + ObjFile.marshal_out_segment ch ~segment:"summary" (sum : seg_sum); + ObjFile.marshal_out_segment ch ~segment:"library" (lib : seg_lib); + ObjFile.marshal_out_segment ch ~segment:"universes" (univs : seg_univ option); + ObjFile.marshal_out_segment ch ~segment:"tasks" (tasks : 'tasks option); + ObjFile.marshal_out_segment ch ~segment:"opaques" (proofs : seg_proofs); + ObjFile.close_out ch with reraise -> let reraise = Exninfo.capture reraise in - close_out ch; + ObjFile.close_out ch; Feedback.msg_warning (str "Removed file " ++ str f); Sys.remove f; Exninfo.iraise reraise diff --git a/vernac/obligations.ml b/vernac/obligations.ml index 060f069419..bed593234b 100644 --- a/vernac/obligations.ml +++ b/vernac/obligations.ml @@ -133,7 +133,7 @@ let solve_by_tac ?loc name evi t poly uctx = try (* the status is dropped. *) let env = Global.env () in - let body, types, _, uctx = + let body, types, _univs, _, uctx = Declare.build_by_tactic env ~uctx ~poly ~typ:evi.evar_concl t in Inductiveops.control_only_guard env (Evd.from_ctx uctx) (EConstr.of_constr body); Some (body, types, uctx) diff --git a/vernac/pfedit.ml b/vernac/pfedit.ml index d6b9592176..e6c66ee503 100644 --- a/vernac/pfedit.ml +++ b/vernac/pfedit.ml @@ -1,9 +1,19 @@ (* Compat API / *) let get_current_context = Declare.get_current_context +[@@ocaml.deprecated "Use [Declare.get_current_context]"] let solve = Proof.solve +[@@ocaml.deprecated "Use [Proof.solve]"] let by = Declare.by +[@@ocaml.deprecated "Use [Declare.by]"] let refine_by_tactic = Proof.refine_by_tactic +[@@ocaml.deprecated "Use [Proof.refine_by_tactic]"] (* We don't want to export this anymore, but we do for now *) -let build_by_tactic = Declare.build_by_tactic +let build_by_tactic ?side_eff env ~uctx ~poly ~typ tac = + let b, t, _unis, safe, uctx = + Declare.build_by_tactic ?side_eff env ~uctx ~poly ~typ tac in + b, t, safe, uctx +[@@ocaml.deprecated "Use [Proof.build_by_tactic]"] + let build_constant_by_tactic = Declare.build_constant_by_tactic +[@@ocaml.deprecated "Use [Proof.build_constant_by_tactic]"] diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml index 7a2e6d8b03..f1aae239aa 100644 --- a/vernac/ppvernac.ml +++ b/vernac/ppvernac.ml @@ -168,8 +168,8 @@ open Pputils keyword "Search" ++ spc() ++ prlist_with_sep spc pr_search sl ++ pr_in_out_modules b let pr_option_ref_value = function - | QualidRefValue id -> pr_qualid id - | StringRefValue s -> qs s + | Goptions.QualidRefValue id -> pr_qualid id + | Goptions.StringRefValue s -> qs s let pr_printoption table b = prlist_with_sep spc str table ++ @@ -185,7 +185,7 @@ open Pputils | [] -> mt() | _ as z -> str":" ++ spc() ++ prlist_with_sep sep str z - let pr_reference_or_constr pr_c = let open Hints in function + let pr_reference_or_constr pr_c = let open ComHints in function | HintsReference r -> pr_qualid r | HintsConstr c -> pr_c c @@ -202,6 +202,7 @@ open Pputils let opth = pr_opt_hintbases db in let pph = let open Hints in + let open ComHints in match h with | HintsResolve l -> keyword "Resolve " ++ prlist_with_sep sep diff --git a/vernac/proof_global.ml b/vernac/proof_global.ml index b6c07042e2..54d1db44a4 100644 --- a/vernac/proof_global.ml +++ b/vernac/proof_global.ml @@ -1,7 +1,12 @@ (* compatibility module; can be removed once we agree on the API *) type t = Declare.Proof.t +[@@ocaml.deprecated "Use [Declare.Proof.t]"] let map_proof = Declare.Proof.map_proof +[@@ocaml.deprecated "Use [Declare.Proof.map_proof]"] let get_proof = Declare.Proof.get_proof +[@@ocaml.deprecated "Use [Declare.Proof.get_proof]"] -type opacity_flag = Declare.opacity_flag = Opaque | Transparent +type opacity_flag = Declare.opacity_flag = + | Opaque [@ocaml.deprecated "Use [Declare.Opaque]"] + | Transparent [@ocaml.deprecated "Use [Declare.Transparent]"] diff --git a/vernac/pvernac.mli b/vernac/pvernac.mli index 4de12f5e3b..2b6beaf2e3 100644 --- a/vernac/pvernac.mli +++ b/vernac/pvernac.mli @@ -28,7 +28,7 @@ module Vernac_ : val command_entry : vernac_expr Entry.t val main_entry : vernac_control option Entry.t val red_expr : raw_red_expr Entry.t - val hint_info : Hints.hint_info_expr Entry.t + val hint_info : ComHints.hint_info_expr Entry.t end (* To be removed when the parser is made functional wrt the tactic diff --git a/vernac/record.ml b/vernac/record.ml index 0b6e8cd8c1..9fda98d08e 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -71,7 +71,7 @@ let interp_fields_evars env sigma ~ninds ~nparams impls_env nots l = let impls = match i with | Anonymous -> impls - | Name id -> Id.Map.add id (compute_internalization_data env sigma Constrintern.Method t' impl) impls + | Name id -> Id.Map.add id (compute_internalization_data env sigma id Constrintern.Method t' impl) impls in let d = match b' with | None -> LocalAssum (make_annot i r,t') diff --git a/vernac/retrieveObl.ml b/vernac/retrieveObl.ml index c529972b8d..b8564037e0 100644 --- a/vernac/retrieveObl.ml +++ b/vernac/retrieveObl.ml @@ -72,7 +72,7 @@ let subst_evar_constr evm evs n idf t = *) let args = let n = match chop with None -> 0 | Some c -> c in - let l, r = CList.chop n (List.rev (Array.to_list args)) in + let l, r = CList.chop n (List.rev args) in List.rev r in let args = diff --git a/vernac/vernac.mllib b/vernac/vernac.mllib index b7728fe699..6d5d16d94a 100644 --- a/vernac/vernac.mllib +++ b/vernac/vernac.mllib @@ -9,6 +9,8 @@ Himsg Locality Egramml Vernacextend +Declare +ComHints Ppvernac Proof_using Egramcoq diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 044e479aeb..df94f69cf6 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -475,7 +475,7 @@ let program_inference_hook env sigma ev = Evarutil.is_ground_term sigma concl) then None else - let c, _, _, ctx = + let c, _, _, _, ctx = Declare.build_by_tactic ~poly:false env ~uctx:(Evd.evar_universe_context sigma) ~typ:concl tac in Some (Evd.set_universe_context sigma ctx, EConstr.of_constr c) @@ -1275,7 +1275,7 @@ let vernac_hints ~atts dbnames h = "This command does not support the export attribute in sections."); | OptDefault | OptLocal -> () in - Hints.add_hints ~locality dbnames (Hints.interp_hints ~poly h) + Hints.add_hints ~locality dbnames (ComHints.interp_hints ~poly h) let vernac_syntactic_definition ~atts lid x only_parsing = let module_local, deprecation = Attributes.(parse Notations.(module_locality ++ deprecation) atts) in @@ -1302,6 +1302,7 @@ let vernac_generalizable ~local = Implicit_quantifiers.declare_generalizable ~local let allow_sprop_opt_name = ["Allow";"StrictProp"] +let cumul_sprop_opt_name = ["Cumulative";"StrictProp"] let () = declare_bool_option @@ -1313,6 +1314,13 @@ let () = let () = declare_bool_option { optdepr = false; + optkey = cumul_sprop_opt_name; + optread = Global.is_cumulative_sprop; + optwrite = Global.set_cumulative_sprop } + +let () = + declare_bool_option + { optdepr = false; optkey = ["Silent"]; optread = (fun () -> !Flags.quiet); optwrite = ((:=) Flags.quiet) } @@ -1487,21 +1495,21 @@ let () = optread = CWarnings.get_flags; optwrite = CWarnings.set_flags } -let _ = +let () = declare_bool_option { optdepr = false; optkey = ["Guard"; "Checking"]; optread = (fun () -> (Global.typing_flags ()).Declarations.check_guarded); optwrite = (fun b -> Global.set_check_guarded b) } -let _ = +let () = declare_bool_option { optdepr = false; optkey = ["Positivity"; "Checking"]; optread = (fun () -> (Global.typing_flags ()).Declarations.check_positive); optwrite = (fun b -> Global.set_check_positive b) } -let _ = +let () = declare_bool_option { optdepr = false; optkey = ["Universe"; "Checking"]; @@ -1554,26 +1562,11 @@ let vernac_set_option ~locality table v = match v with vernac_set_option0 ~locality table v | _ -> vernac_set_option0 ~locality table v -let vernac_add_option key lv = - let f = function - | StringRefValue s -> (get_string_table key).add (Global.env()) s - | QualidRefValue locqid -> (get_ref_table key).add (Global.env()) locqid - in - try List.iter f lv with Not_found -> error_undeclared_key key +let vernac_add_option = iter_table { aux = fun table -> table.add } -let vernac_remove_option key lv = - let f = function - | StringRefValue s -> (get_string_table key).remove (Global.env()) s - | QualidRefValue locqid -> (get_ref_table key).remove (Global.env()) locqid - in - try List.iter f lv with Not_found -> error_undeclared_key key +let vernac_remove_option = iter_table { aux = fun table -> table.remove } -let vernac_mem_option key lv = - let f = function - | StringRefValue s -> (get_string_table key).mem (Global.env()) s - | QualidRefValue locqid -> (get_ref_table key).mem (Global.env()) locqid - in - try List.iter f lv with Not_found -> error_undeclared_key key +let vernac_mem_option = iter_table { aux = fun table -> table.mem } let vernac_print_option key = try (get_ref_table key).print () @@ -1734,7 +1727,8 @@ let vernac_print ~pstate ~atts = | PrintHintGoal -> begin match pstate with | Some pstate -> - Hints.pr_applicable_hint pstate + let pf = Declare.Proof.get_proof pstate in + Hints.pr_applicable_hint pf | None -> str "No proof in progress" end diff --git a/vernac/vernacentries.mli b/vernac/vernacentries.mli index 2ac8458ad5..cf233248d7 100644 --- a/vernac/vernacentries.mli +++ b/vernac/vernacentries.mli @@ -26,3 +26,4 @@ val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr val command_focus : unit Proof.focus_kind val allow_sprop_opt_name : string list +val cumul_sprop_opt_name : string list diff --git a/vernac/vernacexpr.ml b/vernac/vernacexpr.ml index c32ac414ba..b65a0da1cc 100644 --- a/vernac/vernacexpr.ml +++ b/vernac/vernacexpr.ml @@ -121,10 +121,6 @@ type option_setting = | OptionSetInt of int | OptionSetString of string -type option_ref_value = - | StringRefValue of string - | QualidRefValue of qualid - (** Identifier and optional list of bound universes and constraints. *) type sort_expr = Sorts.family @@ -340,18 +336,18 @@ type nonrec vernac_expr = local_binder_expr list * (* binders *) constr_expr * (* type *) (bool * constr_expr) option * (* body (bool=true when using {}) *) - Hints.hint_info_expr + ComHints.hint_info_expr | VernacDeclareInstance of ident_decl * (* name *) local_binder_expr list * (* binders *) constr_expr * (* type *) - Hints.hint_info_expr + ComHints.hint_info_expr | VernacContext of local_binder_expr list | VernacExistingInstance of - (qualid * Hints.hint_info_expr) list (* instances names, priorities and patterns *) + (qualid * ComHints.hint_info_expr) list (* instances names, priorities and patterns *) | VernacExistingClass of qualid (* inductive or definition name *) @@ -391,7 +387,7 @@ type nonrec vernac_expr = (* Commands *) | VernacCreateHintDb of string * bool | VernacRemoveHints of string list * qualid list - | VernacHints of string list * Hints.hints_expr + | VernacHints of string list * ComHints.hints_expr | VernacSyntacticDefinition of lident * (Id.t list * constr_expr) * onlyparsing_flag @@ -406,9 +402,9 @@ type nonrec vernac_expr = | VernacSetStrategy of (Conv_oracle.level * qualid or_by_notation list) list | VernacSetOption of bool (* Export modifier? *) * Goptions.option_name * option_setting - | VernacAddOption of Goptions.option_name * option_ref_value list - | VernacRemoveOption of Goptions.option_name * option_ref_value list - | VernacMemOption of Goptions.option_name * option_ref_value list + | VernacAddOption of Goptions.option_name * Goptions.table_value list + | VernacRemoveOption of Goptions.option_name * Goptions.table_value 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 |