diff options
203 files changed, 9887 insertions, 6399 deletions
diff --git a/.gitignore b/.gitignore index bdd692420f..aab1d1ede7 100644 --- a/.gitignore +++ b/.gitignore @@ -155,6 +155,7 @@ kernel/byterun/coq_jumptbl.h kernel/genOpcodeFiles.exe kernel/vmopcodes.ml kernel/uint63.ml +kernel/float64.ml ide/coqide/default.bindings ide/coqide/default_bindings_src.exe ide/coqide/index_urls.txt diff --git a/Makefile.common b/Makefile.common index a482b9b963..caf1821ce5 100644 --- a/Makefile.common +++ b/Makefile.common @@ -149,11 +149,9 @@ CCCMO:=plugins/cc/cc_plugin.cmo BTAUTOCMO:=plugins/btauto/btauto_plugin.cmo RTAUTOCMO:=plugins/rtauto/rtauto_plugin.cmo SYNTAXCMO:=$(addprefix plugins/syntax/, \ - r_syntax_plugin.cmo \ int63_syntax_plugin.cmo \ float_syntax_plugin.cmo \ - numeral_notation_plugin.cmo \ - string_notation_plugin.cmo) + number_string_notation_plugin.cmo) DERIVECMO:=plugins/derive/derive_plugin.cmo LTACCMO:=plugins/ltac/ltac_plugin.cmo plugins/ltac/tauto_plugin.cmo SSRMATCHINGCMO:=plugins/ssrmatching/ssrmatching_plugin.cmo diff --git a/coqpp/coqpp_main.ml b/coqpp/coqpp_main.ml index 83929bd030..8affe58824 100644 --- a/coqpp/coqpp_main.ml +++ b/coqpp/coqpp_main.ml @@ -454,7 +454,7 @@ struct let terminal s = let p = - if s <> "" && s.[0] >= '0' && s.[0] <= '9' then "CLexer.terminal_numeral" + if s <> "" && s.[0] >= '0' && s.[0] <= '9' then "CLexer.terminal_number" else "CLexer.terminal" in let c = Printf.sprintf "Pcoq.Symbol.token (%s \"%s\")" p s in SymbQuote c diff --git a/dev/ci/user-overlays/12218-proux01-numeral-notations-non-inductive.sh b/dev/ci/user-overlays/12218-proux01-numeral-notations-non-inductive.sh new file mode 100644 index 0000000000..d9b49ad0d1 --- /dev/null +++ b/dev/ci/user-overlays/12218-proux01-numeral-notations-non-inductive.sh @@ -0,0 +1,18 @@ +if [ "$CI_PULL_REQUEST" = "12218" ] || [ "$CI_BRANCH" = "numeral-notations-non-inductive" ]; then + + stdlib2_CI_REF=numeral-notations-non-inductive + stdlib2_CI_GITURL=https://github.com/proux01/stdlib2 + + hott_CI_REF=numeral-notations-non-inductive + hott_CI_GITURL=https://github.com/proux01/HoTT + + paramcoq_CI_REF=numeral-notations-non-inductive + paramcoq_CI_GITURL=https://github.com/proux01/paramcoq + + quickchick_CI_REF=numeral-notations-non-inductive + quickchick_CI_GITURL=https://github.com/proux01/QuickChick + + metacoq_CI_REF=numeral-notations-non-inductive + metacoq_CI_GITURL=https://github.com/proux01/metacoq + +fi diff --git a/dev/ci/user-overlays/13139-ppedrot-clean-hint-constr.sh b/dev/ci/user-overlays/13139-ppedrot-clean-hint-constr.sh new file mode 100644 index 0000000000..2f70f43a2b --- /dev/null +++ b/dev/ci/user-overlays/13139-ppedrot-clean-hint-constr.sh @@ -0,0 +1,9 @@ +if [ "$CI_PULL_REQUEST" = "13139" ] || [ "$CI_BRANCH" = "clean-hint-constr" ]; then + + equations_CI_REF=clean-hint-constr + equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations + + fiat_parsers_CI_REF=clean-hint-constr + fiat_parsers_CI_GITURL=https://github.com/ppedrot/fiat + +fi diff --git a/doc/changelog/01-kernel/12738-fix-sr-cumul-inds.rst b/doc/changelog/01-kernel/12738-fix-sr-cumul-inds.rst deleted file mode 100644 index 1bf62de3fd..0000000000 --- a/doc/changelog/01-kernel/12738-fix-sr-cumul-inds.rst +++ /dev/null @@ -1,5 +0,0 @@ -- **Fixed:** Incompleteness of conversion checking on problems - involving :ref:`eta-expansion` and :ref:`cumulative universe - polymorphic inductive types <cumulative>` (`#12738 - <https://github.com/coq/coq/pull/12738>`_, fixes `#7015 - <https://github.com/coq/coq/issues/7015>`_, by Gaëtan Gilbert). diff --git a/doc/changelog/03-notations/12099-master+constraining-terms-occurring-also-as-pattern-in-notations.rst b/doc/changelog/03-notations/12099-master+constraining-terms-occurring-also-as-pattern-in-notations.rst new file mode 100644 index 0000000000..e9b02aed6d --- /dev/null +++ b/doc/changelog/03-notations/12099-master+constraining-terms-occurring-also-as-pattern-in-notations.rst @@ -0,0 +1,4 @@ +- **Changed:** + Improved support for notations/abbreviations with mixed terms and patterns (such as the forcing modality) + (`#12099 <https://github.com/coq/coq/pull/12099>`_, + by Hugo Herbelin). diff --git a/doc/changelog/03-notations/12218-numeral-notations-non-inductive.rst b/doc/changelog/03-notations/12218-numeral-notations-non-inductive.rst new file mode 100644 index 0000000000..5ea37e7494 --- /dev/null +++ b/doc/changelog/03-notations/12218-numeral-notations-non-inductive.rst @@ -0,0 +1,19 @@ +- **Deprecated** + ``Numeral.v`` is deprecated, please use ``Number.v`` instead. +- **Changed** + Rational and real constants are parsed differently. + The exponent is now encoded separately from the fractional part + using ``Z.pow_pos``. This way, parsing large exponents can no longer + blow up and constants are printed in a form closer to the one they + were parsed (i.e., ``102e-2`` is reprinted as such and not ``1.02``). +- **Removed** + OCaml parser and printer for real constants have been removed. + Real constants are now handled with proven Coq code. +- **Added:** + :ref:`Number Notation <number-notations>` and :ref:`String Notation + <string-notations>` commands now + support parameterized inductive and non inductive types + (`#12218 <https://github.com/coq/coq/pull/12218>`_, + fixes `#12035 <https://github.com/coq/coq/issues/12035>`_, + by Pierre Roux, review by Jason Gross and Jim Fehrle for the + reference manual). diff --git a/doc/changelog/03-notations/12946-master+fix12908-part1-collision-lonely-notation-printing.rst b/doc/changelog/03-notations/12946-master+fix12908-part1-collision-lonely-notation-printing.rst deleted file mode 100644 index 95a9093272..0000000000 --- a/doc/changelog/03-notations/12946-master+fix12908-part1-collision-lonely-notation-printing.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Fixed:** - Undetected collision between a lonely notation and a notation in - scope at printing time - (`#12946 <https://github.com/coq/coq/pull/12946>`_, - fixes the first part of `#12908 <https://github.com/coq/coq/issues/12908>`_, - by Hugo Herbelin). diff --git a/doc/changelog/03-notations/13026-master+fix-printing-custom-no-level-8.2.rst b/doc/changelog/03-notations/13026-master+fix-printing-custom-no-level-8.2.rst deleted file mode 100644 index 42b62eed75..0000000000 --- a/doc/changelog/03-notations/13026-master+fix-printing-custom-no-level-8.2.rst +++ /dev/null @@ -1,7 +0,0 @@ -- **Fixed:** - Fixing printing of notations in custom entries with - variables not mentioning an explicit level - (`#13026 <https://github.com/coq/coq/pull/13026>`_, - fixes `#12775 <https://github.com/coq/coq/issues/12775>`_ - and `#13018 <https://github.com/coq/coq/issues/13018>`_, - by Hugo Herbelin). diff --git a/doc/changelog/03-notations/13067-master+fix-display-parentheses-default-coqide.rst b/doc/changelog/03-notations/13067-master+fix-display-parentheses-default-coqide.rst deleted file mode 100644 index 50aa4a9052..0000000000 --- a/doc/changelog/03-notations/13067-master+fix-display-parentheses-default-coqide.rst +++ /dev/null @@ -1,5 +0,0 @@ -- **Fixed:** - Repairing option :g:`Display parentheses` in CoqIDE - (`#12794 <https://github.com/coq/coq/pull/12794>`_ and `#13067 <https://github.com/coq/coq/pull/13067>`_, - fixes `#12793 <https://github.com/coq/coq/issues/12793>`_, - by Jean-Christophe Léchenet and Hugo Herbelin). diff --git a/doc/changelog/04-tactics/12816-master+fix12787-K-redex-injection-anomaly.rst b/doc/changelog/04-tactics/12816-master+fix12787-K-redex-injection-anomaly.rst deleted file mode 100644 index 289d17167d..0000000000 --- a/doc/changelog/04-tactics/12816-master+fix12787-K-redex-injection-anomaly.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Fixed:** - Anomaly with :tacn:`injection` involving artificial - dependencies disappearing by reduction - (`#12816 <https://github.com/coq/coq/pull/12816>`_, - fixes `#12787 <https://github.com/coq/coq/issues/12787>`_, - by Hugo Herbelin). diff --git a/doc/changelog/04-tactics/12847-master+inversion-works-with-eq-in-type.rst b/doc/changelog/04-tactics/12847-master+inversion-works-with-eq-in-type.rst deleted file mode 100644 index b444a2f436..0000000000 --- a/doc/changelog/04-tactics/12847-master+inversion-works-with-eq-in-type.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Added:** - :tacn:`replace` and :tacn:`inversion` support registration of a - :g:`core.identity`-like equality in :g:`Type`, such as HoTT's :g:`path` - (`#12847 <https://github.com/coq/coq/pull/12847>`_, - partially fixes `#12846 <https://github.com/coq/coq/issues/12846>`_, - by Hugo Herbelin). diff --git a/doc/changelog/05-tactic-language/13232-ltac2-if-then-else.rst b/doc/changelog/05-tactic-language/13232-ltac2-if-then-else.rst new file mode 100644 index 0000000000..d105561a23 --- /dev/null +++ b/doc/changelog/05-tactic-language/13232-ltac2-if-then-else.rst @@ -0,0 +1,5 @@ +- **Added:** + An if-then-else syntax to Ltac2 + (`#13232 <https://github.com/coq/coq/pull/13232>`_, + fixes `#10110 <https://github.com/coq/coq/issues/10110>`_, + by Pierre-Marie Pédrot). diff --git a/doc/changelog/05-tactic-language/13247-master+fix13241-locating-nested-ltac-errors.rst b/doc/changelog/05-tactic-language/13247-master+fix13241-locating-nested-ltac-errors.rst deleted file mode 100644 index 1eb8ef5a2a..0000000000 --- a/doc/changelog/05-tactic-language/13247-master+fix13241-locating-nested-ltac-errors.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Fixed:** - Miscellaneous issues with locating tactic errors - (`#13247 <https://github.com/coq/coq/pull/13247>`_, - fixes `#12773 <https://github.com/coq/coq/issues/12773>`_ - and `#12992 <https://github.com/coq/coq/issues/12992>`_, - by Hugo Herbelin). diff --git a/doc/changelog/06-ssreflect/12857-changelog-for-12857.rst b/doc/changelog/06-ssreflect/12857-changelog-for-12857.rst deleted file mode 100644 index 4350fd0238..0000000000 --- a/doc/changelog/06-ssreflect/12857-changelog-for-12857.rst +++ /dev/null @@ -1,8 +0,0 @@ -- **Fixed:** - Regression in error reporting after :tacn:`case <case (ssreflect)>`. - A generic error message "Could not fill dependent hole in apply" was - reported for any error following :tacn:`case <case (ssreflect)>` or - :tacn:`elim <elim (ssreflect)>` - (`#12857 <https://github.com/coq/coq/pull/12857>`_, - fixes `#12837 <https://github.com/coq/coq/issues/12837>`_, - by Enrico Tassi). diff --git a/doc/changelog/07-commands-and-options/13139-clean-hint-constr.rst b/doc/changelog/07-commands-and-options/13139-clean-hint-constr.rst new file mode 100644 index 0000000000..1a6bc88c6c --- /dev/null +++ b/doc/changelog/07-commands-and-options/13139-clean-hint-constr.rst @@ -0,0 +1,6 @@ +- **Changed:** + When declaring arbitrary terms as hints, unsolved + evars are not abstracted implicitly anymore and instead + raise an error + (`#13139 <https://github.com/coq/coq/pull/13139>`_, + by Pierre-Marie Pédrot). diff --git a/doc/changelog/07-commands-and-options/13255-master+fix13244-use-coercions-in-search.rst b/doc/changelog/07-commands-and-options/13255-master+fix13244-use-coercions-in-search.rst new file mode 100644 index 0000000000..03be92f897 --- /dev/null +++ b/doc/changelog/07-commands-and-options/13255-master+fix13244-use-coercions-in-search.rst @@ -0,0 +1,7 @@ +- **Added:** + Added support for automatic insertion of coercions in :cmd:`Search` + patterns. Additionally, head patterns are now automatically + interpreted as types + (`#13255 <https://github.com/coq/coq/pull/13255>`_, + fixes `#13244 <https://github.com/coq/coq/issues/13244>`_, + by Hugo Herbelin). diff --git a/doc/changelog/08-tools/12754-master+fix-coqdoc-index-escaping.rst b/doc/changelog/08-tools/12754-master+fix-coqdoc-index-escaping.rst deleted file mode 100644 index a05829b720..0000000000 --- a/doc/changelog/08-tools/12754-master+fix-coqdoc-index-escaping.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Fixed:** - Special symbols now escaped in the index produced by coqdoc, - avoiding collision with the syntax of the output format - (`#12754 <https://github.com/coq/coq/pull/12754>`_, - fixes `#12752 <https://github.com/coq/coq/issues/12752>`_, - by Hugo Herbelin). diff --git a/doc/changelog/08-tools/12772-fix-details.rst b/doc/changelog/08-tools/12772-fix-details.rst deleted file mode 100644 index 67ee061285..0000000000 --- a/doc/changelog/08-tools/12772-fix-details.rst +++ /dev/null @@ -1,5 +0,0 @@ -- **Fixed:** - The `details` environment added in the 8.12 release can now be used - as advertised in the reference manual - (`#12772 <https://github.com/coq/coq/pull/12772>`_, - by Thomas Letan). diff --git a/doc/changelog/08-tools/13063-fix-no-output-sync-make-file.rst b/doc/changelog/08-tools/13063-fix-no-output-sync-make-file.rst deleted file mode 100644 index 75b1e26248..0000000000 --- a/doc/changelog/08-tools/13063-fix-no-output-sync-make-file.rst +++ /dev/null @@ -1,6 +0,0 @@ -- **Fixed:** - Targets such as ``print-pretty-timed`` in ``coq_makefile``-made - ``Makefile``\s no longer error in rare cases where ``--output-sync`` is not - passed to make and the timing output gets interleaved in just the wrong way - (`#13063 <https://github.com/coq/coq/pull/13063>`_, fixes `#13062 - <https://github.com/coq/coq/issues/13062>`_, by Jason Gross). diff --git a/doc/changelog/11-infrastructure-and-dependencies/12864-fix-approve-output.rst b/doc/changelog/11-infrastructure-and-dependencies/12864-fix-approve-output.rst deleted file mode 100644 index c754826e62..0000000000 --- a/doc/changelog/11-infrastructure-and-dependencies/12864-fix-approve-output.rst +++ /dev/null @@ -1,5 +0,0 @@ -- **Fixed:** - ``make approve-output`` in the test-suite now correctly handles - ``output-coqtop`` and ``output-coqchk`` tests (`#12864 - <https://github.com/coq/coq/pull/12864>`_, fixes `#12863 - <https://github.com/coq/coq/issues/12863>`_, by Jason Gross). diff --git a/doc/changelog/11-infrastructure-and-dependencies/12972-ocaml+4_11.rst b/doc/changelog/11-infrastructure-and-dependencies/12972-ocaml+4_11.rst deleted file mode 100644 index 855aa360f1..0000000000 --- a/doc/changelog/11-infrastructure-and-dependencies/12972-ocaml+4_11.rst +++ /dev/null @@ -1,4 +0,0 @@ -- **Added:** - Coq is now tested against OCaml 4.11.1 - (`#12972 <https://github.com/coq/coq/pull/12972>`_, - by Emilio Jesus Gallego Arias). diff --git a/doc/changelog/11-infrastructure-and-dependencies/13011-sphinx-3.rst b/doc/changelog/11-infrastructure-and-dependencies/13011-sphinx-3.rst deleted file mode 100644 index d17a2dff6b..0000000000 --- a/doc/changelog/11-infrastructure-and-dependencies/13011-sphinx-3.rst +++ /dev/null @@ -1,5 +0,0 @@ -- **Fixed:** - The reference manual can now build with Sphinx 3 - (`#13011 <https://github.com/coq/coq/pull/13011>`_, - fixes `#12332 <https://github.com/coq/coq/issues/12332>`_, - by Théo Zimmermann and Jim Fehrle). diff --git a/doc/sphinx/addendum/micromega.rst b/doc/sphinx/addendum/micromega.rst index 0942a82d6f..2c7b637a42 100644 --- a/doc/sphinx/addendum/micromega.rst +++ b/doc/sphinx/addendum/micromega.rst @@ -1,6 +1,6 @@ .. _micromega: -Micromega: tactics for solving arithmetic goals over ordered rings +Micromega: solvers for arithmetic goals over ordered rings ================================================================== :Authors: Frédéric Besson and Evgeny Makarov diff --git a/doc/sphinx/addendum/nsatz.rst b/doc/sphinx/addendum/nsatz.rst index 85e0cb9536..7a2be3dcef 100644 --- a/doc/sphinx/addendum/nsatz.rst +++ b/doc/sphinx/addendum/nsatz.rst @@ -1,6 +1,6 @@ .. _nsatz_chapter: -Nsatz: tactics for proving equalities in integral domains +Nsatz: a solver for equalities in integral domains =========================================================== :Author: Loïc Pottier diff --git a/doc/sphinx/addendum/omega.rst b/doc/sphinx/addendum/omega.rst index 35f087d47d..5c08bc44df 100644 --- a/doc/sphinx/addendum/omega.rst +++ b/doc/sphinx/addendum/omega.rst @@ -1,6 +1,6 @@ .. _omega_chapter: -Omega: a solver for quantifier-free problems in Presburger Arithmetic +Omega: a (deprecated) solver for arithmetic ===================================================================== :Author: Pierre Crégut diff --git a/doc/sphinx/addendum/ring.rst b/doc/sphinx/addendum/ring.rst index da1a393b4a..027db9f47a 100644 --- a/doc/sphinx/addendum/ring.rst +++ b/doc/sphinx/addendum/ring.rst @@ -10,8 +10,8 @@ .. _theringandfieldtacticfamilies: -The ring and field tactic families -==================================== +ring and field: solvers for polynomial and rational equations +============================================================= :Author: Bruno Barras, Benjamin Grégoire, Assia Mahboubi, Laurent Théry [#f1]_ diff --git a/doc/sphinx/changes.rst b/doc/sphinx/changes.rst index 5bc229954f..79f00a4a5a 100644 --- a/doc/sphinx/changes.rst +++ b/doc/sphinx/changes.rst @@ -1141,9 +1141,6 @@ Infrastructure and dependencies Changes in 8.12.0 ~~~~~~~~~~~~~~~~~~~~~ -.. contents:: - :local: - **Notations** - **Added:** @@ -1216,6 +1213,116 @@ Changes in 8.12.0 modified in the meantime (`#12583 <https://github.com/coq/coq/pull/12583>`_, fixes `#12582 <https://github.com/coq/coq/issues/12582>`_, by Jason Gross). +Changes in 8.12.1 +~~~~~~~~~~~~~~~~~~~~~ + +**Kernel** + +- **Fixed:** Incompleteness of conversion checking on problems + involving :ref:`eta-expansion` and :ref:`cumulative universe + polymorphic inductive types <cumulative>` (`#12738 + <https://github.com/coq/coq/pull/12738>`_, fixes `#7015 + <https://github.com/coq/coq/issues/7015>`_, by Gaëtan Gilbert). + +**Notations** + +- **Fixed:** + Undetected collision between a lonely notation and a notation in + scope at printing time + (`#12946 <https://github.com/coq/coq/pull/12946>`_, + fixes the first part of `#12908 <https://github.com/coq/coq/issues/12908>`_, + by Hugo Herbelin). +- **Fixed:** + Printing of notations in custom entries with + variables not mentioning an explicit level + (`#13026 <https://github.com/coq/coq/pull/13026>`_, + fixes `#12775 <https://github.com/coq/coq/issues/12775>`_ + and `#13018 <https://github.com/coq/coq/issues/13018>`_, + by Hugo Herbelin). + +**Tactics** + +- **Added:** + :tacn:`replace` and :tacn:`inversion` support registration of a + :g:`core.identity`\-like equality in :g:`Type`, such as HoTT's :g:`path` + (`#12847 <https://github.com/coq/coq/pull/12847>`_, + partially fixes `#12846 <https://github.com/coq/coq/issues/12846>`_, + by Hugo Herbelin). +- **Fixed:** + Anomaly with :tacn:`injection` involving artificial + dependencies disappearing by reduction + (`#12816 <https://github.com/coq/coq/pull/12816>`_, + fixes `#12787 <https://github.com/coq/coq/issues/12787>`_, + by Hugo Herbelin). + +**Tactic language** + +- **Fixed:** + Miscellaneous issues with locating tactic errors + (`#13247 <https://github.com/coq/coq/pull/13247>`_, + fixes `#12773 <https://github.com/coq/coq/issues/12773>`_ + and `#12992 <https://github.com/coq/coq/issues/12992>`_, + by Hugo Herbelin). + +**SSReflect** + +- **Fixed:** + Regression in error reporting after :tacn:`case <case (ssreflect)>`. + A generic error message "Could not fill dependent hole in apply" was + reported for any error following :tacn:`case <case (ssreflect)>` or + :tacn:`elim <elim (ssreflect)>` + (`#12857 <https://github.com/coq/coq/pull/12857>`_, + fixes `#12837 <https://github.com/coq/coq/issues/12837>`_, + by Enrico Tassi). + +**Commands and options** + +- **Fixed:** + Failures of :cmd:`Search` in the presence of primitive projections + (`#13301 <https://github.com/coq/coq/pull/13301>`_, + fixes `#13298 <https://github.com/coq/coq/issues/13298>`_, + by Hugo Herbelin). + +**Tools** + +- **Fixed:** + Special symbols now escaped in the index produced by coqdoc, + avoiding collision with the syntax of the output format + (`#12754 <https://github.com/coq/coq/pull/12754>`_, + fixes `#12752 <https://github.com/coq/coq/issues/12752>`_, + by Hugo Herbelin). +- **Fixed:** + The `details` environment added in the 8.12 release can now be used + as advertised in the reference manual + (`#12772 <https://github.com/coq/coq/pull/12772>`_, + by Thomas Letan). +- **Fixed:** + Targets such as ``print-pretty-timed`` in ``coq_makefile``\-made + ``Makefile``\s no longer error in rare cases where ``--output-sync`` is not + passed to make and the timing output gets interleaved in just the wrong way + (`#13063 <https://github.com/coq/coq/pull/13063>`_, fixes `#13062 + <https://github.com/coq/coq/issues/13062>`_, by Jason Gross). + +**CoqIDE** + +- **Fixed:** + View menu "Display parentheses" + (`#12794 <https://github.com/coq/coq/pull/12794>`_ and `#13067 <https://github.com/coq/coq/pull/13067>`_, + fixes `#12793 <https://github.com/coq/coq/issues/12793>`_, + by Jean-Christophe Léchenet and Hugo Herbelin). + +**Infrastructure and dependencies** + +- **Added:** + Coq is now tested against OCaml 4.11.1 + (`#12972 <https://github.com/coq/coq/pull/12972>`_, + by Emilio Jesus Gallego Arias). +- **Fixed:** + The reference manual can now build with Sphinx 3 + (`#13011 <https://github.com/coq/coq/pull/13011>`_, + fixes `#12332 <https://github.com/coq/coq/issues/12332>`_, + by Théo Zimmermann and Jim Fehrle). + Version 8.11 ------------ diff --git a/doc/sphinx/language/core/basic.rst b/doc/sphinx/language/core/basic.rst index 29a2b40162..dfa2aaf8ff 100644 --- a/doc/sphinx/language/core/basic.rst +++ b/doc/sphinx/language/core/basic.rst @@ -113,7 +113,7 @@ Identifiers Numbers Numbers are sequences of digits with an optional fractional part - and exponent, optionally preceded by a minus sign. Hexadecimal numerals + and exponent, optionally preceded by a minus sign. Hexadecimal numbers start with ``0x`` or ``0X``. :n:`@bigint` are integers; numbers without fractional nor exponent parts. :n:`@bignat` are non-negative integers. Underscores embedded in the digits are ignored, for example diff --git a/doc/sphinx/proof-engine/ltac2.rst b/doc/sphinx/proof-engine/ltac2.rst index 64fc1133f0..41f376c43d 100644 --- a/doc/sphinx/proof-engine/ltac2.rst +++ b/doc/sphinx/proof-engine/ltac2.rst @@ -38,7 +38,6 @@ Current limitations include: - Printing functions are limited and awkward to use. Only a few data types are printable. - Deep pattern matching and matching on tuples don't work. - - If statements on Ltac2 boolean values - A convenient way to build terms with casts through the low-level API. Because the cast type is opaque, building terms with casts currently requires an awkward construction like the following, which also incurs extra overhead to repeat typechecking for each @@ -345,12 +344,10 @@ Ltac2 Definitions .. coqtop:: all - Ltac2 mutable rec f b := match b with true => 0 | _ => f true end. - Ltac2 Set f := fun b => - match b with true => 1 | _ => f true end. + Ltac2 mutable rec f b := if b then 0 else f true. + Ltac2 Set f := fun b => if b then 1 else f true. Ltac2 Eval (f false). - Ltac2 Set f as oldf := fun b => - match b with true => 2 | _ => oldf false end. + Ltac2 Set f as oldf := fun b => if b then 2 else oldf false. Ltac2 Eval (f false). In the definition, the `f` in the body is resolved statically @@ -1149,6 +1146,13 @@ Match on values | @tac2pat1 , {*, @tac2pat1 } | @tac2pat1 +.. tacn:: if @ltac2_expr5__test then @ltac2_expr5__then else @ltac2_expr5__else + :name: if-then-else (Ltac2) + + Equivalent to a :tacn:`match <match (Ltac2)>` on a boolean value. If the + :n:`@ltac2_expr5__test` evaluates to true, :n:`@ltac2_expr5__then` + is evaluated. Otherwise :n:`@ltac2_expr5__else` is evaluated. + .. note:: For now, deep pattern matching is not implemented. diff --git a/doc/sphinx/proof-engine/proof-handling.rst b/doc/sphinx/proof-engine/proof-handling.rst index f4aef8f879..7f5aacbfdb 100644 --- a/doc/sphinx/proof-engine/proof-handling.rst +++ b/doc/sphinx/proof-engine/proof-handling.rst @@ -1,927 +1,5 @@ -.. _proofhandling: +:orphan: -------------------- - Proof handling -------------------- +.. raw:: html -In |Coq|’s proof editing mode all top-level commands documented in -Chapter :ref:`vernacularcommands` remain available and the user has access to specialized -commands dealing with proof development pragmas documented in this -section. They can also use some other specialized commands called -*tactics*. They are the very tools allowing the user to deal with -logical reasoning. They are documented in Chapter :ref:`tactics`. - -|Coq| user interfaces usually have a way of marking whether the user has -switched to proof editing mode. For instance, in coqtop the prompt ``Coq <`` is changed into -:n:`@ident <` where :token:`ident` is the declared name of the theorem currently edited. - -At each stage of a proof development, one has a list of goals to -prove. Initially, the list consists only in the theorem itself. After -having applied some tactics, the list of goals contains the subgoals -generated by the tactics. - -To each subgoal is associated a number of hypotheses called the *local context* -of the goal. Initially, the local context contains the local variables and -hypotheses of the current section (see Section :ref:`gallina-assumptions`) and -the local variables and hypotheses of the theorem statement. It is enriched by -the use of certain tactics (see e.g. :tacn:`intro`). - -When a proof is completed, the message ``Proof completed`` is displayed. -One can then register this proof as a defined constant in the -environment. Because there exists a correspondence between proofs and -terms of λ-calculus, known as the *Curry-Howard isomorphism* -:cite:`How80,Bar81,Gir89,H89`, |Coq| stores proofs as terms of |Cic|. Those -terms are called *proof terms*. - - -.. exn:: No focused proof. - - |Coq| raises this error message when one attempts to use a proof editing command - out of the proof editing mode. - -.. _proof-editing-mode: - -Entering and leaving proof editing mode ---------------------------------------- - -The proof editing mode is entered by asserting a statement, which typically is -the assertion of a theorem using an assertion command like :cmd:`Theorem`. The -list of assertion commands is given in :ref:`Assertions`. The command -:cmd:`Goal` can also be used. - -.. cmd:: Goal @type - - This is intended for quick assertion of statements, without knowing in - advance which name to give to the assertion, typically for quick - testing of the provability of a statement. If the proof of the - statement is eventually completed and validated, the statement is then - bound to the name ``Unnamed_thm`` (or a variant of this name not already - used for another statement). - -.. cmd:: Qed - - This command is available in interactive editing proof mode when the - proof is completed. Then :cmd:`Qed` extracts a proof term from the proof - script, switches back to |Coq| top-level and attaches the extracted - proof term to the declared name of the original goal. The name is - added to the environment as an opaque constant. - - .. exn:: Attempt to save an incomplete proof. - :undocumented: - - .. note:: - - Sometimes an error occurs when building the proof term, because - tactics do not enforce completely the term construction - constraints. - - The user should also be aware of the fact that since the - proof term is completely rechecked at this point, one may have to wait - a while when the proof is large. In some exceptional cases one may - even incur a memory overflow. - -.. cmd:: Save @ident - :name: Save - - Saves a completed proof with the name :token:`ident`, which - overrides any name provided by the :cmd:`Theorem` command or - its variants. - -.. cmd:: Defined {? @ident } - - Similar to :cmd:`Qed` and :cmd:`Save`, except the proof is made *transparent*, which means - that its content can be explicitly used for type checking and that it can be - unfolded in conversion tactics (see :ref:`performingcomputations`, - :cmd:`Opaque`, :cmd:`Transparent`). If :token:`ident` is specified, - the proof is defined with the given name, which overrides any name - provided by the :cmd:`Theorem` command or its variants. - -.. cmd:: Admitted - - This command is available in interactive editing mode to give up - the current proof and declare the initial goal as an axiom. - -.. cmd:: Abort {? {| All | @ident } } - - Cancels the current proof development, switching back to - the previous proof development, or to the |Coq| toplevel if no other - proof was being edited. - - :n:`@ident` - Aborts editing the proof named :n:`@ident` for use when you have - nested proofs. See also :flag:`Nested Proofs Allowed`. - - :n:`All` - Aborts all current proofs. - - .. exn:: No focused proof (No proof-editing in progress). - :undocumented: - -.. cmd:: Proof @term - :name: Proof `term` - - This command applies in proof editing mode. It is equivalent to - :n:`exact @term. Qed.` - That is, you have to give the full proof in one gulp, as a - proof term (see Section :ref:`applyingtheorems`). - - .. warning:: - - Use of this command is discouraged. In particular, it - doesn't work in Proof General because it must - immediately follow the command that opened proof mode, but - Proof General inserts :cmd:`Unset` :flag:`Silent` before it (see - `Proof General issue #498 - <https://github.com/ProofGeneral/PG/issues/498>`_). - -.. cmd:: Proof - - Is a no-op which is useful to delimit the sequence of tactic commands - which start a proof, after a :cmd:`Theorem` command. It is a good practice to - use :cmd:`Proof` as an opening parenthesis, closed in the script with a - closing :cmd:`Qed`. - - .. seealso:: :cmd:`Proof with` - -.. cmd:: Proof using @section_var_expr {? with @ltac_expr } - - .. insertprodn section_var_expr starred_ident_ref - - .. prodn:: - section_var_expr ::= {* @starred_ident_ref } - | {? - } @section_var_expr50 - section_var_expr50 ::= @section_var_expr0 - @section_var_expr0 - | @section_var_expr0 + @section_var_expr0 - | @section_var_expr0 - section_var_expr0 ::= @starred_ident_ref - | ( @section_var_expr ) {? * } - starred_ident_ref ::= @ident {? * } - | Type {? * } - | All - - Opens proof editing mode, declaring the set of - section variables (see :ref:`gallina-assumptions`) used by the proof. - At :cmd:`Qed` time, the - system verifies that the set of section variables used in - the proof is a subset of the declared one. - - The set of declared variables is closed under type dependency. For - example, if ``T`` is a variable and ``a`` is a variable of type - ``T``, then the commands ``Proof using a`` and ``Proof using T a`` - are equivalent. - - The set of declared variables always includes the variables used by - the statement. In other words ``Proof using e`` is equivalent to - ``Proof using Type + e`` for any declaration expression ``e``. - - :n:`- @section_var_expr50` - Use all section variables except those specified by :n:`@section_var_expr50` - - :n:`@section_var_expr0 + @section_var_expr0` - Use section variables from the union of both collections. - See :ref:`nameaset` to see how to form a named collection. - - :n:`@section_var_expr0 - @section_var_expr0` - Use section variables which are in the first collection but not in the - second one. - - :n:`{? * }` - Use the transitive closure of the specified collection. - - :n:`Type` - Use only section variables occurring in the statement. Specifying :n:`*` - uses the forward transitive closure of all the section variables occurring - in the statement. For example, if the variable ``H`` has type ``p < 5`` then - ``H`` is in ``p*`` since ``p`` occurs in the type of ``H``. - - :n:`All` - Use all section variables. - - .. seealso:: :ref:`tactics-implicit-automation` - -.. attr:: using - - This attribute can be applied to the :cmd:`Definition`, :cmd:`Example`, - :cmd:`Fixpoint` and :cmd:`CoFixpoint` commands as well as to :cmd:`Lemma` and - its variants. It takes - a :n:`@section_var_expr`, in quotes, as its value. This is equivalent to - specifying the same :n:`@section_var_expr` in - :cmd:`Proof using`. - - .. example:: - - .. coqtop:: all - - Section Test. - Variable n : nat. - Hypothesis Hn : n <> 0. - - #[using="Hn"] - Lemma example : 0 < n. - - .. coqtop:: in - - Abort. - End Test. - - -Proof using options -``````````````````` - -The following options modify the behavior of ``Proof using``. - - -.. opt:: Default Proof Using "@section_var_expr" - :name: Default Proof Using - - Use :n:`@section_var_expr` as the default ``Proof using`` value. E.g. ``Set Default - Proof Using "a b"`` will complete all ``Proof`` commands not followed by a - ``using`` part with ``using a b``. - - -.. flag:: Suggest Proof Using - - When :cmd:`Qed` is performed, suggest a ``using`` annotation if the user did not - provide one. - -.. _`nameaset`: - -Name a set of section hypotheses for ``Proof using`` -```````````````````````````````````````````````````` - -.. cmd:: Collection @ident := @section_var_expr - - This can be used to name a set of section - hypotheses, with the purpose of making ``Proof using`` annotations more - compact. - - .. example:: - - Define the collection named ``Some`` containing ``x``, ``y`` and ``z``:: - - Collection Some := x y z. - - Define the collection named ``Fewer`` containing only ``x`` and ``y``:: - - Collection Fewer := Some - z - - Define the collection named ``Many`` containing the set union or set - difference of ``Fewer`` and ``Some``:: - - Collection Many := Fewer + Some - Collection Many := Fewer - Some - - Define the collection named ``Many`` containing the set difference of - ``Fewer`` and the unnamed collection ``x y``:: - - Collection Many := Fewer - (x y) - - - -.. cmd:: Existential @natural {? : @type } := @term - - This command instantiates an existential variable. :token:`natural` is an index in - the list of uninstantiated existential variables displayed by :cmd:`Show Existentials`. - - This command is intended to be used to instantiate existential - variables when the proof is completed but some uninstantiated - existential variables remain. To instantiate existential variables - during proof edition, you should use the tactic :tacn:`instantiate`. - -.. cmd:: Grab Existential Variables - - This command can be run when a proof has no more goal to be solved but - has remaining uninstantiated existential variables. It takes every - uninstantiated existential variable and turns it into a goal. - -Proof modes -``````````` - -When entering proof mode through commands such as :cmd:`Goal` and :cmd:`Proof`, -|Coq| picks by default the |Ltac| mode. Nonetheless, there exist other proof modes -shipped in the standard |Coq| installation, and furthermore some plugins define -their own proof modes. The default proof mode used when opening a proof can -be changed using the following option. - -.. opt:: Default Proof Mode @string - - Select the proof mode to use when starting a proof. Depending on the proof - mode, various syntactic constructs are allowed when writing an interactive - proof. All proof modes support vernacular commands; the proof mode determines - which tactic language and set of tactic definitions are available. The - possible option values are: - - `"Classic"` - Activates the |Ltac| language and the tactics with the syntax documented - in this manual. - Some tactics are not available until the associated plugin is loaded, - such as `SSR` or `micromega`. - This proof mode is set when the :term:`prelude` is loaded. - - `"Noedit"` - No tactic - language is activated at all. This is the default when the :term:`prelude` - is not loaded, e.g. through the `-noinit` option for `coqc`. - - `"Ltac2"` - Activates the Ltac2 language and the Ltac2-specific variants of the documented - tactics. - This value is only available after :cmd:`Requiring <Require>` Ltac2. - :cmd:`Importing <Import>` Ltac2 sets this mode. - - Some external plugins also define their own proof mode, which can be - activated with this command. - -Navigation in the proof tree --------------------------------- - -.. cmd:: Undo {? {? To } @natural } - - Cancels the effect of the last :token:`natural` commands or tactics. - The :n:`To @natural` form goes back to the specified state number. - If :token:`natural` is not specified, the command goes back one command or tactic. - -.. cmd:: Restart - - Restores the proof editing process to the original goal. - - .. exn:: No focused proof to restart. - :undocumented: - -.. cmd:: Focus {? @natural } - - Focuses the attention on the first subgoal to prove or, if :token:`natural` is - specified, the :token:`natural`\-th. The - printing of the other subgoals is suspended until the focused subgoal - is solved or unfocused. - - .. deprecated:: 8.8 - - Prefer the use of bullets or focusing brackets with a goal selector (see below). - -.. cmd:: Unfocus - - This command restores to focus the goal that were suspended by the - last :cmd:`Focus` command. - - .. deprecated:: 8.8 - -.. cmd:: Unfocused - - Succeeds if the proof is fully unfocused, fails if there are some - goals out of focus. - -.. _curly-braces: - -.. index:: { - } - -.. todo: :name: "{"; "}" doesn't work, nor does :name: left curly bracket; right curly bracket, - hence the verbose names - -.. tacn:: {? {| @natural | [ @ident ] } : } %{ - %} - - .. todo - See https://github.com/coq/coq/issues/12004 and - https://github.com/coq/coq/issues/12825. - - ``{`` (without a terminating period) focuses on the first - goal. The subproof can only be - unfocused when it has been fully solved (*i.e.*, when there is no - focused goal left). Unfocusing is then handled by ``}`` (again, without a - terminating period). See also an example in the next section. - - Note that when a focused goal is proved a message is displayed - together with a suggestion about the right bullet or ``}`` to unfocus it - or focus the next one. - - :n:`@natural:` - Focuses on the :token:`natural`\-th subgoal to prove. - - :n:`[ @ident ]: %{` - Focuses on the named goal :token:`ident`. - - .. note:: - - Goals are just existential variables and existential variables do not - get a name by default. You can give a name to a goal by using :n:`refine ?[@ident]`. - You may also wrap this in an Ltac-definition like: - - .. coqtop:: in - - Ltac name_goal name := refine ?[name]. - - .. seealso:: :ref:`existential-variables` - - .. example:: - - This first example uses the Ltac definition above, and the named goals - only serve for documentation. - - .. coqtop:: all - - Goal forall n, n + 0 = n. - Proof. - induction n; [ name_goal base | name_goal step ]. - [base]: { - - .. coqtop:: all - - reflexivity. - - .. coqtop:: in - - } - - .. coqtop:: all - - [step]: { - - .. coqtop:: all - - simpl. - f_equal. - assumption. - } - Qed. - - This can also be a way of focusing on a shelved goal, for instance: - - .. coqtop:: all - - Goal exists n : nat, n = n. - eexists ?[x]. - reflexivity. - [x]: exact 0. - Qed. - - .. exn:: This proof is focused, but cannot be unfocused this way. - - You are trying to use ``}`` but the current subproof has not been fully solved. - - .. exn:: No such goal (@natural). - :undocumented: - - .. exn:: No such goal (@ident). - :undocumented: - - .. exn:: Brackets do not support multi-goal selectors. - - Brackets are used to focus on a single goal given either by its position - or by its name if it has one. - - .. seealso:: The error messages for bullets below. - -.. _bullets: - -Bullets -``````` - -Alternatively, proofs can be structured with bullets instead of ``{`` and ``}``. The -use of a bullet ``b`` for the first time focuses on the first goal ``g``, the -same bullet cannot be used again until the proof of ``g`` is completed, -then it is mandatory to focus the next goal with ``b``. The consequence is -that ``g`` and all goals present when ``g`` was focused are focused with the -same bullet ``b``. See the example below. - -Different bullets can be used to nest levels. The scope of bullet does -not go beyond enclosing ``{`` and ``}``, so bullets can be reused as further -nesting levels provided they are delimited by these. Bullets are made of -repeated ``-``, ``+`` or ``*`` symbols: - -.. prodn:: bullet ::= {| {+ - } | {+ + } | {+ * } } - -Note again that when a focused goal is proved a message is displayed -together with a suggestion about the right bullet or ``}`` to unfocus it -or focus the next one. - -.. note:: - - In Proof General (``Emacs`` interface to |Coq|), you must use - bullets with the priority ordering shown above to have a correct - indentation. For example ``-`` must be the outer bullet and ``**`` the inner - one in the example below. - -The following example script illustrates all these features: - -.. example:: - - .. coqtop:: all - - Goal (((True /\ True) /\ True) /\ True) /\ True. - Proof. - split. - - split. - + split. - ** { split. - - trivial. - - trivial. - } - ** trivial. - + trivial. - - assert True. - { trivial. } - assumption. - Qed. - -.. exn:: Wrong bullet @bullet__1: Current bullet @bullet__2 is not finished. - - Before using bullet :n:`@bullet__1` again, you should first finish proving - the current focused goal. - Note that :n:`@bullet__1` and :n:`@bullet__2` may be the same. - -.. exn:: Wrong bullet @bullet__1: Bullet @bullet__2 is mandatory here. - - You must put :n:`@bullet__2` to focus on the next goal. No other bullet is - allowed here. - -.. exn:: No such goal. Focus next goal with bullet @bullet. - - You tried to apply a tactic but no goals were under focus. - Using :n:`@bullet` is mandatory here. - -.. FIXME: the :noindex: below works around a Sphinx issue. - (https://github.com/sphinx-doc/sphinx/issues/4979) - It should be removed once that issue is fixed. - -.. exn:: No such goal. Try unfocusing with %}. - :noindex: - - You just finished a goal focused by ``{``, you must unfocus it with ``}``. - -Mandatory Bullets -````````````````` - -Using :opt:`Default Goal Selector` with the ``!`` selector forces -tactic scripts to keep focus to exactly one goal (e.g. using bullets) -or use explicit goal selectors. - -Set Bullet Behavior -``````````````````` -.. opt:: Bullet Behavior {| "None" | "Strict Subproofs" } - :name: Bullet Behavior - - This option controls the bullet behavior and can take two possible values: - - - "None": this makes bullets inactive. - - "Strict Subproofs": this makes bullets active (this is the default behavior). - -.. _requestinginformation: - -Requesting information ----------------------- - - -.. cmd:: Show {? {| @ident | @natural } } - - Displays the current goals. - - :n:`@natural` - Display only the :token:`natural`\-th subgoal. - - :n:`@ident` - Displays the named goal :token:`ident`. This is useful in - particular to display a shelved goal but only works if the - corresponding existential variable has been named by the user - (see :ref:`existential-variables`) as in the following example. - - .. example:: - - .. coqtop:: all abort - - Goal exists n, n = 0. - eexists ?[n]. - Show n. - - .. exn:: No focused proof. - :undocumented: - - .. exn:: No such goal. - :undocumented: - -.. cmd:: Show Proof {? Diffs {? removed } } - - Displays the proof term generated by the tactics - that have been applied so far. If the proof is incomplete, the term - will contain holes, which correspond to subterms which are still to be - constructed. Each hole is an existential variable, which appears as a - question mark followed by an identifier. - - Specifying “Diffs” highlights the difference between the - current and previous proof step. By default, the command shows the - output once with additions highlighted. Including “removed” shows - the output twice: once showing removals and once showing additions. - It does not examine the :opt:`Diffs` option. See :ref:`showing_proof_diffs`. - -.. cmd:: Show Conjectures - - Prints the names of all the - theorems that are currently being proved. As it is possible to start - proving a previous lemma during the proof of a theorem, there may - be multiple names. - -.. cmd:: Show Intro - - If the current goal begins by at least one product, - prints the name of the first product as it would be - generated by an anonymous :tacn:`intro`. The aim of this command is to ease - the writing of more robust scripts. For example, with an appropriate - Proof General macro, it is possible to transform any anonymous :tacn:`intro` - into a qualified one such as ``intro y13``. In the case of a non-product - goal, it prints nothing. - -.. cmd:: Show Intros - - Similar to the previous command. - Simulates the naming process of :tacn:`intros`. - -.. cmd:: Show Existentials - - Displays all open goals / existential variables in the current proof - along with the type and the context of each variable. - -.. cmd:: Show Match @qualid - - Displays a template of the Gallina :token:`match<term_match>` - construct with a branch for each constructor of the type - :token:`qualid`. This is used internally by - `company-coq <https://github.com/cpitclaudel/company-coq>`_. - - .. example:: - - .. coqtop:: all - - Show Match nat. - - .. exn:: Unknown inductive type. - :undocumented: - -.. cmd:: Show Universes - - Displays the set of all universe constraints and - its normalized form at the current stage of the proof, useful for - debugging universe inconsistencies. - -.. cmd:: Show Goal @natural at @natural - - Available in coqtop. Displays a goal at a - proof state using the goal ID number and the proof state ID number. - It is primarily for use by tools such as Prooftree that need to fetch - goal history in this way. Prooftree is a tool for visualizing a proof - as a tree that runs in Proof General. - -.. cmd:: Guarded - - Some tactics (e.g. :tacn:`refine`) allow to build proofs using - fixpoint or co-fixpoint constructions. Due to the incremental nature - of interactive proof construction, the check of the termination (or - guardedness) of the recursive calls in the fixpoint or cofixpoint - constructions is postponed to the time of the completion of the proof. - - The command :cmd:`Guarded` allows checking if the guard condition for - fixpoint and cofixpoint is violated at some time of the construction - of the proof without having to wait the completion of the proof. - -.. _showing_diffs: - -Showing differences between proof steps ---------------------------------------- - -|Coq| can automatically highlight the differences between successive proof steps -and between values in some error messages. |Coq| can also highlight differences -in the proof term. -For example, the following screenshots of |CoqIDE| and coqtop show the application -of the same :tacn:`intros` tactic. The tactic creates two new hypotheses, highlighted in green. -The conclusion is entirely in pale green because although it’s changed, no tokens were added -to it. The second screenshot uses the "removed" option, so it shows the conclusion a -second time with the old text, with deletions marked in red. Also, since the hypotheses are -new, no line of old text is shown for them. - -.. comment screenshot produced with: - Inductive ev : nat -> Prop := - | ev_0 : ev 0 - | ev_SS : forall n : nat, ev n -> ev (S (S n)). - - Fixpoint double (n:nat) := - match n with - | O => O - | S n' => S (S (double n')) - end. - - Goal forall n, ev n -> exists k, n = double k. - intros n E. - -.. - - .. image:: ../_static/diffs-coqide-on.png - :alt: |CoqIDE| with Set Diffs on - -.. - - .. image:: ../_static/diffs-coqide-removed.png - :alt: |CoqIDE| with Set Diffs removed - -.. - - .. image:: ../_static/diffs-coqtop-on3.png - :alt: coqtop with Set Diffs on - -This image shows an error message with diff highlighting in |CoqIDE|: - -.. - - .. image:: ../_static/diffs-error-message.png - :alt: |CoqIDE| error message with diffs - -How to enable diffs -``````````````````` - -.. opt:: Diffs {| "on" | "off" | "removed" } - :name: Diffs - - The “on” setting highlights added tokens in green, while the “removed” setting - additionally reprints items with removed tokens in red. Unchanged tokens in - modified items are shown with pale green or red. Diffs in error messages - use red and green for the compared values; they appear regardless of the setting. - (Colors are user-configurable.) - -For coqtop, showing diffs can be enabled when starting coqtop with the -``-diffs on|off|removed`` command-line option or by setting the :opt:`Diffs` option -within |Coq|. You will need to provide the ``-color on|auto`` command-line option when -you start coqtop in either case. - -Colors for coqtop can be configured by setting the ``COQ_COLORS`` environment -variable. See section :ref:`customization-by-environment-variables`. Diffs -use the tags ``diff.added``, ``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg``. - -In |CoqIDE|, diffs should be enabled from the ``View`` menu. Don’t use the ``Set Diffs`` -command in |CoqIDE|. You can change the background colors shown for diffs from the -``Edit | Preferences | Tags`` panel by changing the settings for the ``diff.added``, -``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg`` tags. This panel also -lets you control other attributes of the highlights, such as the foreground -color, bold, italic, underline and strikeout. - -Proof General can also display |Coq|-generated proof diffs automatically. -Please see the PG documentation section -"`Showing Proof Diffs" <https://proofgeneral.github.io/doc/master/userman/Coq-Proof-General#Showing-Proof-Diffs>`_) -for details. - -How diffs are calculated -```````````````````````` - -Diffs are calculated as follows: - -1. Select the old proof state to compare to, which is the proof state before - the last tactic that changed the proof. Changes that only affect the view - of the proof, such as ``all: swap 1 2``, are ignored. - -2. For each goal in the new proof state, determine what old goal to compare - it to—the one it is derived from or is the same as. Match the hypotheses by - name (order is ignored), handling compacted items specially. - -3. For each hypothesis and conclusion (the “items”) in each goal, pass - them as strings to the lexer to break them into tokens. Then apply the - Myers diff algorithm :cite:`Myers` on the tokens and add appropriate highlighting. - -Notes: - -* Aside from the highlights, output for the "on" option should be identical - to the undiffed output. -* Goals completed in the last proof step will not be shown even with the - "removed" setting. - -.. comment The following screenshots show diffs working with multiple goals and with compacted - hypotheses. In the first one, notice that the goal ``P 1`` is not highlighted at - all after the split because it has not changed. - - .. todo: Use this script and remove the screenshots when COQ_COLORS - works for coqtop in sphinx - .. coqtop:: none - - Set Diffs "on". - Parameter P : nat -> Prop. - Goal P 1 /\ P 2 /\ P 3. - - .. coqtop:: out - - split. - - .. coqtop:: all abort - - 2: split. - - .. - - .. coqtop:: none - - Set Diffs "on". - Goal forall n m : nat, n + m = m + n. - Set Diffs "on". - - .. coqtop:: out - - intros n. - - .. coqtop:: all abort - - intros m. - -This screen shot shows the result of applying a :tacn:`split` tactic that replaces one goal -with 2 goals. Notice that the goal ``P 1`` is not highlighted at all after -the split because it has not changed. - -.. - - .. image:: ../_static/diffs-coqide-multigoal.png - :alt: coqide with Set Diffs on with multiple goals - -Diffs may appear like this after applying a :tacn:`intro` tactic that results -in a compacted hypotheses: - -.. - - .. image:: ../_static/diffs-coqide-compacted.png - :alt: coqide with Set Diffs on with compacted hypotheses - -.. _showing_proof_diffs: - -"Show Proof" differences -```````````````````````` - -To show differences in the proof term: - -- In coqtop and Proof General, use the :cmd:`Show Proof` `Diffs` command. - -- In |CoqIDE|, position the cursor on or just after a tactic to compare the proof term - after the tactic with the proof term before the tactic, then select - `View / Show Proof` from the menu or enter the associated key binding. - Differences will be shown applying the current `Show Diffs` setting - from the `View` menu. If the current setting is `Don't show diffs`, diffs - will not be shown. - - Output with the "added and removed" option looks like this: - - .. - - .. image:: ../_static/diffs-show-proof.png - :alt: coqide with Set Diffs on with compacted hypotheses - -Controlling the effect of proof editing commands ------------------------------------------------- - - -.. opt:: Hyps Limit @natural - :name: Hyps Limit - - This option controls the maximum number of hypotheses displayed in goals - after the application of a tactic. All the hypotheses remain usable - in the proof development. - When unset, it goes back to the default mode which is to print all - available hypotheses. - - -.. flag:: Nested Proofs Allowed - - When turned on (it is off by default), this flag enables support for nested - proofs: a new assertion command can be inserted before the current proof is - finished, in which case |Coq| will temporarily switch to the proof of this - *nested lemma*. When the proof of the nested lemma is finished (with :cmd:`Qed` - or :cmd:`Defined`), its statement will be made available (as if it had been - proved before starting the previous proof) and |Coq| will switch back to the - proof of the previous assertion. - -.. flag:: Printing Goal Names - - When turned on, the name of the goal is printed in interactive - proof mode, which can be useful in cases of cross references - between goals. - -Controlling memory usage ------------------------- - -.. cmd:: Print Debug GC - - Prints heap usage statistics, which are values from the `stat` type of the `Gc` module - described - `here <https://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEstat>`_ - in the |OCaml| documentation. - The `live_words`, `heap_words` and `top_heap_words` values give the basic information. - Words are 8 bytes or 4 bytes, respectively, for 64- and 32-bit executables. - -When experiencing high memory usage the following commands can be used -to force |Coq| to optimize some of its internal data structures. - -.. cmd:: Optimize Proof - - Shrink the data structure used to represent the current proof. - - -.. cmd:: Optimize Heap - - Perform a heap compaction. This is generally an expensive operation. - See: `|OCaml| Gc.compact <http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact>`_ - There is also an analogous tactic :tacn:`optimize_heap`. - -Memory usage parameters can be set through the :ref:`OCAMLRUNPARAM <OCAMLRUNPARAM>` -environment variable. + <meta http-equiv="refresh" content="0;URL=../proofs/writing-proofs/proof-mode.html"> diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst index fe9a31e220..c665026500 100644 --- a/doc/sphinx/proof-engine/tactics.rst +++ b/doc/sphinx/proof-engine/tactics.rst @@ -2663,1760 +2663,6 @@ and an explanation of the underlying technique. simultaneously proved are respectively :g:`forall binder ... binder, type` The identifiers :n:`@ident` are the names of the coinduction hypotheses. -.. _rewritingexpressions: - -Rewriting expressions ---------------------- - -These tactics use the equality :g:`eq:forall A:Type, A->A->Prop` defined in -file ``Logic.v`` (see :ref:`coq-library-logic`). The notation for :g:`eq T t u` is -simply :g:`t=u` dropping the implicit type of :g:`t` and :g:`u`. - -.. tacn:: rewrite @term - :name: rewrite - - This tactic applies to any goal. The type of :token:`term` must have the form - - ``forall (x``:sub:`1` ``:A``:sub:`1` ``) ... (x``:sub:`n` ``:A``:sub:`n` ``), eq term``:sub:`1` ``term``:sub:`2` ``.`` - - where :g:`eq` is the Leibniz equality or a registered setoid equality. - - Then :n:`rewrite @term` finds the first subterm matching `term`\ :sub:`1` in the goal, - resulting in instances `term`:sub:`1`' and `term`:sub:`2`' and then - replaces every occurrence of `term`:subscript:`1`' by `term`:subscript:`2`'. - Hence, some of the variables :g:`x`\ :sub:`i` are solved by unification, - and some of the types :g:`A`\ :sub:`1`:g:`, ..., A`\ :sub:`n` become new - subgoals. - - .. exn:: The @term provided does not end with an equation. - :undocumented: - - .. exn:: Tactic generated a subgoal identical to the original goal. This happens if @term does not occur in the goal. - :undocumented: - - .. tacv:: rewrite -> @term - - Is equivalent to :n:`rewrite @term` - - .. tacv:: rewrite <- @term - - Uses the equality :n:`@term`:sub:`1` :n:`= @term` :sub:`2` from right to left - - .. tacv:: rewrite @term in @goal_occurrences - - Analogous to :n:`rewrite @term` but rewriting is done following - the clause :token:`goal_occurrences`. For instance: - - + :n:`rewrite H in H'` will rewrite `H` in the hypothesis - ``H'`` instead of the current goal. - + :n:`rewrite H in H' at 1, H'' at - 2 |- *` means - :n:`rewrite H; rewrite H in H' at 1; rewrite H in H'' at - 2.` - In particular a failure will happen if any of these three simpler tactics - fails. - + :n:`rewrite H in * |-` will do :n:`rewrite H in H'` for all hypotheses - :g:`H'` different from :g:`H`. - A success will happen as soon as at least one of these simpler tactics succeeds. - + :n:`rewrite H in *` is a combination of :n:`rewrite H` and :n:`rewrite H in * |-` - that succeeds if at least one of these two tactics succeeds. - - Orientation :g:`->` or :g:`<-` can be inserted before the :token:`term` to rewrite. - - .. tacv:: rewrite @term at @occurrences - - Rewrite only the given :token:`occurrences` of :token:`term`. Occurrences are - specified from left to right as for pattern (:tacn:`pattern`). The rewrite is - always performed using setoid rewriting, even for Leibniz’s equality, so one - has to ``Import Setoid`` to use this variant. - - .. tacv:: rewrite @term by @tactic - - Use tactic to completely solve the side-conditions arising from the - :tacn:`rewrite`. - - .. tacv:: rewrite {+, @orientation @term} {? in @ident } - - Is equivalent to the `n` successive tactics :n:`{+; rewrite @term}`, each one - working on the first subgoal generated by the previous one. An :production:`orientation` - ``->`` or ``<-`` can be inserted before each :token:`term` to rewrite. One - unique clause can be added at the end after the keyword in; it will then - affect all rewrite operations. - - In all forms of rewrite described above, a :token:`term` to rewrite can be - immediately prefixed by one of the following modifiers: - - + `?` : the tactic :n:`rewrite ?@term` performs the rewrite of :token:`term` as many - times as possible (perhaps zero time). This form never fails. - + :n:`@natural?` : works similarly, except that it will do at most :token:`natural` rewrites. - + `!` : works as `?`, except that at least one rewrite should succeed, otherwise - the tactic fails. - + :n:`@natural!` (or simply :n:`@natural`) : precisely :token:`natural` rewrites of :token:`term` will be done, - leading to failure if these :token:`natural` rewrites are not possible. - - .. tacv:: erewrite @term - :name: erewrite - - This tactic works as :n:`rewrite @term` but turning - unresolved bindings into existential variables, if any, instead of - failing. It has the same variants as :tacn:`rewrite` has. - - .. flag:: Keyed Unification - - Makes higher-order unification used by :tacn:`rewrite` rely on a set of keys to drive - unification. The subterms, considered as rewriting candidates, must start with - the same key as the left- or right-hand side of the lemma given to rewrite, and the arguments - are then unified up to full reduction. - -.. tacn:: replace @term with @term’ - :name: replace - - This tactic applies to any goal. It replaces all free occurrences of :n:`@term` - in the current goal with :n:`@term’` and generates an equality :n:`@term = @term’` - as a subgoal. This equality is automatically solved if it occurs among - the assumptions, or if its symmetric form occurs. It is equivalent to - :n:`cut @term = @term’; [intro H`:sub:`n` :n:`; rewrite <- H`:sub:`n` :n:`; clear H`:sub:`n`:n:`|| assumption || symmetry; try assumption]`. - - .. exn:: Terms do not have convertible types. - :undocumented: - - .. tacv:: replace @term with @term’ by @tactic - - This acts as :n:`replace @term with @term’` but applies :token:`tactic` to solve the generated - subgoal :n:`@term = @term’`. - - .. tacv:: replace @term - - Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has - the form :n:`@term = @term’` or :n:`@term’ = @term`. - - .. tacv:: replace -> @term - - Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has - the form :n:`@term = @term’` - - .. tacv:: replace <- @term - - Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has - the form :n:`@term’ = @term` - - .. tacv:: replace @term {? with @term} in @goal_occurrences {? by @tactic} - replace -> @term in @goal_occurrences - replace <- @term in @goal_occurrences - - Acts as before but the replacements take place in the specified clauses - (:token:`goal_occurrences`) (see :ref:`performingcomputations`) and not - only in the conclusion of the goal. The clause argument must not contain - any ``type of`` nor ``value of``. - -.. tacn:: subst @ident - :name: subst - - This tactic applies to a goal that has :n:`@ident` in its context and (at - least) one hypothesis, say :g:`H`, of type :n:`@ident = t` or :n:`t = @ident` - with :n:`@ident` not occurring in :g:`t`. Then it replaces :n:`@ident` by - :g:`t` everywhere in the goal (in the hypotheses and in the conclusion) and - clears :n:`@ident` and :g:`H` from the context. - - If :n:`@ident` is a local definition of the form :n:`@ident := t`, it is also - unfolded and cleared. - - If :n:`@ident` is a section variable it is expected to have no - indirect occurrences in the goal, i.e. that no global declarations - implicitly depending on the section variable must be present in the - goal. - - .. note:: - + When several hypotheses have the form :n:`@ident = t` or :n:`t = @ident`, the - first one is used. - - + If :g:`H` is itself dependent in the goal, it is replaced by the proof of - reflexivity of equality. - - .. tacv:: subst {+ @ident} - - This is equivalent to :n:`subst @ident`:sub:`1`:n:`; ...; subst @ident`:sub:`n`. - - .. tacv:: subst - - This applies :tacn:`subst` repeatedly from top to bottom to all hypotheses of the - context for which an equality of the form :n:`@ident = t` or :n:`t = @ident` - or :n:`@ident := t` exists, with :n:`@ident` not occurring in - ``t`` and :n:`@ident` not a section variable with indirect - dependencies in the goal. - - .. flag:: Regular Subst Tactic - - This flag controls the behavior of :tacn:`subst`. When it is - activated (it is by default), :tacn:`subst` also deals with the following corner cases: - - + A context with ordered hypotheses :n:`@ident`:sub:`1` :n:`= @ident`:sub:`2` - and :n:`@ident`:sub:`1` :n:`= t`, or :n:`t′ = @ident`:sub:`1`` with `t′` not - a variable, and no other hypotheses of the form :n:`@ident`:sub:`2` :n:`= u` - or :n:`u = @ident`:sub:`2`; without the flag, a second call to - subst would be necessary to replace :n:`@ident`:sub:`2` by `t` or - `t′` respectively. - + The presence of a recursive equation which without the flag would - be a cause of failure of :tacn:`subst`. - + A context with cyclic dependencies as with hypotheses :n:`@ident`:sub:`1` :n:`= f @ident`:sub:`2` - and :n:`@ident`:sub:`2` :n:`= g @ident`:sub:`1` which without the - flag would be a cause of failure of :tacn:`subst`. - - Additionally, it prevents a local definition such as :n:`@ident := t` to be - unfolded which otherwise it would exceptionally unfold in configurations - containing hypotheses of the form :n:`@ident = u`, or :n:`u′ = @ident` - with `u′` not a variable. Finally, it preserves the initial order of - hypotheses, which without the flag it may break. - default. - - .. exn:: Cannot find any non-recursive equality over :n:`@ident`. - :undocumented: - - .. exn:: Section variable :n:`@ident` occurs implicitly in global declaration :n:`@qualid` present in hypothesis :n:`@ident`. - Section variable :n:`@ident` occurs implicitly in global declaration :n:`@qualid` present in the conclusion. - - Raised when the variable is a section variable with indirect - dependencies in the goal. - - -.. tacn:: stepl @term - :name: stepl - - This tactic is for chaining rewriting steps. It assumes a goal of the - form :n:`R @term @term` where ``R`` is a binary relation and relies on a - database of lemmas of the form :g:`forall x y z, R x y -> eq x z -> R z y` - where `eq` is typically a setoid equality. The application of :n:`stepl @term` - then replaces the goal by :n:`R @term @term` and adds a new goal stating - :n:`eq @term @term`. - - .. cmd:: Declare Left Step @term - - Adds :n:`@term` to the database used by :tacn:`stepl`. - - This tactic is especially useful for parametric setoids which are not accepted - as regular setoids for :tacn:`rewrite` and :tacn:`setoid_replace` (see - :ref:`Generalizedrewriting`). - - .. tacv:: stepl @term by @tactic - - This applies :n:`stepl @term` then applies :token:`tactic` to the second goal. - - .. tacv:: stepr @term by @tactic - :name: stepr - - This behaves as :tacn:`stepl` but on the right-hand-side of the binary - relation. Lemmas are expected to be of the form - :g:`forall x y z, R x y -> eq y z -> R x z`. - - .. cmd:: Declare Right Step @term - - Adds :n:`@term` to the database used by :tacn:`stepr`. - - -.. tacn:: change @term - :name: change - - This tactic applies to any goal. It implements the rule ``Conv`` given in - :ref:`subtyping-rules`. :g:`change U` replaces the current goal `T` - with `U` providing that `U` is well-formed and that `T` and `U` are - convertible. - - .. exn:: Not convertible. - :undocumented: - - .. tacv:: change @term with @term’ - - This replaces the occurrences of :n:`@term` by :n:`@term’` in the current goal. - The term :n:`@term` and :n:`@term’` must be convertible. - - .. tacv:: change @term at {+ @natural} with @term’ - - This replaces the occurrences numbered :n:`{+ @natural}` of :n:`@term` by :n:`@term’` - in the current goal. The terms :n:`@term` and :n:`@term’` must be convertible. - - .. exn:: Too few occurrences. - :undocumented: - - .. tacv:: change @term {? {? at {+ @natural}} with @term} in @ident - - This applies the :tacn:`change` tactic not to the goal but to the hypothesis :n:`@ident`. - - .. tacv:: now_show @term - - This is a synonym of :n:`change @term`. It can be used to - make some proof steps explicit when refactoring a proof script - to make it readable. - - .. seealso:: :ref:`Performing computations <performingcomputations>` - -.. _performingcomputations: - -Performing computations ---------------------------- - -.. insertprodn red_expr pattern_occ - -.. prodn:: - red_expr ::= red - | hnf - | simpl {? @delta_flag } {? @ref_or_pattern_occ } - | cbv {? @strategy_flag } - | cbn {? @strategy_flag } - | lazy {? @strategy_flag } - | compute {? @delta_flag } - | vm_compute {? @ref_or_pattern_occ } - | native_compute {? @ref_or_pattern_occ } - | unfold {+, @unfold_occ } - | fold {+ @one_term } - | pattern {+, @pattern_occ } - | @ident - delta_flag ::= {? - } [ {+ @reference } ] - strategy_flag ::= {+ @red_flag } - | @delta_flag - red_flag ::= beta - | iota - | match - | fix - | cofix - | zeta - | delta {? @delta_flag } - ref_or_pattern_occ ::= @reference {? at @occs_nums } - | @one_term {? at @occs_nums } - occs_nums ::= {+ {| @natural | @ident } } - | - {| @natural | @ident } {* @int_or_var } - int_or_var ::= @integer - | @ident - unfold_occ ::= @reference {? at @occs_nums } - pattern_occ ::= @one_term {? at @occs_nums } - -This set of tactics implements different specialized usages of the -tactic :tacn:`change`. - -All conversion tactics (including :tacn:`change`) can be parameterized by the -parts of the goal where the conversion can occur. This is done using -*goal clauses* which consists in a list of hypotheses and, optionally, -of a reference to the conclusion of the goal. For defined hypothesis -it is possible to specify if the conversion should occur on the type -part, the body part or both (default). - -Goal clauses are written after a conversion tactic (tactics :tacn:`set`, -:tacn:`rewrite`, :tacn:`replace` and :tacn:`autorewrite` also use goal -clauses) and are introduced by the keyword `in`. If no goal clause is -provided, the default is to perform the conversion only in the -conclusion. - -The syntax and description of the various goal clauses is the -following: - -+ :n:`in {+ @ident} |-` only in hypotheses :n:`{+ @ident}` -+ :n:`in {+ @ident} |- *` in hypotheses :n:`{+ @ident}` and in the - conclusion -+ :n:`in * |-` in every hypothesis -+ :n:`in *` (equivalent to in :n:`* |- *`) everywhere -+ :n:`in (type of @ident) (value of @ident) ... |-` in type part of - :n:`@ident`, in the value part of :n:`@ident`, etc. - -For backward compatibility, the notation :n:`in {+ @ident}` performs -the conversion in hypotheses :n:`{+ @ident}`. - -.. tacn:: cbv {? @strategy_flag } - lazy {? @strategy_flag } - :name: cbv; lazy - - These parameterized reduction tactics apply to any goal and perform - the normalization of the goal according to the specified flags. In - correspondence with the kinds of reduction considered in |Coq| namely - :math:`\beta` (reduction of functional application), :math:`\delta` - (unfolding of transparent constants, see :ref:`vernac-controlling-the-reduction-strategies`), - :math:`\iota` (reduction of - pattern matching over a constructed term, and unfolding of :g:`fix` and - :g:`cofix` expressions) and :math:`\zeta` (contraction of local definitions), the - flags are either ``beta``, ``delta``, ``match``, ``fix``, ``cofix``, - ``iota`` or ``zeta``. The ``iota`` flag is a shorthand for ``match``, ``fix`` - and ``cofix``. The ``delta`` flag itself can be refined into - :n:`delta [ {+ @qualid} ]` or :n:`delta - [ {+ @qualid} ]`, restricting in the first - case the constants to unfold to the constants listed, and restricting in the - second case the constant to unfold to all but the ones explicitly mentioned. - Notice that the ``delta`` flag does not apply to variables bound by a let-in - construction inside the :n:`@term` itself (use here the ``zeta`` flag). In - any cases, opaque constants are not unfolded (see :ref:`vernac-controlling-the-reduction-strategies`). - - Normalization according to the flags is done by first evaluating the - head of the expression into a *weak-head* normal form, i.e. until the - evaluation is blocked by a variable (or an opaque constant, or an - axiom), as e.g. in :g:`x u1 ... un` , or :g:`match x with ... end`, or - :g:`(fix f x {struct x} := ...) x`, or is a constructed form (a - :math:`\lambda`-expression, a constructor, a cofixpoint, an inductive type, a - product type, a sort), or is a redex that the flags prevent to reduce. Once a - weak-head normal form is obtained, subterms are recursively reduced using the - same strategy. - - Reduction to weak-head normal form can be done using two strategies: - *lazy* (``lazy`` tactic), or *call-by-value* (``cbv`` tactic). The lazy - strategy is a call-by-need strategy, with sharing of reductions: the - arguments of a function call are weakly evaluated only when necessary, - and if an argument is used several times then it is weakly computed - only once. This reduction is efficient for reducing expressions with - dead code. For instance, the proofs of a proposition :g:`exists x. P(x)` - reduce to a pair of a witness :g:`t`, and a proof that :g:`t` satisfies the - predicate :g:`P`. Most of the time, :g:`t` may be computed without computing - the proof of :g:`P(t)`, thanks to the lazy strategy. - - The call-by-value strategy is the one used in ML languages: the - arguments of a function call are systematically weakly evaluated - first. Despite the lazy strategy always performs fewer reductions than - the call-by-value strategy, the latter is generally more efficient for - evaluating purely computational expressions (i.e. with little dead code). - -.. tacv:: compute - cbv - :name: compute; _ - - These are synonyms for ``cbv beta delta iota zeta``. - -.. tacv:: lazy - - This is a synonym for ``lazy beta delta iota zeta``. - -.. tacv:: compute [ {+ @qualid} ] - cbv [ {+ @qualid} ] - - These are synonyms of :n:`cbv beta delta {+ @qualid} iota zeta`. - -.. tacv:: compute - [ {+ @qualid} ] - cbv - [ {+ @qualid} ] - - These are synonyms of :n:`cbv beta delta -{+ @qualid} iota zeta`. - -.. tacv:: lazy [ {+ @qualid} ] - lazy - [ {+ @qualid} ] - - These are respectively synonyms of :n:`lazy beta delta {+ @qualid} iota zeta` - and :n:`lazy beta delta -{+ @qualid} iota zeta`. - -.. tacv:: vm_compute - :name: vm_compute - - This tactic evaluates the goal using the optimized call-by-value evaluation - bytecode-based virtual machine described in :cite:`CompiledStrongReduction`. - This algorithm is dramatically more efficient than the algorithm used for the - :tacn:`cbv` tactic, but it cannot be fine-tuned. It is especially interesting for - full evaluation of algebraic objects. This includes the case of - reflection-based tactics. - -.. tacv:: native_compute - :name: native_compute - - This tactic evaluates the goal by compilation to |OCaml| as described - in :cite:`FullReduction`. If |Coq| is running in native code, it can be - typically two to five times faster than :tacn:`vm_compute`. Note however that the - compilation cost is higher, so it is worth using only for intensive - computations. - - .. flag:: NativeCompute Timing - - This flag causes all calls to the native compiler to print - timing information for the conversion to native code, - compilation, execution, and reification phases of native - compilation. Timing is printed in units of seconds of - wall-clock time. - - .. flag:: NativeCompute Profiling - - On Linux, if you have the ``perf`` profiler installed, this flag makes - it possible to profile :tacn:`native_compute` evaluations. - - .. opt:: NativeCompute Profile Filename @string - :name: NativeCompute Profile Filename - - This option specifies the profile output; the default is - ``native_compute_profile.data``. The actual filename used - will contain extra characters to avoid overwriting an existing file; that - filename is reported to the user. - That means you can individually profile multiple uses of - :tacn:`native_compute` in a script. From the Linux command line, run ``perf report`` - on the profile file to see the results. Consult the ``perf`` documentation - for more details. - -.. flag:: Debug Cbv - - This flag makes :tacn:`cbv` (and its derivative :tacn:`compute`) print - information about the constants it encounters and the unfolding decisions it - makes. - -.. tacn:: red - :name: red - - This tactic applies to a goal that has the form:: - - forall (x:T1) ... (xk:Tk), T - - with :g:`T` :math:`\beta`:math:`\iota`:math:`\zeta`-reducing to :g:`c t`:sub:`1` :g:`... t`:sub:`n` and :g:`c` a - constant. If :g:`c` is transparent then it replaces :g:`c` with its - definition (say :g:`t`) and then reduces - :g:`(t t`:sub:`1` :g:`... t`:sub:`n` :g:`)` according to :math:`\beta`:math:`\iota`:math:`\zeta`-reduction rules. - -.. exn:: Not reducible. - :undocumented: - -.. exn:: No head constant to reduce. - :undocumented: - -.. tacn:: hnf - :name: hnf - - This tactic applies to any goal. It replaces the current goal with its - 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`. - -.. note:: - The :math:`\delta` rule only applies to transparent constants (see :ref:`vernac-controlling-the-reduction-strategies` - on transparency and opacity). - -.. tacn:: cbn - simpl - :name: cbn; simpl - - These tactics apply to any goal. They try to reduce a term to - something still readable instead of fully normalizing it. They perform - a sort of strong normalization with two key differences: - - + They unfold a constant if and only if it leads to a :math:`\iota`-reduction, - i.e. reducing a match or unfolding a fixpoint. - + While reducing a constant unfolding to (co)fixpoints, the tactics - use the name of the constant the (co)fixpoint comes from instead of - the (co)fixpoint definition in recursive calls. - - The :tacn:`cbn` tactic is claimed to be a more principled, faster and more - predictable replacement for :tacn:`simpl`. - - 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 :cmd:`Arguments` command. - - .. 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 - constant defined by :g:`plus' := plus` is possibly unfolded and reused in - the recursive calls, but a constant such as :g:`succ := plus (S O)` is - never unfolded. This is the main difference between :tacn:`simpl` and :tacn:`cbn`. - The tactic :tacn:`cbn` reduces whenever it will be able to reuse it or not: - :g:`succ t` is reduced to :g:`S t`. - -.. tacv:: cbn [ {+ @qualid} ] - cbn - [ {+ @qualid} ] - - These are respectively synonyms of :n:`cbn beta delta [ {+ @qualid} ] iota zeta` - and :n:`cbn beta delta - [ {+ @qualid} ] iota zeta` (see :tacn:`cbn`). - -.. tacv:: simpl @pattern - - This applies :tacn:`simpl` only to the subterms matching - :n:`@pattern` in the current goal. - -.. tacv:: simpl @pattern at {+ @natural} - - This applies :tacn:`simpl` only to the :n:`{+ @natural}` occurrences of the subterms - matching :n:`@pattern` in the current goal. - - .. exn:: Too few occurrences. - :undocumented: - -.. tacv:: simpl @qualid - simpl @string - - This applies :tacn:`simpl` only to the applicative subterms whose head occurrence - is the unfoldable constant :n:`@qualid` (the constant can be referred to by - its notation using :n:`@string` if such a notation exists). - -.. tacv:: simpl @qualid at {+ @natural} - simpl @string at {+ @natural} - - This applies :tacn:`simpl` only to the :n:`{+ @natural}` applicative subterms whose - head occurrence is :n:`@qualid` (or :n:`@string`). - -.. flag:: Debug RAKAM - - This flag makes :tacn:`cbn` print various debugging information. - ``RAKAM`` is the Refolding Algebraic Krivine Abstract Machine. - -.. tacn:: unfold @qualid - :name: unfold - - This tactic applies to any goal. The argument qualid must denote a - defined transparent constant or local definition (see - :ref:`gallina-definitions` and - :ref:`vernac-controlling-the-reduction-strategies`). The tactic - :tacn:`unfold` applies the :math:`\delta` rule to each occurrence - of the constant to which :n:`@qualid` refers in the current goal - and then replaces it with its :math:`\beta\iota\zeta`-normal form. - Use the general reduction tactics if you want to avoid this final - reduction, for instance :n:`cbv delta [@qualid]`. - - .. exn:: Cannot coerce @qualid to an evaluable reference. - - This error is frequent when trying to unfold something that has - defined as an inductive type (or constructor) and not as a - definition. - - .. example:: - - .. coqtop:: abort all fail - - Goal 0 <= 1. - unfold le. - - This error can also be raised if you are trying to unfold - something that has been marked as opaque. - - .. example:: - - .. coqtop:: abort all fail - - Opaque Nat.add. - Goal 1 + 0 = 1. - unfold Nat.add. - - .. tacv:: unfold @qualid in @goal_occurrences - - Replaces :n:`@qualid` in hypothesis (or hypotheses) designated - by :token:`goal_occurrences` with its definition and replaces - the hypothesis with its :math:`\beta`:math:`\iota` normal form. - - .. tacv:: unfold {+, @qualid} - - Replaces :n:`{+, @qualid}` with their definitions and replaces - the current goal with its :math:`\beta`:math:`\iota` normal - form. - - .. tacv:: unfold {+, @qualid at @occurrences } - - The list :token:`occurrences` specify the occurrences of - :n:`@qualid` to be unfolded. Occurrences are located from left - to right. - - .. exn:: Bad occurrence number of @qualid. - :undocumented: - - .. exn:: @qualid does not occur. - :undocumented: - - .. tacv:: unfold @string - - If :n:`@string` denotes the discriminating symbol of a notation - (e.g. "+") or an expression defining a notation (e.g. `"_ + - _"`), and this notation denotes an application whose head symbol - is an unfoldable constant, then the tactic unfolds it. - - .. tacv:: unfold @string%@ident - - This is variant of :n:`unfold @string` where :n:`@string` gets - its interpretation from the scope bound to the delimiting key - :token:`ident` instead of its default interpretation (see - :ref:`Localinterpretationrulesfornotations`). - - .. tacv:: unfold {+, {| @qualid | @string{? %@ident } } {? at @occurrences } } {? in @goal_occurrences } - - This is the most general form. - -.. tacn:: fold @term - :name: fold - - This tactic applies to any goal. The term :n:`@term` is reduced using the - :tacn:`red` tactic. Every occurrence of the resulting :n:`@term` in the goal is - then replaced by :n:`@term`. This tactic is particularly useful when a fixpoint - definition has been wrongfully unfolded, making the goal very hard to read. - On the other hand, when an unfolded function applied to its argument has been - reduced, the :tacn:`fold` tactic won't do anything. - - .. example:: - - .. coqtop:: all abort - - Goal ~0=0. - unfold not. - Fail progress fold not. - pattern (0 = 0). - fold not. - - .. tacv:: fold {+ @term} - - Equivalent to :n:`fold @term ; ... ; fold @term`. - -.. tacn:: pattern @term - :name: pattern - - This command applies to any goal. The argument :n:`@term` must be a free - subterm of the current goal. The command pattern performs :math:`\beta`-expansion - (the inverse of :math:`\beta`-reduction) of the current goal (say :g:`T`) by - - + replacing all occurrences of :n:`@term` in :g:`T` with a fresh variable - + abstracting this variable - + applying the abstracted goal to :n:`@term` - - For instance, if the current goal :g:`T` is expressible as - :math:`\varphi`:g:`(t)` where the notation captures all the instances of :g:`t` - in :math:`\varphi`:g:`(t)`, then :n:`pattern t` transforms it into - :g:`(fun x:A =>` :math:`\varphi`:g:`(x)) t`. This tactic can be used, for - instance, when the tactic ``apply`` fails on matching. - -.. tacv:: pattern @term at {+ @natural} - - Only the occurrences :n:`{+ @natural}` of :n:`@term` are considered for - :math:`\beta`-expansion. Occurrences are located from left to right. - -.. tacv:: pattern @term at - {+ @natural} - - All occurrences except the occurrences of indexes :n:`{+ @natural }` - of :n:`@term` are considered for :math:`\beta`-expansion. Occurrences are located from - left to right. - -.. tacv:: pattern {+, @term} - - Starting from a goal :math:`\varphi`:g:`(t`:sub:`1` :g:`... t`:sub:`m`:g:`)`, - the tactic :n:`pattern t`:sub:`1`:n:`, ..., t`:sub:`m` generates the - equivalent goal - :g:`(fun (x`:sub:`1`:g:`:A`:sub:`1`:g:`) ... (x`:sub:`m` :g:`:A`:sub:`m` :g:`) =>`:math:`\varphi`:g:`(x`:sub:`1` :g:`... x`:sub:`m` :g:`)) t`:sub:`1` :g:`... t`:sub:`m`. - If :g:`t`:sub:`i` occurs in one of the generated types :g:`A`:sub:`j` these - occurrences will also be considered and possibly abstracted. - -.. tacv:: pattern {+, @term at {+ @natural}} - - This behaves as above but processing only the occurrences :n:`{+ @natural}` of - :n:`@term` starting from :n:`@term`. - -.. tacv:: pattern {+, @term {? at {? -} {+, @natural}}} - - This is the most general syntax that combines the different variants. - -.. tacn:: with_strategy @strategy_level_or_var [ {+ @reference } ] @ltac_expr3 - :name: with_strategy - - Executes :token:`ltac_expr3`, applying the alternate unfolding - behavior that the :cmd:`Strategy` command controls, but only for - :token:`ltac_expr3`. This can be useful for guarding calls to - reduction in tactic automation to ensure that certain constants are - never unfolded by tactics like :tacn:`simpl` and :tacn:`cbn` or to - ensure that unfolding does not fail. - - .. example:: - - .. coqtop:: all reset abort - - Opaque id. - Goal id 10 = 10. - Fail unfold id. - with_strategy transparent [id] unfold id. - - .. warning:: - - Use this tactic with care, as effects do not persist past the - end of the proof script. Notably, this fine-tuning of the - conversion strategy is not in effect during :cmd:`Qed` nor - :cmd:`Defined`, so this tactic is most useful either in - combination with :tacn:`abstract`, which will check the proof - early while the fine-tuning is still in effect, or to guard - calls to conversion in tactic automation to ensure that, e.g., - :tacn:`unfold` does not fail just because the user made a - constant :cmd:`Opaque`. - - This can be illustrated with the following example involving the - factorial function. - - .. coqtop:: in reset - - Fixpoint fact (n : nat) : nat := - match n with - | 0 => 1 - | S n' => n * fact n' - end. - - Suppose now that, for whatever reason, we want in general to - unfold the :g:`id` function very late during conversion: - - .. coqtop:: in - - Strategy 1000 [id]. - - If we try to prove :g:`id (fact n) = fact n` by - :tacn:`reflexivity`, it will now take time proportional to - :math:`n!`, because |Coq| will keep unfolding :g:`fact` and - :g:`*` and :g:`+` before it unfolds :g:`id`, resulting in a full - computation of :g:`fact n` (in unary, because we are using - :g:`nat`), which takes time :math:`n!`. We can see this cross - the relevant threshold at around :math:`n = 9`: - - .. coqtop:: all abort - - Goal True. - Time assert (id (fact 8) = fact 8) by reflexivity. - Time assert (id (fact 9) = fact 9) by reflexivity. - - Note that behavior will be the same if you mark :g:`id` as - :g:`Opaque` because while most reduction tactics refuse to - unfold :g:`Opaque` constants, conversion treats :g:`Opaque` as - merely a hint to unfold this constant last. - - We can get around this issue by using :tacn:`with_strategy`: - - .. coqtop:: all - - Goal True. - Fail Timeout 1 assert (id (fact 100) = fact 100) by reflexivity. - Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] reflexivity. - - However, when we go to close the proof, we will run into - trouble, because the reduction strategy changes are local to the - tactic passed to :tacn:`with_strategy`. - - .. coqtop:: all abort fail - - exact I. - Timeout 1 Defined. - - We can fix this issue by using :tacn:`abstract`: - - .. coqtop:: all - - Goal True. - Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] abstract reflexivity. - exact I. - Time Defined. - - On small examples this sort of behavior doesn't matter, but - because |Coq| is a super-linear performance domain in so many - places, unless great care is taken, tactic automation using - :tacn:`with_strategy` may not be robustly performant when - scaling the size of the input. - - .. warning:: - - In much the same way this tactic does not play well with - :cmd:`Qed` and :cmd:`Defined` without using :tacn:`abstract` as - an intermediary, this tactic does not play well with ``coqchk``, - even when used with :tacn:`abstract`, due to the inability of - tactics to persist information about conversion hints in the - proof term. See `#12200 - <https://github.com/coq/coq/issues/12200>`_ for more details. - -Conversion tactics applied to hypotheses -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.. tacn:: @tactic in {+, @ident} - - Applies :token:`tactic` (any of the conversion tactics listed in this - section) to the hypotheses :n:`{+ @ident}`. - - If :token:`ident` is a local definition, then :token:`ident` can be replaced by - :n:`type of @ident` to address not the body but the type of the local - definition. - - Example: :n:`unfold not in (type of H1) (type of H3)`. - -.. exn:: No such hypothesis: @ident. - :undocumented: - - -.. _automation: - -Automation ----------- - -.. tacn:: auto - :name: auto - - This tactic implements a Prolog-like resolution procedure to solve the - current goal. It first tries to solve the goal using the :tacn:`assumption` - tactic, then it reduces the goal to an atomic one using :tacn:`intros` and - introduces the newly generated hypotheses as hints. Then it looks at - the list of tactics associated to the head symbol of the goal and - tries to apply one of them (starting from the tactics with lower - cost). This process is recursively applied to the generated subgoals. - - By default, :tacn:`auto` only uses the hypotheses of the current goal and - the hints of the database named ``core``. - - .. warning:: - - :tacn:`auto` uses a weaker version of :tacn:`apply` that is closer to - :tacn:`simple apply` so it is expected that sometimes :tacn:`auto` will - fail even if applying manually one of the hints would succeed. - - .. tacv:: auto @natural - - Forces the search depth to be :token:`natural`. The maximal search depth - is 5 by default. - - .. tacv:: auto with {+ @ident} - - Uses the hint databases :n:`{+ @ident}` in addition to the database ``core``. - - .. note:: - - Use the fake database `nocore` if you want to *not* use the `core` - database. - - .. tacv:: auto with * - - Uses all existing hint databases. Using this variant is highly discouraged - in finished scripts since it is both slower and less robust than the variant - where the required databases are explicitly listed. - - .. seealso:: - :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` for the list of - pre-defined databases and the way to create or extend a database. - - .. tacv:: auto using {+ @qualid__i} {? with {+ @ident } } - - Uses lemmas :n:`@qualid__i` in addition to hints. If :n:`@qualid` is an - inductive type, it is the collection of its constructors which are added - as hints. - - .. note:: - - The hints passed through the `using` clause are used in the same - way as if they were passed through a hint database. Consequently, - they use a weaker version of :tacn:`apply` and :n:`auto using @qualid` - may fail where :n:`apply @qualid` succeeds. - - Given that this can be seen as counter-intuitive, it could be useful - to have an option to use full-blown :tacn:`apply` for lemmas passed - through the `using` clause. Contributions welcome! - - .. tacv:: info_auto - - Behaves like :tacn:`auto` but shows the tactics it uses to solve the goal. This - variant is very useful for getting a better understanding of automation, or - to know what lemmas/assumptions were used. - - .. tacv:: debug auto - :name: debug auto - - Behaves like :tacn:`auto` but shows the tactics it tries to solve the goal, - including failing paths. - - .. tacv:: {? info_}auto {? @natural} {? using {+ @qualid}} {? with {+ @ident}} - - This is the most general form, combining the various options. - -.. tacv:: trivial - :name: trivial - - This tactic is a restriction of :tacn:`auto` that is not recursive - and tries only hints that cost `0`. Typically it solves trivial - equalities like :g:`X=X`. - - .. tacv:: trivial with {+ @ident} - trivial with * - trivial using {+ @qualid} - debug trivial - info_trivial - {? info_}trivial {? using {+ @qualid}} {? with {+ @ident}} - :name: _; _; _; debug trivial; info_trivial; _ - :undocumented: - -.. note:: - :tacn:`auto` and :tacn:`trivial` either solve completely the goal or - else succeed without changing the goal. Use :g:`solve [ auto ]` and - :g:`solve [ trivial ]` if you would prefer these tactics to fail when - they do not manage to solve the goal. - -.. flag:: Info Auto - Debug Auto - Info Trivial - Debug Trivial - - These flags enable printing of informative or debug information for - the :tacn:`auto` and :tacn:`trivial` tactics. - -.. tacn:: eauto - :name: eauto - - This tactic generalizes :tacn:`auto`. While :tacn:`auto` does not try - resolution hints which would leave existential variables in the goal, - :tacn:`eauto` does try them (informally speaking, it internally uses a tactic - close to :tacn:`simple eapply` instead of a tactic close to :tacn:`simple apply` - in the case of :tacn:`auto`). As a consequence, :tacn:`eauto` - can solve such a goal: - - .. example:: - - .. coqtop:: all - - Hint Resolve ex_intro : core. - Goal forall P:nat -> Prop, P 0 -> exists n, P n. - eauto. - - Note that ``ex_intro`` should be declared as a hint. - - - .. tacv:: {? info_}eauto {? @natural} {? using {+ @qualid}} {? with {+ @ident}} - - The various options for :tacn:`eauto` are the same as for :tacn:`auto`. - - :tacn:`eauto` also obeys the following flags: - - .. flag:: Info Eauto - Debug Eauto - :undocumented: - - .. seealso:: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` - - -.. tacn:: autounfold with {+ @ident} - :name: autounfold - - This tactic unfolds constants that were declared through a :cmd:`Hint Unfold` - in the given databases. - -.. tacv:: autounfold with {+ @ident} in @goal_occurrences - - Performs the unfolding in the given clause (:token:`goal_occurrences`). - -.. tacv:: autounfold with * - - Uses the unfold hints declared in all the hint databases. - -.. tacn:: autorewrite with {+ @ident} - :name: autorewrite - - This tactic carries out rewritings according to the rewriting rule - bases :n:`{+ @ident}`. - - Each rewriting rule from the base :n:`@ident` is applied to the main subgoal until - it fails. Once all the rules have been processed, if the main subgoal has - progressed (e.g., if it is distinct from the initial main goal) then the rules - of this base are processed again. If the main subgoal has not progressed then - the next base is processed. For the bases, the behavior is exactly similar to - the processing of the rewriting rules. - - The rewriting rule bases are built with the :cmd:`Hint Rewrite` - command. - -.. warning:: - - This tactic may loop if you build non terminating rewriting systems. - -.. tacv:: autorewrite with {+ @ident} using @tactic - - Performs, in the same way, all the rewritings of the bases :n:`{+ @ident}` - applying tactic to the main subgoal after each rewriting step. - -.. tacv:: autorewrite with {+ @ident} in @qualid - - Performs all the rewritings in hypothesis :n:`@qualid`. - -.. tacv:: autorewrite with {+ @ident} in @qualid using @tactic - - Performs all the rewritings in hypothesis :n:`@qualid` applying :n:`@tactic` - to the main subgoal after each rewriting step. - -.. tacv:: autorewrite with {+ @ident} in @goal_occurrences - - Performs all the rewriting in the clause :n:`@goal_occurrences`. - -.. seealso:: - - :ref:`Hint-Rewrite <hintrewrite>` for feeding the database of lemmas used by - :tacn:`autorewrite` and :tacn:`autorewrite` for examples showing the use of this tactic. - -.. tacn:: easy - :name: easy - - This tactic tries to solve the current goal by a number of standard closing steps. - In particular, it tries to close the current goal using the closing tactics - :tacn:`trivial`, :tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`contradiction` - and :tacn:`inversion` of hypothesis. - If this fails, it tries introducing variables and splitting and-hypotheses, - using the closing tactics afterwards, and splitting the goal using - :tacn:`split` and recursing. - - This tactic solves goals that belong to many common classes; in particular, many cases of - unsatisfiable hypotheses, and simple equality goals are usually solved by this tactic. - -.. tacv:: now @tactic - :name: now - - Run :n:`@tactic` followed by :tacn:`easy`. This is a notation for :n:`@tactic; easy`. - -Controlling automation --------------------------- - -.. _thehintsdatabasesforautoandeauto: - -The hints databases for auto and eauto -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The hints for :tacn:`auto` and :tacn:`eauto` are stored in databases. Each database -maps head symbols to a list of hints. - -.. cmd:: Print Hint @ident - - Use this command - to display the hints associated to the head symbol :n:`@ident` - (see :ref:`Print Hint <printhint>`). Each hint has a cost that is a nonnegative - integer, and an optional pattern. The hints with lower cost are tried first. A - hint is tried by :tacn:`auto` when the conclusion of the current goal matches its - pattern or when it has no pattern. - -Creating Hint databases -``````````````````````` - -One can optionally declare a hint database using the command -:cmd:`Create HintDb`. If a hint is added to an unknown database, it will be -automatically created. - -.. cmd:: Create HintDb @ident {? discriminated} - - This command creates a new database named :n:`@ident`. The database is - implemented by a Discrimination Tree (DT) that serves as an index of - all the lemmas. The DT can use transparency information to decide if a - constant should be indexed or not - (c.f. :ref:`The hints databases for auto and eauto <thehintsdatabasesforautoandeauto>`), - making the retrieval more efficient. The legacy implementation (the default one - for new databases) uses the DT only on goals without existentials (i.e., :tacn:`auto` - goals), for non-Immediate hints and does not make use of transparency - hints, putting more work on the unification that is run after - retrieval (it keeps a list of the lemmas in case the DT is not used). - The new implementation enabled by the discriminated option makes use - of DTs in all cases and takes transparency information into account. - However, the order in which hints are retrieved from the DT may differ - from the order in which they were inserted, making this implementation - observationally different from the legacy one. - -.. cmd:: Hint @hint_definition : {+ @ident} - - The general command to add a hint to some databases :n:`{+ @ident}`. - - This command supports the :attr:`local`, :attr:`global` and :attr:`export` - locality attributes. When no locality is explictly given, the - command is :attr:`local` inside a section and :attr:`global` otherwise. - - + :attr:`local` hints are never visible from other modules, even if they - require or import the current module. Inside a section, the :attr:`local` - attribute is useless since hints do not survive anyway to the closure of - sections. - - + :attr:`export` are visible from other modules when they import the current - module. Requiring it is not enough. This attribute is only effective for - the :cmd:`Hint Resolve`, :cmd:`Hint Immediate`, :cmd:`Hint Unfold` and - :cmd:`Hint Extern` variants of the command. - - + :attr:`global` hints are made available by merely requiring the current - module. - - The various possible :production:`hint_definition`\s are given below. - - .. cmdv:: Hint @hint_definition - - No database name is given: the hint is registered in the ``core`` database. - - .. deprecated:: 8.10 - - .. cmdv:: Hint Resolve @qualid {? | {? @natural} {? @pattern}} : @ident - :name: Hint Resolve - - This command adds :n:`simple apply @qualid` to the hint list with the head - symbol of the type of :n:`@qualid`. The cost of that hint is the number of - subgoals generated by :n:`simple apply @qualid` or :n:`@natural` if specified. The - associated :n:`@pattern` is inferred from the conclusion of the type of - :n:`@qualid` or the given :n:`@pattern` if specified. In case the inferred type - of :n:`@qualid` does not start with a product the tactic added in the hint list - is :n:`exact @qualid`. In case this type can however be reduced to a type - starting with a product, the tactic :n:`simple apply @qualid` is also stored in - the hints list. If the inferred type of :n:`@qualid` contains a dependent - quantification on a variable which occurs only in the premisses of the type - and not in its conclusion, no instance could be inferred for the variable by - unification with the goal. In this case, the hint is added to the hint list - of :tacn:`eauto` instead of the hint list of auto and a warning is printed. A - typical example of a hint that is used only by :tacn:`eauto` is a transitivity - lemma. - - .. exn:: @qualid cannot be used as a hint - - The head symbol of the type of :n:`@qualid` is a bound variable - such that this tactic cannot be associated to a constant. - - .. cmdv:: Hint Resolve {+ @qualid} : @ident - - Adds each :n:`Hint Resolve @qualid`. - - .. cmdv:: Hint Resolve -> @qualid : @ident - - Adds the left-to-right implication of an equivalence as a hint (informally - the hint will be used as :n:`apply <- @qualid`, although as mentioned - before, the tactic actually used is a restricted version of - :tacn:`apply`). - - .. cmdv:: Hint Resolve <- @qualid - - Adds the right-to-left implication of an equivalence as a hint. - - .. cmdv:: Hint Immediate @qualid : @ident - :name: Hint Immediate - - This command adds :n:`simple apply @qualid; trivial` to the hint list associated - with the head symbol of the type of :n:`@ident` in the given database. This - tactic will fail if all the subgoals generated by :n:`simple apply @qualid` are - not solved immediately by the :tacn:`trivial` tactic (which only tries tactics - with cost 0).This command is useful for theorems such as the symmetry of - equality or :g:`n+1=m+1 -> n=m` that we may like to introduce with a limited - use in order to avoid useless proof-search. The cost of this tactic (which - never generates subgoals) is always 1, so that it is not used by :tacn:`trivial` - itself. - - .. exn:: @qualid cannot be used as a hint - :undocumented: - - .. cmdv:: Hint Immediate {+ @qualid} : @ident - - Adds each :n:`Hint Immediate @qualid`. - - .. cmdv:: Hint Constructors @qualid : @ident - :name: Hint Constructors - - If :token:`qualid` is an inductive type, this command adds all its constructors as - hints of type ``Resolve``. Then, when the conclusion of current goal has the form - :n:`(@qualid ...)`, :tacn:`auto` will try to apply each constructor. - - .. exn:: @qualid is not an inductive type - :undocumented: - - .. cmdv:: Hint Constructors {+ @qualid} : @ident - - Extends the previous command for several inductive types. - - .. cmdv:: Hint Unfold @qualid : @ident - :name: Hint Unfold - - This adds the tactic :n:`unfold @qualid` to the hint list that will only be - used when the head constant of the goal is :token:`qualid`. - Its cost is 4. - - .. cmdv:: Hint Unfold {+ @qualid} - - Extends the previous command for several defined constants. - - .. cmdv:: Hint Transparent {+ @qualid} : @ident - Hint Opaque {+ @qualid} : @ident - :name: Hint Transparent; Hint Opaque - - This adds transparency hints to the database, making :n:`@qualid` - transparent or opaque constants during resolution. This information is used - during unification of the goal with any lemma in the database and inside the - discrimination network to relax or constrain it in the case of discriminated - databases. - - .. cmdv:: Hint Variables {| Transparent | Opaque } : @ident - Hint Constants {| Transparent | Opaque } : @ident - :name: Hint Variables; Hint Constants - - This sets the transparency flag used during unification of - hints in the database for all constants or all variables, - overwriting the existing settings of opacity. It is advised - to use this just after a :cmd:`Create HintDb` command. - - .. cmdv:: Hint Extern @natural {? @pattern} => @tactic : @ident - :name: Hint Extern - - This hint type is to extend :tacn:`auto` with tactics other than :tacn:`apply` and - :tacn:`unfold`. For that, we must specify a cost, an optional :n:`@pattern` and a - :n:`@tactic` to execute. - - .. example:: - - .. coqtop:: in - - Hint Extern 4 (~(_ = _)) => discriminate : core. - - Now, when the head of the goal is a disequality, ``auto`` will try - discriminate if it does not manage to solve the goal with hints with a - cost less than 4. - - One can even use some sub-patterns of the pattern in - the tactic script. A sub-pattern is a question mark followed by an - identifier, like ``?X1`` or ``?X2``. Here is an example: - - .. example:: - - .. coqtop:: reset all - - Require Import List. - Hint Extern 5 ({?X1 = ?X2} + {?X1 <> ?X2}) => generalize X1, X2; decide equality : eqdec. - Goal forall a b:list (nat * nat), {a = b} + {a <> b}. - Info 1 auto with eqdec. - - .. cmdv:: Hint Cut @regexp : @ident - :name: Hint Cut - - .. warning:: - - These hints currently only apply to typeclass proof search and the - :tacn:`typeclasses eauto` tactic. - - This command can be used to cut the proof-search tree according to a regular - expression matching paths to be cut. The grammar for regular expressions is - the following. Beware, there is no operator precedence during parsing, one can - check with :cmd:`Print HintDb` to verify the current cut expression: - - .. prodn:: - regexp ::= @ident (hint or instance identifier) - | _ (any hint) - | @regexp | @regexp (disjunction) - | @regexp @regexp (sequence) - | @regexp * (Kleene star) - | emp (empty) - | eps (epsilon) - | ( @regexp ) - - The `emp` regexp does not match any search path while `eps` - matches the empty path. During proof search, the path of - successive successful hints on a search branch is recorded, as a - list of identifiers for the hints (note that :cmd:`Hint Extern`\’s do not have - an associated identifier). - Before applying any hint :n:`@ident` the current path `p` extended with - :n:`@ident` is matched against the current cut expression `c` associated to - the hint database. If matching succeeds, the hint is *not* applied. The - semantics of :n:`Hint Cut @regexp` is to set the cut expression - to :n:`c | regexp`, the initial cut expression being `emp`. - - .. cmdv:: Hint Mode @qualid {* {| + | ! | - } } : @ident - :name: Hint Mode - - This sets an optional mode of use of the identifier :n:`@qualid`. When - proof-search faces a goal that ends in an application of :n:`@qualid` to - arguments :n:`@term ... @term`, the mode tells if the hints associated to - :n:`@qualid` can be applied or not. A mode specification is a list of n ``+``, - ``!`` or ``-`` items that specify if an argument of the identifier is to be - treated as an input (``+``), if its head only is an input (``!``) or an output - (``-``) of the identifier. For a mode to match a list of arguments, input - terms and input heads *must not* contain existential variables or be - existential variables respectively, while outputs can be any term. Multiple - modes can be declared for a single identifier, in that case only one mode - needs to match the arguments for the hints to be applied. The head of a term - is understood here as the applicative head, or the match or projection - scrutinee’s head, recursively, casts being ignored. :cmd:`Hint Mode` is - especially useful for typeclasses, when one does not want to support default - instances and avoid ambiguity in general. Setting a parameter of a class as an - input forces proof-search to be driven by that index of the class, with ``!`` - giving more flexibility by allowing existentials to still appear deeper in the - index but not at its head. - - .. note:: - - + One can use a :cmd:`Hint Extern` with no pattern to do - pattern matching on hypotheses using ``match goal with`` - inside the tactic. - - + If you want to add hints such as :cmd:`Hint Transparent`, - :cmd:`Hint Cut`, or :cmd:`Hint Mode`, for typeclass - resolution, do not forget to put them in the - ``typeclass_instances`` hint database. - - -Hint databases defined in the |Coq| standard library -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Several hint databases are defined in the |Coq| standard library. The -actual content of a database is the collection of hints declared -to belong to this database in each of the various modules currently -loaded. Especially, requiring new modules may extend the database. -At |Coq| startup, only the core database is nonempty and can be used. - -:core: This special database is automatically used by ``auto``, except when - pseudo-database ``nocore`` is given to ``auto``. The core database - contains only basic lemmas about negation, conjunction, and so on. - Most of the hints in this database come from the Init and Logic directories. - -:arith: 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. 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. - -:datatypes: is for lemmas about lists, streams and so on that are mainly proved - in the Lists subdirectory. - -:sets: contains lemmas about sets and relations from the directories Sets and - Relations. - -:typeclass_instances: contains all the typeclass instances declared in the - environment, including those used for ``setoid_rewrite``, - from the Classes directory. - -:fset: internal database for the implementation of the ``FSets`` library. - -:ordered_type: lemmas about ordered types (as defined in the legacy ``OrderedType`` module), - mainly used in the ``FSets`` and ``FMaps`` libraries. - -You are advised not to put your own hints in the core database, but -use one or several databases specific to your development. - -.. _removehints: - -.. cmd:: Remove Hints {+ @term} : {+ @ident} - - This command removes the hints associated to terms :n:`{+ @term}` in databases - :n:`{+ @ident}`. - -.. _printhint: - -.. cmd:: Print Hint - - This command displays all hints that apply to the current goal. It - fails if no proof is being edited, while the two variants can be used - at every moment. - -**Variants:** - - -.. cmd:: Print Hint @ident - - This command displays only tactics associated with :n:`@ident` in the hints - list. This is independent of the goal being edited, so this command will not - fail if no goal is being edited. - -.. cmd:: Print Hint * - - This command displays all declared hints. - -.. cmd:: Print HintDb @ident - - This command displays all hints from database :n:`@ident`. - -.. _hintrewrite: - -.. cmd:: Hint Rewrite {+ @term} : {+ @ident} - - This vernacular command adds the terms :n:`{+ @term}` (their types must be - equalities) in the rewriting bases :n:`{+ @ident}` with the default orientation - (left to right). Notice that the rewriting bases are distinct from the :tacn:`auto` - hint bases and that :tacn:`auto` does not take them into account. - - This command is synchronous with the section mechanism (see :ref:`section-mechanism`): - when closing a section, all aliases created by ``Hint Rewrite`` in that - section are lost. Conversely, when loading a module, all ``Hint Rewrite`` - declarations at the global level of that module are loaded. - -**Variants:** - -.. cmd:: Hint Rewrite -> {+ @term} : {+ @ident} - - This is strictly equivalent to the command above (we only make explicit the - orientation which otherwise defaults to ->). - -.. cmd:: Hint Rewrite <- {+ @term} : {+ @ident} - - Adds the rewriting rules :n:`{+ @term}` with a right-to-left orientation in - the bases :n:`{+ @ident}`. - -.. cmd:: Hint Rewrite {? {| -> | <- } } {+ @one_term } {? using @ltac_expr } {? : {* @ident } } - - When the rewriting rules :n:`{+ @term}` in :n:`{+ @ident}` will be used, the - tactic ``tactic`` will be applied to the generated subgoals, the main subgoal - excluded. - -.. cmd:: Print Rewrite HintDb @ident - - This command displays all rewrite hints contained in :n:`@ident`. - -Hint locality -~~~~~~~~~~~~~ - -Hints provided by the ``Hint`` commands are erased when closing a section. -Conversely, all hints of a module ``A`` that are not defined inside a -section (and not defined with option ``Local``) become available when the -module ``A`` is required (using e.g. ``Require A.``). - -As of today, hints only have a binary behavior regarding locality, as -described above: either they disappear at the end of a section scope, -or they remain global forever. This causes a scalability issue, -because hints coming from an unrelated part of the code may badly -influence another development. It can be mitigated to some extent -thanks to the :cmd:`Remove Hints` command, -but this is a mere workaround and has some limitations (for instance, external -hints cannot be removed). - -A proper way to fix this issue is to bind the hints to their module scope, as -for most of the other objects |Coq| uses. Hints should only be made available when -the module they are defined in is imported, not just required. It is very -difficult to change the historical behavior, as it would break a lot of scripts. -We propose a smooth transitional path by providing the :opt:`Loose Hint Behavior` -option which accepts three flags allowing for a fine-grained handling of -non-imported hints. - -.. opt:: Loose Hint Behavior {| "Lax" | "Warn" | "Strict" } - :name: Loose Hint Behavior - - This option accepts three values, which control the behavior of hints w.r.t. - :cmd:`Import`: - - - "Lax": this is the default, and corresponds to the historical behavior, - that is, hints defined outside of a section have a global scope. - - - "Warn": outputs a warning when a non-imported hint is used. Note that this - is an over-approximation, because a hint may be triggered by a run that - will eventually fail and backtrack, resulting in the hint not being - actually useful for the proof. - - - "Strict": changes the behavior of an unloaded hint to a immediate fail - tactic, allowing to emulate an import-scoped hint mechanism. - -.. _tactics-implicit-automation: - -Setting implicit automation tactics -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -.. cmd:: Proof with @tactic - - This command may be used to start a proof. It defines a default tactic - to be used each time a tactic command ``tactic``:sub:`1` is ended by ``...``. - In this case the tactic command typed by the user is equivalent to - ``tactic``:sub:`1` ``;tactic``. - - .. seealso:: :cmd:`Proof` in :ref:`proof-editing-mode`. - - - .. cmdv:: Proof with @tactic using {+ @ident} - - Combines in a single line ``Proof with`` and ``Proof using``, see :ref:`proof-editing-mode` - - .. cmdv:: Proof using {+ @ident} with @tactic - - Combines in a single line ``Proof with`` and ``Proof using``, see :ref:`proof-editing-mode` - -.. _decisionprocedures: - -Decision procedures -------------------- - -.. tacn:: tauto - :name: tauto - - This tactic implements a decision procedure for intuitionistic propositional - calculus based on the contraction-free sequent calculi LJT* of Roy Dyckhoff - :cite:`Dyc92`. Note that :tacn:`tauto` succeeds on any instance of an - intuitionistic tautological proposition. :tacn:`tauto` unfolds negations and - logical equivalence but does not unfold any other definition. - -.. example:: - - The following goal can be proved by :tacn:`tauto` whereas :tacn:`auto` would - fail: - - .. coqtop:: reset all - - Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x. - intros. - tauto. - -Moreover, if it has nothing else to do, :tacn:`tauto` performs introductions. -Therefore, the use of :tacn:`intros` in the previous proof is unnecessary. -:tacn:`tauto` can for instance for: - -.. example:: - - .. coqtop:: reset all - - Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ A -> P x. - tauto. - -.. note:: - In contrast, :tacn:`tauto` cannot solve the following goal - :g:`Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) ->` - :g:`forall x:nat, ~ ~ (A \/ P x).` - because :g:`(forall x:nat, ~ A -> P x)` cannot be treated as atomic and - an instantiation of `x` is necessary. - -.. tacv:: dtauto - :name: dtauto - - While :tacn:`tauto` recognizes inductively defined connectives isomorphic to - the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, - ``Empty_set``, ``unit``, ``True``, :tacn:`dtauto` also recognizes all inductive - types with one constructor and no indices, i.e. record-style connectives. - -.. tacn:: intuition @tactic - :name: intuition - - The tactic :tacn:`intuition` takes advantage of the search-tree built by the - decision procedure involved in the tactic :tacn:`tauto`. It uses this - information to generate a set of subgoals equivalent to the original one (but - simpler than it) and applies the tactic :n:`@tactic` to them :cite:`Mun94`. If - this tactic fails on some goals then :tacn:`intuition` fails. In fact, - :tacn:`tauto` is simply :g:`intuition fail`. - - .. example:: - - For instance, the tactic :g:`intuition auto` applied to the goal:: - - (forall (x:nat), P x) /\ B -> (forall (y:nat), P y) /\ P O \/ B /\ P O - - internally replaces it by the equivalent one:: - - (forall (x:nat), P x), B |- P O - - and then uses :tacn:`auto` which completes the proof. - -Originally due to César Muñoz, these tactics (:tacn:`tauto` and -:tacn:`intuition`) have been completely re-engineered by David Delahaye using -mainly the tactic language (see :ref:`ltac`). The code is -now much shorter and a significant increase in performance has been noticed. -The general behavior with respect to dependent types, unfolding and -introductions has slightly changed to get clearer semantics. This may lead to -some incompatibilities. - -.. tacv:: intuition - - Is equivalent to :g:`intuition auto with *`. - -.. tacv:: dintuition - :name: dintuition - - While :tacn:`intuition` recognizes inductively defined connectives - isomorphic to the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, - ``Empty_set``, ``unit``, ``True``, :tacn:`dintuition` also recognizes all inductive - types with one constructor and no indices, i.e. record-style connectives. - -.. flag:: Intuition Negation Unfolding - - Controls whether :tacn:`intuition` unfolds inner negations which do not need - to be unfolded. This flag is on by default. - -.. tacn:: rtauto - :name: rtauto - - The :tacn:`rtauto` tactic solves propositional tautologies similarly to what - :tacn:`tauto` does. The main difference is that the proof term is built using a - reflection scheme applied to a sequent calculus proof of the goal. The search - procedure is also implemented using a different technique. - - Users should be aware that this difference may result in faster proof-search - but slower proof-checking, and :tacn:`rtauto` might not solve goals that - :tacn:`tauto` would be able to solve (e.g. goals involving universal - quantifiers). - - Note that this tactic is only available after a ``Require Import Rtauto``. - -.. tacn:: firstorder - :name: firstorder - - The tactic :tacn:`firstorder` is an experimental extension of :tacn:`tauto` to - first- order reasoning, written by Pierre Corbineau. It is not restricted to - usual logical connectives but instead may reason about any first-order class - inductive definition. - -.. opt:: Firstorder Solver @tactic - :name: Firstorder Solver - - The default tactic used by :tacn:`firstorder` when no rule applies is - :g:`auto with core`, it can be reset locally or globally using this option. - - .. cmd:: Print Firstorder Solver - - Prints the default tactic used by :tacn:`firstorder` when no rule applies. - -.. tacv:: firstorder @tactic - - Tries to solve the goal with :n:`@tactic` when no logical rule may apply. - -.. tacv:: firstorder using {+ @qualid} - - .. deprecated:: 8.3 - - Use the syntax below instead (with commas). - -.. tacv:: firstorder using {+, @qualid} - - Adds lemmas :n:`{+, @qualid}` to the proof-search environment. If :n:`@qualid` - refers to an inductive type, it is the collection of its constructors which are - added to the proof-search environment. - -.. tacv:: firstorder with {+ @ident} - - Adds lemmas from :tacn:`auto` hint bases :n:`{+ @ident}` to the proof-search - environment. - -.. tacv:: firstorder @tactic using {+, @qualid} with {+ @ident} - - This combines the effects of the different variants of :tacn:`firstorder`. - -.. opt:: Firstorder Depth @natural - :name: Firstorder Depth - - This option controls the proof-search depth bound. - -.. tacn:: congruence - :name: congruence - - The tactic :tacn:`congruence`, by Pierre Corbineau, implements the standard - Nelson and Oppen congruence closure algorithm, which is a decision procedure - for ground equalities with uninterpreted symbols. It also includes - constructor theory (see :tacn:`injection` and :tacn:`discriminate`). If the goal - is a non-quantified equality, congruence tries to prove it with non-quantified - equalities in the context. Otherwise it tries to infer a discriminable equality - from those in the context. Alternatively, congruence tries to prove that a - hypothesis is equal to the goal or to the negation of another hypothesis. - - :tacn:`congruence` is also able to take advantage of hypotheses stating - quantified equalities, but you have to provide a bound for the number of extra - equalities generated that way. Please note that one of the sides of the - equality must contain all the quantified variables in order for congruence to - match against it. - -.. example:: - - .. coqtop:: reset all - - Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b: a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a. - intros. - congruence. - Qed. - - Theorem inj (A:Type) (f:A -> A * A) (a c d: A) : f = pair a -> Some (f c) = Some (f d) -> c=d. - intros. - congruence. - Qed. - -.. tacv:: congruence @natural - - Tries to add at most :token:`natural` instances of hypotheses stating quantified equalities - to the problem in order to solve it. A bigger value of :token:`natural` does not make - success slower, only failure. You might consider adding some lemmas as - hypotheses using assert in order for :tacn:`congruence` to use them. - -.. tacv:: congruence with {+ @term} - :name: congruence with - - Adds :n:`{+ @term}` to the pool of terms used by :tacn:`congruence`. This helps - in case you have partially applied constructors in your goal. - -.. exn:: I don’t know how to handle dependent equality. - - The decision procedure managed to find a proof of the goal or of a - discriminable equality but this proof could not be built in |Coq| because of - dependently-typed functions. - -.. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with {+ @term}, replacing metavariables by arbitrary terms. - - The decision procedure could solve the goal with the provision that additional - arguments are supplied for some partially applied constructors. Any term of an - appropriate type will allow the tactic to successfully solve the goal. Those - additional arguments can be given to congruence by filling in the holes in the - terms given in the error message, using the :tacn:`congruence with` variant described above. - -.. flag:: Congruence Verbose - - This flag makes :tacn:`congruence` print debug information. - Checking properties of terms ---------------------------- @@ -4647,189 +2893,6 @@ using the ``Require Import`` command. Use :tacn:`classical_right` to prove the right part of the disjunction with the assumption that the negation of left part holds. -.. _tactics-automating: - -Automating ------------- - - -.. tacn:: btauto - :name: btauto - - The tactic :tacn:`btauto` implements a reflexive solver for boolean - tautologies. It solves goals of the form :g:`t = u` where `t` and `u` are - constructed over the following grammar: - - .. prodn:: - btauto_term ::= @ident - | true - | false - | orb @btauto_term @btauto_term - | andb @btauto_term @btauto_term - | xorb @btauto_term @btauto_term - | negb @btauto_term - | if @btauto_term then @btauto_term else @btauto_term - - Whenever the formula supplied is not a tautology, it also provides a - counter-example. - - Internally, it uses a system very similar to the one of the ring - tactic. - - Note that this tactic is only available after a ``Require Import Btauto``. - - .. exn:: Cannot recognize a boolean equality. - - The goal is not of the form :g:`t = u`. Especially note that :tacn:`btauto` - doesn't introduce variables into the context on its own. - -.. tacv:: field - field_simplify {* @term} - field_simplify_eq - - The field tactic is built on the same ideas as ring: this is a - reflexive tactic that solves or simplifies equations in a field - structure. The main idea is to reduce a field expression (which is an - extension of ring expressions with the inverse and division - operations) to a fraction made of two polynomial expressions. - - Tactic :n:`field` is used to solve subgoals, whereas :n:`field_simplify {+ @term}` - replaces the provided terms by their reduced fraction. - :n:`field_simplify_eq` applies when the conclusion is an equation: it - simplifies both hand sides and multiplies so as to cancel - denominators. So it produces an equation without division nor inverse. - - All of these 3 tactics may generate a subgoal in order to prove that - denominators are different from zero. - - See :ref:`Theringandfieldtacticfamilies` for more information on the tactic and how to - declare new field structures. All declared field structures can be - printed with the Print Fields command. - -.. example:: - - .. coqtop:: reset all - - Require Import Reals. - Goal forall x y:R, - (x * y > 0)%R -> - (x * (1 / x + x / (x + y)))%R = - ((- 1 / y) * y * (- x * (x / (x + y)) - 1))%R. - - intros; field. - -.. seealso:: - - File plugins/ring/RealField.v for an example of instantiation, - theory theories/Reals for many examples of use of field. - -Non-logical tactics ------------------------- - - -.. tacn:: cycle @integer - :name: cycle - - Reorders the selected goals so that the first :n:`@integer` goals appear after the - other selected goals. - If :n:`@integer` is negative, it puts the last :n:`@integer` goals at the - beginning of the list. - The tactic is only useful with a goal selector, most commonly `all:`. - Note that other selectors reorder goals; `1,3: cycle 1` is not equivalent - to `all: cycle 1`. See :tacn:`… : … (goal selector)`. - -.. example:: - - .. coqtop:: none reset - - Parameter P : nat -> Prop. - - .. coqtop:: all abort - - Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. - repeat split. - all: cycle 2. - all: cycle -3. - -.. tacn:: swap @integer @integer - :name: swap - - Exchanges the position of the specified goals. - Negative values for :n:`@integer` indicate counting goals - backward from the end of the list of selected goals. Goals are indexed from 1. - The tactic is only useful with a goal selector, most commonly `all:`. - Note that other selectors reorder goals; `1,3: swap 1 3` is not equivalent - to `all: swap 1 3`. See :tacn:`… : … (goal selector)`. - -.. example:: - - .. coqtop:: all abort - - Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. - repeat split. - all: swap 1 3. - all: swap 1 -1. - -.. tacn:: revgoals - :name: revgoals - - Reverses the order of the selected goals. The tactic is only useful with a goal - selector, most commonly `all :`. Note that other selectors reorder goals; - `1,3: revgoals` is not equivalent to `all: revgoals`. See :tacn:`… : … (goal selector)`. - - .. example:: - - .. coqtop:: all abort - - Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. - repeat split. - all: revgoals. - -.. tacn:: shelve - :name: shelve - - This tactic moves all goals under focus to a shelf. While on the - shelf, goals will not be focused on. They can be solved by - unification, or they can be called back into focus with the command - :cmd:`Unshelve`. - - .. tacv:: shelve_unifiable - :name: shelve_unifiable - - Shelves only the goals under focus that are mentioned in other goals. - Goals that appear in the type of other goals can be solved by unification. - - .. example:: - - .. coqtop:: all abort - - Goal exists n, n=0. - refine (ex_intro _ _ _). - all: shelve_unifiable. - reflexivity. - -.. cmd:: Unshelve - - This command moves all the goals on the shelf (see :tacn:`shelve`) - from the shelf into focus, by appending them to the end of the current - list of focused goals. - -.. tacn:: unshelve @tactic - :name: unshelve - - Performs :n:`@tactic`, then unshelves existential variables added to the - shelf by the execution of :n:`@tactic`, prepending them to the current goal. - -.. tacn:: give_up - :name: give_up - - This tactic removes the focused goals from the proof. They are not - solved, and cannot be solved later in the proof. As the goals are not - solved, the proof cannot be closed. - - The ``give_up`` tactic can be used while editing a proof, to choose to - write the proof script in a non-sequential order. - Delaying solving unification constraints ---------------------------------------- diff --git a/doc/sphinx/proof-engine/vernacular-commands.rst b/doc/sphinx/proof-engine/vernacular-commands.rst index 301559d69d..dd0b12f8ec 100644 --- a/doc/sphinx/proof-engine/vernacular-commands.rst +++ b/doc/sphinx/proof-engine/vernacular-commands.rst @@ -990,11 +990,6 @@ described first. has to check the conversion (see Section :ref:`conversion-rules`) of two distinct applied constants. - .. seealso:: - - Sections :ref:`performingcomputations`, :ref:`tactics-automating`, - :ref:`proof-editing-mode` - .. cmd:: Transparent {+ @reference } This command accepts the :attr:`global` attribute. By default, the scope @@ -1015,10 +1010,7 @@ described first. There is no constant named :n:`@qualid` in the environment. - .. seealso:: - - Sections :ref:`performingcomputations`, - :ref:`tactics-automating`, :ref:`proof-editing-mode` +.. seealso:: :ref:`performingcomputations` and :ref:`proof-editing-mode` .. _vernac-strategy: diff --git a/doc/sphinx/proofs/automatic-tactics/auto.rst b/doc/sphinx/proofs/automatic-tactics/auto.rst new file mode 100644 index 0000000000..cc8af976d2 --- /dev/null +++ b/doc/sphinx/proofs/automatic-tactics/auto.rst @@ -0,0 +1,672 @@ +.. _automation: + +========================= +Programmable proof search +========================= + +.. tacn:: auto + :name: auto + + This tactic implements a Prolog-like resolution procedure to solve the + current goal. It first tries to solve the goal using the :tacn:`assumption` + tactic, then it reduces the goal to an atomic one using :tacn:`intros` and + introduces the newly generated hypotheses as hints. Then it looks at + the list of tactics associated to the head symbol of the goal and + tries to apply one of them (starting from the tactics with lower + cost). This process is recursively applied to the generated subgoals. + + By default, :tacn:`auto` only uses the hypotheses of the current goal and + the hints of the database named ``core``. + + .. warning:: + + :tacn:`auto` uses a weaker version of :tacn:`apply` that is closer to + :tacn:`simple apply` so it is expected that sometimes :tacn:`auto` will + fail even if applying manually one of the hints would succeed. + + .. tacv:: auto @natural + + Forces the search depth to be :token:`natural`. The maximal search depth + is 5 by default. + + .. tacv:: auto with {+ @ident} + + Uses the hint databases :n:`{+ @ident}` in addition to the database ``core``. + + .. note:: + + Use the fake database `nocore` if you want to *not* use the `core` + database. + + .. tacv:: auto with * + + Uses all existing hint databases. Using this variant is highly discouraged + in finished scripts since it is both slower and less robust than the variant + where the required databases are explicitly listed. + + .. seealso:: + :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` for the list of + pre-defined databases and the way to create or extend a database. + + .. tacv:: auto using {+ @qualid__i} {? with {+ @ident } } + + Uses lemmas :n:`@qualid__i` in addition to hints. If :n:`@qualid` is an + inductive type, it is the collection of its constructors which are added + as hints. + + .. note:: + + The hints passed through the `using` clause are used in the same + way as if they were passed through a hint database. Consequently, + they use a weaker version of :tacn:`apply` and :n:`auto using @qualid` + may fail where :n:`apply @qualid` succeeds. + + Given that this can be seen as counter-intuitive, it could be useful + to have an option to use full-blown :tacn:`apply` for lemmas passed + through the `using` clause. Contributions welcome! + + .. tacv:: info_auto + + Behaves like :tacn:`auto` but shows the tactics it uses to solve the goal. This + variant is very useful for getting a better understanding of automation, or + to know what lemmas/assumptions were used. + + .. tacv:: debug auto + :name: debug auto + + Behaves like :tacn:`auto` but shows the tactics it tries to solve the goal, + including failing paths. + + .. tacv:: {? info_}auto {? @natural} {? using {+ @qualid}} {? with {+ @ident}} + + This is the most general form, combining the various options. + +.. tacv:: trivial + :name: trivial + + This tactic is a restriction of :tacn:`auto` that is not recursive + and tries only hints that cost `0`. Typically it solves trivial + equalities like :g:`X=X`. + + .. tacv:: trivial with {+ @ident} + trivial with * + trivial using {+ @qualid} + debug trivial + info_trivial + {? info_}trivial {? using {+ @qualid}} {? with {+ @ident}} + :name: _; _; _; debug trivial; info_trivial; _ + :undocumented: + +.. note:: + :tacn:`auto` and :tacn:`trivial` either solve completely the goal or + else succeed without changing the goal. Use :g:`solve [ auto ]` and + :g:`solve [ trivial ]` if you would prefer these tactics to fail when + they do not manage to solve the goal. + +.. flag:: Info Auto + Debug Auto + Info Trivial + Debug Trivial + + These flags enable printing of informative or debug information for + the :tacn:`auto` and :tacn:`trivial` tactics. + +.. tacn:: eauto + :name: eauto + + This tactic generalizes :tacn:`auto`. While :tacn:`auto` does not try + resolution hints which would leave existential variables in the goal, + :tacn:`eauto` does try them (informally speaking, it internally uses a tactic + close to :tacn:`simple eapply` instead of a tactic close to :tacn:`simple apply` + in the case of :tacn:`auto`). As a consequence, :tacn:`eauto` + can solve such a goal: + + .. example:: + + .. coqtop:: all + + Hint Resolve ex_intro : core. + Goal forall P:nat -> Prop, P 0 -> exists n, P n. + eauto. + + Note that ``ex_intro`` should be declared as a hint. + + + .. tacv:: {? info_}eauto {? @natural} {? using {+ @qualid}} {? with {+ @ident}} + + The various options for :tacn:`eauto` are the same as for :tacn:`auto`. + + :tacn:`eauto` also obeys the following flags: + + .. flag:: Info Eauto + Debug Eauto + :undocumented: + + .. seealso:: :ref:`The Hints Databases for auto and eauto <thehintsdatabasesforautoandeauto>` + + +.. tacn:: autounfold with {+ @ident} + :name: autounfold + + This tactic unfolds constants that were declared through a :cmd:`Hint Unfold` + in the given databases. + +.. tacv:: autounfold with {+ @ident} in @goal_occurrences + + Performs the unfolding in the given clause (:token:`goal_occurrences`). + +.. tacv:: autounfold with * + + Uses the unfold hints declared in all the hint databases. + +.. tacn:: autorewrite with {+ @ident} + :name: autorewrite + + This tactic carries out rewritings according to the rewriting rule + bases :n:`{+ @ident}`. + + Each rewriting rule from the base :n:`@ident` is applied to the main subgoal until + it fails. Once all the rules have been processed, if the main subgoal has + progressed (e.g., if it is distinct from the initial main goal) then the rules + of this base are processed again. If the main subgoal has not progressed then + the next base is processed. For the bases, the behavior is exactly similar to + the processing of the rewriting rules. + + The rewriting rule bases are built with the :cmd:`Hint Rewrite` + command. + +.. warning:: + + This tactic may loop if you build non terminating rewriting systems. + +.. tacv:: autorewrite with {+ @ident} using @tactic + + Performs, in the same way, all the rewritings of the bases :n:`{+ @ident}` + applying tactic to the main subgoal after each rewriting step. + +.. tacv:: autorewrite with {+ @ident} in @qualid + + Performs all the rewritings in hypothesis :n:`@qualid`. + +.. tacv:: autorewrite with {+ @ident} in @qualid using @tactic + + Performs all the rewritings in hypothesis :n:`@qualid` applying :n:`@tactic` + to the main subgoal after each rewriting step. + +.. tacv:: autorewrite with {+ @ident} in @goal_occurrences + + Performs all the rewriting in the clause :n:`@goal_occurrences`. + +.. seealso:: + + :ref:`Hint-Rewrite <hintrewrite>` for feeding the database of lemmas used by + :tacn:`autorewrite` and :tacn:`autorewrite` for examples showing the use of this tactic. + +.. tacn:: easy + :name: easy + + This tactic tries to solve the current goal by a number of standard closing steps. + In particular, it tries to close the current goal using the closing tactics + :tacn:`trivial`, :tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`contradiction` + and :tacn:`inversion` of hypothesis. + If this fails, it tries introducing variables and splitting and-hypotheses, + using the closing tactics afterwards, and splitting the goal using + :tacn:`split` and recursing. + + This tactic solves goals that belong to many common classes; in particular, many cases of + unsatisfiable hypotheses, and simple equality goals are usually solved by this tactic. + +.. tacv:: now @tactic + :name: now + + Run :n:`@tactic` followed by :tacn:`easy`. This is a notation for :n:`@tactic; easy`. + +Controlling automation +-------------------------- + +.. _thehintsdatabasesforautoandeauto: + +The hints databases for auto and eauto +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The hints for :tacn:`auto` and :tacn:`eauto` are stored in databases. Each database +maps head symbols to a list of hints. + +.. cmd:: Print Hint @ident + + Use this command + to display the hints associated to the head symbol :n:`@ident` + (see :ref:`Print Hint <printhint>`). Each hint has a cost that is a nonnegative + integer, and an optional pattern. The hints with lower cost are tried first. A + hint is tried by :tacn:`auto` when the conclusion of the current goal matches its + pattern or when it has no pattern. + +Creating Hint databases +``````````````````````` + +One can optionally declare a hint database using the command +:cmd:`Create HintDb`. If a hint is added to an unknown database, it will be +automatically created. + +.. cmd:: Create HintDb @ident {? discriminated} + + This command creates a new database named :n:`@ident`. The database is + implemented by a Discrimination Tree (DT) that serves as an index of + all the lemmas. The DT can use transparency information to decide if a + constant should be indexed or not + (c.f. :ref:`The hints databases for auto and eauto <thehintsdatabasesforautoandeauto>`), + making the retrieval more efficient. The legacy implementation (the default one + for new databases) uses the DT only on goals without existentials (i.e., :tacn:`auto` + goals), for non-Immediate hints and does not make use of transparency + hints, putting more work on the unification that is run after + retrieval (it keeps a list of the lemmas in case the DT is not used). + The new implementation enabled by the discriminated option makes use + of DTs in all cases and takes transparency information into account. + However, the order in which hints are retrieved from the DT may differ + from the order in which they were inserted, making this implementation + observationally different from the legacy one. + +.. cmd:: Hint @hint_definition : {+ @ident} + + The general command to add a hint to some databases :n:`{+ @ident}`. + + This command supports the :attr:`local`, :attr:`global` and :attr:`export` + locality attributes. When no locality is explictly given, the + command is :attr:`local` inside a section and :attr:`global` otherwise. + + + :attr:`local` hints are never visible from other modules, even if they + require or import the current module. Inside a section, the :attr:`local` + attribute is useless since hints do not survive anyway to the closure of + sections. + + + :attr:`export` are visible from other modules when they import the current + module. Requiring it is not enough. This attribute is only effective for + the :cmd:`Hint Resolve`, :cmd:`Hint Immediate`, :cmd:`Hint Unfold` and + :cmd:`Hint Extern` variants of the command. + + + :attr:`global` hints are made available by merely requiring the current + module. + + The various possible :production:`hint_definition`\s are given below. + + .. cmdv:: Hint @hint_definition + + No database name is given: the hint is registered in the ``core`` database. + + .. deprecated:: 8.10 + + .. cmdv:: Hint Resolve @qualid {? | {? @natural} {? @pattern}} : @ident + :name: Hint Resolve + + This command adds :n:`simple apply @qualid` to the hint list with the head + symbol of the type of :n:`@qualid`. The cost of that hint is the number of + subgoals generated by :n:`simple apply @qualid` or :n:`@natural` if specified. The + associated :n:`@pattern` is inferred from the conclusion of the type of + :n:`@qualid` or the given :n:`@pattern` if specified. In case the inferred type + of :n:`@qualid` does not start with a product the tactic added in the hint list + is :n:`exact @qualid`. In case this type can however be reduced to a type + starting with a product, the tactic :n:`simple apply @qualid` is also stored in + the hints list. If the inferred type of :n:`@qualid` contains a dependent + quantification on a variable which occurs only in the premisses of the type + and not in its conclusion, no instance could be inferred for the variable by + unification with the goal. In this case, the hint is added to the hint list + of :tacn:`eauto` instead of the hint list of auto and a warning is printed. A + typical example of a hint that is used only by :tacn:`eauto` is a transitivity + lemma. + + .. exn:: @qualid cannot be used as a hint + + The head symbol of the type of :n:`@qualid` is a bound variable + such that this tactic cannot be associated to a constant. + + .. cmdv:: Hint Resolve {+ @qualid} : @ident + + Adds each :n:`Hint Resolve @qualid`. + + .. cmdv:: Hint Resolve -> @qualid : @ident + + Adds the left-to-right implication of an equivalence as a hint (informally + the hint will be used as :n:`apply <- @qualid`, although as mentioned + before, the tactic actually used is a restricted version of + :tacn:`apply`). + + .. cmdv:: Hint Resolve <- @qualid + + Adds the right-to-left implication of an equivalence as a hint. + + .. cmdv:: Hint Immediate @qualid : @ident + :name: Hint Immediate + + This command adds :n:`simple apply @qualid; trivial` to the hint list associated + with the head symbol of the type of :n:`@ident` in the given database. This + tactic will fail if all the subgoals generated by :n:`simple apply @qualid` are + not solved immediately by the :tacn:`trivial` tactic (which only tries tactics + with cost 0).This command is useful for theorems such as the symmetry of + equality or :g:`n+1=m+1 -> n=m` that we may like to introduce with a limited + use in order to avoid useless proof-search. The cost of this tactic (which + never generates subgoals) is always 1, so that it is not used by :tacn:`trivial` + itself. + + .. exn:: @qualid cannot be used as a hint + :undocumented: + + .. cmdv:: Hint Immediate {+ @qualid} : @ident + + Adds each :n:`Hint Immediate @qualid`. + + .. cmdv:: Hint Constructors @qualid : @ident + :name: Hint Constructors + + If :token:`qualid` is an inductive type, this command adds all its constructors as + hints of type ``Resolve``. Then, when the conclusion of current goal has the form + :n:`(@qualid ...)`, :tacn:`auto` will try to apply each constructor. + + .. exn:: @qualid is not an inductive type + :undocumented: + + .. cmdv:: Hint Constructors {+ @qualid} : @ident + + Extends the previous command for several inductive types. + + .. cmdv:: Hint Unfold @qualid : @ident + :name: Hint Unfold + + This adds the tactic :n:`unfold @qualid` to the hint list that will only be + used when the head constant of the goal is :token:`qualid`. + Its cost is 4. + + .. cmdv:: Hint Unfold {+ @qualid} + + Extends the previous command for several defined constants. + + .. cmdv:: Hint Transparent {+ @qualid} : @ident + Hint Opaque {+ @qualid} : @ident + :name: Hint Transparent; Hint Opaque + + This adds transparency hints to the database, making :n:`@qualid` + transparent or opaque constants during resolution. This information is used + during unification of the goal with any lemma in the database and inside the + discrimination network to relax or constrain it in the case of discriminated + databases. + + .. cmdv:: Hint Variables {| Transparent | Opaque } : @ident + Hint Constants {| Transparent | Opaque } : @ident + :name: Hint Variables; Hint Constants + + This sets the transparency flag used during unification of + hints in the database for all constants or all variables, + overwriting the existing settings of opacity. It is advised + to use this just after a :cmd:`Create HintDb` command. + + .. cmdv:: Hint Extern @natural {? @pattern} => @tactic : @ident + :name: Hint Extern + + This hint type is to extend :tacn:`auto` with tactics other than :tacn:`apply` and + :tacn:`unfold`. For that, we must specify a cost, an optional :n:`@pattern` and a + :n:`@tactic` to execute. + + .. example:: + + .. coqtop:: in + + Hint Extern 4 (~(_ = _)) => discriminate : core. + + Now, when the head of the goal is a disequality, ``auto`` will try + discriminate if it does not manage to solve the goal with hints with a + cost less than 4. + + One can even use some sub-patterns of the pattern in + the tactic script. A sub-pattern is a question mark followed by an + identifier, like ``?X1`` or ``?X2``. Here is an example: + + .. example:: + + .. coqtop:: reset all + + Require Import List. + Hint Extern 5 ({?X1 = ?X2} + {?X1 <> ?X2}) => generalize X1, X2; decide equality : eqdec. + Goal forall a b:list (nat * nat), {a = b} + {a <> b}. + Info 1 auto with eqdec. + + .. cmdv:: Hint Cut @regexp : @ident + :name: Hint Cut + + .. warning:: + + These hints currently only apply to typeclass proof search and the + :tacn:`typeclasses eauto` tactic. + + This command can be used to cut the proof-search tree according to a regular + expression matching paths to be cut. The grammar for regular expressions is + the following. Beware, there is no operator precedence during parsing, one can + check with :cmd:`Print HintDb` to verify the current cut expression: + + .. prodn:: + regexp ::= @ident (hint or instance identifier) + | _ (any hint) + | @regexp | @regexp (disjunction) + | @regexp @regexp (sequence) + | @regexp * (Kleene star) + | emp (empty) + | eps (epsilon) + | ( @regexp ) + + The `emp` regexp does not match any search path while `eps` + matches the empty path. During proof search, the path of + successive successful hints on a search branch is recorded, as a + list of identifiers for the hints (note that :cmd:`Hint Extern`\’s do not have + an associated identifier). + Before applying any hint :n:`@ident` the current path `p` extended with + :n:`@ident` is matched against the current cut expression `c` associated to + the hint database. If matching succeeds, the hint is *not* applied. The + semantics of :n:`Hint Cut @regexp` is to set the cut expression + to :n:`c | regexp`, the initial cut expression being `emp`. + + .. cmdv:: Hint Mode @qualid {* {| + | ! | - } } : @ident + :name: Hint Mode + + This sets an optional mode of use of the identifier :n:`@qualid`. When + proof-search faces a goal that ends in an application of :n:`@qualid` to + arguments :n:`@term ... @term`, the mode tells if the hints associated to + :n:`@qualid` can be applied or not. A mode specification is a list of n ``+``, + ``!`` or ``-`` items that specify if an argument of the identifier is to be + treated as an input (``+``), if its head only is an input (``!``) or an output + (``-``) of the identifier. For a mode to match a list of arguments, input + terms and input heads *must not* contain existential variables or be + existential variables respectively, while outputs can be any term. Multiple + modes can be declared for a single identifier, in that case only one mode + needs to match the arguments for the hints to be applied. The head of a term + is understood here as the applicative head, or the match or projection + scrutinee’s head, recursively, casts being ignored. :cmd:`Hint Mode` is + especially useful for typeclasses, when one does not want to support default + instances and avoid ambiguity in general. Setting a parameter of a class as an + input forces proof-search to be driven by that index of the class, with ``!`` + giving more flexibility by allowing existentials to still appear deeper in the + index but not at its head. + + .. note:: + + + One can use a :cmd:`Hint Extern` with no pattern to do + pattern matching on hypotheses using ``match goal with`` + inside the tactic. + + + If you want to add hints such as :cmd:`Hint Transparent`, + :cmd:`Hint Cut`, or :cmd:`Hint Mode`, for typeclass + resolution, do not forget to put them in the + ``typeclass_instances`` hint database. + + +Hint databases defined in the |Coq| standard library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Several hint databases are defined in the |Coq| standard library. The +actual content of a database is the collection of hints declared +to belong to this database in each of the various modules currently +loaded. Especially, requiring new modules may extend the database. +At |Coq| startup, only the core database is nonempty and can be used. + +:core: This special database is automatically used by ``auto``, except when + pseudo-database ``nocore`` is given to ``auto``. The core database + contains only basic lemmas about negation, conjunction, and so on. + Most of the hints in this database come from the Init and Logic directories. + +:arith: 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. 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. + +:datatypes: is for lemmas about lists, streams and so on that are mainly proved + in the Lists subdirectory. + +:sets: contains lemmas about sets and relations from the directories Sets and + Relations. + +:typeclass_instances: contains all the typeclass instances declared in the + environment, including those used for ``setoid_rewrite``, + from the Classes directory. + +:fset: internal database for the implementation of the ``FSets`` library. + +:ordered_type: lemmas about ordered types (as defined in the legacy ``OrderedType`` module), + mainly used in the ``FSets`` and ``FMaps`` libraries. + +You are advised not to put your own hints in the core database, but +use one or several databases specific to your development. + +.. _removehints: + +.. cmd:: Remove Hints {+ @term} : {+ @ident} + + This command removes the hints associated to terms :n:`{+ @term}` in databases + :n:`{+ @ident}`. + +.. _printhint: + +.. cmd:: Print Hint + + This command displays all hints that apply to the current goal. It + fails if no proof is being edited, while the two variants can be used + at every moment. + +**Variants:** + + +.. cmd:: Print Hint @ident + + This command displays only tactics associated with :n:`@ident` in the hints + list. This is independent of the goal being edited, so this command will not + fail if no goal is being edited. + +.. cmd:: Print Hint * + + This command displays all declared hints. + +.. cmd:: Print HintDb @ident + + This command displays all hints from database :n:`@ident`. + +.. _hintrewrite: + +.. cmd:: Hint Rewrite {+ @term} : {+ @ident} + + This vernacular command adds the terms :n:`{+ @term}` (their types must be + equalities) in the rewriting bases :n:`{+ @ident}` with the default orientation + (left to right). Notice that the rewriting bases are distinct from the :tacn:`auto` + hint bases and that :tacn:`auto` does not take them into account. + + This command is synchronous with the section mechanism (see :ref:`section-mechanism`): + when closing a section, all aliases created by ``Hint Rewrite`` in that + section are lost. Conversely, when loading a module, all ``Hint Rewrite`` + declarations at the global level of that module are loaded. + +**Variants:** + +.. cmd:: Hint Rewrite -> {+ @term} : {+ @ident} + + This is strictly equivalent to the command above (we only make explicit the + orientation which otherwise defaults to ->). + +.. cmd:: Hint Rewrite <- {+ @term} : {+ @ident} + + Adds the rewriting rules :n:`{+ @term}` with a right-to-left orientation in + the bases :n:`{+ @ident}`. + +.. cmd:: Hint Rewrite {? {| -> | <- } } {+ @one_term } {? using @ltac_expr } {? : {* @ident } } + + When the rewriting rules :n:`{+ @term}` in :n:`{+ @ident}` will be used, the + tactic ``tactic`` will be applied to the generated subgoals, the main subgoal + excluded. + +.. cmd:: Print Rewrite HintDb @ident + + This command displays all rewrite hints contained in :n:`@ident`. + +Hint locality +~~~~~~~~~~~~~ + +Hints provided by the ``Hint`` commands are erased when closing a section. +Conversely, all hints of a module ``A`` that are not defined inside a +section (and not defined with option ``Local``) become available when the +module ``A`` is required (using e.g. ``Require A.``). + +As of today, hints only have a binary behavior regarding locality, as +described above: either they disappear at the end of a section scope, +or they remain global forever. This causes a scalability issue, +because hints coming from an unrelated part of the code may badly +influence another development. It can be mitigated to some extent +thanks to the :cmd:`Remove Hints` command, +but this is a mere workaround and has some limitations (for instance, external +hints cannot be removed). + +A proper way to fix this issue is to bind the hints to their module scope, as +for most of the other objects |Coq| uses. Hints should only be made available when +the module they are defined in is imported, not just required. It is very +difficult to change the historical behavior, as it would break a lot of scripts. +We propose a smooth transitional path by providing the :opt:`Loose Hint Behavior` +option which accepts three flags allowing for a fine-grained handling of +non-imported hints. + +.. opt:: Loose Hint Behavior {| "Lax" | "Warn" | "Strict" } + :name: Loose Hint Behavior + + This option accepts three values, which control the behavior of hints w.r.t. + :cmd:`Import`: + + - "Lax": this is the default, and corresponds to the historical behavior, + that is, hints defined outside of a section have a global scope. + + - "Warn": outputs a warning when a non-imported hint is used. Note that this + is an over-approximation, because a hint may be triggered by a run that + will eventually fail and backtrack, resulting in the hint not being + actually useful for the proof. + + - "Strict": changes the behavior of an unloaded hint to a immediate fail + tactic, allowing to emulate an import-scoped hint mechanism. + +.. _tactics-implicit-automation: + +Setting implicit automation tactics +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. cmd:: Proof with @tactic + + This command may be used to start a proof. It defines a default tactic + to be used each time a tactic command ``tactic``:sub:`1` is ended by ``...``. + In this case the tactic command typed by the user is equivalent to + ``tactic``:sub:`1` ``;tactic``. + + .. seealso:: :cmd:`Proof` in :ref:`proof-editing-mode`. + + + .. cmdv:: Proof with @tactic using {+ @ident} + + Combines in a single line ``Proof with`` and ``Proof using``, see :ref:`proof-editing-mode` + + .. cmdv:: Proof using {+ @ident} with @tactic + + Combines in a single line ``Proof with`` and ``Proof using``, see :ref:`proof-editing-mode` diff --git a/doc/sphinx/proofs/automatic-tactics/index.rst b/doc/sphinx/proofs/automatic-tactics/index.rst index a219770c69..c3712b109d 100644 --- a/doc/sphinx/proofs/automatic-tactics/index.rst +++ b/doc/sphinx/proofs/automatic-tactics/index.rst @@ -1,20 +1,22 @@ .. _automatic-tactics: ===================================================== -Built-in decision procedures and programmable tactics +Automatic solvers and programmable tactics ===================================================== Some tactics are largely automated and are able to solve complex -goals. This chapter presents both some decision procedures that can -be used to solve some specific categories of goals, and some -programmable tactics, that the user can instrument to handle some +goals. This chapter presents both built-in solvers that can +be used on specific categories of goals and +programmable tactics that the user can instrument to handle complex goals in new domains. .. toctree:: :maxdepth: 1 + logic ../../addendum/omega ../../addendum/micromega ../../addendum/ring ../../addendum/nsatz + auto ../../addendum/generalized-rewriting diff --git a/doc/sphinx/proofs/automatic-tactics/logic.rst b/doc/sphinx/proofs/automatic-tactics/logic.rst new file mode 100644 index 0000000000..acf64ae437 --- /dev/null +++ b/doc/sphinx/proofs/automatic-tactics/logic.rst @@ -0,0 +1,294 @@ +.. _decisionprocedures: + +============================== +Solvers for logic and equality +============================== + +.. tacn:: tauto + :name: tauto + + This tactic implements a decision procedure for intuitionistic propositional + calculus based on the contraction-free sequent calculi LJT* of Roy Dyckhoff + :cite:`Dyc92`. Note that :tacn:`tauto` succeeds on any instance of an + intuitionistic tautological proposition. :tacn:`tauto` unfolds negations and + logical equivalence but does not unfold any other definition. + +.. example:: + + The following goal can be proved by :tacn:`tauto` whereas :tacn:`auto` would + fail: + + .. coqtop:: reset all + + Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x. + intros. + tauto. + +Moreover, if it has nothing else to do, :tacn:`tauto` performs introductions. +Therefore, the use of :tacn:`intros` in the previous proof is unnecessary. +:tacn:`tauto` can for instance for: + +.. example:: + + .. coqtop:: reset all + + Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ A -> P x. + tauto. + +.. note:: + In contrast, :tacn:`tauto` cannot solve the following goal + :g:`Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) ->` + :g:`forall x:nat, ~ ~ (A \/ P x).` + because :g:`(forall x:nat, ~ A -> P x)` cannot be treated as atomic and + an instantiation of `x` is necessary. + +.. tacv:: dtauto + :name: dtauto + + While :tacn:`tauto` recognizes inductively defined connectives isomorphic to + the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, + ``Empty_set``, ``unit``, ``True``, :tacn:`dtauto` also recognizes all inductive + types with one constructor and no indices, i.e. record-style connectives. + +.. tacn:: intuition @tactic + :name: intuition + + The tactic :tacn:`intuition` takes advantage of the search-tree built by the + decision procedure involved in the tactic :tacn:`tauto`. It uses this + information to generate a set of subgoals equivalent to the original one (but + simpler than it) and applies the tactic :n:`@tactic` to them :cite:`Mun94`. If + this tactic fails on some goals then :tacn:`intuition` fails. In fact, + :tacn:`tauto` is simply :g:`intuition fail`. + + .. example:: + + For instance, the tactic :g:`intuition auto` applied to the goal:: + + (forall (x:nat), P x) /\ B -> (forall (y:nat), P y) /\ P O \/ B /\ P O + + internally replaces it by the equivalent one:: + + (forall (x:nat), P x), B |- P O + + and then uses :tacn:`auto` which completes the proof. + +Originally due to César Muñoz, these tactics (:tacn:`tauto` and +:tacn:`intuition`) have been completely re-engineered by David Delahaye using +mainly the tactic language (see :ref:`ltac`). The code is +now much shorter and a significant increase in performance has been noticed. +The general behavior with respect to dependent types, unfolding and +introductions has slightly changed to get clearer semantics. This may lead to +some incompatibilities. + +.. tacv:: intuition + + Is equivalent to :g:`intuition auto with *`. + +.. tacv:: dintuition + :name: dintuition + + While :tacn:`intuition` recognizes inductively defined connectives + isomorphic to the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, + ``Empty_set``, ``unit``, ``True``, :tacn:`dintuition` also recognizes all inductive + types with one constructor and no indices, i.e. record-style connectives. + +.. flag:: Intuition Negation Unfolding + + Controls whether :tacn:`intuition` unfolds inner negations which do not need + to be unfolded. This flag is on by default. + +.. tacn:: rtauto + :name: rtauto + + The :tacn:`rtauto` tactic solves propositional tautologies similarly to what + :tacn:`tauto` does. The main difference is that the proof term is built using a + reflection scheme applied to a sequent calculus proof of the goal. The search + procedure is also implemented using a different technique. + + Users should be aware that this difference may result in faster proof-search + but slower proof-checking, and :tacn:`rtauto` might not solve goals that + :tacn:`tauto` would be able to solve (e.g. goals involving universal + quantifiers). + + Note that this tactic is only available after a ``Require Import Rtauto``. + +.. tacn:: firstorder + :name: firstorder + + The tactic :tacn:`firstorder` is an experimental extension of :tacn:`tauto` to + first- order reasoning, written by Pierre Corbineau. It is not restricted to + usual logical connectives but instead may reason about any first-order class + inductive definition. + +.. opt:: Firstorder Solver @tactic + :name: Firstorder Solver + + The default tactic used by :tacn:`firstorder` when no rule applies is + :g:`auto with core`, it can be reset locally or globally using this option. + + .. cmd:: Print Firstorder Solver + + Prints the default tactic used by :tacn:`firstorder` when no rule applies. + +.. tacv:: firstorder @tactic + + Tries to solve the goal with :n:`@tactic` when no logical rule may apply. + +.. tacv:: firstorder using {+ @qualid} + + .. deprecated:: 8.3 + + Use the syntax below instead (with commas). + +.. tacv:: firstorder using {+, @qualid} + + Adds lemmas :n:`{+, @qualid}` to the proof-search environment. If :n:`@qualid` + refers to an inductive type, it is the collection of its constructors which are + added to the proof-search environment. + +.. tacv:: firstorder with {+ @ident} + + Adds lemmas from :tacn:`auto` hint bases :n:`{+ @ident}` to the proof-search + environment. + +.. tacv:: firstorder @tactic using {+, @qualid} with {+ @ident} + + This combines the effects of the different variants of :tacn:`firstorder`. + +.. opt:: Firstorder Depth @natural + :name: Firstorder Depth + + This option controls the proof-search depth bound. + +.. tacn:: congruence + :name: congruence + + The tactic :tacn:`congruence`, by Pierre Corbineau, implements the standard + Nelson and Oppen congruence closure algorithm, which is a decision procedure + for ground equalities with uninterpreted symbols. It also includes + constructor theory (see :tacn:`injection` and :tacn:`discriminate`). If the goal + is a non-quantified equality, congruence tries to prove it with non-quantified + equalities in the context. Otherwise it tries to infer a discriminable equality + from those in the context. Alternatively, congruence tries to prove that a + hypothesis is equal to the goal or to the negation of another hypothesis. + + :tacn:`congruence` is also able to take advantage of hypotheses stating + quantified equalities, but you have to provide a bound for the number of extra + equalities generated that way. Please note that one of the sides of the + equality must contain all the quantified variables in order for congruence to + match against it. + +.. example:: + + .. coqtop:: reset all + + Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b: a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a. + intros. + congruence. + Qed. + + Theorem inj (A:Type) (f:A -> A * A) (a c d: A) : f = pair a -> Some (f c) = Some (f d) -> c=d. + intros. + congruence. + Qed. + +.. tacv:: congruence @natural + + Tries to add at most :token:`natural` instances of hypotheses stating quantified equalities + to the problem in order to solve it. A bigger value of :token:`natural` does not make + success slower, only failure. You might consider adding some lemmas as + hypotheses using assert in order for :tacn:`congruence` to use them. + +.. tacv:: congruence with {+ @term} + :name: congruence with + + Adds :n:`{+ @term}` to the pool of terms used by :tacn:`congruence`. This helps + in case you have partially applied constructors in your goal. + +.. exn:: I don’t know how to handle dependent equality. + + The decision procedure managed to find a proof of the goal or of a + discriminable equality but this proof could not be built in |Coq| because of + dependently-typed functions. + +.. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with {+ @term}, replacing metavariables by arbitrary terms. + + The decision procedure could solve the goal with the provision that additional + arguments are supplied for some partially applied constructors. Any term of an + appropriate type will allow the tactic to successfully solve the goal. Those + additional arguments can be given to congruence by filling in the holes in the + terms given in the error message, using the :tacn:`congruence with` variant described above. + +.. flag:: Congruence Verbose + + This flag makes :tacn:`congruence` print debug information. + +.. tacn:: btauto + :name: btauto + + The tactic :tacn:`btauto` implements a reflexive solver for boolean + tautologies. It solves goals of the form :g:`t = u` where `t` and `u` are + constructed over the following grammar: + + .. prodn:: + btauto_term ::= @ident + | true + | false + | orb @btauto_term @btauto_term + | andb @btauto_term @btauto_term + | xorb @btauto_term @btauto_term + | negb @btauto_term + | if @btauto_term then @btauto_term else @btauto_term + + Whenever the formula supplied is not a tautology, it also provides a + counter-example. + + Internally, it uses a system very similar to the one of the ring + tactic. + + Note that this tactic is only available after a ``Require Import Btauto``. + + .. exn:: Cannot recognize a boolean equality. + + The goal is not of the form :g:`t = u`. Especially note that :tacn:`btauto` + doesn't introduce variables into the context on its own. + +.. tacv:: field + field_simplify {* @term} + field_simplify_eq + + The field tactic is built on the same ideas as ring: this is a + reflexive tactic that solves or simplifies equations in a field + structure. The main idea is to reduce a field expression (which is an + extension of ring expressions with the inverse and division + operations) to a fraction made of two polynomial expressions. + + Tactic :n:`field` is used to solve subgoals, whereas :n:`field_simplify {+ @term}` + replaces the provided terms by their reduced fraction. + :n:`field_simplify_eq` applies when the conclusion is an equation: it + simplifies both hand sides and multiplies so as to cancel + denominators. So it produces an equation without division nor inverse. + + All of these 3 tactics may generate a subgoal in order to prove that + denominators are different from zero. + + See :ref:`Theringandfieldtacticfamilies` for more information on the tactic and how to + declare new field structures. All declared field structures can be + printed with the Print Fields command. + +.. example:: + + .. coqtop:: reset all + + Require Import Reals. + Goal forall x y:R, + (x * y > 0)%R -> + (x * (1 / x + x / (x + y)))%R = + ((- 1 / y) * y * (- x * (x / (x + y)) - 1))%R. + + intros; field. + +.. seealso:: + + File plugins/ring/RealField.v for an example of instantiation, + theory theories/Reals for many examples of use of field. diff --git a/doc/sphinx/proofs/writing-proofs/index.rst b/doc/sphinx/proofs/writing-proofs/index.rst index 3f5526dba8..1c7fd050f1 100644 --- a/doc/sphinx/proofs/writing-proofs/index.rst +++ b/doc/sphinx/proofs/writing-proofs/index.rst @@ -1,8 +1,8 @@ .. _writing-proofs: -============== -Writing proofs -============== +=================== +Basic proof writing +=================== |Coq| is an interactive theorem prover, or proof assistant, which means that proofs can be constructed interactively through a dialog between @@ -27,8 +27,9 @@ flavors of tactics, including the SSReflect proof language. .. toctree:: :maxdepth: 1 - ../../proof-engine/proof-handling + proof-mode ../../proof-engine/tactics + rewriting ../../proof-engine/ssreflect-proof-language ../../proof-engine/detailed-tactic-examples ../../user-extensions/proof-schemes diff --git a/doc/sphinx/proofs/writing-proofs/proof-mode.rst b/doc/sphinx/proofs/writing-proofs/proof-mode.rst new file mode 100644 index 0000000000..b74c9d3a23 --- /dev/null +++ b/doc/sphinx/proofs/writing-proofs/proof-mode.rst @@ -0,0 +1,1037 @@ +.. _proofhandling: + +------------------- + Proof handling +------------------- + +In |Coq|’s proof editing mode all top-level commands documented in +Chapter :ref:`vernacularcommands` remain available and the user has access to specialized +commands dealing with proof development pragmas documented in this +section. They can also use some other specialized commands called +*tactics*. They are the very tools allowing the user to deal with +logical reasoning. They are documented in Chapter :ref:`tactics`. + +|Coq| user interfaces usually have a way of marking whether the user has +switched to proof editing mode. For instance, in coqtop the prompt ``Coq <`` is changed into +:n:`@ident <` where :token:`ident` is the declared name of the theorem currently edited. + +At each stage of a proof development, one has a list of goals to +prove. Initially, the list consists only in the theorem itself. After +having applied some tactics, the list of goals contains the subgoals +generated by the tactics. + +To each subgoal is associated a number of hypotheses called the *local context* +of the goal. Initially, the local context contains the local variables and +hypotheses of the current section (see Section :ref:`gallina-assumptions`) and +the local variables and hypotheses of the theorem statement. It is enriched by +the use of certain tactics (see e.g. :tacn:`intro`). + +When a proof is completed, the message ``Proof completed`` is displayed. +One can then register this proof as a defined constant in the +environment. Because there exists a correspondence between proofs and +terms of λ-calculus, known as the *Curry-Howard isomorphism* +:cite:`How80,Bar81,Gir89,H89`, |Coq| stores proofs as terms of |Cic|. Those +terms are called *proof terms*. + + +.. exn:: No focused proof. + + |Coq| raises this error message when one attempts to use a proof editing command + out of the proof editing mode. + +.. _proof-editing-mode: + +Entering and leaving proof editing mode +--------------------------------------- + +The proof editing mode is entered by asserting a statement, which typically is +the assertion of a theorem using an assertion command like :cmd:`Theorem`. The +list of assertion commands is given in :ref:`Assertions`. The command +:cmd:`Goal` can also be used. + +.. cmd:: Goal @type + + This is intended for quick assertion of statements, without knowing in + advance which name to give to the assertion, typically for quick + testing of the provability of a statement. If the proof of the + statement is eventually completed and validated, the statement is then + bound to the name ``Unnamed_thm`` (or a variant of this name not already + used for another statement). + +.. cmd:: Qed + + This command is available in interactive editing proof mode when the + proof is completed. Then :cmd:`Qed` extracts a proof term from the proof + script, switches back to |Coq| top-level and attaches the extracted + proof term to the declared name of the original goal. The name is + added to the environment as an opaque constant. + + .. exn:: Attempt to save an incomplete proof. + :undocumented: + + .. note:: + + Sometimes an error occurs when building the proof term, because + tactics do not enforce completely the term construction + constraints. + + The user should also be aware of the fact that since the + proof term is completely rechecked at this point, one may have to wait + a while when the proof is large. In some exceptional cases one may + even incur a memory overflow. + +.. cmd:: Save @ident + :name: Save + + Saves a completed proof with the name :token:`ident`, which + overrides any name provided by the :cmd:`Theorem` command or + its variants. + +.. cmd:: Defined {? @ident } + + Similar to :cmd:`Qed` and :cmd:`Save`, except the proof is made *transparent*, which means + that its content can be explicitly used for type checking and that it can be + unfolded in conversion tactics (see :ref:`performingcomputations`, + :cmd:`Opaque`, :cmd:`Transparent`). If :token:`ident` is specified, + the proof is defined with the given name, which overrides any name + provided by the :cmd:`Theorem` command or its variants. + +.. cmd:: Admitted + + This command is available in interactive editing mode to give up + the current proof and declare the initial goal as an axiom. + +.. cmd:: Abort {? {| All | @ident } } + + Cancels the current proof development, switching back to + the previous proof development, or to the |Coq| toplevel if no other + proof was being edited. + + :n:`@ident` + Aborts editing the proof named :n:`@ident` for use when you have + nested proofs. See also :flag:`Nested Proofs Allowed`. + + :n:`All` + Aborts all current proofs. + + .. exn:: No focused proof (No proof-editing in progress). + :undocumented: + +.. cmd:: Proof @term + :name: Proof `term` + + This command applies in proof editing mode. It is equivalent to + :n:`exact @term. Qed.` + That is, you have to give the full proof in one gulp, as a + proof term (see Section :ref:`applyingtheorems`). + + .. warning:: + + Use of this command is discouraged. In particular, it + doesn't work in Proof General because it must + immediately follow the command that opened proof mode, but + Proof General inserts :cmd:`Unset` :flag:`Silent` before it (see + `Proof General issue #498 + <https://github.com/ProofGeneral/PG/issues/498>`_). + +.. cmd:: Proof + + Is a no-op which is useful to delimit the sequence of tactic commands + which start a proof, after a :cmd:`Theorem` command. It is a good practice to + use :cmd:`Proof` as an opening parenthesis, closed in the script with a + closing :cmd:`Qed`. + + .. seealso:: :cmd:`Proof with` + +.. cmd:: Proof using @section_var_expr {? with @ltac_expr } + + .. insertprodn section_var_expr starred_ident_ref + + .. prodn:: + section_var_expr ::= {* @starred_ident_ref } + | {? - } @section_var_expr50 + section_var_expr50 ::= @section_var_expr0 - @section_var_expr0 + | @section_var_expr0 + @section_var_expr0 + | @section_var_expr0 + section_var_expr0 ::= @starred_ident_ref + | ( @section_var_expr ) {? * } + starred_ident_ref ::= @ident {? * } + | Type {? * } + | All + + Opens proof editing mode, declaring the set of + section variables (see :ref:`gallina-assumptions`) used by the proof. + At :cmd:`Qed` time, the + system verifies that the set of section variables used in + the proof is a subset of the declared one. + + The set of declared variables is closed under type dependency. For + example, if ``T`` is a variable and ``a`` is a variable of type + ``T``, then the commands ``Proof using a`` and ``Proof using T a`` + are equivalent. + + The set of declared variables always includes the variables used by + the statement. In other words ``Proof using e`` is equivalent to + ``Proof using Type + e`` for any declaration expression ``e``. + + :n:`- @section_var_expr50` + Use all section variables except those specified by :n:`@section_var_expr50` + + :n:`@section_var_expr0 + @section_var_expr0` + Use section variables from the union of both collections. + See :ref:`nameaset` to see how to form a named collection. + + :n:`@section_var_expr0 - @section_var_expr0` + Use section variables which are in the first collection but not in the + second one. + + :n:`{? * }` + Use the transitive closure of the specified collection. + + :n:`Type` + Use only section variables occurring in the statement. Specifying :n:`*` + uses the forward transitive closure of all the section variables occurring + in the statement. For example, if the variable ``H`` has type ``p < 5`` then + ``H`` is in ``p*`` since ``p`` occurs in the type of ``H``. + + :n:`All` + Use all section variables. + + .. seealso:: :ref:`tactics-implicit-automation` + +.. attr:: using + + This attribute can be applied to the :cmd:`Definition`, :cmd:`Example`, + :cmd:`Fixpoint` and :cmd:`CoFixpoint` commands as well as to :cmd:`Lemma` and + its variants. It takes + a :n:`@section_var_expr`, in quotes, as its value. This is equivalent to + specifying the same :n:`@section_var_expr` in + :cmd:`Proof using`. + + .. example:: + + .. coqtop:: all + + Section Test. + Variable n : nat. + Hypothesis Hn : n <> 0. + + #[using="Hn"] + Lemma example : 0 < n. + + .. coqtop:: in + + Abort. + End Test. + + +Proof using options +``````````````````` + +The following options modify the behavior of ``Proof using``. + + +.. opt:: Default Proof Using "@section_var_expr" + :name: Default Proof Using + + Use :n:`@section_var_expr` as the default ``Proof using`` value. E.g. ``Set Default + Proof Using "a b"`` will complete all ``Proof`` commands not followed by a + ``using`` part with ``using a b``. + + +.. flag:: Suggest Proof Using + + When :cmd:`Qed` is performed, suggest a ``using`` annotation if the user did not + provide one. + +.. _`nameaset`: + +Name a set of section hypotheses for ``Proof using`` +```````````````````````````````````````````````````` + +.. cmd:: Collection @ident := @section_var_expr + + This can be used to name a set of section + hypotheses, with the purpose of making ``Proof using`` annotations more + compact. + + .. example:: + + Define the collection named ``Some`` containing ``x``, ``y`` and ``z``:: + + Collection Some := x y z. + + Define the collection named ``Fewer`` containing only ``x`` and ``y``:: + + Collection Fewer := Some - z + + Define the collection named ``Many`` containing the set union or set + difference of ``Fewer`` and ``Some``:: + + Collection Many := Fewer + Some + Collection Many := Fewer - Some + + Define the collection named ``Many`` containing the set difference of + ``Fewer`` and the unnamed collection ``x y``:: + + Collection Many := Fewer - (x y) + + + +.. cmd:: Existential @natural {? : @type } := @term + + This command instantiates an existential variable. :token:`natural` is an index in + the list of uninstantiated existential variables displayed by :cmd:`Show Existentials`. + + This command is intended to be used to instantiate existential + variables when the proof is completed but some uninstantiated + existential variables remain. To instantiate existential variables + during proof edition, you should use the tactic :tacn:`instantiate`. + +.. cmd:: Grab Existential Variables + + This command can be run when a proof has no more goal to be solved but + has remaining uninstantiated existential variables. It takes every + uninstantiated existential variable and turns it into a goal. + +Proof modes +``````````` + +When entering proof mode through commands such as :cmd:`Goal` and :cmd:`Proof`, +|Coq| picks by default the |Ltac| mode. Nonetheless, there exist other proof modes +shipped in the standard |Coq| installation, and furthermore some plugins define +their own proof modes. The default proof mode used when opening a proof can +be changed using the following option. + +.. opt:: Default Proof Mode @string + + Select the proof mode to use when starting a proof. Depending on the proof + mode, various syntactic constructs are allowed when writing an interactive + proof. All proof modes support vernacular commands; the proof mode determines + which tactic language and set of tactic definitions are available. The + possible option values are: + + `"Classic"` + Activates the |Ltac| language and the tactics with the syntax documented + in this manual. + Some tactics are not available until the associated plugin is loaded, + such as `SSR` or `micromega`. + This proof mode is set when the :term:`prelude` is loaded. + + `"Noedit"` + No tactic + language is activated at all. This is the default when the :term:`prelude` + is not loaded, e.g. through the `-noinit` option for `coqc`. + + `"Ltac2"` + Activates the Ltac2 language and the Ltac2-specific variants of the documented + tactics. + This value is only available after :cmd:`Requiring <Require>` Ltac2. + :cmd:`Importing <Import>` Ltac2 sets this mode. + + Some external plugins also define their own proof mode, which can be + activated with this command. + +Navigation in the proof tree +-------------------------------- + +.. cmd:: Undo {? {? To } @natural } + + Cancels the effect of the last :token:`natural` commands or tactics. + The :n:`To @natural` form goes back to the specified state number. + If :token:`natural` is not specified, the command goes back one command or tactic. + +.. cmd:: Restart + + Restores the proof editing process to the original goal. + + .. exn:: No focused proof to restart. + :undocumented: + +.. cmd:: Focus {? @natural } + + Focuses the attention on the first subgoal to prove or, if :token:`natural` is + specified, the :token:`natural`\-th. The + printing of the other subgoals is suspended until the focused subgoal + is solved or unfocused. + + .. deprecated:: 8.8 + + Prefer the use of bullets or focusing brackets with a goal selector (see below). + +.. cmd:: Unfocus + + This command restores to focus the goal that were suspended by the + last :cmd:`Focus` command. + + .. deprecated:: 8.8 + +.. cmd:: Unfocused + + Succeeds if the proof is fully unfocused, fails if there are some + goals out of focus. + +.. _curly-braces: + +.. index:: { + } + +.. todo: :name: "{"; "}" doesn't work, nor does :name: left curly bracket; right curly bracket, + hence the verbose names + +.. tacn:: {? {| @natural | [ @ident ] } : } %{ + %} + + .. todo + See https://github.com/coq/coq/issues/12004 and + https://github.com/coq/coq/issues/12825. + + ``{`` (without a terminating period) focuses on the first + goal. The subproof can only be + unfocused when it has been fully solved (*i.e.*, when there is no + focused goal left). Unfocusing is then handled by ``}`` (again, without a + terminating period). See also an example in the next section. + + Note that when a focused goal is proved a message is displayed + together with a suggestion about the right bullet or ``}`` to unfocus it + or focus the next one. + + :n:`@natural:` + Focuses on the :token:`natural`\-th subgoal to prove. + + :n:`[ @ident ]: %{` + Focuses on the named goal :token:`ident`. + + .. note:: + + Goals are just existential variables and existential variables do not + get a name by default. You can give a name to a goal by using :n:`refine ?[@ident]`. + You may also wrap this in an Ltac-definition like: + + .. coqtop:: in + + Ltac name_goal name := refine ?[name]. + + .. seealso:: :ref:`existential-variables` + + .. example:: + + This first example uses the Ltac definition above, and the named goals + only serve for documentation. + + .. coqtop:: all + + Goal forall n, n + 0 = n. + Proof. + induction n; [ name_goal base | name_goal step ]. + [base]: { + + .. coqtop:: all + + reflexivity. + + .. coqtop:: in + + } + + .. coqtop:: all + + [step]: { + + .. coqtop:: all + + simpl. + f_equal. + assumption. + } + Qed. + + This can also be a way of focusing on a shelved goal, for instance: + + .. coqtop:: all + + Goal exists n : nat, n = n. + eexists ?[x]. + reflexivity. + [x]: exact 0. + Qed. + + .. exn:: This proof is focused, but cannot be unfocused this way. + + You are trying to use ``}`` but the current subproof has not been fully solved. + + .. exn:: No such goal (@natural). + :undocumented: + + .. exn:: No such goal (@ident). + :undocumented: + + .. exn:: Brackets do not support multi-goal selectors. + + Brackets are used to focus on a single goal given either by its position + or by its name if it has one. + + .. seealso:: The error messages for bullets below. + +.. _bullets: + +Bullets +``````` + +Alternatively, proofs can be structured with bullets instead of ``{`` and ``}``. The +use of a bullet ``b`` for the first time focuses on the first goal ``g``, the +same bullet cannot be used again until the proof of ``g`` is completed, +then it is mandatory to focus the next goal with ``b``. The consequence is +that ``g`` and all goals present when ``g`` was focused are focused with the +same bullet ``b``. See the example below. + +Different bullets can be used to nest levels. The scope of bullet does +not go beyond enclosing ``{`` and ``}``, so bullets can be reused as further +nesting levels provided they are delimited by these. Bullets are made of +repeated ``-``, ``+`` or ``*`` symbols: + +.. prodn:: bullet ::= {| {+ - } | {+ + } | {+ * } } + +Note again that when a focused goal is proved a message is displayed +together with a suggestion about the right bullet or ``}`` to unfocus it +or focus the next one. + +.. note:: + + In Proof General (``Emacs`` interface to |Coq|), you must use + bullets with the priority ordering shown above to have a correct + indentation. For example ``-`` must be the outer bullet and ``**`` the inner + one in the example below. + +The following example script illustrates all these features: + +.. example:: + + .. coqtop:: all + + Goal (((True /\ True) /\ True) /\ True) /\ True. + Proof. + split. + - split. + + split. + ** { split. + - trivial. + - trivial. + } + ** trivial. + + trivial. + - assert True. + { trivial. } + assumption. + Qed. + +.. exn:: Wrong bullet @bullet__1: Current bullet @bullet__2 is not finished. + + Before using bullet :n:`@bullet__1` again, you should first finish proving + the current focused goal. + Note that :n:`@bullet__1` and :n:`@bullet__2` may be the same. + +.. exn:: Wrong bullet @bullet__1: Bullet @bullet__2 is mandatory here. + + You must put :n:`@bullet__2` to focus on the next goal. No other bullet is + allowed here. + +.. exn:: No such goal. Focus next goal with bullet @bullet. + + You tried to apply a tactic but no goals were under focus. + Using :n:`@bullet` is mandatory here. + +.. FIXME: the :noindex: below works around a Sphinx issue. + (https://github.com/sphinx-doc/sphinx/issues/4979) + It should be removed once that issue is fixed. + +.. exn:: No such goal. Try unfocusing with %}. + :noindex: + + You just finished a goal focused by ``{``, you must unfocus it with ``}``. + +Mandatory Bullets +~~~~~~~~~~~~~~~~~ + +Using :opt:`Default Goal Selector` with the ``!`` selector forces +tactic scripts to keep focus to exactly one goal (e.g. using bullets) +or use explicit goal selectors. + +Set Bullet Behavior +~~~~~~~~~~~~~~~~~~~ + +.. opt:: Bullet Behavior {| "None" | "Strict Subproofs" } + :name: Bullet Behavior + + This option controls the bullet behavior and can take two possible values: + + - "None": this makes bullets inactive. + - "Strict Subproofs": this makes bullets active (this is the default behavior). + +Modifying the order of goals +```````````````````````````` + +.. tacn:: cycle @integer + :name: cycle + + Reorders the selected goals so that the first :n:`@integer` goals appear after the + other selected goals. + If :n:`@integer` is negative, it puts the last :n:`@integer` goals at the + beginning of the list. + The tactic is only useful with a goal selector, most commonly `all:`. + Note that other selectors reorder goals; `1,3: cycle 1` is not equivalent + to `all: cycle 1`. See :tacn:`… : … (goal selector)`. + +.. example:: + + .. coqtop:: none reset + + Parameter P : nat -> Prop. + + .. coqtop:: all abort + + Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. + repeat split. + all: cycle 2. + all: cycle -3. + +.. tacn:: swap @integer @integer + :name: swap + + Exchanges the position of the specified goals. + Negative values for :n:`@integer` indicate counting goals + backward from the end of the list of selected goals. Goals are indexed from 1. + The tactic is only useful with a goal selector, most commonly `all:`. + Note that other selectors reorder goals; `1,3: swap 1 3` is not equivalent + to `all: swap 1 3`. See :tacn:`… : … (goal selector)`. + +.. example:: + + .. coqtop:: all abort + + Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. + repeat split. + all: swap 1 3. + all: swap 1 -1. + +.. tacn:: revgoals + :name: revgoals + + Reverses the order of the selected goals. The tactic is only useful with a goal + selector, most commonly `all :`. Note that other selectors reorder goals; + `1,3: revgoals` is not equivalent to `all: revgoals`. See :tacn:`… : … (goal selector)`. + + .. example:: + + .. coqtop:: all abort + + Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. + repeat split. + all: revgoals. + +Postponing the proof of some goals +`````````````````````````````````` + +.. tacn:: shelve + :name: shelve + + This tactic moves all goals under focus to a shelf. While on the + shelf, goals will not be focused on. They can be solved by + unification, or they can be called back into focus with the command + :cmd:`Unshelve`. + + .. tacv:: shelve_unifiable + :name: shelve_unifiable + + Shelves only the goals under focus that are mentioned in other goals. + Goals that appear in the type of other goals can be solved by unification. + + .. example:: + + .. coqtop:: all abort + + Goal exists n, n=0. + refine (ex_intro _ _ _). + all: shelve_unifiable. + reflexivity. + +.. cmd:: Unshelve + + This command moves all the goals on the shelf (see :tacn:`shelve`) + from the shelf into focus, by appending them to the end of the current + list of focused goals. + +.. tacn:: unshelve @tactic + :name: unshelve + + Performs :n:`@tactic`, then unshelves existential variables added to the + shelf by the execution of :n:`@tactic`, prepending them to the current goal. + +.. tacn:: give_up + :name: give_up + + This tactic removes the focused goals from the proof. They are not + solved, and cannot be solved later in the proof. As the goals are not + solved, the proof cannot be closed. + + The ``give_up`` tactic can be used while editing a proof, to choose to + write the proof script in a non-sequential order. + +.. _requestinginformation: + +Requesting information +---------------------- + + +.. cmd:: Show {? {| @ident | @natural } } + + Displays the current goals. + + :n:`@natural` + Display only the :token:`natural`\-th subgoal. + + :n:`@ident` + Displays the named goal :token:`ident`. This is useful in + particular to display a shelved goal but only works if the + corresponding existential variable has been named by the user + (see :ref:`existential-variables`) as in the following example. + + .. example:: + + .. coqtop:: all abort + + Goal exists n, n = 0. + eexists ?[n]. + Show n. + + .. exn:: No focused proof. + :undocumented: + + .. exn:: No such goal. + :undocumented: + +.. cmd:: Show Proof {? Diffs {? removed } } + + Displays the proof term generated by the tactics + that have been applied so far. If the proof is incomplete, the term + will contain holes, which correspond to subterms which are still to be + constructed. Each hole is an existential variable, which appears as a + question mark followed by an identifier. + + Specifying “Diffs” highlights the difference between the + current and previous proof step. By default, the command shows the + output once with additions highlighted. Including “removed” shows + the output twice: once showing removals and once showing additions. + It does not examine the :opt:`Diffs` option. See :ref:`showing_proof_diffs`. + +.. cmd:: Show Conjectures + + Prints the names of all the + theorems that are currently being proved. As it is possible to start + proving a previous lemma during the proof of a theorem, there may + be multiple names. + +.. cmd:: Show Intro + + If the current goal begins by at least one product, + prints the name of the first product as it would be + generated by an anonymous :tacn:`intro`. The aim of this command is to ease + the writing of more robust scripts. For example, with an appropriate + Proof General macro, it is possible to transform any anonymous :tacn:`intro` + into a qualified one such as ``intro y13``. In the case of a non-product + goal, it prints nothing. + +.. cmd:: Show Intros + + Similar to the previous command. + Simulates the naming process of :tacn:`intros`. + +.. cmd:: Show Existentials + + Displays all open goals / existential variables in the current proof + along with the type and the context of each variable. + +.. cmd:: Show Match @qualid + + Displays a template of the Gallina :token:`match<term_match>` + construct with a branch for each constructor of the type + :token:`qualid`. This is used internally by + `company-coq <https://github.com/cpitclaudel/company-coq>`_. + + .. example:: + + .. coqtop:: all + + Show Match nat. + + .. exn:: Unknown inductive type. + :undocumented: + +.. cmd:: Show Universes + + Displays the set of all universe constraints and + its normalized form at the current stage of the proof, useful for + debugging universe inconsistencies. + +.. cmd:: Show Goal @natural at @natural + + Available in coqtop. Displays a goal at a + proof state using the goal ID number and the proof state ID number. + It is primarily for use by tools such as Prooftree that need to fetch + goal history in this way. Prooftree is a tool for visualizing a proof + as a tree that runs in Proof General. + +.. cmd:: Guarded + + Some tactics (e.g. :tacn:`refine`) allow to build proofs using + fixpoint or co-fixpoint constructions. Due to the incremental nature + of interactive proof construction, the check of the termination (or + guardedness) of the recursive calls in the fixpoint or cofixpoint + constructions is postponed to the time of the completion of the proof. + + The command :cmd:`Guarded` allows checking if the guard condition for + fixpoint and cofixpoint is violated at some time of the construction + of the proof without having to wait the completion of the proof. + +.. _showing_diffs: + +Showing differences between proof steps +--------------------------------------- + +|Coq| can automatically highlight the differences between successive proof steps +and between values in some error messages. |Coq| can also highlight differences +in the proof term. +For example, the following screenshots of |CoqIDE| and coqtop show the application +of the same :tacn:`intros` tactic. The tactic creates two new hypotheses, highlighted in green. +The conclusion is entirely in pale green because although it’s changed, no tokens were added +to it. The second screenshot uses the "removed" option, so it shows the conclusion a +second time with the old text, with deletions marked in red. Also, since the hypotheses are +new, no line of old text is shown for them. + +.. comment screenshot produced with: + Inductive ev : nat -> Prop := + | ev_0 : ev 0 + | ev_SS : forall n : nat, ev n -> ev (S (S n)). + + Fixpoint double (n:nat) := + match n with + | O => O + | S n' => S (S (double n')) + end. + + Goal forall n, ev n -> exists k, n = double k. + intros n E. + +.. + + .. image:: ../../_static/diffs-coqide-on.png + :alt: |CoqIDE| with Set Diffs on + +.. + + .. image:: ../../_static/diffs-coqide-removed.png + :alt: |CoqIDE| with Set Diffs removed + +.. + + .. image:: ../../_static/diffs-coqtop-on3.png + :alt: coqtop with Set Diffs on + +This image shows an error message with diff highlighting in |CoqIDE|: + +.. + + .. image:: ../../_static/diffs-error-message.png + :alt: |CoqIDE| error message with diffs + +How to enable diffs +``````````````````` + +.. opt:: Diffs {| "on" | "off" | "removed" } + :name: Diffs + + The “on” setting highlights added tokens in green, while the “removed” setting + additionally reprints items with removed tokens in red. Unchanged tokens in + modified items are shown with pale green or red. Diffs in error messages + use red and green for the compared values; they appear regardless of the setting. + (Colors are user-configurable.) + +For coqtop, showing diffs can be enabled when starting coqtop with the +``-diffs on|off|removed`` command-line option or by setting the :opt:`Diffs` option +within |Coq|. You will need to provide the ``-color on|auto`` command-line option when +you start coqtop in either case. + +Colors for coqtop can be configured by setting the ``COQ_COLORS`` environment +variable. See section :ref:`customization-by-environment-variables`. Diffs +use the tags ``diff.added``, ``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg``. + +In |CoqIDE|, diffs should be enabled from the ``View`` menu. Don’t use the ``Set Diffs`` +command in |CoqIDE|. You can change the background colors shown for diffs from the +``Edit | Preferences | Tags`` panel by changing the settings for the ``diff.added``, +``diff.added.bg``, ``diff.removed`` and ``diff.removed.bg`` tags. This panel also +lets you control other attributes of the highlights, such as the foreground +color, bold, italic, underline and strikeout. + +Proof General can also display |Coq|-generated proof diffs automatically. +Please see the PG documentation section +"`Showing Proof Diffs" <https://proofgeneral.github.io/doc/master/userman/Coq-Proof-General#Showing-Proof-Diffs>`_) +for details. + +How diffs are calculated +```````````````````````` + +Diffs are calculated as follows: + +1. Select the old proof state to compare to, which is the proof state before + the last tactic that changed the proof. Changes that only affect the view + of the proof, such as ``all: swap 1 2``, are ignored. + +2. For each goal in the new proof state, determine what old goal to compare + it to—the one it is derived from or is the same as. Match the hypotheses by + name (order is ignored), handling compacted items specially. + +3. For each hypothesis and conclusion (the “items”) in each goal, pass + them as strings to the lexer to break them into tokens. Then apply the + Myers diff algorithm :cite:`Myers` on the tokens and add appropriate highlighting. + +Notes: + +* Aside from the highlights, output for the "on" option should be identical + to the undiffed output. +* Goals completed in the last proof step will not be shown even with the + "removed" setting. + +.. comment The following screenshots show diffs working with multiple goals and with compacted + hypotheses. In the first one, notice that the goal ``P 1`` is not highlighted at + all after the split because it has not changed. + + .. todo: Use this script and remove the screenshots when COQ_COLORS + works for coqtop in sphinx + .. coqtop:: none + + Set Diffs "on". + Parameter P : nat -> Prop. + Goal P 1 /\ P 2 /\ P 3. + + .. coqtop:: out + + split. + + .. coqtop:: all abort + + 2: split. + + .. + + .. coqtop:: none + + Set Diffs "on". + Goal forall n m : nat, n + m = m + n. + Set Diffs "on". + + .. coqtop:: out + + intros n. + + .. coqtop:: all abort + + intros m. + +This screen shot shows the result of applying a :tacn:`split` tactic that replaces one goal +with 2 goals. Notice that the goal ``P 1`` is not highlighted at all after +the split because it has not changed. + +.. + + .. image:: ../../_static/diffs-coqide-multigoal.png + :alt: coqide with Set Diffs on with multiple goals + +Diffs may appear like this after applying a :tacn:`intro` tactic that results +in a compacted hypotheses: + +.. + + .. image:: ../../_static/diffs-coqide-compacted.png + :alt: coqide with Set Diffs on with compacted hypotheses + +.. _showing_proof_diffs: + +"Show Proof" differences +```````````````````````` + +To show differences in the proof term: + +- In coqtop and Proof General, use the :cmd:`Show Proof` `Diffs` command. + +- In |CoqIDE|, position the cursor on or just after a tactic to compare the proof term + after the tactic with the proof term before the tactic, then select + `View / Show Proof` from the menu or enter the associated key binding. + Differences will be shown applying the current `Show Diffs` setting + from the `View` menu. If the current setting is `Don't show diffs`, diffs + will not be shown. + + Output with the "added and removed" option looks like this: + + .. + + .. image:: ../../_static/diffs-show-proof.png + :alt: coqide with Set Diffs on with compacted hypotheses + +Controlling the effect of proof editing commands +------------------------------------------------ + + +.. opt:: Hyps Limit @natural + :name: Hyps Limit + + This option controls the maximum number of hypotheses displayed in goals + after the application of a tactic. All the hypotheses remain usable + in the proof development. + When unset, it goes back to the default mode which is to print all + available hypotheses. + + +.. flag:: Nested Proofs Allowed + + When turned on (it is off by default), this flag enables support for nested + proofs: a new assertion command can be inserted before the current proof is + finished, in which case |Coq| will temporarily switch to the proof of this + *nested lemma*. When the proof of the nested lemma is finished (with :cmd:`Qed` + or :cmd:`Defined`), its statement will be made available (as if it had been + proved before starting the previous proof) and |Coq| will switch back to the + proof of the previous assertion. + +.. flag:: Printing Goal Names + + When turned on, the name of the goal is printed in interactive + proof mode, which can be useful in cases of cross references + between goals. + +Controlling memory usage +------------------------ + +.. cmd:: Print Debug GC + + Prints heap usage statistics, which are values from the `stat` type of the `Gc` module + described + `here <https://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#TYPEstat>`_ + in the |OCaml| documentation. + The `live_words`, `heap_words` and `top_heap_words` values give the basic information. + Words are 8 bytes or 4 bytes, respectively, for 64- and 32-bit executables. + +When experiencing high memory usage the following commands can be used +to force |Coq| to optimize some of its internal data structures. + +.. cmd:: Optimize Proof + + Shrink the data structure used to represent the current proof. + + +.. cmd:: Optimize Heap + + Perform a heap compaction. This is generally an expensive operation. + See: `|OCaml| Gc.compact <http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact>`_ + There is also an analogous tactic :tacn:`optimize_heap`. + +Memory usage parameters can be set through the :ref:`OCAMLRUNPARAM <OCAMLRUNPARAM>` +environment variable. diff --git a/doc/sphinx/proofs/writing-proofs/rewriting.rst b/doc/sphinx/proofs/writing-proofs/rewriting.rst new file mode 100644 index 0000000000..1358aad432 --- /dev/null +++ b/doc/sphinx/proofs/writing-proofs/rewriting.rst @@ -0,0 +1,857 @@ +================================= +Term rewriting and simplification +================================= + +.. _rewritingexpressions: + +Rewriting expressions +--------------------- + +These tactics use the equality :g:`eq:forall A:Type, A->A->Prop` defined in +file ``Logic.v`` (see :ref:`coq-library-logic`). The notation for :g:`eq T t u` is +simply :g:`t=u` dropping the implicit type of :g:`t` and :g:`u`. + +.. tacn:: rewrite @term + :name: rewrite + + This tactic applies to any goal. The type of :token:`term` must have the form + + ``forall (x``:sub:`1` ``:A``:sub:`1` ``) ... (x``:sub:`n` ``:A``:sub:`n` ``), eq term``:sub:`1` ``term``:sub:`2` ``.`` + + where :g:`eq` is the Leibniz equality or a registered setoid equality. + + Then :n:`rewrite @term` finds the first subterm matching `term`\ :sub:`1` in the goal, + resulting in instances `term`:sub:`1`' and `term`:sub:`2`' and then + replaces every occurrence of `term`:subscript:`1`' by `term`:subscript:`2`'. + Hence, some of the variables :g:`x`\ :sub:`i` are solved by unification, + and some of the types :g:`A`\ :sub:`1`:g:`, ..., A`\ :sub:`n` become new + subgoals. + + .. exn:: The @term provided does not end with an equation. + :undocumented: + + .. exn:: Tactic generated a subgoal identical to the original goal. This happens if @term does not occur in the goal. + :undocumented: + + .. tacv:: rewrite -> @term + + Is equivalent to :n:`rewrite @term` + + .. tacv:: rewrite <- @term + + Uses the equality :n:`@term`:sub:`1` :n:`= @term` :sub:`2` from right to left + + .. tacv:: rewrite @term in @goal_occurrences + + Analogous to :n:`rewrite @term` but rewriting is done following + the clause :token:`goal_occurrences`. For instance: + + + :n:`rewrite H in H'` will rewrite `H` in the hypothesis + ``H'`` instead of the current goal. + + :n:`rewrite H in H' at 1, H'' at - 2 |- *` means + :n:`rewrite H; rewrite H in H' at 1; rewrite H in H'' at - 2.` + In particular a failure will happen if any of these three simpler tactics + fails. + + :n:`rewrite H in * |-` will do :n:`rewrite H in H'` for all hypotheses + :g:`H'` different from :g:`H`. + A success will happen as soon as at least one of these simpler tactics succeeds. + + :n:`rewrite H in *` is a combination of :n:`rewrite H` and :n:`rewrite H in * |-` + that succeeds if at least one of these two tactics succeeds. + + Orientation :g:`->` or :g:`<-` can be inserted before the :token:`term` to rewrite. + + .. tacv:: rewrite @term at @occurrences + + Rewrite only the given :token:`occurrences` of :token:`term`. Occurrences are + specified from left to right as for pattern (:tacn:`pattern`). The rewrite is + always performed using setoid rewriting, even for Leibniz’s equality, so one + has to ``Import Setoid`` to use this variant. + + .. tacv:: rewrite @term by @tactic + + Use tactic to completely solve the side-conditions arising from the + :tacn:`rewrite`. + + .. tacv:: rewrite {+, @orientation @term} {? in @ident } + + Is equivalent to the `n` successive tactics :n:`{+; rewrite @term}`, each one + working on the first subgoal generated by the previous one. An :production:`orientation` + ``->`` or ``<-`` can be inserted before each :token:`term` to rewrite. One + unique clause can be added at the end after the keyword in; it will then + affect all rewrite operations. + + In all forms of rewrite described above, a :token:`term` to rewrite can be + immediately prefixed by one of the following modifiers: + + + `?` : the tactic :n:`rewrite ?@term` performs the rewrite of :token:`term` as many + times as possible (perhaps zero time). This form never fails. + + :n:`@natural?` : works similarly, except that it will do at most :token:`natural` rewrites. + + `!` : works as `?`, except that at least one rewrite should succeed, otherwise + the tactic fails. + + :n:`@natural!` (or simply :n:`@natural`) : precisely :token:`natural` rewrites of :token:`term` will be done, + leading to failure if these :token:`natural` rewrites are not possible. + + .. tacv:: erewrite @term + :name: erewrite + + This tactic works as :n:`rewrite @term` but turning + unresolved bindings into existential variables, if any, instead of + failing. It has the same variants as :tacn:`rewrite` has. + + .. flag:: Keyed Unification + + Makes higher-order unification used by :tacn:`rewrite` rely on a set of keys to drive + unification. The subterms, considered as rewriting candidates, must start with + the same key as the left- or right-hand side of the lemma given to rewrite, and the arguments + are then unified up to full reduction. + +.. tacn:: replace @term with @term’ + :name: replace + + This tactic applies to any goal. It replaces all free occurrences of :n:`@term` + in the current goal with :n:`@term’` and generates an equality :n:`@term = @term’` + as a subgoal. This equality is automatically solved if it occurs among + the assumptions, or if its symmetric form occurs. It is equivalent to + :n:`cut @term = @term’; [intro H`:sub:`n` :n:`; rewrite <- H`:sub:`n` :n:`; clear H`:sub:`n`:n:`|| assumption || symmetry; try assumption]`. + + .. exn:: Terms do not have convertible types. + :undocumented: + + .. tacv:: replace @term with @term’ by @tactic + + This acts as :n:`replace @term with @term’` but applies :token:`tactic` to solve the generated + subgoal :n:`@term = @term’`. + + .. tacv:: replace @term + + Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has + the form :n:`@term = @term’` or :n:`@term’ = @term`. + + .. tacv:: replace -> @term + + Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has + the form :n:`@term = @term’` + + .. tacv:: replace <- @term + + Replaces :n:`@term` with :n:`@term’` using the first assumption whose type has + the form :n:`@term’ = @term` + + .. tacv:: replace @term {? with @term} in @goal_occurrences {? by @tactic} + replace -> @term in @goal_occurrences + replace <- @term in @goal_occurrences + + Acts as before but the replacements take place in the specified clauses + (:token:`goal_occurrences`) (see :ref:`performingcomputations`) and not + only in the conclusion of the goal. The clause argument must not contain + any ``type of`` nor ``value of``. + +.. tacn:: subst @ident + :name: subst + + This tactic applies to a goal that has :n:`@ident` in its context and (at + least) one hypothesis, say :g:`H`, of type :n:`@ident = t` or :n:`t = @ident` + with :n:`@ident` not occurring in :g:`t`. Then it replaces :n:`@ident` by + :g:`t` everywhere in the goal (in the hypotheses and in the conclusion) and + clears :n:`@ident` and :g:`H` from the context. + + If :n:`@ident` is a local definition of the form :n:`@ident := t`, it is also + unfolded and cleared. + + If :n:`@ident` is a section variable it is expected to have no + indirect occurrences in the goal, i.e. that no global declarations + implicitly depending on the section variable must be present in the + goal. + + .. note:: + + When several hypotheses have the form :n:`@ident = t` or :n:`t = @ident`, the + first one is used. + + + If :g:`H` is itself dependent in the goal, it is replaced by the proof of + reflexivity of equality. + + .. tacv:: subst {+ @ident} + + This is equivalent to :n:`subst @ident`:sub:`1`:n:`; ...; subst @ident`:sub:`n`. + + .. tacv:: subst + + This applies :tacn:`subst` repeatedly from top to bottom to all hypotheses of the + context for which an equality of the form :n:`@ident = t` or :n:`t = @ident` + or :n:`@ident := t` exists, with :n:`@ident` not occurring in + ``t`` and :n:`@ident` not a section variable with indirect + dependencies in the goal. + + .. flag:: Regular Subst Tactic + + This flag controls the behavior of :tacn:`subst`. When it is + activated (it is by default), :tacn:`subst` also deals with the following corner cases: + + + A context with ordered hypotheses :n:`@ident`:sub:`1` :n:`= @ident`:sub:`2` + and :n:`@ident`:sub:`1` :n:`= t`, or :n:`t′ = @ident`:sub:`1`` with `t′` not + a variable, and no other hypotheses of the form :n:`@ident`:sub:`2` :n:`= u` + or :n:`u = @ident`:sub:`2`; without the flag, a second call to + subst would be necessary to replace :n:`@ident`:sub:`2` by `t` or + `t′` respectively. + + The presence of a recursive equation which without the flag would + be a cause of failure of :tacn:`subst`. + + A context with cyclic dependencies as with hypotheses :n:`@ident`:sub:`1` :n:`= f @ident`:sub:`2` + and :n:`@ident`:sub:`2` :n:`= g @ident`:sub:`1` which without the + flag would be a cause of failure of :tacn:`subst`. + + Additionally, it prevents a local definition such as :n:`@ident := t` to be + unfolded which otherwise it would exceptionally unfold in configurations + containing hypotheses of the form :n:`@ident = u`, or :n:`u′ = @ident` + with `u′` not a variable. Finally, it preserves the initial order of + hypotheses, which without the flag it may break. + default. + + .. exn:: Cannot find any non-recursive equality over :n:`@ident`. + :undocumented: + + .. exn:: Section variable :n:`@ident` occurs implicitly in global declaration :n:`@qualid` present in hypothesis :n:`@ident`. + Section variable :n:`@ident` occurs implicitly in global declaration :n:`@qualid` present in the conclusion. + + Raised when the variable is a section variable with indirect + dependencies in the goal. + + +.. tacn:: stepl @term + :name: stepl + + This tactic is for chaining rewriting steps. It assumes a goal of the + form :n:`R @term @term` where ``R`` is a binary relation and relies on a + database of lemmas of the form :g:`forall x y z, R x y -> eq x z -> R z y` + where `eq` is typically a setoid equality. The application of :n:`stepl @term` + then replaces the goal by :n:`R @term @term` and adds a new goal stating + :n:`eq @term @term`. + + .. cmd:: Declare Left Step @term + + Adds :n:`@term` to the database used by :tacn:`stepl`. + + This tactic is especially useful for parametric setoids which are not accepted + as regular setoids for :tacn:`rewrite` and :tacn:`setoid_replace` (see + :ref:`Generalizedrewriting`). + + .. tacv:: stepl @term by @tactic + + This applies :n:`stepl @term` then applies :token:`tactic` to the second goal. + + .. tacv:: stepr @term by @tactic + :name: stepr + + This behaves as :tacn:`stepl` but on the right-hand-side of the binary + relation. Lemmas are expected to be of the form + :g:`forall x y z, R x y -> eq y z -> R x z`. + + .. cmd:: Declare Right Step @term + + Adds :n:`@term` to the database used by :tacn:`stepr`. + + +.. tacn:: change @term + :name: change + + This tactic applies to any goal. It implements the rule ``Conv`` given in + :ref:`subtyping-rules`. :g:`change U` replaces the current goal `T` + with `U` providing that `U` is well-formed and that `T` and `U` are + convertible. + + .. exn:: Not convertible. + :undocumented: + + .. tacv:: change @term with @term’ + + This replaces the occurrences of :n:`@term` by :n:`@term’` in the current goal. + The term :n:`@term` and :n:`@term’` must be convertible. + + .. tacv:: change @term at {+ @natural} with @term’ + + This replaces the occurrences numbered :n:`{+ @natural}` of :n:`@term` by :n:`@term’` + in the current goal. The terms :n:`@term` and :n:`@term’` must be convertible. + + .. exn:: Too few occurrences. + :undocumented: + + .. tacv:: change @term {? {? at {+ @natural}} with @term} in @ident + + This applies the :tacn:`change` tactic not to the goal but to the hypothesis :n:`@ident`. + + .. tacv:: now_show @term + + This is a synonym of :n:`change @term`. It can be used to + make some proof steps explicit when refactoring a proof script + to make it readable. + + .. seealso:: :ref:`Performing computations <performingcomputations>` + +.. _performingcomputations: + +Performing computations +--------------------------- + +.. insertprodn red_expr pattern_occ + +.. prodn:: + red_expr ::= red + | hnf + | simpl {? @delta_flag } {? @ref_or_pattern_occ } + | cbv {? @strategy_flag } + | cbn {? @strategy_flag } + | lazy {? @strategy_flag } + | compute {? @delta_flag } + | vm_compute {? @ref_or_pattern_occ } + | native_compute {? @ref_or_pattern_occ } + | unfold {+, @unfold_occ } + | fold {+ @one_term } + | pattern {+, @pattern_occ } + | @ident + delta_flag ::= {? - } [ {+ @reference } ] + strategy_flag ::= {+ @red_flag } + | @delta_flag + red_flag ::= beta + | iota + | match + | fix + | cofix + | zeta + | delta {? @delta_flag } + ref_or_pattern_occ ::= @reference {? at @occs_nums } + | @one_term {? at @occs_nums } + occs_nums ::= {+ {| @natural | @ident } } + | - {| @natural | @ident } {* @int_or_var } + int_or_var ::= @integer + | @ident + unfold_occ ::= @reference {? at @occs_nums } + pattern_occ ::= @one_term {? at @occs_nums } + +This set of tactics implements different specialized usages of the +tactic :tacn:`change`. + +All conversion tactics (including :tacn:`change`) can be parameterized by the +parts of the goal where the conversion can occur. This is done using +*goal clauses* which consists in a list of hypotheses and, optionally, +of a reference to the conclusion of the goal. For defined hypothesis +it is possible to specify if the conversion should occur on the type +part, the body part or both (default). + +Goal clauses are written after a conversion tactic (tactics :tacn:`set`, +:tacn:`rewrite`, :tacn:`replace` and :tacn:`autorewrite` also use goal +clauses) and are introduced by the keyword `in`. If no goal clause is +provided, the default is to perform the conversion only in the +conclusion. + +The syntax and description of the various goal clauses is the +following: + ++ :n:`in {+ @ident} |-` only in hypotheses :n:`{+ @ident}` ++ :n:`in {+ @ident} |- *` in hypotheses :n:`{+ @ident}` and in the + conclusion ++ :n:`in * |-` in every hypothesis ++ :n:`in *` (equivalent to in :n:`* |- *`) everywhere ++ :n:`in (type of @ident) (value of @ident) ... |-` in type part of + :n:`@ident`, in the value part of :n:`@ident`, etc. + +For backward compatibility, the notation :n:`in {+ @ident}` performs +the conversion in hypotheses :n:`{+ @ident}`. + +.. tacn:: cbv {? @strategy_flag } + lazy {? @strategy_flag } + :name: cbv; lazy + + These parameterized reduction tactics apply to any goal and perform + the normalization of the goal according to the specified flags. In + correspondence with the kinds of reduction considered in |Coq| namely + :math:`\beta` (reduction of functional application), :math:`\delta` + (unfolding of transparent constants, see :ref:`vernac-controlling-the-reduction-strategies`), + :math:`\iota` (reduction of + pattern matching over a constructed term, and unfolding of :g:`fix` and + :g:`cofix` expressions) and :math:`\zeta` (contraction of local definitions), the + flags are either ``beta``, ``delta``, ``match``, ``fix``, ``cofix``, + ``iota`` or ``zeta``. The ``iota`` flag is a shorthand for ``match``, ``fix`` + and ``cofix``. The ``delta`` flag itself can be refined into + :n:`delta [ {+ @qualid} ]` or :n:`delta - [ {+ @qualid} ]`, restricting in the first + case the constants to unfold to the constants listed, and restricting in the + second case the constant to unfold to all but the ones explicitly mentioned. + Notice that the ``delta`` flag does not apply to variables bound by a let-in + construction inside the :n:`@term` itself (use here the ``zeta`` flag). In + any cases, opaque constants are not unfolded (see :ref:`vernac-controlling-the-reduction-strategies`). + + Normalization according to the flags is done by first evaluating the + head of the expression into a *weak-head* normal form, i.e. until the + evaluation is blocked by a variable (or an opaque constant, or an + axiom), as e.g. in :g:`x u1 ... un` , or :g:`match x with ... end`, or + :g:`(fix f x {struct x} := ...) x`, or is a constructed form (a + :math:`\lambda`-expression, a constructor, a cofixpoint, an inductive type, a + product type, a sort), or is a redex that the flags prevent to reduce. Once a + weak-head normal form is obtained, subterms are recursively reduced using the + same strategy. + + Reduction to weak-head normal form can be done using two strategies: + *lazy* (``lazy`` tactic), or *call-by-value* (``cbv`` tactic). The lazy + strategy is a call-by-need strategy, with sharing of reductions: the + arguments of a function call are weakly evaluated only when necessary, + and if an argument is used several times then it is weakly computed + only once. This reduction is efficient for reducing expressions with + dead code. For instance, the proofs of a proposition :g:`exists x. P(x)` + reduce to a pair of a witness :g:`t`, and a proof that :g:`t` satisfies the + predicate :g:`P`. Most of the time, :g:`t` may be computed without computing + the proof of :g:`P(t)`, thanks to the lazy strategy. + + The call-by-value strategy is the one used in ML languages: the + arguments of a function call are systematically weakly evaluated + first. Despite the lazy strategy always performs fewer reductions than + the call-by-value strategy, the latter is generally more efficient for + evaluating purely computational expressions (i.e. with little dead code). + +.. tacv:: compute + cbv + :name: compute; _ + + These are synonyms for ``cbv beta delta iota zeta``. + +.. tacv:: lazy + + This is a synonym for ``lazy beta delta iota zeta``. + +.. tacv:: compute [ {+ @qualid} ] + cbv [ {+ @qualid} ] + + These are synonyms of :n:`cbv beta delta {+ @qualid} iota zeta`. + +.. tacv:: compute - [ {+ @qualid} ] + cbv - [ {+ @qualid} ] + + These are synonyms of :n:`cbv beta delta -{+ @qualid} iota zeta`. + +.. tacv:: lazy [ {+ @qualid} ] + lazy - [ {+ @qualid} ] + + These are respectively synonyms of :n:`lazy beta delta {+ @qualid} iota zeta` + and :n:`lazy beta delta -{+ @qualid} iota zeta`. + +.. tacv:: vm_compute + :name: vm_compute + + This tactic evaluates the goal using the optimized call-by-value evaluation + bytecode-based virtual machine described in :cite:`CompiledStrongReduction`. + This algorithm is dramatically more efficient than the algorithm used for the + :tacn:`cbv` tactic, but it cannot be fine-tuned. It is especially interesting for + full evaluation of algebraic objects. This includes the case of + reflection-based tactics. + +.. tacv:: native_compute + :name: native_compute + + This tactic evaluates the goal by compilation to |OCaml| as described + in :cite:`FullReduction`. If |Coq| is running in native code, it can be + typically two to five times faster than :tacn:`vm_compute`. Note however that the + compilation cost is higher, so it is worth using only for intensive + computations. + + .. flag:: NativeCompute Timing + + This flag causes all calls to the native compiler to print + timing information for the conversion to native code, + compilation, execution, and reification phases of native + compilation. Timing is printed in units of seconds of + wall-clock time. + + .. flag:: NativeCompute Profiling + + On Linux, if you have the ``perf`` profiler installed, this flag makes + it possible to profile :tacn:`native_compute` evaluations. + + .. opt:: NativeCompute Profile Filename @string + :name: NativeCompute Profile Filename + + This option specifies the profile output; the default is + ``native_compute_profile.data``. The actual filename used + will contain extra characters to avoid overwriting an existing file; that + filename is reported to the user. + That means you can individually profile multiple uses of + :tacn:`native_compute` in a script. From the Linux command line, run ``perf report`` + on the profile file to see the results. Consult the ``perf`` documentation + for more details. + +.. flag:: Debug Cbv + + This flag makes :tacn:`cbv` (and its derivative :tacn:`compute`) print + information about the constants it encounters and the unfolding decisions it + makes. + +.. tacn:: red + :name: red + + This tactic applies to a goal that has the form:: + + forall (x:T1) ... (xk:Tk), T + + with :g:`T` :math:`\beta`:math:`\iota`:math:`\zeta`-reducing to :g:`c t`:sub:`1` :g:`... t`:sub:`n` and :g:`c` a + constant. If :g:`c` is transparent then it replaces :g:`c` with its + definition (say :g:`t`) and then reduces + :g:`(t t`:sub:`1` :g:`... t`:sub:`n` :g:`)` according to :math:`\beta`:math:`\iota`:math:`\zeta`-reduction rules. + +.. exn:: Not reducible. + :undocumented: + +.. exn:: No head constant to reduce. + :undocumented: + +.. tacn:: hnf + :name: hnf + + This tactic applies to any goal. It replaces the current goal with its + 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`. + +.. note:: + The :math:`\delta` rule only applies to transparent constants (see :ref:`vernac-controlling-the-reduction-strategies` + on transparency and opacity). + +.. tacn:: cbn + simpl + :name: cbn; simpl + + These tactics apply to any goal. They try to reduce a term to + something still readable instead of fully normalizing it. They perform + a sort of strong normalization with two key differences: + + + They unfold a constant if and only if it leads to a :math:`\iota`-reduction, + i.e. reducing a match or unfolding a fixpoint. + + While reducing a constant unfolding to (co)fixpoints, the tactics + use the name of the constant the (co)fixpoint comes from instead of + the (co)fixpoint definition in recursive calls. + + The :tacn:`cbn` tactic is claimed to be a more principled, faster and more + predictable replacement for :tacn:`simpl`. + + 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 :cmd:`Arguments` command. + + .. 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 + constant defined by :g:`plus' := plus` is possibly unfolded and reused in + the recursive calls, but a constant such as :g:`succ := plus (S O)` is + never unfolded. This is the main difference between :tacn:`simpl` and :tacn:`cbn`. + The tactic :tacn:`cbn` reduces whenever it will be able to reuse it or not: + :g:`succ t` is reduced to :g:`S t`. + +.. tacv:: cbn [ {+ @qualid} ] + cbn - [ {+ @qualid} ] + + These are respectively synonyms of :n:`cbn beta delta [ {+ @qualid} ] iota zeta` + and :n:`cbn beta delta - [ {+ @qualid} ] iota zeta` (see :tacn:`cbn`). + +.. tacv:: simpl @pattern + + This applies :tacn:`simpl` only to the subterms matching + :n:`@pattern` in the current goal. + +.. tacv:: simpl @pattern at {+ @natural} + + This applies :tacn:`simpl` only to the :n:`{+ @natural}` occurrences of the subterms + matching :n:`@pattern` in the current goal. + + .. exn:: Too few occurrences. + :undocumented: + +.. tacv:: simpl @qualid + simpl @string + + This applies :tacn:`simpl` only to the applicative subterms whose head occurrence + is the unfoldable constant :n:`@qualid` (the constant can be referred to by + its notation using :n:`@string` if such a notation exists). + +.. tacv:: simpl @qualid at {+ @natural} + simpl @string at {+ @natural} + + This applies :tacn:`simpl` only to the :n:`{+ @natural}` applicative subterms whose + head occurrence is :n:`@qualid` (or :n:`@string`). + +.. flag:: Debug RAKAM + + This flag makes :tacn:`cbn` print various debugging information. + ``RAKAM`` is the Refolding Algebraic Krivine Abstract Machine. + +.. tacn:: unfold @qualid + :name: unfold + + This tactic applies to any goal. The argument qualid must denote a + defined transparent constant or local definition (see + :ref:`gallina-definitions` and + :ref:`vernac-controlling-the-reduction-strategies`). The tactic + :tacn:`unfold` applies the :math:`\delta` rule to each occurrence + of the constant to which :n:`@qualid` refers in the current goal + and then replaces it with its :math:`\beta\iota\zeta`-normal form. + Use the general reduction tactics if you want to avoid this final + reduction, for instance :n:`cbv delta [@qualid]`. + + .. exn:: Cannot coerce @qualid to an evaluable reference. + + This error is frequent when trying to unfold something that has + defined as an inductive type (or constructor) and not as a + definition. + + .. example:: + + .. coqtop:: abort all fail + + Goal 0 <= 1. + unfold le. + + This error can also be raised if you are trying to unfold + something that has been marked as opaque. + + .. example:: + + .. coqtop:: abort all fail + + Opaque Nat.add. + Goal 1 + 0 = 1. + unfold Nat.add. + + .. tacv:: unfold @qualid in @goal_occurrences + + Replaces :n:`@qualid` in hypothesis (or hypotheses) designated + by :token:`goal_occurrences` with its definition and replaces + the hypothesis with its :math:`\beta`:math:`\iota` normal form. + + .. tacv:: unfold {+, @qualid} + + Replaces :n:`{+, @qualid}` with their definitions and replaces + the current goal with its :math:`\beta`:math:`\iota` normal + form. + + .. tacv:: unfold {+, @qualid at @occurrences } + + The list :token:`occurrences` specify the occurrences of + :n:`@qualid` to be unfolded. Occurrences are located from left + to right. + + .. exn:: Bad occurrence number of @qualid. + :undocumented: + + .. exn:: @qualid does not occur. + :undocumented: + + .. tacv:: unfold @string + + If :n:`@string` denotes the discriminating symbol of a notation + (e.g. "+") or an expression defining a notation (e.g. `"_ + + _"`), and this notation denotes an application whose head symbol + is an unfoldable constant, then the tactic unfolds it. + + .. tacv:: unfold @string%@ident + + This is variant of :n:`unfold @string` where :n:`@string` gets + its interpretation from the scope bound to the delimiting key + :token:`ident` instead of its default interpretation (see + :ref:`Localinterpretationrulesfornotations`). + + .. tacv:: unfold {+, {| @qualid | @string{? %@ident } } {? at @occurrences } } {? in @goal_occurrences } + + This is the most general form. + +.. tacn:: fold @term + :name: fold + + This tactic applies to any goal. The term :n:`@term` is reduced using the + :tacn:`red` tactic. Every occurrence of the resulting :n:`@term` in the goal is + then replaced by :n:`@term`. This tactic is particularly useful when a fixpoint + definition has been wrongfully unfolded, making the goal very hard to read. + On the other hand, when an unfolded function applied to its argument has been + reduced, the :tacn:`fold` tactic won't do anything. + + .. example:: + + .. coqtop:: all abort + + Goal ~0=0. + unfold not. + Fail progress fold not. + pattern (0 = 0). + fold not. + + .. tacv:: fold {+ @term} + + Equivalent to :n:`fold @term ; ... ; fold @term`. + +.. tacn:: pattern @term + :name: pattern + + This command applies to any goal. The argument :n:`@term` must be a free + subterm of the current goal. The command pattern performs :math:`\beta`-expansion + (the inverse of :math:`\beta`-reduction) of the current goal (say :g:`T`) by + + + replacing all occurrences of :n:`@term` in :g:`T` with a fresh variable + + abstracting this variable + + applying the abstracted goal to :n:`@term` + + For instance, if the current goal :g:`T` is expressible as + :math:`\varphi`:g:`(t)` where the notation captures all the instances of :g:`t` + in :math:`\varphi`:g:`(t)`, then :n:`pattern t` transforms it into + :g:`(fun x:A =>` :math:`\varphi`:g:`(x)) t`. This tactic can be used, for + instance, when the tactic ``apply`` fails on matching. + +.. tacv:: pattern @term at {+ @natural} + + Only the occurrences :n:`{+ @natural}` of :n:`@term` are considered for + :math:`\beta`-expansion. Occurrences are located from left to right. + +.. tacv:: pattern @term at - {+ @natural} + + All occurrences except the occurrences of indexes :n:`{+ @natural }` + of :n:`@term` are considered for :math:`\beta`-expansion. Occurrences are located from + left to right. + +.. tacv:: pattern {+, @term} + + Starting from a goal :math:`\varphi`:g:`(t`:sub:`1` :g:`... t`:sub:`m`:g:`)`, + the tactic :n:`pattern t`:sub:`1`:n:`, ..., t`:sub:`m` generates the + equivalent goal + :g:`(fun (x`:sub:`1`:g:`:A`:sub:`1`:g:`) ... (x`:sub:`m` :g:`:A`:sub:`m` :g:`) =>`:math:`\varphi`:g:`(x`:sub:`1` :g:`... x`:sub:`m` :g:`)) t`:sub:`1` :g:`... t`:sub:`m`. + If :g:`t`:sub:`i` occurs in one of the generated types :g:`A`:sub:`j` these + occurrences will also be considered and possibly abstracted. + +.. tacv:: pattern {+, @term at {+ @natural}} + + This behaves as above but processing only the occurrences :n:`{+ @natural}` of + :n:`@term` starting from :n:`@term`. + +.. tacv:: pattern {+, @term {? at {? -} {+, @natural}}} + + This is the most general syntax that combines the different variants. + +.. tacn:: with_strategy @strategy_level_or_var [ {+ @reference } ] @ltac_expr3 + :name: with_strategy + + Executes :token:`ltac_expr3`, applying the alternate unfolding + behavior that the :cmd:`Strategy` command controls, but only for + :token:`ltac_expr3`. This can be useful for guarding calls to + reduction in tactic automation to ensure that certain constants are + never unfolded by tactics like :tacn:`simpl` and :tacn:`cbn` or to + ensure that unfolding does not fail. + + .. example:: + + .. coqtop:: all reset abort + + Opaque id. + Goal id 10 = 10. + Fail unfold id. + with_strategy transparent [id] unfold id. + + .. warning:: + + Use this tactic with care, as effects do not persist past the + end of the proof script. Notably, this fine-tuning of the + conversion strategy is not in effect during :cmd:`Qed` nor + :cmd:`Defined`, so this tactic is most useful either in + combination with :tacn:`abstract`, which will check the proof + early while the fine-tuning is still in effect, or to guard + calls to conversion in tactic automation to ensure that, e.g., + :tacn:`unfold` does not fail just because the user made a + constant :cmd:`Opaque`. + + This can be illustrated with the following example involving the + factorial function. + + .. coqtop:: in reset + + Fixpoint fact (n : nat) : nat := + match n with + | 0 => 1 + | S n' => n * fact n' + end. + + Suppose now that, for whatever reason, we want in general to + unfold the :g:`id` function very late during conversion: + + .. coqtop:: in + + Strategy 1000 [id]. + + If we try to prove :g:`id (fact n) = fact n` by + :tacn:`reflexivity`, it will now take time proportional to + :math:`n!`, because |Coq| will keep unfolding :g:`fact` and + :g:`*` and :g:`+` before it unfolds :g:`id`, resulting in a full + computation of :g:`fact n` (in unary, because we are using + :g:`nat`), which takes time :math:`n!`. We can see this cross + the relevant threshold at around :math:`n = 9`: + + .. coqtop:: all abort + + Goal True. + Time assert (id (fact 8) = fact 8) by reflexivity. + Time assert (id (fact 9) = fact 9) by reflexivity. + + Note that behavior will be the same if you mark :g:`id` as + :g:`Opaque` because while most reduction tactics refuse to + unfold :g:`Opaque` constants, conversion treats :g:`Opaque` as + merely a hint to unfold this constant last. + + We can get around this issue by using :tacn:`with_strategy`: + + .. coqtop:: all + + Goal True. + Fail Timeout 1 assert (id (fact 100) = fact 100) by reflexivity. + Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] reflexivity. + + However, when we go to close the proof, we will run into + trouble, because the reduction strategy changes are local to the + tactic passed to :tacn:`with_strategy`. + + .. coqtop:: all abort fail + + exact I. + Timeout 1 Defined. + + We can fix this issue by using :tacn:`abstract`: + + .. coqtop:: all + + Goal True. + Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] abstract reflexivity. + exact I. + Time Defined. + + On small examples this sort of behavior doesn't matter, but + because |Coq| is a super-linear performance domain in so many + places, unless great care is taken, tactic automation using + :tacn:`with_strategy` may not be robustly performant when + scaling the size of the input. + + .. warning:: + + In much the same way this tactic does not play well with + :cmd:`Qed` and :cmd:`Defined` without using :tacn:`abstract` as + an intermediary, this tactic does not play well with ``coqchk``, + even when used with :tacn:`abstract`, due to the inability of + tactics to persist information about conversion hints in the + proof term. See `#12200 + <https://github.com/coq/coq/issues/12200>`_ for more details. + +Conversion tactics applied to hypotheses +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. tacn:: @tactic in {+, @ident} + + Applies :token:`tactic` (any of the conversion tactics listed in this + section) to the hypotheses :n:`{+ @ident}`. + + If :token:`ident` is a local definition, then :token:`ident` can be replaced by + :n:`type of @ident` to address not the body but the type of the local + definition. + + Example: :n:`unfold not in (type of H1) (type of H3)`. diff --git a/doc/sphinx/user-extensions/syntax-extensions.rst b/doc/sphinx/user-extensions/syntax-extensions.rst index 06018304ab..9d1fcc160d 100644 --- a/doc/sphinx/user-extensions/syntax-extensions.rst +++ b/doc/sphinx/user-extensions/syntax-extensions.rst @@ -1386,7 +1386,7 @@ Scopes` or :cmd:`Print Scope`. ``char_scope`` This scope includes interpretation for all strings of the form ``"c"`` where :g:`c` is an ASCII character, or of the form ``"nnn"`` where nnn is - a three-digits number (possibly with leading 0's), or of the form + a three-digit number (possibly with leading 0s), or of the form ``""""``. Their respective denotations are the ASCII code of :g:`c`, the decimal ASCII code ``nnn``, or the ascii code of the character ``"`` (i.e. the ASCII code 34), all of them being represented in the type :g:`ascii`. @@ -1553,16 +1553,18 @@ numbers (see :ref:`datatypes`). Number notations ~~~~~~~~~~~~~~~~ -.. cmd:: Number Notation @qualid__type @qualid__parse @qualid__print : @scope_name {? @numeral_modifier } +.. cmd:: Number Notation @qualid__type @qualid__parse @qualid__print {? ( {+, @number_modifier } ) } : @scope_name :name: Number Notation - .. insertprodn numeral_modifier numeral_modifier + .. insertprodn number_modifier number_string_via .. prodn:: - numeral_modifier ::= ( warning after @bignat ) - | ( abstract after @bignat ) + number_modifier ::= warning after @bignat + | abstract after @bignat + | @number_string_via + number_string_via ::= via @qualid mapping [ {+, {| @qualid => @qualid | [ @qualid ] => @qualid } } ] - This command allows the user to customize the way numeral literals + This command allows the user to customize the way number literals are parsed and printed. :n:`@qualid__type` @@ -1571,32 +1573,32 @@ Number notations parsing and printing functions, respectively. The parsing function :n:`@qualid__parse` should have one of the following types: - * :n:`Numeral.int -> @qualid__type` - * :n:`Numeral.int -> option @qualid__type` - * :n:`Numeral.uint -> @qualid__type` - * :n:`Numeral.uint -> option @qualid__type` + * :n:`Number.int -> @qualid__type` + * :n:`Number.int -> option @qualid__type` + * :n:`Number.uint -> @qualid__type` + * :n:`Number.uint -> option @qualid__type` * :n:`Z -> @qualid__type` * :n:`Z -> option @qualid__type` - * :n:`Numeral.numeral -> @qualid__type` - * :n:`Numeral.numeral -> option @qualid__type` + * :n:`Number.number -> @qualid__type` + * :n:`Number.number -> option @qualid__type` And the printing function :n:`@qualid__print` should have one of the following types: - * :n:`@qualid__type -> Numeral.int` - * :n:`@qualid__type -> option Numeral.int` - * :n:`@qualid__type -> Numeral.uint` - * :n:`@qualid__type -> option Numeral.uint` + * :n:`@qualid__type -> Number.int` + * :n:`@qualid__type -> option Number.int` + * :n:`@qualid__type -> Number.uint` + * :n:`@qualid__type -> option Number.uint` * :n:`@qualid__type -> Z` * :n:`@qualid__type -> option Z` - * :n:`@qualid__type -> Numeral.numeral` - * :n:`@qualid__type -> option Numeral.numeral` + * :n:`@qualid__type -> Number.number` + * :n:`@qualid__type -> option Number.number` .. deprecated:: 8.12 - Numeral notations on :g:`Decimal.uint`, :g:`Decimal.int` and - :g:`Decimal.decimal` are replaced respectively by numeral - notations on :g:`Numeral.uint`, :g:`Numeral.int` and - :g:`Numeral.numeral`. + Number notations on :g:`Decimal.uint`, :g:`Decimal.int` and + :g:`Decimal.decimal` are replaced respectively by number + notations on :g:`Number.uint`, :g:`Number.int` and + :g:`Number.number`. When parsing, the application of the parsing function :n:`@qualid__parse` to the number will be fully reduced, and universes @@ -1606,7 +1608,44 @@ Number notations function application, constructors, inductive type families, sorts, and primitive integers) will be considered for printing. - :n:`( warning after @bignat )` + .. _number-string-via: + + :n:`via @qualid__ind mapping [ {+, @qualid__constant => @qualid__constructor } ]` + When using this option, :n:`@qualid__type` no + longer needs to be an inductive type and is instead mapped to the + inductive type :n:`@qualid__ind` according to the provided + list of pairs, whose first component :n:`@qualid__constant` is a + constant of type :n:`@qualid__type` + (or a function of type :n:`{* _ -> } @qualid__type`) and the second a + constructor of type :n:`@qualid__ind`. The type + :n:`@qualid__type` is then replaced by :n:`@qualid__ind` in the + above parser and printer types. + + When :n:`@qualid__constant` is surrounded by square brackets, + all the implicit arguments of :n:`@qualid__constant` (whether maximally inserted or not) are ignored + when translating to :n:`@qualid__constructor` (i.e., before + applying :n:`@qualid__print`) and replaced with implicit + argument holes :g:`_` when translating from + :n:`@qualid__constructor` to :n:`@qualid__constant` (after + :n:`@qualid__parse`). See below for an :ref:`example <example-number-notation-implicit-args>`. + + .. note:: + The implicit status of the arguments is considered + only at notation declaration time, any further + modification of this status has no impact + on the previously declared notations. + + .. note:: + In case of multiple implicit options (for instance + :g:`Arguments eq_refl {A}%type_scope {x}, [_] _`), an + argument is considered implicit when it is implicit in any of the + options. + + .. note:: + To use a :token:`sort` as the target type :n:`@qualid__type`, use an :ref:`abbreviation <Abbreviations>` + as in the :ref:`example below <example-number-notation-non-inductive>`. + + :n:`warning after @bignat` displays a warning message about a possible stack overflow when calling :n:`@qualid__parse` to parse a literal larger than :n:`@bignat`. @@ -1616,11 +1655,11 @@ Number notations with :n:`(warning after @bignat)`, this warning is emitted when parsing a number greater than or equal to :token:`bignat`. - :n:`( abstract after @bignat )` + :n:`abstract after @bignat` returns :n:`(@qualid__parse m)` when parsing a literal :n:`m` that's greater than :n:`@bignat` rather than reducing it to a normal form. Here :g:`m` will be a - :g:`Numeral.int`, :g:`Numeral.uint`, :g:`Z` or :g:`Numeral.numeral`, depending on the + :g:`Number.int`, :g:`Number.uint`, :g:`Z` or :g:`Number.number`, depending on the type of the parsing function :n:`@qualid__parse`. This allows for a more compact representation of literals in types such as :g:`nat`, and limits parse failures due to stack overflow. Note that a @@ -1642,76 +1681,94 @@ Number notations As noted above, the :n:`(abstract after @natural)` directive has no effect when :n:`@qualid__parse` lands in an :g:`option` type. + .. exn:: 'via' and 'abstract' cannot be used together. + + With the :n:`abstract after` option, the parser function + :n:`@qualid__parse` does not reduce large numbers to a normal form, + which prevents doing the translation given in the :n:`mapping` list. + .. exn:: Cannot interpret this number as a value of type @type - The numeral notation registered for :token:`type` does not support + The number notation registered for :token:`type` does not support the given number. This error is given when the interpretation function returns :g:`None`, or if the interpretation is registered only for integers or non-negative integers, and the given number has a fractional or exponent part or is negative. - .. exn:: @qualid__parse should go from Numeral.int to @type or (option @type). Instead of Numeral.int, the types Numeral.uint or Z or Int63.int or Numeral.numeral could be used (you may need to require BinNums or Numeral or Int63 first). + .. exn:: @qualid__parse should go from Number.int to @type or (option @type). Instead of Number.int, the types Number.uint or Z or Int63.int or Number.number could be used (you may need to require BinNums or Number or Int63 first). The parsing function given to the :cmd:`Number Notation` vernacular is not of the right type. - .. exn:: @qualid__print should go from @type to Numeral.int or (option Numeral.int). Instead of Numeral.int, the types Numeral.uint or Z or Int63.int or Numeral.numeral could be used (you may need to require BinNums or Numeral or Int63 first). + .. exn:: @qualid__print should go from @type to Number.int or (option Number.int). Instead of Number.int, the types Number.uint or Z or Int63.int or Number.number could be used (you may need to require BinNums or Number or Int63 first). The printing function given to the :cmd:`Number Notation` vernacular is not of the right type. - .. exn:: Unexpected term @term while parsing a numeral notation. + .. exn:: Unexpected term @term while parsing a number notation. Parsing functions must always return ground terms, made up of - applications of constructors, inductive types, and primitive + function application, constructors, inductive type families, sorts and primitive integers. Parsing functions may not return terms containing axioms, bare (co)fixpoints, lambdas, etc. - .. exn:: Unexpected non-option term @term while parsing a numeral notation. + .. exn:: Unexpected non-option term @term while parsing a number notation. Parsing functions expected to return an :g:`option` must always return a concrete :g:`Some` or :g:`None` when applied to a concrete number expressed as a (hexa)decimal. They may not return opaque constants. + .. exn:: Multiple 'via' options. + + At most one :g:`via` option can be given. + + .. exn:: Multiple 'warning after' or 'abstract after' options. + + At most one :g:`warning after` or :g:`abstract after` option can be given. + .. _string-notations: String notations ~~~~~~~~~~~~~~~~ -.. cmd:: String Notation @qualid @qualid__parse @qualid__print : @scope_name +.. cmd:: String Notation @qualid__type @qualid__parse @qualid__print {? ( @number_string_via ) } : @scope_name :name: String Notation Allows the user to customize how strings are parsed and printed. - 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:`@qualid__parse` should have one of the following types: + :n:`@qualid__type` + the name of an inductive type, + while :n:`@qualid__parse` and :n:`@qualid__print` should be the names of the + parsing and printing functions, respectively. The parsing function + :n:`@qualid__parse` should have one of the following types: - * :n:`Byte.byte -> @qualid` - * :n:`Byte.byte -> option @qualid` - * :n:`list Byte.byte -> @qualid` - * :n:`list Byte.byte -> option @qualid` + * :n:`Byte.byte -> @qualid__type` + * :n:`Byte.byte -> option @qualid__type` + * :n:`list Byte.byte -> @qualid__type` + * :n:`list Byte.byte -> option @qualid__type` - The printing function :n:`@qualid__print` should have one of the - following types: + The printing function :n:`@qualid__print` should have one of the + following types: - * :n:`@qualid -> Byte.byte` - * :n:`@qualid -> option Byte.byte` - * :n:`@qualid -> list Byte.byte` - * :n:`@qualid -> option (list Byte.byte)` + * :n:`@qualid__type -> Byte.byte` + * :n:`@qualid__type -> option Byte.byte` + * :n:`@qualid__type -> list Byte.byte` + * :n:`@qualid__type -> option (list Byte.byte)` - 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. + 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 + :n:`via @qualid__ind mapping [ {+, @qualid__constant => @qualid__constructor } ]` + works as for :ref:`number notations above <number-string-via>`. + + .. exn:: Cannot interpret this string as a value of type @type The string notation registered for :token:`type` does not support the given string. This error is given when the interpretation @@ -1730,7 +1787,7 @@ String notations .. exn:: Unexpected term @term while parsing a string notation. Parsing functions must always return ground terms, made up of - applications of constructors, inductive types, and primitive + function application, constructors, inductive type families, sorts and primitive integers. Parsing functions may not return terms containing axioms, bare (co)fixpoints, lambdas, etc. @@ -1741,16 +1798,37 @@ String notations concrete string expressed as a decimal. They may not return opaque constants. -The following errors apply to both string and numeral notations: +.. note:: + Number or string notations for parameterized inductive types can be + added by declaring an :ref:`abbreviation <Abbreviations>` for the + inductive which instantiates all parameters. See :ref:`example below <example-string-notation-parameterized-inductive>`. + +The following errors apply to both string and number notations: .. exn:: @type is not an inductive type. - String and numeral notations can only be declared for inductive types with no - arguments. + String and number notations can only be declared for inductive types. + Declare string or numeral notations for non-inductive types using :n:`@number_string_via`. + + .. exn:: @qualid was already mapped to @qualid and cannot be remapped to @qualid + + Duplicates are not allowed in the :n:`mapping` list. + + .. exn:: Missing mapping for constructor @qualid + + A mapping should be provided for :n:`@qualid` in the :n:`mapping` list. + + .. warn:: @type was already mapped to @type, mapping it also to @type might yield ill typed terms when using the notation. + + Two pairs in the :n:`mapping` list associate types that might be incompatible. + + .. warn:: Type of @qualid seems incompatible with the type of @qualid. Expected type is: @type instead of @type. This might yield ill typed terms when using the notation. + + A mapping given in the :n:`mapping` list associates a constant with a seemingly incompatible constructor. .. exn:: Cannot interpret in @scope_name because @qualid could not be found in the current environment. - The inductive type used to register the string or numeral notation is no + The inductive type used to register the string or number notation is no longer available in the environment. Most likely, this is because the notation was declared inside a functor for an inductive type inside the functor. This use case is not currently @@ -1779,6 +1857,198 @@ The following errors apply to both string and numeral notations: .. todo note on "single qualified identifiers" https://github.com/coq/coq/pull/11718#discussion_r415076703 +.. example:: Number Notation for radix 3 + + The following example parses and prints natural numbers + whose digits are :g:`0`, :g:`1` or :g:`2` as terms of the following + inductive type encoding radix 3 numbers. + + .. coqtop:: in reset + + Inductive radix3 : Set := + | x0 : radix3 + | x3 : radix3 -> radix3 + | x3p1 : radix3 -> radix3 + | x3p2 : radix3 -> radix3. + + We first define a parsing function + + .. coqtop:: in + + Definition of_uint_dec (u : Decimal.uint) : option radix3 := + let fix f u := match u with + | Decimal.Nil => Some x0 + | Decimal.D0 u => match f u with Some u => Some (x3 u) | None => None end + | Decimal.D1 u => match f u with Some u => Some (x3p1 u) | None => None end + | Decimal.D2 u => match f u with Some u => Some (x3p2 u) | None => None end + | _ => None end in + f (Decimal.rev u). + Definition of_uint (u : Number.uint) : option radix3 := + match u with Number.UIntDecimal u => of_uint_dec u | Number.UIntHexadecimal _ => None end. + + and a printing function + + .. coqtop:: in + + Definition to_uint_dec (x : radix3) : Decimal.uint := + let fix f x := match x with + | x0 => Decimal.Nil + | x3 x => Decimal.D0 (f x) + | x3p1 x => Decimal.D1 (f x) + | x3p2 x => Decimal.D2 (f x) end in + Decimal.rev (f x). + Definition to_uint (x : radix3) : Number.uint := Number.UIntDecimal (to_uint_dec x). + + before declaring the notation + + .. coqtop:: in + + Declare Scope radix3_scope. + Open Scope radix3_scope. + Number Notation radix3 of_uint to_uint : radix3_scope. + + We can check the printer + + .. coqtop:: all + + Check x3p2 (x3p1 x0). + + and the parser + + .. coqtop:: all + + Set Printing All. + Check 120. + + Digits other than :g:`0`, :g:`1` and :g:`2` are rejected. + + .. coqtop:: all fail + + Check 3. + +.. _example-number-notation-non-inductive: + +.. example:: Number Notation for a non inductive type + + The following example encodes the terms in the form :g:`sum unit ( ... (sum unit unit) ... )` + as the number of units in the term. For instance :g:`sum unit (sum unit unit)` + is encoded as :g:`3` while :g:`unit` is :g:`1` and :g:`0` stands for :g:`Empty_set`. + The inductive :g:`I` will be used as :n:`@qualid__ind`. + + .. coqtop:: in reset + + Inductive I := Iempty : I | Iunit : I | Isum : I -> I -> I. + + We then define :n:`@qualid__parse` and :n:`@qualid__print` + + .. coqtop:: in + + Definition of_uint (x : Number.uint) : I := + let fix f n := match n with + | O => Iempty | S O => Iunit + | S n => Isum Iunit (f n) end in + f (Nat.of_num_uint x). + + Definition to_uint (x : I) : Number.uint := + let fix f i := match i with + | Iempty => O | Iunit => 1 + | Isum i1 i2 => f i1 + f i2 end in + Nat.to_num_uint (f x). + + Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. + + the number notation itself + + .. coqtop:: in + + Notation nSet := Set (only parsing). + Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) : type_scope. + + and check the printer + + .. coqtop:: all + + Local Open Scope type_scope. + Check sum unit (sum unit unit). + + and the parser + + .. coqtop:: all + + Set Printing All. + Check 3. + +.. _example-number-notation-implicit-args: + +.. example:: Number Notation with implicit arguments + + The following example parses and prints natural numbers between + :g:`0` and :g:`n-1` as terms of type :g:`Fin.t n`. + + .. coqtop:: all reset + + Require Import Vector. + Print Fin.t. + + Note the implicit arguments of :g:`Fin.F1` and :g:`Fin.FS`, + which won't appear in the corresponding inductive type. + + .. coqtop:: in + + Inductive I := I1 : I | IS : I -> I. + + Definition of_uint (x : Number.uint) : I := + let fix f n := match n with O => I1 | S n => IS (f n) end in + f (Nat.of_num_uint x). + + Definition to_uint (x : I) : Number.uint := + let fix f i := match i with I1 => O | IS n => S (f n) end in + Nat.to_num_uint (f x). + + Declare Scope fin_scope. + Delimit Scope fin_scope with fin. + Local Open Scope fin_scope. + Number Notation Fin.t of_uint to_uint (via I + mapping [[Fin.F1] => I1, [Fin.FS] => IS]) : fin_scope. + + Now :g:`2` is parsed as :g:`Fin.FS (Fin.FS Fin.F1)`, that is + :g:`@Fin.FS _ (@Fin.FS _ (@Fin.F1 _))`. + + .. coqtop:: all + + Check 2. + + which can be of type :g:`Fin.t 3` (numbers :g:`0`, :g:`1` and :g:`2`) + + .. coqtop:: all + + Check 2 : Fin.t 3. + + but cannot be of type :g:`Fin.t 2` (only :g:`0` and :g:`1`) + + .. coqtop:: all fail + + Check 2 : Fin.t 2. + +.. _example-string-notation-parameterized-inductive: + +.. example:: String Notation with a parameterized inductive type + + The parameter :g:`Byte.byte` for the parameterized inductive type + :g:`list` is given through an :ref:`abbreviation <Abbreviations>`. + + .. coqtop:: in reset + + Notation string := (list Byte.byte) (only parsing). + Definition id_string := @id string. + + String Notation string id_string id_string : list_scope. + + .. coqtop:: all + + Check "abc"%list. + .. _TacticNotation: Tactic Notations diff --git a/doc/stdlib/hidden-files b/doc/stdlib/hidden-files index 4d2972ef8f..e4f0967794 100644 --- a/doc/stdlib/hidden-files +++ b/doc/stdlib/hidden-files @@ -1,3 +1,4 @@ +theories/Init/Numeral.v theories/btauto/Algebra.v theories/btauto/Btauto.v theories/btauto/Reflect.v diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index 7c1328916b..b08d7e9d2c 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -22,7 +22,7 @@ through the <tt>Require Import</tt> command.</p> theories/Init/Nat.v theories/Init/Decimal.v theories/Init/Hexadecimal.v - theories/Init/Numeral.v + theories/Init/Number.v theories/Init/Peano.v theories/Init/Specif.v theories/Init/Tactics.v @@ -238,6 +238,7 @@ through the <tt>Require Import</tt> command.</p> theories/Numbers/DecimalN.v theories/Numbers/DecimalZ.v theories/Numbers/DecimalQ.v + theories/Numbers/DecimalR.v theories/Numbers/DecimalString.v theories/Numbers/HexadecimalFacts.v theories/Numbers/HexadecimalNat.v @@ -245,6 +246,7 @@ through the <tt>Require Import</tt> command.</p> theories/Numbers/HexadecimalN.v theories/Numbers/HexadecimalZ.v theories/Numbers/HexadecimalQ.v + theories/Numbers/HexadecimalR.v theories/Numbers/HexadecimalString.v </dd> diff --git a/doc/tools/docgram/common.edit_mlg b/doc/tools/docgram/common.edit_mlg index f6a684bbd7..97d479b238 100644 --- a/doc/tools/docgram/common.edit_mlg +++ b/doc/tools/docgram/common.edit_mlg @@ -1285,12 +1285,12 @@ command: [ | 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 numeral_modifier -| WITH "Numeral" "Notation" reference reference reference ":" scope_name numeral_modifier -| REPLACE "Number" "Notation" reference reference reference ":" ident numeral_modifier -| WITH "Number" "Notation" reference reference reference ":" scope_name numeral_modifier -| REPLACE "String" "Notation" reference reference reference ":" ident -| WITH "String" "Notation" reference reference reference ":" scope_name +| REPLACE "Number" "Notation" reference reference reference OPT number_options ":" ident +| WITH "Number" "Notation" reference reference reference OPT number_options ":" scope_name +| REPLACE "Numeral" "Notation" reference reference reference ":" ident deprecated_number_modifier +| WITH "Numeral" "Notation" reference reference reference ":" scope_name deprecated_number_modifier +| REPLACE "String" "Notation" reference reference reference OPT string_option ":" ident +| WITH "String" "Notation" reference reference reference OPT string_option ":" scope_name | DELETE "Ltac2" ltac2_entry (* was split up *) | DELETE "Add" "Zify" "InjTyp" constr (* micromega plugin *) @@ -1358,10 +1358,6 @@ explicit_subentry: [ | DELETE "constr" (* covered by another prod *) ] -numeral_modifier: [ -| OPTINREF -] - binder_tactic: [ | REPLACE "let" [ "rec" | ] LIST1 let_clause SEP "with" "in" ltac_expr5 | WITH "let" OPT "rec" let_clause LIST0 ( "with" let_clause ) "in" ltac_expr5 @@ -2198,6 +2194,7 @@ ltac2_expr5: [ | REPLACE "let" OPT "rec" LIST1 ltac2_let_clause SEP "with" "in" ltac2_expr6 (* Ltac2 plugin *) | WITH "let" OPT "rec" ltac2_let_clause LIST0 ( "with" ltac2_let_clause ) "in" ltac2_expr6 TAG Ltac2 | MOVETO simple_tactic "match" ltac2_expr5 "with" OPT ltac2_branches "end" (* Ltac2 plugin *) +| MOVETO simple_tactic "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 (* Ltac2 plugin *) | DELETE simple_tactic ] @@ -2464,6 +2461,9 @@ SPLICE: [ | constr_with_bindings | simple_binding | ssexpr35 (* strange in mlg, ssexpr50 is after this *) +| number_string_mapping +| number_options +| string_option ] (* end SPLICE *) RENAME: [ diff --git a/doc/tools/docgram/doc_grammar.ml b/doc/tools/docgram/doc_grammar.ml index b7f1e18d2b..92bcd51528 100644 --- a/doc/tools/docgram/doc_grammar.ml +++ b/doc/tools/docgram/doc_grammar.ml @@ -538,12 +538,11 @@ let autoloaded_mlgs = [ (* in the order they are loaded by Coq *) "plugins/ltac/g_eqdecide.mlg"; "plugins/ltac/g_tactic.mlg"; "plugins/ltac/g_ltac.mlg"; - "plugins/syntax/g_string.mlg"; "plugins/btauto/g_btauto.mlg"; "plugins/rtauto/g_rtauto.mlg"; "plugins/cc/g_congruence.mlg"; "plugins/firstorder/g_ground.mlg"; - "plugins/syntax/g_numeral.mlg"; + "plugins/syntax/g_number_string.mlg"; ] diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar index c764cb6f37..20ac8f8bf3 100644 --- a/doc/tools/docgram/fullGrammar +++ b/doc/tools/docgram/fullGrammar @@ -686,9 +686,9 @@ command: [ | "Print" "Rings" (* ring plugin *) | "Add" "Field" ident ":" constr OPT field_mods (* ring plugin *) | "Print" "Fields" (* ring plugin *) -| "Number" "Notation" reference reference reference ":" ident numeral_modifier -| "Numeral" "Notation" reference reference reference ":" ident numeral_modifier -| "String" "Notation" reference reference reference ":" ident +| "Number" "Notation" reference reference reference OPT number_options ":" ident +| "Numeral" "Notation" reference reference reference ":" ident deprecated_number_modifier +| "String" "Notation" reference reference reference OPT string_option ":" ident | "Ltac2" ltac2_entry (* Ltac2 plugin *) | "Ltac2" "Eval" ltac2_expr6 (* Ltac2 plugin *) | "Print" "Ltac2" reference (* Ltac2 plugin *) @@ -2549,12 +2549,35 @@ field_mods: [ | "(" LIST1 field_mod SEP "," ")" (* ring plugin *) ] -numeral_modifier: [ +deprecated_number_modifier: [ | | "(" "warning" "after" bignat ")" | "(" "abstract" "after" bignat ")" ] +number_string_mapping: [ +| reference "=>" reference +| "[" reference "]" "=>" reference +] + +number_string_via: [ +| "via" reference "mapping" "[" LIST1 number_string_mapping SEP "," "]" +] + +number_modifier: [ +| "warning" "after" bignat +| "abstract" "after" bignat +| number_string_via +] + +number_options: [ +| "(" LIST1 number_modifier SEP "," ")" +] + +string_option: [ +| "(" number_string_via ")" +] + tac2pat1: [ | Prim.qualid LIST1 tac2pat0 (* Ltac2 plugin *) | Prim.qualid (* Ltac2 plugin *) @@ -2586,6 +2609,7 @@ ltac2_expr5: [ | "fun" LIST1 G_LTAC2_input_fun "=>" ltac2_expr6 (* Ltac2 plugin *) | "let" rec_flag LIST1 G_LTAC2_let_clause SEP "with" "in" ltac2_expr6 (* Ltac2 plugin *) | "match" ltac2_expr5 "with" G_LTAC2_branches "end" (* Ltac2 plugin *) +| "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 (* Ltac2 plugin *) | ltac2_expr4 (* Ltac2 plugin *) ] diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar index 12a7bc684d..75c0ca1453 100644 --- a/doc/tools/docgram/orderedGrammar +++ b/doc/tools/docgram/orderedGrammar @@ -884,8 +884,6 @@ command: [ | "Print" "Rings" (* ring plugin *) | "Add" "Field" ident ":" one_term OPT ( "(" LIST1 field_mod SEP "," ")" ) (* ring plugin *) | "Print" "Fields" (* ring plugin *) -| "Number" "Notation" qualid qualid qualid ":" scope_name OPT numeral_modifier -| "Numeral" "Notation" qualid qualid qualid ":" scope_name OPT numeral_modifier | "Hint" "Cut" "[" hints_path "]" OPT ( ":" LIST1 ident ) | "Typeclasses" "Transparent" LIST1 qualid | "Typeclasses" "Opaque" LIST1 qualid @@ -910,7 +908,9 @@ command: [ | "Derive" "Dependent" "Inversion_clear" ident "with" one_term "Sort" sort_family | "Declare" "Left" "Step" one_term | "Declare" "Right" "Step" one_term -| "String" "Notation" qualid qualid qualid ":" scope_name +| "Number" "Notation" qualid qualid qualid OPT ( "(" LIST1 number_modifier SEP "," ")" ) ":" scope_name +| "Numeral" "Notation" qualid qualid qualid ":" scope_name deprecated_number_modifier +| "String" "Notation" qualid qualid qualid OPT ( "(" number_string_via ")" ) ":" scope_name | "SubClass" ident_decl def_body | thm_token ident_decl LIST0 binder ":" type LIST0 [ "with" ident_decl LIST0 binder ":" type ] | assumption_token OPT ( "Inline" OPT ( "(" natural ")" ) ) [ LIST1 ( "(" assumpt ")" ) | assumpt ] @@ -1269,11 +1269,22 @@ field_mod: [ | "completeness" one_term (* ring plugin *) ] -numeral_modifier: [ +deprecated_number_modifier: [ +| | "(" "warning" "after" bignat ")" | "(" "abstract" "after" bignat ")" ] +number_modifier: [ +| "warning" "after" bignat +| "abstract" "after" bignat +| number_string_via +] + +number_string_via: [ +| "via" qualid "mapping" "[" LIST1 [ qualid "=>" qualid | "[" qualid "]" "=>" qualid ] SEP "," "]" +] + hints_path: [ | "(" hints_path ")" | hints_path "*" @@ -1640,6 +1651,7 @@ simple_tactic: [ | "ring" OPT ( "[" LIST1 one_term "]" ) | "ring_simplify" OPT ( "[" LIST1 one_term "]" ) LIST1 one_term OPT ( "in" ident ) | "match" ltac2_expr5 "with" OPT ltac2_branches "end" +| "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 | qualid LIST1 tactic_arg ] diff --git a/engine/eConstr.ml b/engine/eConstr.ml index bb2873b486..0c84dee572 100644 --- a/engine/eConstr.ml +++ b/engine/eConstr.ml @@ -628,6 +628,9 @@ let subst_var subst c = of_constr (Vars.subst_var subst (to_constr c)) let subst_univs_level_constr subst c = of_constr (Vars.subst_univs_level_constr subst (to_constr c)) +let subst_univs_constr subst c = + of_constr (UnivSubst.subst_univs_constr subst (to_constr c)) + (** Operations that dot NOT commute with evar-normalization *) let noccurn sigma n term = let rec occur_rec n c = match kind sigma c with diff --git a/engine/eConstr.mli b/engine/eConstr.mli index a018f4064f..882dfe2848 100644 --- a/engine/eConstr.mli +++ b/engine/eConstr.mli @@ -295,6 +295,7 @@ val closedn : Evd.evar_map -> int -> t -> bool val closed0 : Evd.evar_map -> t -> bool val subst_univs_level_constr : Univ.universe_level_subst -> t -> t +val subst_univs_constr : Univ.universe_subst -> t -> t val subst_of_rel_context_instance : rel_context -> t list -> t list diff --git a/interp/constrexpr.ml b/interp/constrexpr.ml index d14d156ffc..235310660b 100644 --- a/interp/constrexpr.ml +++ b/interp/constrexpr.ml @@ -58,7 +58,7 @@ type abstraction_kind = AbsLambda | AbsPi type proj_flag = int option (** [Some n] = proj of the n-th visible argument *) type prim_token = - | Numeral of NumTok.Signed.t + | Number of NumTok.Signed.t | String of string type instance_expr = Glob_term.glob_level list diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml index 7075d082ee..8cc63c5d03 100644 --- a/interp/constrexpr_ops.ml +++ b/interp/constrexpr_ops.ml @@ -44,13 +44,13 @@ let names_of_local_binders bl = (**********************************************************************) (* Functions on constr_expr *) -(* Note: redundant Numeral representations, such as -0 and +0 (and others), +(* Note: redundant Number representations, such as -0 and +0 (and others), are considered different here. *) let prim_token_eq t1 t2 = match t1, t2 with -| Numeral n1, Numeral n2 -> NumTok.Signed.equal n1 n2 +| Number n1, Number n2 -> NumTok.Signed.equal n1 n2 | String s1, String s2 -> String.equal s1 s2 -| (Numeral _ | String _), _ -> false +| (Number _ | String _), _ -> false let explicitation_eq ex1 ex2 = match ex1, ex2 with | ExplByPos (i1, id1), ExplByPos (i2, id2) -> diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 7bf1c58148..d1bec16a3f 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -357,18 +357,18 @@ let destPatPrim = function { CAst.v = CPatPrim t } -> Some t | _ -> None let make_notation_gen loc ntn mknot mkprim destprim l bl = match snd ntn,List.map destprim l with (* Special case to avoid writing "- 3" for e.g. (Z.opp 3) *) - | "- _", [Some (Numeral p)] when not (NumTok.Signed.is_zero p) -> + | "- _", [Some (Number p)] when not (NumTok.Signed.is_zero p) -> assert (bl=[]); mknot (loc,ntn,([mknot (loc,(InConstrEntry,"( _ )"),l,[])]),[]) | _ -> match decompose_notation_key ntn, l with | (InConstrEntry,[Terminal "-"; Terminal x]), [] -> begin match NumTok.Unsigned.parse_string x with - | Some n -> mkprim (loc, Numeral (NumTok.SMinus,n)) + | Some n -> mkprim (loc, Number (NumTok.SMinus,n)) | None -> mknot (loc,ntn,l,bl) end | (InConstrEntry,[Terminal x]), [] -> begin match NumTok.Unsigned.parse_string x with - | Some n -> mkprim (loc, Numeral (NumTok.SPlus,n)) + | Some n -> mkprim (loc, Number (NumTok.SPlus,n)) | None -> mknot (loc,ntn,l,bl) end | _ -> mknot (loc,ntn,l,bl) @@ -915,7 +915,7 @@ let extern_float f scopes = let hex = !Flags.raw_print || not (get_printing_float ()) in if hex then Float64.to_hex_string f else Float64.to_string f in let n = NumTok.Signed.of_string s in - extern_prim_token_delimiter_if_required (Numeral n) + extern_prim_token_delimiter_if_required (Number n) "float" "float_scope" scopes (**********************************************************************) @@ -1097,7 +1097,7 @@ let rec extern inctx ?impargs scopes vars r = | GInt i -> extern_prim_token_delimiter_if_required - (Numeral (NumTok.Signed.of_int_string (Uint63.to_string i))) + (Number (NumTok.Signed.of_int_string (Uint63.to_string i))) "int63" "int63_scope" (snd scopes) | GFloat f -> extern_float f (snd scopes) diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 959b61a3d7..ecf2b951a2 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -263,6 +263,13 @@ type intern_env = { binder_block_names: (abstraction_kind option (* None = unknown *) * Id.Set.t) option; } +type pattern_intern_env = { + pat_scopes: Notation_term.subscopes; + (* ids = Some means accept local variables; this is useful for + terms as patterns parsed as pattersn in notations *) + pat_ids: Id.Set.t option; +} + (**********************************************************************) (* Remembering the parsing scope of variables in notations *) @@ -317,6 +324,9 @@ let reset_tmp_scope env = {env with tmp_scope = None} let set_env_scopes env (scopt,subscopes) = {env with tmp_scope = scopt; scopes = subscopes @ env.scopes} +let env_for_pattern env = + {pat_scopes = (env.tmp_scope, env.scopes); pat_ids = Some env.ids} + let mkGProd ?loc (na,bk,t) body = DAst.make ?loc @@ GProd (na, bk, t, body) let mkGLambda ?loc (na,bk,t) body = DAst.make ?loc @@ GLambda (na, bk, t, body) @@ -420,6 +430,40 @@ let binder_status_fun = { slide = on_snd slide_binders; } +(* [test_kind_strict] rules out pattern which refers to global other + than constructors or variables; It is used in instances of notations *) + +let test_kind_pattern_in_notation ?loc = function + | GlobRef.ConstructRef _ -> () + (* We do not accept non constructors to be used as variables in + patterns *) + | GlobRef.ConstRef _ -> + user_err ?loc (str "Found a constant while a pattern was expected.") + | GlobRef.IndRef _ -> + user_err ?loc (str "Found an inductive type while a pattern was expected.") + | GlobRef.VarRef _ -> + (* we accept a section variable name to be used as pattern variable *) + raise Not_found + +let test_kind_ident_in_notation ?loc = function + | GlobRef.ConstructRef _ -> + user_err ?loc (str "Found a constructor while a variable name was expected.") + | GlobRef.ConstRef _ -> + user_err ?loc (str "Found a constant while a variable name was expected.") + | GlobRef.IndRef _ -> + user_err ?loc (str "Found an inductive type while a variable name was expected.") + | GlobRef.VarRef _ -> + (* we accept a section variable name to be used as pattern variable *) + raise Not_found + +(* [test_kind_tolerant] allow global reference names to be used as pattern variables *) + +let test_kind_tolerant ?loc = function + | GlobRef.ConstructRef _ -> () + | GlobRef.ConstRef _ | GlobRef.IndRef _ | GlobRef.VarRef _ -> + (* A non-constructor global reference in a pattern is seen as a variable *) + raise Not_found + (**) let locate_if_hole ?loc na c = match DAst.get c with @@ -539,9 +583,9 @@ let intern_letin_binder intern ntnvars env (({loc;v=na} as locna),def,ty) = (push_name_env ntnvars impls env locna, (na,Explicit,term,ty)) -let intern_cases_pattern_as_binder ?loc ntnvars env p = +let intern_cases_pattern_as_binder ?loc test_kind ntnvars env p = let il,disjpat = - let (il, subst_disjpat) = !intern_cases_pattern_fwd ntnvars (None,env.scopes) p in + let (il, subst_disjpat) = !intern_cases_pattern_fwd test_kind ntnvars (env_for_pattern (reset_tmp_scope env)) p in let substl,disjpat = List.split subst_disjpat in if not (List.for_all (fun subst -> Id.Map.equal Id.equal subst Id.Map.empty) substl) then user_err ?loc (str "Unsupported nested \"as\" clause."); @@ -568,7 +612,7 @@ let intern_local_binder_aux intern ntnvars (env,bl) = function | Some ty -> ty | None -> CAst.make ?loc @@ CHole(None,IntroAnonymous,None) in - let env, ((disjpat,il),id),na = intern_cases_pattern_as_binder ?loc ntnvars env p in + let env, ((disjpat,il),id),na = intern_cases_pattern_as_binder ?loc test_kind_tolerant ntnvars env p in let bk = Default Explicit in let _, bl' = intern_assumption intern ntnvars env [na] bk tyc in let {v=(_,bk,t)} = List.hd bl' in @@ -661,27 +705,21 @@ let is_patvar_store store pat = | PatVar na -> ignore(store na); true | _ -> false -let out_patvar pat = - match pat.v with +let out_patvar = CAst.map_with_loc (fun ?loc -> function | CPatAtom (Some qid) when qualid_is_ident qid -> Name (qualid_basename qid) | CPatAtom None -> Anonymous - | _ -> assert false - -let term_of_name = function - | Name id -> DAst.make (GVar id) - | Anonymous -> - let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in - DAst.make (GHole (Evar_kinds.QuestionMark { Evar_kinds.default_question_mark with Evar_kinds.qm_obligation=st }, IntroAnonymous, None)) + | _ -> assert false) let traverse_binder intern_pat ntnvars (terms,_,binders,_ as subst) avoid (renaming,env) = function | Anonymous -> (renaming,env), None, Anonymous | Name id -> let store,get = set_temporary_memory () in + let test_kind = test_kind_tolerant in try (* We instantiate binder name with patterns which may be parsed as terms *) let pat = coerce_to_cases_pattern_expr (fst (Id.Map.find id terms)) in - let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in + let env,((disjpat,ids),id),na = intern_pat test_kind ntnvars env pat in let pat, na = match disjpat with | [pat] when is_patvar_store store pat -> let na = get () in None, na | _ -> Some ((List.map (fun x -> x.v) ids,disjpat),id), na.v in @@ -694,11 +732,11 @@ 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 [] env (make ?loc:pat.loc na) in - (renaming,env), None, na + let env = push_name_env ntnvars [] env na in + (renaming,env), None, na.v else (* Interpret as a pattern *) - let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in + let env,((disjpat,ids),id),na = intern_pat test_kind ntnvars env pat in let pat, na = match disjpat with | [pat] when is_patvar_store store pat -> let na = get () in None, na @@ -829,22 +867,22 @@ let instantiate_notation_constr loc intern intern_pat ntnvars subst infos c = let arg = match arg with | None -> None | Some arg -> - let mk_env id (c, (tmp_scope, subscopes)) map = - let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in + let mk_env id (c, scopes) map = + let nenv = set_env_scopes env scopes in try let gc = intern nenv c in Id.Map.add id (gc, None) map with Nametab.GlobalizationError _ -> map in - let mk_env' (c, (onlyident,(tmp_scope,subscopes))) = - let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in - if onlyident then - let na = out_patvar c in term_of_name na, None - else - let _,((disjpat,_),_),_ = intern_pat ntnvars nenv c in - match disjpat with - | [pat] -> (glob_constr_of_cases_pattern (Global.env()) pat, None) - | _ -> error_cannot_coerce_disjunctive_pattern_term ?loc:c.loc () + let mk_env' (c, (onlyident,scopes)) = + let nenv = set_env_scopes env scopes in + let test_kind = + if onlyident then test_kind_ident_in_notation + else test_kind_pattern_in_notation in + let _,((disjpat,_),_),_ = intern_pat test_kind ntnvars nenv c in + match disjpat with + | [pat] -> (glob_constr_of_cases_pattern (Global.env()) pat, None) + | _ -> error_cannot_coerce_disjunctive_pattern_term ?loc:c.loc () in let terms = Id.Map.fold mk_env terms Id.Map.empty in let binders = Id.Map.map mk_env' binders in @@ -890,20 +928,19 @@ let instantiate_notation_constr loc intern intern_pat ntnvars subst infos c = (* subst remembers the delimiters stack in the interpretation *) (* of the notations *) try - let (a,(scopt,subscopes)) = Id.Map.find id terms in - intern {env with tmp_scope = scopt; - scopes = subscopes @ env.scopes} a + let (a,scopes) = Id.Map.find id terms in + intern (set_env_scopes env scopes) a with Not_found -> try let pat,(onlyident,scopes) = Id.Map.find id binders in - let env = set_env_scopes env scopes in - if onlyident then - term_of_name (out_patvar pat) - else - let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in - match disjpat with - | [pat] -> glob_constr_of_cases_pattern (Global.env()) pat - | _ -> user_err Pp.(str "Cannot turn a disjunctive pattern into a term.") + let nenv = set_env_scopes env scopes in + let test_kind = + if onlyident then test_kind_ident_in_notation + else test_kind_pattern_in_notation in + let env,((disjpat,ids),id),na = intern_pat test_kind ntnvars nenv pat in + match disjpat with + | [pat] -> glob_constr_of_cases_pattern (Global.env()) pat + | _ -> user_err Pp.(str "Cannot turn a disjunctive pattern into a term.") with Not_found -> try match binderopt with @@ -1570,11 +1607,11 @@ let rec subst_pat_iterator y t = DAst.(map (function | RCPatOr pl -> RCPatOr (List.map (subst_pat_iterator y t) pl))) let is_non_zero c = match c with -| { CAst.v = CPrim (Numeral p) } -> not (NumTok.Signed.is_zero p) +| { CAst.v = CPrim (Number p) } -> not (NumTok.Signed.is_zero p) | _ -> false let is_non_zero_pat c = match c with -| { CAst.v = CPatPrim (Numeral p) } -> not (NumTok.Signed.is_zero p) +| { CAst.v = CPatPrim (Number p) } -> not (NumTok.Signed.is_zero p) | _ -> false let get_asymmetric_patterns = Goptions.declare_bool_option_and_ref @@ -1582,19 +1619,14 @@ let get_asymmetric_patterns = Goptions.declare_bool_option_and_ref ~key:["Asymmetric";"Patterns"] ~value:false -let drop_notations_pattern looked_for genv = +let drop_notations_pattern (test_kind_top,test_kind_inner) genv env pat = (* At toplevel, Constructors and Inductives are accepted, in recursive calls only constructor are allowed *) - let ensure_kind top loc g = - try - if top then looked_for g else - match g with GlobRef.ConstructRef _ -> () | _ -> raise Not_found + let ensure_kind test_kind ?loc g = + try test_kind ?loc g with Not_found -> error_invalid_pattern_notation ?loc () in - let test_kind top = - if top then looked_for else function GlobRef.ConstructRef _ -> () | _ -> raise Not_found - in (* [rcp_of_glob] : from [glob_constr] to [raw_cases_pattern_expr] *) let rec rcp_of_glob scopes x = DAst.(map (function | GVar id -> RCPatAtom (Some (CAst.make ?loc:x.loc id,scopes)) @@ -1611,47 +1643,49 @@ let drop_notations_pattern looked_for genv = end | _ -> CErrors.anomaly Pp.(str "Invalid return pattern from Notation.interp_prim_token_cases_pattern_expr."))) x in - let rec drop_syndef top scopes qid pats = + let rec drop_syndef test_kind ?loc scopes qid pats = try + if qualid_is_ident qid && Option.cata (Id.Set.mem (qualid_basename qid)) false env.pat_ids then + raise Not_found; match Nametab.locate_extended qid with | SynDef sp -> let filter (vars,a) = try match a with | NRef g -> (* Convention: do not deactivate implicit arguments and scopes for further arguments *) - test_kind top g; + test_kind ?loc g; let () = assert (List.is_empty vars) in let (_,argscs) = find_remaining_scopes [] pats g in Some (g, [], List.map2 (in_pat_sc scopes) argscs pats) | NApp (NRef g,[]) -> (* special case: Syndef for @Cstr deactivates implicit arguments *) - test_kind top g; + test_kind ?loc g; let () = assert (List.is_empty vars) in let (_,argscs) = find_remaining_scopes [] pats g in Some (g, List.map2 (in_pat_sc scopes) argscs pats, []) | NApp (NRef g,args) -> (* Convention: do not deactivate implicit arguments and scopes for further arguments *) - test_kind top g; + test_kind ?loc g; let nvars = List.length vars in if List.length pats < nvars then error_not_enough_arguments ?loc:qid.loc; let pats1,pats2 = List.chop nvars pats in let subst = split_by_type_pat vars (pats1,[]) in - let idspl1 = List.map (in_not false qid.loc scopes subst []) args in + let idspl1 = List.map (in_not test_kind_inner qid.loc scopes subst []) args in let (_,argscs) = find_remaining_scopes pats1 pats2 g in Some (g, idspl1, List.map2 (in_pat_sc scopes) argscs pats2) | _ -> raise Not_found with Not_found -> None in Syntax_def.search_filtered_syntactic_definition filter sp | TrueGlobal g -> - test_kind top g; + test_kind ?loc g; Dumpglob.add_glob ?loc:qid.loc g; let (_,argscs) = find_remaining_scopes [] pats g in Some (g,[],List.map2 (in_pat_sc scopes) argscs pats) with Not_found -> None - and in_pat top scopes pt = + and in_pat test_kind scopes pt = let open CAst in let loc = pt.loc in match pt.v with - | CPatAlias (p, id) -> DAst.make ?loc @@ RCPatAlias (in_pat top scopes p, id) + | CPatAlias (p, id) -> DAst.make ?loc @@ RCPatAlias (in_pat test_kind scopes p, id) | CPatRecord l -> let sorted_fields = sort_fields ~complete:false loc l (fun _idx fieldname constructor -> CAst.make ?loc @@ CPatAtom None) in @@ -1668,7 +1702,7 @@ let drop_notations_pattern looked_for genv = end | CPatCstr (head, None, pl) -> begin - match drop_syndef top scopes head pl with + match drop_syndef test_kind ?loc scopes head pl with | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c) | None -> Loc.raise ?loc (InternalizationError (NotAConstructor head)) end @@ -1682,37 +1716,37 @@ let drop_notations_pattern looked_for genv = in if expl_pl == [] then (* Convention: (@r) deactivates all further implicit arguments and scopes *) - DAst.make ?loc @@ RCPatCstr (g, List.map (in_pat false scopes) pl, []) + DAst.make ?loc @@ RCPatCstr (g, List.map (in_pat test_kind_inner scopes) pl, []) else (* Convention: (@r expl_pl) deactivates implicit arguments in expl_pl and in pl *) (* but not scopes in expl_pl *) let (argscs1,_) = find_remaining_scopes expl_pl pl g in - DAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, []) + DAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat test_kind_inner scopes) pl, []) | CPatNotation (_,(InConstrEntry,"- _"),([a],[]),[]) when is_non_zero_pat a -> - let p = match a.CAst.v with CPatPrim (Numeral (_, p)) -> p | _ -> assert false in - let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (ensure_kind false loc) (Numeral (SMinus,p)) scopes in + let p = match a.CAst.v with CPatPrim (Number (_, p)) -> p | _ -> assert false in + let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (ensure_kind test_kind_inner) (Number (SMinus,p)) scopes in rcp_of_glob scopes pat | CPatNotation (_,(InConstrEntry,"( _ )"),([a],[]),[]) -> - in_pat top scopes a + in_pat test_kind scopes a | CPatNotation (_,ntn,fullargs,extrargs) -> let ntn,(terms,termlists) = contract_curly_brackets_pat ntn fullargs in let ((ids',c),df) = Notation.interp_notation ?loc ntn scopes in - let (terms,termlists) = split_by_type_pat ?loc ids' (terms,termlists) in + let subst = split_by_type_pat ?loc ids' (terms,termlists) in Dumpglob.dump_notation_location (patntn_loc ?loc fullargs ntn) ntn df; - in_not top loc scopes (terms,termlists) extrargs c + in_not test_kind loc scopes subst extrargs c | CPatDelimiters (key, e) -> - in_pat top (None,find_delimiters_scope ?loc key::snd scopes) e + in_pat test_kind (None,find_delimiters_scope ?loc key::snd scopes) e | CPatPrim p -> - let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (test_kind false) p scopes in + let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc test_kind_inner p scopes in rcp_of_glob scopes pat | CPatAtom (Some id) -> begin - match drop_syndef top scopes id [] with + match drop_syndef test_kind ?loc scopes id [] with | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr (a, b, c) | None -> DAst.make ?loc @@ RCPatAtom (Some ((make ?loc @@ find_pattern_variable id),scopes)) end | CPatAtom None -> DAst.make ?loc @@ RCPatAtom None - | CPatOr pl -> DAst.make ?loc @@ RCPatOr (List.map (in_pat top scopes) pl) + | CPatOr pl -> DAst.make ?loc @@ RCPatOr (List.map (in_pat test_kind scopes) pl) | CPatCast (_,_) -> (* We raise an error if the pattern contains a cast, due to current restrictions on casts in patterns. Cast in patterns @@ -1725,8 +1759,8 @@ let drop_notations_pattern looked_for genv = This check is here and not in the parser because it would require duplicating the levels of the [pattern] rule. *) CErrors.user_err ?loc (Pp.strbrk "Casts are not supported in this pattern.") - and in_pat_sc scopes x = in_pat false (x,snd scopes) - and in_not top loc scopes (subst,substlist as fullsubst) args = function + and in_pat_sc scopes x = in_pat test_kind_inner (x,snd scopes) + and in_not (test_kind:?loc:Loc.t->'a->'b) loc scopes (subst,substlist as fullsubst) args = function | NVar id -> let () = assert (List.is_empty args) in begin @@ -1734,21 +1768,21 @@ let drop_notations_pattern looked_for genv = (* of the notations *) try let (a,(scopt,subscopes)) = Id.Map.find id subst in - in_pat top (scopt,subscopes@snd scopes) a + in_pat test_kind (scopt,subscopes@snd scopes) a with Not_found -> if Id.equal id ldots_var then DAst.make ?loc @@ RCPatAtom (Some ((make ?loc id),scopes)) else anomaly (str "Unbound pattern notation variable: " ++ Id.print id ++ str ".") end | NRef g -> - ensure_kind top loc g; + ensure_kind test_kind ?loc g; let (_,argscs) = find_remaining_scopes [] args g in DAst.make ?loc @@ RCPatCstr (g, [], List.map2 (in_pat_sc scopes) argscs args) | NApp (NRef g,pl) -> - ensure_kind top loc g; + ensure_kind test_kind ?loc g; let (argscs1,argscs2) = find_remaining_scopes pl args g in - let pl = List.map2 (fun x -> in_not false loc (x,snd scopes) fullsubst []) argscs1 pl in + let pl = List.map2 (fun x -> in_not test_kind_inner loc (x,snd scopes) fullsubst []) argscs1 pl in let pl = add_local_defs_and_check_length loc genv g pl args in - let args = List.map2 (fun x -> in_pat false (x,snd scopes)) argscs2 args in + let args = List.map2 (fun x -> in_pat test_kind_inner (x,snd scopes)) argscs2 args in let pat = if List.length pl = 0 then (* Convention: if notation is @f, encoded as NApp(Nref g,[]), then @@ -1763,10 +1797,10 @@ let drop_notations_pattern looked_for genv = (try (* All elements of the list are in scopes (scopt,subscopes) *) let (l,(scopt,subscopes)) = Id.Map.find x substlist in - let termin = in_not top loc scopes fullsubst [] terminator in + let termin = in_not test_kind_inner loc scopes fullsubst [] terminator in List.fold_right (fun a t -> let nsubst = Id.Map.add y (a, (scopt, subscopes)) subst in - let u = in_not false loc scopes (nsubst, substlist) [] iter in + let u = in_not test_kind_inner loc scopes (nsubst, substlist) [] iter in subst_pat_iterator ldots_var t u) (if revert then List.rev l else l) termin with Not_found -> @@ -1775,7 +1809,7 @@ let drop_notations_pattern looked_for genv = let () = assert (List.is_empty args) in DAst.make ?loc @@ RCPatAtom None | t -> error_invalid_pattern_notation ?loc () - in in_pat true + in in_pat test_kind_top env.pat_scopes pat let rec intern_pat genv ntnvars aliases pat = let intern_cstr_with_all_args loc c with_letin idslpl1 pl2 = @@ -1816,19 +1850,30 @@ let rec intern_pat genv ntnvars aliases pat = check_or_pat_variables loc ids (List.tl idsl); (ids,List.flatten pl') -let intern_cases_pattern genv ntnvars scopes aliases pat = +let intern_cases_pattern test_kind genv ntnvars env aliases pat = intern_pat genv ntnvars aliases - (drop_notations_pattern (function GlobRef.ConstructRef _ -> () | _ -> raise Not_found) genv scopes pat) + (drop_notations_pattern (test_kind,test_kind) genv env pat) let _ = intern_cases_pattern_fwd := - fun ntnvars scopes p -> intern_cases_pattern (Global.env ()) ntnvars scopes empty_alias p - -let intern_ind_pattern genv ntnvars scopes pat = + fun test_kind ntnvars env p -> + intern_cases_pattern test_kind (Global.env ()) ntnvars env empty_alias p + +let intern_ind_pattern genv ntnvars env pat = + let test_kind_top ?loc = function + | GlobRef.IndRef _ -> () + | GlobRef.ConstructRef _ | GlobRef.ConstRef _ | GlobRef.VarRef _ -> + (* A non-inductive global reference at top is an error *) + error_invalid_pattern_notation ?loc () in + let test_kind_inner ?loc = function + | GlobRef.ConstructRef _ -> () + | GlobRef.IndRef _ | GlobRef.ConstRef _ | GlobRef.VarRef _ -> + (* A non-constructor global reference deep in a pattern is seen as a variable *) + raise Not_found in let no_not = try - drop_notations_pattern (function (GlobRef.IndRef _ | GlobRef.ConstructRef _) -> () | _ -> raise Not_found) genv scopes pat - with InternalizationError(NotAConstructor _) as exn -> + drop_notations_pattern (test_kind_top,test_kind_inner) genv env pat + with InternalizationError (NotAConstructor _) as exn -> let _, info = Exninfo.capture exn in error_bad_inductive_type ~info () in @@ -2006,8 +2051,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = GLetIn (na.CAst.v, inc1, int, intern_restart_binders (push_name_env ntnvars (impls_term_list 1 inc1) env na) c2) | CNotation (_,(InConstrEntry,"- _"), ([a],[],[],[])) when is_non_zero a -> - let p = match a.CAst.v with CPrim (Numeral (_, p)) -> p | _ -> assert false in - intern env (CAst.make ?loc @@ CPrim (Numeral (SMinus,p))) + let p = match a.CAst.v with CPrim (Number (_, p)) -> p | _ -> assert false in + intern env (CAst.make ?loc @@ CPrim (Number (SMinus,p))) | CNotation (_,(InConstrEntry,"( _ )"),([a],[],[],[])) -> intern env a | CNotation (_,ntn,args) -> let c = intern_notation intern env ntnvars loc ntn args in @@ -2221,7 +2266,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = (* Expands a multiple pattern into a disjunction of multiple patterns *) and intern_multiple_pattern env n pl = - let idsl_pll = List.map (intern_cases_pattern globalenv ntnvars (None,env.scopes) empty_alias) pl in + let env = { pat_ids = None; pat_scopes = (None,env.scopes) } in + let idsl_pll = List.map (intern_cases_pattern test_kind_tolerant globalenv ntnvars env empty_alias) pl in let loc = loc_of_multiple_pattern pl in check_number_of_pattern loc n pl; product_of_cases_patterns empty_alias idsl_pll @@ -2262,7 +2308,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c = let match_td,typ = match t with | Some t -> let with_letin,(ind,ind_ids,alias_subst,l) = - intern_ind_pattern globalenv ntnvars (None,env.scopes) t in + intern_ind_pattern globalenv ntnvars (env_for_pattern (set_type_scope env)) t in let (mib,mip) = Inductive.lookup_mind_specif globalenv ind in let nparams = (List.length (mib.Declarations.mind_params_ctxt)) in (* for "in Vect n", we answer (["n","n"],[(loc,"n")]) @@ -2403,7 +2449,8 @@ let intern_gen kind env sigma let intern_constr env sigma c = intern_gen WithoutTypeConstraint env sigma c let intern_type env sigma c = intern_gen IsType env sigma c let intern_pattern globalenv patt = - intern_cases_pattern globalenv Id.Map.empty (None,[]) empty_alias patt + let env = {pat_ids = None; pat_scopes = (None, [])} in + intern_cases_pattern test_kind_tolerant globalenv Id.Map.empty env empty_alias patt (*********************************************************************) (* Functions to parse and interpret constructions *) @@ -2471,6 +2518,14 @@ let intern_constr_pattern env sigma ?(as_type=false) ?(ltacvars=empty_ltac_sign) ~pattern_mode:true ~ltacvars env sigma c in pattern_of_glob_constr c +let interp_constr_pattern env sigma ?(expected_type=WithoutTypeConstraint) c = + let c = intern_gen expected_type ~pattern_mode:true env sigma c in + let flags = { Pretyping.no_classes_no_fail_inference_flags with expand_evars = false } in + let sigma, c = understand_tcc ~flags env sigma ~expected_type c in + (* FIXME: it is necessary to be unsafe here because of the way we handle + evars in the pretyper. Sometimes they get solved eagerly. *) + pattern_of_constr env sigma (EConstr.Unsafe.to_constr c) + let intern_core kind env sigma ?(pattern_mode=false) ?(ltacvars=empty_ltac_sign) { Genintern.intern_ids = ids; Genintern.notation_variable_status = vl } c = let tmp_scope = scope_of_type_kind env sigma kind in diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 898a3e09c8..11d756803f 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -136,10 +136,16 @@ val interp_type_evars_impls : ?flags:inference_flags -> env -> evar_map -> (** Interprets constr patterns *) +(** Without typing *) val intern_constr_pattern : env -> evar_map -> ?as_type:bool -> ?ltacvars:ltac_sign -> constr_pattern_expr -> patvar list * constr_pattern +(** With typing *) +val interp_constr_pattern : + env -> evar_map -> ?expected_type:typing_constraint -> + constr_pattern_expr -> constr_pattern + (** Raise Not_found if syndef not bound to a name and error if unexisting ref *) val intern_reference : qualid -> GlobRef.t diff --git a/interp/notation.ml b/interp/notation.ml index c150ae7abb..8d05fab63c 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -32,7 +32,7 @@ open NumTok fail if a number has no interpretation in the scope (e.g. there is no interpretation for negative numbers in [nat]); interpreters both for terms and patterns can be set; these interpreters are in permanent table - [numeral_interpreter_tab] + [number_interpreter_tab] - a set of ML printers for expressions denoting numbers parsable in this scope - a set of interpretations for infix (more generally distfix) notations @@ -451,13 +451,13 @@ module InnerPrimToken = struct let do_interp ?loc interp primtok = match primtok, interp with - | Numeral n, RawNumInterp interp -> interp ?loc n - | Numeral n, BigNumInterp interp -> + | Number n, RawNumInterp interp -> interp ?loc n + | Number n, BigNumInterp interp -> (match NumTok.Signed.to_bigint n with | Some n -> interp ?loc n | None -> raise Not_found) | String s, StringInterp interp -> interp ?loc s - | (Numeral _ | String _), + | (Number _ | String _), (RawNumInterp _ | BigNumInterp _ | StringInterp _) -> raise Not_found type uninterpreter = @@ -471,16 +471,16 @@ module InnerPrimToken = struct | StringUninterp f, StringUninterp f' -> f == f' | _ -> false - let mkNumeral n = - Numeral (NumTok.Signed.of_bigint CDec n) + let mkNumber n = + Number (NumTok.Signed.of_bigint CDec n) let mkString = function | None -> None | Some s -> if Unicode.is_utf8 s then Some (String s) else None let do_uninterp uninterp g = match uninterp with - | RawNumUninterp u -> Option.map (fun (s,n) -> Numeral (s,n)) (u g) - | BigNumUninterp u -> Option.map mkNumeral (u g) + | RawNumUninterp u -> Option.map (fun (s,n) -> Number (s,n)) (u g) + | BigNumUninterp u -> Option.map mkNumber (u g) | StringUninterp u -> mkString (u g) end @@ -500,7 +500,7 @@ let prim_token_uninterpreters = (Hashtbl.create 7 : (prim_token_uid, InnerPrimToken.uninterpreter) Hashtbl.t) (*******************************************************) -(* Numeral notation interpretation *) +(* Number notation interpretation *) type prim_token_notation_error = | UnexpectedTerm of Constr.t | UnexpectedNonOptionTerm of Constr.t @@ -524,21 +524,21 @@ type z_pos_ty = { z_ty : Names.inductive; pos_ty : Names.inductive } -type numeral_ty = +type number_ty = { int : int_ty; decimal : Names.inductive; hexadecimal : Names.inductive; - numeral : Names.inductive } + number : Names.inductive } type target_kind = - | Int of int_ty (* Coq.Init.Numeral.int + uint *) - | UInt of int_ty (* Coq.Init.Numeral.uint *) + | Int of int_ty (* Coq.Init.Number.int + uint *) + | UInt of int_ty (* Coq.Init.Number.uint *) | Z of z_pos_ty (* Coq.Numbers.BinNums.Z and positive *) | Int63 (* Coq.Numbers.Cyclic.Int63.Int63.int *) - | Numeral of numeral_ty (* Coq.Init.Numeral.numeral + uint + int *) + | Number of number_ty (* Coq.Init.Number.number + uint + int *) | DecimalInt of int_ty (* Coq.Init.Decimal.int + uint (deprecated) *) | DecimalUInt of int_ty (* Coq.Init.Decimal.uint (deprecated) *) - | Decimal of numeral_ty (* Coq.Init.Decimal.Decimal + uint + int (deprecated) *) + | Decimal of number_ty (* Coq.Init.Decimal.Decimal + uint + int (deprecated) *) type string_target_kind = | ListByte @@ -547,19 +547,36 @@ type string_target_kind = type option_kind = Option | Direct type 'target conversion_kind = 'target * option_kind +(** A postprocessing translation [to_post] can be done after execution + of the [to_ty] interpreter. The reverse translation is performed + before the [of_ty] uninterpreter. + + [to_post] is an array of [n] lists [l_i] of tuples [(f, t, + args)]. When the head symbol of the translated term matches one of + the [f] in the list [l_0] it is replaced by [t] and its arguments + are translated acording to [args] where [ToPostCopy] means that the + argument is kept unchanged and [ToPostAs k] means that the + argument is recursively translated according to [l_k]. + [ToPostHole] introduces an additional implicit argument hole + (in the reverse translation, the corresponding argument is removed). + [ToPostCheck r] behaves as [ToPostCopy] except in the reverse + translation which fails if the copied term is not [r]. + When [n] is null, no translation is performed. *) +type to_post_arg = ToPostCopy | ToPostAs of int | ToPostHole | ToPostCheck of GlobRef.t type ('target, 'warning) prim_token_notation_obj = { to_kind : 'target conversion_kind; to_ty : GlobRef.t; + to_post : ((GlobRef.t * GlobRef.t * to_post_arg list) list) array; of_kind : 'target conversion_kind; of_ty : GlobRef.t; ty_name : Libnames.qualid; (* for warnings / error messages *) warning : 'warning } -type numeral_notation_obj = (target_kind, numnot_option) prim_token_notation_obj +type number_notation_obj = (target_kind, numnot_option) prim_token_notation_obj type string_notation_obj = (string_target_kind, unit) prim_token_notation_obj module PrimTokenNotation = struct -(** * Code shared between Numeral notation and String notation *) +(** * Code shared between Number notation and String notation *) (** Reduction The constr [c] below isn't necessarily well-typed, since we @@ -593,22 +610,69 @@ exception NotAValidPrimToken to [constr] for the subset that concerns us. Note that if you update [constr_of_glob], you should update the - corresponding numeral notation *and* string notation doc in + corresponding number notation *and* string notation doc in doc/sphinx/user-extensions/syntax-extensions.rst that describes what it means for a term to be ground / to be able to be considered for parsing. *) -let rec constr_of_glob env sigma g = match DAst.get g with - | Glob_term.GRef (GlobRef.ConstructRef c, _) -> - let sigma,c = Evd.fresh_constructor_instance env sigma c in - sigma,mkConstructU c - | Glob_term.GRef (GlobRef.IndRef c, _) -> - let sigma,c = Evd.fresh_inductive_instance env sigma c in - sigma,mkIndU c +let constr_of_globref allow_constant env sigma = function + | GlobRef.ConstructRef c -> + let sigma,c = Evd.fresh_constructor_instance env sigma c in + sigma,mkConstructU c + | GlobRef.IndRef c -> + let sigma,c = Evd.fresh_inductive_instance env sigma c in + sigma,mkIndU c + | GlobRef.ConstRef c when allow_constant -> + let sigma,c = Evd.fresh_constant_instance env sigma c in + sigma,mkConstU c + | _ -> raise NotAValidPrimToken + +let rec constr_of_glob allow_constant to_post post env sigma g = match DAst.get g with + | Glob_term.GRef (r, _) -> + let o = List.find_opt (fun (_,r',_) -> GlobRef.equal r r') post in + begin match o with + | None -> constr_of_globref allow_constant env sigma r + | Some (r, _, a) -> + (* [g] is not a GApp so check that [post] + does not expect any actual argument + (i.e., [a] contains only ToPostHole since they mean "ignore arg") *) + if List.exists ((<>) ToPostHole) a then raise NotAValidPrimToken; + constr_of_globref true env sigma r + end | Glob_term.GApp (gc, gcl) -> - let sigma,c = constr_of_glob env sigma gc in - let sigma,cl = List.fold_left_map (constr_of_glob env) sigma gcl in - sigma,mkApp (c, Array.of_list cl) + let o = match DAst.get gc with + | Glob_term.GRef (r, _) -> List.find_opt (fun (_,r',_) -> GlobRef.equal r r') post + | _ -> None in + begin match o with + | None -> + let sigma,c = constr_of_glob allow_constant to_post post env sigma gc in + let sigma,cl = List.fold_left_map (constr_of_glob allow_constant to_post post env) sigma gcl in + sigma,mkApp (c, Array.of_list cl) + | Some (r, _, a) -> + let sigma,c = constr_of_globref true env sigma r in + let rec aux sigma a gcl = match a, gcl with + | [], [] -> sigma,[] + | ToPostCopy :: a, gc :: gcl -> + let sigma,c = constr_of_glob allow_constant [||] [] env sigma gc in + let sigma,cl = aux sigma a gcl in + sigma, c :: cl + | ToPostCheck r :: a, gc :: gcl -> + let () = match DAst.get gc with + | Glob_term.GRef (r', _) when GlobRef.equal r r' -> () + | _ -> raise NotAValidPrimToken in + let sigma,c = constr_of_glob true [||] [] env sigma gc in + let sigma,cl = aux sigma a gcl in + sigma, c :: cl + | ToPostAs i :: a, gc :: gcl -> + let sigma,c = constr_of_glob allow_constant to_post to_post.(i) env sigma gc in + let sigma,cl = aux sigma a gcl in + sigma, c :: cl + | ToPostHole :: post, _ :: gcl -> aux sigma post gcl + | [], _ :: _ | _ :: _, [] -> raise NotAValidPrimToken + in + let sigma,cl = aux sigma a gcl in + sigma,mkApp (c, Array.of_list cl) + end | Glob_term.GInt i -> sigma, mkInt i | Glob_term.GSort gs -> let sigma,c = Evd.fresh_sort_in_family sigma (Glob_ops.glob_sort_family gs) in @@ -616,6 +680,10 @@ let rec constr_of_glob env sigma g = match DAst.get g with | _ -> raise NotAValidPrimToken +let constr_of_glob to_post env sigma (Glob_term.AnyGlobConstr g) = + let post = match to_post with [||] -> [] | _ -> to_post.(0) in + constr_of_glob false to_post post env sigma g + let rec glob_of_constr token_kind ?loc env sigma c = match Constr.kind c with | App (c, ca) -> let c = glob_of_constr token_kind ?loc env sigma c in @@ -637,9 +705,38 @@ let no_such_prim_token uninterpreted_token_kind ?loc ty = (str ("Cannot interpret this "^uninterpreted_token_kind^" as a value of type ") ++ pr_qualid ty) -let interp_option uninterpreted_token_kind token_kind ty ?loc env sigma c = +let rec postprocess token_kind ?loc ty to_post post g = + let g', gl = match DAst.get g with Glob_term.GApp (g, gl) -> g, gl | _ -> g, [] in + let o = + match DAst.get g' with + | Glob_term.GRef (r, None) -> + List.find_opt (fun (r',_,_) -> GlobRef.equal r r') post + | _ -> None in + match o with None -> g | Some (_, r, a) -> + let rec f n a gl = match a, gl with + | [], [] -> [] + | ToPostHole :: a, gl -> + let e = Evar_kinds.ImplicitArg (r, (n, None), true) in + let h = DAst.make ?loc (Glob_term.GHole (e, Namegen.IntroAnonymous, None)) in + h :: f (n+1) a gl + | (ToPostCopy | ToPostCheck _) :: a, g :: gl -> g :: f (n+1) a gl + | ToPostAs c :: a, g :: gl -> + postprocess token_kind ?loc ty to_post to_post.(c) g :: f (n+1) a gl + | [], _::_ | _::_, [] -> + no_such_prim_token token_kind ?loc ty + in + let gl = f 1 a gl in + let g = DAst.make ?loc (Glob_term.GRef (r, None)) in + DAst.make ?loc (Glob_term.GApp (g, gl)) + +let glob_of_constr token_kind ty ?loc env sigma to_post c = + let g = glob_of_constr token_kind ?loc env sigma c in + match to_post with [||] -> g | _ -> + postprocess token_kind ?loc ty to_post to_post.(0) g + +let interp_option uninterpreted_token_kind token_kind ty ?loc env sigma to_post c = match Constr.kind c with - | App (_Some, [| _; c |]) -> glob_of_constr token_kind ?loc env sigma c + | App (_Some, [| _; c |]) -> glob_of_constr token_kind ty ?loc env sigma to_post c | App (_None, [| _ |]) -> no_such_prim_token uninterpreted_token_kind ?loc ty | x -> Loc.raise ?loc (PrimTokenNotationError(token_kind,env,sigma,UnexpectedNonOptionTerm c)) @@ -648,13 +745,13 @@ let uninterp_option c = | App (_Some, [| _; x |]) -> x | _ -> raise NotAValidPrimToken -let uninterp to_raw o (Glob_term.AnyGlobConstr n) = +let uninterp to_raw o n = let env = Global.env () in let sigma = Evd.from_env env in let sigma,of_ty = Evd.fresh_global env sigma o.of_ty in let of_ty = EConstr.Unsafe.to_constr of_ty in try - let sigma,n = constr_of_glob env sigma n in + let sigma,n = constr_of_glob o.to_post env sigma n in let c = eval_constr_app env sigma of_ty n in let c = if snd o.of_kind == Direct then c else uninterp_option c in Some (to_raw (fst o.of_kind, c)) @@ -675,8 +772,8 @@ let rec int63_of_pos_bigint i = (Uint63.mul (Uint63.of_int 2) (int63_of_pos_bigint quo)) else Uint63.mul (Uint63.of_int 2) (int63_of_pos_bigint quo) -module Numeral = struct -(** * Numeral notation *) +module Numbers = struct +(** * Number notation *) open PrimTokenNotation let warn_large_num = @@ -732,7 +829,7 @@ let coqint_of_rawnum inds c (sign,n) = let pos_neg = match sign with SPlus -> 1 | SMinus -> 2 in mkApp (mkConstruct (ind, pos_neg), [|uint|]) -let coqnumeral_of_rawnum inds c n = +let coqnumber_of_rawnum inds c n = let ind = match c with CDec -> inds.decimal | CHex -> inds.hexadecimal in let i, f, e = NumTok.Signed.to_int_frac_and_exponent n in let i = coqint_of_rawnum inds.int c i in @@ -744,19 +841,19 @@ let coqnumeral_of_rawnum inds c n = mkApp (mkConstruct (ind, 2), [|i; f; e|]) (* (D|Hexad)ecimalExp *) let mkDecHex ind c n = match c with - | CDec -> mkApp (mkConstruct (ind, 1), [|n|]) (* (UInt|Int|)Dec *) - | CHex -> mkApp (mkConstruct (ind, 2), [|n|]) (* (UInt|Int|)Hex *) + | CDec -> mkApp (mkConstruct (ind, 1), [|n|]) (* (UInt|Int|)Decimal *) + | CHex -> mkApp (mkConstruct (ind, 2), [|n|]) (* (UInt|Int|)Hexadecimal *) exception NonDecimal -let decimal_coqnumeral_of_rawnum inds n = +let decimal_coqnumber_of_rawnum inds n = if NumTok.Signed.classify n <> CDec then raise NonDecimal; - coqnumeral_of_rawnum inds CDec n + coqnumber_of_rawnum inds CDec n -let coqnumeral_of_rawnum inds n = +let coqnumber_of_rawnum inds n = let c = NumTok.Signed.classify n in - let n = coqnumeral_of_rawnum inds c n in - mkDecHex inds.numeral c n + let n = coqnumber_of_rawnum inds c n in + mkDecHex inds.number c n let decimal_coquint_of_rawnum inds n = if NumTok.UnsignedNat.classify n <> CDec then raise NonDecimal; @@ -806,7 +903,7 @@ let rawnum_of_coqint cl c = | _ -> raise NotAValidPrimToken) | _ -> raise NotAValidPrimToken -let rawnum_of_coqnumeral cl c = +let rawnum_of_coqnumber cl c = let of_ife i f e = let n = rawnum_of_coqint cl i in let f = try Some (rawnum_of_coquint cl f) with NotAValidPrimToken -> None in @@ -820,17 +917,17 @@ let rawnum_of_coqnumeral cl c = let destDecHex c = match Constr.kind c with | App (c,[|c'|]) -> (match Constr.kind c with - | Construct ((_,1), _) (* (UInt|Int|)Dec *) -> CDec, c' - | Construct ((_,2), _) (* (UInt|Int|)Hex *) -> CHex, c' + | Construct ((_,1), _) (* (UInt|Int|)Decimal *) -> CDec, c' + | Construct ((_,2), _) (* (UInt|Int|)Hexadecimal *) -> CHex, c' | _ -> raise NotAValidPrimToken) | _ -> raise NotAValidPrimToken -let decimal_rawnum_of_coqnumeral c = - rawnum_of_coqnumeral CDec c +let decimal_rawnum_of_coqnumber c = + rawnum_of_coqnumber CDec c -let rawnum_of_coqnumeral c = +let rawnum_of_coqnumber c = let cl, c = destDecHex c in - rawnum_of_coqnumeral cl c + rawnum_of_coqnumber cl c let decimal_rawnum_of_coquint c = rawnum_of_coquint CDec c @@ -952,9 +1049,9 @@ let interp o ?loc n = interp_int63 ?loc (NumTok.SignedNat.to_bigint n) | (Int _ | UInt _ | DecimalInt _ | DecimalUInt _ | Z _ | Int63), _ -> no_such_prim_token "number" ?loc o.ty_name - | Numeral numeral_ty, _ -> coqnumeral_of_rawnum numeral_ty n - | Decimal numeral_ty, _ -> - (try decimal_coqnumeral_of_rawnum numeral_ty n + | Number number_ty, _ -> coqnumber_of_rawnum number_ty n + | Decimal number_ty, _ -> + (try decimal_coqnumber_of_rawnum number_ty n with NonDecimal -> no_such_prim_token "number" ?loc o.ty_name) in let env = Global.env () in @@ -964,12 +1061,13 @@ let interp o ?loc n = match o.warning, snd o.to_kind with | Abstract threshold, Direct when NumTok.Signed.is_bigger_int_than n threshold -> warn_abstract_large_num (o.ty_name,o.to_ty); - glob_of_constr "numeral" ?loc env sigma (mkApp (to_ty,[|c|])) + assert (Array.length o.to_post = 0); + glob_of_constr "number" o.ty_name ?loc env sigma o.to_post (mkApp (to_ty,[|c|])) | _ -> let res = eval_constr_app env sigma to_ty c in match snd o.to_kind with - | Direct -> glob_of_constr "numeral" ?loc env sigma res - | Option -> interp_option "number" "numeral" o.ty_name ?loc env sigma res + | Direct -> glob_of_constr "number" o.ty_name ?loc env sigma o.to_post res + | Option -> interp_option "number" "number" o.ty_name ?loc env sigma o.to_post res let uninterp o n = PrimTokenNotation.uninterp @@ -978,10 +1076,10 @@ let uninterp o n = | (UInt _, c) -> NumTok.Signed.of_nat (rawnum_of_coquint c) | (Z _, c) -> NumTok.Signed.of_bigint CDec (bigint_of_z c) | (Int63, c) -> NumTok.Signed.of_bigint CDec (bigint_of_int63 c) - | (Numeral _, c) -> rawnum_of_coqnumeral c + | (Number _, c) -> rawnum_of_coqnumber c | (DecimalInt _, c) -> NumTok.Signed.of_int (decimal_rawnum_of_coqint c) | (DecimalUInt _, c) -> NumTok.Signed.of_nat (decimal_rawnum_of_coquint c) - | (Decimal _, c) -> decimal_rawnum_of_coqnumeral c + | (Decimal _, c) -> decimal_rawnum_of_coqnumber c end o n end @@ -1014,11 +1112,12 @@ let coqbyte_of_string ?loc byte s = let p = if Int.equal (String.length s) 1 then int_of_char s.[0] else - if Int.equal (String.length s) 3 && is_digit s.[0] && is_digit s.[1] && is_digit s.[2] - then int_of_string s - else + let n = + if Int.equal (String.length s) 3 && is_digit s.[0] && is_digit s.[1] && is_digit s.[2] + then int_of_string s else 256 in + if n < 256 then n else user_err ?loc ~hdr:"coqbyte_of_string" - (str "Expects a single character or a three-digits ascii code.") in + (str "Expects a single character or a three-digit ASCII code.") in coqbyte_of_char_code byte p let coqbyte_of_char byte c = coqbyte_of_char_code byte (Char.code c) @@ -1073,8 +1172,8 @@ let interp o ?loc n = let to_ty = EConstr.Unsafe.to_constr to_ty in let res = eval_constr_app env sigma to_ty c in match snd o.to_kind with - | Direct -> glob_of_constr "string" ?loc env sigma res - | Option -> interp_option "string" "string" o.ty_name ?loc env sigma res + | Direct -> glob_of_constr "string" o.ty_name ?loc env sigma o.to_post res + | Option -> interp_option "string" "string" o.ty_name ?loc env sigma o.to_post res let uninterp o n = PrimTokenNotation.uninterp @@ -1086,21 +1185,21 @@ end (* A [prim_token_infos], which is synchronized with the document state, either contains a unique id pointing to an unsynchronized - prim token function, or a numeral notation object describing how to + prim token function, or a number notation object describing how to interpret and uninterpret. We provide [prim_token_infos] because we expect plugins to provide their own interpretation functions, - rather than going through numeral notations, which are available as + rather than going through number notations, which are available as a vernacular. *) type prim_token_interp_info = Uid of prim_token_uid - | NumeralNotation of numeral_notation_obj + | NumberNotation of number_notation_obj | StringNotation of string_notation_obj type prim_token_infos = { pt_local : bool; (** Is this interpretation local? *) pt_scope : scope_name; (** Concerned scope *) - pt_interp_info : prim_token_interp_info; (** Unique id "pointing" to (un)interp functions, OR a numeral notation object describing (un)interp functions *) + pt_interp_info : prim_token_interp_info; (** Unique id "pointing" to (un)interp functions, OR a number notation object describing (un)interp functions *) pt_required : required_module; (** Module that should be loaded first *) pt_refs : GlobRef.t list; (** Entry points during uninterpretation *) pt_in_match : bool (** Is this prim token legal in match patterns ? *) @@ -1124,7 +1223,7 @@ let hashtbl_check_and_set allow_overwrite uid f h eq = | _ -> user_err ~hdr:"prim_token_interpreter" (str "Unique identifier " ++ str uid ++ - str " already used to register a numeral or string (un)interpreter.") + str " already used to register a number or string (un)interpreter.") let register_gen_interpretation allow_overwrite uid (interp, uninterp) = hashtbl_check_and_set @@ -1152,7 +1251,6 @@ let cache_prim_token_interpretation (_,infos) = String.Map.add sc (infos.pt_required,ptii) !prim_token_interp_infos; let add_uninterp r = let l = try GlobRef.Map.find r !prim_token_uninterp_infos with Not_found -> [] in - let l = List.remove_assoc_f String.equal sc l in prim_token_uninterp_infos := GlobRef.Map.add r ((sc,(ptii,infos.pt_in_match)) :: l) !prim_token_uninterp_infos in @@ -1225,7 +1323,7 @@ let check_required_module ?loc sc (sp,d) = (str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".") -(* Look if some notation or numeral printer in [scope] can be used in +(* Look if some notation or number printer in [scope] can be used in the scope stack [scopes], and if yes, using delimiters or not *) let find_with_delimiters = function @@ -1242,7 +1340,7 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function | NotationInScope scope' when String.equal scope scope' -> Some (None,None) | _ -> - (* If the most recently open scope has a notation/numeral printer + (* If the most recently open scope has a notation/number printer but not the expected one then we need delimiters *) if find scope then find_with_delimiters ntn_scope @@ -1380,8 +1478,8 @@ let find_notation ntn sc = | _ -> raise Not_found let notation_of_prim_token = function - | Constrexpr.Numeral (SPlus,n) -> InConstrEntry, NumTok.Unsigned.sprint n - | Constrexpr.Numeral (SMinus,n) -> InConstrEntry, "- "^NumTok.Unsigned.sprint n + | Constrexpr.Number (SPlus,n) -> InConstrEntry, NumTok.Unsigned.sprint n + | Constrexpr.Number (SMinus,n) -> InConstrEntry, "- "^NumTok.Unsigned.sprint n | String _ -> raise Not_found let find_prim_token check_allowed ?loc p sc = @@ -1399,7 +1497,7 @@ let find_prim_token check_allowed ?loc p sc = check_required_module ?loc sc spdir; let interp = match info with | Uid uid -> Hashtbl.find prim_token_interpreters uid - | NumeralNotation o -> InnerPrimToken.RawNumInterp (Numeral.interp o) + | NumberNotation o -> InnerPrimToken.RawNumInterp (Numbers.interp o) | StringNotation o -> InnerPrimToken.StringInterp (Strings.interp o) in let pat = InnerPrimToken.do_interp ?loc interp p in @@ -1416,8 +1514,8 @@ let interp_prim_token_gen ?loc g p local_scopes = let _, info = Exninfo.capture exn in user_err ?loc ~info ~hdr:"interp_prim_token" ((match p with - | Numeral _ -> - str "No interpretation for numeral " ++ pr_notation (notation_of_prim_token p) + | Number _ -> + str "No interpretation for number " ++ pr_notation (notation_of_prim_token p) | String s -> str "No interpretation for string " ++ qs s) ++ str ".") let interp_prim_token ?loc = @@ -1667,14 +1765,14 @@ let availability_of_prim_token n printer_scope local_scopes = let uid = snd (String.Map.find scope !prim_token_interp_infos) in let open InnerPrimToken in match n, uid with - | Constrexpr.Numeral _, NumeralNotation _ -> true - | _, NumeralNotation _ -> false + | Constrexpr.Number _, NumberNotation _ -> true + | _, NumberNotation _ -> false | String _, StringNotation _ -> true | _, StringNotation _ -> false | _, Uid uid -> let interp = Hashtbl.find prim_token_interpreters uid in match n, interp with - | Constrexpr.Numeral _, (RawNumInterp _ | BigNumInterp _) -> true + | Constrexpr.Number _, (RawNumInterp _ | BigNumInterp _) -> true | String _, StringInterp _ -> true | _ -> false with Not_found -> false @@ -1689,7 +1787,7 @@ let rec find_uninterpretation need_delim def find = function def | OpenScopeItem scope :: scopes -> (try find need_delim scope - with Not_found -> find_uninterpretation need_delim def find scopes) (* TODO: here we should also update the need_delim list with all regular notations in scope [scope] that could shadow a numeral notation *) + with Not_found -> find_uninterpretation need_delim def find scopes) (* TODO: here we should also update the need_delim list with all regular notations in scope [scope] that could shadow a number notation *) | LonelyNotationItem ntn::scopes -> find_uninterpretation (ntn::need_delim) def find scopes @@ -1701,7 +1799,7 @@ let uninterp_prim_token c local_scopes = try let uninterp = match info with | Uid uid -> Hashtbl.find prim_token_uninterpreters uid - | NumeralNotation o -> InnerPrimToken.RawNumUninterp (Numeral.uninterp o) + | NumberNotation o -> InnerPrimToken.RawNumUninterp (Numbers.uninterp o) | StringNotation o -> InnerPrimToken.StringUninterp (Strings.uninterp o) in match InnerPrimToken.do_uninterp uninterp (AnyGlobConstr c) with diff --git a/interp/notation.mli b/interp/notation.mli index 4d6d640a2d..b8939ff87b 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -74,7 +74,7 @@ val find_delimiters_scope : ?loc:Loc.t -> delimiters -> scope_name (** {6 Declare and uses back and forth an interpretation of primitive token } *) -(** A numeral interpreter is the pair of an interpreter for **(hexa)decimal** +(** A number interpreter is the pair of an interpreter for **(hexa)decimal** numbers in terms and an optional interpreter in pattern, if non integer or negative numbers are not supported, the interpreter must fail with an appropriate error message *) @@ -84,7 +84,7 @@ type required_module = full_path * string list type rawnum = NumTok.Signed.t (** The unique id string below will be used to refer to a particular - registered interpreter/uninterpreter of numeral or string notation. + registered interpreter/uninterpreter of number or string notation. Using the same uid for different (un)interpreters will fail. If at most one interpretation of prim token is used per scope, then the scope name could be used as unique id. *) @@ -106,7 +106,7 @@ val register_bignumeral_interpretation : val register_string_interpretation : ?allow_overwrite:bool -> prim_token_uid -> string prim_token_interpretation -> unit -(** * Numeral notation *) +(** * Number notation *) type prim_token_notation_error = | UnexpectedTerm of Constr.t @@ -131,21 +131,21 @@ type z_pos_ty = { z_ty : Names.inductive; pos_ty : Names.inductive } -type numeral_ty = +type number_ty = { int : int_ty; decimal : Names.inductive; hexadecimal : Names.inductive; - numeral : Names.inductive } + number : Names.inductive } type target_kind = - | Int of int_ty (* Coq.Init.Numeral.int + uint *) - | UInt of int_ty (* Coq.Init.Numeral.uint *) + | Int of int_ty (* Coq.Init.Number.int + uint *) + | UInt of int_ty (* Coq.Init.Number.uint *) | Z of z_pos_ty (* Coq.Numbers.BinNums.Z and positive *) | Int63 (* Coq.Numbers.Cyclic.Int63.Int63.int *) - | Numeral of numeral_ty (* Coq.Init.Numeral.numeral + uint + int *) + | Number of number_ty (* Coq.Init.Number.number + uint + int *) | DecimalInt of int_ty (* Coq.Init.Decimal.int + uint (deprecated) *) | DecimalUInt of int_ty (* Coq.Init.Decimal.uint (deprecated) *) - | Decimal of numeral_ty (* Coq.Init.Decimal.Decimal + uint + int (deprecated) *) + | Decimal of number_ty (* Coq.Init.Decimal.Decimal + uint + int (deprecated) *) type string_target_kind = | ListByte @@ -154,26 +154,43 @@ type string_target_kind = type option_kind = Option | Direct type 'target conversion_kind = 'target * option_kind +(** A postprocessing translation [to_post] can be done after execution + of the [to_ty] interpreter. The reverse translation is performed + before the [of_ty] uninterpreter. + + [to_post] is an array of [n] lists [l_i] of tuples [(f, t, + args)]. When the head symbol of the translated term matches one of + the [f] in the list [l_0] it is replaced by [t] and its arguments + are translated acording to [args] where [ToPostCopy] means that the + argument is kept unchanged and [ToPostAs k] means that the + argument is recursively translated according to [l_k]. + [ToPostHole] introduces an additional implicit argument hole + (in the reverse translation, the corresponding argument is removed). + [ToPostCheck r] behaves as [ToPostCopy] except in the reverse + translation which fails if the copied term is not [r]. + When [n] is null, no translation is performed. *) +type to_post_arg = ToPostCopy | ToPostAs of int | ToPostHole | ToPostCheck of GlobRef.t type ('target, 'warning) prim_token_notation_obj = { to_kind : 'target conversion_kind; to_ty : GlobRef.t; + to_post : ((GlobRef.t * GlobRef.t * to_post_arg list) list) array; of_kind : 'target conversion_kind; of_ty : GlobRef.t; ty_name : Libnames.qualid; (* for warnings / error messages *) warning : 'warning } -type numeral_notation_obj = (target_kind, numnot_option) prim_token_notation_obj +type number_notation_obj = (target_kind, numnot_option) prim_token_notation_obj type string_notation_obj = (string_target_kind, unit) prim_token_notation_obj type prim_token_interp_info = Uid of prim_token_uid - | NumeralNotation of numeral_notation_obj + | NumberNotation of number_notation_obj | StringNotation of string_notation_obj type prim_token_infos = { pt_local : bool; (** Is this interpretation local? *) pt_scope : scope_name; (** Concerned scope *) - pt_interp_info : prim_token_interp_info; (** Unique id "pointing" to (un)interp functions, OR a numeral notation object describing (un)interp functions *) + pt_interp_info : prim_token_interp_info; (** Unique id "pointing" to (un)interp functions, OR a number notation object describing (un)interp functions *) pt_required : required_module; (** Module that should be loaded first *) pt_refs : GlobRef.t list; (** Entry points during uninterpretation *) pt_in_match : bool (** Is this prim token legal in match patterns ? *) diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 24b5dfce29..2e3fa0aa0e 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -941,7 +941,7 @@ let bind_term_as_binding_env alp (terms,termlists,binders,binderlists as sigma) try (* If already bound to a term, unify the binder and the term *) match DAst.get (Id.List.assoc var terms) with - | GVar id' -> + | GVar id' | GRef (GlobRef.VarRef id',None) -> (if not (Id.equal id id') then (fst alp,(id,id')::snd alp) else alp), sigma | t -> @@ -1147,16 +1147,22 @@ let does_not_come_from_already_eta_expanded_var glob = (* checked). *) match DAst.get glob with GVar _ -> false | _ -> true +let is_var_term = function + (* The kind of expressions allowed to be both a term and a binding variable *) + | GVar _ -> true + | GRef (GlobRef.VarRef _,None) -> true + | _ -> false + let rec match_ inner u alp metas sigma a1 a2 = let open CAst in let loc = a1.loc in match DAst.get a1, a2 with (* Matching notation variable *) | r1, NVar id2 when is_term_meta id2 metas -> bind_term_env alp sigma id2 a1 - | GVar _, NVar id2 when is_onlybinding_pattern_like_meta true id2 metas -> bind_binding_as_term_env alp sigma id2 a1 + | r1, NVar id2 when is_var_term r1 && is_onlybinding_pattern_like_meta true id2 metas -> bind_binding_as_term_env alp sigma id2 a1 | r1, NVar id2 when is_onlybinding_pattern_like_meta false id2 metas -> bind_binding_as_term_env alp sigma id2 a1 - | GVar _, NVar id2 when is_onlybinding_strict_meta id2 metas -> raise No_match - | GVar _, NVar id2 when is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 a1 + | r1, NVar id2 when is_var_term r1 && is_onlybinding_strict_meta id2 metas -> raise No_match + | r1, NVar id2 when is_var_term r1 && is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 a1 | r1, NVar id2 when is_bindinglist_meta id2 metas -> bind_term_env alp sigma id2 a1 (* Matching recursive notations for terms *) diff --git a/interp/numTok.mli b/interp/numTok.mli index bcfe663dd2..386a25f042 100644 --- a/interp/numTok.mli +++ b/interp/numTok.mli @@ -8,20 +8,20 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -(** Numerals in different forms: signed or unsigned, possibly with +(** Numbers in different forms: signed or unsigned, possibly with fractional part and exponent. - Numerals are represented using raw strings of (hexa)decimal + Numbers are represented using raw strings of (hexa)decimal literals and a separate sign flag. Note that this representation is not unique, due to possible multiple leading or trailing zeros, and -0 = +0, for instances. - The reason to keep the numeral exactly as it was parsed is that - specific notations can be declared for specific numerals + The reason to keep the number exactly as it was parsed is that + specific notations can be declared for specific numbers (e.g. [Notation "0" := False], or [Notation "00" := (nil,nil)], or [Notation "2e1" := ...]). Those notations override the generic - interpretation as numeral. So, one has to record the form of the - numeral which exactly matches the notation. *) + interpretation as number. So, one has to record the form of the + number which exactly matches the notation. *) type sign = SPlus | SMinus @@ -44,7 +44,7 @@ sig val sprint : t -> string val print : t -> Pp.t - (** [sprint] and [print] returns the numeral as it was parsed, for printing *) + (** [sprint] and [print] returns the number as it was parsed, for printing *) val classify : t -> num_class @@ -69,7 +69,7 @@ sig val to_bigint : t -> Z.t end -(** {6 Unsigned decimal numerals } *) +(** {6 Unsigned decimal numbers } *) module Unsigned : sig @@ -80,12 +80,12 @@ sig val sprint : t -> string val print : t -> Pp.t - (** [sprint] and [print] returns the numeral as it was parsed, for printing *) + (** [sprint] and [print] returns the number as it was parsed, for printing *) val parse : char Stream.t -> t - (** Parse a positive Coq numeral. + (** Parse a positive Coq number. Precondition: the first char on the stream is already known to be a digit (\[0-9\]). - Precondition: at least two extra chars after the numeral to parse. + Precondition: at least two extra chars after the number to parse. The recognized syntax is: - integer part: \[0-9\]\[0-9_\]* @@ -97,13 +97,13 @@ sig - exponent part: empty or \[pP\]\[+-\]?\[0-9\]\[0-9_\]* *) val parse_string : string -> t option - (** Parse the string as a non negative Coq numeral, if possible *) + (** Parse the string as a non negative Coq number, if possible *) val classify : t -> num_class end -(** {6 Signed decimal numerals } *) +(** {6 Signed decimal numbers } *) module Signed : sig @@ -117,10 +117,10 @@ sig val sprint : t -> string val print : t -> Pp.t - (** [sprint] and [print] returns the numeral as it was parsed, for printing *) + (** [sprint] and [print] returns the number as it was parsed, for printing *) val parse_string : string -> t option - (** Parse the string as a signed Coq numeral, if possible *) + (** Parse the string as a signed Coq number, if possible *) val of_int_string : string -> t (** Convert from a string in the syntax of OCaml's int/int64 *) diff --git a/interp/smartlocate.ml b/interp/smartlocate.ml index 33d8aa6064..46baa00c74 100644 --- a/interp/smartlocate.ml +++ b/interp/smartlocate.ml @@ -50,6 +50,16 @@ let locate_global_with_alias ?(head=false) qid = user_err ?loc:qid.CAst.loc (pr_qualid qid ++ str " is bound to a notation that does not denote a reference.") +let global_constant_with_alias qid = + try match locate_global_with_alias qid with + | Names.GlobRef.ConstRef c -> c + | ref -> + user_err ?loc:qid.CAst.loc ~hdr:"global_inductive" + (pr_qualid qid ++ spc () ++ str "is not a reference to a constant.") + with Not_found as exn -> + let _, info = Exninfo.capture exn in + Nametab.error_global_not_found ~info qid + let global_inductive_with_alias qid = try match locate_global_with_alias qid with | Names.GlobRef.IndRef ind -> ind @@ -60,6 +70,16 @@ let global_inductive_with_alias qid = let _, info = Exninfo.capture exn in Nametab.error_global_not_found ~info qid +let global_constructor_with_alias qid = + try match locate_global_with_alias qid with + | Names.GlobRef.ConstructRef c -> c + | ref -> + user_err ?loc:qid.CAst.loc ~hdr:"global_inductive" + (pr_qualid qid ++ spc () ++ str "is not a constructor of an inductive type.") + with Not_found as exn -> + let _, info = Exninfo.capture exn in + Nametab.error_global_not_found ~info qid + let global_with_alias ?head qid = try locate_global_with_alias ?head qid with Not_found as exn -> @@ -72,9 +92,17 @@ let smart_global ?(head = false) = let open Constrexpr in CAst.with_loc_val (fun | ByNotation (ntn,sc) -> Notation.interp_notation_as_global_reference ?loc ~head (fun _ -> true) ntn sc) -let smart_global_inductive = let open Constrexpr in CAst.with_loc_val (fun ?loc -> function - | AN r -> - global_inductive_with_alias r +let smart_global_kind f dest is = let open Constrexpr in CAst.with_loc_val (fun ?loc -> function + | AN r -> f r | ByNotation (ntn,sc) -> - destIndRef - (Notation.interp_notation_as_global_reference ?loc ~head:false isIndRef ntn sc)) + dest + (Notation.interp_notation_as_global_reference ?loc ~head:false is ntn sc)) + +let smart_global_constant = + smart_global_kind global_constant_with_alias destConstRef isConstRef + +let smart_global_inductive = + smart_global_kind global_inductive_with_alias destIndRef isIndRef + +let smart_global_constructor = + smart_global_kind global_constructor_with_alias destConstructRef isConstructRef diff --git a/interp/smartlocate.mli b/interp/smartlocate.mli index 9b24a62086..26f2a4f36d 100644 --- a/interp/smartlocate.mli +++ b/interp/smartlocate.mli @@ -28,11 +28,23 @@ val global_of_extended_global : extended_global_reference -> GlobRef.t a reference. *) val global_with_alias : ?head:bool -> qualid -> GlobRef.t +(** The same for constants *) +val global_constant_with_alias : qualid -> Constant.t + (** The same for inductive types *) val global_inductive_with_alias : qualid -> inductive +(** The same for constructors of an inductive type *) +val global_constructor_with_alias : qualid -> constructor + (** Locate a reference taking into account notations and "aliases" *) val smart_global : ?head:bool -> qualid Constrexpr.or_by_notation -> GlobRef.t +(** The same for constants *) +val smart_global_constant : qualid Constrexpr.or_by_notation -> Constant.t + (** The same for inductive types *) val smart_global_inductive : qualid Constrexpr.or_by_notation -> inductive + +(** The same for constructors of an inductive type *) +val smart_global_constructor : qualid Constrexpr.or_by_notation -> constructor diff --git a/parsing/cLexer.ml b/parsing/cLexer.ml index f485970eec..d8d2f2a2ef 100644 --- a/parsing/cLexer.ml +++ b/parsing/cLexer.ml @@ -823,7 +823,7 @@ let token_text : type c. c Tok.p -> string = function | PKEYWORD t -> "'" ^ t ^ "'" | PIDENT None -> "identifier" | PIDENT (Some t) -> "'" ^ t ^ "'" - | PNUMBER None -> "numeral" + | PNUMBER None -> "number" | PNUMBER (Some n) -> "'" ^ NumTok.Unsigned.sprint n ^ "'" | PSTRING None -> "string" | PSTRING (Some s) -> "STRING \"" ^ s ^ "\"" @@ -916,7 +916,7 @@ let terminal s = if is_ident_not_keyword s then PIDENT (Some s) else PKEYWORD s -(* Precondition: the input is a numeral (c.f. [NumTok.t]) *) -let terminal_numeral s = match NumTok.Unsigned.parse_string s with +(* Precondition: the input is a number (c.f. [NumTok.t]) *) +let terminal_number s = match NumTok.Unsigned.parse_string s with | Some n -> PNUMBER (Some n) - | None -> failwith "numeral token expected." + | None -> failwith "number token expected." diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli index ac2c5bcfe2..af4b7ba334 100644 --- a/parsing/cLexer.mli +++ b/parsing/cLexer.mli @@ -49,8 +49,8 @@ val check_keyword : string -> unit (** When string is not an ident, returns a keyword. *) val terminal : string -> string Tok.p -(** Precondition: the input is a numeral (c.f. [NumTok.t]) *) -val terminal_numeral : string -> NumTok.Unsigned.t Tok.p +(** Precondition: the input is a number (c.f. [NumTok.t]) *) +val terminal_number : string -> NumTok.Unsigned.t Tok.p (** The lexer of Coq: *) diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index 349e14bba3..67a061175a 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -173,10 +173,10 @@ GRAMMAR EXTEND Gram [ c = atomic_constr -> { c } | c = term_match -> { c } | "("; c = term LEVEL "200"; ")" -> - { (* Preserve parentheses around numerals so that constrintern does not - collapse -(3) into the numeral -3. *) + { (* Preserve parentheses around numbers so that constrintern does not + collapse -(3) into the number -3. *) (match c.CAst.v with - | CPrim (Numeral (NumTok.SPlus,n)) -> + | CPrim (Number (NumTok.SPlus,n)) -> CAst.make ~loc @@ CNotation(None,(InConstrEntry,"( _ )"),([c],[],[],[])) | _ -> c) } | "{|"; c = record_declaration; bar_cbrace -> { c } @@ -258,7 +258,7 @@ GRAMMAR EXTEND Gram atomic_constr: [ [ g = global; i = univ_annot -> { CAst.make ~loc @@ CRef (g,i) } | s = sort -> { CAst.make ~loc @@ CSort s } - | n = NUMBER-> { CAst.make ~loc @@ CPrim (Numeral (NumTok.SPlus,n)) } + | n = NUMBER-> { CAst.make ~loc @@ CPrim (Number (NumTok.SPlus,n)) } | s = string -> { CAst.make ~loc @@ CPrim (String s) } | "_" -> { CAst.make ~loc @@ CHole (None, IntroAnonymous, None) } | "?"; "["; id = identref; "]" -> { CAst.make ~loc @@ CHole (None, IntroIdentifier id.CAst.v, None) } @@ -362,15 +362,15 @@ GRAMMAR EXTEND Gram | "{|"; pat = record_patterns; bar_cbrace -> { CAst.make ~loc @@ CPatRecord pat } | "_" -> { CAst.make ~loc @@ CPatAtom None } | "("; p = pattern LEVEL "200"; ")" -> - { (* Preserve parentheses around numerals so that constrintern does not - collapse -(3) into the numeral -3. *) + { (* Preserve parentheses around numbers so that constrintern does not + collapse -(3) into the number -3. *) match p.CAst.v with - | CPatPrim (Numeral (NumTok.SPlus,n)) -> + | CPatPrim (Number (NumTok.SPlus,n)) -> CAst.make ~loc @@ CPatNotation(None,(InConstrEntry,"( _ )"),([p],[]),[]) | _ -> p } | "("; p = pattern LEVEL "200"; "|" ; pl = LIST1 pattern LEVEL "200" SEP "|"; ")" -> { CAst.make ~loc @@ CPatOr (p::pl) } - | n = NUMBER-> { CAst.make ~loc @@ CPatPrim (Numeral (NumTok.SPlus,n)) } + | n = NUMBER-> { CAst.make ~loc @@ CPatPrim (Number (NumTok.SPlus,n)) } | s = string -> { CAst.make ~loc @@ CPatPrim (String s) } ] ] ; fixannot: diff --git a/plugins/ltac/g_rewrite.mlg b/plugins/ltac/g_rewrite.mlg index ee94fd565a..a3f03b5bb5 100644 --- a/plugins/ltac/g_rewrite.mlg +++ b/plugins/ltac/g_rewrite.mlg @@ -67,12 +67,12 @@ END { type raw_strategy = (constr_expr, Tacexpr.raw_red_expr) strategy_ast -type glob_strategy = (glob_constr_and_expr, Tacexpr.raw_red_expr) strategy_ast +type glob_strategy = (glob_constr_and_expr, Tacexpr.glob_red_expr) strategy_ast let interp_strategy ist gl s = let sigma = project gl in - sigma, strategy_of_ast s -let glob_strategy ist s = map_strategy (Tacintern.intern_constr ist) (fun c -> c) s + sigma, strategy_of_ast ist s +let glob_strategy ist s = map_strategy (Tacintern.intern_constr ist) (Tacintern.intern_red_expr ist) s let subst_strategy s str = str let pr_strategy _ _ _ (s : strategy) = Pp.str "<strategy>" @@ -80,12 +80,9 @@ let pr_raw_strategy env sigma prc prlc _ (s : raw_strategy) = let prr = Pptactic.pr_red_expr env sigma (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_qualid, prc) in Rewrite.pr_strategy (prc env sigma) prr s let pr_glob_strategy env sigma prc prlc _ (s : glob_strategy) = - let prr = Pptactic.pr_red_expr env sigma - (Ppconstr.pr_constr_expr, - Ppconstr.pr_lconstr_expr, - Pputils.pr_or_by_notation Libnames.pr_qualid, - Ppconstr.pr_constr_expr) - in + let prpat env sigma (_,c,_) = prc env sigma c in + let prcst = Pputils.pr_or_var Pptactic.(pr_and_short_name (pr_evaluable_reference_env env)) in + let prr = Pptactic.pr_red_expr env sigma (prc, prlc, prcst, prpat) in Rewrite.pr_strategy (prc env sigma) prr s } @@ -130,15 +127,15 @@ END { let db_strat db = StratUnary (Topdown, StratHints (false, db)) -let cl_rewrite_clause_db db = cl_rewrite_clause_strat (strategy_of_ast (db_strat db)) +let cl_rewrite_clause_db ist db = cl_rewrite_clause_strat (strategy_of_ast ist (db_strat db)) } TACTIC EXTEND rewrite_strat | [ "rewrite_strat" rewstrategy(s) "in" hyp(id) ] -> { cl_rewrite_clause_strat s (Some id) } | [ "rewrite_strat" rewstrategy(s) ] -> { cl_rewrite_clause_strat s None } -| [ "rewrite_db" preident(db) "in" hyp(id) ] -> { cl_rewrite_clause_db db (Some id) } -| [ "rewrite_db" preident(db) ] -> { cl_rewrite_clause_db db None } +| [ "rewrite_db" preident(db) "in" hyp(id) ] -> { cl_rewrite_clause_db ist db (Some id) } +| [ "rewrite_db" preident(db) ] -> { cl_rewrite_clause_db ist db None } END { diff --git a/plugins/ltac/g_tactic.mlg b/plugins/ltac/g_tactic.mlg index 97d75261c5..ecfe6c1664 100644 --- a/plugins/ltac/g_tactic.mlg +++ b/plugins/ltac/g_tactic.mlg @@ -121,8 +121,8 @@ let destruction_arg_of_constr (c,lbind as clbind) = match lbind with end | _ -> ElimOnConstr clbind -let mkNumeral n = - Numeral (NumTok.Signed.of_int_string (string_of_int n)) +let mkNumber n = + Number (NumTok.Signed.of_int_string (string_of_int n)) let mkTacCase with_evar = function | [(clear,ElimOnConstr cl),(None,None),None],None -> @@ -130,7 +130,7 @@ let mkTacCase with_evar = function (* Reinterpret numbers as a notation for terms *) | [(clear,ElimOnAnonHyp n),(None,None),None],None -> TacCase (with_evar, - (clear,(CAst.make @@ CPrim (mkNumeral n), + (clear,(CAst.make @@ CPrim (mkNumber n), NoBindings))) (* Reinterpret ident as notations for variables in the context *) (* because we don't know if they are quantified or not *) diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml index 87da304330..edd56ee0f7 100644 --- a/plugins/ltac/pptactic.ml +++ b/plugins/ltac/pptactic.ml @@ -1135,8 +1135,8 @@ let pr_goal_selector ~toplevel s = pr_dconstr = (fun env sigma -> pr_and_constr_expr (pr_glob_constr_env env)); pr_lconstr = (fun env sigma -> pr_and_constr_expr (pr_lglob_constr_env env)); pr_pattern = (fun env sigma -> pr_pat_and_constr_expr (pr_glob_constr_env env)); - pr_lpattern = (fun env sigma -> pr_pat_and_constr_expr (pr_lglob_constr_env env)); pr_constant = pr_or_var (pr_and_short_name (pr_evaluable_reference_env env)); + pr_lpattern = (fun env sigma -> pr_pat_and_constr_expr (pr_lglob_constr_env env)); pr_reference = pr_ltac_or_var (pr_located pr_ltac_constant); pr_name = pr_lident; pr_generic = Pputils.pr_glb_generic; diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index a1970cbce2..26e2b18a02 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -1638,9 +1638,9 @@ let cl_rewrite_clause l left2right occs clause = let cl_rewrite_clause_strat strat clause = cl_rewrite_clause_strat false strat clause -let apply_glob_constr c l2r occs = (); fun ({ state = () ; env = env } as input) -> +let apply_glob_constr ist c l2r occs = (); fun ({ state = () ; env = env } as input) -> let c sigma = - let (sigma, c) = Pretyping.understand_tcc env sigma c in + let (sigma, c) = Tacinterp.interp_open_constr ist env sigma c in (sigma, (c, NoBindings)) in let flags = general_rewrite_unif_flags () in @@ -1717,12 +1717,12 @@ let rec pr_strategy prc prr = function | StratEval r -> str "eval" ++ spc () ++ prr r | StratFold c -> str "fold" ++ spc () ++ prc c -let rec strategy_of_ast = function +let rec strategy_of_ast ist = function | StratId -> Strategies.id | StratFail -> Strategies.fail | StratRefl -> Strategies.refl | StratUnary (f, s) -> - let s' = strategy_of_ast s in + let s' = strategy_of_ast ist s in let f' = match f with | Subterms -> all_subterms | Subterm -> one_subterm @@ -1736,13 +1736,13 @@ let rec strategy_of_ast = function | Repeat -> Strategies.repeat in f' s' | StratBinary (f, s, t) -> - let s' = strategy_of_ast s in - let t' = strategy_of_ast t in + let s' = strategy_of_ast ist s in + let t' = strategy_of_ast ist t in let f' = match f with | Compose -> Strategies.seq | Choice -> Strategies.choice in f' s' t' - | StratConstr (c, b) -> { strategy = apply_glob_constr (fst c) b AllOccurrences } + | StratConstr (c, b) -> { strategy = apply_glob_constr ist c b AllOccurrences } | StratHints (old, id) -> if old then Strategies.old_hints id else Strategies.hints id | StratTerms l -> { strategy = (fun ({ state = () ; env } as input) -> @@ -1751,7 +1751,7 @@ let rec strategy_of_ast = function } | StratEval r -> { strategy = (fun ({ state = () ; env ; evars } as input) -> - let (sigma,r_interp) = Tacinterp.interp_redexp env (goalevars evars) r in + let (sigma,r_interp) = Tacinterp.interp_red_expr ist env (goalevars evars) r in (Strategies.reduce r_interp).strategy { input with evars = (sigma,cstrevars evars) }) } | StratFold c -> Strategies.fold_glob (fst c) diff --git a/plugins/ltac/rewrite.mli b/plugins/ltac/rewrite.mli index 60a66dd861..8e0ce183c2 100644 --- a/plugins/ltac/rewrite.mli +++ b/plugins/ltac/rewrite.mli @@ -62,7 +62,7 @@ type rewrite_result = type strategy -val strategy_of_ast : (glob_constr_and_expr, raw_red_expr) strategy_ast -> strategy +val strategy_of_ast : interp_sign -> (glob_constr_and_expr, glob_red_expr) strategy_ast -> strategy val map_strategy : ('a -> 'b) -> ('c -> 'd) -> ('a, 'c) strategy_ast -> ('b, 'd) strategy_ast diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli index fe3079198c..a74f4592f7 100644 --- a/plugins/ltac/tacinterp.mli +++ b/plugins/ltac/tacinterp.mli @@ -77,6 +77,9 @@ val val_interp : interp_sign -> glob_tactic_expr -> (value -> unit Proofview.tac val interp_ltac_constr : interp_sign -> glob_tactic_expr -> (constr -> unit Proofview.tactic) -> unit Proofview.tactic (** Interprets redexp arguments *) +val interp_red_expr : interp_sign -> Environ.env -> Evd.evar_map -> glob_red_expr -> Evd.evar_map * red_expr + +(** Interprets redexp arguments from a raw one *) val interp_redexp : Environ.env -> Evd.evar_map -> raw_red_expr -> Evd.evar_map * red_expr (** Interprets tactic expressions *) diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg index 35fecfb0a5..ccdf5fa68e 100644 --- a/plugins/ssr/ssrparser.mlg +++ b/plugins/ssr/ssrparser.mlg @@ -350,7 +350,7 @@ let interp_index ist gl idx = | Some c -> let rc = Detyping.detype Detyping.Now false Id.Set.empty (pf_env gl) (project gl) c in begin match Notation.uninterp_prim_token rc (None, []) with - | Constrexpr.Numeral n, _ when NumTok.Signed.is_int n -> + | Constrexpr.Number n, _ when NumTok.Signed.is_int n -> int_of_string (NumTok.Signed.to_string n) | _ -> raise Not_found end diff --git a/plugins/ssr/ssrvernac.mlg b/plugins/ssr/ssrvernac.mlg index a49a5e8b28..99cf197b78 100644 --- a/plugins/ssr/ssrvernac.mlg +++ b/plugins/ssr/ssrvernac.mlg @@ -304,21 +304,6 @@ END { - let warn_search_moved_enabled = ref true - let warn_search_moved = CWarnings.create ~name:"ssr-search-moved" - ~category:"deprecated" ~default:CWarnings.Enabled - (fun () -> - (Pp.strbrk - "In previous versions of Coq, loading SSReflect had the effect of \ - replacing the built-in 'Search' command with an SSReflect version \ - of that command. \ - Coq's own search feature was still available via 'SearchAbout' \ - (but that alias is deprecated). \ - This replacement no longer happens; now 'Search' calls Coq's own search \ - feature even when SSReflect is loaded. \ - If you want to use SSReflect's deprecated Search command \ - instead of the built-in one, please Require the ssrsearch module.")) - open G_vernac } @@ -328,7 +313,6 @@ GRAMMAR EXTEND Gram query_command: [ [ IDENT "Search"; s = search_query; l = search_queries; "." -> { let (sl,m) = l in - if !warn_search_moved_enabled then warn_search_moved (); fun g -> Vernacexpr.VernacSearch (Vernacexpr.Search (s::sl),g, m) } ] ] diff --git a/plugins/ssr/ssrvernac.mli b/plugins/ssr/ssrvernac.mli index 93339313f0..327a2d4660 100644 --- a/plugins/ssr/ssrvernac.mli +++ b/plugins/ssr/ssrvernac.mli @@ -9,5 +9,3 @@ (************************************************************************) (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) - -val warn_search_moved_enabled : bool ref diff --git a/plugins/ssrsearch/g_search.mlg b/plugins/ssrsearch/g_search.mlg index 5e002e09cc..54fdea0860 100644 --- a/plugins/ssrsearch/g_search.mlg +++ b/plugins/ssrsearch/g_search.mlg @@ -301,10 +301,6 @@ let ssrdisplaysearch gr env t = let pr_res = pr_global gr ++ str ":" ++ spc () ++ pr_lconstr_env env Evd.empty t in Feedback.msg_notice (hov 2 pr_res ++ fnl ()) -(* Remove the warning entirely when this plugin is loaded. *) -let _ = - Ssreflect_plugin.Ssrvernac.warn_search_moved_enabled := false - let deprecated_search = CWarnings.create ~name:"deprecated-ssr-search" diff --git a/plugins/syntax/dune b/plugins/syntax/dune index b395695c8a..f930fc265a 100644 --- a/plugins/syntax/dune +++ b/plugins/syntax/dune @@ -1,22 +1,8 @@ (library - (name numeral_notation_plugin) - (public_name coq.plugins.numeral_notation) - (synopsis "Coq numeral notation plugin") - (modules g_numeral numeral) - (libraries coq.vernac)) - -(library - (name string_notation_plugin) - (public_name coq.plugins.string_notation) - (synopsis "Coq string notation plugin") - (modules g_string string_notation) - (libraries coq.vernac)) - -(library - (name r_syntax_plugin) - (public_name coq.plugins.r_syntax) - (synopsis "Coq syntax plugin: reals") - (modules r_syntax) + (name number_string_notation_plugin) + (public_name coq.plugins.number_string_notation) + (synopsis "Coq number and string notation plugin") + (modules g_number_string string_notation number) (libraries coq.vernac)) (library @@ -33,4 +19,4 @@ (modules float_syntax) (libraries coq.vernac)) -(coq.pp (modules g_numeral g_string)) +(coq.pp (modules g_number_string)) diff --git a/plugins/syntax/g_number_string.mlg b/plugins/syntax/g_number_string.mlg new file mode 100644 index 0000000000..c8badd238d --- /dev/null +++ b/plugins/syntax/g_number_string.mlg @@ -0,0 +1,110 @@ +(************************************************************************) +(* * 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 PLUGIN "number_string_notation_plugin" + +{ + +open Notation +open Number +open String_notation +open Pp +open Names +open Stdarg +open Pcoq.Prim + +let pr_number_after = function + | Nop -> mt () + | Warning n -> str "warning after " ++ NumTok.UnsignedNat.print n + | Abstract n -> str "abstract after " ++ NumTok.UnsignedNat.print n + +let pr_deprecated_number_modifier m = str "(" ++ pr_number_after m ++ str ")" + +let warn_deprecated_numeral_notation = + CWarnings.create ~name:"numeral-notation" ~category:"deprecated" + (fun () -> + strbrk "Numeral Notation is deprecated, please use Number Notation instead.") + +let pr_number_string_mapping (b, n, n') = + if b then + str "[" ++ Libnames.pr_qualid n ++ str "]" ++ spc () ++ str "=>" ++ spc () + ++ Libnames.pr_qualid n' + else + Libnames.pr_qualid n ++ spc () ++ str "=>" ++ spc () + ++ Libnames.pr_qualid n' + +let pr_number_string_via (n, l) = + str "via " ++ Libnames.pr_qualid n ++ str " mapping [" + ++ prlist_with_sep pr_comma pr_number_string_mapping l ++ str "]" + +let pr_number_modifier = function + | After a -> pr_number_after a + | Via nl -> pr_number_string_via nl + +let pr_number_options l = + str "(" ++ prlist_with_sep pr_comma pr_number_modifier l ++ str ")" + +let pr_string_option l = + str "(" ++ pr_number_string_via l ++ str ")" + +} + +VERNAC ARGUMENT EXTEND deprecated_number_modifier + PRINTED BY { pr_deprecated_number_modifier } +| [ ] -> { Nop } +| [ "(" "warning" "after" bignat(waft) ")" ] -> { Warning (NumTok.UnsignedNat.of_string waft) } +| [ "(" "abstract" "after" bignat(n) ")" ] -> { Abstract (NumTok.UnsignedNat.of_string n) } +END + +VERNAC ARGUMENT EXTEND number_string_mapping + PRINTED BY { pr_number_string_mapping } +| [ reference(n) "=>" reference(n') ] -> { false, n, n' } +| [ "[" reference(n) "]" "=>" reference(n') ] -> { true, n, n' } +END + +VERNAC ARGUMENT EXTEND number_string_via + PRINTED BY { pr_number_string_via } +| [ "via" reference(n) "mapping" "[" ne_number_string_mapping_list_sep(l, ",") "]" ] -> { n, l } +END + +VERNAC ARGUMENT EXTEND number_modifier + PRINTED BY { pr_number_modifier } +| [ "warning" "after" bignat(waft) ] -> { After (Warning (NumTok.UnsignedNat.of_string waft)) } +| [ "abstract" "after" bignat(n) ] -> { After (Abstract (NumTok.UnsignedNat.of_string n)) } +| [ number_string_via(v) ] -> { Via v } +END + +VERNAC ARGUMENT EXTEND number_options + PRINTED BY { pr_number_options } +| [ "(" ne_number_modifier_list_sep(l, ",") ")" ] -> { l } +END + +VERNAC ARGUMENT EXTEND string_option + PRINTED BY { pr_string_option } +| [ "(" number_string_via(v) ")" ] -> { v } +END + +VERNAC COMMAND EXTEND NumberNotation CLASSIFIED AS SIDEFF + | #[ locality = Attributes.locality; ] [ "Number" "Notation" reference(ty) reference(f) reference(g) number_options_opt(nl) ":" + ident(sc) ] -> + + { vernac_number_notation (Locality.make_module_locality locality) ty f g (Option.default [] nl) (Id.to_string sc) } + | #[ locality = Attributes.locality; ] [ "Numeral" "Notation" reference(ty) reference(f) reference(g) ":" + ident(sc) deprecated_number_modifier(o) ] -> + + { warn_deprecated_numeral_notation (); + vernac_number_notation (Locality.make_module_locality locality) ty f g [After o] (Id.to_string sc) } +END + +VERNAC COMMAND EXTEND StringNotation CLASSIFIED AS SIDEFF + | #[ locality = Attributes.locality; ] [ "String" "Notation" reference(ty) reference(f) reference(g) string_option_opt(o) ":" + ident(sc) ] -> + { vernac_string_notation (Locality.make_module_locality locality) ty f g o (Id.to_string sc) } +END diff --git a/plugins/syntax/g_numeral.mlg b/plugins/syntax/g_numeral.mlg deleted file mode 100644 index 93d91abea3..0000000000 --- a/plugins/syntax/g_numeral.mlg +++ /dev/null @@ -1,51 +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) *) -(************************************************************************) - -DECLARE PLUGIN "numeral_notation_plugin" - -{ - -open Notation -open Numeral -open Pp -open Names -open Stdarg -open Pcoq.Prim - -let pr_numnot_option = function - | Nop -> mt () - | Warning n -> str "(warning after " ++ NumTok.UnsignedNat.print n ++ str ")" - | Abstract n -> str "(abstract after " ++ NumTok.UnsignedNat.print n ++ str ")" - -let warn_deprecated_numeral_notation = - CWarnings.create ~name:"numeral-notation" ~category:"deprecated" - (fun () -> - strbrk "Numeral Notation is deprecated, please use Number Notation instead.") - -} - -VERNAC ARGUMENT EXTEND numeral_modifier - PRINTED BY { pr_numnot_option } -| [ ] -> { Nop } -| [ "(" "warning" "after" bignat(waft) ")" ] -> { Warning (NumTok.UnsignedNat.of_string waft) } -| [ "(" "abstract" "after" bignat(n) ")" ] -> { Abstract (NumTok.UnsignedNat.of_string n) } -END - -VERNAC COMMAND EXTEND NumeralNotation CLASSIFIED AS SIDEFF - | #[ locality = Attributes.locality; ] [ "Number" "Notation" reference(ty) reference(f) reference(g) ":" - ident(sc) numeral_modifier(o) ] -> - - { vernac_numeral_notation (Locality.make_module_locality locality) ty f g (Id.to_string sc) o } - | #[ locality = Attributes.locality; ] [ "Numeral" "Notation" reference(ty) reference(f) reference(g) ":" - ident(sc) numeral_modifier(o) ] -> - - { warn_deprecated_numeral_notation (); - vernac_numeral_notation (Locality.make_module_locality locality) ty f g (Id.to_string sc) o } -END diff --git a/plugins/syntax/g_string.mlg b/plugins/syntax/g_string.mlg deleted file mode 100644 index 788f9e011d..0000000000 --- a/plugins/syntax/g_string.mlg +++ /dev/null @@ -1,25 +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) *) -(************************************************************************) - -DECLARE PLUGIN "string_notation_plugin" - -{ - -open String_notation -open Names -open Stdarg - -} - -VERNAC COMMAND EXTEND StringNotation CLASSIFIED AS SIDEFF - | #[ locality = Attributes.locality; ] [ "String" "Notation" reference(ty) reference(f) reference(g) ":" - ident(sc) ] -> - { vernac_string_notation (Locality.make_module_locality locality) ty f g (Id.to_string sc) } -END diff --git a/plugins/syntax/int63_syntax.ml b/plugins/syntax/int63_syntax.ml index 5f4db8e800..b14b02f3bb 100644 --- a/plugins/syntax/int63_syntax.ml +++ b/plugins/syntax/int63_syntax.ml @@ -43,6 +43,7 @@ let _ = let id_int63 = Nametab.locate q_id_int63 in let o = { to_kind = Int63, Direct; to_ty = id_int63; + to_post = [||]; of_kind = Int63, Direct; of_ty = id_int63; ty_name = q_int63; @@ -50,7 +51,7 @@ let _ = enable_prim_token_interpretation { pt_local = false; pt_scope = int63_scope; - pt_interp_info = NumeralNotation o; + pt_interp_info = NumberNotation o; pt_required = (int63_path, int63_module); pt_refs = []; pt_in_match = false }) diff --git a/plugins/syntax/number.ml b/plugins/syntax/number.ml new file mode 100644 index 0000000000..89d757a72a --- /dev/null +++ b/plugins/syntax/number.ml @@ -0,0 +1,505 @@ +(************************************************************************) +(* * 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 Util +open Names +open Libnames +open Constrexpr +open Constrexpr_ops +open Notation + +module CSet = CSet.Make (Constr) +module CMap = CMap.Make (Constr) + +(** * Number notation *) + +type number_string_via = qualid * (bool * qualid * qualid) list +type number_option = + | After of numnot_option + | Via of number_string_via + +let warn_abstract_large_num_no_op = + CWarnings.create ~name:"abstract-large-number-no-op" ~category:"numbers" + (fun f -> + strbrk "The 'abstract after' directive has no effect when " ++ + strbrk "the parsing function (" ++ + Nametab.pr_global_env (Termops.vars_of_env (Global.env ())) f ++ strbrk ") targets an " ++ + strbrk "option type.") + +let get_constructors ind = + let mib,oib = Global.lookup_inductive ind in + let mc = oib.Declarations.mind_consnames in + Array.to_list + (Array.mapi (fun j c -> GlobRef.ConstructRef (ind, j + 1)) mc) + +let qualid_of_ref n = + n |> Coqlib.lib_ref |> Nametab.shortest_qualid_of_global Id.Set.empty + +let q_option () = qualid_of_ref "core.option.type" + +let unsafe_locate_ind q = + match Nametab.locate q with + | GlobRef.IndRef i -> i + | _ -> raise Not_found + +let locate_z () = + let zn = "num.Z.type" in + let pn = "num.pos.type" in + if Coqlib.has_ref zn && Coqlib.has_ref pn + then + let q_z = qualid_of_ref zn in + let q_pos = qualid_of_ref pn in + Some ({ + z_ty = unsafe_locate_ind q_z; + pos_ty = unsafe_locate_ind q_pos; + }, mkRefC q_z) + else None + +let locate_number () = + let dint = "num.int.type" in + let duint = "num.uint.type" in + let dec = "num.decimal.type" in + let hint = "num.hexadecimal_int.type" in + let huint = "num.hexadecimal_uint.type" in + let hex = "num.hexadecimal.type" in + let int = "num.num_int.type" in + let uint = "num.num_uint.type" in + let num = "num.number.type" in + if Coqlib.has_ref dint && Coqlib.has_ref duint && Coqlib.has_ref dec + && Coqlib.has_ref hint && Coqlib.has_ref huint && Coqlib.has_ref hex + && Coqlib.has_ref int && Coqlib.has_ref uint && Coqlib.has_ref num + then + let q_dint = qualid_of_ref dint in + let q_duint = qualid_of_ref duint in + let q_dec = qualid_of_ref dec in + let q_hint = qualid_of_ref hint in + let q_huint = qualid_of_ref huint in + let q_hex = qualid_of_ref hex in + let q_int = qualid_of_ref int in + let q_uint = qualid_of_ref uint in + let q_num = qualid_of_ref num in + let int_ty = { + dec_int = unsafe_locate_ind q_dint; + dec_uint = unsafe_locate_ind q_duint; + hex_int = unsafe_locate_ind q_hint; + hex_uint = unsafe_locate_ind q_huint; + int = unsafe_locate_ind q_int; + uint = unsafe_locate_ind q_uint; + } in + let num_ty = { + int = int_ty; + decimal = unsafe_locate_ind q_dec; + hexadecimal = unsafe_locate_ind q_hex; + number = unsafe_locate_ind q_num; + } in + Some (int_ty, mkRefC q_int, mkRefC q_uint, mkRefC q_dint, mkRefC q_duint, + num_ty, mkRefC q_num, mkRefC q_dec) + else None + +let locate_int63 () = + let int63n = "num.int63.type" in + if Coqlib.has_ref int63n + then + let q_int63 = qualid_of_ref int63n in + Some (mkRefC q_int63) + else None + +let has_type env sigma f ty = + let c = mkCastC (mkRefC f, Glob_term.CastConv ty) in + try let _ = Constrintern.interp_constr env sigma c in true + with Pretype_errors.PretypeError _ -> false + +let type_error_to f ty = + CErrors.user_err + (pr_qualid f ++ str " should go from Number.int to " ++ + pr_qualid ty ++ str " or (option " ++ pr_qualid ty ++ str ")." ++ + fnl () ++ str "Instead of Number.int, the types Number.uint or Z or Int63.int or Number.number could be used (you may need to require BinNums or Number or Int63 first).") + +let type_error_of g ty = + CErrors.user_err + (pr_qualid g ++ str " should go from " ++ pr_qualid ty ++ + str " to Number.int or (option Number.int)." ++ fnl () ++ + str "Instead of Number.int, the types Number.uint or Z or Int63.int or Number.number could be used (you may need to require BinNums or Number or Int63 first).") + +let warn_deprecated_decimal = + CWarnings.create ~name:"decimal-numeral-notation" ~category:"deprecated" + (fun () -> + strbrk "Deprecated Number Notation for Decimal.uint, \ + Decimal.int or Decimal.decimal. Use Number.uint, \ + Number.int or Number.number respectively.") + +let error_params ind = + CErrors.user_err + (str "Wrong number of parameters for inductive" ++ spc () + ++ Printer.pr_global (GlobRef.IndRef ind) ++ str ".") + +let remapping_error ?loc ty ty' ty'' = + CErrors.user_err ?loc + (Printer.pr_global ty + ++ str " was already mapped to" ++ spc () ++ Printer.pr_global ty' + ++ str " and cannot be remapped to" ++ spc () ++ Printer.pr_global ty'' + ++ str ".") + +let error_missing c = + CErrors.user_err + (str "Missing mapping for constructor " ++ Printer.pr_global c ++ str ".") + +let pr_constr env sigma c = + let c = Constrextern.extern_constr env sigma (EConstr.of_constr c) in + Ppconstr.pr_constr_expr env sigma c + +let warn_via_remapping = + CWarnings.create ~name:"via-type-remapping" ~category:"numbers" + (fun (env, sigma, ty, ty', ty'') -> + let constr = pr_constr env sigma in + constr ty ++ str " was already mapped to" ++ spc () ++ constr ty' + ++ str ", mapping it also to" ++ spc () ++ constr ty'' + ++ str " might yield ill typed terms when using the notation.") + +let warn_via_type_mismatch = + CWarnings.create ~name:"via-type-mismatch" ~category:"numbers" + (fun (env, sigma, g, g', exp, actual) -> + let constr = pr_constr env sigma in + str "Type of" ++ spc() ++ Printer.pr_global g + ++ str " seems incompatible with the type of" ++ spc () + ++ Printer.pr_global g' ++ str "." ++ spc () + ++ str "Expected type is: " ++ constr exp ++ spc () + ++ str "instead of " ++ constr actual ++ str "." ++ spc () + ++ str "This might yield ill typed terms when using the notation.") + +let multiple_via_error () = + CErrors.user_err (Pp.str "Multiple 'via' options.") + +let multiple_after_error () = + CErrors.user_err (Pp.str "Multiple 'warning after' or 'abstract after' options.") + +let via_abstract_error () = + CErrors.user_err (Pp.str "'via' and 'abstract' cannot be used together.") + +let locate_global_sort_inductive_or_constant sigma qid = + let locate_sort qid = + match Nametab.locate_extended qid with + | Globnames.TrueGlobal _ -> raise Not_found + | Globnames.SynDef kn -> + match Syntax_def.search_syntactic_definition kn with + | [], Notation_term.NSort r -> + let sigma,c = Evd.fresh_sort_in_family sigma (Glob_ops.glob_sort_family r) in + sigma,Constr.mkSort c + | _ -> raise Not_found in + try locate_sort qid + with Not_found -> + match Smartlocate.global_with_alias qid with + | GlobRef.IndRef i -> sigma, Constr.mkInd i + | _ -> sigma, Constr.mkConst (Smartlocate.global_constant_with_alias qid) + +let locate_global_constructor_inductive_or_constant qid = + let g = Smartlocate.global_with_alias qid in + match g with + | GlobRef.ConstructRef c -> g, Constr.mkConstruct c + | GlobRef.IndRef i -> g, Constr.mkInd i + | _ -> g, Constr.mkConst (Smartlocate.global_constant_with_alias qid) + +(* [get_type env sigma c] retrieves the type of [c] and returns a pair + [l, t] such that [c : l_0 -> ... -> l_n -> t]. *) +let get_type env sigma c = + (* inspired from [compute_implicit_names] in "interp/impargs.ml" *) + let rec aux env acc t = + let t = Reductionops.whd_all env sigma t in + match EConstr.kind sigma t with + | Constr.Prod (na, a, b) -> + let a = Reductionops.whd_all env sigma a in + let rel = Context.Rel.Declaration.LocalAssum (na, a) in + aux (EConstr.push_rel rel env) ((na, a) :: acc) b + | _ -> List.rev acc, t in + let t = Retyping.get_type_of env sigma (EConstr.of_constr c) in + let l, t = aux env [] t in + List.map (fun (na, a) -> na, EConstr.Unsafe.to_constr a) l, + EConstr.Unsafe.to_constr t + +(* [elaborate_to_post_params env sigma ty_ind params] builds the + [to_post] translation (c.f., interp/notation.mli) for the numeral + notation to parse/print type [ty_ind]. This translation is the + identity ([ToPostCopy]) except that it checks ([ToPostCheck]) that + the parameters of the inductive type [ty_ind] match the ones given + in [params]. *) +let elaborate_to_post_params env sigma ty_ind params = + let to_post_for_constructor indc = + let sigma, c = match indc with + | GlobRef.ConstructRef c -> + let sigma,c = Evd.fresh_constructor_instance env sigma c in + sigma, Constr.mkConstructU c + | _ -> assert false in (* c.f. get_constructors *) + let args, t = get_type env sigma c in + let params_indc = match Constr.kind t with + | Constr.App (_, a) -> Array.to_list a | _ -> [] in + let sz = List.length args in + let a = Array.make sz ToPostCopy in + if List.length params <> List.length params_indc then error_params ty_ind; + List.iter2 (fun param param_indc -> + match param, Constr.kind param_indc with + | Some p, Constr.Rel i when i <= sz -> a.(sz - i) <- ToPostCheck p + | _ -> ()) + params params_indc; + indc, indc, Array.to_list a in + let pt_refs = get_constructors ty_ind in + let to_post_0 = List.map to_post_for_constructor pt_refs in + let to_post = + let only_copy (_, _, args) = List.for_all ((=) ToPostCopy) args in + if (List.for_all only_copy to_post_0) then [||] else [|to_post_0|] in + to_post, pt_refs + +(* [elaborate_to_post_via env sigma ty_name ty_ind l] builds the [to_post] + translation (c.f., interp/notation.mli) for the number notation to + parse/print type [ty_name] through the inductive [ty_ind] according + to the pairs [constant, constructor] in the list [l]. *) +let elaborate_to_post_via env sigma ty_name ty_ind l = + let sigma, ty_name = + locate_global_sort_inductive_or_constant sigma ty_name in + let ty_ind = Constr.mkInd ty_ind in + (* Retrieve constants and constructors mappings and their type. + For each constant [cnst] and inductive constructor [indc] in [l], retrieve: + * its location: [lcnst] and [lindc] + * its GlobRef: [cnst] and [indc] + * its type: [tcnst] and [tindc] (decomposed in product by [get_type] above) + * [impls] are the implicit arguments of [cnst] *) + let l = + let read (consider_implicits, cnst, indc) = + let lcnst, lindc = cnst.CAst.loc, indc.CAst.loc in + let cnst, ccnst = locate_global_constructor_inductive_or_constant cnst in + let indc, cindc = + let indc = Smartlocate.global_constructor_with_alias indc in + GlobRef.ConstructRef indc, Constr.mkConstruct indc in + let get_type_wo_params c = + (* ignore parameters of inductive types *) + let rm_params c = match Constr.kind c with + | Constr.App (c, _) when Constr.isInd c -> c + | _ -> c in + let lc, tc = get_type env sigma c in + List.map (fun (n, c) -> n, rm_params c) lc, rm_params tc in + let tcnst, tindc = get_type_wo_params ccnst, get_type_wo_params cindc in + let impls = + if not consider_implicits then [] else + Impargs.(select_stronger_impargs (implicits_of_global cnst)) in + lcnst, cnst, tcnst, lindc, indc, tindc, impls in + List.map read l in + let eq_indc indc (_, _, _, _, indc', _, _) = GlobRef.equal indc indc' in + (* Collect all inductive types involved. + That is [ty_ind] and all final codomains of [tindc] above. *) + let inds = + List.fold_left (fun s (_, _, _, _, _, tindc, _) -> CSet.add (snd tindc) s) + (CSet.singleton ty_ind) l in + (* And for each inductive, retrieve its constructors. *) + let constructors = + CSet.fold (fun ind m -> + let inductive, _ = Constr.destInd ind in + CMap.add ind (get_constructors inductive) m) + inds CMap.empty in + (* Error if one [constructor] in some inductive in [inds] + doesn't appear exactly once in [l] *) + let _ = (* check_for duplicate constructor and error *) + List.fold_left (fun already_seen (_, cnst, _, loc, indc, _, _) -> + try + let cnst' = List.assoc_f GlobRef.equal indc already_seen in + remapping_error ?loc indc cnst' cnst + with Not_found -> (indc, cnst) :: already_seen) + [] l in + let () = (* check for missing constructor and error *) + CMap.iter (fun _ -> + List.iter (fun cstr -> + if not (List.exists (eq_indc cstr) l) then error_missing cstr)) + constructors in + (* Perform some checks on types and warn if they look strange. + These checks are neither sound nor complete, so we only warn. *) + let () = + (* associate inductives to types, and check that this mapping is one to one + and maps [ty_ind] to [ty_name] *) + let ind2ty, ty2ind = + let add loc ckey cval m = + match CMap.find_opt ckey m with + | None -> CMap.add ckey cval m + | Some old_cval -> + if not (Constr.equal old_cval cval) then + warn_via_remapping ?loc (env, sigma, ckey, old_cval, cval); + m in + List.fold_left + (fun (ind2ty, ty2ind) (lcnst, _, (_, tcnst), lindc, _, (_, tindc), _) -> + add lcnst tindc tcnst ind2ty, add lindc tcnst tindc ty2ind) + CMap.(singleton ty_ind ty_name, singleton ty_name ty_ind) l in + (* check that type of constants and constructors mapped in [l] + match modulo [ind2ty] *) + let rm_impls impls (l, t) = + let rec aux impls l = match impls, l with + | Some _ :: impls, _ :: b -> aux impls b + | None :: impls, (n, a) :: b -> (n, a) :: aux impls b + | _ -> l in + aux impls l, t in + let replace m (l, t) = + let apply_m c = try CMap.find c m with Not_found -> c in + List.fold_right (fun (na, a) b -> Constr.mkProd (na, (apply_m a), b)) + l (apply_m t) in + List.iter (fun (_, cnst, tcnst, loc, indc, tindc, impls) -> + let tcnst = rm_impls impls tcnst in + let tcnst' = replace CMap.empty tcnst in + if not (Constr.equal tcnst' (replace ind2ty tindc)) then + let actual = replace CMap.empty tindc in + let expected = replace ty2ind tcnst in + warn_via_type_mismatch ?loc (env, sigma, indc, cnst, expected, actual)) + l in + (* Associate an index to each inductive, starting from 0 for [ty_ind]. *) + let ind2num, num2ind, nb_ind = + CMap.fold (fun ind _ (ind2num, num2ind, i) -> + CMap.add ind i ind2num, Int.Map.add i ind num2ind, i + 1) + (CMap.remove ty_ind constructors) + (CMap.singleton ty_ind 0, Int.Map.singleton 0 ty_ind, 1) in + (* Finally elaborate [to_post] *) + let to_post = + let rec map_prod impls tindc = match impls with + | Some _ :: impls -> ToPostHole :: map_prod impls tindc + | _ -> + match tindc with + | [] -> [] + | (_, a) :: b -> + let t = match CMap.find_opt a ind2num with + | Some i -> ToPostAs i + | None -> ToPostCopy in + let impls = match impls with [] -> [] | _ :: t -> t in + t :: map_prod impls b in + Array.init nb_ind (fun i -> + List.map (fun indc -> + let _, cnst, _, _, _, tindc, impls = List.find (eq_indc indc) l in + indc, cnst, map_prod impls (fst tindc)) + (CMap.find (Int.Map.find i num2ind) constructors)) in + (* and use constants mapped to constructors of [ty_ind] as triggers. *) + let pt_refs = List.map (fun (_, cnst, _) -> cnst) (to_post.(0)) in + to_post, pt_refs + +let locate_global_inductive allow_params qid = + let locate_param_inductive qid = + match Nametab.locate_extended qid with + | Globnames.TrueGlobal _ -> raise Not_found + | Globnames.SynDef kn -> + match Syntax_def.search_syntactic_definition kn with + | [], Notation_term.(NApp (NRef (GlobRef.IndRef i), l)) when allow_params -> + i, + List.map (function + | Notation_term.NRef r -> Some r + | Notation_term.NHole _ -> None + | _ -> raise Not_found) l + | _ -> raise Not_found in + try locate_param_inductive qid + with Not_found -> Smartlocate.global_inductive_with_alias qid, [] + +let vernac_number_notation local ty f g opts scope = + let rec parse_opts = function + | [] -> None, Nop + | h :: opts -> + let via, opts = parse_opts opts in + let via = match h, via with + | Via _, Some _ -> multiple_via_error () + | Via v, None -> Some v + | _ -> via in + let opts = match h, opts with + | After _, (Warning _ | Abstract _) -> multiple_after_error () + | After a, Nop -> a + | _ -> opts in + via, opts in + let via, opts = parse_opts opts in + (match via, opts with Some _, Abstract _ -> via_abstract_error () | _ -> ()); + let env = Global.env () in + let sigma = Evd.from_env env in + let num_ty = locate_number () in + let z_pos_ty = locate_z () in + let int63_ty = locate_int63 () in + let ty_name = ty in + let ty, via = + match via with None -> ty, via | Some (ty', a) -> ty', Some (ty, a) in + let tyc, params = locate_global_inductive (via = None) ty in + let to_ty = Smartlocate.global_with_alias f in + let of_ty = Smartlocate.global_with_alias g in + let cty = mkRefC ty in + let app x y = mkAppC (x,[y]) in + let arrow x y = + mkProdC ([CAst.make Anonymous],Default Glob_term.Explicit, x, y) + in + let opt r = app (mkRefC (q_option ())) r in + (* Check the type of f *) + let to_kind = + match num_ty with + | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma f (arrow cint cty) -> Int int_ty, Direct + | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma f (arrow cint (opt cty)) -> Int int_ty, Option + | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma f (arrow cuint cty) -> UInt int_ty, Direct + | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma f (arrow cuint (opt cty)) -> UInt int_ty, Option + | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma f (arrow cnum cty) -> Number num_ty, Direct + | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma f (arrow cnum (opt cty)) -> Number num_ty, Option + | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma f (arrow cint cty) -> DecimalInt int_ty, Direct + | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma f (arrow cint (opt cty)) -> DecimalInt int_ty, Option + | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma f (arrow cuint cty) -> DecimalUInt int_ty, Direct + | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma f (arrow cuint (opt cty)) -> DecimalUInt int_ty, Option + | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma f (arrow cdec cty) -> Decimal num_ty, Direct + | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma f (arrow cdec (opt cty)) -> Decimal num_ty, Option + | _ -> + match z_pos_ty with + | Some (z_pos_ty, cZ) when has_type env sigma f (arrow cZ cty) -> Z z_pos_ty, Direct + | Some (z_pos_ty, cZ) when has_type env sigma f (arrow cZ (opt cty)) -> Z z_pos_ty, Option + | _ -> + match int63_ty with + | Some cint63 when has_type env sigma f (arrow cint63 cty) -> Int63, Direct + | Some cint63 when has_type env sigma f (arrow cint63 (opt cty)) -> Int63, Option + | _ -> type_error_to f ty + in + (* Check the type of g *) + let of_kind = + match num_ty with + | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma g (arrow cty cint) -> Int int_ty, Direct + | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma g (arrow cty (opt cint)) -> Int int_ty, Option + | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma g (arrow cty cuint) -> UInt int_ty, Direct + | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma g (arrow cty (opt cuint)) -> UInt int_ty, Option + | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma g (arrow cty cnum) -> Number num_ty, Direct + | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma g (arrow cty (opt cnum)) -> Number num_ty, Option + | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma g (arrow cty cint) -> DecimalInt int_ty, Direct + | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma g (arrow cty (opt cint)) -> DecimalInt int_ty, Option + | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma g (arrow cty cuint) -> DecimalUInt int_ty, Direct + | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma g (arrow cty (opt cuint)) -> DecimalUInt int_ty, Option + | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma g (arrow cty cdec) -> Decimal num_ty, Direct + | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma g (arrow cty (opt cdec)) -> Decimal num_ty, Option + | _ -> + match z_pos_ty with + | Some (z_pos_ty, cZ) when has_type env sigma g (arrow cty cZ) -> Z z_pos_ty, Direct + | Some (z_pos_ty, cZ) when has_type env sigma g (arrow cty (opt cZ)) -> Z z_pos_ty, Option + | _ -> + match int63_ty with + | Some cint63 when has_type env sigma g (arrow cty cint63) -> Int63, Direct + | Some cint63 when has_type env sigma g (arrow cty (opt cint63)) -> Int63, Option + | _ -> type_error_of g ty + in + (match to_kind, of_kind with + | ((DecimalInt _ | DecimalUInt _ | Decimal _), _), _ + | _, ((DecimalInt _ | DecimalUInt _ | Decimal _), _) -> + warn_deprecated_decimal () + | _ -> ()); + let to_post, pt_refs = match via with + | None -> elaborate_to_post_params env sigma tyc params + | Some (ty, l) -> elaborate_to_post_via env sigma ty tyc l in + let o = { to_kind; to_ty; to_post; of_kind; of_ty; ty_name; + warning = opts } + in + (match opts, to_kind with + | Abstract _, (_, Option) -> warn_abstract_large_num_no_op o.to_ty + | _ -> ()); + let i = + { pt_local = local; + pt_scope = scope; + pt_interp_info = NumberNotation o; + pt_required = Nametab.path_of_global (GlobRef.IndRef tyc),[]; + pt_refs; + pt_in_match = true } + in + enable_prim_token_interpretation i diff --git a/plugins/syntax/number.mli b/plugins/syntax/number.mli new file mode 100644 index 0000000000..d7d28b29ed --- /dev/null +++ b/plugins/syntax/number.mli @@ -0,0 +1,31 @@ +(************************************************************************) +(* * 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 Libnames +open Vernacexpr +open Notation + +(** * Number notation *) + +type number_string_via = qualid * (bool * qualid * qualid) list +type number_option = + | After of numnot_option + | Via of number_string_via + +val vernac_number_notation : locality_flag -> + qualid -> + qualid -> qualid -> + number_option list -> + Notation_term.scope_name -> unit + +(** These are also used in string notations *) +val locate_global_inductive : bool -> Libnames.qualid -> Names.inductive * Names.GlobRef.t option list +val elaborate_to_post_params : Environ.env -> Evd.evar_map -> Names.inductive -> Names.GlobRef.t option list -> (Names.GlobRef.t * Names.GlobRef.t * Notation.to_post_arg list) list array * Names.GlobRef.t list +val elaborate_to_post_via : Environ.env -> Evd.evar_map -> Libnames.qualid -> Names.inductive -> (bool * Libnames.qualid * Libnames.qualid) list -> (Names.GlobRef.t * Names.GlobRef.t * Notation.to_post_arg list) list array * Names.GlobRef.t list diff --git a/plugins/syntax/number_string_notation_plugin.mlpack b/plugins/syntax/number_string_notation_plugin.mlpack new file mode 100644 index 0000000000..74c32d3a53 --- /dev/null +++ b/plugins/syntax/number_string_notation_plugin.mlpack @@ -0,0 +1,3 @@ +Number +String_notation +G_number_string diff --git a/plugins/syntax/numeral.ml b/plugins/syntax/numeral.ml deleted file mode 100644 index 2db76719b8..0000000000 --- a/plugins/syntax/numeral.ml +++ /dev/null @@ -1,217 +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) *) -(************************************************************************) - -open Pp -open Util -open Names -open Libnames -open Constrexpr -open Constrexpr_ops -open Notation - -(** * Numeral notation *) - -let warn_abstract_large_num_no_op = - CWarnings.create ~name:"abstract-large-number-no-op" ~category:"numbers" - (fun f -> - strbrk "The 'abstract after' directive has no effect when " ++ - strbrk "the parsing function (" ++ - Nametab.pr_global_env (Termops.vars_of_env (Global.env ())) f ++ strbrk ") targets an " ++ - strbrk "option type.") - -let get_constructors ind = - let mib,oib = Global.lookup_inductive ind in - let mc = oib.Declarations.mind_consnames in - Array.to_list - (Array.mapi (fun j c -> GlobRef.ConstructRef (ind, j + 1)) mc) - -let qualid_of_ref n = - n |> Coqlib.lib_ref |> Nametab.shortest_qualid_of_global Id.Set.empty - -let q_option () = qualid_of_ref "core.option.type" - -let unsafe_locate_ind q = - match Nametab.locate q with - | GlobRef.IndRef i -> i - | _ -> raise Not_found - -let locate_z () = - let zn = "num.Z.type" in - let pn = "num.pos.type" in - if Coqlib.has_ref zn && Coqlib.has_ref pn - then - let q_z = qualid_of_ref zn in - let q_pos = qualid_of_ref pn in - Some ({ - z_ty = unsafe_locate_ind q_z; - pos_ty = unsafe_locate_ind q_pos; - }, mkRefC q_z) - else None - -let locate_numeral () = - let dint = "num.int.type" in - let duint = "num.uint.type" in - let dec = "num.decimal.type" in - let hint = "num.hexadecimal_int.type" in - let huint = "num.hexadecimal_uint.type" in - let hex = "num.hexadecimal.type" in - let int = "num.num_int.type" in - let uint = "num.num_uint.type" in - let num = "num.numeral.type" in - if Coqlib.has_ref dint && Coqlib.has_ref duint && Coqlib.has_ref dec - && Coqlib.has_ref hint && Coqlib.has_ref huint && Coqlib.has_ref hex - && Coqlib.has_ref int && Coqlib.has_ref uint && Coqlib.has_ref num - then - let q_dint = qualid_of_ref dint in - let q_duint = qualid_of_ref duint in - let q_dec = qualid_of_ref dec in - let q_hint = qualid_of_ref hint in - let q_huint = qualid_of_ref huint in - let q_hex = qualid_of_ref hex in - let q_int = qualid_of_ref int in - let q_uint = qualid_of_ref uint in - let q_num = qualid_of_ref num in - let int_ty = { - dec_int = unsafe_locate_ind q_dint; - dec_uint = unsafe_locate_ind q_duint; - hex_int = unsafe_locate_ind q_hint; - hex_uint = unsafe_locate_ind q_huint; - int = unsafe_locate_ind q_int; - uint = unsafe_locate_ind q_uint; - } in - let num_ty = { - int = int_ty; - decimal = unsafe_locate_ind q_dec; - hexadecimal = unsafe_locate_ind q_hex; - numeral = unsafe_locate_ind q_num; - } in - Some (int_ty, mkRefC q_int, mkRefC q_uint, mkRefC q_dint, mkRefC q_duint, - num_ty, mkRefC q_num, mkRefC q_dec) - else None - -let locate_int63 () = - let int63n = "num.int63.type" in - if Coqlib.has_ref int63n - then - let q_int63 = qualid_of_ref int63n in - Some (mkRefC q_int63) - else None - -let has_type env sigma f ty = - let c = mkCastC (mkRefC f, Glob_term.CastConv ty) in - try let _ = Constrintern.interp_constr env sigma c in true - with Pretype_errors.PretypeError _ -> false - -let type_error_to f ty = - CErrors.user_err - (pr_qualid f ++ str " should go from Numeral.int to " ++ - pr_qualid ty ++ str " or (option " ++ pr_qualid ty ++ str ")." ++ - fnl () ++ str "Instead of Numeral.int, the types Numeral.uint or Z or Int63.int or Numeral.numeral could be used (you may need to require BinNums or Numeral or Int63 first).") - -let type_error_of g ty = - CErrors.user_err - (pr_qualid g ++ str " should go from " ++ pr_qualid ty ++ - str " to Numeral.int or (option Numeral.int)." ++ fnl () ++ - str "Instead of Numeral.int, the types Numeral.uint or Z or Int63.int or Numeral.numeral could be used (you may need to require BinNums or Numeral or Int63 first).") - -let warn_deprecated_decimal = - CWarnings.create ~name:"decimal-numeral-notation" ~category:"deprecated" - (fun () -> - strbrk "Deprecated Numeral Notation for Decimal.uint, \ - Decimal.int or Decimal.decimal. Use Numeral.uint, \ - Numeral.int or Numeral.numeral respectively.") - -let vernac_numeral_notation local ty f g scope opts = - let env = Global.env () in - let sigma = Evd.from_env env in - let num_ty = locate_numeral () in - let z_pos_ty = locate_z () in - let int63_ty = locate_int63 () in - let tyc = Smartlocate.global_inductive_with_alias ty in - let to_ty = Smartlocate.global_with_alias f in - let of_ty = Smartlocate.global_with_alias g in - let cty = mkRefC ty in - let app x y = mkAppC (x,[y]) in - let arrow x y = - mkProdC ([CAst.make Anonymous],Default Glob_term.Explicit, x, y) - in - let opt r = app (mkRefC (q_option ())) r in - let constructors = get_constructors tyc in - (* Check the type of f *) - let to_kind = - match num_ty with - | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma f (arrow cint cty) -> Int int_ty, Direct - | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma f (arrow cint (opt cty)) -> Int int_ty, Option - | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma f (arrow cuint cty) -> UInt int_ty, Direct - | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma f (arrow cuint (opt cty)) -> UInt int_ty, Option - | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma f (arrow cnum cty) -> Numeral num_ty, Direct - | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma f (arrow cnum (opt cty)) -> Numeral num_ty, Option - | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma f (arrow cint cty) -> DecimalInt int_ty, Direct - | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma f (arrow cint (opt cty)) -> DecimalInt int_ty, Option - | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma f (arrow cuint cty) -> DecimalUInt int_ty, Direct - | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma f (arrow cuint (opt cty)) -> DecimalUInt int_ty, Option - | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma f (arrow cdec cty) -> Decimal num_ty, Direct - | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma f (arrow cdec (opt cty)) -> Decimal num_ty, Option - | _ -> - match z_pos_ty with - | Some (z_pos_ty, cZ) when has_type env sigma f (arrow cZ cty) -> Z z_pos_ty, Direct - | Some (z_pos_ty, cZ) when has_type env sigma f (arrow cZ (opt cty)) -> Z z_pos_ty, Option - | _ -> - match int63_ty with - | Some cint63 when has_type env sigma f (arrow cint63 cty) -> Int63, Direct - | Some cint63 when has_type env sigma f (arrow cint63 (opt cty)) -> Int63, Option - | _ -> type_error_to f ty - in - (* Check the type of g *) - let of_kind = - match num_ty with - | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma g (arrow cty cint) -> Int int_ty, Direct - | Some (int_ty, cint, _, _, _, _, _, _) when has_type env sigma g (arrow cty (opt cint)) -> Int int_ty, Option - | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma g (arrow cty cuint) -> UInt int_ty, Direct - | Some (int_ty, _, cuint, _, _, _, _, _) when has_type env sigma g (arrow cty (opt cuint)) -> UInt int_ty, Option - | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma g (arrow cty cnum) -> Numeral num_ty, Direct - | Some (_, _, _, _, _, num_ty, cnum, _) when has_type env sigma g (arrow cty (opt cnum)) -> Numeral num_ty, Option - | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma g (arrow cty cint) -> DecimalInt int_ty, Direct - | Some (int_ty, _, _, cint, _, _, _, _) when has_type env sigma g (arrow cty (opt cint)) -> DecimalInt int_ty, Option - | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma g (arrow cty cuint) -> DecimalUInt int_ty, Direct - | Some (int_ty, _, _, _, cuint, _, _, _) when has_type env sigma g (arrow cty (opt cuint)) -> DecimalUInt int_ty, Option - | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma g (arrow cty cdec) -> Decimal num_ty, Direct - | Some (_, _, _, _, _, num_ty, _, cdec) when has_type env sigma g (arrow cty (opt cdec)) -> Decimal num_ty, Option - | _ -> - match z_pos_ty with - | Some (z_pos_ty, cZ) when has_type env sigma g (arrow cty cZ) -> Z z_pos_ty, Direct - | Some (z_pos_ty, cZ) when has_type env sigma g (arrow cty (opt cZ)) -> Z z_pos_ty, Option - | _ -> - match int63_ty with - | Some cint63 when has_type env sigma g (arrow cty cint63) -> Int63, Direct - | Some cint63 when has_type env sigma g (arrow cty (opt cint63)) -> Int63, Option - | _ -> type_error_of g ty - in - (match to_kind, of_kind with - | ((DecimalInt _ | DecimalUInt _ | Decimal _), _), _ - | _, ((DecimalInt _ | DecimalUInt _ | Decimal _), _) -> - warn_deprecated_decimal () - | _ -> ()); - let o = { to_kind; to_ty; of_kind; of_ty; - ty_name = ty; - warning = opts } - in - (match opts, to_kind with - | Abstract _, (_, Option) -> warn_abstract_large_num_no_op o.to_ty - | _ -> ()); - let i = - { pt_local = local; - pt_scope = scope; - pt_interp_info = NumeralNotation o; - pt_required = Nametab.path_of_global (GlobRef.IndRef tyc),[]; - pt_refs = constructors; - pt_in_match = true } - in - enable_prim_token_interpretation i diff --git a/plugins/syntax/numeral.mli b/plugins/syntax/numeral.mli deleted file mode 100644 index 99252484b4..0000000000 --- a/plugins/syntax/numeral.mli +++ /dev/null @@ -1,19 +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) *) -(************************************************************************) - -open Libnames -open Vernacexpr -open Notation - -(** * Numeral notation *) - -val vernac_numeral_notation : locality_flag -> - qualid -> qualid -> qualid -> - Notation_term.scope_name -> numnot_option -> unit diff --git a/plugins/syntax/numeral_notation_plugin.mlpack b/plugins/syntax/numeral_notation_plugin.mlpack deleted file mode 100644 index f4d9cae3ff..0000000000 --- a/plugins/syntax/numeral_notation_plugin.mlpack +++ /dev/null @@ -1,2 +0,0 @@ -Numeral -G_numeral diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml deleted file mode 100644 index d66b9537b4..0000000000 --- a/plugins/syntax/r_syntax.ml +++ /dev/null @@ -1,214 +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) *) -(************************************************************************) - -open Util -open Names -open Glob_term - -(* Poor's man DECLARE PLUGIN *) -let __coq_plugin_name = "r_syntax_plugin" -let () = Mltop.add_known_module __coq_plugin_name - -exception Non_closed_number - -(**********************************************************************) -(* Parsing positive via scopes *) -(**********************************************************************) - -let binnums = ["Coq";"Numbers";"BinNums"] - -let make_dir l = DirPath.make (List.rev_map Id.of_string l) -let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id) - -let is_gr c gr = match DAst.get c with -| GRef (r, _) -> GlobRef.equal r gr -| _ -> false - -let positive_modpath = MPfile (make_dir binnums) - -let positive_kn = MutInd.make2 positive_modpath (Label.make "positive") -let path_of_xI = ((positive_kn,0),1) -let path_of_xO = ((positive_kn,0),2) -let path_of_xH = ((positive_kn,0),3) -let glob_xI = GlobRef.ConstructRef path_of_xI -let glob_xO = GlobRef.ConstructRef path_of_xO -let glob_xH = GlobRef.ConstructRef path_of_xH - -let pos_of_bignat ?loc x = - let ref_xI = DAst.make @@ GRef (glob_xI, None) in - let ref_xH = DAst.make @@ GRef (glob_xH, None) in - let ref_xO = DAst.make @@ GRef (glob_xO, None) in - let rec pos_of x = - match Z.(div_rem x (of_int 2)) with - | (q,rem) when rem = Z.zero -> DAst.make @@ GApp (ref_xO,[pos_of q]) - | (q,_) when not Z.(equal q zero) -> DAst.make @@ GApp (ref_xI,[pos_of q]) - | (q,_) -> ref_xH - in - pos_of x - -(**********************************************************************) -(* Printing positive via scopes *) -(**********************************************************************) - -let rec bignat_of_pos c = match DAst.get c with - | GApp (r, [a]) when is_gr r glob_xO -> Z.mul Z.(of_int 2) (bignat_of_pos a) - | GApp (r, [a]) when is_gr r glob_xI -> Z.add Z.one Z.(mul (of_int 2) (bignat_of_pos a)) - | GRef (a, _) when GlobRef.equal a glob_xH -> Z.one - | _ -> raise Non_closed_number - -(**********************************************************************) -(* Parsing Z via scopes *) -(**********************************************************************) - -let z_kn = MutInd.make2 positive_modpath (Label.make "Z") -let path_of_ZERO = ((z_kn,0),1) -let path_of_POS = ((z_kn,0),2) -let path_of_NEG = ((z_kn,0),3) -let glob_ZERO = GlobRef.ConstructRef path_of_ZERO -let glob_POS = GlobRef.ConstructRef path_of_POS -let glob_NEG = GlobRef.ConstructRef path_of_NEG - -let z_of_int ?loc n = - if not Z.(equal n zero) then - let sgn, n = - if Z.(leq zero n) then glob_POS, n else glob_NEG, Z.neg n in - DAst.make @@ GApp(DAst.make @@ GRef (sgn,None), [pos_of_bignat ?loc n]) - else - DAst.make @@ GRef (glob_ZERO, None) - -(**********************************************************************) -(* Printing Z via scopes *) -(**********************************************************************) - -let bigint_of_z c = match DAst.get c with - | GApp (r,[a]) when is_gr r glob_POS -> bignat_of_pos a - | GApp (r,[a]) when is_gr r glob_NEG -> Z.neg (bignat_of_pos a) - | GRef (a, _) when GlobRef.equal a glob_ZERO -> Z.zero - | _ -> raise Non_closed_number - -(**********************************************************************) -(* Parsing R via scopes *) -(**********************************************************************) - -let rdefinitions = ["Coq";"Reals";"Rdefinitions"] -let r_modpath = MPfile (make_dir rdefinitions) -let r_base_modpath = MPdot (r_modpath, Label.make "RbaseSymbolsImpl") -let r_path = make_path ["Coq";"Reals";"Rdefinitions";"RbaseSymbolsImpl"] "R" - -let glob_IZR = GlobRef.ConstRef (Constant.make2 r_modpath @@ Label.make "IZR") -let glob_Rmult = GlobRef.ConstRef (Constant.make2 r_base_modpath @@ Label.make "Rmult") -let glob_Rdiv = GlobRef.ConstRef (Constant.make2 r_modpath @@ Label.make "Rdiv") - -let binintdef = ["Coq";"ZArith";"BinIntDef"] -let z_modpath = MPdot (MPfile (make_dir binintdef), Label.make "Z") - -let glob_pow_pos = GlobRef.ConstRef (Constant.make2 z_modpath @@ Label.make "pow_pos") - -let r_of_rawnum ?loc n = - let n,e = NumTok.Signed.to_bigint_and_exponent n in - let e,p = NumTok.(match e with EDec e -> e, 10 | EBin e -> e, 2) in - let izr z = - DAst.make @@ GApp (DAst.make @@ GRef(glob_IZR,None), [z]) in - let rmult r r' = - DAst.make @@ GApp (DAst.make @@ GRef(glob_Rmult,None), [r; r']) in - let rdiv r r' = - DAst.make @@ GApp (DAst.make @@ GRef(glob_Rdiv,None), [r; r']) in - let pow p e = - let p = z_of_int ?loc (Z.of_int p) in - let e = pos_of_bignat e in - DAst.make @@ GApp (DAst.make @@ GRef(glob_pow_pos,None), [p; e]) in - let n = - izr (z_of_int ?loc n) in - if Int.equal (Z.sign e) 1 then rmult n (izr (pow p e)) - else if Int.equal (Z.sign e) (-1) then rdiv n (izr (pow p (Z.neg e))) - else n (* e = 0 *) - -(**********************************************************************) -(* Printing R via scopes *) -(**********************************************************************) - -let rawnum_of_r c = - (* print i * 10^e, precondition: e <> 0 *) - let numTok_of_int_exp i e = - (* choose between 123e-2 and 1.23, this is purely heuristic - and doesn't play any soundness role *) - let choose_exponent = - if Int.equal (Z.sign e) 1 then - true (* don't print 12 * 10^2 as 1200 to distinguish them *) - else - let i = Z.to_string i in - let li = if i.[0] = '-' then String.length i - 1 else String.length i in - let e = Z.neg e in - let le = String.length (Z.to_string e) in - Z.(lt (add (of_int li) (of_int le)) e) in - (* print 123 * 10^-2 as 123e-2 *) - let numTok_exponent () = - NumTok.Signed.of_bigint_and_exponent i (NumTok.EDec e) in - (* print 123 * 10^-2 as 1.23, precondition e < 0 *) - let numTok_dot () = - let s, i = - if Z.sign i >= 0 then NumTok.SPlus, Z.to_string i - else NumTok.SMinus, Z.(to_string (neg i)) in - let ni = String.length i in - let e = - (Z.to_int e) in - assert (e > 0); - let i, f = - if e < ni then String.sub i 0 (ni - e), String.sub i (ni - e) e - else "0", String.make (e - ni) '0' ^ i in - let i = s, NumTok.UnsignedNat.of_string i in - let f = NumTok.UnsignedNat.of_string f in - NumTok.Signed.of_int_frac_and_exponent i (Some f) None in - if choose_exponent then numTok_exponent () else numTok_dot () in - match DAst.get c with - | GApp (r, [a]) when is_gr r glob_IZR -> - let n = bigint_of_z a in - NumTok.(Signed.of_bigint CDec n) - | GApp (md, [l; r]) when is_gr md glob_Rmult || is_gr md glob_Rdiv -> - begin match DAst.get l, DAst.get r with - | GApp (i, [l]), GApp (i', [r]) - when is_gr i glob_IZR && is_gr i' glob_IZR -> - begin match DAst.get r with - | GApp (p, [t; e]) when is_gr p glob_pow_pos -> - let t = bigint_of_z t in - if not (Z.(equal t (of_int 10))) then - raise Non_closed_number - else - let i = bigint_of_z l in - let e = bignat_of_pos e in - let e = if is_gr md glob_Rdiv then Z.neg e else e in - numTok_of_int_exp i e - | _ -> raise Non_closed_number - end - | _ -> raise Non_closed_number - end - | _ -> raise Non_closed_number - -let uninterp_r (AnyGlobConstr p) = - try - Some (rawnum_of_r p) - with Non_closed_number -> - None - -open Notation - -let at_declare_ml_module f x = - Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name - -let r_scope = "R_scope" - -let _ = - register_rawnumeral_interpretation r_scope (r_of_rawnum,uninterp_r); - at_declare_ml_module enable_prim_token_interpretation - { pt_local = false; - pt_scope = r_scope; - pt_interp_info = Uid r_scope; - pt_required = (r_path,["Coq";"Reals";"Rdefinitions"]); - pt_refs = [glob_IZR; glob_Rmult; glob_Rdiv]; - pt_in_match = false } diff --git a/plugins/syntax/r_syntax.mli b/plugins/syntax/r_syntax.mli deleted file mode 100644 index b72d544151..0000000000 --- a/plugins/syntax/r_syntax.mli +++ /dev/null @@ -1,9 +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) *) -(************************************************************************) diff --git a/plugins/syntax/r_syntax_plugin.mlpack b/plugins/syntax/r_syntax_plugin.mlpack deleted file mode 100644 index d4ee75ea48..0000000000 --- a/plugins/syntax/r_syntax_plugin.mlpack +++ /dev/null @@ -1 +0,0 @@ -R_syntax diff --git a/plugins/syntax/string_notation.ml b/plugins/syntax/string_notation.ml index e7ed0d8061..774d59dda3 100644 --- a/plugins/syntax/string_notation.ml +++ b/plugins/syntax/string_notation.ml @@ -9,21 +9,15 @@ (************************************************************************) open Pp -open Util open Names open Libnames open Constrexpr open Constrexpr_ops open Notation +open Number (** * String notation *) -let get_constructors ind = - let mib,oib = Global.lookup_inductive ind in - let mc = oib.Declarations.mind_consnames in - Array.to_list - (Array.mapi (fun j c -> GlobRef.ConstructRef (ind, j + 1)) mc) - let qualid_of_ref n = n |> Coqlib.lib_ref |> Nametab.shortest_qualid_of_global Id.Set.empty @@ -46,7 +40,7 @@ let type_error_of g ty = (pr_qualid g ++ str " should go from " ++ pr_qualid ty ++ str " to Byte.byte or (option Byte.byte) or (list Byte.byte) or (option (list Byte.byte)).") -let vernac_string_notation local ty f g scope = +let vernac_string_notation local ty f g via scope = let env = Global.env () in let sigma = Evd.from_env env in let app x y = mkAppC (x,[y]) in @@ -56,14 +50,16 @@ let vernac_string_notation local ty f g scope = let coption = cref (q_option ()) in let opt r = app coption r in let clist_byte = app clist cbyte in - let tyc = Smartlocate.global_inductive_with_alias ty in + let ty_name = ty in + let ty, via = + match via with None -> ty, via | Some (ty', a) -> ty', Some (ty, a) in + let tyc, params = locate_global_inductive (via = None) ty in let to_ty = Smartlocate.global_with_alias f in let of_ty = Smartlocate.global_with_alias g in let cty = cref ty in let arrow x y = mkProdC ([CAst.make Anonymous],Default Glob_term.Explicit, x, y) in - let constructors = get_constructors tyc in (* Check the type of f *) let to_kind = if has_type env sigma f (arrow clist_byte cty) then ListByte, Direct @@ -80,11 +76,10 @@ let vernac_string_notation local ty f g scope = else if has_type env sigma g (arrow cty (opt cbyte)) then Byte, Option else type_error_of g ty in - let o = { to_kind = to_kind; - to_ty = to_ty; - of_kind = of_kind; - of_ty = of_ty; - ty_name = ty; + let to_post, pt_refs = match via with + | None -> elaborate_to_post_params env sigma tyc params + | Some (ty, l) -> elaborate_to_post_via env sigma ty tyc l in + let o = { to_kind; to_ty; to_post; of_kind; of_ty; ty_name; warning = () } in let i = @@ -92,7 +87,7 @@ let vernac_string_notation local ty f g scope = pt_scope = scope; pt_interp_info = StringNotation o; pt_required = Nametab.path_of_global (GlobRef.IndRef tyc),[]; - pt_refs = constructors; + pt_refs; pt_in_match = true } in enable_prim_token_interpretation i diff --git a/plugins/syntax/string_notation.mli b/plugins/syntax/string_notation.mli index 0d99f98d26..f3c7c969c6 100644 --- a/plugins/syntax/string_notation.mli +++ b/plugins/syntax/string_notation.mli @@ -14,5 +14,7 @@ open Vernacexpr (** * String notation *) val vernac_string_notation : locality_flag -> - qualid -> qualid -> qualid -> + qualid -> + qualid -> qualid -> + Number.number_string_via option -> Notation_term.scope_name -> unit diff --git a/plugins/syntax/string_notation_plugin.mlpack b/plugins/syntax/string_notation_plugin.mlpack deleted file mode 100644 index 6aa081dab4..0000000000 --- a/plugins/syntax/string_notation_plugin.mlpack +++ /dev/null @@ -1,2 +0,0 @@ -String_notation -G_string diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml index bdf3495479..f42c754ef5 100644 --- a/pretyping/glob_ops.ml +++ b/pretyping/glob_ops.ml @@ -523,6 +523,7 @@ let rec cases_pattern_of_glob_constr env na c = | Anonymous -> PatVar (Name id) end | GHole (_,_,_) -> PatVar na + | GRef (GlobRef.VarRef id,_) -> PatVar (Name id) | GRef (GlobRef.ConstructRef cstr,_) -> PatCstr (cstr,[],na) | GApp (c, l) -> begin match DAst.get c with diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 4d37c0ef60..982814fdfc 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -687,6 +687,17 @@ let eta_constructor_app env sigma f l1 term = | _ -> assert false) | _ -> assert false +(* If the terms are irrelevant, check that they have the same type. *) +let careful_infer_conv ~pb ~ts env sigma m n = + if Retyping.relevance_of_term env sigma m == Sorts.Irrelevant && + Retyping.relevance_of_term env sigma n == Sorts.Irrelevant + then + let tm = Retyping.get_type_of env sigma m in + let tn = Retyping.get_type_of env sigma n in + Option.bind (infer_conv ~pb:CONV ~ts env sigma tm tn) + (fun sigma -> infer_conv ~pb ~ts env sigma m n) + else infer_conv ~pb ~ts env sigma m n + let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top env cv_pb flags m n = let rec unirec_rec (curenv,nb as curenvnb) pb opt ((sigma,metasubst,evarsubst) as substn : subst0) curm curn = let cM = Evarutil.whd_head_evar sigma curm @@ -1127,7 +1138,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e None else let ans = match flags.modulo_conv_on_closed_terms with - | Some convflags -> infer_conv ~pb:cv_pb ~ts:convflags env sigma m n + | Some convflags -> careful_infer_conv ~pb:cv_pb ~ts:convflags env sigma m n | _ -> constr_cmp cv_pb env sigma flags m n in match ans with | Some sigma -> ans diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index 45d0e39ed6..e312c68b7d 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -77,8 +77,8 @@ let tag_var = tag Tag.variable | LevelSome -> true let prec_of_prim_token = function - | Numeral (NumTok.SPlus,_) -> lposint - | Numeral (NumTok.SMinus,_) -> lnegint + | Number (NumTok.SPlus,_) -> lposint + | Number (NumTok.SMinus,_) -> lnegint | String _ -> latom let print_hunks n pr pr_patt pr_binders (terms, termlists, binders, binderlists) unps = @@ -222,7 +222,7 @@ let tag_var = tag Tag.variable | t -> str " :" ++ pr_sep_com (fun()->brk(1,4)) (pr ltop) t let pr_prim_token = function - | Numeral n -> NumTok.Signed.print n + | Number n -> NumTok.Signed.print n | String s -> qs s let pr_evar pr id l = diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index ed92a85a12..9e66e8668f 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -482,8 +482,7 @@ let make_resolve_hyp env sigma st only_classes pri decl = let keep = not only_classes || is_class in if keep then let id = GlobRef.VarRef id in - let name = PathHints [id] in - (make_resolves env sigma pri ~name ~check:false (IsGlobRef id)) + make_resolves env sigma pri id else [] let make_hints g (modes,st) only_classes sign = diff --git a/tactics/hints.ml b/tactics/hints.ml index fe3efef7c5..68229dbe26 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -1347,6 +1347,10 @@ let add_hints ~locality dbnames h = | HintsExternEntry (info, tacexp) -> add_externs info tacexp ~local ~superglobal dbnames +let hint_globref gr = IsGlobRef gr + +let hint_constr (c, diff) = IsConstr (c, diff) + let expand_constructor_hints env sigma lems = List.map_append (fun (evd,lem) -> match EConstr.kind sigma lem with @@ -1365,8 +1369,9 @@ let constructor_hints env sigma eapply lems = List.map_append (fun lem -> make_resolves env sigma (eapply, true) empty_hint_info ~check:true lem) lems -let make_resolves env sigma info ~check ?name hint = - make_resolves env sigma (true, false) info ~check ?name hint +let make_resolves env sigma info hint = + let name = PathHints [hint] in + make_resolves env sigma (true, false) info ~check:false ~name (IsGlobRef hint) let make_local_hint_db env sigma ts eapply lems = let map c = c env sigma in diff --git a/tactics/hints.mli b/tactics/hints.mli index dd22cff10b..3d4d9c7970 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -167,9 +167,7 @@ type hint_db = Hint_db.t type hnf = bool -type hint_term = - | IsGlobRef of GlobRef.t - | IsConstr of constr * Univ.ContextSet.t option [@ocaml.deprecated "Declare a hint constant instead"] +type hint_term type hints_entry = | HintsResolveEntry of (hint_info * hnf * hints_path_atom * hint_term) list @@ -199,8 +197,10 @@ val current_pure_db : unit -> hint_db list val add_hints : locality:Goptions.option_locality -> hint_db_name list -> hints_entry -> unit -val prepare_hint : bool (* Check no remaining evars *) -> - env -> evar_map -> evar_map * constr -> (constr * Univ.ContextSet.t) +val hint_globref : GlobRef.t -> hint_term + +val hint_constr : constr * Univ.ContextSet.t option -> hint_term +[@ocaml.deprecated "Declare a hint constant instead"] (** A constr which is Hint'ed will be: - (1) used as an Exact, if it does not start with a product @@ -210,8 +210,7 @@ val prepare_hint : bool (* Check no remaining evars *) -> has missing arguments. *) val make_resolves : - env -> evar_map -> hint_info -> check:bool -> ?name:hints_path_atom -> - hint_term -> hint_entry list + env -> evar_map -> hint_info -> GlobRef.t -> hint_entry list (** [make_resolve_hyp hname htyp]. used to add an hypothesis to the local hint database; diff --git a/test-suite/bugs/closed/bug_10972.v b/test-suite/bugs/closed/bug_10972.v new file mode 100644 index 0000000000..945c23c9a4 --- /dev/null +++ b/test-suite/bugs/closed/bug_10972.v @@ -0,0 +1,9 @@ +(* Check rewrite_strat is compatible with Ltac *) +Require Import Coq.Setoids.Setoid. +Module foo. + Definition Foo := True. + Ltac foo := rewrite_strat eval cbv [Foo]. +End foo. +Goal foo.Foo. + foo.foo. +Abort. diff --git a/test-suite/bugs/closed/bug_13162.v b/test-suite/bugs/closed/bug_13162.v new file mode 100644 index 0000000000..eacc8980a9 --- /dev/null +++ b/test-suite/bugs/closed/bug_13162.v @@ -0,0 +1,7 @@ + +Module Type T. End T. +Module F (X:T). End F. +Fail Import F. +(* Error: Anomaly "Uncaught exception Not_found." *) + +Fail Import T. diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out index fa0c20bf73..a6fd39c29b 100644 --- a/test-suite/output/Notations4.out +++ b/test-suite/output/Notations4.out @@ -125,3 +125,57 @@ Warning: Notation "_ :=: _" was already used. [notation-overridden,parsing] : Prop fun x : nat => <{ x; (S x) }> : nat -> nat +exists p : nat, ▢_p (p >= 1) + : Prop +▢_n (n >= 1) + : Prop +The command has indeed failed with message: +Found an inductive type while a variable name was expected. +The command has indeed failed with message: +Found a constructor while a variable name was expected. +The command has indeed failed with message: +Found a constant while a variable name was expected. +exists x y : nat, ▢_(x, y) (x >= 1 /\ y >= 2) + : Prop +▢_n (n >= 1) + : Prop +The command has indeed failed with message: +Found an inductive type while a pattern was expected. +▢_tt (tt = tt) + : Prop +The command has indeed failed with message: +Found a constant while a pattern was expected. +exists x y : nat, ▢_(x, y) (x >= 1 /\ y >= 2) + : Prop +pseudo_force n (fun n : nat => n >= 1) + : Prop +The command has indeed failed with message: +Found an inductive type while a pattern was expected. +▢_tt (tt = tt) + : Prop +The command has indeed failed with message: +Found a constant while a pattern was expected. +exists x y : nat, myforce (x, y) (x >= 1 /\ y >= 2) + : Prop +myforce n (n >= 1) + : Prop +The command has indeed failed with message: +Found an inductive type while a pattern was expected. +myforce tt (tt = tt) + : Prop +The command has indeed failed with message: +Found a constant while a pattern was expected. +id nat + : Set +fun a : bool => id a + : bool -> bool +fun nat : bool => id nat + : bool -> bool +The command has indeed failed with message: +Found an inductive type while a pattern was expected. +!! nat, nat = true + : Prop +!!! nat, nat = true + : Prop +!!!! (nat, id), nat = true /\ id = false + : Prop diff --git a/test-suite/output/Notations4.v b/test-suite/output/Notations4.v index 6dadd8c7fe..0731819bba 100644 --- a/test-suite/output/Notations4.v +++ b/test-suite/output/Notations4.v @@ -124,7 +124,7 @@ Check r 2 3. End I. Require Import Coq.Numbers.Cyclic.Int63.Int63. -Module NumeralNotations. +Module NumberNotations. Module Test17. (** Test int63 *) Declare Scope test17_scope. @@ -134,7 +134,7 @@ Module NumeralNotations. Number Notation myint63 of_int to_int : test17_scope. Check let v := 0%test17 in v : myint63. End Test17. -End NumeralNotations. +End NumberNotations. Module K. @@ -313,3 +313,104 @@ Notation "x" := x (in custom com_top at level 90, x custom com at level 90). Check fun x => <{ x ; (S x) }>. End CoercionEntryTransitivity. + +(* Some corner cases *) + +Module P. + +(* Basic rules: + - a section variable be used for itself and as a binding variable + - a global name cannot be used for itself and as a binding variable +*) + + Definition pseudo_force {A} (n:A) (P:A -> Prop) := forall n', n' = n -> P n'. + + Module NotationMixedTermBinderAsIdent. + + Notation "▢_ n P" := (pseudo_force n (fun n => P)) + (at level 0, n ident, P at level 9, format "▢_ n P"). + Check exists p, ▢_p (p >= 1). + Section S. + Variable n:nat. + Check ▢_n (n >= 1). + End S. + Fail Check ▢_nat (nat = bool). + Fail Check ▢_O (O >= 1). + Axiom n:nat. + Fail Check ▢_n (n >= 1). + + End NotationMixedTermBinderAsIdent. + + Module NotationMixedTermBinderAsPattern. + + Notation "▢_ n P" := (pseudo_force n (fun n => P)) + (at level 0, n pattern, P at level 9, format "▢_ n P"). + Check exists x y, ▢_(x,y) (x >= 1 /\ y >= 2). + Section S. + Variable n:nat. + Check ▢_n (n >= 1). + End S. + Fail Check ▢_nat (nat = bool). + Check ▢_tt (tt = tt). + Axiom n:nat. + Fail Check ▢_n (n >= 1). + + End NotationMixedTermBinderAsPattern. + + Module NotationMixedTermBinderAsStrictPattern. + + Notation "▢_ n P" := (pseudo_force n (fun n => P)) + (at level 0, n strict pattern, P at level 9, format "▢_ n P"). + Check exists x y, ▢_(x,y) (x >= 1 /\ y >= 2). + Section S. + Variable n:nat. + Check ▢_n (n >= 1). + End S. + Fail Check ▢_nat (nat = bool). + Check ▢_tt (tt = tt). + Axiom n:nat. + Fail Check ▢_n (n >= 1). + + End NotationMixedTermBinderAsStrictPattern. + + Module AbbreviationMixedTermBinderAsStrictPattern. + + Notation myforce n P := (pseudo_force n (fun n => P)). + Check exists x y, myforce (x,y) (x >= 1 /\ y >= 2). + Section S. + Variable n:nat. + Check myforce n (n >= 1). (* strict hence not used for printing *) + End S. + Fail Check myforce nat (nat = bool). + Check myforce tt (tt = tt). + Axiom n:nat. + Fail Check myforce n (n >= 1). + + End AbbreviationMixedTermBinderAsStrictPattern. + + Module Bug4765Part. + + Notation id x := ((fun y => y) x). + Check id nat. + + Notation id' x := ((fun x => x) x). + Check fun a : bool => id' a. + Check fun nat : bool => id' nat. + Fail Check id' nat. + + End Bug4765Part. + + Module NotationBinderNotMixedWithTerms. + + Notation "!! x , P" := (forall x, P) (at level 200, x pattern). + Check !! nat, nat = true. + + Notation "!!! x , P" := (forall x, P) (at level 200). + Check !!! nat, nat = true. + + Notation "!!!! x , P" := (forall x, P) (at level 200, x strict pattern). + Check !!!! (nat,id), nat = true /\ id = false. + + End NotationBinderNotMixedWithTerms. + +End P. diff --git a/test-suite/output/NumberNotations.out b/test-suite/output/NumberNotations.out index 8065c8d311..60682edec8 100644 --- a/test-suite/output/NumberNotations.out +++ b/test-suite/output/NumberNotations.out @@ -1,9 +1,9 @@ The command has indeed failed with message: -Unexpected term (nat -> nat) while parsing a numeral notation. +Unexpected term (nat -> nat) while parsing a number notation. The command has indeed failed with message: -Unexpected non-option term opaque4 while parsing a numeral notation. +Unexpected non-option term opaque4 while parsing a number notation. The command has indeed failed with message: -Unexpected term (fun (A : Type) (x : A) => x) while parsing a numeral +Unexpected term (fun (A : Type) (x : A) => x) while parsing a number notation. let v := 0%ppp in v : punit : punit @@ -32,7 +32,7 @@ Warning: To avoid stack overflow, large numbers in punit are interpreted as applications of pto_punits. [abstract-large-number,numbers] The command has indeed failed with message: In environment -v := pto_punits (Numeral.UIntDec (Decimal.D1 Decimal.Nil)) : punit +v := pto_punits (Number.UIntDecimal (Decimal.D1 Decimal.Nil)) : punit The term "v" has type "punit@{Set}" while it is expected to have type "punit@{u}". S @@ -61,7 +61,7 @@ The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "wuint". - = {| unwrap := Numeral.UIntDec (Decimal.D0 Decimal.Nil) |} + = {| unwrap := Number.UIntDecimal (Decimal.D0 Decimal.Nil) |} : wuint let v := 0%wuint8' in v : wuint : wuint @@ -82,7 +82,7 @@ function (of_uint) targets an option type. The command has indeed failed with message: The 'abstract after' directive has no effect when the parsing function (of_uint) targets an option type. [abstract-large-number-no-op,numbers] -let v := of_uint (Numeral.UIntDec (Decimal.D1 Decimal.Nil)) in v : unit +let v := of_uint (Number.UIntDecimal (Decimal.D1 Decimal.Nil)) in v : unit : unit let v := 0%test13 in v : unit : unit @@ -234,3 +234,282 @@ let v : ty := Build_ty Type type in v : ty : Prop 1_000 : list nat +0 + : Set +1 + : Set +2 + : Set +3 + : Set +Empty_set + : Set +unit + : Set +sum unit unit + : Set +sum unit (sum unit unit) + : Set +The command has indeed failed with message: +Missing mapping for constructor Isum. +The command has indeed failed with message: +Iunit was already mapped to unit and cannot be remapped to unit. +The command has indeed failed with message: +add is not an inductive type. +The command has indeed failed with message: +add is not a constructor of an inductive type. +The command has indeed failed with message: +Missing mapping for constructor Iempty. +File "stdin", line 574, characters 56-61: +Warning: Type of I'sum seems incompatible with the type of sum. +Expected type is: (I' -> I' -> I') instead of (I -> I' -> I'). +This might yield ill typed terms when using the notation. +[via-type-mismatch,numbers] +File "stdin", line 579, characters 32-33: +Warning: I was already mapped to Set, mapping it also to +nat might yield ill typed terms when using the notation. +[via-type-remapping,numbers] +File "stdin", line 579, characters 37-42: +Warning: Type of Iunit seems incompatible with the type of O. +Expected type is: I instead of I. +This might yield ill typed terms when using the notation. +[via-type-mismatch,numbers] +The command has indeed failed with message: +'via' and 'abstract' cannot be used together. +File "stdin", line 659, characters 21-23: +Warning: Type of I1 seems incompatible with the type of Fin.F1. +Expected type is: (nat -> I) instead of I. +This might yield ill typed terms when using the notation. +[via-type-mismatch,numbers] +File "stdin", line 659, characters 35-37: +Warning: Type of IS seems incompatible with the type of Fin.FS. +Expected type is: (nat -> I -> I) instead of (I -> I). +This might yield ill typed terms when using the notation. +[via-type-mismatch,numbers] +The command has indeed failed with message: +The term "0" has type "forall n : nat, Fin.t (S n)" +while it is expected to have type "nat". +0 + : Fin.t (S ?n) +where +?n : [ |- nat] +1 + : Fin.t (S (S ?n)) +where +?n : [ |- nat] +2 + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat] +3 + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat] +0 : Fin.t 3 + : Fin.t 3 +1 : Fin.t 3 + : Fin.t 3 +2 : Fin.t 3 + : Fin.t 3 +The command has indeed failed with message: +The term "3" has type "Fin.t (S (S (S (S ?n))))" +while it is expected to have type "Fin.t 3". +@Fin.F1 ?n + : Fin.t (S ?n) +where +?n : [ |- nat] +@Fin.FS (S ?n) (@Fin.F1 ?n) + : Fin.t (S (S ?n)) +where +?n : [ |- nat] +@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat] +@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat] +@Fin.F1 (S (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +The command has indeed failed with message: +The term + "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" +has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type + "Fin.t (S (S (S O)))". +0 + : list unit +1 + : list unit +2 + : list unit +2 + : list unit +0 :: 0 :: nil + : list nat +0 + : Ip nat bool +1 + : Ip nat bool +2 + : Ip nat bool +3 + : Ip nat bool +1 + : Ip nat bool +1 + : Ip nat bool +1 + : Ip nat bool +1 + : Ip nat bool +Ip0 nat nat 1 + : Ip nat nat +Ip0 bool bool 1 + : Ip bool bool +Ip1 nat nat 1 + : Ip nat nat +Ip3 1 nat nat + : Ip nat nat +Ip0 nat bool O + : Ip nat bool +Ip1 bool nat (S O) + : Ip nat bool +Ip2 nat (S (S O)) bool + : Ip nat bool +Ip3 (S (S (S O))) nat bool + : Ip nat bool +0 + : 0 = 0 +eq_refl + : 1 = 1 +0 + : 1 = 1 +2 + : extra_list_unit +cons O unit tt (cons O unit tt (nil O unit)) + : extra_list unit +0 + : Set +1 + : Set +2 + : Set +3 + : Set +Empty_set + : Set +unit + : Set +sum unit unit + : Set +sum unit (sum unit unit) + : Set +0 + : Fin.t (S ?n) +where +?n : [ |- nat] +1 + : Fin.t (S (S ?n)) +where +?n : [ |- nat] +2 + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat] +3 + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat] +0 : Fin.t 3 + : Fin.t 3 +1 : Fin.t 3 + : Fin.t 3 +2 : Fin.t 3 + : Fin.t 3 +The command has indeed failed with message: +The term "3" has type "Fin.t (S (S (S (S ?n))))" +while it is expected to have type "Fin.t 3". +@Fin.F1 ?n + : Fin.t (S ?n) +where +?n : [ |- nat] +@Fin.FS (S ?n) (@Fin.F1 ?n) + : Fin.t (S (S ?n)) +where +?n : [ |- nat] +@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat] +@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat] +@Fin.F1 (S (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +The command has indeed failed with message: +The term + "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" +has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type + "Fin.t (S (S (S O)))". +0 + : Fin.t (S ?n) +where +?n : [ |- nat : Set] +1 + : Fin.t (S (S ?n)) +where +?n : [ |- nat : Set] +2 + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat : Set] +3 + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat : Set] +0 : Fin.t 3 + : Fin.t 3 +1 : Fin.t 3 + : Fin.t 3 +2 : Fin.t 3 + : Fin.t 3 +The command has indeed failed with message: +The term "3" has type "Fin.t (S (S (S (S ?n))))" +while it is expected to have type "Fin.t 3". +@Fin.F1 ?n + : Fin.t (S ?n) +where +?n : [ |- nat : Set] +@Fin.FS (S ?n) (@Fin.F1 ?n) + : Fin.t (S (S ?n)) +where +?n : [ |- nat : Set] +@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) + : Fin.t (S (S (S ?n))) +where +?n : [ |- nat : Set] +@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) + : Fin.t (S (S (S (S ?n)))) +where +?n : [ |- nat : Set] +@Fin.F1 (S (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +@Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) + : Fin.t (S (S (S O))) +The command has indeed failed with message: +The term + "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" +has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type + "Fin.t (S (S (S O)))". diff --git a/test-suite/output/NumberNotations.v b/test-suite/output/NumberNotations.v index e411005da3..718da13500 100644 --- a/test-suite/output/NumberNotations.v +++ b/test-suite/output/NumberNotations.v @@ -5,17 +5,17 @@ Declare Scope opaque_scope. (* https://github.com/coq/coq/pull/8064#discussion_r202497516 *) Module Test1. Axiom hold : forall {A B C}, A -> B -> C. - Definition opaque3 (x : Numeral.int) : Numeral.int := hold x (fix f (x : nat) : nat := match x with O => O | S n => S (f n) end). - Number Notation Numeral.int opaque3 opaque3 : opaque_scope. + Definition opaque3 (x : Number.int) : Number.int := hold x (fix f (x : nat) : nat := match x with O => O | S n => S (f n) end). + Number Notation Number.int opaque3 opaque3 : opaque_scope. Delimit Scope opaque_scope with opaque. Fail Check 1%opaque. End Test1. (* https://github.com/coq/coq/pull/8064#discussion_r202497990 *) Module Test2. - Axiom opaque4 : option Numeral.int. - Definition opaque6 (x : Numeral.int) : option Numeral.int := opaque4. - Number Notation Numeral.int opaque6 opaque6 : opaque_scope. + Axiom opaque4 : option Number.int. + Definition opaque6 (x : Number.int) : option Number.int := opaque4. + Number Notation Number.int opaque6 opaque6 : opaque_scope. Delimit Scope opaque_scope with opaque. Open Scope opaque_scope. Fail Check 1%opaque. @@ -24,8 +24,8 @@ End Test2. Declare Scope silly_scope. Module Test3. - Inductive silly := SILLY (v : Numeral.uint) (f : forall A, A -> A). - Definition to_silly (v : Numeral.uint) := SILLY v (fun _ x => x). + Inductive silly := SILLY (v : Number.uint) (f : forall A, A -> A). + Definition to_silly (v : Number.uint) := SILLY v (fun _ x => x). Definition of_silly (v : silly) := match v with SILLY v _ => v end. Number Notation silly to_silly of_silly : silly_scope. Delimit Scope silly_scope with silly. @@ -45,15 +45,15 @@ Module Test4. Declare Scope upp. Declare Scope ppps. Polymorphic NonCumulative Inductive punit := ptt. - Polymorphic Definition pto_punit (v : Numeral.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. - Polymorphic Definition pto_punit_all (v : Numeral.uint) : punit := ptt. - Polymorphic Definition pof_punit (v : punit) : Numeral.uint := Nat.to_num_uint 0. - Definition to_punit (v : Numeral.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. - Definition of_punit (v : punit) : Numeral.uint := Nat.to_num_uint 0. - Polymorphic Definition pto_unit (v : Numeral.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. - Polymorphic Definition pof_unit (v : unit) : Numeral.uint := Nat.to_num_uint 0. - Definition to_unit (v : Numeral.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. - Definition of_unit (v : unit) : Numeral.uint := Nat.to_num_uint 0. + Polymorphic Definition pto_punit (v : Number.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. + Polymorphic Definition pto_punit_all (v : Number.uint) : punit := ptt. + Polymorphic Definition pof_punit (v : punit) : Number.uint := Nat.to_num_uint 0. + Definition to_punit (v : Number.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. + Definition of_punit (v : punit) : Number.uint := Nat.to_num_uint 0. + Polymorphic Definition pto_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. + Polymorphic Definition pof_unit (v : unit) : Number.uint := Nat.to_num_uint 0. + Definition to_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. + Definition of_unit (v : unit) : Number.uint := Nat.to_num_uint 0. Number Notation punit to_punit of_punit : pto. Number Notation punit pto_punit of_punit : ppo. Number Notation punit to_punit pof_punit : ptp. @@ -83,7 +83,7 @@ Module Test4. Polymorphic Definition pto_punits := pto_punit_all@{Set}. Polymorphic Definition pof_punits := pof_punit@{Set}. - Number Notation punit pto_punits pof_punits : ppps (abstract after 1). + Number Notation punit pto_punits pof_punits (abstract after 1) : ppps. Delimit Scope ppps with ppps. Universe u. Constraint Set < u. @@ -96,7 +96,7 @@ Module Test5. End Test5. Module Test6. - (* Check that numeral notations on enormous terms don't take forever to print/parse *) + (* Check that number notations on enormous terms don't take forever to print/parse *) (* Ackerman definition from https://stackoverflow.com/a/10303475/377022 *) Fixpoint ack (n m : nat) : nat := match n with @@ -113,15 +113,15 @@ Module Test6. Local Set Primitive Projections. Record > wnat := wrap { unwrap :> nat }. - Definition to_uint (x : wnat) : Numeral.uint := Nat.to_num_uint x. - Definition of_uint (x : Numeral.uint) : wnat := Nat.of_num_uint x. + Definition to_uint (x : wnat) : Number.uint := Nat.to_num_uint x. + Definition of_uint (x : Number.uint) : wnat := Nat.of_num_uint x. Module Export Scopes. Declare Scope wnat_scope. Delimit Scope wnat_scope with wnat. End Scopes. Module Export Notations. Export Scopes. - Number Notation wnat of_uint to_uint : wnat_scope (abstract after 5000). + Number Notation wnat of_uint to_uint (abstract after 5000) : wnat_scope. End Notations. Set Printing Coercions. Check let v := 0%wnat in v : wnat. @@ -138,7 +138,7 @@ End Test6_2. Module Test7. Local Set Primitive Projections. - Record wuint := wrap { unwrap : Numeral.uint }. + Record wuint := wrap { unwrap : Number.uint }. Declare Scope wuint_scope. Delimit Scope wuint_scope with wuint. Number Notation wuint wrap unwrap : wuint_scope. @@ -148,7 +148,7 @@ End Test7. Module Test8. Local Set Primitive Projections. - Record wuint := wrap { unwrap : Numeral.uint }. + Record wuint := wrap { unwrap : Number.uint }. Declare Scope wuint8_scope. Declare Scope wuint8'_scope. Delimit Scope wuint8_scope with wuint8. @@ -177,7 +177,7 @@ Module Test9. Delimit Scope wuint9'_scope with wuint9'. Section with_let. Local Set Primitive Projections. - Record wuint := wrap { unwrap : Numeral.uint }. + Record wuint := wrap { unwrap : Number.uint }. Let wrap' := wrap. Let unwrap' := unwrap. Local Notation wrap'' := wrap. @@ -194,26 +194,26 @@ End Test9. Module Test10. (* Test that it is only a warning to add abstract after to an optional parsing function *) Definition to_uint (v : unit) := Nat.to_num_uint 0. - Definition of_uint (v : Numeral.uint) := match Nat.of_num_uint v with O => Some tt | _ => None end. - Definition of_any_uint (v : Numeral.uint) := tt. + Definition of_uint (v : Number.uint) := match Nat.of_num_uint v with O => Some tt | _ => None end. + Definition of_any_uint (v : Number.uint) := tt. Declare Scope unit_scope. Declare Scope unit2_scope. Delimit Scope unit_scope with unit. Delimit Scope unit2_scope with unit2. - Number Notation unit of_uint to_uint : unit_scope (abstract after 1). + Number Notation unit of_uint to_uint (abstract after 1) : unit_scope. Local Set Warnings Append "+abstract-large-number-no-op". (* Check that there is actually a warning here *) - Fail Number Notation unit of_uint to_uint : unit2_scope (abstract after 1). + Fail Number Notation unit of_uint to_uint (abstract after 1) : unit2_scope. (* Check that there is no warning here *) - Number Notation unit of_any_uint to_uint : unit2_scope (abstract after 1). + Number Notation unit of_any_uint to_uint (abstract after 1) : unit2_scope. End Test10. Module Test12. - (* Test for numeral notations on context variables *) + (* Test for number notations on context variables *) Declare Scope test12_scope. Delimit Scope test12_scope with test12. Section test12. - Context (to_uint : unit -> Numeral.uint) (of_uint : Numeral.uint -> unit). + Context (to_uint : unit -> Number.uint) (of_uint : Number.uint -> unit). Number Notation unit of_uint to_uint : test12_scope. Check let v := 1%test12 in v : unit. @@ -221,15 +221,15 @@ Module Test12. End Test12. Module Test13. - (* Test for numeral notations on notations which do not denote references *) + (* Test for number notations on notations which do not denote references *) Declare Scope test13_scope. Declare Scope test13'_scope. Declare Scope test13''_scope. Delimit Scope test13_scope with test13. Delimit Scope test13'_scope with test13'. Delimit Scope test13''_scope with test13''. - Definition to_uint (x y : unit) : Numeral.uint := Nat.to_num_uint O. - Definition of_uint (x : Numeral.uint) : unit := tt. + Definition to_uint (x y : unit) : Number.uint := Nat.to_num_uint O. + Definition of_uint (x : Number.uint) : unit := tt. Definition to_uint_good := to_uint tt. Notation to_uint' := (to_uint tt). Notation to_uint'' := (to_uint _). @@ -242,7 +242,7 @@ Module Test13. End Test13. Module Test14. - (* Test that numeral notations follow [Import], not [Require], and + (* Test that number notations follow [Import], not [Require], and also test that [Local Number Notation]s do not escape modules nor sections. *) Declare Scope test14_scope. @@ -254,8 +254,8 @@ Module Test14. Delimit Scope test14''_scope with test14''. Delimit Scope test14'''_scope with test14'''. Module Inner. - Definition to_uint (x : unit) : Numeral.uint := Nat.to_num_uint O. - Definition of_uint (x : Numeral.uint) : unit := tt. + Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. + Definition of_uint (x : Number.uint) : unit := tt. Local Number Notation unit of_uint to_uint : test14_scope. Global Number Notation unit of_uint to_uint : test14'_scope. Check let v := 0%test14 in v : unit. @@ -267,8 +267,8 @@ Module Test14. Fail Check let v := 0%test14 in v : unit. Check let v := 0%test14' in v : unit. Section InnerSection. - Definition to_uint (x : unit) : Numeral.uint := Nat.to_num_uint O. - Definition of_uint (x : Numeral.uint) : unit := tt. + Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. + Definition of_uint (x : Number.uint) : unit := tt. Local Number Notation unit of_uint to_uint : test14''_scope. Fail Global Number Notation unit of_uint to_uint : test14'''_scope. Check let v := 0%test14'' in v : unit. @@ -283,8 +283,8 @@ Module Test15. Declare Scope test15_scope. Delimit Scope test15_scope with test15. Module Inner. - Definition to_uint (x : unit) : Numeral.uint := Nat.to_num_uint O. - Definition of_uint (x : Numeral.uint) : unit := tt. + Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. + Definition of_uint (x : Number.uint) : unit := tt. Number Notation unit of_uint to_uint : test15_scope. Check let v := 0%test15 in v : unit. End Inner. @@ -306,8 +306,8 @@ Module Test16. End A. Module F (a : A). Inductive Foo := foo (_ : a.T). - Definition to_uint (x : Foo) : Numeral.uint := Nat.to_num_uint O. - Definition of_uint (x : Numeral.uint) : Foo := foo a.t. + Definition to_uint (x : Foo) : Number.uint := Nat.to_num_uint O. + Definition of_uint (x : Number.uint) : Foo := foo a.t. Global Number Notation Foo of_uint to_uint : test16_scope. Check let v := 0%test16 in v : Foo. End F. @@ -352,8 +352,8 @@ Module Test18. Definition Q_of_nat (x : nat) : Q := {| num := x ; den := 1 ; reduced := transparentify (nat_eq_dec _ _) (gcd_good _) |}. Definition nat_of_Q (x : Q) : option nat := if Nat.eqb x.(den) 1 then Some (x.(num)) else None. - Definition Q_of_uint (x : Numeral.uint) : Q := Q_of_nat (Nat.of_num_uint x). - Definition uint_of_Q (x : Q) : option Numeral.uint + Definition Q_of_uint (x : Number.uint) : Q := Q_of_nat (Nat.of_num_uint x). + Definition uint_of_Q (x : Q) : option Number.uint := option_map Nat.to_num_uint (nat_of_Q x). Number Notation Q Q_of_uint uint_of_Q : Q_scope. @@ -411,7 +411,7 @@ Module Test20. Record > ty := { t : Type ; kt : known_type t }. - Definition ty_of_uint (x : Numeral.uint) : option ty + Definition ty_of_uint (x : Number.uint) : option ty := match Nat.of_num_uint x with | 0 => @Some ty zero | 1 => @Some ty one @@ -421,7 +421,7 @@ Module Test20. | 5 => @Some ty type | _ => None end. - Definition uint_of_ty (x : ty) : Numeral.uint + Definition uint_of_ty (x : ty) : Number.uint := Nat.to_num_uint match kt x with | prop => 3 | set => 4 @@ -487,3 +487,488 @@ Check (-0)%Z. *) End Test22. + +(* Test the via ... mapping ... option *) +Module Test23. + +Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. + +Inductive I := +| Iempty : I +| Iunit : I +| Isum : I -> I -> I. + +Definition of_uint (x : Number.uint) : I := + let fix f n := + match n with + | O => Iempty + | S O => Iunit + | S n => Isum Iunit (f n) + end in + f (Nat.of_num_uint x). + +Definition to_uint (x : I) : Number.uint := + let fix f i := + match i with + | Iempty => O + | Iunit => 1 + | Isum i1 i2 => f i1 + f i2 + end in + Nat.to_num_uint (f x). + +Notation nSet := (Set) (only parsing). (* needed as a reference is expected in Number Notation and Set is syntactically not a reference *) +Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) + : type_scope. + +Local Open Scope type_scope. + +Check Empty_set. +Check unit. +Check sum unit unit. +Check sum unit (sum unit unit). +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Unset Printing All. + +(* Test error messages *) + +(* missing constructor *) +Fail Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit]) + : type_scope. + +(* duplicate constructor *) +Fail Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum, unit => Iunit]) + : type_scope. + +(* not an inductive *) +Fail Number Notation nSet of_uint to_uint (via add + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) + : type_scope. + +(* not a constructor *) +Fail Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => add, sum => Isum]) + : type_scope. + +(* put constructors of the wrong inductive ~~> missing constructors *) +Fail Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => O, unit => S]) + : type_scope. + +(* Test warnings *) + +(* wrong type *) +Inductive I' := +| I'empty : I' +| I'unit : I' +| I'sum : I -> I' -> I'. +Definition of_uint' (x : Number.uint) : I' := I'empty. +Definition to_uint' (x : I') : Number.uint := Number.UIntDecimal Decimal.Nil. +Number Notation nSet of_uint' to_uint' (via I' + mapping [Empty_set => I'empty, unit => I'unit, sum => I'sum]) + : type_scope. + +(* wrong type mapping *) +Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, O => Iunit, sum => Isum]) + : type_scope. + +(* incompatibility with abstract (but warning is fine) *) +Fail Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum], + abstract after 12) + : type_scope. +Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum], + warning after 12) + : type_scope. + +(* Test reduction of types when building the notation *) + +Inductive foo := bar : match (true <: bool) with true => nat -> foo | false => True end. + +Definition foo_of_uint (x : Number.uint) : foo := bar (Nat.of_num_uint x). +Definition foo_to_uint (x : foo) : Number.uint := + match x with + | bar x => Nat.to_num_uint x + end. + +Number Notation foo foo_of_uint foo_to_uint (via foo mapping [bar => bar]) + : type_scope. + +Inductive foo' := bar' : let n := nat in n -> foo'. + +Definition foo'_of_uint (x : Number.uint) : foo' := bar' (Nat.of_num_uint x). +Definition foo'_to_uint (x : foo') : Number.uint := + match x with + | bar' x => Nat.to_num_uint x + end. + +Number Notation foo' foo'_of_uint foo'_to_uint (via foo' mapping [bar' => bar']) + : type_scope. + +Inductive foo'' := bar'' : (nat <: Type) -> (foo'' <: Type). + +Definition foo''_of_uint (x : Number.uint) : foo'' := bar'' (Nat.of_num_uint x). +Definition foo''_to_uint (x : foo'') : Number.uint := + match x with + | bar'' x => Nat.to_num_uint x + end. + +Number Notation foo'' foo''_of_uint foo''_to_uint (via foo'' mapping [bar'' => bar'']) + : type_scope. + +End Test23. + +(* Test the via ... mapping ... option with implicit arguments *) +Require Vector. +Module Test24. + +Import Vector. + +Inductive I := +| I1 : I +| IS : I -> I. + +Definition of_uint (x : Number.uint) : I := + let fix f n := + match n with + | O => I1 + | S n => IS (f n) + end in + f (Nat.of_num_uint x). + +Definition to_uint (x : I) : Number.uint := + let fix f i := + match i with + | I1 => O + | IS n => S (f n) + end in + Nat.to_num_uint (f x). + +Local Open Scope type_scope. + +(* ignoring implicit arguments doesn't work *) +Number Notation Fin.t of_uint to_uint (via I + mapping [Fin.F1 => I1, Fin.FS => IS]) + : type_scope. + +Fail Check 1. + +Number Notation Fin.t of_uint to_uint (via I + mapping [[Fin.F1] => I1, [Fin.FS] => IS]) + : type_scope. + +Check Fin.F1. +Check Fin.FS Fin.F1. +Check Fin.FS (Fin.FS Fin.F1). +Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). +Check Fin.F1 : Fin.t 3. +Check Fin.FS Fin.F1 : Fin.t 3. +Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. +Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Check 0 : Fin.t 3. +Check 1 : Fin.t 3. +Check 2 : Fin.t 3. +Fail Check 3 : Fin.t 3. +Unset Printing All. + +End Test24. + +(* Test number notations for parameterized inductives *) +Module Test25. + +Definition of_uint (u : Number.uint) : list unit := + let fix f n := + match n with + | O => nil + | S n => cons tt (f n) + end in + f (Nat.of_num_uint u). + +Definition to_uint (l : list unit) : Number.uint := + let fix f n := + match n with + | nil => O + | cons tt l => S (f l) + end in + Nat.to_num_uint (f l). + +Notation listunit := (list unit) (only parsing). +Number Notation listunit of_uint to_uint : nat_scope. + +Check 0. +Check 1. +Check 2. + +Check cons tt (cons tt nil). +Check cons O (cons O nil). (* printer not called on list nat *) + +(* inductive with multiple parameters that are not the first + parameters and not in the same order for each constructor *) +Inductive Ip : Type -> Type -> Type := +| Ip0 : forall T T', nat -> Ip T T' +| Ip1 : forall T' T, nat -> Ip T T' +| Ip2 : forall T, nat -> forall T', Ip T T' +| Ip3 : nat -> forall T T', Ip T T'. + +Definition Ip_of_uint (u : Number.uint) : option (Ip nat bool) := + let f n := + match n with + | O => Some (Ip0 nat bool O) + | S O => Some (Ip1 bool nat (S O)) + | S (S O) => Some (Ip2 nat (S (S O)) bool) + | S (S (S O)) => Some (Ip3 (S (S (S O))) nat bool) + | _ => None + end in + f (Nat.of_num_uint u). + +Definition Ip_to_uint (l : Ip nat bool) : Number.uint := + let f n := + match n with + | Ip0 _ _ n => n + | Ip1 _ _ n => n + | Ip2 _ n _ => n + | Ip3 n _ _ => n + end in + Nat.to_num_uint (f l). + +Notation Ip_nat_bool := (Ip nat bool) (only parsing). +Number Notation Ip_nat_bool Ip_of_uint Ip_to_uint : nat_scope. + +Check 0. +Check 1. +Check 2. +Check 3. +Check Ip0 nat bool (S O). +Check Ip1 bool nat (S O). +Check Ip2 nat (S O) bool. +Check Ip3 (S O) nat bool. +Check Ip0 nat nat (S O). (* not printed *) +Check Ip0 bool bool (S O). (* not printed *) +Check Ip1 nat nat (S O). (* not printed *) +Check Ip3 (S O) nat nat. (* not printed *) +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Unset Printing All. + +Notation eqO := (eq _ O) (only parsing). +Definition eqO_of_uint (x : Number.uint) : eqO := eq_refl O. +Definition eqO_to_uint (x : O = O) : Number.uint := + match x with + | eq_refl _ => Nat.to_num_uint O + end. +Number Notation eqO eqO_of_uint eqO_to_uint : nat_scope. + +Check 42. +Check eq_refl (S O). (* doesn't match eq _ O, printer not called *) + +Notation eq_ := (eq _ _) (only parsing). +Number Notation eq_ eqO_of_uint eqO_to_uint : nat_scope. + +Check eq_refl (S O). (* matches eq _ _, printer called *) + +Inductive extra_list : Type -> Type := +| nil (n : nat) (v : Type) : extra_list v +| cons (n : nat) (t : Type) (x : t) : extra_list t -> extra_list t. + +Definition extra_list_unit_of_uint (x : Number.uint) : extra_list unit := + let fix f n := + match n with + | O => nil O unit + | S n => cons O unit tt (f n) + end in + f (Nat.of_num_uint x). + +Definition extra_list_unit_to_uint (x : extra_list unit) : Number.uint := + let fix f T (x : extra_list T) := + match x with + | nil _ _ => O + | cons _ T _ x => S (f T x) + end in + Nat.to_num_uint (f unit x). + +Notation extra_list_unit := (extra_list unit). +Number Notation extra_list_unit + extra_list_unit_of_uint extra_list_unit_to_uint : nat_scope. + +Check 2. +Set Printing All. +Check 2. +Unset Printing All. + +End Test25. + +(* Test the via ... mapping ... option with let-binders, beta-redexes, delta-redexes, etc *) +Module Test26. + +Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. + +Inductive I (dummy:=O) := +| Iempty : let v := I in id v +| Iunit : (fun x => x) I +| Isum : let v := I in (fun A B => A -> B) (let v' := v in v') (forall x : match O with O => I | _ => Empty_set end, let dummy2 := x in I). + +Definition of_uint (x : (fun x => let v := I in x) Number.uint) : (fun x => let v := I in x) I := + let fix f n := + match n with + | O => Iempty + | S O => Iunit + | S n => Isum Iunit (f n) + end in + f (Nat.of_num_uint x). + +Definition to_uint (x : (fun x => let v := x in v) I) : match O with O => Number.uint | _ => Empty_set end := + let fix f i := + match i with + | Iempty => O + | Iunit => 1 + | Isum i1 i2 => f i1 + f i2 + end in + Nat.to_num_uint (f x). + +Notation nSet := (Set) (only parsing). (* needed as a reference is expected in Number Notation and Set is syntactically not a reference *) +Number Notation nSet of_uint to_uint (via I + mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) + : type_scope. + +Local Open Scope type_scope. + +Check Empty_set. +Check unit. +Check sum unit unit. +Check sum unit (sum unit unit). +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Unset Printing All. +End Test26. + +(* Test the via ... mapping ... option with implicit arguments with let binders, etc *) +Module Test27. + +Module Fin. +Inductive t0 (x:=O) := +with + t (x:=O) : forall y : nat, let z := y in Set := +| F1 (y:=O) {n} : match y with O => t (S n) | _ => Empty_set end +| FS (y:=x) {n} (v:=n+y) (m:=n) : id (match y with O => id (t n) | _ => Empty_set end -> (fun x => x) t (S m)) +with t' (x:=O) := . +End Fin. + +Inductive I (dummy:=O) := +| I1 : I +| IS : let x := I in id x -> I. + +Definition of_uint (x : Number.uint) : I := + let fix f n := + match n with + | O => I1 + | S n => IS (f n) + end in + f (Nat.of_num_uint x). + +Definition to_uint (x : I) : Number.uint := + let fix f i := + match i with + | I1 => O + | IS n => S (f n) + end in + Nat.to_num_uint (f x). + +Local Open Scope type_scope. + +Number Notation Fin.t of_uint to_uint (via I + mapping [[Fin.F1] => I1, [Fin.FS] => IS]) + : type_scope. + +Check Fin.F1. +Check Fin.FS Fin.F1. +Check Fin.FS (Fin.FS Fin.F1). +Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). +Check Fin.F1 : Fin.t 3. +Check Fin.FS Fin.F1 : Fin.t 3. +Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. +Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Check 0 : Fin.t 3. +Check 1 : Fin.t 3. +Check 2 : Fin.t 3. +Fail Check 3 : Fin.t 3. +Unset Printing All. + +End Test27. + +Module Test28. +Module Fin. +Inductive t : nat -> Set := +| F1 {n : (nat : Set)} : (t (S n) : Set) +| FS {n : (nat : Set)} : (t n : Set) -> (t (S n) : Set). +End Fin. + +Inductive I := +| I1 : I +| IS : I -> I. + +Definition of_uint (x : Number.uint) : I := + let fix f n := + match n with + | O => I1 + | S n => IS (f n) + end in + f (Nat.of_num_uint x). + +Definition to_uint (x : I) : Number.uint := + let fix f i := + match i with + | I1 => O + | IS n => S (f n) + end in + Nat.to_num_uint (f x). + +Local Open Scope type_scope. + +Number Notation Fin.t of_uint to_uint (via I + mapping [[Fin.F1] => I1, [Fin.FS] => IS]) + : type_scope. + +Check Fin.F1. +Check Fin.FS Fin.F1. +Check Fin.FS (Fin.FS Fin.F1). +Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). +Check Fin.F1 : Fin.t 3. +Check Fin.FS Fin.F1 : Fin.t 3. +Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. +Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. +Set Printing All. +Check 0. +Check 1. +Check 2. +Check 3. +Check 0 : Fin.t 3. +Check 1 : Fin.t 3. +Check 2 : Fin.t 3. +Fail Check 3 : Fin.t 3. +Unset Printing All. + +End Test28. diff --git a/test-suite/output/QArithSyntax.out b/test-suite/output/QArithSyntax.out index 9b5c076cb4..ced52524f2 100644 --- a/test-suite/output/QArithSyntax.out +++ b/test-suite/output/QArithSyntax.out @@ -1,26 +1,72 @@ eq_refl : 1.02 = 1.02 : 1.02 = 1.02 -eq_refl : 10.2 = 10.2 - : 10.2 = 10.2 -eq_refl : 1020 = 1020 - : 1020 = 1020 -eq_refl : 102 = 102 - : 102 = 102 -eq_refl : 1.02 = 1.02 - : 1.02 = 1.02 -eq_refl : -1e-4 = -1e-4 - : -1e-4 = -1e-4 +1.02e1 + : Q +10.2 + : Q +1.02e3 + : Q +1020 + : Q +1.02e2 + : Q +102 + : Q +eq_refl : 10.2e-1 = 1.02 + : 10.2e-1 = 1.02 +eq_refl : -0.0001 = -0.0001 + : -0.0001 = -0.0001 eq_refl : -0.50 = -0.50 : -0.50 = -0.50 -eq_refl : -26 = -26 - : -26 = -26 -eq_refl : 2860 # 256 = 2860 # 256 - : 2860 # 256 = 2860 # 256 -eq_refl : -6882 = -6882 - : -6882 = -6882 -eq_refl : 2860 # 64 = 2860 # 64 - : 2860 # 64 = 2860 # 64 -eq_refl : 2860 = 2860 - : 2860 = 2860 -eq_refl : -2860 # 1024 = -2860 # 1024 - : -2860 # 1024 = -2860 # 1024 +0 + : Q +0 + : Q +42 + : Q +42 + : Q +1.23 + : Q +0x1.23%xQ + : Q +0.0012 + : Q +42e3 + : Q +42e-3 + : Q +eq_refl : -0x1a = -0x1a + : -0x1a = -0x1a +eq_refl : 0xb.2c = 0xb.2c + : 0xb.2c = 0xb.2c +eq_refl : -0x1ae2 = -0x1ae2 + : -0x1ae2 = -0x1ae2 +0xb.2cp2 + : Q +2860 # 64 + : Q +0xb.2cp8 + : Q +0xb2c + : Q +eq_refl : -0xb.2cp-2 = -2860 # 1024 + : -0xb.2cp-2 = -2860 # 1024 +0x0 + : Q +0x0 + : Q +0x2a + : Q +0x2a + : Q +1.23%Q + : Q +0x1.23 + : Q +0x0.0012 + : Q +0x2ap3 + : Q +0x2ap-3 + : Q diff --git a/test-suite/output/QArithSyntax.v b/test-suite/output/QArithSyntax.v index b5c6222bba..e979abca66 100644 --- a/test-suite/output/QArithSyntax.v +++ b/test-suite/output/QArithSyntax.v @@ -1,15 +1,39 @@ Require Import QArith. Open Scope Q_scope. Check (eq_refl : 1.02 = 102 # 100). -Check (eq_refl : 1.02e1 = 102 # 10). -Check (eq_refl : 1.02e+03 = 1020). -Check (eq_refl : 1.02e+02 = 102 # 1). +Check 1.02e1. +Check 102 # 10. +Check 1.02e+03. +Check 1020. +Check 1.02e+02. +Check 102 # 1. Check (eq_refl : 10.2e-1 = 1.02). Check (eq_refl : -0.0001 = -1 # 10000). Check (eq_refl : -0.50 = - 50 # 100). +Check 0. +Check 000. +Check 42. +Check 0x2a. +Check 1.23. +Check 0x1.23. +Check 0.0012. +Check 42e3. +Check 42e-3. +Open Scope hex_Q_scope. Check (eq_refl : -0x1a = - 26 # 1). Check (eq_refl : 0xb.2c = 2860 # 256). Check (eq_refl : -0x1ae2 = -6882). -Check (eq_refl : 0xb.2cp2 = 2860 # 64). -Check (eq_refl : 0xb.2cp8 = 2860). +Check 0xb.2cp2. +Check 2860 # 64. +Check 0xb.2cp8. +Check 2860. Check (eq_refl : -0xb.2cp-2 = -2860 # 1024). +Check 0x0. +Check 0x00. +Check 42. +Check 0x2a. +Check 1.23. +Check 0x1.23. +Check 0x0.0012. +Check 0x2ap3. +Check 0x2ap-3. diff --git a/test-suite/output/RealSyntax.out b/test-suite/output/RealSyntax.out index a9386b2781..a7b7dabb20 100644 --- a/test-suite/output/RealSyntax.out +++ b/test-suite/output/RealSyntax.out @@ -4,34 +4,81 @@ : R 1.5%R : R -15%R - : R -eq_refl : 1.02 = 1.02 - : 1.02 = 1.02 -eq_refl : 10.2 = 10.2 - : 10.2 = 10.2 -eq_refl : 102e1 = 102e1 - : 102e1 = 102e1 -eq_refl : 102 = 102 - : 102 = 102 -eq_refl : 1.02 = 1.02 - : 1.02 = 1.02 -eq_refl : -1e-4 = -1e-4 - : -1e-4 = -1e-4 -eq_refl : -0.50 = -0.50 - : -0.50 = -0.50 +1.5e1%R + : R +eq_refl : 1.02 = 102e-2 + : 1.02 = 102e-2 +1.02e1 + : R +102e-1 + : R +1.02e3 + : R +102e1 + : R +1.02e2 + : R +102 + : R +10.2e-1 + : R +1.02 + : R +eq_refl : -0.0001 = -1e-4 + : -0.0001 = -1e-4 +eq_refl : -0.50 = -50e-2 + : -0.50 = -50e-2 eq_refl : -26 = -26 : -26 = -26 -eq_refl : 2860 / IZR (BinIntDef.Z.pow_pos 2 8) = 2860 / IZR (Z.pow_pos 2 8) - : 2860 / IZR (BinIntDef.Z.pow_pos 2 8) = 2860 / IZR (Z.pow_pos 2 8) +eq_refl : 0xb.2c%xR = 0xb2cp-8%xR + : 0xb.2c%xR = 0xb2cp-8%xR eq_refl : -6882 = -6882 : -6882 = -6882 -eq_refl : 2860 / IZR (BinIntDef.Z.pow_pos 2 6) = 2860 / IZR (Z.pow_pos 2 6) - : 2860 / IZR (BinIntDef.Z.pow_pos 2 6) = 2860 / IZR (Z.pow_pos 2 6) -eq_refl : 2860 = 2860 - : 2860 = 2860 -eq_refl -: --2860 / IZR (BinIntDef.Z.pow_pos 2 10) = - (2860) / IZR (Z.pow_pos 2 10) - : -2860 / IZR (BinIntDef.Z.pow_pos 2 10) = - - (2860) / IZR (Z.pow_pos 2 10) +0xb.2cp2%xR + : R +0xb2cp-6%xR + : R +0xb.2cp8%xR + : R +2860 + : R +(-0xb.2cp-2)%xR + : R +- 0xb2cp-10%xR + : R +0 + : R +0 + : R +42 + : R +42 + : R +1.23 + : R +0x1.23%xR + : R +0.0012 + : R +42e3 + : R +42e-3 + : R +0x0 + : R +0x0 + : R +0x2a + : R +0x2a + : R +1.23%R + : R +0x1.23 + : R +0x0.0012 + : R +0x2ap3 + : R +0x2ap-3 + : R diff --git a/test-suite/output/RealSyntax.v b/test-suite/output/RealSyntax.v index 69ce3ef5f9..790d5c654f 100644 --- a/test-suite/output/RealSyntax.v +++ b/test-suite/output/RealSyntax.v @@ -8,18 +8,48 @@ Check 1_.5_e1_%R. Open Scope R_scope. Check (eq_refl : 1.02 = IZR 102 / IZR (Z.pow_pos 10 2)). -Check (eq_refl : 1.02e1 = IZR 102 / IZR (Z.pow_pos 10 1)). -Check (eq_refl : 1.02e+03 = IZR 102 * IZR (Z.pow_pos 10 1)). -Check (eq_refl : 1.02e+02 = IZR 102). -Check (eq_refl : 10.2e-1 = 1.02). +Check 1.02e1. +Check IZR 102 / IZR (Z.pow_pos 10 1). +Check 1.02e+03. +Check IZR 102 * IZR (Z.pow_pos 10 1). +Check 1.02e+02. +Check IZR 102. +Check 10.2e-1. +Check 1.02. Check (eq_refl : -0.0001 = IZR (-1) / IZR (Z.pow_pos 10 4)). Check (eq_refl : -0.50 = IZR (-50) / IZR (Z.pow_pos 10 2)). Check (eq_refl : -0x1a = - 26). Check (eq_refl : 0xb.2c = IZR 2860 / IZR (Z.pow_pos 2 8)). Check (eq_refl : -0x1ae2 = -6882). -Check (eq_refl : 0xb.2cp2 = IZR 2860 / IZR (Z.pow_pos 2 6)). -Check (eq_refl : 0xb.2cp8 = 2860). -Check (eq_refl : -0xb.2cp-2 = - IZR 2860 / IZR (Z.pow_pos 2 10)). +Check 0xb.2cp2. +Check IZR 2860 / IZR (Z.pow_pos 2 6). +Check 0xb.2cp8. +Check 2860. +Check -0xb.2cp-2. +Check - (IZR 2860 / IZR (Z.pow_pos 2 10)). +Check 0. +Check 000. +Check 42. +Check 0x2a. +Check 1.23. +Check 0x1.23. +Check 0.0012. +Check 42e3. +Check 42e-3. + +Open Scope hex_R_scope. + +Check 0x0. +Check 0x000. +Check 42. +Check 0x2a. +Check 1.23. +Check 0x1.23. +Check 0x0.0012. +Check 0x2ap3. +Check 0x2ap-3. + +Close Scope hex_R_scope. Require Import Reals. diff --git a/test-suite/output/Search.out b/test-suite/output/Search.out index 09feca71e7..ef4c6bac93 100644 --- a/test-suite/output/Search.out +++ b/test-suite/output/Search.out @@ -30,15 +30,15 @@ implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool BoolSpec: Prop -> Prop -> bool -> Prop -Numeral.numeral_beq: Numeral.numeral -> Numeral.numeral -> bool +Number.number_beq: Number.number -> Number.number -> bool Nat.eqb: nat -> nat -> bool Nat.testbit: nat -> nat -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool -Numeral.uint_beq: Numeral.uint -> Numeral.uint -> bool +Number.uint_beq: Number.uint -> Number.uint -> bool Decimal.uint_beq: Decimal.uint -> Decimal.uint -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool -Numeral.int_beq: Numeral.int -> Numeral.int -> bool +Number.int_beq: Number.int -> Number.int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool @@ -64,34 +64,34 @@ eq_true_rec: bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b eq_true_sind: forall P : bool -> SProp, P true -> forall b : bool, eq_true b -> P b -Numeral.internal_uint_dec_bl1: - forall x y : Numeral.uint, Numeral.uint_beq x y = true -> x = y +Number.internal_uint_dec_bl1: + forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true Hexadecimal.internal_int_dec_lb0: forall x y : Hexadecimal.int, x = y -> Hexadecimal.int_beq x y = true -Numeral.internal_numeral_dec_lb: - forall x y : Numeral.numeral, x = y -> Numeral.numeral_beq x y = true +Number.internal_number_dec_lb: + forall x y : Number.number, x = y -> Number.number_beq x y = true Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Hexadecimal.internal_int_dec_bl0: forall x y : Hexadecimal.int, Hexadecimal.int_beq x y = true -> x = y -Numeral.internal_int_dec_lb1: - forall x y : Numeral.int, x = y -> Numeral.int_beq x y = true -Numeral.internal_int_dec_bl1: - forall x y : Numeral.int, Numeral.int_beq x y = true -> x = y +Number.internal_int_dec_lb1: + forall x y : Number.int, x = y -> Number.int_beq x y = true +Number.internal_int_dec_bl1: + forall x y : Number.int, Number.int_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y -Numeral.internal_uint_dec_lb1: - forall x y : Numeral.uint, x = y -> Numeral.uint_beq x y = true +Number.internal_uint_dec_lb1: + forall x y : Number.uint, x = y -> Number.uint_beq x y = true Decimal.internal_int_dec_bl: forall x y : Decimal.int, Decimal.int_beq x y = true -> x = y Decimal.internal_int_dec_lb: forall x y : Decimal.int, x = y -> Decimal.int_beq x y = true -Numeral.internal_numeral_dec_bl: - forall x y : Numeral.numeral, Numeral.numeral_beq x y = true -> x = y +Number.internal_number_dec_bl: + forall x y : Number.number, Number.number_beq x y = true -> x = y Byte.of_bits: bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) -> Byte.byte @@ -160,21 +160,21 @@ f_equal2_mult: f_equal2_nat: forall (B : Type) (f : nat -> nat -> B) (x1 y1 x2 y2 : nat), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2 -Numeral.internal_numeral_dec_lb: - forall x y : Numeral.numeral, x = y -> Numeral.numeral_beq x y = true -Numeral.internal_int_dec_lb1: - forall x y : Numeral.int, x = y -> Numeral.int_beq x y = true -Numeral.internal_numeral_dec_bl: - forall x y : Numeral.numeral, Numeral.numeral_beq x y = true -> x = y +Number.internal_number_dec_lb: + forall x y : Number.number, x = y -> Number.number_beq x y = true +Number.internal_int_dec_lb1: + forall x y : Number.int, x = y -> Number.int_beq x y = true +Number.internal_number_dec_bl: + forall x y : Number.number, Number.number_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true -Numeral.internal_int_dec_bl1: - forall x y : Numeral.int, Numeral.int_beq x y = true -> x = y -Numeral.internal_uint_dec_lb1: - forall x y : Numeral.uint, x = y -> Numeral.uint_beq x y = true -Numeral.internal_uint_dec_bl1: - forall x y : Numeral.uint, Numeral.uint_beq x y = true -> x = y +Number.internal_int_dec_bl1: + forall x y : Number.int, Number.int_beq x y = true -> x = y +Number.internal_uint_dec_lb1: + forall x y : Number.uint, x = y -> Number.uint_beq x y = true +Number.internal_uint_dec_bl1: + forall x y : Number.uint, Number.uint_beq x y = true -> x = y Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Hexadecimal.internal_hexadecimal_dec_bl: @@ -213,18 +213,18 @@ bool_choice: forall [S : Set] [R1 R2 : S -> Prop], (forall x : S, {R1 x} + {R2 x}) -> {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x} -Numeral.internal_numeral_dec_lb: - forall x y : Numeral.numeral, x = y -> Numeral.numeral_beq x y = true -Numeral.internal_numeral_dec_bl: - forall x y : Numeral.numeral, Numeral.numeral_beq x y = true -> x = y -Numeral.internal_int_dec_lb1: - forall x y : Numeral.int, x = y -> Numeral.int_beq x y = true -Numeral.internal_int_dec_bl1: - forall x y : Numeral.int, Numeral.int_beq x y = true -> x = y -Numeral.internal_uint_dec_lb1: - forall x y : Numeral.uint, x = y -> Numeral.uint_beq x y = true -Numeral.internal_uint_dec_bl1: - forall x y : Numeral.uint, Numeral.uint_beq x y = true -> x = y +Number.internal_number_dec_lb: + forall x y : Number.number, x = y -> Number.number_beq x y = true +Number.internal_number_dec_bl: + forall x y : Number.number, Number.number_beq x y = true -> x = y +Number.internal_int_dec_lb1: + forall x y : Number.int, x = y -> Number.int_beq x y = true +Number.internal_int_dec_bl1: + forall x y : Number.int, Number.int_beq x y = true -> x = y +Number.internal_uint_dec_lb1: + forall x y : Number.uint, x = y -> Number.uint_beq x y = true +Number.internal_uint_dec_bl1: + forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true @@ -306,12 +306,12 @@ nat_rect_plus: (nat_rect (fun _ : nat => A) x (fun _ : nat => f) m) (fun _ : nat => f) n Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat -Numeral.internal_numeral_dec_bl: - forall x y : Numeral.numeral, Numeral.numeral_beq x y = true -> x = y -Numeral.internal_int_dec_bl1: - forall x y : Numeral.int, Numeral.int_beq x y = true -> x = y -Numeral.internal_uint_dec_bl1: - forall x y : Numeral.uint, Numeral.uint_beq x y = true -> x = y +Number.internal_number_dec_bl: + forall x y : Number.number, Number.number_beq x y = true -> x = y +Number.internal_int_dec_bl1: + forall x y : Number.int, Number.int_beq x y = true -> x = y +Number.internal_uint_dec_bl1: + forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y @@ -328,12 +328,12 @@ Byte.to_bits_of_bits: forall b : bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))), Byte.to_bits (Byte.of_bits b) = b -Numeral.internal_numeral_dec_lb: - forall x y : Numeral.numeral, x = y -> Numeral.numeral_beq x y = true -Numeral.internal_uint_dec_lb1: - forall x y : Numeral.uint, x = y -> Numeral.uint_beq x y = true -Numeral.internal_int_dec_lb1: - forall x y : Numeral.int, x = y -> Numeral.int_beq x y = true +Number.internal_number_dec_lb: + forall x y : Number.number, x = y -> Number.number_beq x y = true +Number.internal_uint_dec_lb1: + forall x y : Number.uint, x = y -> Number.uint_beq x y = true +Number.internal_int_dec_lb1: + forall x y : Number.int, x = y -> Number.int_beq x y = true Decimal.internal_int_dec_lb: forall x y : Decimal.int, x = y -> Decimal.int_beq x y = true Hexadecimal.internal_hexadecimal_dec_lb: @@ -391,7 +391,7 @@ Nat.lor: nat -> nat -> nat Nat.lxor: nat -> nat -> nat Nat.of_hex_uint: Hexadecimal.uint -> nat Nat.of_uint: Decimal.uint -> nat -Nat.of_num_uint: Numeral.uint -> nat +Nat.of_num_uint: Number.uint -> nat length: forall [A : Type], list A -> nat plus_n_O: forall n : nat, n = n + 0 plus_O_n: forall n : nat, 0 + n = n @@ -458,3 +458,7 @@ reflexive_eq_dom_reflexive: B.b: B.a A.b: A.a F.L: F.P 0 +inr: forall {A B : Type}, B -> A + B +inl: forall {A B : Type}, A -> A + B +(use "About" for full details on the implicit arguments of inl and inr) +f: None = 0 diff --git a/test-suite/output/Search.v b/test-suite/output/Search.v index a5ac2cb511..2f29e1aff1 100644 --- a/test-suite/output/Search.v +++ b/test-suite/output/Search.v @@ -89,3 +89,10 @@ Module Bug12647. Search F.P. End Bar. End Bug12647. + +Module WithCoercions. + Search headconcl:(_ + _) inside Datatypes. + Coercion Some_nat := @Some nat. + Axiom f : None = 0. + Search (None = 0). +End WithCoercions. diff --git a/test-suite/output/SearchHead.out b/test-suite/output/SearchHead.out index 9554581ebe..2f0d854ac6 100644 --- a/test-suite/output/SearchHead.out +++ b/test-suite/output/SearchHead.out @@ -21,15 +21,15 @@ orb: bool -> bool -> bool implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool -Numeral.uint_beq: Numeral.uint -> Numeral.uint -> bool +Number.uint_beq: Number.uint -> Number.uint -> bool Nat.testbit: nat -> nat -> bool Nat.eqb: nat -> nat -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool -Numeral.numeral_beq: Numeral.numeral -> Numeral.numeral -> bool -Numeral.int_beq: Numeral.int -> Numeral.int -> bool +Number.number_beq: Number.number -> Number.number -> bool +Number.int_beq: Number.int -> Number.int -> bool Hexadecimal.int_beq: Hexadecimal.int -> Hexadecimal.int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool diff --git a/test-suite/output/SearchPattern.out b/test-suite/output/SearchPattern.out index 80b03e8a0b..d705ec898b 100644 --- a/test-suite/output/SearchPattern.out +++ b/test-suite/output/SearchPattern.out @@ -7,15 +7,15 @@ orb: bool -> bool -> bool implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool -Numeral.uint_beq: Numeral.uint -> Numeral.uint -> bool +Number.uint_beq: Number.uint -> Number.uint -> bool Nat.testbit: nat -> nat -> bool Nat.eqb: nat -> nat -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool -Numeral.numeral_beq: Numeral.numeral -> Numeral.numeral -> bool -Numeral.int_beq: Numeral.int -> Numeral.int -> bool +Number.number_beq: Number.number -> Number.number -> bool +Number.int_beq: Number.int -> Number.int -> bool Hexadecimal.int_beq: Hexadecimal.int -> Hexadecimal.int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool @@ -50,7 +50,7 @@ Nat.lor: nat -> nat -> nat Nat.gcd: nat -> nat -> nat Hexadecimal.nb_digits: Hexadecimal.uint -> nat Nat.of_hex_uint: Hexadecimal.uint -> nat -Nat.of_num_uint: Numeral.uint -> nat +Nat.of_num_uint: Number.uint -> nat Nat.of_uint: Decimal.uint -> nat Decimal.nb_digits: Decimal.uint -> nat Nat.tail_addmul: nat -> nat -> nat -> nat diff --git a/test-suite/output/Search_bug13298.out b/test-suite/output/Search_bug13298.out new file mode 100644 index 0000000000..18488c790f --- /dev/null +++ b/test-suite/output/Search_bug13298.out @@ -0,0 +1 @@ +snd: forall c : c, fst c = 0 diff --git a/test-suite/output/Search_bug13298.v b/test-suite/output/Search_bug13298.v new file mode 100644 index 0000000000..9a75321c64 --- /dev/null +++ b/test-suite/output/Search_bug13298.v @@ -0,0 +1,3 @@ +Set Primitive Projections. +Record c : Type := { fst : nat; snd : fst = 0 }. +Search concl:fst. diff --git a/test-suite/output/StringSyntax.out b/test-suite/output/StringSyntax.out index e9cf4282dc..68ee7cfeb5 100644 --- a/test-suite/output/StringSyntax.out +++ b/test-suite/output/StringSyntax.out @@ -1051,7 +1051,7 @@ Arguments byte_ind _%function_scope _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ "127" : byte The command has indeed failed with message: -Expects a single character or a three-digits ascii code. +Expects a single character or a three-digit ASCII code. "000" : ascii "a" @@ -1059,7 +1059,7 @@ Expects a single character or a three-digits ascii code. "127" : ascii The command has indeed failed with message: -Expects a single character or a three-digits ascii code. +Expects a single character or a three-digit ASCII code. "000" : string "a" @@ -1084,3 +1084,21 @@ Expects a single character or a three-digits ascii code. = ["000"; "001"; "002"; "003"; "004"; "005"; "006"; "007"; "008"; "009"; "010"; "011"; "012"; "013"; "014"; "015"; "016"; "017"; "018"; "019"; "020"; "021"; "022"; "023"; "024"; "025"; "026"; "027"; "028"; "029"; "030"; "031"; " "; "!"; """"; "#"; "$"; "%"; "&"; "'"; "("; ")"; "*"; "+"; ","; "-"; "."; "/"; "0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; ":"; ";"; "<"; "="; ">"; "?"; "@"; "A"; "B"; "C"; "D"; "E"; "F"; "G"; "H"; "I"; "J"; "K"; "L"; "M"; "N"; "O"; "P"; "Q"; "R"; "S"; "T"; "U"; "V"; "W"; "X"; "Y"; "Z"; "["; "\"; "]"; "^"; "_"; "`"; "a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"; "k"; "l"; "m"; "n"; "o"; "p"; "q"; "r"; "s"; "t"; "u"; "v"; "w"; "x"; "y"; "z"; "{"; "|"; "}"; "~"; "127"; "128"; "129"; "130"; "131"; "132"; "133"; "134"; "135"; "136"; "137"; "138"; "139"; "140"; "141"; "142"; "143"; "144"; "145"; "146"; "147"; "148"; "149"; "150"; "151"; "152"; "153"; "154"; "155"; "156"; "157"; "158"; "159"; "160"; "161"; "162"; "163"; "164"; "165"; "166"; "167"; "168"; "169"; "170"; "171"; "172"; "173"; "174"; "175"; "176"; "177"; "178"; "179"; "180"; "181"; "182"; "183"; "184"; "185"; "186"; "187"; "188"; "189"; "190"; "191"; "192"; "193"; "194"; "195"; "196"; "197"; "198"; "199"; "200"; "201"; "202"; "203"; "204"; "205"; "206"; "207"; "208"; "209"; "210"; "211"; "212"; "213"; "214"; "215"; "216"; "217"; "218"; "219"; "220"; "221"; "222"; "223"; "224"; "225"; "226"; "227"; "228"; "229"; "230"; "231"; "232"; "233"; "234"; "235"; "236"; "237"; "238"; "239"; "240"; "241"; "242"; "243"; "244"; "245"; "246"; "247"; "248"; "249"; "250"; "251"; "252"; "253"; "254"; "255"] : list ascii +"abc" + : string +"000" + : nat +"001" + : nat +"002" + : nat +"255" + : nat +The command has indeed failed with message: +Expects a single character or a three-digit ASCII code. +"abc" + : string2 +"abc" : string2 + : string2 +"abc" : string1 + : string1 diff --git a/test-suite/output/StringSyntax.v b/test-suite/output/StringSyntax.v index aab6e0bb03..a1ffe69527 100644 --- a/test-suite/output/StringSyntax.v +++ b/test-suite/output/StringSyntax.v @@ -50,3 +50,68 @@ Local Close Scope byte_scope. Local Open Scope char_scope. Compute List.map Ascii.ascii_of_nat (List.seq 0 256). Local Close Scope char_scope. + +(* Test numeral notations for parameterized inductives *) +Module Test2. + +Notation string := (list Byte.byte). +Definition id_string := @id string. + +String Notation string id_string id_string : list_scope. + +Check "abc"%list. + +End Test2. + +(* Test the via ... using ... option *) +Module Test3. + +Inductive I := +| IO : I +| IS : I -> I. + +Definition of_byte (x : Byte.byte) : I := + let fix f n := + match n with + | O => IO + | S n => IS (f n) + end in + f (Byte.to_nat x). + +Definition to_byte (x : I) : option Byte.byte := + let fix f i := + match i with + | IO => O + | IS i => S (f i) + end in + Byte.of_nat (f x). + +String Notation nat of_byte to_byte (via I mapping [O => IO, S => IS]) : nat_scope. + +Check "000". +Check "001". +Check "002". +Check "255". +Fail Check "256". + +End Test3. + +(* Test overlapping string notations *) +Module Test4. + +Notation string1 := (list Byte.byte). +Definition id_string1 := @id string1. + +String Notation string1 id_string1 id_string1 : list_scope. + +Notation string2 := (list Ascii.ascii). +Definition a2b := List.map byte_of_ascii. +Definition b2a := List.map ascii_of_byte. + +String Notation string2 b2a a2b : list_scope. + +Check "abc"%list. +Check ["a";"b";"c"]%char%list : string2. +Check ["a";"b";"c"]%byte%list : string1. + +End Test4. diff --git a/test-suite/output/ZSyntax.v b/test-suite/output/ZSyntax.v index 7b2bb00ce0..67c4f85d5c 100644 --- a/test-suite/output/ZSyntax.v +++ b/test-suite/output/ZSyntax.v @@ -18,7 +18,7 @@ Require Import Arith. Check (0 + Z.of_nat 11)%Z. (* Check hexadecimal printing *) -Definition to_num_int n := Numeral.IntHex (Z.to_hex_int n). +Definition to_num_int n := Number.IntHexadecimal (Z.to_hex_int n). Number Notation Z Z.of_num_int to_num_int : Z_scope. Check 42%Z. Check (-42)%Z. diff --git a/test-suite/output/bug_12159.v b/test-suite/output/bug_12159.v index 437b4a68e9..a7366f2d35 100644 --- a/test-suite/output/bug_12159.v +++ b/test-suite/output/bug_12159.v @@ -2,10 +2,10 @@ Declare Scope A. Declare Scope B. Delimit Scope A with A. Delimit Scope B with B. -Definition to_unit (v : Numeral.uint) : option unit +Definition to_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. -Definition of_unit (v : unit) : Numeral.uint := Nat.to_num_uint 0. -Definition of_unit' (v : unit) : Numeral.uint := Nat.to_num_uint 1. +Definition of_unit (v : unit) : Number.uint := Nat.to_num_uint 0. +Definition of_unit' (v : unit) : Number.uint := Nat.to_num_uint 1. Number Notation unit to_unit of_unit : A. Number Notation unit to_unit of_unit' : B. Definition f x : unit := x. diff --git a/test-suite/output/bug_13244.out b/test-suite/output/bug_13244.out new file mode 100644 index 0000000000..8c7d4ac776 --- /dev/null +++ b/test-suite/output/bug_13244.out @@ -0,0 +1,9 @@ +negbT: forall [b : bool], b = false -> ~~ b +contra_notN: forall [P : Prop] [b : bool], (b -> P) -> ~ P -> ~~ b +contraPN: forall [P : Prop] [b : bool], (b -> ~ P) -> P -> ~~ b +contraNN: forall [c b : bool], (c -> b) -> ~~ b -> ~~ c +contraL: forall [c b : bool], (c -> ~~ b) -> b -> ~~ c +contraTN: forall [c b : bool], (c -> ~~ b) -> b -> ~~ c +contra: forall [c b : bool], (c -> b) -> ~~ b -> ~~ c +introN: forall [P : Prop] [b : bool], reflect P b -> ~ P -> ~~ b +contraFN: forall [c b : bool], (c -> b) -> b = false -> ~~ c diff --git a/test-suite/output/bug_13244.v b/test-suite/output/bug_13244.v new file mode 100644 index 0000000000..83eaac1a35 --- /dev/null +++ b/test-suite/output/bug_13244.v @@ -0,0 +1,3 @@ +Require Import ssr.ssrbool. +Set Warnings "-ssr-search-moved". +Search headconcl:(~~ _). diff --git a/test-suite/success/NumeralNotationsNoLocal.v b/test-suite/success/NumberNotationsNoLocal.v index fe97f10ddf..e19d06cfa7 100644 --- a/test-suite/success/NumeralNotationsNoLocal.v +++ b/test-suite/success/NumberNotationsNoLocal.v @@ -1,4 +1,4 @@ -(* Test that numeral notations don't work on proof-local variables, especially not ones containing evars *) +(* Test that number notations don't work on proof-local variables, especially not ones containing evars *) Inductive unit11 := tt11. Declare Scope unit11_scope. Delimit Scope unit11_scope with unit11. diff --git a/test-suite/success/rewrite_strat.v b/test-suite/success/rewrite_strat.v index a6e59fdda0..98045d1162 100644 --- a/test-suite/success/rewrite_strat.v +++ b/test-suite/success/rewrite_strat.v @@ -51,3 +51,12 @@ Time Qed. (* 0.06 s *) Set Printing All. Set Printing Depth 100000. + +Tactic Notation "my_rewrite_strat" constr(x) := rewrite_strat topdown x. +Tactic Notation "my_rewrite_strat2" uconstr(x) := rewrite_strat topdown x. +Goal (forall x, S x = 0) -> 1=0. +intro H. +my_rewrite_strat H. +Undo. +my_rewrite_strat2 H. +Abort. diff --git a/test-suite/success/sprop_uip.v b/test-suite/success/sprop_uip.v index eae1b75689..c9377727db 100644 --- a/test-suite/success/sprop_uip.v +++ b/test-suite/success/sprop_uip.v @@ -121,6 +121,33 @@ Proof. simpl. Fail check. Abort. +Module HoTTStyle. + (* a small proof which tests destruct in a tricky case *) + + Definition ap {A B} (f:A -> B) {x y} (e : seq x y) : seq (f x) (f y). + Proof. destruct e. reflexivity. Defined. + + Section S. + Context + (A : Type) + (B : Type) + (f : A -> B) + (g : B -> A) + (section : forall a, seq (g (f a)) a) + (retraction : forall b, seq (f (g b)) b). + + Lemma bla (P : B -> Type) (a : A) (F : forall a, P (f a)) + : seq_rect _ (f (g (f a))) (fun a _ => P a) (F (g (f a))) (f a) (retraction (f a)) = F a. + Proof. + lazy. + change (retraction (f a)) with (ap f (section a)). + destruct (section a). + reflexivity. + Qed. + End S. + +End HoTTStyle. + (* check that extraction doesn't fall apart on matches with special reduction *) Require Extraction. diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index 36b9cf06b9..2d34412908 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -31,7 +31,7 @@ Lemma ind_0_1_SS : Proof. intros P H0 H1 H2. fix ind_0_1_SS 1. - destruct n as [|[|n]]. + intros n; destruct n as [|[|n]]. - exact H0. - exact H1. - apply H2, ind_0_1_SS. @@ -105,17 +105,17 @@ Hint Resolve double_S: arith. Lemma even_odd_double n : (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))). Proof. - revert n. fix even_odd_double 1. destruct n as [|[|n]]. + revert n. fix even_odd_double 1. intros n; destruct n as [|[|n]]. - (* n = 0 *) split; split; auto with arith. inversion 1. - (* n = 1 *) - split; split; auto with arith. inversion_clear 1. inversion H0. + split; split; auto with arith. inversion_clear 1 as [|? H0]. inversion H0. - (* n = (S (S n')) *) destruct (even_odd_double n) as ((Ev,Ev'),(Od,Od')). split; split; simpl div2; rewrite ?double_S. - + inversion_clear 1. inversion_clear H0. auto. + + inversion_clear 1 as [|? H0]. inversion_clear H0. auto. + injection 1. auto with arith. - + inversion_clear 1. inversion_clear H0. auto. + + inversion_clear 1 as [? H0]. inversion_clear H0. auto. + injection 1. auto with arith. Qed. diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v index fdd149e01a..d5f715d843 100644 --- a/theories/Arith/Euclid.v +++ b/theories/Arith/Euclid.v @@ -21,7 +21,7 @@ Inductive diveucl a b : Set := Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n. Proof. - induction m as (m,H0) using gt_wf_rec. + intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. destruct (H0 (m - n)) as (q,r,Hge0,Heq); auto with arith. apply divex with (S q) r; trivial. @@ -34,7 +34,7 @@ Lemma quotient : n > 0 -> forall m:nat, {q : nat | exists r : nat, m = q * n + r /\ n > r}. Proof. - induction m as (m,H0) using gt_wf_rec. + intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. destruct (H0 (m - n)) as (q & Hq); auto with arith; exists (S q). destruct Hq as (r & Heq & Hgt); exists r; split; trivial. @@ -47,7 +47,7 @@ Lemma modulo : n > 0 -> forall m:nat, {r : nat | exists q : nat, m = q * n + r /\ n > r}. Proof. - induction m as (m,H0) using gt_wf_rec. + intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. destruct (H0 (m - n)) as (r & Hr); auto with arith; exists r. destruct Hr as (q & Heq & Hgt); exists (S q); split; trivial. diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index 9c0a6bd96f..3422596818 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -39,28 +39,28 @@ Hint Constructors odd: arith. Lemma even_equiv : forall n, even n <-> Nat.Even n. Proof. fix even_equiv 1. - destruct n as [|[|n]]; simpl. + intros n; destruct n as [|[|n]]; simpl. - split; [now exists 0 | constructor]. - split. - + inversion_clear 1. inversion_clear H0. + + inversion_clear 1 as [|? H0]. inversion_clear H0. + now rewrite <- Nat.even_spec. - rewrite Nat.Even_succ_succ, <- even_equiv. split. - + inversion_clear 1. now inversion_clear H0. + + inversion_clear 1 as [|? H0]. now inversion_clear H0. + now do 2 constructor. Qed. Lemma odd_equiv : forall n, odd n <-> Nat.Odd n. Proof. fix odd_equiv 1. - destruct n as [|[|n]]; simpl. + intros n; destruct n as [|[|n]]; simpl. - split. + inversion_clear 1. + now rewrite <- Nat.odd_spec. - split; [ now exists 0 | do 2 constructor ]. - rewrite Nat.Odd_succ_succ, <- odd_equiv. split. - + inversion_clear 1. now inversion_clear H0. + + inversion_clear 1 as [? H0]. now inversion_clear H0. + now do 2 constructor. Qed. @@ -68,14 +68,14 @@ Qed. Lemma even_or_odd n : even n \/ odd n. Proof. - induction n. + induction n as [|n IHn]. - auto with arith. - elim IHn; auto with arith. Qed. Lemma even_odd_dec n : {even n} + {odd n}. Proof. - induction n. + induction n as [|n IHn]. - auto with arith. - elim IHn; auto with arith. Defined. diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index bea14480f8..52605a4667 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -16,7 +16,7 @@ (** A boolean is either [true] or [false], and this is decidable *) Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}. - destruct b; auto. + intros b; destruct b; auto. Defined. Hint Resolve sumbool_of_bool: bool. @@ -24,13 +24,13 @@ Hint Resolve sumbool_of_bool: bool. Definition bool_eq_rec : forall (b:bool) (P:bool -> Set), (b = true -> P true) -> (b = false -> P false) -> P b. - destruct b; auto. + intros b; destruct b; auto. Defined. Definition bool_eq_ind : forall (b:bool) (P:bool -> Prop), (b = true -> P true) -> (b = false -> P false) -> P b. - destruct b; auto. + intros b; destruct b; auto. Defined. diff --git a/theories/Init/Byte.v b/theories/Init/Byte.v index 7449b52d76..e03820ef22 100644 --- a/theories/Init/Byte.v +++ b/theories/Init/Byte.v @@ -16,7 +16,7 @@ Require Import Coq.Init.Logic. Require Import Coq.Init.Specif. Require Coq.Init.Nat. -Declare ML Module "string_notation_plugin". +Declare ML Module "number_string_notation_plugin". (** We define an inductive for use with the [String Notation] command which contains all ascii characters. We use 256 constructors for diff --git a/theories/Init/Decimal.v b/theories/Init/Decimal.v index 025264ab01..bb12f9ca3e 100644 --- a/theories/Init/Decimal.v +++ b/theories/Init/Decimal.v @@ -118,6 +118,12 @@ Definition opp (d:int) := | Neg d => Pos d end. +Definition abs (d:int) : uint := + match d with + | Pos d => d + | Neg d => d + end. + (** For conversions with binary numbers, it is easier to operate on little-endian numbers. *) diff --git a/theories/Init/Hexadecimal.v b/theories/Init/Hexadecimal.v index 36f5e5ad1f..7467aa1262 100644 --- a/theories/Init/Hexadecimal.v +++ b/theories/Init/Hexadecimal.v @@ -125,6 +125,12 @@ Definition opp (d:int) := | Neg d => Pos d end. +Definition abs (d:int) : uint := + match d with + | Pos d => d + | Neg d => d + end. + (** For conversions with binary numbers, it is easier to operate on little-endian numbers. *) @@ -173,6 +179,38 @@ Definition nztail_int d := | Neg d => let (r, n) := nztail d in pair (Neg r) n end. +(** [del_head n d] removes [n] digits at beginning of [d] + or returns [zero] if [d] has less than [n] digits. *) + +Fixpoint del_head n d := + match n with + | O => d + | S n => + match d with + | Nil => zero + | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d + | Da d | Db d | Dc d | Dd d | De d | Df d => + del_head n d + end + end. + +Definition del_head_int n d := + match d with + | Pos d => del_head n d + | Neg d => del_head n d + end. + +(** [del_tail n d] removes [n] digits at end of [d] + or returns [zero] if [d] has less than [n] digits. *) + +Definition del_tail n d := rev (del_head n (rev d)). + +Definition del_tail_int n d := + match d with + | Pos d => Pos (del_tail n d) + | Neg d => Neg (del_tail n d) + end. + Module Little. (** Successor of little-endian numbers *) diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v index 7c8cf0b536..9a3a3ec99b 100644 --- a/theories/Init/Nat.v +++ b/theories/Init/Nat.v @@ -9,7 +9,7 @@ (************************************************************************) Require Import Notations Logic Datatypes. -Require Decimal Hexadecimal Numeral. +Require Decimal Hexadecimal Number. Local Open Scope nat_scope. (**********************************************************************) @@ -212,10 +212,10 @@ Fixpoint of_hex_uint_acc (d:Hexadecimal.uint)(acc:nat) := Definition of_hex_uint (d:Hexadecimal.uint) := of_hex_uint_acc d O. -Definition of_num_uint (d:Numeral.uint) := +Definition of_num_uint (d:Number.uint) := match d with - | Numeral.UIntDec d => of_uint d - | Numeral.UIntHex d => of_hex_uint d + | Number.UIntDecimal d => of_uint d + | Number.UIntHexadecimal d => of_hex_uint d end. Fixpoint to_little_uint n acc := @@ -236,9 +236,9 @@ Fixpoint to_little_hex_uint n acc := Definition to_hex_uint n := Hexadecimal.rev (to_little_hex_uint n Hexadecimal.zero). -Definition to_num_uint n := Numeral.UIntDec (to_uint n). +Definition to_num_uint n := Number.UIntDecimal (to_uint n). -Definition to_num_hex_uint n := Numeral.UIntHex (to_hex_uint n). +Definition to_num_hex_uint n := Number.UIntHexadecimal (to_hex_uint n). Definition of_int (d:Decimal.int) : option nat := match Decimal.norm d with @@ -252,17 +252,17 @@ Definition of_hex_int (d:Hexadecimal.int) : option nat := | _ => None end. -Definition of_num_int (d:Numeral.int) : option nat := +Definition of_num_int (d:Number.int) : option nat := match d with - | Numeral.IntDec d => of_int d - | Numeral.IntHex d => of_hex_int d + | Number.IntDecimal d => of_int d + | Number.IntHexadecimal d => of_hex_int d end. Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int n := Hexadecimal.Pos (to_hex_uint n). -Definition to_num_int n := Numeral.IntDec (to_int n). +Definition to_num_int n := Number.IntDecimal (to_int n). (** ** Euclidean division *) diff --git a/theories/Init/Number.v b/theories/Init/Number.v new file mode 100644 index 0000000000..eb9cc856ac --- /dev/null +++ b/theories/Init/Number.v @@ -0,0 +1,45 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +(** * Decimal or Hexadecimal numbers *) + +Require Import Decimal Hexadecimal. + +Variant uint := UIntDecimal (u:Decimal.uint) | UIntHexadecimal (u:Hexadecimal.uint). +#[deprecated(since="8.13",note="Use UintDecimal instead.")] +Notation UIntDec := UIntDecimal (only parsing). +#[deprecated(since="8.13",note="Use UintHexadecimal instead.")] +Notation UIntHex := UIntHexadecimal (only parsing). + +Variant int := IntDecimal (i:Decimal.int) | IntHexadecimal (i:Hexadecimal.int). +#[deprecated(since="8.13",note="Use IntDecimal instead.")] +Notation IntDec := IntDecimal (only parsing). +#[deprecated(since="8.13",note="Use IntHexadecimal instead.")] +Notation IntHex := IntHexadecimal (only parsing). + +Variant number := Decimal (d:Decimal.decimal) | Hexadecimal (h:Hexadecimal.hexadecimal). +#[deprecated(since="8.13",note="Use Decimal instead.")] +Notation Dec := Decimal (only parsing). +#[deprecated(since="8.13",note="Use Hexadecimal instead.")] +Notation Hex := Hexadecimal (only parsing). + +Scheme Equality for uint. +Scheme Equality for int. +Scheme Equality for number. + +Register uint as num.num_uint.type. +Register int as num.num_int.type. +Register number as num.number.type. + +(** Pseudo-conversion functions used when declaring + Number Notations on [uint] and [int]. *) + +Definition uint_of_uint (i:uint) := i. +Definition int_of_int (i:int) := i. diff --git a/theories/Init/Numeral.v b/theories/Init/Numeral.v index 179547d0b3..50fa312e7e 100644 --- a/theories/Init/Numeral.v +++ b/theories/Init/Numeral.v @@ -8,26 +8,47 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -(** * Decimal or Hexadecimal numbers *) - -Require Import Decimal Hexadecimal. - -Variant uint := UIntDec (u:Decimal.uint) | UIntHex (u:Hexadecimal.uint). - -Variant int := IntDec (i:Decimal.int) | IntHex (i:Hexadecimal.int). - -Variant numeral := Dec (d:Decimal.decimal) | Hex (h:Hexadecimal.hexadecimal). - -Scheme Equality for uint. -Scheme Equality for int. -Scheme Equality for numeral. - -Register uint as num.num_uint.type. -Register int as num.num_int.type. -Register numeral as num.numeral.type. - -(** Pseudo-conversion functions used when declaring - Number Notations on [uint] and [int]. *) - -Definition uint_of_uint (i:uint) := i. -Definition int_of_int (i:int) := i. +(** * Deprecated: use Number.v instead *) + +Require Import Decimal Hexadecimal Number. + +#[deprecated(since="8.13",note="Use Number.uint instead.")] +Notation uint := uint (only parsing). +#[deprecated(since="8.13",note="Use Number.UintDecimal instead.")] +Notation UIntDec := UIntDecimal (only parsing). +#[deprecated(since="8.13",note="Use Number.UintHexadecimal instead.")] +Notation UIntHex := UIntHexadecimal (only parsing). + +#[deprecated(since="8.13",note="Use Number.int instead.")] +Notation int := int (only parsing). +#[deprecated(since="8.13",note="Use Number.IntDecimal instead.")] +Notation IntDec := IntDecimal (only parsing). +#[deprecated(since="8.13",note="Use Number.IntHexadecimal instead.")] +Notation IntHex := IntHexadecimal (only parsing). + +#[deprecated(since="8.13",note="Use Number.numeral instead.")] +Notation numeral := number (only parsing). +#[deprecated(since="8.13",note="Use Number.Decimal instead.")] +Notation Dec := Decimal (only parsing). +#[deprecated(since="8.13",note="Use Number.Hexadecimal instead.")] +Notation Hex := Hexadecimal (only parsing). + +#[deprecated(since="8.13",note="Use Number.uint_beq instead.")] +Notation uint_beq := uint_beq (only parsing). +#[deprecated(since="8.13",note="Use Number.uint_eq_dec instead.")] +Notation uint_eq_dec := uint_eq_dec (only parsing). +#[deprecated(since="8.13",note="Use Number.int_beq instead.")] +Notation int_beq := int_beq (only parsing). +#[deprecated(since="8.13",note="Use Number.int_eq_dec instead.")] +Notation int_eq_dec := int_eq_dec (only parsing). +#[deprecated(since="8.13",note="Use Number.numeral_beq instead.")] +Notation numeral_beq := number_beq (only parsing). +#[deprecated(since="8.13",note="Use Number.numeral_eq_dec instead.")] +Notation numeral_eq_dec := number_eq_dec (only parsing). + +Register number as num.numeral.type. + +#[deprecated(since="8.13",note="Use Number.uint_of_uint instead.")] +Notation uint_of_uint := uint_of_uint (only parsing). +#[deprecated(since="8.13",note="Use Number.int_of_int instead.")] +Notation int_of_int := int_of_int (only parsing). diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index 0fe3d5491e..9f8a054b5c 100644 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -17,6 +17,7 @@ Require Coq.Init.Byte. Require Coq.Init.Decimal. Require Coq.Init.Hexadecimal. Require Coq.Init.Numeral. +Require Coq.Init.Number. Require Coq.Init.Nat. Require Export Peano. Require Export Coq.Init.Wf. @@ -29,28 +30,26 @@ Require Export Coq.Init.Tauto. *) Declare ML Module "cc_plugin". Declare ML Module "ground_plugin". -Declare ML Module "numeral_notation_plugin". -Declare ML Module "string_notation_plugin". (* Parsing / printing of hexadecimal numbers *) Arguments Nat.of_hex_uint d%hex_uint_scope. Arguments Nat.of_hex_int d%hex_int_scope. -Number Notation Numeral.uint Numeral.uint_of_uint Numeral.uint_of_uint +Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint : hex_uint_scope. -Number Notation Numeral.int Numeral.int_of_int Numeral.int_of_int +Number Notation Number.int Number.int_of_int Number.int_of_int : hex_int_scope. (* Parsing / printing of decimal numbers *) Arguments Nat.of_uint d%dec_uint_scope. Arguments Nat.of_int d%dec_int_scope. -Number Notation Numeral.uint Numeral.uint_of_uint Numeral.uint_of_uint +Number Notation Number.uint Number.uint_of_uint Number.uint_of_uint : dec_uint_scope. -Number Notation Numeral.int Numeral.int_of_int Numeral.int_of_int +Number Notation Number.int Number.int_of_int Number.int_of_int : dec_int_scope. (* Parsing / printing of [nat] numbers *) -Number Notation nat Nat.of_num_uint Nat.to_num_hex_uint : hex_nat_scope (abstract after 5001). -Number Notation nat Nat.of_num_uint Nat.to_num_uint : nat_scope (abstract after 5001). +Number Notation nat Nat.of_num_uint Nat.to_num_hex_uint (abstract after 5001) : hex_nat_scope. +Number Notation nat Nat.of_num_uint Nat.to_num_uint (abstract after 5001) : nat_scope. (* Printing/Parsing of bytes *) Export Byte.ByteSyntaxNotations. diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index 222e76c3e7..e57e5fe856 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -390,10 +390,10 @@ Definition of_uint (d:Decimal.uint) := Pos.of_uint d. Definition of_hex_uint (d:Hexadecimal.uint) := Pos.of_hex_uint d. -Definition of_num_uint (d:Numeral.uint) := +Definition of_num_uint (d:Number.uint) := match d with - | Numeral.UIntDec d => of_uint d - | Numeral.UIntHex d => of_hex_uint d + | Number.UIntDecimal d => of_uint d + | Number.UIntHexadecimal d => of_hex_uint d end. Definition of_int (d:Decimal.int) := @@ -408,10 +408,10 @@ Definition of_hex_int (d:Hexadecimal.int) := | Hexadecimal.Neg _ => None end. -Definition of_num_int (d:Numeral.int) := +Definition of_num_int (d:Number.int) := match d with - | Numeral.IntDec d => of_int d - | Numeral.IntHex d => of_hex_int d + | Number.IntDecimal d => of_int d + | Number.IntHexadecimal d => of_hex_int d end. Definition to_uint n := @@ -426,13 +426,13 @@ Definition to_hex_uint n := | pos p => Pos.to_hex_uint p end. -Definition to_num_uint n := Numeral.UIntDec (to_uint n). +Definition to_num_uint n := Number.UIntDecimal (to_uint n). Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int n := Hexadecimal.Pos (to_hex_uint n). -Definition to_num_int n := Numeral.IntDec (to_int n). +Definition to_num_int n := Number.IntDecimal (to_int n). Number Notation N of_num_uint to_num_uint : N_scope. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index 8280b7d01f..adeb527c1c 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -36,13 +36,13 @@ Notation Nxor_nilpotent := N.lxor_nilpotent (only parsing). Lemma Ptestbit_Pbit : forall p n, Pos.testbit p (N.of_nat n) = Pos.testbit_nat p n. Proof. - induction p as [p IH|p IH| ]; intros [|n]; simpl; trivial; + intro p; induction p as [p IH|p IH| ]; intros [|n]; simpl; trivial; rewrite <- IH; f_equal; rewrite (pred_Sn n) at 2; now rewrite Nat2N.inj_pred. Qed. Lemma Ntestbit_Nbit : forall a n, N.testbit a (N.of_nat n) = N.testbit_nat a n. Proof. - destruct a. trivial. apply Ptestbit_Pbit. + intro a; destruct a. trivial. apply Ptestbit_Pbit. Qed. Lemma Pbit_Ptestbit : @@ -54,7 +54,7 @@ Qed. Lemma Nbit_Ntestbit : forall a n, N.testbit_nat a (N.to_nat n) = N.testbit a n. Proof. - destruct a. trivial. apply Pbit_Ptestbit. + intro a; destruct a. trivial. apply Pbit_Ptestbit. Qed. (** Equivalence of shifts, index in [N] or [nat] *) @@ -104,7 +104,7 @@ Qed. Lemma Nshiftr_nat_spec : forall a n m, N.testbit_nat (N.shiftr_nat a n) m = N.testbit_nat a (m+n). Proof. - induction n; intros m. + intros a n; induction n as [|n IHn]; intros m. now rewrite <- plus_n_O. simpl. rewrite <- plus_n_Sm, <- plus_Sn_m, <- IHn. destruct (N.shiftr_nat a n) as [|[p|p|]]; simpl; trivial. @@ -113,7 +113,7 @@ Qed. Lemma Nshiftl_nat_spec_high : forall a n m, (n<=m)%nat -> N.testbit_nat (N.shiftl_nat a n) m = N.testbit_nat a (m-n). Proof. - induction n; intros m H. + intros a n; induction n as [|n IHn]; intros m H. - now rewrite Nat.sub_0_r. - destruct m. + inversion H. @@ -125,9 +125,9 @@ Qed. Lemma Nshiftl_nat_spec_low : forall a n m, (m<n)%nat -> N.testbit_nat (N.shiftl_nat a n) m = false. Proof. - induction n; intros m H. inversion H. + intros a n; induction n as [|n IHn]; intros m H. inversion H. rewrite Nshiftl_nat_S. - destruct m. + destruct m as [|m]. - destruct (N.shiftl_nat a n); trivial. - apply Lt.lt_S_n in H. specialize (IHn m H). @@ -147,13 +147,13 @@ Lemma Pshiftl_nat_N : forall p n, Npos (Pos.shiftl_nat p n) = N.shiftl_nat (Npos p) n. Proof. unfold Pos.shiftl_nat, N.shiftl_nat. - induction n; simpl; auto. now rewrite <- IHn. + intros p n; induction n as [|n IHn]; simpl; auto. now rewrite <- IHn. Qed. Lemma Pshiftl_nat_plus : forall n m p, Pos.shiftl_nat p (m + n) = Pos.shiftl_nat (Pos.shiftl_nat p n) m. Proof. - induction m; simpl; intros. reflexivity. + intros n m; induction m; simpl; intros. reflexivity. now f_equal. Qed. @@ -221,13 +221,13 @@ Local Notation Step H := (fun n => H (S n)). Lemma Pbit_faithful_0 : forall p, ~(Pos.testbit_nat p == (fun _ => false)). Proof. - induction p as [p IHp|p IHp| ]; intros H; try discriminate (H O). + intros p; induction p as [p IHp|p IHp| ]; intros H; try discriminate (H O). apply (IHp (Step H)). Qed. Lemma Pbit_faithful : forall p p', Pos.testbit_nat p == Pos.testbit_nat p' -> p = p'. Proof. - induction p as [p IHp|p IHp| ]; intros [p'|p'|] H; trivial; + intros p; induction p as [p IHp|p IHp| ]; intros [p'|p'|] H; trivial; try discriminate (H O). f_equal. apply (IHp _ (Step H)). destruct (Pbit_faithful_0 _ (Step H)). @@ -260,25 +260,25 @@ Definition Neven (n:N) := N.odd n = false. Lemma Nbit0_correct : forall n:N, N.testbit_nat n 0 = N.odd n. Proof. - destruct n; trivial. + intros n; destruct n as [|p]; trivial. destruct p; trivial. Qed. Lemma Ndouble_bit0 : forall n:N, N.odd (N.double n) = false. Proof. - destruct n; trivial. + intros n; destruct n; trivial. Qed. Lemma Ndouble_plus_one_bit0 : forall n:N, N.odd (N.succ_double n) = true. Proof. - destruct n; trivial. + intros n; destruct n; trivial. Qed. Lemma Ndiv2_double : forall n:N, Neven n -> N.double (N.div2 n) = n. Proof. - destruct n. trivial. destruct p. intro H. discriminate H. + intros n; destruct n as [|p]. trivial. destruct p. intro H. discriminate H. intros. reflexivity. intro H. discriminate H. Qed. @@ -286,7 +286,7 @@ Qed. Lemma Ndiv2_double_plus_one : forall n:N, Nodd n -> N.succ_double (N.div2 n) = n. Proof. - destruct n. intro. discriminate H. + intros n; destruct n as [|p]. intro H. discriminate H. destruct p. intros. reflexivity. intro H. discriminate H. intro. reflexivity. @@ -295,21 +295,21 @@ Qed. Lemma Ndiv2_correct : forall (a:N) (n:nat), N.testbit_nat (N.div2 a) n = N.testbit_nat a (S n). Proof. - destruct a; trivial. + intros a; destruct a as [|p]; trivial. destruct p; trivial. Qed. Lemma Nxor_bit0 : forall a a':N, N.odd (N.lxor a a') = xorb (N.odd a) (N.odd a'). Proof. - intros. rewrite <- Nbit0_correct, (Nxor_semantics a a' O). + intros a a'. rewrite <- Nbit0_correct, (Nxor_semantics a a' O). rewrite Nbit0_correct, Nbit0_correct. reflexivity. Qed. Lemma Nxor_div2 : forall a a':N, N.div2 (N.lxor a a') = N.lxor (N.div2 a) (N.div2 a'). Proof. - intros. apply Nbit_faithful. unfold eqf. intro. + intros a a'. apply Nbit_faithful. unfold eqf. intro n. rewrite (Nxor_semantics (N.div2 a) (N.div2 a') n), Ndiv2_correct, (Nxor_semantics a a' (S n)). rewrite 2! Ndiv2_correct. reflexivity. @@ -319,7 +319,7 @@ Lemma Nneg_bit0 : forall a a':N, N.odd (N.lxor a a') = true -> N.odd a = negb (N.odd a'). Proof. - intros. + intros a a' H. rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, xorb_nilpotent, xorb_false. reflexivity. @@ -328,21 +328,21 @@ Qed. Lemma Nneg_bit0_1 : forall a a':N, N.lxor a a' = Npos 1 -> N.odd a = negb (N.odd a'). Proof. - intros. apply Nneg_bit0. rewrite H. reflexivity. + intros a a' H. apply Nneg_bit0. rewrite H. reflexivity. Qed. Lemma Nneg_bit0_2 : forall (a a':N) (p:positive), N.lxor a a' = Npos (xI p) -> N.odd a = negb (N.odd a'). Proof. - intros. apply Nneg_bit0. rewrite H. reflexivity. + intros a a' p H. apply Nneg_bit0. rewrite H. reflexivity. Qed. Lemma Nsame_bit0 : forall (a a':N) (p:positive), N.lxor a a' = Npos (xO p) -> N.odd a = N.odd a'. Proof. - intros. rewrite <- (xorb_false (N.odd a)). + intros a a' p H. rewrite <- (xorb_false (N.odd a)). assert (H0: N.odd (Npos (xO p)) = false) by reflexivity. rewrite <- H0, <- H, Nxor_bit0, <- xorb_assoc, xorb_nilpotent, false_xorb. reflexivity. @@ -366,7 +366,7 @@ Lemma Nbit0_less : forall a a', N.odd a = false -> N.odd a' = true -> Nless a a' = true. Proof. - intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. + intros a a' H H0. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity. assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. @@ -379,7 +379,7 @@ Lemma Nbit0_gt : forall a a', N.odd a = true -> N.odd a' = false -> Nless a a' = false. Proof. - intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. + intros a a' H H0. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity. assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. @@ -390,13 +390,13 @@ Qed. Lemma Nless_not_refl : forall a, Nless a a = false. Proof. - intro. unfold Nless. rewrite (N.lxor_nilpotent a). reflexivity. + intro a. unfold Nless. rewrite (N.lxor_nilpotent a). reflexivity. Qed. Lemma Nless_def_1 : forall a a', Nless (N.double a) (N.double a') = Nless a a'. Proof. - destruct a; destruct a'. reflexivity. + intros a a'; destruct a as [|p]; destruct a' as [|p0]. reflexivity. trivial. unfold Nless. simpl. destruct p; trivial. unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity. @@ -407,7 +407,7 @@ Lemma Nless_def_2 : forall a a', Nless (N.succ_double a) (N.succ_double a') = Nless a a'. Proof. - destruct a; destruct a'. reflexivity. + intros a a'; destruct a as [|p]; destruct a' as [|p0]. reflexivity. trivial. unfold Nless. simpl. destruct p; trivial. unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity. @@ -430,20 +430,20 @@ Qed. Lemma Nless_z : forall a, Nless a N0 = false. Proof. - induction a. reflexivity. + intros a; induction a as [|p]. reflexivity. unfold Nless. rewrite (N.lxor_0_r (Npos p)). induction p; trivial. Qed. Lemma N0_less_1 : forall a, Nless N0 a = true -> {p : positive | a = Npos p}. Proof. - destruct a. discriminate. + intros a; destruct a as [|p]. discriminate. intros. exists p. reflexivity. Qed. Lemma N0_less_2 : forall a, Nless N0 a = false -> a = N0. Proof. - induction a as [|p]; intro H. trivial. + intros a; induction a as [|p]; intro H. trivial. exfalso. induction p as [|p IHp|]; discriminate || simpl; auto using IHp. Qed. @@ -451,14 +451,14 @@ Lemma Nless_trans : forall a a' a'', Nless a a' = true -> Nless a' a'' = true -> Nless a a'' = true. Proof. - induction a as [|a IHa|a IHa] using N.binary_ind; intros a' a'' H H0. + intros a; induction a as [|a IHa|a IHa] using N.binary_ind; intros a' a'' H H0. - case_eq (Nless N0 a'') ; intros Heqn. + trivial. + rewrite (N0_less_2 a'' Heqn), (Nless_z a') in H0. discriminate H0. - induction a' as [|a' _|a' _] using N.binary_ind. + rewrite (Nless_z (N.double a)) in H. discriminate H. + rewrite (Nless_def_1 a a') in H. - induction a'' using N.binary_ind. + induction a'' as [|a'' _|a'' _] using N.binary_ind. * rewrite (Nless_z (N.double a')) in H0. discriminate H0. * rewrite (Nless_def_1 a' a'') in H0. rewrite (Nless_def_1 a a''). exact (IHa _ _ H H0). @@ -470,7 +470,7 @@ Proof. - induction a' as [|a' _|a' _] using N.binary_ind. + rewrite (Nless_z (N.succ_double a)) in H. discriminate H. + rewrite (Nless_def_4 a a') in H. discriminate H. - + induction a'' using N.binary_ind. + + induction a'' as [|a'' _|a'' _] using N.binary_ind. * rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0. * rewrite (Nless_def_4 a' a'') in H0. discriminate H0. * rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H. @@ -480,7 +480,7 @@ Qed. Lemma Nless_total : forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}. Proof. - induction a using N.binary_rec; intro a'. + intro a; induction a as [|a IHa|a IHa] using N.binary_rec; intro a'. - case_eq (Nless N0 a') ; intros Heqb. + left. left. auto. + right. rewrite (N0_less_2 a' Heqb). reflexivity. @@ -553,9 +553,9 @@ Definition ByteV2N {n : nat} : ByteVector n -> N := Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n. Proof. -destruct n. +intro n; destruct n as [|p]. simpl; auto. -induction p; simpl in *; auto; rewrite IHp; simpl; auto. +induction p as [p IHp|p IHp|]; simpl in *; auto; rewrite IHp; simpl; auto. Qed. (** The opposite composition is not so simple: if the considered @@ -564,7 +564,7 @@ Qed. Lemma Bv2N_Nsize : forall n (bv:Bvector n), N.size_nat (Bv2N n bv) <= n. Proof. -induction bv; intros. +intros n bv; induction bv as [|h n bv]; intros. auto. simpl. destruct h; @@ -579,16 +579,16 @@ Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)), Bsign _ bv = true <-> N.size_nat (Bv2N _ bv) = (S n). Proof. -apply Vector.rectS ; intros ; simpl. +apply Vector.rectS ; intros a ; simpl. destruct a ; compute ; split ; intros x ; now inversion x. - destruct a, (Bv2N (S n) v) ; + intros n v IH; destruct a, (Bv2N (S n) v) ; simpl ;intuition ; try discriminate. Qed. Lemma Bv2N_upper_bound (n : nat) (bv : Bvector n) : (Bv2N bv < N.shiftl_nat 1 n)%N. Proof with simpl; auto. - induction bv... + induction bv as [|h]... - constructor. - destruct h. + apply N.succ_double_lt... @@ -621,7 +621,7 @@ Fixpoint N2Bv_gen (n:nat)(a:N) : Bvector n := Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (N.size_nat a) a. Proof. -destruct a; simpl. +intro a; destruct a as [|p]; simpl. auto. induction p; simpl; intros; auto; congruence. Qed. @@ -632,7 +632,7 @@ Qed. Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat), N2Bv_gen (N.size_nat a + k) a = Vector.append (N2Bv a) (Bvect_false k). Proof. -destruct a; simpl. +intros a k; destruct a as [|p]; simpl. destruct k; simpl; auto. induction p; simpl; intros;unfold Bcons; f_equal; auto. Qed. @@ -642,7 +642,7 @@ Qed. Lemma N2Bv_Bv2N : forall n (bv:Bvector n), N2Bv_gen n (Bv2N n bv) = bv. Proof. -induction bv; intros. +intros n bv; induction bv as [|h n bv IHbv]; intros. auto. simpl. generalize IHbv; clear IHbv. @@ -658,7 +658,7 @@ Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)), N.odd (Bv2N _ bv) = Blow _ bv. Proof. apply Vector.caseS. -intros. +intros h n t. unfold Blow. simpl. destruct (Bv2N n t); simpl; @@ -670,9 +670,9 @@ Notation Bnth := (@Vector.nth_order bool). Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n), Bnth bv H = N.testbit_nat (Bv2N _ bv) p. Proof. -induction bv; intros. +intros n bv; induction bv as [|h n bv IHbv]; intros p H. inversion H. -destruct p ; simpl. +destruct p as [|p]; simpl. destruct (Bv2N n bv); destruct h; simpl in *; auto. specialize IHbv with p (Lt.lt_S_n _ _ H). simpl in * ; destruct (Bv2N n bv); destruct h; simpl in *; auto. @@ -680,9 +680,9 @@ Qed. Lemma Nbit_Nsize : forall n p, N.size_nat n <= p -> N.testbit_nat n p = false. Proof. -destruct n as [|n]. +intro n; destruct n as [|n]. simpl; auto. -induction n; simpl in *; intros; destruct p; auto with arith. +induction n; simpl in *; intros p H; destruct p; auto with arith. inversion H. inversion H. Qed. @@ -690,9 +690,9 @@ Qed. Lemma Nbit_Bth: forall n p (H:p < N.size_nat n), N.testbit_nat n p = Bnth (N2Bv n) H. Proof. -destruct n as [|n]. -inversion H. -induction n ; destruct p ; unfold Vector.nth_order in *; simpl in * ; auto. +intro n; destruct n as [|n]. +intros p H; inversion H. +induction n ; intro p; destruct p ; unfold Vector.nth_order in *; simpl in * ; auto. intros H ; destruct (Lt.lt_n_O _ (Lt.lt_S_n _ _ H)). Qed. @@ -701,8 +701,9 @@ Qed. Lemma Nxor_BVxor : forall n (bv bv' : Bvector n), Bv2N _ (BVxor _ bv bv') = N.lxor (Bv2N _ bv) (Bv2N _ bv'). Proof. -apply Vector.rect2 ; intros. +apply Vector.rect2. now simpl. +intros n v1 v2 H a b. simpl. destruct a, b, (Bv2N n v1), (Bv2N n v2); simpl in *; rewrite H ; now simpl. Qed. @@ -710,8 +711,8 @@ Qed. Lemma Nand_BVand : forall n (bv bv' : Bvector n), Bv2N _ (BVand _ bv bv') = N.land (Bv2N _ bv) (Bv2N _ bv'). Proof. -refine (@Vector.rect2 _ _ _ _ _); simpl; intros; auto. -rewrite H. +refine (@Vector.rect2 _ _ _ _ _); simpl; auto. +intros n v1 v2 H a b; rewrite H. destruct a, b, (Bv2N n v1), (Bv2N n v2); simpl; auto. Qed. @@ -719,15 +720,15 @@ Qed. Lemma N2Bv_sized_Nsize (n : N) : N2Bv_sized (N.size_nat n) n = N2Bv n. Proof with simpl; auto. - destruct n... - induction p... + destruct n as [|p]... + induction p as [p IHp|p IHp|]... all: rewrite IHp... Qed. Lemma N2Bv_sized_Bv2N (n : nat) (v : Bvector n) : N2Bv_sized n (Bv2N n v) = v. Proof with simpl; auto. - induction v... + induction v as [|h n v IHv]... destruct h; unfold N2Bv_sized; destruct (Bv2N n v) as [|[]]; @@ -737,6 +738,6 @@ Qed. Lemma N2Bv_N2Bv_sized_above (a : N) (k : nat) : N2Bv_sized (N.size_nat a + k) a = N2Bv a ++ Bvect_false k. Proof with auto. - destruct a... + destruct a as [|p]... induction p; simpl; f_equal... Qed. diff --git a/theories/Numbers/AltBinNotations.v b/theories/Numbers/AltBinNotations.v index 7c846571a7..c203c178f5 100644 --- a/theories/Numbers/AltBinNotations.v +++ b/theories/Numbers/AltBinNotations.v @@ -17,7 +17,7 @@ the [Decimal.int] representation. When working with numbers with thousands of digits and more, conversion from/to [Decimal.int] can become significantly slow. If that becomes a problem for your - development, this file provides some alternative [Numeral + development, this file provides some alternative [Number Notation] commands that use [Z] as bridge type. To enable these commands, just be sure to [Require] this file after other files defining numeral notations. diff --git a/theories/Numbers/DecimalFacts.v b/theories/Numbers/DecimalFacts.v index dd361562ba..87a9f704cd 100644 --- a/theories/Numbers/DecimalFacts.v +++ b/theories/Numbers/DecimalFacts.v @@ -10,175 +10,425 @@ (** * DecimalFacts : some facts about Decimal numbers *) -Require Import Decimal Arith. +Require Import Decimal Arith ZArith. + +Variant digits := d0 | d1 | d2 | d3 | d4 | d5 | d6 | d7 | d8 | d9. + +Fixpoint to_list (u : uint) : list digits := + match u with + | Nil => nil + | D0 u => cons d0 (to_list u) + | D1 u => cons d1 (to_list u) + | D2 u => cons d2 (to_list u) + | D3 u => cons d3 (to_list u) + | D4 u => cons d4 (to_list u) + | D5 u => cons d5 (to_list u) + | D6 u => cons d6 (to_list u) + | D7 u => cons d7 (to_list u) + | D8 u => cons d8 (to_list u) + | D9 u => cons d9 (to_list u) + end. -Lemma uint_dec (d d' : uint) : { d = d' } + { d <> d' }. -Proof. - decide equality. -Defined. +Fixpoint of_list (l : list digits) : uint := + match l with + | nil => Nil + | cons d0 l => D0 (of_list l) + | cons d1 l => D1 (of_list l) + | cons d2 l => D2 (of_list l) + | cons d3 l => D3 (of_list l) + | cons d4 l => D4 (of_list l) + | cons d5 l => D5 (of_list l) + | cons d6 l => D6 (of_list l) + | cons d7 l => D7 (of_list l) + | cons d8 l => D8 (of_list l) + | cons d9 l => D9 (of_list l) + end. -Lemma rev_revapp d d' : - rev (revapp d d') = revapp d' d. +Lemma of_list_to_list u : of_list (to_list u) = u. +Proof. now induction u; [|simpl; rewrite IHu..]. Qed. + +Lemma to_list_of_list l : to_list (of_list l) = l. +Proof. now induction l as [|h t IHl]; [|case h; simpl; rewrite IHl]. Qed. + +Lemma to_list_inj u u' : to_list u = to_list u' -> u = u'. Proof. - revert d'. induction d; simpl; intros; now rewrite ?IHd. + now intro H; rewrite <-(of_list_to_list u), <-(of_list_to_list u'), H. Qed. -Lemma rev_rev d : rev (rev d) = d. +Lemma of_list_inj u u' : of_list u = of_list u' -> u = u'. Proof. - apply rev_revapp. + now intro H; rewrite <-(to_list_of_list u), <-(to_list_of_list u'), H. Qed. -Lemma revapp_rev_nil d : revapp (rev d) Nil = d. -Proof. now fold (rev (rev d)); rewrite rev_rev. Qed. +Lemma nb_digits_spec u : nb_digits u = length (to_list u). +Proof. now induction u; [|simpl; rewrite IHu..]. Qed. -Lemma app_nil_r d : app d Nil = d. -Proof. now unfold app; rewrite revapp_rev_nil. Qed. +Fixpoint lnzhead l := + match l with + | nil => nil + | cons d l' => + match d with + | d0 => lnzhead l' + | _ => l + end + end. -Lemma app_int_nil_r d : app_int d Nil = d. -Proof. now case d; intro d'; simpl; rewrite app_nil_r. Qed. +Lemma nzhead_spec u : to_list (nzhead u) = lnzhead (to_list u). +Proof. now induction u; [|simpl; rewrite IHu|..]. Qed. + +Definition lzero := cons d0 nil. + +Definition lunorm l := + match lnzhead l with + | nil => lzero + | d => d + end. + +Lemma unorm_spec u : to_list (unorm u) = lunorm (to_list u). +Proof. now unfold unorm, lunorm; rewrite <-nzhead_spec; case (nzhead u). Qed. -Lemma revapp_revapp_1 d d' d'' : - nb_digits d <= 1 -> - revapp (revapp d d') d'' = revapp d' (revapp d d''). +Lemma revapp_spec d d' : + to_list (revapp d d') = List.rev_append (to_list d) (to_list d'). +Proof. now revert d'; induction d; intro d'; [|simpl; rewrite IHd..]. Qed. + +Lemma rev_spec d : to_list (rev d) = List.rev (to_list d). +Proof. now unfold rev; rewrite revapp_spec, List.rev_alt; simpl. Qed. + +Lemma app_spec d d' : + to_list (app d d') = Datatypes.app (to_list d) (to_list d'). Proof. - now case d; clear d; intro d; - [|case d; clear d; intro d; - [|simpl; case nb_digits; [|intros n]; intros Hn; exfalso; - [apply (Nat.nle_succ_diag_l _ Hn)| - apply (Nat.nle_succ_0 _ (le_S_n _ _ Hn))]..]..]. + unfold app. + now rewrite revapp_spec, List.rev_append_rev, rev_spec, List.rev_involutive. Qed. -Lemma nb_digits_pos d : d <> Nil -> 0 < nb_digits d. -Proof. now case d; [|intros d' _; apply Nat.lt_0_succ..]. Qed. +Definition lnztail l := + let fix aux l_rev := + match l_rev with + | cons d0 l_rev => let (r, n) := aux l_rev in pair r (S n) + | _ => pair l_rev O + end in + let (r, n) := aux (List.rev l) in pair (List.rev r) n. -Lemma nb_digits_revapp d d' : - nb_digits (revapp d d') = nb_digits d + nb_digits d'. +Lemma nztail_spec d : + let (r, n) := nztail d in + let (r', n') := lnztail (to_list d) in + to_list r = r' /\ n = n'. Proof. - now revert d'; induction d; [|intro d'; simpl; rewrite IHd; simpl..]. + unfold nztail, lnztail. + set (f := fix aux d_rev := match d_rev with + | D0 d_rev => let (r, n) := aux d_rev in (r, S n) + | _ => (d_rev, 0) end). + set (f' := fix aux (l_rev : list digits) : list digits * nat := + match l_rev with + | cons d0 l_rev => let (r, n) := aux l_rev in (r, S n) + | _ => (l_rev, 0) + end). + rewrite <-(of_list_to_list (rev d)), rev_spec. + induction (List.rev _) as [|h t IHl]; [now simpl|]. + case h; simpl; [|now rewrite rev_spec; simpl; rewrite to_list_of_list..]. + now revert IHl; case f; intros r n; case f'; intros r' n' [-> ->]. Qed. -Lemma nb_digits_rev u : nb_digits (rev u) = nb_digits u. -Proof. now unfold rev; rewrite nb_digits_revapp. Qed. +Lemma del_head_spec_0 d : del_head 0 d = d. +Proof. now simpl. Qed. -Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. -Proof. now induction u; [|apply le_S|..]. Qed. +Lemma del_head_spec_small n d : + n <= length (to_list d) -> to_list (del_head n d) = List.skipn n (to_list d). +Proof. + revert d; induction n as [|n IHn]; intro d; [now simpl|]. + now case d; [|intros d' H; apply IHn, le_S_n..]. +Qed. -Lemma del_head_nb_digits (u:uint) : del_head (nb_digits u) u = Nil. -Proof. now induction u. Qed. +Lemma del_head_spec_large n d : length (to_list d) < n -> del_head n d = zero. +Proof. + revert d; induction n; intro d; [now case d|]. + now case d; [|intro d'; simpl; intro H; rewrite (IHn _ (lt_S_n _ _ H))..]. +Qed. -Lemma nb_digits_del_head n u : - n <= nb_digits u -> nb_digits (del_head n u) = nb_digits u - n. +Lemma nb_digits_0 d : nb_digits d = 0 -> d = Nil. Proof. - revert u; induction n; intros u; [now rewrite Nat.sub_0_r|]. - now case u; clear u; intro u; [|intro Hn; apply IHn, le_S_n..]. + rewrite nb_digits_spec, <-(of_list_to_list d). + now case (to_list d) as [|h t]; [|rewrite to_list_of_list]. Qed. +Lemma nb_digits_n0 d : nb_digits d <> 0 -> d <> Nil. +Proof. now case d; [|intros u _..]. Qed. + Lemma nb_digits_iter_D0 n d : nb_digits (Nat.iter n D0 d) = n + nb_digits d. Proof. now induction n; simpl; [|rewrite IHn]. Qed. -Fixpoint nth n u := - match n with - | O => - match u with - | Nil => Nil - | D0 d => D0 Nil - | D1 d => D1 Nil - | D2 d => D2 Nil - | D3 d => D3 Nil - | D4 d => D4 Nil - | D5 d => D5 Nil - | D6 d => D6 Nil - | D7 d => D7 Nil - | D8 d => D8 Nil - | D9 d => D9 Nil - end - | S n => - match u with - | Nil => Nil - | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => - nth n d - end - end. +Lemma length_lnzhead l : length (lnzhead l) <= length l. +Proof. now induction l as [|h t IHl]; [|case h; [apply le_S|..]]. Qed. + +Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. +Proof. now induction u; [|apply le_S|..]. Qed. + +Lemma unorm_nzhead u : nzhead u <> Nil -> unorm u = nzhead u. +Proof. now unfold unorm; case nzhead. Qed. -Lemma nb_digits_nth n u : nb_digits (nth n u) <= 1. +Lemma nb_digits_unorm u : u <> Nil -> nb_digits (unorm u) <= nb_digits u. Proof. - revert u; induction n. - - now intro u; case u; [apply Nat.le_0_1|..]. - - intro u; case u; [apply Nat.le_0_1|intro u'; apply IHn..]. + intro Hu; case (uint_eq_dec (nzhead u) Nil). + { unfold unorm; intros ->; simpl. + now revert Hu; case u; [|intros u' _; apply le_n_S, Nat.le_0_l..]. } + intro H; rewrite (unorm_nzhead _ H); apply nb_digits_nzhead. Qed. -Lemma del_head_nth n u : - n < nb_digits u -> - del_head n u = revapp (nth n u) (del_head (S n) u). -Proof. - revert u; induction n; intro u; [now case u|]. - now case u; [|intro u'; intro H; apply IHn, le_S_n..]. -Qed. - -Lemma nth_revapp_r n d d' : - nb_digits d <= n -> - nth n (revapp d d') = nth (n - nb_digits d) d'. -Proof. - revert d d'; induction n; intro d. - - now case d; intro d'; - [case d'|intros d'' H; exfalso; revert H; apply Nat.nle_succ_0..]. - - now induction d; - [intro d'; case d'| - intros d' H; - simpl revapp; rewrite IHd; [|now apply le_Sn_le]; - rewrite Nat.sub_succ_l; [|now apply le_S_n]; - simpl; rewrite <-(IHn _ _ (le_S_n _ _ H))..]. -Qed. - -Lemma nth_revapp_l n d d' : - n < nb_digits d -> - nth n (revapp d d') = nth (nb_digits d - n - 1) d. -Proof. - revert d d'; induction n; intro d. - - rewrite Nat.sub_0_r. - now induction d; - [|intros d' _; simpl revapp; - revert IHd; case d; clear d; [|intro d..]; intro IHd; - [|rewrite IHd; [simpl nb_digits; rewrite (Nat.sub_succ_l _ (S _))|]; - [|apply le_n_S, Nat.le_0_l..]..]..]. - - now induction d; - [|intros d' H; - simpl revapp; simpl nb_digits; - simpl in H; generalize (lt_S_n _ _ H); clear H; intro H; - case (le_lt_eq_dec _ _ H); clear H; intro H; - [rewrite (IHd _ H), Nat.sub_succ_l; - [rewrite Nat.sub_succ_l; [|apply Nat.le_add_le_sub_r]| - apply le_Sn_le]| - rewrite nth_revapp_r; rewrite <-H; - [rewrite Nat.sub_succ, Nat.sub_succ_l; [rewrite !Nat.sub_diag|]|]]..]. -Qed. - -Lemma app_del_tail_head (u:uint) n : - n <= nb_digits u -> - app (del_tail n u) (del_head (nb_digits u - n) u) = u. -Proof. - unfold app, del_tail; rewrite rev_rev. - induction n. - - intros _; rewrite Nat.sub_0_r, del_head_nb_digits; simpl. - now rewrite revapp_rev_nil. - - intro Hn. - rewrite (del_head_nth (_ - _)); - [|now apply Nat.sub_lt; [|apply Nat.lt_0_succ]]. - rewrite Nat.sub_succ_r, <-Nat.sub_1_r. - rewrite <-(nth_revapp_l _ _ Nil Hn); fold (rev u). - rewrite <-revapp_revapp_1; [|now apply nb_digits_nth]. - rewrite <-(del_head_nth _ _); [|now rewrite nb_digits_rev]. - rewrite Nat.sub_1_r, Nat.succ_pred_pos; [|now apply Nat.lt_add_lt_sub_r]. - apply (IHn (le_Sn_le _ _ Hn)). +Lemma nb_digits_rev d : nb_digits (rev d) = nb_digits d. +Proof. now rewrite !nb_digits_spec, rev_spec, List.rev_length. Qed. + +Lemma nb_digits_del_head_sub d n : + n <= nb_digits d -> + nb_digits (del_head (nb_digits d - n) d) = n. +Proof. + rewrite !nb_digits_spec; intro Hn. + rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. + rewrite List.skipn_length, <-(Nat2Z.id (_ - _)). + rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. + rewrite (Nat2Z.inj_sub _ _ Hn). + rewrite Z.sub_sub_distr, Z.sub_diag; apply Nat2Z.id. +Qed. + +Lemma unorm_D0 u : unorm (D0 u) = unorm u. +Proof. reflexivity. Qed. + +Lemma app_nil_l d : app Nil d = d. +Proof. now simpl. Qed. + +Lemma app_nil_r d : app d Nil = d. +Proof. now apply to_list_inj; rewrite app_spec, List.app_nil_r. Qed. + +Lemma abs_app_int d d' : abs (app_int d d') = app (abs d) d'. +Proof. now case d. Qed. + +Lemma abs_norm d : abs (norm d) = unorm (abs d). +Proof. now case d as [u|u]; [|simpl; unfold unorm; case nzhead]. Qed. + +Lemma iter_D0_nzhead d : + Nat.iter (nb_digits d - nb_digits (nzhead d)) D0 (nzhead d) = d. +Proof. + induction d; [now simpl| |now rewrite Nat.sub_diag..]. + simpl nzhead; simpl nb_digits. + rewrite (Nat.sub_succ_l _ _ (nb_digits_nzhead _)). + now rewrite <-IHd at 4. +Qed. + +Lemma iter_D0_unorm d : + d <> Nil -> + Nat.iter (nb_digits d - nb_digits (unorm d)) D0 (unorm d) = d. +Proof. + case (uint_eq_dec (nzhead d) Nil); intro Hn. + { unfold unorm; rewrite Hn; simpl; intro H. + revert H Hn; induction d; [now simpl|intros _|now intros _..]. + case (uint_eq_dec d Nil); simpl; intros H Hn; [now rewrite H|]. + rewrite Nat.sub_0_r, (le_plus_minus 1 (nb_digits d)). + { now simpl; rewrite IHd. } + revert H; case d; [now simpl|intros u _; apply le_n_S, Nat.le_0_l..]. } + intros _; rewrite (unorm_nzhead _ Hn); apply iter_D0_nzhead. +Qed. + +Lemma nzhead_app_l d d' : + nb_digits d' < nb_digits (nzhead (app d d')) -> + nzhead (app d d') = app (nzhead d) d'. +Proof. + intro Hl; apply to_list_inj; revert Hl. + rewrite !nb_digits_spec, app_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]. + { now simpl; intro H; exfalso; revert H; apply le_not_lt, length_lnzhead. } + rewrite <-List.app_comm_cons. + now case h; [simpl; intro Hl; apply IHl|..]. +Qed. + +Lemma nzhead_app_r d d' : + nb_digits (nzhead (app d d')) <= nb_digits d' -> + nzhead (app d d') = nzhead d'. +Proof. + intro Hl; apply to_list_inj; revert Hl. + rewrite !nb_digits_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + rewrite <-List.app_comm_cons. + now case h; [| simpl; rewrite List.app_length; intro Hl; exfalso; revert Hl; + apply le_not_lt, le_plus_r..]. +Qed. + +Lemma nzhead_app_nil_r d d' : nzhead (app d d') = Nil -> nzhead d' = Nil. +Proof. +now intro H; generalize H; rewrite nzhead_app_r; [|rewrite H; apply Nat.le_0_l]. +Qed. + +Lemma nzhead_app_nil d d' : + nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead d = Nil. +Proof. + intro H; apply to_list_inj; revert H. + rewrite !nb_digits_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + now case h; [now simpl|..]; + simpl;intro H; exfalso; revert H; apply le_not_lt; + rewrite List.app_length; apply le_plus_r. +Qed. + +Lemma nzhead_app_nil_l d d' : nzhead (app d d') = Nil -> nzhead d = Nil. +Proof. + intro H; apply to_list_inj; generalize (f_equal to_list H); clear H. + rewrite !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + now rewrite <-List.app_comm_cons; case h. +Qed. + +Lemma unorm_app_zero d d' : + nb_digits (unorm (app d d')) <= nb_digits d' -> unorm d = zero. +Proof. + unfold unorm. + case (uint_eq_dec (nzhead (app d d')) Nil). + { now intro Hn; rewrite Hn, (nzhead_app_nil_l _ _ Hn). } + intro H; fold (unorm (app d d')); rewrite (unorm_nzhead _ H); intro H'. + case (uint_eq_dec (nzhead d) Nil); [now intros->|]. + intro H''; fold (unorm d); rewrite (unorm_nzhead _ H''). + exfalso; apply H''; revert H'; apply nzhead_app_nil. +Qed. + +Lemma app_int_nil_r d : app_int d Nil = d. +Proof. + now case d; intro d'; simpl; + rewrite <-(of_list_to_list (app _ _)), app_spec; + rewrite List.app_nil_r, of_list_to_list. +Qed. + +Lemma unorm_app_l d d' : + nb_digits d' < nb_digits (unorm (app d d')) -> + unorm (app d d') = app (unorm d) d'. +Proof. + case (uint_eq_dec d' Nil); [now intros->; rewrite !app_nil_r|intro Hd']. + case (uint_eq_dec (nzhead (app d d')) Nil). + { unfold unorm; intros->; simpl; intro H; exfalso; revert H; apply le_not_lt. + now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } + intro Ha; rewrite (unorm_nzhead _ Ha). + intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). + rewrite !nb_digits_spec, app_spec, List.app_length. + case (uint_eq_dec (nzhead d) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } + now intro H; rewrite (unorm_nzhead _ H). +Qed. + +Lemma unorm_app_r d d' : + nb_digits (unorm (app d d')) <= nb_digits d' -> + unorm (app d d') = unorm d'. +Proof. + case (uint_eq_dec (nzhead (app d d')) Nil). + { now unfold unorm; intro H; rewrite H, (nzhead_app_nil_r _ _ H). } + intro Ha; rewrite (unorm_nzhead _ Ha). + case (uint_eq_dec (nzhead d') Nil). + { now intros H H'; exfalso; apply Ha; rewrite nzhead_app_r. } + intro Hd'; rewrite (unorm_nzhead _ Hd'); apply nzhead_app_r. +Qed. + +Lemma norm_app_int d d' : + nb_digits d' < nb_digits (unorm (app (abs d) d')) -> + norm (app_int d d') = app_int (norm d) d'. +Proof. + case (uint_eq_dec d' Nil); [now intros->; rewrite !app_int_nil_r|intro Hd']. + case d as [d|d]; [now simpl; intro H; apply f_equal, unorm_app_l|]. + simpl; unfold unorm. + case (uint_eq_dec (nzhead (app d d')) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply le_not_lt. + now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } + set (m := match nzhead _ with Nil => _ | _ => _ end). + intro Ha. + replace m with (nzhead (app d d')). + 2:{ now unfold m; revert Ha; case nzhead. } + intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). + case (uint_eq_dec (app (nzhead d) d') Nil). + { intros->; simpl; intro H; exfalso; revert H; apply le_not_lt, Nat.le_0_l. } + clear m; set (m := match app _ _ with Nil => _ | _ => _ end). + intro Ha'. + replace m with (Neg (app (nzhead d) d')); [|now unfold m; revert Ha'; case app]. + case (uint_eq_dec (nzhead d) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + intro Hd. + now replace m with (Neg (nzhead d)); [|unfold m; revert Hd; case nzhead]. +Qed. + +Lemma del_head_nb_digits d : del_head (nb_digits d) d = Nil. +Proof. + apply to_list_inj. + rewrite nb_digits_spec, del_head_spec_small; [|now simpl]. + now rewrite List.skipn_all. +Qed. + +Lemma del_tail_nb_digits d : del_tail (nb_digits d) d = Nil. +Proof. now unfold del_tail; rewrite <-nb_digits_rev, del_head_nb_digits. Qed. + +Lemma del_head_app n d d' : + n <= nb_digits d -> del_head n (app d d') = app (del_head n d) d'. +Proof. + rewrite nb_digits_spec; intro Hn. + apply to_list_inj. + rewrite del_head_spec_small. + 2:{ now rewrite app_spec, List.app_length; apply le_plus_trans. } + rewrite !app_spec, (del_head_spec_small _ _ Hn). + rewrite List.skipn_app. + now rewrite (proj2 (Nat.sub_0_le _ _) Hn). +Qed. + +Lemma del_tail_app n d d' : + n <= nb_digits d' -> del_tail n (app d d') = app d (del_tail n d'). +Proof. + rewrite nb_digits_spec; intro Hn. + unfold del_tail. + rewrite <-(of_list_to_list (rev (app d d'))), rev_spec, app_spec. + rewrite List.rev_app_distr, <-!rev_spec, <-app_spec, of_list_to_list. + rewrite del_head_app; [|now rewrite nb_digits_spec, rev_spec, List.rev_length]. + apply to_list_inj. + rewrite rev_spec, !app_spec, !rev_spec. + now rewrite List.rev_app_distr, List.rev_involutive. +Qed. + +Lemma del_tail_app_int n d d' : + n <= nb_digits d' -> del_tail_int n (app_int d d') = app_int d (del_tail n d'). +Proof. now case d as [d|d]; simpl; intro H; rewrite del_tail_app. Qed. + +Lemma app_del_tail_head n (d:uint) : + n <= nb_digits d -> app (del_tail n d) (del_head (nb_digits d - n) d) = d. +Proof. + rewrite nb_digits_spec; intro Hn; unfold del_tail. + rewrite <-(of_list_to_list (app _ _)), app_spec, rev_spec. + rewrite del_head_spec_small; [|now rewrite rev_spec, List.rev_length]. + rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. + rewrite rev_spec. + set (n' := _ - n). + assert (Hn' : n = length (to_list d) - n'). + { now apply plus_minus; rewrite Nat.add_comm; symmetry; apply le_plus_minus_r. } + now rewrite Hn', <-List.firstn_skipn_rev, List.firstn_skipn, of_list_to_list. Qed. Lemma app_int_del_tail_head n (d:int) : - let ad := match d with Pos d | Neg d => d end in - n <= nb_digits ad -> - app_int (del_tail_int n d) (del_head (nb_digits ad - n) ad) = d. + n <= nb_digits (abs d) -> + app_int (del_tail_int n d) (del_head (nb_digits (abs d) - n) (abs d)) = d. Proof. now case d; clear d; simpl; intros u Hu; rewrite app_del_tail_head. Qed. +Lemma del_head_app_int_exact i f : + nb_digits f < nb_digits (unorm (app (abs i) f)) -> + del_head (nb_digits (unorm (app (abs i) f)) - nb_digits f) (unorm (app (abs i) f)) = f. +Proof. + simpl; intro Hnb; generalize Hnb; rewrite (unorm_app_l _ _ Hnb); clear Hnb. + replace (_ - _) with (nb_digits (unorm (abs i))). + - now rewrite del_head_app; [rewrite del_head_nb_digits|]. + - rewrite !nb_digits_spec, app_spec, List.app_length. + now rewrite Nat.add_comm, minus_plus. +Qed. + +Lemma del_tail_app_int_exact i f : + nb_digits f < nb_digits (unorm (app (abs i) f)) -> + del_tail_int (nb_digits f) (norm (app_int i f)) = norm i. +Proof. + simpl; intro Hnb. + rewrite (norm_app_int _ _ Hnb). + rewrite del_tail_app_int; [|now simpl]. + now rewrite del_tail_nb_digits, app_int_nil_r. +Qed. + (** Normalization on little-endian numbers *) Fixpoint nztail d := @@ -224,10 +474,13 @@ Proof. apply nzhead_revapp. Qed. +Lemma rev_rev d : rev (rev d) = d. +Proof. now apply to_list_inj; rewrite !rev_spec, List.rev_involutive. Qed. + Lemma rev_nztail_rev d : rev (nztail (rev d)) = nzhead d. Proof. - destruct (uint_dec (nztail (rev d)) Nil) as [H|H]. + destruct (uint_eq_dec (nztail (rev d)) Nil) as [H|H]. - rewrite H. unfold rev; simpl. rewrite <- (rev_rev d). symmetry. now apply nzhead_revapp_0. @@ -278,21 +531,9 @@ Proof. unfold unorm. now destruct nzhead. Qed. -Lemma unorm_D0 u : unorm (D0 u) = unorm u. -Proof. reflexivity. Qed. - Lemma unorm_iter_D0 n u : unorm (Nat.iter n D0 u) = unorm u. Proof. now induction n. Qed. -Lemma nb_digits_unorm u : - u <> Nil -> nb_digits (unorm u) <= nb_digits u. -Proof. - case u; clear u; [now simpl|intro u..]; [|now simpl..]. - intros _; unfold unorm. - case_eq (nzhead (D0 u)); [|now intros u' <-; apply nb_digits_nzhead..]. - intros _; apply le_n_S, Nat.le_0_l. -Qed. - Lemma del_head_nonnil n u : n < nb_digits u -> del_head n u <> Nil. Proof. @@ -311,73 +552,78 @@ Proof. now apply del_head_nonnil. Qed. -Lemma nzhead_invol d : nzhead (nzhead d) = nzhead d. +Lemma nzhead_involutive d : nzhead (nzhead d) = nzhead d. Proof. now induction d. Qed. +#[deprecated(since="8.13",note="Use nzhead_involutive instead.")] +Notation nzhead_invol := nzhead_involutive (only parsing). -Lemma nztail_invol d : nztail (nztail d) = nztail d. +Lemma nztail_involutive d : nztail (nztail d) = nztail d. Proof. rewrite <-(rev_rev (nztail _)), <-(rev_rev (nztail d)), <-(rev_rev d). - now rewrite !rev_nztail_rev, nzhead_invol. + now rewrite !rev_nztail_rev, nzhead_involutive. Qed. +#[deprecated(since="8.13",note="Use nztail_involutive instead.")] +Notation nztail_invol := nztail_involutive (only parsing). -Lemma unorm_invol d : unorm (unorm d) = unorm d. +Lemma unorm_involutive d : unorm (unorm d) = unorm d. Proof. unfold unorm. destruct (nzhead d) eqn:E; trivial. destruct (nzhead_nonzero _ _ E). Qed. +#[deprecated(since="8.13",note="Use unorm_involutive instead.")] +Notation unorm_invol := unorm_involutive (only parsing). -Lemma norm_invol d : norm (norm d) = norm d. +Lemma norm_involutive d : norm (norm d) = norm d. Proof. unfold norm. destruct d. - - f_equal. apply unorm_invol. + - f_equal. apply unorm_involutive. - destruct (nzhead d) eqn:E; auto. destruct (nzhead_nonzero _ _ E). Qed. +#[deprecated(since="8.13",note="Use norm_involutive instead.")] +Notation norm_invol := norm_involutive (only parsing). + +Lemma lnzhead_neq_d0_head l l' : ~(lnzhead l = cons d0 l'). +Proof. now induction l as [|h t Il]; [|case h]. Qed. + +Lemma lnzhead_head_nd0 h t : h <> d0 -> lnzhead (cons h t) = cons h t. +Proof. now case h. Qed. Lemma nzhead_del_tail_nzhead_eq n u : nzhead u = u -> n < nb_digits u -> nzhead (del_tail n u) = del_tail n u. Proof. + rewrite nb_digits_spec, <-List.rev_length. intros Hu Hn. - assert (Hhd : forall u, - nzhead u = u <-> match nth 0 u with D0 _ => False | _ => True end). - { clear n u Hu Hn; intro u. - case u; clear u; [|intro u..]; [now simpl| |now simpl..]; simpl. - split; [|now simpl]. - apply nzhead_nonzero. } - assert (Hhd' : nth 0 (del_tail n u) = nth 0 u). - { rewrite <-(app_del_tail_head _ _ (le_Sn_le _ _ Hn)) at 2. - unfold app. - rewrite nth_revapp_l. - - rewrite <-(nth_revapp_l _ _ Nil). - + now fold (rev (rev (del_tail n u))); rewrite rev_rev. - + unfold del_tail; rewrite rev_rev. - rewrite nb_digits_del_head; rewrite nb_digits_rev. - * now rewrite <-Nat.lt_add_lt_sub_r. - * now apply Nat.lt_le_incl. - - unfold del_tail; rewrite rev_rev. - rewrite nb_digits_del_head; rewrite nb_digits_rev. - + now rewrite <-Nat.lt_add_lt_sub_r. - + now apply Nat.lt_le_incl. } - revert Hu; rewrite Hhd; intro Hu. - now rewrite Hhd, Hhd'. + apply to_list_inj; unfold del_tail. + rewrite nzhead_spec, rev_spec. + rewrite del_head_spec_small; [|now rewrite rev_spec; apply Nat.lt_le_incl]. + rewrite rev_spec. + rewrite List.skipn_rev, List.rev_involutive. + generalize (f_equal to_list Hu) Hn; rewrite nzhead_spec; intro Hu'. + case (to_list u) as [|h t]. + { simpl; intro H; exfalso; revert H; apply le_not_lt, Peano.le_0_n. } + intro Hn'; generalize (Nat.sub_gt _ _ Hn'); rewrite List.rev_length. + case (_ - _); [now simpl|]; intros n' _. + rewrite List.firstn_cons, lnzhead_head_nd0; [now simpl|]. + intro Hh; revert Hu'; rewrite Hh; apply lnzhead_neq_d0_head. Qed. Lemma nzhead_del_tail_nzhead n u : n < nb_digits (nzhead u) -> nzhead (del_tail n (nzhead u)) = del_tail n (nzhead u). -Proof. apply nzhead_del_tail_nzhead_eq, nzhead_invol. Qed. +Proof. apply nzhead_del_tail_nzhead_eq, nzhead_involutive. Qed. Lemma unorm_del_tail_unorm n u : n < nb_digits (unorm u) -> unorm (del_tail n (unorm u)) = del_tail n (unorm u). Proof. - case (uint_dec (nzhead u) Nil). + case (uint_eq_dec (nzhead u) Nil). - unfold unorm; intros->; case n; [now simpl|]; intro n'. now simpl; intro H; exfalso; generalize (lt_S_n _ _ H). - unfold unorm. @@ -396,7 +642,7 @@ Lemma norm_del_tail_int_norm n d : Proof. case d; clear d; intros u; simpl. - now intro H; simpl; rewrite unorm_del_tail_unorm. - - case (uint_dec (nzhead u) Nil); intro Hu. + - case (uint_eq_dec (nzhead u) Nil); intro Hu. + now rewrite Hu; case n; [|intros n' Hn'; generalize (lt_S_n _ _ Hn')]. + set (m := match nzhead u with Nil => Pos zero | _ => _ end). replace m with (Neg (nzhead u)); [|now unfold m; revert Hu; case nzhead]. @@ -418,7 +664,7 @@ Proof. generalize (nzhead_revapp d d'). generalize (nzhead_revapp_0 (nztail d) d'). generalize (nzhead_revapp (nztail d) d'). - rewrite nztail_invol. + rewrite nztail_involutive. now case nztail; [intros _ H _ H'; rewrite (H eq_refl), (H' eq_refl) |intros d'' H _ H' _; rewrite H; [rewrite H'|]..]. @@ -455,5 +701,10 @@ Proof. |rewrite H'; unfold r; clear m r H']; unfold norm; rewrite rev_rev, <-Hd''; - rewrite nzhead_revapp; rewrite nztail_invol; [|rewrite Hd'']..]. + rewrite nzhead_revapp; rewrite nztail_involutive; [|rewrite Hd'']..]. +Qed. + +Lemma unorm_app_l_nil d d' : nzhead d = Nil -> unorm (app d d') = unorm d'. +Proof. + now unfold unorm; rewrite <-nzhead_app_nzhead; intros->; rewrite app_nil_l. Qed. diff --git a/theories/Numbers/DecimalN.v b/theories/Numbers/DecimalN.v index 8bc5c38fb5..a5dd97f24b 100644 --- a/theories/Numbers/DecimalN.v +++ b/theories/Numbers/DecimalN.v @@ -74,7 +74,7 @@ Proof. destruct (norm d) eqn:Hd; intros [= <-]. unfold N.to_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - - intros [= <-]. apply unorm_invol. + - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. @@ -93,7 +93,7 @@ Qed. Lemma of_int_norm d : N.of_int (norm d) = N.of_int d. Proof. - unfold N.of_int. now rewrite norm_invol. + unfold N.of_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : diff --git a/theories/Numbers/DecimalNat.v b/theories/Numbers/DecimalNat.v index 1962ac5d9d..4fee40caa2 100644 --- a/theories/Numbers/DecimalNat.v +++ b/theories/Numbers/DecimalNat.v @@ -270,7 +270,7 @@ Proof. destruct (norm d) eqn:Hd; intros [= <-]. unfold Nat.to_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - - intros [= <-]. apply unorm_invol. + - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. @@ -289,7 +289,7 @@ Qed. Lemma of_int_norm d : Nat.of_int (norm d) = Nat.of_int d. Proof. - unfold Nat.of_int. now rewrite norm_invol. + unfold Nat.of_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : diff --git a/theories/Numbers/DecimalQ.v b/theories/Numbers/DecimalQ.v index c51cced024..2027813eec 100644 --- a/theories/Numbers/DecimalQ.v +++ b/theories/Numbers/DecimalQ.v @@ -15,455 +15,413 @@ Require Import Decimal DecimalFacts DecimalPos DecimalN DecimalZ QArith. -Lemma of_to (q:Q) : forall d, to_decimal q = Some d -> of_decimal d = q. +Lemma of_IQmake_to_decimal num den : + match IQmake_to_decimal num den with + | None => True + | Some (DecimalExp _ _ _) => False + | Some (Decimal i f) => of_decimal (Decimal i f) = IQmake (IZ_of_Z num) den + end. Proof. - cut (match to_decimal q with None => True | Some d => of_decimal d = q end). - { now case to_decimal; [intros d <- d' Hd'; injection Hd'; intros ->|]. } - destruct q as (num, den). - unfold to_decimal; simpl. - generalize (DecimalPos.Unsigned.nztail_to_uint den). - case Decimal.nztail; intros u n. - case u; clear u; [intros; exact I|intros; exact I|intro u|intros; exact I..]. - case u; clear u; [|intros; exact I..]. - unfold Pos.of_uint, Pos.of_uint_acc; rewrite N.mul_1_l. - case n. - - unfold of_decimal, app_int, app, Z.to_int; simpl. - intro H; inversion H as (H1); clear H H1. - case num; [reflexivity|intro pnum; fold (rev (rev (Pos.to_uint pnum)))..]. - + rewrite rev_rev; simpl. - now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. - + rewrite rev_rev; simpl. - now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. - - clear n; intros n H. - injection H; clear H; intros ->. - case Nat.ltb. - + unfold of_decimal. - rewrite of_to. - apply f_equal2; [|now simpl]. - unfold app_int, app, Z.to_int; simpl. - now case num; - [|intro pnum; fold (rev (rev (Pos.to_uint pnum))); - rewrite rev_rev; unfold Z.of_int, Z.of_uint; - rewrite DecimalPos.Unsigned.of_to..]. - + unfold of_decimal; case Nat.ltb_spec; intro Hn; simpl. - * rewrite nb_digits_del_head; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply le_Sn_le]. - rewrite Z.sub_sub_distr, Z.sub_diag; simpl. - rewrite <-(of_to num) at 4. - now revert Hn; case Z.to_int; clear num; intros pnum Hn; simpl; - (rewrite app_del_tail_head; [|now apply le_Sn_le]). - * revert Hn. - set (anum := match Z.to_int num with Pos i => i | _ => _ end). - intro Hn. - assert (H : exists l, nb_digits anum = S l). - { exists (Nat.pred (nb_digits anum)); apply S_pred_pos. - now unfold anum; case num; - [apply Nat.lt_0_1| - intro pnum; apply nb_digits_pos, Unsigned.to_uint_nonnil..]. } - destruct H as (l, Hl); rewrite Hl. - assert (H : forall n d, (nb_digits (Nat.iter n D0 d) = n + nb_digits d)%nat). - { now intros n'; induction n'; intro d; [|simpl; rewrite IHn']. } - rewrite H, Hl. - rewrite Nat.add_succ_r, Nat.sub_add; [|now apply le_S_n; rewrite <-Hl]. - assert (H' : forall n d, Pos.of_uint (Nat.iter n D0 d) = Pos.of_uint d). - { now intro n'; induction n'; intro d; [|simpl; rewrite IHn']. } - now unfold anum; case num; simpl; [|intro pnum..]; - unfold app, Z.of_uint; simpl; - rewrite H', ?DecimalPos.Unsigned.of_to. + unfold IQmake_to_decimal. + generalize (Unsigned.nztail_to_uint den). + case Decimal.nztail; intros den' e_den'. + case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. + case den'; [ |now simpl..]; clear den'. + case e_den' as [|e_den']; simpl; intro H; injection H; clear H; intros->. + { now unfold of_decimal; simpl; rewrite app_int_nil_r, DecimalZ.of_to. } + replace (10 ^ _)%positive with (Nat.iter (S e_den') (Pos.mul 10) 1%positive). + 2:{ induction e_den' as [|n IHn]; [now simpl| ]. + now rewrite SuccNat2Pos.inj_succ, Pos.pow_succ_r, <-IHn. } + case Nat.ltb_spec; intro He_den'. + - unfold of_decimal; simpl. + rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. + rewrite DecimalZ.of_to. + now rewrite nb_digits_del_head_sub; [|now apply Nat.lt_le_incl]. + - unfold of_decimal; simpl. + rewrite nb_digits_iter_D0. + apply f_equal2. + + apply f_equal, DecimalZ.to_int_inj. + rewrite DecimalZ.to_of. + rewrite <-(DecimalZ.of_to num), DecimalZ.to_of. + case (Z.to_int num); clear He_den' num; intro num; simpl. + * unfold app; simpl. + now rewrite unorm_D0, unorm_iter_D0, unorm_involutive. + * case (uint_eq_dec (nzhead num) Nil); [|intro Hn]. + { intros->; simpl; unfold app; simpl. + now rewrite unorm_D0, unorm_iter_D0. } + replace (match nzhead num with Nil => _ | _ => _ end) + with (Neg (nzhead num)); [|now revert Hn; case nzhead]. + simpl. + rewrite nzhead_iter_D0, nzhead_involutive. + now revert Hn; case nzhead. + + revert He_den'; case nb_digits as [|n]; [now simpl; rewrite Nat.add_0_r|]. + intro Hn. + rewrite Nat.add_succ_r, Nat.add_comm. + now rewrite <-le_plus_minus; [|apply le_S_n]. Qed. -(* normalize without fractional part, for instance norme 12.3e-1 is 123e-2 *) -Definition dnorme (d:decimal) : decimal := - let '(i, f, e) := - match d with - | Decimal i f => (i, f, Pos Nil) - | DecimalExp i f e => (i, f, e) - end in - let i := norm (app_int i f) in - let e := norm (Z.to_int (Z.of_int e - Z.of_nat (nb_digits f))) in - match e with - | Pos zero => Decimal i Nil - | _ => DecimalExp i Nil e +Lemma IZ_of_Z_IZ_to_Z z z' : IZ_to_Z z = Some z' -> IZ_of_Z z' = z. +Proof. now case z as [| |p|p]; [|intro H; injection H; intros<-..]. Qed. + +Lemma of_IQmake_to_decimal' num den : + match IQmake_to_decimal' num den with + | None => True + | Some (DecimalExp _ _ _) => False + | Some (Decimal i f) => of_decimal (Decimal i f) = IQmake num den end. +Proof. + unfold IQmake_to_decimal'. + case_eq (IZ_to_Z num); [intros num' Hnum'|now simpl]. + generalize (of_IQmake_to_decimal num' den). + case IQmake_to_decimal as [d|]; [|now simpl]. + case d as [i f|]; [|now simpl]. + now rewrite (IZ_of_Z_IZ_to_Z _ _ Hnum'). +Qed. + +Lemma of_to (q:IQ) : forall d, to_decimal q = Some d -> of_decimal d = q. +Proof. + intro d. + case q as [num den|q q'|q q']; simpl. + - generalize (of_IQmake_to_decimal' num den). + case IQmake_to_decimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + now intros H H'; injection H'; clear H'; intros <-. + - case q as [num den| |]; [|now simpl..]. + case q' as [num' den'| |]; [|now simpl..]. + case num' as [z p| | |]; [|now simpl..]. + case (Z.eq_dec z 10); [intros->|]. + 2:{ case z; [now simpl| |now simpl]; intro pz'. + case pz'; [intros d0..| ]; [now simpl| |now simpl]. + case d0; [intros d1..| ]; [ |now simpl..]. + case d1; [intros d2..| ]; [now simpl| |now simpl]. + now case d2. } + case (Pos.eq_dec den' 1%positive); [intros->|now case den']. + generalize (of_IQmake_to_decimal' num den). + case IQmake_to_decimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros <-; clear num den. + intros H; injection H; clear H; intros<-. + unfold of_decimal; simpl. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + - case q as [num den| |]; [|now simpl..]. + case q' as [num' den'| |]; [|now simpl..]. + case num' as [z p| | |]; [|now simpl..]. + case (Z.eq_dec z 10); [intros->|]. + 2:{ case z; [now simpl| |now simpl]; intro pz'. + case pz'; [intros d0..| ]; [now simpl| |now simpl]. + case d0; [intros d1..| ]; [ |now simpl..]. + case d1; [intros d2..| ]; [now simpl| |now simpl]. + now case d2. } + case (Pos.eq_dec den' 1%positive); [intros->|now case den']. + generalize (of_IQmake_to_decimal' num den). + case IQmake_to_decimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros <-; clear num den. + intros H; injection H; clear H; intros<-. + unfold of_decimal; simpl. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. +Qed. -(* normalize without exponent part, for instance norme 12.3e-1 is 1.23 *) -Definition dnormf (d:decimal) : decimal := - match dnorme d with - | Decimal i _ => Decimal i Nil - | DecimalExp i _ e => - match Z.of_int e with - | Z0 => Decimal i Nil - | Zpos e => Decimal (norm (app_int i (Pos.iter D0 Nil e))) Nil - | Zneg e => - let ne := Pos.to_nat e in - let ai := match i with Pos d | Neg d => d end in - let ni := nb_digits ai in - if ne <? ni then - Decimal (del_tail_int ne i) (del_head (ni - ne) ai) - else - let z := match i with Pos _ => Pos zero | Neg _ => Neg zero end in - Decimal z (Nat.iter (ne - ni) D0 ai) +Definition dnorm (d:decimal) : decimal := + let norm_i i f := + match i with + | Pos i => Pos (unorm i) + | Neg i => match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end + end in + match d with + | Decimal i f => Decimal (norm_i i f) f + | DecimalExp i f e => + match norm e with + | Pos zero => Decimal (norm_i i f) f + | e => DecimalExp (norm_i i f) f e end end. -Lemma dnorme_spec d : - match dnorme d with - | Decimal i Nil => i = norm i - | DecimalExp i Nil e => i = norm i /\ e = norm e /\ e <> Pos zero - | _ => False +Lemma dnorm_spec_i d : + let (i, f) := + match d with Decimal i f => (i, f) | DecimalExp i f _ => (i, f) end in + let i' := match dnorm d with Decimal i _ => i | DecimalExp i _ _ => i end in + match i with + | Pos i => i' = Pos (unorm i) + | Neg i => + (i' = Neg (unorm i) /\ (nzhead i <> Nil \/ nzhead f <> Nil)) + \/ (i' = Pos zero /\ (nzhead i = Nil /\ nzhead f = Nil)) end. Proof. - case d; clear d; intros i f; [|intro e]; unfold dnorme; simpl. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); [intros->|intro Hne']. - + now rewrite norm_invol. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - replace m with r; [now unfold r; rewrite !norm_invol|]. - unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); [intros->|intro Hne']. - + now rewrite norm_invol. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - replace m with r; [now unfold r; rewrite !norm_invol|]. - unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. + case d as [i f|i f e]; case i as [i|i]. + - now simpl. + - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + + rewrite Ha; right; split; [now simpl|split]. + * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). + * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + + left; split; [now revert Ha; case nzhead|]. + case (uint_eq_dec (nzhead i) Nil). + * intro Hi; right; intro Hf; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now intro H; left. + - simpl; case (norm e); clear e; intro e; [|now simpl]. + now case e; clear e; [|intro e..]; [|case e|..]. + - simpl. + set (m := match nzhead _ with Nil => _ | _ => _ end). + set (m' := match _ with Decimal _ _ => _ | _ => _ end). + replace m' with m. + 2:{ unfold m'; case (norm e); clear m' e; intro e; [|now simpl]. + now case e; clear e; [|intro e..]; [|case e|..]. } + unfold m; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + + rewrite Ha; right; split; [now simpl|split]. + * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). + * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + + left; split; [now revert Ha; case nzhead|]. + case (uint_eq_dec (nzhead i) Nil). + * intro Hi; right; intro Hf; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now intro H; left. +Qed. + +Lemma dnorm_spec_f d : + let f := match d with Decimal _ f => f | DecimalExp _ f _ => f end in + let f' := match dnorm d with Decimal _ f => f | DecimalExp _ f _ => f end in + f' = f. +Proof. + case d as [i f|i f e]; [now simpl|]. + simpl; case (int_eq_dec (norm e) (Pos zero)); [now intros->|intro He]. + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match norm e with Pos Nil => _ | _ => _ end). + replace m with (DecimalExp i' f (norm e)); [now simpl|]. + unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. Qed. -Lemma dnormf_spec d : - match dnormf d with - | Decimal i f => i = Neg zero \/ i = norm i - | _ => False +Lemma dnorm_spec_e d : + match d, dnorm d with + | Decimal _ _, Decimal _ _ => True + | DecimalExp _ _ e, Decimal _ _ => norm e = Pos zero + | DecimalExp _ _ e, DecimalExp _ _ e' => e' = norm e /\ e' <> Pos zero + | Decimal _ _, DecimalExp _ _ _ => False end. Proof. - case d; clear d; intros i f; [|intro e]; unfold dnormf, dnorme; simpl. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); [intros->|intro Hne']. - + now right; rewrite norm_invol. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - case_eq (Z.of_int e'); [|intros pe'..]; intro Hpe'; - [now right; rewrite norm_invol..|]. - case Nat.ltb_spec. - * now intro H; rewrite (norm_del_tail_int_norm _ _ H); right. - * now intros _; case norm; intros _; [right|left]. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); [intros->|intro Hne']. - + now right; rewrite norm_invol. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - case_eq (Z.of_int e'); [|intros pe'..]; intro Hpe'; - [now right; rewrite norm_invol..|]. - case Nat.ltb_spec. - * now intro H; rewrite (norm_del_tail_int_norm _ _ H); right. - * now intros _; case norm; intros _; [right|left]. + case d as [i f|i f e]; [now simpl|]. + simpl; case (int_eq_dec (norm e) (Pos zero)); [now intros->|intro He]. + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match norm e with Pos Nil => _ | _ => _ end). + replace m with (DecimalExp i' f (norm e)); [now simpl|]. + unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. Qed. -Lemma dnorme_invol d : dnorme (dnorme d) = dnorme d. +Lemma dnorm_involutive d : dnorm (dnorm d) = dnorm d. Proof. - case d; clear d; intros i f; [|intro e]; unfold dnorme; simpl. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); intro Hne'. - + rewrite Hne'; simpl; rewrite app_int_nil_r, norm_invol. - revert Hne'. - rewrite <-to_of. - change (Pos zero) with (Z.to_int 0). - intro H; generalize (to_int_inj _ _ H); clear H. - unfold e'; rewrite DecimalZ.of_to. - now case f; [rewrite app_int_nil_r|..]. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - unfold nb_digits, Z.of_nat; rewrite Z.sub_0_r, to_of, norm_invol. - rewrite app_int_nil_r, norm_invol. - set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); intro Hne'. - + rewrite Hne'; simpl; rewrite app_int_nil_r, norm_invol. - revert Hne'. - rewrite <-to_of. - change (Pos zero) with (Z.to_int 0). - intro H; generalize (to_int_inj _ _ H); clear H. - unfold e'; rewrite DecimalZ.of_to. - now case f; [rewrite app_int_nil_r|..]. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - unfold nb_digits, Z.of_nat; rewrite Z.sub_0_r, to_of, norm_invol. - rewrite app_int_nil_r, norm_invol. - set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. + case d as [i f|i f e]; case i as [i|i]. + - now simpl; rewrite unorm_involutive. + - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + set (m := match nzhead _ with Nil =>_ | _ => _ end). + replace m with (Neg (unorm i)). + 2:{ now unfold m; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + + unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + * intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now case nzhead. + + rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. + - simpl; case (int_eq_dec (norm e) (Pos zero)); intro He. + + now rewrite He; simpl; rewrite unorm_involutive. + + set (m := match norm e with Pos Nil => _ | _ => _ end). + replace m with (DecimalExp (Pos (unorm i)) f (norm e)). + 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + simpl; rewrite norm_involutive, unorm_involutive. + revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. + - simpl; case (int_eq_dec (norm e) (Pos zero)); intro He. + + rewrite He; simpl. + case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + set (m := match nzhead _ with Nil =>_ | _ => _ end). + replace m with (Neg (unorm i)). + 2:{ now unfold m; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + * unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + -- intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + -- now case nzhead. + * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. + + set (m := match norm e with Pos Nil => _ | _ => _ end). + pose (i' := match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end). + replace m with (DecimalExp i' f (norm e)). + 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + simpl; rewrite norm_involutive. + set (i'' := match i' with Pos _ => _ | _ => _ end). + clear m; set (m := match norm e with Pos Nil => _ | _ => _ end). + replace m with (DecimalExp i'' f (norm e)). + 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + unfold i'', i'. + case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + fold i'; replace i' with (Neg (unorm i)). + 2:{ now unfold i'; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + * unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + -- intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + -- now case nzhead. + * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. Qed. -Lemma dnormf_invol d : dnormf (dnormf d) = dnormf d. +Lemma IZ_to_Z_IZ_of_Z z : IZ_to_Z (IZ_of_Z z) = Some z. +Proof. now case z. Qed. + +Lemma dnorm_i_exact i f : + (nb_digits f < nb_digits (unorm (app (abs i) f)))%nat -> + match i with + | Pos i => Pos (unorm i) + | Neg i => + match nzhead (app i f) with + | Nil => Pos zero + | _ => Neg (unorm i) + end + end = norm i. Proof. - case d; clear d; intros i f; [|intro e]; unfold dnormf, dnorme; simpl. - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); intro Hne'. - + rewrite Hne'; simpl; rewrite app_int_nil_r, norm_invol. - revert Hne'. - rewrite <-to_of. - change (Pos zero) with (Z.to_int 0). - intro H; generalize (to_int_inj _ _ H); clear H. - unfold e'; rewrite DecimalZ.of_to. - now case f; [rewrite app_int_nil_r|..]. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite of_int_norm. - case_eq (Z.of_int e'); [|intro pe'..]; intro Hnpe'; - [now simpl; rewrite app_int_nil_r, norm_invol..|]. - case Nat.ltb_spec; intro Hpe'. - * rewrite nb_digits_del_head; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.lt_le_incl]. - simpl. - rewrite Z.sub_sub_distr, Z.sub_diag, Z.add_0_l. - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - rewrite positive_nat_Z; simpl. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. - now rewrite norm_invol, (proj2 (Nat.ltb_lt _ _) Hpe'). - * simpl. - rewrite nb_digits_iter_D0. - rewrite (Nat.sub_add _ _ Hpe'). - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - rewrite positive_nat_Z; simpl. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - revert Hpe'. - set (i' := norm (app_int i f)). - case_eq i'; intros u Hu Hpe'. - ++ simpl; unfold app; simpl. - rewrite unorm_D0, unorm_iter_D0. - assert (Hu' : unorm u = u). - { generalize (f_equal norm Hu). - unfold i'; rewrite norm_invol; fold i'. - now simpl; rewrite Hu; intro H; injection H. } - now rewrite Hu', (proj2 (Nat.ltb_ge _ _) Hpe'). - ++ simpl; rewrite nzhead_iter_D0. - assert (Hu' : nzhead u = u). - { generalize (f_equal norm Hu). - unfold i'; rewrite norm_invol; fold i'. - now rewrite Hu; simpl; case (nzhead u); [|intros u' H; injection H..]. } - rewrite Hu'. - assert (Hu'' : u <> Nil). - { intro H; revert Hu; rewrite H; unfold i'. - now case app_int; intro u'; [|simpl; case nzhead]. } - set (m := match u with Nil => Pos zero | _ => _ end). - assert (H : m = Neg u); [|rewrite H; clear m H]. - { now revert Hu''; unfold m; case u. } - now rewrite (proj2 (Nat.ltb_ge _ _) Hpe'). - - set (e' := Z.to_int _). - case (int_eq_dec (norm e') (Pos zero)); intro Hne'. - + rewrite Hne'; simpl; rewrite app_int_nil_r, norm_invol. - revert Hne'. - rewrite <-to_of. - change (Pos zero) with (Z.to_int 0). - intro H; generalize (to_int_inj _ _ H); clear H. - unfold e'; rewrite DecimalZ.of_to. - now case f; [rewrite app_int_nil_r|..]. - + set (r := DecimalExp _ _ _). - set (m := match norm e' with Pos zero => _ | _ => _ end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { unfold m; revert Hne'; case (norm e'); intro e''; [|now simpl]. - now case e''; [|intro e'''; case e'''..]. } - rewrite of_int_norm. - case_eq (Z.of_int e'); [|intro pe'..]; intro Hnpe'; - [now simpl; rewrite app_int_nil_r, norm_invol..|]. - case Nat.ltb_spec; intro Hpe'. - * rewrite nb_digits_del_head; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.lt_le_incl]. - simpl. - rewrite Z.sub_sub_distr, Z.sub_diag, Z.add_0_l. - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - rewrite positive_nat_Z; simpl. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. - now rewrite norm_invol, (proj2 (Nat.ltb_lt _ _) Hpe'). - * simpl. - rewrite nb_digits_iter_D0. - rewrite (Nat.sub_add _ _ Hpe'). - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - rewrite positive_nat_Z; simpl. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - revert Hpe'. - set (i' := norm (app_int i f)). - case_eq i'; intros u Hu Hpe'. - ++ simpl; unfold app; simpl. - rewrite unorm_D0, unorm_iter_D0. - assert (Hu' : unorm u = u). - { generalize (f_equal norm Hu). - unfold i'; rewrite norm_invol; fold i'. - now simpl; rewrite Hu; intro H; injection H. } - now rewrite Hu', (proj2 (Nat.ltb_ge _ _) Hpe'). - ++ simpl; rewrite nzhead_iter_D0. - assert (Hu' : nzhead u = u). - { generalize (f_equal norm Hu). - unfold i'; rewrite norm_invol; fold i'. - now rewrite Hu; simpl; case (nzhead u); [|intros u' H; injection H..]. } - rewrite Hu'. - assert (Hu'' : u <> Nil). - { intro H; revert Hu; rewrite H; unfold i'. - now case app_int; intro u'; [|simpl; case nzhead]. } - set (m := match u with Nil => Pos zero | _ => _ end). - assert (H : m = Neg u); [|rewrite H; clear m H]. - { now revert Hu''; unfold m; case u. } - now rewrite (proj2 (Nat.ltb_ge _ _) Hpe'). + case i as [ni|ni]; [now simpl|]; simpl. + case (uint_eq_dec (nzhead (app ni f)) Nil); intro Ha. + { now rewrite Ha, (nzhead_app_nil_l _ _ Ha). } + rewrite (unorm_nzhead _ Ha). + set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (unorm ni)); [|now unfold m; revert Ha; case nzhead]. + case (uint_eq_dec (nzhead ni) Nil); intro Hni. + { rewrite <-nzhead_app_nzhead, Hni, app_nil_l. + intro H; exfalso; revert H; apply le_not_lt, nb_digits_nzhead. } + clear m; set (m := match nzhead ni with Nil => _ | _ => _ end). + replace m with (Neg (nzhead ni)); [|now unfold m; revert Hni; case nzhead]. + now rewrite (unorm_nzhead _ Hni). +Qed. + +Lemma dnorm_i_exact' i f : + (nb_digits (unorm (app (abs i) f)) <= nb_digits f)%nat -> + match i with + | Pos i => Pos (unorm i) + | Neg i => + match nzhead (app i f) with + | Nil => Pos zero + | _ => Neg (unorm i) + end + end = + match norm (app_int i f) with + | Pos _ => Pos zero + | Neg _ => Neg zero + end. +Proof. + case i as [ni|ni]; simpl. + { now intro Hnb; rewrite (unorm_app_zero _ _ Hnb). } + unfold unorm. + case (uint_eq_dec (nzhead (app ni f)) Nil); intro Hn. + { now rewrite Hn. } + set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (nzhead (app ni f)). + 2:{ now unfold m; revert Hn; case nzhead. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (unorm ni)). + 2:{ now unfold m, unorm; revert Hn; case nzhead. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (nzhead (app ni f))). + 2:{ now unfold m; revert Hn; case nzhead. } + rewrite <-(unorm_nzhead _ Hn). + now intro H; rewrite (unorm_app_zero _ _ H). Qed. -Lemma to_of (d:decimal) : - to_decimal (of_decimal d) = Some (dnorme d) - \/ to_decimal (of_decimal d) = Some (dnormf d). +Lemma to_of (d:decimal) : to_decimal (of_decimal d) = Some (dnorm d). Proof. - unfold to_decimal. - pose (t10 := fun y => ((y + y~0~0)~0)%positive). - assert (H : exists e_den, - Decimal.nztail (Pos.to_uint (Qden (of_decimal d))) = (D1 Nil, e_den)). - { assert (H : forall p, - Decimal.nztail (Pos.to_uint (Pos.iter t10 1%positive p)) - = (D1 Nil, Pos.to_nat p)). - { intro p; rewrite Pos2Nat.inj_iter. - fold (Nat.iter (Pos.to_nat p) t10 1%positive). - induction (Pos.to_nat p); [now simpl|]. - rewrite DecimalPos.Unsigned.nat_iter_S. - unfold Pos.to_uint. - change (Pos.to_little_uint _) - with (Unsigned.to_lu (10 * N.pos (Nat.iter n t10 1%positive))). - rewrite Unsigned.to_ldec_tenfold. - revert IHn; unfold Pos.to_uint. - unfold Decimal.nztail; rewrite !rev_rev; simpl. - set (f'' := _ (Pos.to_little_uint _)). - now case f''; intros r n' H; inversion H. } - case d; intros i f; [|intro e]; unfold of_decimal; simpl. - - case (- Z.of_nat _)%Z; [|intro p..]; simpl; [now exists O..|]. - exists (Pos.to_nat p); apply H. - - case (_ - _)%Z; [|intros p..]; simpl; [now exists O..|]. - exists (Pos.to_nat p); apply H. } - generalize (DecimalPos.Unsigned.nztail_to_uint (Qden (of_decimal d))). - destruct H as (e, He); rewrite He; clear He; simpl. - assert (Hn1 : forall p, N.pos (Pos.iter t10 1%positive p) = 1%N -> False). - { intro p. - rewrite Pos2Nat.inj_iter. - case_eq (Pos.to_nat p); [|now simpl]. - intro H; exfalso; apply (lt_irrefl O). - rewrite <-H at 2; apply Pos2Nat.is_pos. } - assert (Ht10inj : forall n m, t10 n = t10 m -> n = m). - { intros n m H; generalize (f_equal Z.pos H); clear H. - change (Z.pos (t10 n)) with (Z.mul 10 (Z.pos n)). - change (Z.pos (t10 m)) with (Z.mul 10 (Z.pos m)). - rewrite Z.mul_comm, (Z.mul_comm 10). - intro H; generalize (f_equal (fun z => Z.div z 10) H); clear H. - now rewrite !Z.div_mul; [|now simpl..]; intro H; inversion H. } - assert (Hinj : forall n m, - Nat.iter n t10 1%positive = Nat.iter m t10 1%positive -> n = m). - { induction n; [now intro m; case m|]. - intro m; case m; [now simpl|]; clear m; intro m. - rewrite !Unsigned.nat_iter_S. - intro H; generalize (Ht10inj _ _ H); clear H; intro H. - now rewrite (IHn _ H). } - case e; clear e; [|intro e]; simpl; unfold of_decimal, dnormf, dnorme. - - case d; clear d; intros i f; [|intro e]; simpl. - + intro H; left; revert H. - generalize (nb_digits_pos f). - case f; - [|now clear f; intro f; intros H1 H2; exfalso; revert H1 H2; - case nb_digits; simpl; - [intros H _; apply (lt_irrefl O), H|intros n _; apply Hn1]..]. - now intros _ _; simpl; rewrite to_of. - + intro H; right; revert H. - rewrite <-to_of, DecimalZ.of_to. - set (emf := (_ - _)%Z). - case_eq emf; [|intro pemf..]. - * now simpl; rewrite to_of. - * set (r := DecimalExp _ _ _). - set (m := match _ with Pos _ => _ | _ => r end). - assert (H : m = r). - { unfold m, Z.to_int. - generalize (Unsigned.to_uint_nonzero pemf). - now case Pos.to_uint; [|intro u; case u..]. } - rewrite H; unfold r; clear H m r. - rewrite DecimalZ.of_to. - simpl Qnum. - intros Hpemf _. - apply f_equal; apply f_equal2; [|reflexivity]. - rewrite !Pos2Nat.inj_iter. - set (n := _ pemf). - fold (Nat.iter n (Z.mul 10) (Z.of_int (app_int i f))). - fold (Nat.iter n D0 Nil). - rewrite <-of_int_iter_D0, to_of. - now rewrite norm_app_int_norm; [|induction n]. - * simpl Qden; intros _ H; exfalso; revert H; apply Hn1. - - case d; clear d; intros i f; [|intro e']; simpl. - + case_eq (nb_digits f); [|intros nf' Hnf']; - [now simpl; intros _ H; exfalso; symmetry in H; revert H; apply Hn1|]. - unfold Z.of_nat, Z.opp. - simpl Qden. - intro H; injection H; clear H; unfold Pos.pow. - rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (SuccNat2Pos.inj _ _ ((Pos2Nat.inj _ _ H))); clear H. - intro He; rewrite <-He; clear e He. - simpl Qnum. - case Nat.ltb; [left|right]. - * now rewrite <-to_of, DecimalZ.of_to, to_of. - * rewrite to_of. - set (nif := norm _). - set (anif := match nif with Pos i0 => i0 | _ => _ end). - set (r := DecimalExp nif Nil _). - set (m := match _ with Pos _ => _ | _ => r end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { now unfold m; rewrite <-to_of, DecimalZ.of_to. } - rewrite <-to_of, !DecimalZ.of_to. - fold anif. - now rewrite SuccNat2Pos.id_succ. - + set (nemf := (_ - _)%Z); intro H. - assert (H' : exists pnemf, nemf = Z.neg pnemf); [|revert H]. - { revert H; case nemf; [|intro pnemf..]; [..|now intros _; exists pnemf]; - simpl Qden; intro H; exfalso; symmetry in H; revert H; apply Hn1. } - destruct H' as (pnemf,Hpnemf); rewrite Hpnemf. - simpl Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H. - intro H; revert Hpnemf; rewrite H; clear pnemf H; intro Hnemf. - simpl Qnum. - case Nat.ltb; [left|right]. - * now rewrite <-to_of, DecimalZ.of_to, to_of. - * rewrite to_of. - set (nif := norm _). - set (anif := match nif with Pos i0 => i0 | _ => _ end). - set (r := DecimalExp nif Nil _). - set (m := match _ with Pos _ => _ | _ => r end). - assert (H : m = r); [|rewrite H; unfold m, r; clear m r H]. - { now unfold m; rewrite <-to_of, DecimalZ.of_to. } - rewrite <-to_of, !DecimalZ.of_to. - fold anif. - now rewrite SuccNat2Pos.id_succ. + case d as [i f|i f e]. + - unfold of_decimal; simpl; unfold IQmake_to_decimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_decimal; simpl. + change (fun _ : positive => _) with (Pos.mul 10). + rewrite nztail_to_uint_pow10, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + + rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + + rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + * rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + * rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + - unfold of_decimal; simpl. + rewrite <-to_of. + case (Z.of_int e); clear e; [|intro e..]; simpl. + + unfold IQmake_to_decimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_decimal; simpl. + change (fun _ : positive => _) with (Pos.mul 10). + rewrite nztail_to_uint_pow10, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + + unfold IQmake_to_decimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_decimal; simpl. + change (fun _ : positive => _) with (Pos.mul 10). + rewrite nztail_to_uint_pow10, to_of. + generalize (Unsigned.to_uint_nonzero e); intro He. + set (dnorm_i := match i with Pos _ => _ | _ => _ end). + set (m := match Pos.to_uint e with Nil => _ | _ => _ end). + replace m with (DecimalExp dnorm_i f (Pos (Pos.to_uint e))). + 2:{ now unfold m; revert He; case (Pos.to_uint e); [|intro u; case u|..]. } + clear m; unfold dnorm_i. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + + unfold IQmake_to_decimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_decimal; simpl. + change (fun _ : positive => _) with (Pos.mul 10). + rewrite nztail_to_uint_pow10, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. Qed. (** Some consequences *) @@ -478,84 +436,24 @@ Proof. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. -Lemma to_decimal_surj d : - exists q, to_decimal q = Some (dnorme d) \/ to_decimal q = Some (dnormf d). +Lemma to_decimal_surj d : exists q, to_decimal q = Some (dnorm d). Proof. exists (of_decimal d). apply to_of. Qed. -Lemma of_decimal_dnorme d : of_decimal (dnorme d) = of_decimal d. +Lemma of_decimal_dnorm d : of_decimal (dnorm d) = of_decimal d. +Proof. now apply to_decimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. + +Lemma of_inj d d' : of_decimal d = of_decimal d' -> dnorm d = dnorm d'. Proof. - unfold of_decimal, dnorme. - destruct d. - - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - case_eq (nb_digits f); [|intro nf]; intro Hnf. - + now simpl; rewrite app_int_nil_r, <-DecimalZ.to_of, DecimalZ.of_to. - + simpl; rewrite Z.sub_0_r. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - rewrite app_int_nil_r. - now rewrite <-DecimalZ.to_of, DecimalZ.of_to. - - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - set (emf := (_ - _)%Z). - case_eq emf; [|intro pemf..]; intro Hemf. - + now simpl; rewrite app_int_nil_r, <-DecimalZ.to_of, DecimalZ.of_to. - + simpl. - set (r := DecimalExp _ Nil _). - set (m := match Pos.to_uint pemf with zero => _ | _ => r end). - assert (H : m = r); [|rewrite H; unfold r; clear m r H]. - { generalize (Unsigned.to_uint_nonzero pemf). - now unfold m; case Pos.to_uint; [|intro u; case u|..]. } - simpl; rewrite Z.sub_0_r. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - rewrite app_int_nil_r. - now rewrite <-DecimalZ.to_of, DecimalZ.of_to. - + simpl. - unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - rewrite app_int_nil_r. - now rewrite <-DecimalZ.to_of, DecimalZ.of_to. + intro H. + apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) + (Some (dnorm d)) (Some (dnorm d'))). + now rewrite <- !to_of, H. Qed. -Lemma of_decimal_dnormf d : of_decimal (dnormf d) = of_decimal d. +Lemma of_iff d d' : of_decimal d = of_decimal d' <-> dnorm d = dnorm d'. Proof. - rewrite <-(of_decimal_dnorme d). - unfold of_decimal, dnormf. - assert (H : match dnorme d with Decimal _ f | DecimalExp _ f _ => f end = Nil). - { now unfold dnorme; destruct d; - (case norm; intro d; [case d; [|intro u; case u|..]|]). } - revert H; generalize (dnorme d); clear d; intro d. - destruct d; intro H; rewrite H; clear H; [now simpl|]. - case (Z.of_int e); clear e; [|intro e..]. - - now simpl. - - simpl. - rewrite app_int_nil_r. - apply f_equal2; [|reflexivity]. - rewrite app_int_nil_r. - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - rewrite !Pos2Nat.inj_iter. - fold (Nat.iter (Pos.to_nat e) D0 Nil). - now rewrite of_int_iter_D0. - - simpl. - set (ai := match i with Pos _ => _ | _ => _ end). - rewrite app_int_nil_r. - case Nat.ltb_spec; intro Hei; simpl. - + rewrite nb_digits_del_head; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. - rewrite Nat2Z.inj_sub; [|now apply le_Sn_le]. - rewrite Z.sub_sub_distr, Z.sub_diag; simpl. - rewrite positive_nat_Z; simpl. - now revert Hei; unfold ai; case i; clear i ai; intros i Hei; simpl; - (rewrite app_del_tail_head; [|now apply le_Sn_le]). - + set (n := nb_digits _). - assert (H : (n = Pos.to_nat e - nb_digits ai + nb_digits ai)%nat). - { unfold n; induction (_ - _)%nat; [now simpl|]. - now rewrite Unsigned.nat_iter_S; simpl; rewrite IHn0. } - rewrite H; clear n H. - rewrite Nat2Z.inj_add, (Nat2Z.inj_sub _ _ Hei). - rewrite <-Z.sub_sub_distr, Z.sub_diag, Z.sub_0_r. - rewrite positive_nat_Z; simpl. - rewrite <-(DecimalZ.of_to (Z.of_int (app_int _ _))), DecimalZ.to_of. - rewrite <-(DecimalZ.of_to (Z.of_int i)), DecimalZ.to_of. - apply f_equal2; [|reflexivity]; apply f_equal. - now unfold ai; case i; clear i ai Hei; intro i; - (induction (_ - _)%nat; [|rewrite <-IHn]). + split. apply of_inj. intros E. rewrite <- of_decimal_dnorm, E. + apply of_decimal_dnorm. Qed. diff --git a/theories/Numbers/DecimalR.v b/theories/Numbers/DecimalR.v new file mode 100644 index 0000000000..9b65a7dc20 --- /dev/null +++ b/theories/Numbers/DecimalR.v @@ -0,0 +1,312 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +(** * DecimalR + + Proofs that conversions between decimal numbers and [R] + are bijections. *) + +Require Import Decimal DecimalFacts DecimalPos DecimalZ DecimalQ Rdefinitions. + +Lemma of_IQmake_to_decimal num den : + match IQmake_to_decimal num den with + | None => True + | Some (DecimalExp _ _ _) => False + | Some (Decimal i f) => + of_decimal (Decimal i f) = IRQ (QArith_base.Qmake num den) + end. +Proof. + unfold IQmake_to_decimal. + case (Pos.eq_dec den 1); [now intros->|intro Hden]. + assert (Hf : match QArith_base.IQmake_to_decimal num den with + | Some (Decimal i f) => f <> Nil + | _ => True + end). + { unfold QArith_base.IQmake_to_decimal; simpl. + generalize (Unsigned.nztail_to_uint den). + case Decimal.nztail as [den' e_den']. + case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. + case den'; [ |now simpl..]; clear den'. + case e_den' as [|e_den']; [now simpl; intros H _; apply Hden; injection H|]. + intros _. + case Nat.ltb_spec; intro He_den'. + - apply del_head_nonnil. + revert He_den'; case nb_digits as [|n]; [now simpl|]. + now intro H; simpl; apply le_lt_n_Sm, Nat.le_sub_l. + - apply nb_digits_n0. + now rewrite nb_digits_iter_D0, Nat.sub_add. } + replace (match den with 1%positive => _ | _ => _ end) + with (QArith_base.IQmake_to_decimal num den); [|now revert Hden; case den]. + generalize (of_IQmake_to_decimal num den). + case QArith_base.IQmake_to_decimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + unfold of_decimal; simpl. + intro H; injection H; clear H; intros <-. + intro H; generalize (f_equal QArith_base.IZ_to_Z H); clear H. + rewrite !IZ_to_Z_IZ_of_Z; intro H; injection H; clear H; intros<-. + now revert Hf; case f. +Qed. + +Lemma of_to (q:IR) : forall d, to_decimal q = Some d -> of_decimal d = q. +Proof. + intro d. + case q as [z|q|r r'|r r']; simpl. + - case z as [z p| |p|p]. + + now simpl. + + now simpl; intro H; injection H; clear H; intros<-. + + simpl; intro H; injection H; clear H; intros<-. + now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. + + simpl; intro H; injection H; clear H; intros<-. + now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. + - case q as [num den]. + generalize (of_IQmake_to_decimal num den). + case IQmake_to_decimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + now intros H H'; injection H'; intros<-. + - case r as [z|q| |]; [|case q as[num den]|now simpl..]; + (case r' as [z'| | |]; [|now simpl..]); + (case z' as [p e| | |]; [|now simpl..]). + + case (Z.eq_dec p 10); [intros->|intro Hp]. + 2:{ revert Hp; case p; [now simpl|intro d0..]; + (case d0; [intro d1..|]; [now simpl| |now simpl]; + case d1; [intro d2..|]; [|now simpl..]; + case d2; [intro d3..|]; [now simpl| |now simpl]; + now case d3). } + case z as [| |p|p]; [now simpl|..]; intro H; injection H; intros<-. + * now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. + * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. + now rewrite Unsigned.of_to. + * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. + now rewrite Unsigned.of_to. + + case (Z.eq_dec p 10); [intros->|intro Hp]. + 2:{ revert Hp; case p; [now simpl|intro d0..]; + (case d0; [intro d1..|]; [now simpl| |now simpl]; + case d1; [intro d2..|]; [|now simpl..]; + case d2; [intro d3..|]; [now simpl| |now simpl]; + now case d3). } + generalize (of_IQmake_to_decimal num den). + case IQmake_to_decimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros H H'; injection H'; clear H'; intros<-. + unfold of_decimal; simpl. + change (match f with Nil => _ | _ => _ end) with (of_decimal (Decimal i f)). + rewrite H; clear H. + now unfold Z.of_uint; rewrite Unsigned.of_to. + - case r as [z|q| |]; [|case q as[num den]|now simpl..]; + (case r' as [z'| | |]; [|now simpl..]); + (case z' as [p e| | |]; [|now simpl..]). + + case (Z.eq_dec p 10); [intros->|intro Hp]. + 2:{ revert Hp; case p; [now simpl|intro d0..]; + (case d0; [intro d1..|]; [now simpl| |now simpl]; + case d1; [intro d2..|]; [|now simpl..]; + case d2; [intro d3..|]; [now simpl| |now simpl]; + now case d3). } + case z as [| |p|p]; [now simpl|..]; intro H; injection H; intros<-. + * now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. + * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. + now rewrite Unsigned.of_to. + * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. + now rewrite Unsigned.of_to. + + case (Z.eq_dec p 10); [intros->|intro Hp]. + 2:{ revert Hp; case p; [now simpl|intro d0..]; + (case d0; [intro d1..|]; [now simpl| |now simpl]; + case d1; [intro d2..|]; [|now simpl..]; + case d2; [intro d3..|]; [now simpl| |now simpl]; + now case d3). } + generalize (of_IQmake_to_decimal num den). + case IQmake_to_decimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros H H'; injection H'; clear H'; intros<-. + unfold of_decimal; simpl. + change (match f with Nil => _ | _ => _ end) with (of_decimal (Decimal i f)). + rewrite H; clear H. + now unfold Z.of_uint; rewrite Unsigned.of_to. +Qed. + +Lemma to_of (d:decimal) : to_decimal (of_decimal d) = Some (dnorm d). +Proof. + case d as [i f|i f e]. + - unfold of_decimal; simpl. + case (uint_eq_dec f Nil); intro Hf. + + rewrite Hf; clear f Hf. + unfold to_decimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + + set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_decimal; simpl. + unfold IQmake_to_decimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_decimal, n; simpl. + rewrite nztail_to_uint_pow10. + clear r; set (r := if _ <? _ then Some (Decimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite DecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + * rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + * rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + - unfold of_decimal; simpl. + rewrite <-(DecimalZ.to_of e). + case (Z.of_int e); clear e; [|intro e..]; simpl. + + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_decimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_decimal; simpl. + unfold IQmake_to_decimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_decimal, n; simpl. + rewrite nztail_to_uint_pow10. + clear r; set (r := if _ <? _ then Some (Decimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite DecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match Pos.to_uint e with Nil => _ | _ => _ end). + replace m with (DecimalExp i' f (Pos (Pos.to_uint e))). + 2:{ unfold m; generalize (Unsigned.to_uint_nonzero e). + now case Pos.to_uint; [|intro u; case u|..]. } + unfold i'; clear i' m. + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_decimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_decimal; simpl. + unfold IQmake_to_decimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_decimal, n; simpl. + rewrite nztail_to_uint_pow10. + clear r; set (r := if _ <? _ then Some (Decimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite DecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_decimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_decimal; simpl. + unfold IQmake_to_decimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_decimal, n; simpl. + rewrite nztail_to_uint_pow10. + clear r; set (r := if _ <? _ then Some (Decimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite DecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. +Qed. + +(** Some consequences *) + +Lemma to_decimal_inj q q' : + to_decimal q <> None -> to_decimal q = to_decimal q' -> q = q'. +Proof. + intros Hnone EQ. + generalize (of_to q) (of_to q'). + rewrite <-EQ. + revert Hnone; case to_decimal; [|now simpl]. + now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). +Qed. + +Lemma to_decimal_surj d : exists q, to_decimal q = Some (dnorm d). +Proof. + exists (of_decimal d). apply to_of. +Qed. + +Lemma of_decimal_dnorm d : of_decimal (dnorm d) = of_decimal d. +Proof. now apply to_decimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. + +Lemma of_inj d d' : of_decimal d = of_decimal d' -> dnorm d = dnorm d'. +Proof. + intro H. + apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) + (Some (dnorm d)) (Some (dnorm d'))). + now rewrite <- !to_of, H. +Qed. + +Lemma of_iff d d' : of_decimal d = of_decimal d' <-> dnorm d = dnorm d'. +Proof. + split. apply of_inj. intros E. rewrite <- of_decimal_dnorm, E. + apply of_decimal_dnorm. +Qed. diff --git a/theories/Numbers/DecimalZ.v b/theories/Numbers/DecimalZ.v index 69d8073fc7..faaf8a3932 100644 --- a/theories/Numbers/DecimalZ.v +++ b/theories/Numbers/DecimalZ.v @@ -79,9 +79,11 @@ Qed. Lemma of_uint_iter_D0 d n : Z.of_uint (app d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 10) (Z.of_uint d). Proof. - unfold Z.of_uint. - unfold app; rewrite <-rev_revapp. - rewrite Unsigned.of_lu_rev, Unsigned.of_lu_revapp. + rewrite <-(rev_rev (app _ _)), <-(of_list_to_list (rev (app _ _))). + rewrite rev_spec, app_spec, List.rev_app_distr. + rewrite <-!rev_spec, <-app_spec, of_list_to_list. + unfold Z.of_uint; rewrite Unsigned.of_lu_rev. + unfold app; rewrite Unsigned.of_lu_revapp, !rev_rev. rewrite <-!Unsigned.of_lu_rev, !rev_rev. assert (H' : Pos.of_uint (Nat.iter n D0 Nil) = 0%N). { now induction n; [|rewrite Unsigned.nat_iter_S]. } @@ -100,3 +102,22 @@ Proof. - rewrite of_uint_iter_D0; induction n; [now simpl|]. rewrite !Unsigned.nat_iter_S, <-IHn; ring. Qed. + +Lemma nztail_to_uint_pow10 n : + Decimal.nztail (Pos.to_uint (Nat.iter n (Pos.mul 10) 1%positive)) + = (D1 Nil, n). +Proof. + case n as [|n]; [now simpl|]. + rewrite <-(Nat2Pos.id (S n)); [|now simpl]. + generalize (Pos.of_nat (S n)); clear n; intro p. + induction (Pos.to_nat p); [now simpl|]. + rewrite Unsigned.nat_iter_S. + unfold Pos.to_uint. + change (Pos.to_little_uint _) + with (Unsigned.to_lu (10 * N.pos (Nat.iter n (Pos.mul 10) 1%positive))). + rewrite Unsigned.to_ldec_tenfold. + revert IHn; unfold Pos.to_uint. + unfold Decimal.nztail; rewrite !rev_rev; simpl. + set (f'' := _ (Pos.to_little_uint _)). + now case f''; intros r n' H; inversion H. +Qed. diff --git a/theories/Numbers/HexadecimalFacts.v b/theories/Numbers/HexadecimalFacts.v index 7328b2303d..c624b4e6b9 100644 --- a/theories/Numbers/HexadecimalFacts.v +++ b/theories/Numbers/HexadecimalFacts.v @@ -10,136 +10,437 @@ (** * HexadecimalFacts : some facts about Hexadecimal numbers *) -Require Import Hexadecimal Arith. +Require Import Hexadecimal Arith ZArith. + +Variant digits := + | d0 | d1 | d2 | d3 | d4 | d5 | d6 | d7 | d8 | d9 + | da | db | dc | dd | de | df. + +Fixpoint to_list (u : uint) : list digits := + match u with + | Nil => nil + | D0 u => cons d0 (to_list u) + | D1 u => cons d1 (to_list u) + | D2 u => cons d2 (to_list u) + | D3 u => cons d3 (to_list u) + | D4 u => cons d4 (to_list u) + | D5 u => cons d5 (to_list u) + | D6 u => cons d6 (to_list u) + | D7 u => cons d7 (to_list u) + | D8 u => cons d8 (to_list u) + | D9 u => cons d9 (to_list u) + | Da u => cons da (to_list u) + | Db u => cons db (to_list u) + | Dc u => cons dc (to_list u) + | Dd u => cons dd (to_list u) + | De u => cons de (to_list u) + | Df u => cons df (to_list u) + end. + +Fixpoint of_list (l : list digits) : uint := + match l with + | nil => Nil + | cons d0 l => D0 (of_list l) + | cons d1 l => D1 (of_list l) + | cons d2 l => D2 (of_list l) + | cons d3 l => D3 (of_list l) + | cons d4 l => D4 (of_list l) + | cons d5 l => D5 (of_list l) + | cons d6 l => D6 (of_list l) + | cons d7 l => D7 (of_list l) + | cons d8 l => D8 (of_list l) + | cons d9 l => D9 (of_list l) + | cons da l => Da (of_list l) + | cons db l => Db (of_list l) + | cons dc l => Dc (of_list l) + | cons dd l => Dd (of_list l) + | cons de l => De (of_list l) + | cons df l => Df (of_list l) + end. -Scheme Equality for uint. +Lemma of_list_to_list u : of_list (to_list u) = u. +Proof. now induction u; [|simpl; rewrite IHu..]. Qed. -Scheme Equality for int. +Lemma to_list_of_list l : to_list (of_list l) = l. +Proof. now induction l as [|h t IHl]; [|case h; simpl; rewrite IHl]. Qed. -Lemma rev_revapp d d' : - rev (revapp d d') = revapp d' d. +Lemma to_list_inj u u' : to_list u = to_list u' -> u = u'. Proof. - revert d'. induction d; simpl; intros; now rewrite ?IHd. + now intro H; rewrite <-(of_list_to_list u), <-(of_list_to_list u'), H. Qed. -Lemma rev_rev d : rev (rev d) = d. +Lemma of_list_inj u u' : of_list u = of_list u' -> u = u'. Proof. - apply rev_revapp. + now intro H; rewrite <-(to_list_of_list u), <-(to_list_of_list u'), H. Qed. -Lemma revapp_rev_nil d : revapp (rev d) Nil = d. -Proof. now fold (rev (rev d)); rewrite rev_rev. Qed. +Lemma nb_digits_spec u : nb_digits u = length (to_list u). +Proof. now induction u; [|simpl; rewrite IHu..]. Qed. -Lemma app_nil_r d : app d Nil = d. -Proof. now unfold app; rewrite revapp_rev_nil. Qed. +Fixpoint lnzhead l := + match l with + | nil => nil + | cons d l' => + match d with + | d0 => lnzhead l' + | _ => l + end + end. -Lemma app_int_nil_r d : app_int d Nil = d. -Proof. now case d; intro d'; simpl; rewrite app_nil_r. Qed. +Lemma nzhead_spec u : to_list (nzhead u) = lnzhead (to_list u). +Proof. now induction u; [|simpl; rewrite IHu|..]. Qed. + +Definition lzero := cons d0 nil. + +Definition lunorm l := + match lnzhead l with + | nil => lzero + | d => d + end. + +Lemma unorm_spec u : to_list (unorm u) = lunorm (to_list u). +Proof. now unfold unorm, lunorm; rewrite <-nzhead_spec; case (nzhead u). Qed. + +Lemma revapp_spec d d' : + to_list (revapp d d') = List.rev_append (to_list d) (to_list d'). +Proof. now revert d'; induction d; intro d'; [|simpl; rewrite IHd..]. Qed. + +Lemma rev_spec d : to_list (rev d) = List.rev (to_list d). +Proof. now unfold rev; rewrite revapp_spec, List.rev_alt; simpl. Qed. + +Lemma app_spec d d' : + to_list (app d d') = Datatypes.app (to_list d) (to_list d'). +Proof. + unfold app. + now rewrite revapp_spec, List.rev_append_rev, rev_spec, List.rev_involutive. +Qed. -Lemma revapp_revapp_1 d d' d'' : - nb_digits d <= 1 -> - revapp (revapp d d') d'' = revapp d' (revapp d d''). +Definition lnztail l := + let fix aux l_rev := + match l_rev with + | cons d0 l_rev => let (r, n) := aux l_rev in pair r (S n) + | _ => pair l_rev O + end in + let (r, n) := aux (List.rev l) in pair (List.rev r) n. + +Lemma nztail_spec d : + let (r, n) := nztail d in + let (r', n') := lnztail (to_list d) in + to_list r = r' /\ n = n'. Proof. - now case d; clear d; intro d; - [|case d; clear d; intro d; - [|simpl; case nb_digits; [|intros n]; intros Hn; exfalso; - [apply (Nat.nle_succ_diag_l _ Hn)| - apply (Nat.nle_succ_0 _ (le_S_n _ _ Hn))]..]..]. + unfold nztail, lnztail. + set (f := fix aux d_rev := match d_rev with + | D0 d_rev => let (r, n) := aux d_rev in (r, S n) + | _ => (d_rev, 0) end). + set (f' := fix aux (l_rev : list digits) : list digits * nat := + match l_rev with + | cons d0 l_rev => let (r, n) := aux l_rev in (r, S n) + | _ => (l_rev, 0) + end). + rewrite <-(of_list_to_list (rev d)), rev_spec. + induction (List.rev _) as [|h t IHl]; [now simpl|]. + case h; simpl; [|now rewrite rev_spec; simpl; rewrite to_list_of_list..]. + now revert IHl; case f; intros r n; case f'; intros r' n' [-> ->]. Qed. -Lemma nb_digits_pos d : d <> Nil -> 0 < nb_digits d. -Proof. now case d; [|intros d' _; apply Nat.lt_0_succ..]. Qed. +Lemma del_head_spec_0 d : del_head 0 d = d. +Proof. now simpl. Qed. -Lemma nb_digits_revapp d d' : - nb_digits (revapp d d') = nb_digits d + nb_digits d'. +Lemma del_head_spec_small n d : + n <= length (to_list d) -> to_list (del_head n d) = List.skipn n (to_list d). Proof. - now revert d'; induction d; [|intro d'; simpl; rewrite IHd; simpl..]. + revert d; induction n as [|n IHn]; intro d; [now simpl|]. + now case d; [|intros d' H; apply IHn, le_S_n..]. Qed. -Lemma nb_digits_rev u : nb_digits (rev u) = nb_digits u. -Proof. now unfold rev; rewrite nb_digits_revapp. Qed. +Lemma del_head_spec_large n d : length (to_list d) < n -> del_head n d = zero. +Proof. + revert d; induction n; intro d; [now case d|]. + now case d; [|intro d'; simpl; intro H; rewrite (IHn _ (lt_S_n _ _ H))..]. +Qed. -Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. -Proof. now induction u; [|apply le_S|..]. Qed. +Lemma nb_digits_0 d : nb_digits d = 0 -> d = Nil. +Proof. + rewrite nb_digits_spec, <-(of_list_to_list d). + now case (to_list d) as [|h t]; [|rewrite to_list_of_list]. +Qed. + +Lemma nb_digits_n0 d : nb_digits d <> 0 -> d <> Nil. +Proof. now case d; [|intros u _..]. Qed. Lemma nb_digits_iter_D0 n d : nb_digits (Nat.iter n D0 d) = n + nb_digits d. Proof. now induction n; simpl; [|rewrite IHn]. Qed. -Fixpoint nth n u := - match n with - | O => - match u with - | Nil => Nil - | D0 d => D0 Nil - | D1 d => D1 Nil - | D2 d => D2 Nil - | D3 d => D3 Nil - | D4 d => D4 Nil - | D5 d => D5 Nil - | D6 d => D6 Nil - | D7 d => D7 Nil - | D8 d => D8 Nil - | D9 d => D9 Nil - | Da d => Da Nil - | Db d => Db Nil - | Dc d => Dc Nil - | Dd d => Dd Nil - | De d => De Nil - | Df d => Df Nil - end - | S n => - match u with - | Nil => Nil - | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d - | Da d | Db d | Dc d | Dd d | De d | Df d => - nth n d - end - end. +Lemma length_lnzhead l : length (lnzhead l) <= length l. +Proof. now induction l as [|h t IHl]; [|case h; [apply le_S|..]]. Qed. + +Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. +Proof. now induction u; [|apply le_S|..]. Qed. -Lemma nb_digits_nth n u : nb_digits (nth n u) <= 1. -Proof. - revert u; induction n. - - now intro u; case u; [apply Nat.le_0_1|..]. - - intro u; case u; [apply Nat.le_0_1|intro u'; apply IHn..]. -Qed. - -Lemma nth_revapp_r n d d' : - nb_digits d <= n -> - nth n (revapp d d') = nth (n - nb_digits d) d'. -Proof. - revert d d'; induction n; intro d. - - now case d; intro d'; - [case d'|intros d'' H; exfalso; revert H; apply Nat.nle_succ_0..]. - - now induction d; - [intro d'; case d'| - intros d' H; - simpl revapp; rewrite IHd; [|now apply le_Sn_le]; - rewrite Nat.sub_succ_l; [|now apply le_S_n]; - simpl; rewrite <-(IHn _ _ (le_S_n _ _ H))..]. -Qed. - -Lemma nth_revapp_l n d d' : - n < nb_digits d -> - nth n (revapp d d') = nth (nb_digits d - n - 1) d. -Proof. - revert d d'; induction n; intro d. - - rewrite Nat.sub_0_r. - now induction d; - [|intros d' _; simpl revapp; - revert IHd; case d; clear d; [|intro d..]; intro IHd; - [|rewrite IHd; [simpl nb_digits; rewrite (Nat.sub_succ_l _ (S _))|]; - [|apply le_n_S, Nat.le_0_l..]..]..]. - - now induction d; - [|intros d' H; - simpl revapp; simpl nb_digits; - simpl in H; generalize (lt_S_n _ _ H); clear H; intro H; - case (le_lt_eq_dec _ _ H); clear H; intro H; - [rewrite (IHd _ H), Nat.sub_succ_l; - [rewrite Nat.sub_succ_l; [|apply Nat.le_add_le_sub_r]| - apply le_Sn_le]| - rewrite nth_revapp_r; rewrite <-H; - [rewrite Nat.sub_succ, Nat.sub_succ_l; [rewrite !Nat.sub_diag|]|]]..]. +Lemma unorm_nzhead u : nzhead u <> Nil -> unorm u = nzhead u. +Proof. now unfold unorm; case nzhead. Qed. + +Lemma nb_digits_unorm u : u <> Nil -> nb_digits (unorm u) <= nb_digits u. +Proof. + intro Hu; case (uint_eq_dec (nzhead u) Nil). + { unfold unorm; intros ->; simpl. + now revert Hu; case u; [|intros u' _; apply le_n_S, Nat.le_0_l..]. } + intro H; rewrite (unorm_nzhead _ H); apply nb_digits_nzhead. +Qed. + +Lemma nb_digits_rev d : nb_digits (rev d) = nb_digits d. +Proof. now rewrite !nb_digits_spec, rev_spec, List.rev_length. Qed. + +Lemma nb_digits_del_head_sub d n : + n <= nb_digits d -> + nb_digits (del_head (nb_digits d - n) d) = n. +Proof. + rewrite !nb_digits_spec; intro Hn. + rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. + rewrite List.skipn_length, <-(Nat2Z.id (_ - _)). + rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. + rewrite (Nat2Z.inj_sub _ _ Hn). + rewrite Z.sub_sub_distr, Z.sub_diag; apply Nat2Z.id. +Qed. + +Lemma unorm_D0 u : unorm (D0 u) = unorm u. +Proof. reflexivity. Qed. + +Lemma app_nil_l d : app Nil d = d. +Proof. now simpl. Qed. + +Lemma app_nil_r d : app d Nil = d. +Proof. now apply to_list_inj; rewrite app_spec, List.app_nil_r. Qed. + +Lemma abs_app_int d d' : abs (app_int d d') = app (abs d) d'. +Proof. now case d. Qed. + +Lemma abs_norm d : abs (norm d) = unorm (abs d). +Proof. now case d as [u|u]; [|simpl; unfold unorm; case nzhead]. Qed. + +Lemma iter_D0_nzhead d : + Nat.iter (nb_digits d - nb_digits (nzhead d)) D0 (nzhead d) = d. +Proof. + induction d; [now simpl| |now rewrite Nat.sub_diag..]. + simpl nzhead; simpl nb_digits. + rewrite (Nat.sub_succ_l _ _ (nb_digits_nzhead _)). + now rewrite <-IHd at 4. +Qed. + +Lemma iter_D0_unorm d : + d <> Nil -> + Nat.iter (nb_digits d - nb_digits (unorm d)) D0 (unorm d) = d. +Proof. + case (uint_eq_dec (nzhead d) Nil); intro Hn. + { unfold unorm; rewrite Hn; simpl; intro H. + revert H Hn; induction d; [now simpl|intros _|now intros _..]. + case (uint_eq_dec d Nil); simpl; intros H Hn; [now rewrite H|]. + rewrite Nat.sub_0_r, (le_plus_minus 1 (nb_digits d)). + { now simpl; rewrite IHd. } + revert H; case d; [now simpl|intros u _; apply le_n_S, Nat.le_0_l..]. } + intros _; rewrite (unorm_nzhead _ Hn); apply iter_D0_nzhead. +Qed. + +Lemma nzhead_app_l d d' : + nb_digits d' < nb_digits (nzhead (app d d')) -> + nzhead (app d d') = app (nzhead d) d'. +Proof. + intro Hl; apply to_list_inj; revert Hl. + rewrite !nb_digits_spec, app_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]. + { now simpl; intro H; exfalso; revert H; apply le_not_lt, length_lnzhead. } + rewrite <-List.app_comm_cons. + now case h; [simpl; intro Hl; apply IHl|..]. +Qed. + +Lemma nzhead_app_r d d' : + nb_digits (nzhead (app d d')) <= nb_digits d' -> + nzhead (app d d') = nzhead d'. +Proof. + intro Hl; apply to_list_inj; revert Hl. + rewrite !nb_digits_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + rewrite <-List.app_comm_cons. + now case h; [| simpl; rewrite List.app_length; intro Hl; exfalso; revert Hl; + apply le_not_lt, le_plus_r..]. +Qed. + +Lemma nzhead_app_nil_r d d' : nzhead (app d d') = Nil -> nzhead d' = Nil. +Proof. +now intro H; generalize H; rewrite nzhead_app_r; [|rewrite H; apply Nat.le_0_l]. +Qed. + +Lemma nzhead_app_nil d d' : + nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead d = Nil. +Proof. + intro H; apply to_list_inj; revert H. + rewrite !nb_digits_spec, !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + now case h; [now simpl|..]; + simpl;intro H; exfalso; revert H; apply le_not_lt; + rewrite List.app_length; apply le_plus_r. +Qed. + +Lemma nzhead_app_nil_l d d' : nzhead (app d d') = Nil -> nzhead d = Nil. +Proof. + intro H; apply to_list_inj; generalize (f_equal to_list H); clear H. + rewrite !nzhead_spec, app_spec. + induction (to_list d) as [|h t IHl]; [now simpl|]. + now rewrite <-List.app_comm_cons; case h. +Qed. + +Lemma unorm_app_zero d d' : + nb_digits (unorm (app d d')) <= nb_digits d' -> unorm d = zero. +Proof. + unfold unorm. + case (uint_eq_dec (nzhead (app d d')) Nil). + { now intro Hn; rewrite Hn, (nzhead_app_nil_l _ _ Hn). } + intro H; fold (unorm (app d d')); rewrite (unorm_nzhead _ H); intro H'. + case (uint_eq_dec (nzhead d) Nil); [now intros->|]. + intro H''; fold (unorm d); rewrite (unorm_nzhead _ H''). + exfalso; apply H''; revert H'; apply nzhead_app_nil. +Qed. + +Lemma app_int_nil_r d : app_int d Nil = d. +Proof. + now case d; intro d'; simpl; + rewrite <-(of_list_to_list (app _ _)), app_spec; + rewrite List.app_nil_r, of_list_to_list. +Qed. + +Lemma unorm_app_l d d' : + nb_digits d' < nb_digits (unorm (app d d')) -> + unorm (app d d') = app (unorm d) d'. +Proof. + case (uint_eq_dec d' Nil); [now intros->; rewrite !app_nil_r|intro Hd']. + case (uint_eq_dec (nzhead (app d d')) Nil). + { unfold unorm; intros->; simpl; intro H; exfalso; revert H; apply le_not_lt. + now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } + intro Ha; rewrite (unorm_nzhead _ Ha). + intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). + rewrite !nb_digits_spec, app_spec, List.app_length. + case (uint_eq_dec (nzhead d) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } + now intro H; rewrite (unorm_nzhead _ H). +Qed. + +Lemma unorm_app_r d d' : + nb_digits (unorm (app d d')) <= nb_digits d' -> + unorm (app d d') = unorm d'. +Proof. + case (uint_eq_dec (nzhead (app d d')) Nil). + { now unfold unorm; intro H; rewrite H, (nzhead_app_nil_r _ _ H). } + intro Ha; rewrite (unorm_nzhead _ Ha). + case (uint_eq_dec (nzhead d') Nil). + { now intros H H'; exfalso; apply Ha; rewrite nzhead_app_r. } + intro Hd'; rewrite (unorm_nzhead _ Hd'); apply nzhead_app_r. +Qed. + +Lemma norm_app_int d d' : + nb_digits d' < nb_digits (unorm (app (abs d) d')) -> + norm (app_int d d') = app_int (norm d) d'. +Proof. + case (uint_eq_dec d' Nil); [now intros->; rewrite !app_int_nil_r|intro Hd']. + case d as [d|d]; [now simpl; intro H; apply f_equal, unorm_app_l|]. + simpl; unfold unorm. + case (uint_eq_dec (nzhead (app d d')) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply le_not_lt. + now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } + set (m := match nzhead _ with Nil => _ | _ => _ end). + intro Ha. + replace m with (nzhead (app d d')). + 2:{ now unfold m; revert Ha; case nzhead. } + intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). + case (uint_eq_dec (app (nzhead d) d') Nil). + { intros->; simpl; intro H; exfalso; revert H; apply le_not_lt, Nat.le_0_l. } + clear m; set (m := match app _ _ with Nil => _ | _ => _ end). + intro Ha'. + replace m with (Neg (app (nzhead d) d')); [|now unfold m; revert Ha'; case app]. + case (uint_eq_dec (nzhead d) Nil). + { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + intro Hd. + now replace m with (Neg (nzhead d)); [|unfold m; revert Hd; case nzhead]. +Qed. + +Lemma del_head_nb_digits d : del_head (nb_digits d) d = Nil. +Proof. + apply to_list_inj. + rewrite nb_digits_spec, del_head_spec_small; [|now simpl]. + now rewrite List.skipn_all. +Qed. + +Lemma del_tail_nb_digits d : del_tail (nb_digits d) d = Nil. +Proof. now unfold del_tail; rewrite <-nb_digits_rev, del_head_nb_digits. Qed. + +Lemma del_head_app n d d' : + n <= nb_digits d -> del_head n (app d d') = app (del_head n d) d'. +Proof. + rewrite nb_digits_spec; intro Hn. + apply to_list_inj. + rewrite del_head_spec_small. + 2:{ now rewrite app_spec, List.app_length; apply le_plus_trans. } + rewrite !app_spec, (del_head_spec_small _ _ Hn). + rewrite List.skipn_app. + now rewrite (proj2 (Nat.sub_0_le _ _) Hn). +Qed. + +Lemma del_tail_app n d d' : + n <= nb_digits d' -> del_tail n (app d d') = app d (del_tail n d'). +Proof. + rewrite nb_digits_spec; intro Hn. + unfold del_tail. + rewrite <-(of_list_to_list (rev (app d d'))), rev_spec, app_spec. + rewrite List.rev_app_distr, <-!rev_spec, <-app_spec, of_list_to_list. + rewrite del_head_app; [|now rewrite nb_digits_spec, rev_spec, List.rev_length]. + apply to_list_inj. + rewrite rev_spec, !app_spec, !rev_spec. + now rewrite List.rev_app_distr, List.rev_involutive. +Qed. + +Lemma del_tail_app_int n d d' : + n <= nb_digits d' -> del_tail_int n (app_int d d') = app_int d (del_tail n d'). +Proof. now case d as [d|d]; simpl; intro H; rewrite del_tail_app. Qed. + +Lemma app_del_tail_head n (d:uint) : + n <= nb_digits d -> app (del_tail n d) (del_head (nb_digits d - n) d) = d. +Proof. + rewrite nb_digits_spec; intro Hn; unfold del_tail. + rewrite <-(of_list_to_list (app _ _)), app_spec, rev_spec. + rewrite del_head_spec_small; [|now rewrite rev_spec, List.rev_length]. + rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. + rewrite rev_spec. + set (n' := _ - n). + assert (Hn' : n = length (to_list d) - n'). + { now apply plus_minus; rewrite Nat.add_comm; symmetry; apply le_plus_minus_r. } + now rewrite Hn', <-List.firstn_skipn_rev, List.firstn_skipn, of_list_to_list. +Qed. + +Lemma app_int_del_tail_head n (d:int) : + n <= nb_digits (abs d) -> + app_int (del_tail_int n d) (del_head (nb_digits (abs d) - n) (abs d)) = d. +Proof. now case d; clear d; simpl; intros u Hu; rewrite app_del_tail_head. Qed. + +Lemma del_head_app_int_exact i f : + nb_digits f < nb_digits (unorm (app (abs i) f)) -> + del_head (nb_digits (unorm (app (abs i) f)) - nb_digits f) (unorm (app (abs i) f)) = f. +Proof. + simpl; intro Hnb; generalize Hnb; rewrite (unorm_app_l _ _ Hnb); clear Hnb. + replace (_ - _) with (nb_digits (unorm (abs i))). + - now rewrite del_head_app; [rewrite del_head_nb_digits|]. + - rewrite !nb_digits_spec, app_spec, List.app_length. + now rewrite Nat.add_comm, minus_plus. +Qed. + +Lemma del_tail_app_int_exact i f : + nb_digits f < nb_digits (unorm (app (abs i) f)) -> + del_tail_int (nb_digits f) (norm (app_int i f)) = norm i. +Proof. + simpl; intro Hnb. + rewrite (norm_app_int _ _ Hnb). + rewrite del_tail_app_int; [|now simpl]. + now rewrite del_tail_nb_digits, app_int_nil_r. Qed. (** Normalization on little-endian numbers *) @@ -193,6 +494,9 @@ Proof. apply nzhead_revapp. Qed. +Lemma rev_rev d : rev (rev d) = d. +Proof. now apply to_list_inj; rewrite !rev_spec, List.rev_involutive. Qed. + Lemma rev_nztail_rev d : rev (nztail (rev d)) = nzhead d. Proof. @@ -247,47 +551,128 @@ Proof. unfold unorm. now destruct nzhead. Qed. -Lemma unorm_D0 u : unorm (D0 u) = unorm u. -Proof. reflexivity. Qed. - Lemma unorm_iter_D0 n u : unorm (Nat.iter n D0 u) = unorm u. Proof. now induction n. Qed. -Lemma nb_digits_unorm u : - u <> Nil -> nb_digits (unorm u) <= nb_digits u. +Lemma del_head_nonnil n u : + n < nb_digits u -> del_head n u <> Nil. Proof. - case u; clear u; [now simpl|intro u..]; [|now simpl..]. - intros _; unfold unorm. - case_eq (nzhead (D0 u)); [|now intros u' <-; apply nb_digits_nzhead..]. - intros _; apply le_n_S, Nat.le_0_l. + now revert n; induction u; intro n; + [|case n; [|intro n'; simpl; intro H; apply IHu, lt_S_n]..]. Qed. -Lemma nzhead_invol d : nzhead (nzhead d) = nzhead d. +Lemma del_tail_nonnil n u : + n < nb_digits u -> del_tail n u <> Nil. +Proof. + unfold del_tail. + rewrite <-nb_digits_rev. + generalize (rev u); clear u; intro u. + intros Hu H. + generalize (rev_nil_inv _ H); clear H. + now apply del_head_nonnil. +Qed. + +Lemma nzhead_involutive d : nzhead (nzhead d) = nzhead d. Proof. now induction d. Qed. +#[deprecated(since="8.13",note="Use nzhead_involutive instead.")] +Notation nzhead_invol := nzhead_involutive (only parsing). -Lemma nztail_invol d : nztail (nztail d) = nztail d. +Lemma nztail_involutive d : nztail (nztail d) = nztail d. Proof. rewrite <-(rev_rev (nztail _)), <-(rev_rev (nztail d)), <-(rev_rev d). - now rewrite !rev_nztail_rev, nzhead_invol. + now rewrite !rev_nztail_rev, nzhead_involutive. Qed. +#[deprecated(since="8.13",note="Use nztail_involutive instead.")] +Notation nztail_invol := nztail_involutive (only parsing). -Lemma unorm_invol d : unorm (unorm d) = unorm d. +Lemma unorm_involutive d : unorm (unorm d) = unorm d. Proof. unfold unorm. destruct (nzhead d) eqn:E; trivial. destruct (nzhead_nonzero _ _ E). Qed. +#[deprecated(since="8.13",note="Use unorm_involutive instead.")] +Notation unorm_invol := unorm_involutive (only parsing). -Lemma norm_invol d : norm (norm d) = norm d. +Lemma norm_involutive d : norm (norm d) = norm d. Proof. unfold norm. destruct d. - - f_equal. apply unorm_invol. + - f_equal. apply unorm_involutive. - destruct (nzhead d) eqn:E; auto. destruct (nzhead_nonzero _ _ E). Qed. +#[deprecated(since="8.13",note="Use norm_involutive instead.")] +Notation norm_invol := norm_involutive (only parsing). + +Lemma lnzhead_neq_d0_head l l' : ~(lnzhead l = cons d0 l'). +Proof. now induction l as [|h t Il]; [|case h]. Qed. + +Lemma lnzhead_head_nd0 h t : h <> d0 -> lnzhead (cons h t) = cons h t. +Proof. now case h. Qed. + +Lemma nzhead_del_tail_nzhead_eq n u : + nzhead u = u -> + n < nb_digits u -> + nzhead (del_tail n u) = del_tail n u. +Proof. + rewrite nb_digits_spec, <-List.rev_length. + intros Hu Hn. + apply to_list_inj; unfold del_tail. + rewrite nzhead_spec, rev_spec. + rewrite del_head_spec_small; [|now rewrite rev_spec; apply Nat.lt_le_incl]. + rewrite rev_spec. + rewrite List.skipn_rev, List.rev_involutive. + generalize (f_equal to_list Hu) Hn; rewrite nzhead_spec; intro Hu'. + case (to_list u) as [|h t]. + { simpl; intro H; exfalso; revert H; apply le_not_lt, Peano.le_0_n. } + intro Hn'; generalize (Nat.sub_gt _ _ Hn'); rewrite List.rev_length. + case (_ - _); [now simpl|]; intros n' _. + rewrite List.firstn_cons, lnzhead_head_nd0; [now simpl|]. + intro Hh; revert Hu'; rewrite Hh; apply lnzhead_neq_d0_head. +Qed. + +Lemma nzhead_del_tail_nzhead n u : + n < nb_digits (nzhead u) -> + nzhead (del_tail n (nzhead u)) = del_tail n (nzhead u). +Proof. apply nzhead_del_tail_nzhead_eq, nzhead_involutive. Qed. + +Lemma unorm_del_tail_unorm n u : + n < nb_digits (unorm u) -> + unorm (del_tail n (unorm u)) = del_tail n (unorm u). +Proof. + case (uint_eq_dec (nzhead u) Nil). + - unfold unorm; intros->; case n; [now simpl|]; intro n'. + now simpl; intro H; exfalso; generalize (lt_S_n _ _ H). + - unfold unorm. + set (m := match nzhead u with Nil => zero | _ => _ end). + intros H. + replace m with (nzhead u). + + intros H'. + rewrite (nzhead_del_tail_nzhead _ _ H'). + now generalize (del_tail_nonnil _ _ H'); case del_tail. + + now unfold m; revert H; case nzhead. +Qed. + +Lemma norm_del_tail_int_norm n d : + n < nb_digits (match norm d with Pos d | Neg d => d end) -> + norm (del_tail_int n (norm d)) = del_tail_int n (norm d). +Proof. + case d; clear d; intros u; simpl. + - now intro H; simpl; rewrite unorm_del_tail_unorm. + - case (uint_eq_dec (nzhead u) Nil); intro Hu. + + now rewrite Hu; case n; [|intros n' Hn'; generalize (lt_S_n _ _ Hn')]. + + set (m := match nzhead u with Nil => Pos zero | _ => _ end). + replace m with (Neg (nzhead u)); [|now unfold m; revert Hu; case nzhead]. + unfold del_tail_int. + clear m Hu. + simpl. + intro H; generalize (del_tail_nonnil _ _ H). + rewrite (nzhead_del_tail_nzhead _ _ H). + now case del_tail. +Qed. Lemma nzhead_app_nzhead d d' : nzhead (app (nzhead d) d') = nzhead (app d d'). @@ -299,7 +684,7 @@ Proof. generalize (nzhead_revapp d d'). generalize (nzhead_revapp_0 (nztail d) d'). generalize (nzhead_revapp (nztail d) d'). - rewrite nztail_invol. + rewrite nztail_involutive. now case nztail; [intros _ H _ H'; rewrite (H eq_refl), (H' eq_refl) |intros d'' H _ H' _; rewrite H; [rewrite H'|]..]. @@ -336,5 +721,5 @@ Proof. |rewrite H'; unfold r; clear m r H']; unfold norm; rewrite rev_rev, <-Hd''; - rewrite nzhead_revapp; rewrite nztail_invol; [|rewrite Hd'']..]. + rewrite nzhead_revapp; rewrite nztail_involutive; [|rewrite Hd'']..]. Qed. diff --git a/theories/Numbers/HexadecimalN.v b/theories/Numbers/HexadecimalN.v index f333e2b7f6..93ba82d14a 100644 --- a/theories/Numbers/HexadecimalN.v +++ b/theories/Numbers/HexadecimalN.v @@ -74,7 +74,7 @@ Proof. destruct (norm d) eqn:Hd; intros [= <-]. unfold N.to_hex_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - - intros [= <-]. apply unorm_invol. + - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. @@ -93,7 +93,7 @@ Qed. Lemma of_int_norm d : N.of_hex_int (norm d) = N.of_hex_int d. Proof. - unfold N.of_hex_int. now rewrite norm_invol. + unfold N.of_hex_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : diff --git a/theories/Numbers/HexadecimalNat.v b/theories/Numbers/HexadecimalNat.v index b05184e821..94a14b90bd 100644 --- a/theories/Numbers/HexadecimalNat.v +++ b/theories/Numbers/HexadecimalNat.v @@ -289,7 +289,7 @@ Proof. destruct (norm d) eqn:Hd; intros [= <-]. unfold Nat.to_hex_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - - intros [= <-]. apply unorm_invol. + - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. @@ -308,7 +308,7 @@ Qed. Lemma of_int_norm d : Nat.of_hex_int (norm d) = Nat.of_hex_int d. Proof. - unfold Nat.of_hex_int. now rewrite norm_invol. + unfold Nat.of_hex_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : diff --git a/theories/Numbers/HexadecimalQ.v b/theories/Numbers/HexadecimalQ.v index 9bf43ceb88..a32019767c 100644 --- a/theories/Numbers/HexadecimalQ.v +++ b/theories/Numbers/HexadecimalQ.v @@ -16,442 +16,412 @@ Require Import Decimal DecimalFacts DecimalPos DecimalN DecimalZ. Require Import Hexadecimal HexadecimalFacts HexadecimalPos HexadecimalN HexadecimalZ QArith. -Lemma of_to (q:Q) : forall d, to_hexadecimal q = Some d -> of_hexadecimal d = q. +Lemma of_IQmake_to_hexadecimal num den : + match IQmake_to_hexadecimal num den with + | None => True + | Some (HexadecimalExp _ _ _) => False + | Some (Hexadecimal i f) => of_hexadecimal (Hexadecimal i f) = IQmake (IZ_of_Z num) den + end. +Proof. + unfold IQmake_to_hexadecimal. + generalize (Unsigned.nztail_to_hex_uint den). + case Hexadecimal.nztail; intros den' e_den'. + case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. + case den'; [ |now simpl..]; clear den'. + case e_den' as [|e_den']; simpl; intro H; injection H; clear H; intros->. + { now unfold of_hexadecimal; simpl; rewrite app_int_nil_r, HexadecimalZ.of_to. } + replace (16 ^ _)%positive with (Nat.iter (S e_den') (Pos.mul 16) 1%positive). + 2:{ induction e_den' as [|n IHn]; [now simpl| ]. + now rewrite SuccNat2Pos.inj_succ, Pos.pow_succ_r, <-IHn. } + case Nat.ltb_spec; intro He_den'. + - unfold of_hexadecimal; simpl. + rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. + rewrite HexadecimalZ.of_to. + now rewrite nb_digits_del_head_sub; [|now apply Nat.lt_le_incl]. + - unfold of_hexadecimal; simpl. + rewrite nb_digits_iter_D0. + apply f_equal2. + + apply f_equal, HexadecimalZ.to_int_inj. + rewrite HexadecimalZ.to_of. + rewrite <-(HexadecimalZ.of_to num), HexadecimalZ.to_of. + case (Z.to_hex_int num); clear He_den' num; intro num; simpl. + * unfold app; simpl. + now rewrite unorm_D0, unorm_iter_D0, unorm_involutive. + * case (uint_eq_dec (nzhead num) Nil); [|intro Hn]. + { intros->; simpl; unfold app; simpl. + now rewrite unorm_D0, unorm_iter_D0. } + replace (match nzhead num with Nil => _ | _ => _ end) + with (Neg (nzhead num)); [|now revert Hn; case nzhead]. + simpl. + rewrite nzhead_iter_D0, nzhead_involutive. + now revert Hn; case nzhead. + + revert He_den'; case nb_digits as [|n]; [now simpl; rewrite Nat.add_0_r|]. + intro Hn. + rewrite Nat.add_succ_r, Nat.add_comm. + now rewrite <-le_plus_minus; [|apply le_S_n]. +Qed. + +Lemma IZ_of_Z_IZ_to_Z z z' : IZ_to_Z z = Some z' -> IZ_of_Z z' = z. +Proof. now case z as [| |p|p]; [|intro H; injection H; intros<-..]. Qed. + +Lemma of_IQmake_to_hexadecimal' num den : + match IQmake_to_hexadecimal' num den with + | None => True + | Some (HexadecimalExp _ _ _) => False + | Some (Hexadecimal i f) => of_hexadecimal (Hexadecimal i f) = IQmake num den + end. +Proof. + unfold IQmake_to_hexadecimal'. + case_eq (IZ_to_Z num); [intros num' Hnum'|now simpl]. + generalize (of_IQmake_to_hexadecimal num' den). + case IQmake_to_hexadecimal as [d|]; [|now simpl]. + case d as [i f|]; [|now simpl]. + now rewrite (IZ_of_Z_IZ_to_Z _ _ Hnum'). +Qed. + +Lemma of_to (q:IQ) : forall d, to_hexadecimal q = Some d -> of_hexadecimal d = q. Proof. - cut (match to_hexadecimal q with None => True | Some d => of_hexadecimal d = q end). - { now case to_hexadecimal; [intros d <- d' Hd'; injection Hd'; intros ->|]. } - destruct q as (num, den). - unfold to_hexadecimal; simpl Qnum; simpl Qden. - generalize (HexadecimalPos.Unsigned.nztail_to_hex_uint den). - case Hexadecimal.nztail; intros u n. - change 16%N with (2^4)%N; rewrite <-N.pow_mul_r. - change 4%N with (N.of_nat 4); rewrite <-Nnat.Nat2N.inj_mul. - change 4%Z with (Z.of_nat 4); rewrite <-Nat2Z.inj_mul. - case u; clear u; try (intros; exact I); [| | |]; intro u; - (case u; clear u; [|intros; exact I..]). - - unfold Pos.of_hex_uint, Pos.of_hex_uint_acc; rewrite N.mul_1_l. - case n. - + unfold of_hexadecimal, app_int, app, Z.to_hex_int; simpl. - intro H; inversion H as (H1); clear H H1. - case num; [reflexivity|intro pnum; fold (rev (rev (Pos.to_hex_uint pnum)))..]. - * rewrite rev_rev; simpl. - now unfold Z.of_hex_uint; rewrite HexadecimalPos.Unsigned.of_to. - * rewrite rev_rev; simpl. - now unfold Z.of_hex_uint; rewrite HexadecimalPos.Unsigned.of_to. - + clear n; intros n. - intro H; injection H; intros ->; clear H. - unfold of_hexadecimal. - rewrite DecimalZ.of_to. - simpl nb_digits; rewrite Nat2Z.inj_0, Z.mul_0_r, Z.sub_0_r. - now apply f_equal2; [rewrite app_int_nil_r, of_to|]. - - unfold Pos.of_hex_uint, Pos.of_hex_uint_acc. - rewrite <-N.pow_succ_r', <-Nnat.Nat2N.inj_succ. - intro H; injection H; intros ->; clear H. - fold (4 * n)%nat. - change 1%Z with (Z.of_nat 1); rewrite <-Znat.Nat2Z.inj_add. - unfold of_hexadecimal. - rewrite DecimalZ.of_to. - simpl nb_digits; rewrite Nat2Z.inj_0, Z.mul_0_r, Z.sub_0_r. - now apply f_equal2; [rewrite app_int_nil_r, of_to|]. - - change 2%Z with (Z.of_nat 2); rewrite <-Znat.Nat2Z.inj_add. - unfold Pos.of_hex_uint, Pos.of_hex_uint_acc. - change 4%N with (2^2)%N; rewrite <-N.pow_add_r. - change 2%N with (N.of_nat 2); rewrite <-Nnat.Nat2N.inj_add. - intro H; injection H; intros ->; clear H. - fold (4 * n)%nat. - unfold of_hexadecimal. - rewrite DecimalZ.of_to. - simpl nb_digits; rewrite Nat2Z.inj_0, Z.mul_0_r, Z.sub_0_r. - now apply f_equal2; [rewrite app_int_nil_r, of_to|]. - - change 3%Z with (Z.of_nat 3); rewrite <-Znat.Nat2Z.inj_add. - unfold Pos.of_hex_uint, Pos.of_hex_uint_acc. - change 8%N with (2^3)%N; rewrite <-N.pow_add_r. - change 3%N with (N.of_nat 3); rewrite <-Nnat.Nat2N.inj_add. - intro H; injection H; intros ->; clear H. - fold (4 * n)%nat. - unfold of_hexadecimal. - rewrite DecimalZ.of_to. - simpl nb_digits; rewrite Nat2Z.inj_0, Z.mul_0_r, Z.sub_0_r. - now apply f_equal2; [rewrite app_int_nil_r, of_to|]. + intro d. + case q as [num den|q q'|q q']; simpl. + - generalize (of_IQmake_to_hexadecimal' num den). + case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + now intros H H'; injection H'; clear H'; intros <-. + - case q as [num den| |]; [|now simpl..]. + case q' as [num' den'| |]; [|now simpl..]. + case num' as [z p| | |]; [|now simpl..]. + case (Z.eq_dec z 2); [intros->|]. + 2:{ case z; [now simpl| |now simpl]; intro pz'. + case pz'; [intros d0..| ]; [now simpl| |now simpl]. + now case d0. } + case (Pos.eq_dec den' 1%positive); [intros->|now case den']. + generalize (of_IQmake_to_hexadecimal' num den). + case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros <-; clear num den. + intros H; injection H; clear H; intros<-. + unfold of_hexadecimal; simpl. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + - case q as [num den| |]; [|now simpl..]. + case q' as [num' den'| |]; [|now simpl..]. + case num' as [z p| | |]; [|now simpl..]. + case (Z.eq_dec z 2); [intros->|]. + 2:{ case z; [now simpl| |now simpl]; intro pz'. + case pz'; [intros d0..| ]; [now simpl| |now simpl]. + now case d0. } + case (Pos.eq_dec den' 1%positive); [intros->|now case den']. + generalize (of_IQmake_to_hexadecimal' num den). + case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros <-; clear num den. + intros H; injection H; clear H; intros<-. + unfold of_hexadecimal; simpl. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. Qed. -(* normalize without fractional part, for instance norme 0x1.2p-1 is 0x12e-5 *) -Definition hnorme (d:hexadecimal) : hexadecimal := - let '(i, f, e) := - match d with - | Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) - | HexadecimalExp i f e => (i, f, e) + +Definition dnorm (d:hexadecimal) : hexadecimal := + let norm_i i f := + match i with + | Pos i => Pos (unorm i) + | Neg i => match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end end in - let i := norm (app_int i f) in - let e := (Z.of_int e - 4 * Z.of_nat (nb_digits f))%Z in - match e with - | Z0 => Hexadecimal i Nil - | Zpos e => Hexadecimal (Pos.iter double i e) Nil - | Zneg _ => HexadecimalExp i Nil (Decimal.norm (Z.to_int e)) + match d with + | Hexadecimal i f => Hexadecimal (norm_i i f) f + | HexadecimalExp i f e => + match Decimal.norm e with + | Decimal.Pos Decimal.zero => Hexadecimal (norm_i i f) f + | e => HexadecimalExp (norm_i i f) f e + end end. -Lemma hnorme_spec d : - match hnorme d with - | Hexadecimal i Nil => i = norm i - | HexadecimalExp i Nil e => - i = norm i /\ e = Decimal.norm e /\ e <> Decimal.Pos Decimal.zero - | _ => False +Lemma dnorm_spec_i d : + let (i, f) := + match d with Hexadecimal i f => (i, f) | HexadecimalExp i f _ => (i, f) end in + let i' := match dnorm d with Hexadecimal i _ => i | HexadecimalExp i _ _ => i end in + match i with + | Pos i => i' = Pos (unorm i) + | Neg i => + (i' = Neg (unorm i) /\ (nzhead i <> Nil \/ nzhead f <> Nil)) + \/ (i' = Pos zero /\ (nzhead i = Nil /\ nzhead f = Nil)) end. Proof. - case d; clear d; intros i f; [|intro e]; unfold hnorme; simpl. - - case_eq (nb_digits f); [now simpl; rewrite norm_invol|]; intros nf Hnf. - split; [now simpl; rewrite norm_invol|]. - unfold Z.of_nat. - now rewrite <-!DecimalZ.to_of, !DecimalZ.of_to. - - set (e' := (_ - _)%Z). - case_eq e'; [|intro pe'..]; intro He'. - + now rewrite norm_invol. - + rewrite Pos2Nat.inj_iter. - set (ne' := Pos.to_nat pe'). - fold (Nat.iter ne' double (norm (app_int i f))). - induction ne'; [now simpl; rewrite norm_invol|]. - now rewrite Unsigned.nat_iter_S, <-double_norm, IHne', norm_invol. - + split; [now rewrite norm_invol|]. - split; [now rewrite DecimalFacts.norm_invol|]. - rewrite <-DecimalZ.to_of, DecimalZ.of_to. - change (Decimal.Pos _) with (Z.to_int 0). - now intro H; generalize (DecimalZ.to_int_inj _ _ H). + case d as [i f|i f e]; case i as [i|i]. + - now simpl. + - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + + rewrite Ha; right; split; [now simpl|split]. + * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). + * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + + left; split; [now revert Ha; case nzhead|]. + case (uint_eq_dec (nzhead i) Nil). + * intro Hi; right; intro Hf; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now intro H; left. + - simpl; case (Decimal.norm e); clear e; intro e; [|now simpl]. + now case e; clear e; [|intro e..]; [|case e|..]. + - simpl. + set (m := match nzhead _ with Nil => _ | _ => _ end). + set (m' := match _ with Hexadecimal _ _ => _ | _ => _ end). + replace m' with m. + 2:{ unfold m'; case (Decimal.norm e); clear m' e; intro e; [|now simpl]. + now case e; clear e; [|intro e..]; [|case e|..]. } + unfold m; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + + rewrite Ha; right; split; [now simpl|split]. + * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). + * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + + left; split; [now revert Ha; case nzhead|]. + case (uint_eq_dec (nzhead i) Nil). + * intro Hi; right; intro Hf; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now intro H; left. Qed. -Lemma hnorme_invol d : hnorme (hnorme d) = hnorme d. +Lemma dnorm_spec_f d : + let f := match d with Hexadecimal _ f => f | HexadecimalExp _ f _ => f end in + let f' := match dnorm d with Hexadecimal _ f => f | HexadecimalExp _ f _ => f end in + f' = f. +Proof. + case d as [i f|i f e]; [now simpl|]. + simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); [now intros->|intro He]. + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). + replace m with (HexadecimalExp i' f (Decimal.norm e)); [now simpl|]. + unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. +Qed. + +Lemma dnorm_spec_e d : + match d, dnorm d with + | Hexadecimal _ _, Hexadecimal _ _ => True + | HexadecimalExp _ _ e, Hexadecimal _ _ => + Decimal.norm e = Decimal.Pos Decimal.zero + | HexadecimalExp _ _ e, HexadecimalExp _ _ e' => + e' = Decimal.norm e /\ e' <> Decimal.Pos Decimal.zero + | Hexadecimal _ _, HexadecimalExp _ _ _ => False + end. Proof. - case d; clear d; intros i f; [|intro e]; unfold hnorme; simpl. - - case_eq (nb_digits f); [now simpl; rewrite app_int_nil_r, norm_invol|]. - intros nf Hnf. - unfold Z.of_nat. - simpl. - set (pnf := Pos.to_uint _). - set (nz := Decimal.nzhead pnf). - assert (Hnz : nz <> Decimal.Nil). - { unfold nz, pnf. - rewrite <-DecimalFacts.unorm_0. - rewrite <-DecimalPos.Unsigned.to_of. - rewrite DecimalPos.Unsigned.of_to. - change Decimal.zero with (N.to_uint 0). - now intro H; generalize (DecimalN.Unsigned.to_uint_inj _ _ H). } - set (m := match nz with Decimal.Nil => _ | _ => _ end). - assert (Hm : m = (Decimal.Neg (Decimal.unorm pnf))). - { now revert Hnz; unfold m, nz, Decimal.unorm; fold nz; case nz. } - rewrite Hm; unfold pnf. - rewrite <-DecimalPos.Unsigned.to_of, DecimalPos.Unsigned.of_to. - simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. - rewrite Z.sub_0_r; simpl. - fold pnf; fold nz; fold m; rewrite Hm; unfold pnf. - rewrite <-DecimalPos.Unsigned.to_of, DecimalPos.Unsigned.of_to. - now rewrite app_int_nil_r, norm_invol. - - set (e' := (_ - _)%Z). - case_eq e'; [|intro pe'..]; intro Hpe'. - + now simpl; rewrite app_int_nil_r, norm_invol. - + simpl; rewrite app_int_nil_r. - apply f_equal2; [|reflexivity]. - rewrite Pos2Nat.inj_iter. - set (ne' := Pos.to_nat pe'). - fold (Nat.iter ne' double (norm (app_int i f))). - induction ne'; [now simpl; rewrite norm_invol|]. - now rewrite Unsigned.nat_iter_S, <-double_norm, IHne'. - + rewrite <-DecimalZ.to_of, !DecimalZ.of_to; simpl. - rewrite app_int_nil_r, norm_invol. - set (pnf := Pos.to_uint _). - set (nz := Decimal.nzhead pnf). - assert (Hnz : nz <> Decimal.Nil). - { unfold nz, pnf. - rewrite <-DecimalFacts.unorm_0. - rewrite <-DecimalPos.Unsigned.to_of. - rewrite DecimalPos.Unsigned.of_to. - change Decimal.zero with (N.to_uint 0). - now intro H; generalize (DecimalN.Unsigned.to_uint_inj _ _ H). } - set (m := match nz with Decimal.Nil => _ | _ => _ end). - assert (Hm : m = (Decimal.Neg (Decimal.unorm pnf))). - { now revert Hnz; unfold m, nz, Decimal.unorm; fold nz; case nz. } - rewrite Hm; unfold pnf. - now rewrite <-DecimalPos.Unsigned.to_of, DecimalPos.Unsigned.of_to. + case d as [i f|i f e]; [now simpl|]. + simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); [now intros->|intro He]. + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). + replace m with (HexadecimalExp i' f (Decimal.norm e)); [now simpl|]. + unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. Qed. -Lemma to_of (d:hexadecimal) : - to_hexadecimal (of_hexadecimal d) = Some (hnorme d). +Lemma dnorm_involutive d : dnorm (dnorm d) = dnorm d. Proof. - unfold to_hexadecimal. - pose (t10 := fun y => (y~0~0~0~0)%positive). - assert (H : exists h e_den, - Hexadecimal.nztail (Pos.to_hex_uint (Qden (of_hexadecimal d))) - = (h, e_den) - /\ (h = D1 Nil \/ h = D2 Nil \/ h = D4 Nil \/ h = D8 Nil)). - { assert (H : forall p, - Hexadecimal.nztail (Pos.to_hex_uint (Pos.iter (Pos.mul 2) 1%positive p)) - = ((match (Pos.to_nat p) mod 4 with 0%nat => D1 | 1 => D2 | 2 => D4 | _ => D8 end)%nat Nil, - (Pos.to_nat p / 4)%nat)). - { intro p; clear d; rewrite Pos2Nat.inj_iter. - fold (Nat.iter (Pos.to_nat p) (Pos.mul 2) 1%positive). - set (n := Pos.to_nat p). - fold (Nat.iter n t10 1%positive). - set (nm4 := (n mod 4)%nat); set (nd4 := (n / 4)%nat). - rewrite (Nat.div_mod n 4); [|now simpl]. - unfold nm4, nd4; clear nm4 nd4. - generalize (Nat.mod_upper_bound n 4 ltac:(now simpl)). - generalize (n mod 4); generalize (n / 4)%nat. - intros d r Hr; clear p n. - induction d. - { simpl; revert Hr. - do 4 (case r; [now simpl|clear r; intro r]). - intro H; exfalso. - now do 4 (generalize (lt_S_n _ _ H); clear H; intro H). } - rewrite Nat.mul_succ_r, <-Nat.add_assoc, (Nat.add_comm 4), Nat.add_assoc. - rewrite (Nat.add_comm _ 4). - change (4 + _)%nat with (S (S (S (S (4 * d + r))))). - rewrite !Unsigned.nat_iter_S. - rewrite !Pos.mul_assoc. - unfold Pos.to_hex_uint. - change (2 * 2 * 2 * 2)%positive with 0x10%positive. - set (n := Nat.iter _ _ _). - change (Pos.to_little_hex_uint _) with (Unsigned.to_lu (16 * N.pos n)). - rewrite Unsigned.to_lhex_tenfold. - unfold Hexadecimal.nztail; rewrite rev_rev. - rewrite <-(rev_rev (Unsigned.to_lu _)). - set (m := _ (rev _)). - replace m with (let (r, n) := let (r, n) := m in (rev r, n) in (rev r, n)). - 2:{ now case m; intros r' n'; rewrite rev_rev. } - change (let (r, n) := m in (rev r, n)) - with (Hexadecimal.nztail (Pos.to_hex_uint n)). - now unfold n; rewrite IHd, rev_rev; clear n m. } - unfold of_hexadecimal. - case d; intros i f; [|intro e]; unfold of_hexadecimal; simpl. - - case (Z.of_nat _)%Z; [|intro p..]; - [now exists (D1 Nil), O; split; [|left] - | |now exists (D1 Nil), O; split; [|left]]. - exists (D1 Nil), (Pos.to_nat p). - split; [|now left]; simpl. - change (Pos.iter _ _ _) with (Pos.iter (Pos.mul 2) 1%positive (4 * p)). - rewrite H. - rewrite Pos2Nat.inj_mul, Nat.mul_comm, Nat.div_mul; [|now simpl]. - now rewrite Nat.mod_mul; [|now simpl]. - - case (_ - _)%Z; [|intros p..]; [now exists (D1 Nil), O; split; [|left]..|]. - simpl Qden; rewrite H. - eexists; eexists; split; [reflexivity|]. - case (_ mod _); [now left|intro n]. - case n; [now right; left|clear n; intro n]. - case n; [now right; right; left|clear n; intro n]. - now right; right; right. } - generalize (HexadecimalPos.Unsigned.nztail_to_hex_uint (Qden (of_hexadecimal d))). - destruct H as (h, (e, (He, Hh))); rewrite He; clear He. - assert (Hn1 : forall p, N.pos (Pos.iter (Pos.mul 2) 1%positive p) = 1%N -> False). - { intro p. - rewrite Pos2Nat.inj_iter. - case_eq (Pos.to_nat p); [|now simpl]. - intro H; exfalso; apply (lt_irrefl O). - rewrite <-H at 2; apply Pos2Nat.is_pos. } - assert (H16_2 : forall p, (16^p = 2^(4 * p))%positive). - { intro p. - apply (@f_equal _ _ (fun z => match z with Z.pos p => p | _ => 1%positive end) - (Z.pos _) (Z.pos _)). - rewrite !Pos2Z.inj_pow_pos, !Z.pow_pos_fold, Pos2Z.inj_mul. - now change 16%Z with (2^4)%Z; rewrite <-Z.pow_mul_r. } - assert (HN16_2 : forall n, (16^n = 2^(4 * n))%N). - { intro n. - apply N2Z.inj; rewrite !N2Z.inj_pow, N2Z.inj_mul. - change (Z.of_N 16) with (2^4)%Z. - now rewrite <-Z.pow_mul_r; [| |apply N2Z.is_nonneg]. } - assert (Hn1' : forall p, N.pos (Pos.iter (Pos.mul 16) 1%positive p) = 1%N -> False). - { intro p; fold (16^p)%positive; rewrite H16_2; apply Hn1. } - assert (Ht10inj : forall n m, t10 n = t10 m -> n = m). - { intros n m H; generalize (f_equal Z.pos H); clear H. - change (Z.pos (t10 n)) with (Z.mul 0x10 (Z.pos n)). - change (Z.pos (t10 m)) with (Z.mul 0x10 (Z.pos m)). - rewrite Z.mul_comm, (Z.mul_comm 0x10). - intro H; generalize (f_equal (fun z => Z.div z 0x10) H); clear H. - now rewrite !Z.div_mul; [|now simpl..]; intro H; inversion H. } - assert (Ht2inj : forall n m, Pos.mul 2 n = Pos.mul 2 m -> n = m). - { intros n m H; generalize (f_equal Z.pos H); clear H. - change (Z.pos (Pos.mul 2 n)) with (Z.mul 2 (Z.pos n)). - change (Z.pos (Pos.mul 2 m)) with (Z.mul 2 (Z.pos m)). - rewrite Z.mul_comm, (Z.mul_comm 2). - intro H; generalize (f_equal (fun z => Z.div z 2) H); clear H. - now rewrite !Z.div_mul; [|now simpl..]; intro H; inversion H. } - assert (Hinj : forall n m, - Nat.iter n (Pos.mul 2) 1%positive = Nat.iter m (Pos.mul 2) 1%positive - -> n = m). - { induction n; [now intro m; case m|]. - intro m; case m; [now simpl|]; clear m; intro m. - rewrite !Unsigned.nat_iter_S. - intro H; generalize (Ht2inj _ _ H); clear H; intro H. - now rewrite (IHn _ H). } - change 4%Z with (Z.of_nat 4); rewrite <-Nat2Z.inj_mul. - change 1%Z with (Z.of_nat 1); rewrite <-Nat2Z.inj_add. - change 2%Z with (Z.of_nat 2); rewrite <-Nat2Z.inj_add. - change 3%Z with (Z.of_nat 3); rewrite <-Nat2Z.inj_add. - destruct Hh as [Hh|[Hh|[Hh|Hh]]]; rewrite Hh; clear h Hh. - - case e; clear e; [|intro e]; simpl; unfold of_hexadecimal, hnorme. - + case d; clear d; intros i f; [|intro e]. - * generalize (nb_digits_pos f). - case f; - [|now clear f; intro f; intros H1 H2; exfalso; revert H1 H2; - case nb_digits; - [intros H _; apply (lt_irrefl O), H|intros n _; apply Hn1]..]. - now intros _ _; simpl; rewrite to_of. - * rewrite <-DecimalZ.to_of, DecimalZ.of_to. - set (emf := (_ - _)%Z). - case_eq emf; [|intro pemf..]. - ++ now simpl; rewrite to_of. - ++ intros Hemf _; simpl. - apply f_equal, f_equal2; [|reflexivity]. - rewrite !Pos2Nat.inj_iter. - fold (Nat.iter (Pos.to_nat pemf) (Z.mul 2) (Z.of_hex_int (app_int i f))). - fold (Nat.iter (Pos.to_nat pemf) double (norm (app_int i f))). - induction Pos.to_nat; [now simpl; rewrite HexadecimalZ.to_of|]. - now rewrite !Unsigned.nat_iter_S, <-IHn, double_to_hex_int. - ++ simpl Qden; intros _ H; exfalso; revert H; apply Hn1. - + case d; clear d; intros i f; [|intro e']. - * simpl; case_eq (nb_digits f); [|intros nf' Hnf']; - [now simpl; intros _ H; exfalso; symmetry in H; revert H; apply Hn1'|]. - unfold Z.of_nat, Z.opp, Qnum, Qden. - rewrite H16_2. - fold (Pos.mul 2); fold (2^(Pos.of_succ_nat nf')~0~0)%positive. - intro H; injection H; clear H. - unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intro H; injection H. - clear H; intro H; generalize (SuccNat2Pos.inj _ _ H); clear H. - intros <-. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite SuccNat2Pos.id_succ. - change (_~0)%positive with (4 * Pos.of_succ_nat nf')%positive. - now rewrite Pos2Nat.inj_mul, SuccNat2Pos.id_succ. - * set (nemf := (_ - _)%Z); intro H. - assert (H' : exists pnemf, nemf = Z.neg pnemf); [|revert H]. - { revert H; case nemf; [|intro pnemf..]; [..|now intros _; exists pnemf]; - simpl Qden; intro H; exfalso; symmetry in H; revert H; apply Hn1'. } - destruct H' as (pnemf,Hpnemf); rewrite Hpnemf. - unfold Qnum, Qden. - rewrite H16_2. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H. - intro H; revert Hpnemf; rewrite H; clear pnemf H; intro Hnemf. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite SuccNat2Pos.id_succ. - change (_~0)%positive with (4 * Pos.of_succ_nat e)%positive. - now rewrite Pos2Nat.inj_mul, SuccNat2Pos.id_succ. - - simpl Pos.of_hex_uint. - rewrite HN16_2. - rewrite <-N.pow_succ_r; [|now apply N.le_0_l]. - rewrite <-N.succ_pos_spec. - case d; clear d; intros i f; [|intro e']; unfold of_hexadecimal, hnorme. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. - - simpl Pos.of_hex_uint. - rewrite HN16_2. - change 4%N with (2 * 2)%N at 1; rewrite <-!N.mul_assoc. - do 2 (rewrite <-N.pow_succ_r; [|now apply N.le_0_l]). - rewrite <-N.succ_pos_spec. - case d; clear d; intros i f; [|intro e']; unfold of_hexadecimal, hnorme. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite <-SuccNat2Pos.inj_succ. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite <-SuccNat2Pos.inj_succ. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. - - simpl Pos.of_hex_uint. - rewrite HN16_2. - change 8%N with (2 * 2 * 2)%N; rewrite <-!N.mul_assoc. - do 3 (rewrite <-N.pow_succ_r; [|now apply N.le_0_l]). - rewrite <-N.succ_pos_spec. - case d; clear d; intros i f; [|intro e']; unfold of_hexadecimal, hnorme. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite <-!SuccNat2Pos.inj_succ. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. - + set (em4f := (_ - _)%Z). - case_eq em4f; [|intros pem4f..]; intro Hpem4f; - [now simpl; intros H; exfalso; symmetry in H; revert H; apply Hn1..|]. - unfold Qnum, Qden. - intro H; injection H; clear H; unfold Pos.pow; rewrite !Pos2Nat.inj_iter. - intro H; generalize (Hinj _ _ H); clear H; intro H. - generalize (Pos2Nat.inj _ _ H); clear H; intros ->. - rewrite to_of. - rewrite <-DecimalZ.to_of, DecimalZ.of_to; simpl. - do 4 apply f_equal. - apply Pos2Nat.inj. - rewrite <-!SuccNat2Pos.inj_succ. - rewrite SuccNat2Pos.id_succ. - case e; [now simpl|intro e'']; simpl. - unfold Pos.to_nat; simpl. - now rewrite Pmult_nat_mult, SuccNat2Pos.id_succ, Nat.mul_comm. + case d as [i f|i f e]; case i as [i|i]. + - now simpl; rewrite unorm_involutive. + - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + set (m := match nzhead _ with Nil =>_ | _ => _ end). + replace m with (Neg (unorm i)). + 2:{ now unfold m; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + + unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + * intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + * now case nzhead. + + rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. + - simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); intro He. + + now rewrite He; simpl; rewrite unorm_involutive. + + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). + replace m with (HexadecimalExp (Pos (unorm i)) f (Decimal.norm e)). + 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + simpl; rewrite DecimalFacts.norm_involutive, unorm_involutive. + revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. + - simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); intro He. + + rewrite He; simpl. + case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + set (m := match nzhead _ with Nil =>_ | _ => _ end). + replace m with (Neg (unorm i)). + 2:{ now unfold m; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + * unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + -- intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + -- now case nzhead. + * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. + + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). + pose (i' := match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end). + replace m with (HexadecimalExp i' f (Decimal.norm e)). + 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + simpl; rewrite DecimalFacts.norm_involutive. + set (i'' := match i' with Pos _ => _ | _ => _ end). + clear m; set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). + replace m with (HexadecimalExp i'' f (Decimal.norm e)). + 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. + now case e; clear e; [|intro e; case e|..]. } + unfold i'', i'. + case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. + fold i'; replace i' with (Neg (unorm i)). + 2:{ now unfold i'; revert Ha; case nzhead. } + case (uint_eq_dec (nzhead i) Nil); intro Hi. + * unfold unorm; rewrite Hi; simpl. + case (uint_eq_dec (nzhead f) Nil). + -- intro Hf; exfalso; apply Ha. + now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. + -- now case nzhead. + * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. + now revert Ha; case nzhead. +Qed. + +Lemma IZ_to_Z_IZ_of_Z z : IZ_to_Z (IZ_of_Z z) = Some z. +Proof. now case z. Qed. + +Lemma dnorm_i_exact i f : + (nb_digits f < nb_digits (unorm (app (abs i) f)))%nat -> + match i with + | Pos i => Pos (unorm i) + | Neg i => + match nzhead (app i f) with + | Nil => Pos zero + | _ => Neg (unorm i) + end + end = norm i. +Proof. + case i as [ni|ni]; [now simpl|]; simpl. + case (uint_eq_dec (nzhead (app ni f)) Nil); intro Ha. + { now rewrite Ha, (nzhead_app_nil_l _ _ Ha). } + rewrite (unorm_nzhead _ Ha). + set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (unorm ni)); [|now unfold m; revert Ha; case nzhead]. + case (uint_eq_dec (nzhead ni) Nil); intro Hni. + { rewrite <-nzhead_app_nzhead, Hni, app_nil_l. + intro H; exfalso; revert H; apply le_not_lt, nb_digits_nzhead. } + clear m; set (m := match nzhead ni with Nil => _ | _ => _ end). + replace m with (Neg (nzhead ni)); [|now unfold m; revert Hni; case nzhead]. + now rewrite (unorm_nzhead _ Hni). +Qed. + +Lemma dnorm_i_exact' i f : + (nb_digits (unorm (app (abs i) f)) <= nb_digits f)%nat -> + match i with + | Pos i => Pos (unorm i) + | Neg i => + match nzhead (app i f) with + | Nil => Pos zero + | _ => Neg (unorm i) + end + end = + match norm (app_int i f) with + | Pos _ => Pos zero + | Neg _ => Neg zero + end. +Proof. + case i as [ni|ni]; simpl. + { now intro Hnb; rewrite (unorm_app_zero _ _ Hnb). } + unfold unorm. + case (uint_eq_dec (nzhead (app ni f)) Nil); intro Hn. + { now rewrite Hn. } + set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (nzhead (app ni f)). + 2:{ now unfold m; revert Hn; case nzhead. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (unorm ni)). + 2:{ now unfold m, unorm; revert Hn; case nzhead. } + clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). + replace m with (Neg (nzhead (app ni f))). + 2:{ now unfold m; revert Hn; case nzhead. } + rewrite <-(unorm_nzhead _ Hn). + now intro H; rewrite (unorm_app_zero _ _ H). +Qed. + +Lemma to_of (d:hexadecimal) : to_hexadecimal (of_hexadecimal d) = Some (dnorm d). +Proof. + case d as [i f|i f e]. + - unfold of_hexadecimal; simpl; unfold IQmake_to_hexadecimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_hexadecimal; simpl. + change (fun _ : positive => _) with (Pos.mul 16). + rewrite nztail_to_hex_uint_pow16, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + + rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + + rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + * rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + * rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + - unfold of_hexadecimal; simpl. + rewrite <-DecimalZ.to_of. + case (Z.of_int e); clear e; [|intro e..]; simpl. + + unfold IQmake_to_hexadecimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_hexadecimal; simpl. + change (fun _ : positive => _) with (Pos.mul 16). + rewrite nztail_to_hex_uint_pow16, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + + unfold IQmake_to_hexadecimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_hexadecimal; simpl. + change (fun _ : positive => _) with (Pos.mul 16). + rewrite nztail_to_hex_uint_pow16, to_of. + generalize (DecimalPos.Unsigned.to_uint_nonzero e); intro He. + set (dnorm_i := match i with Pos _ => _ | _ => _ end). + set (m := match Pos.to_uint e with Decimal.Nil => _ | _ => _ end). + replace m with (HexadecimalExp dnorm_i f (Decimal.Pos (Pos.to_uint e))). + 2:{ now unfold m; revert He; case (Pos.to_uint e); [|intro u; case u|..]. } + clear m; unfold dnorm_i. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. + + unfold IQmake_to_hexadecimal'. + rewrite IZ_to_Z_IZ_of_Z. + unfold IQmake_to_hexadecimal; simpl. + change (fun _ : positive => _) with (Pos.mul 16). + rewrite nztail_to_hex_uint_pow16, to_of. + case_eq (nb_digits f); [|intro nb]; intro Hnb. + * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. + case i as [ni|ni]; [now simpl|]. + rewrite app_nil_r; simpl; unfold unorm. + now case (nzhead ni). + * rewrite <-Hnb. + rewrite abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnb'. + -- rewrite (del_tail_app_int_exact _ _ Hnb'). + rewrite (del_head_app_int_exact _ _ Hnb'). + now rewrite (dnorm_i_exact _ _ Hnb'). + -- rewrite (unorm_app_r _ _ Hnb'). + rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. + now rewrite dnorm_i_exact'. Qed. (** Some consequences *) @@ -466,68 +436,24 @@ Proof. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. -Lemma to_hexadecimal_surj d : exists q, to_hexadecimal q = Some (hnorme d). +Lemma to_hexadecimal_surj d : exists q, to_hexadecimal q = Some (dnorm d). Proof. exists (of_hexadecimal d). apply to_of. Qed. -Lemma of_hexadecimal_hnorme d : of_hexadecimal (hnorme d) = of_hexadecimal d. -Proof. - unfold of_hexadecimal, hnorme. - destruct d. - - simpl Z.of_int; unfold Z.of_uint, Z.of_N, Pos.of_uint. - rewrite Z.sub_0_l. - set (n4f := (- _)%Z). - case_eq n4f; [|intro pn4f..]; intro Hn4f. - + apply f_equal2; [|reflexivity]. - rewrite app_int_nil_r. - now rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to. - + apply f_equal2; [|reflexivity]. - rewrite app_int_nil_r. - generalize (app_int i f); intro i'. - rewrite !Pos2Nat.inj_iter. - generalize (Pos.to_nat pn4f); intro n. - fold (Nat.iter n double (norm i')). - fold (Nat.iter n (Z.mul 2) (Z.of_hex_int i')). - induction n; [now simpl; rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to|]. - now rewrite !Unsigned.nat_iter_S, <-IHn, of_hex_int_double. - + unfold nb_digits, Z.of_nat. - rewrite Z.mul_0_r, Z.sub_0_r. - rewrite <-DecimalZ.to_of, !DecimalZ.of_to. - rewrite app_int_nil_r. - now rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to. - - set (nem4f := (_ - _)%Z). - case_eq nem4f; [|intro pnem4f..]; intro Hnem4f. - + apply f_equal2; [|reflexivity]. - rewrite app_int_nil_r. - now rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to. - + apply f_equal2; [|reflexivity]. - rewrite app_int_nil_r. - generalize (app_int i f); intro i'. - rewrite !Pos2Nat.inj_iter. - generalize (Pos.to_nat pnem4f); intro n. - fold (Nat.iter n double (norm i')). - fold (Nat.iter n (Z.mul 2) (Z.of_hex_int i')). - induction n; [now simpl; rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to|]. - now rewrite !Unsigned.nat_iter_S, <-IHn, of_hex_int_double. - + unfold nb_digits, Z.of_nat. - rewrite Z.mul_0_r, Z.sub_0_r. - rewrite <-DecimalZ.to_of, !DecimalZ.of_to. - rewrite app_int_nil_r. - now rewrite <-HexadecimalZ.to_of, HexadecimalZ.of_to. -Qed. +Lemma of_hexadecimal_dnorm d : of_hexadecimal (dnorm d) = of_hexadecimal d. +Proof. now apply to_hexadecimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. -Lemma of_inj d d' : - of_hexadecimal d = of_hexadecimal d' -> hnorme d = hnorme d'. +Lemma of_inj d d' : of_hexadecimal d = of_hexadecimal d' -> dnorm d = dnorm d'. Proof. - intros. - cut (Some (hnorme d) = Some (hnorme d')); [now intro H'; injection H'|]. - rewrite <- !to_of. now f_equal. + intro H. + apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) + (Some (dnorm d)) (Some (dnorm d'))). + now rewrite <- !to_of, H. Qed. -Lemma of_iff d d' : - of_hexadecimal d = of_hexadecimal d' <-> hnorme d = hnorme d'. +Lemma of_iff d d' : of_hexadecimal d = of_hexadecimal d' <-> dnorm d = dnorm d'. Proof. - split. apply of_inj. intros E. rewrite <- of_hexadecimal_hnorme, E. - apply of_hexadecimal_hnorme. + split. apply of_inj. intros E. rewrite <- of_hexadecimal_dnorm, E. + apply of_hexadecimal_dnorm. Qed. diff --git a/theories/Numbers/HexadecimalR.v b/theories/Numbers/HexadecimalR.v new file mode 100644 index 0000000000..2deecc5847 --- /dev/null +++ b/theories/Numbers/HexadecimalR.v @@ -0,0 +1,302 @@ +(************************************************************************) +(* * 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) *) +(************************************************************************) + +(** * HexadecimalR + + Proofs that conversions between hexadecimal numbers and [R] + are bijections. *) + +Require Import Decimal DecimalFacts. +Require Import Hexadecimal HexadecimalFacts HexadecimalPos HexadecimalZ. +Require Import HexadecimalQ Rdefinitions. + +Lemma of_IQmake_to_hexadecimal num den : + match IQmake_to_hexadecimal num den with + | None => True + | Some (HexadecimalExp _ _ _) => False + | Some (Hexadecimal i f) => + of_hexadecimal (Hexadecimal i f) = IRQ (QArith_base.Qmake num den) + end. +Proof. + unfold IQmake_to_hexadecimal. + case (Pos.eq_dec den 1); [now intros->|intro Hden]. + assert (Hf : match QArith_base.IQmake_to_hexadecimal num den with + | Some (Hexadecimal i f) => f <> Nil + | _ => True + end). + { unfold QArith_base.IQmake_to_hexadecimal; simpl. + generalize (Unsigned.nztail_to_hex_uint den). + case Hexadecimal.nztail as [den' e_den']. + case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. + case den'; [ |now simpl..]; clear den'. + case e_den' as [|e_den']; [now simpl; intros H _; apply Hden; injection H|]. + intros _. + case Nat.ltb_spec; intro He_den'. + - apply del_head_nonnil. + revert He_den'; case nb_digits as [|n]; [now simpl|]. + now intro H; simpl; apply le_lt_n_Sm, Nat.le_sub_l. + - apply nb_digits_n0. + now rewrite nb_digits_iter_D0, Nat.sub_add. } + replace (match den with 1%positive => _ | _ => _ end) + with (QArith_base.IQmake_to_hexadecimal num den); [|now revert Hden; case den]. + generalize (of_IQmake_to_hexadecimal num den). + case QArith_base.IQmake_to_hexadecimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + unfold of_hexadecimal; simpl. + intro H; injection H; clear H; intros <-. + intro H; generalize (f_equal QArith_base.IZ_to_Z H); clear H. + rewrite !IZ_to_Z_IZ_of_Z; intro H; injection H; clear H; intros<-. + now revert Hf; case f. +Qed. + +Lemma of_to (q:IR) : forall d, to_hexadecimal q = Some d -> of_hexadecimal d = q. +Proof. + intro d. + case q as [z|q|r r'|r r']; simpl. + - case z as [z p| |p|p]. + + now simpl. + + now simpl; intro H; injection H; clear H; intros<-. + + simpl; intro H; injection H; clear H; intros<-. + now unfold of_hexadecimal; simpl; unfold Z.of_hex_uint; rewrite Unsigned.of_to. + + simpl; intro H; injection H; clear H; intros<-. + now unfold of_hexadecimal; simpl; unfold Z.of_hex_uint; rewrite Unsigned.of_to. + - case q as [num den]. + generalize (of_IQmake_to_hexadecimal num den). + case IQmake_to_hexadecimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + now intros H H'; injection H'; intros<-. + - case r as [z|q| |]; [|case q as[num den]|now simpl..]; + (case r' as [z'| | |]; [|now simpl..]); + (case z' as [p e| | |]; [|now simpl..]). + + case (Z.eq_dec p 2); [intros->|intro Hp]. + 2:{ now revert Hp; case p; + [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } + case z as [| |p|p]; [now simpl|..]; intro H; injection H; intros<-. + * now unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. + * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + + case (Z.eq_dec p 2); [intros->|intro Hp]. + 2:{ now revert Hp; case p; + [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } + generalize (of_IQmake_to_hexadecimal num den). + case IQmake_to_hexadecimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros H H'; injection H'; clear H'; intros<-. + unfold of_hexadecimal; simpl. + change (match f with Nil => _ | _ => _ end) with (of_hexadecimal (Hexadecimal i f)). + rewrite H; clear H. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. + - case r as [z|q| |]; [|case q as[num den]|now simpl..]; + (case r' as [z'| | |]; [|now simpl..]); + (case z' as [p e| | |]; [|now simpl..]). + + case (Z.eq_dec p 2); [intros->|intro Hp]. + 2:{ now revert Hp; case p; + [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } + case z as [| |p|p]; [now simpl|..]; intro H; injection H; intros<-. + * now unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. + * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. + now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + + case (Z.eq_dec p 2); [intros->|intro Hp]. + 2:{ now revert Hp; case p; + [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } + generalize (of_IQmake_to_hexadecimal num den). + case IQmake_to_hexadecimal as [d'|]; [|now simpl]. + case d' as [i f|]; [|now simpl]. + intros H H'; injection H'; clear H'; intros<-. + unfold of_hexadecimal; simpl. + change (match f with Nil => _ | _ => _ end) with (of_hexadecimal (Hexadecimal i f)). + rewrite H; clear H. + now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. +Qed. + +Lemma to_of (d:hexadecimal) : to_hexadecimal (of_hexadecimal d) = Some (dnorm d). +Proof. + case d as [i f|i f e]. + - unfold of_hexadecimal; simpl. + case (uint_eq_dec f Nil); intro Hf. + + rewrite Hf; clear f Hf. + unfold to_hexadecimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + + set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_hexadecimal; simpl. + unfold IQmake_to_hexadecimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_hexadecimal, n; simpl. + rewrite nztail_to_hex_uint_pow16. + clear r; set (r := if _ <? _ then Some (Hexadecimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + * rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + * rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + - unfold of_hexadecimal; simpl. + rewrite <-(DecimalZ.to_of e). + case (Z.of_int e); clear e; [|intro e..]; simpl. + + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_hexadecimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_hexadecimal; simpl. + unfold IQmake_to_hexadecimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_hexadecimal, n; simpl. + rewrite nztail_to_hex_uint_pow16. + clear r; set (r := if _ <? _ then Some (Hexadecimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + + set (i' := match i with Pos _ => _ | _ => _ end). + set (m := match Pos.to_uint e with Decimal.Nil => _ | _ => _ end). + replace m with (HexadecimalExp i' f (Decimal.Pos (Pos.to_uint e))). + 2:{ unfold m; generalize (DecimalPos.Unsigned.to_uint_nonzero e). + now case Pos.to_uint; [|intro u; case u|..]. } + unfold i'; clear i' m. + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_hexadecimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_hexadecimal; simpl. + unfold IQmake_to_hexadecimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_hexadecimal, n; simpl. + rewrite nztail_to_hex_uint_pow16. + clear r; set (r := if _ <? _ then Some (Hexadecimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. + + case (uint_eq_dec f Nil); intro Hf. + * rewrite Hf; clear f Hf. + unfold to_hexadecimal; simpl. + rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. + case i as [i|i]; [now simpl|]; simpl. + rewrite app_nil_r. + case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. + now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + * set (r := IRQ _). + set (m := match f with Nil => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + unfold to_hexadecimal; simpl. + unfold IQmake_to_hexadecimal; simpl. + set (n := Nat.iter _ _ _). + case (Pos.eq_dec n 1); intro Hn. + exfalso; apply Hf. + { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } + clear m; set (m := match n with 1%positive | _ => _ end). + replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). + 2:{ now unfold m; revert Hn; case n. } + unfold QArith_base.IQmake_to_hexadecimal, n; simpl. + rewrite nztail_to_hex_uint_pow16. + clear r; set (r := if _ <? _ then Some (Hexadecimal _ _) else Some _). + clear m; set (m := match nb_digits f with 0 => _ | _ => _ end). + replace m with r; [unfold r|now unfold m; revert Hf; case f]. + rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. + case Nat.ltb_spec; intro Hnf. + -- rewrite (del_tail_app_int_exact _ _ Hnf). + rewrite (del_head_app_int_exact _ _ Hnf). + now rewrite (dnorm_i_exact _ _ Hnf). + -- rewrite (unorm_app_r _ _ Hnf). + rewrite (iter_D0_unorm _ Hf). + now rewrite dnorm_i_exact'. +Qed. + +(** Some consequences *) + +Lemma to_hexadecimal_inj q q' : + to_hexadecimal q <> None -> to_hexadecimal q = to_hexadecimal q' -> q = q'. +Proof. + intros Hnone EQ. + generalize (of_to q) (of_to q'). + rewrite <-EQ. + revert Hnone; case to_hexadecimal; [|now simpl]. + now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). +Qed. + +Lemma to_hexadecimal_surj d : exists q, to_hexadecimal q = Some (dnorm d). +Proof. + exists (of_hexadecimal d). apply to_of. +Qed. + +Lemma of_hexadecimal_dnorm d : of_hexadecimal (dnorm d) = of_hexadecimal d. +Proof. now apply to_hexadecimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. + +Lemma of_inj d d' : of_hexadecimal d = of_hexadecimal d' -> dnorm d = dnorm d'. +Proof. + intro H. + apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) + (Some (dnorm d)) (Some (dnorm d'))). + now rewrite <- !to_of, H. +Qed. + +Lemma of_iff d d' : of_hexadecimal d = of_hexadecimal d' <-> dnorm d = dnorm d'. +Proof. + split. apply of_inj. intros E. rewrite <- of_hexadecimal_dnorm, E. + apply of_hexadecimal_dnorm. +Qed. diff --git a/theories/Numbers/HexadecimalZ.v b/theories/Numbers/HexadecimalZ.v index c5ed0b5b28..1d78ad1ad2 100644 --- a/theories/Numbers/HexadecimalZ.v +++ b/theories/Numbers/HexadecimalZ.v @@ -80,9 +80,11 @@ Lemma of_hex_uint_iter_D0 d n : Z.of_hex_uint (app d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 0x10) (Z.of_hex_uint d). Proof. - unfold Z.of_hex_uint. - unfold app; rewrite <-rev_revapp. - rewrite Unsigned.of_lu_rev, Unsigned.of_lu_revapp. + rewrite <-(rev_rev (app _ _)), <-(of_list_to_list (rev (app _ _))). + rewrite rev_spec, app_spec, List.rev_app_distr. + rewrite <-!rev_spec, <-app_spec, of_list_to_list. + unfold Z.of_hex_uint; rewrite Unsigned.of_lu_rev. + unfold app; rewrite Unsigned.of_lu_revapp, !rev_rev. rewrite <-!Unsigned.of_lu_rev, !rev_rev. assert (H' : Pos.of_hex_uint (Nat.iter n D0 Nil) = 0%N). { now induction n; [|rewrite Unsigned.nat_iter_S]. } @@ -140,3 +142,22 @@ Qed. Lemma double_to_hex_int n : double (Z.to_hex_int n) = Z.to_hex_int (Z.double n). Proof. now rewrite <-(of_to n), <-of_hex_int_double, !to_of, double_norm. Qed. + +Lemma nztail_to_hex_uint_pow16 n : + Hexadecimal.nztail (Pos.to_hex_uint (Nat.iter n (Pos.mul 16) 1%positive)) + = (D1 Nil, n). +Proof. + case n as [|n]; [now simpl|]. + rewrite <-(Nat2Pos.id (S n)); [|now simpl]. + generalize (Pos.of_nat (S n)); clear n; intro p. + induction (Pos.to_nat p); [now simpl|]. + rewrite Unsigned.nat_iter_S. + unfold Pos.to_hex_uint. + change (Pos.to_little_hex_uint _) + with (Unsigned.to_lu (16 * N.pos (Nat.iter n (Pos.mul 16) 1%positive))). + rewrite Unsigned.to_lhex_tenfold. + revert IHn; unfold Pos.to_hex_uint. + unfold Hexadecimal.nztail; rewrite !rev_rev; simpl. + set (f'' := _ (Pos.to_little_hex_uint _)). + now case f''; intros r n' H; inversion H. +Qed. diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v index 2361d59c26..0c097b6773 100644 --- a/theories/Numbers/Integer/Abstract/ZAdd.v +++ b/theories/Numbers/Integer/Abstract/ZAdd.v @@ -20,159 +20,157 @@ Include ZBaseProp Z. Hint Rewrite opp_0 : nz. -Theorem add_pred_l : forall n m, P n + m == P (n + m). +Theorem add_pred_l n m : P n + m == P (n + m). Proof. -intros n m. rewrite <- (succ_pred n) at 2. now rewrite add_succ_l, pred_succ. Qed. -Theorem add_pred_r : forall n m, n + P m == P (n + m). +Theorem add_pred_r n m : n + P m == P (n + m). Proof. -intros n m; rewrite 2 (add_comm n); apply add_pred_l. +rewrite 2 (add_comm n); apply add_pred_l. Qed. -Theorem add_opp_r : forall n m, n + (- m) == n - m. +Theorem add_opp_r n m : n + (- m) == n - m. Proof. nzinduct m. now nzsimpl. intro m. rewrite opp_succ, sub_succ_r, add_pred_r. now rewrite pred_inj_wd. Qed. -Theorem sub_0_l : forall n, 0 - n == - n. +Theorem sub_0_l n : 0 - n == - n. Proof. -intro n; rewrite <- add_opp_r; now rewrite add_0_l. +rewrite <- add_opp_r; now rewrite add_0_l. Qed. -Theorem sub_succ_l : forall n m, S n - m == S (n - m). +Theorem sub_succ_l n m : S n - m == S (n - m). Proof. -intros n m; rewrite <- 2 add_opp_r; now rewrite add_succ_l. +rewrite <- 2 add_opp_r; now rewrite add_succ_l. Qed. -Theorem sub_pred_l : forall n m, P n - m == P (n - m). +Theorem sub_pred_l n m : P n - m == P (n - m). Proof. -intros n m. rewrite <- (succ_pred n) at 2. +rewrite <- (succ_pred n) at 2. rewrite sub_succ_l; now rewrite pred_succ. Qed. -Theorem sub_pred_r : forall n m, n - (P m) == S (n - m). +Theorem sub_pred_r n m : n - (P m) == S (n - m). Proof. -intros n m. rewrite <- (succ_pred m) at 2. +rewrite <- (succ_pred m) at 2. rewrite sub_succ_r; now rewrite succ_pred. Qed. -Theorem opp_pred : forall n, - (P n) == S (- n). +Theorem opp_pred n : - (P n) == S (- n). Proof. -intro n. rewrite <- (succ_pred n) at 2. +rewrite <- (succ_pred n) at 2. rewrite opp_succ. now rewrite succ_pred. Qed. -Theorem sub_diag : forall n, n - n == 0. +Theorem sub_diag n : n - n == 0. Proof. nzinduct n. now nzsimpl. intro n. rewrite sub_succ_r, sub_succ_l; now rewrite pred_succ. Qed. -Theorem add_opp_diag_l : forall n, - n + n == 0. +Theorem add_opp_diag_l n : - n + n == 0. Proof. -intro n; now rewrite add_comm, add_opp_r, sub_diag. +now rewrite add_comm, add_opp_r, sub_diag. Qed. -Theorem add_opp_diag_r : forall n, n + (- n) == 0. +Theorem add_opp_diag_r n : n + (- n) == 0. Proof. -intro n; rewrite add_comm; apply add_opp_diag_l. +rewrite add_comm; apply add_opp_diag_l. Qed. -Theorem add_opp_l : forall n m, - m + n == n - m. +Theorem add_opp_l n m : - m + n == n - m. Proof. -intros n m; rewrite <- add_opp_r; now rewrite add_comm. +rewrite <- add_opp_r; now rewrite add_comm. Qed. -Theorem add_sub_assoc : forall n m p, n + (m - p) == (n + m) - p. +Theorem add_sub_assoc n m p : n + (m - p) == (n + m) - p. Proof. -intros n m p; rewrite <- 2 add_opp_r; now rewrite add_assoc. +rewrite <- 2 add_opp_r; now rewrite add_assoc. Qed. -Theorem opp_involutive : forall n, - (- n) == n. +Theorem opp_involutive n : - (- n) == n. Proof. nzinduct n. now nzsimpl. intro n. rewrite opp_succ, opp_pred. now rewrite succ_inj_wd. Qed. -Theorem opp_add_distr : forall n m, - (n + m) == - n + (- m). +Theorem opp_add_distr n m : - (n + m) == - n + (- m). Proof. -intros n m; nzinduct n. +nzinduct n. now nzsimpl. intro n. rewrite add_succ_l; do 2 rewrite opp_succ; rewrite add_pred_l. now rewrite pred_inj_wd. Qed. -Theorem opp_sub_distr : forall n m, - (n - m) == - n + m. +Theorem opp_sub_distr n m : - (n - m) == - n + m. Proof. -intros n m; rewrite <- add_opp_r, opp_add_distr. +rewrite <- add_opp_r, opp_add_distr. now rewrite opp_involutive. Qed. -Theorem opp_inj : forall n m, - n == - m -> n == m. +Theorem opp_inj n m : - n == - m -> n == m. Proof. -intros n m H. apply opp_wd in H. now rewrite 2 opp_involutive in H. +intros H. apply opp_wd in H. now rewrite 2 opp_involutive in H. Qed. -Theorem opp_inj_wd : forall n m, - n == - m <-> n == m. +Theorem opp_inj_wd n m : - n == - m <-> n == m. Proof. -intros n m; split; [apply opp_inj | intros; now f_equiv]. +split; [apply opp_inj | intros; now f_equiv]. Qed. -Theorem eq_opp_l : forall n m, - n == m <-> n == - m. +Theorem eq_opp_l n m : - n == m <-> n == - m. Proof. -intros n m. now rewrite <- (opp_inj_wd (- n) m), opp_involutive. +now rewrite <- (opp_inj_wd (- n) m), opp_involutive. Qed. -Theorem eq_opp_r : forall n m, n == - m <-> - n == m. +Theorem eq_opp_r n m : n == - m <-> - n == m. Proof. symmetry; apply eq_opp_l. Qed. -Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p. +Theorem sub_add_distr n m p : n - (m + p) == (n - m) - p. Proof. -intros n m p; rewrite <- add_opp_r, opp_add_distr, add_assoc. +rewrite <- add_opp_r, opp_add_distr, add_assoc. now rewrite 2 add_opp_r. Qed. -Theorem sub_sub_distr : forall n m p, n - (m - p) == (n - m) + p. +Theorem sub_sub_distr n m p : n - (m - p) == (n - m) + p. Proof. -intros n m p; rewrite <- add_opp_r, opp_sub_distr, add_assoc. +rewrite <- add_opp_r, opp_sub_distr, add_assoc. now rewrite add_opp_r. Qed. -Theorem sub_opp_l : forall n m, - n - m == - m - n. +Theorem sub_opp_l n m : - n - m == - m - n. Proof. -intros n m. rewrite <- 2 add_opp_r. now rewrite add_comm. +rewrite <- 2 add_opp_r. now rewrite add_comm. Qed. -Theorem sub_opp_r : forall n m, n - (- m) == n + m. +Theorem sub_opp_r n m : n - (- m) == n + m. Proof. -intros n m; rewrite <- add_opp_r; now rewrite opp_involutive. +rewrite <- add_opp_r; now rewrite opp_involutive. Qed. -Theorem add_sub_swap : forall n m p, n + m - p == n - p + m. +Theorem add_sub_swap n m p : n + m - p == n - p + m. Proof. -intros n m p. rewrite <- add_sub_assoc, <- (add_opp_r n p), <- add_assoc. +rewrite <- add_sub_assoc, <- (add_opp_r n p), <- add_assoc. now rewrite add_opp_l. Qed. -Theorem sub_cancel_l : forall n m p, n - m == n - p <-> m == p. +Theorem sub_cancel_l n m p : n - m == n - p <-> m == p. Proof. -intros n m p. rewrite <- (add_cancel_l (n - m) (n - p) (- n)). +rewrite <- (add_cancel_l (n - m) (n - p) (- n)). rewrite 2 add_sub_assoc. rewrite add_opp_diag_l; rewrite 2 sub_0_l. apply opp_inj_wd. Qed. -Theorem sub_cancel_r : forall n m p, n - p == m - p <-> n == m. +Theorem sub_cancel_r n m p : n - p == m - p <-> n == m. Proof. -intros n m p. stepl (n - p + p == m - p + p) by apply add_cancel_r. now do 2 rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. @@ -182,16 +180,15 @@ Qed. in the original equation ([add] or [sub]) and the indication whether the left or right term is moved. *) -Theorem add_move_l : forall n m p, n + m == p <-> m == p - n. +Theorem add_move_l n m p : n + m == p <-> m == p - n. Proof. -intros n m p. stepl (n + m - n == p - n) by apply sub_cancel_r. now rewrite add_comm, <- add_sub_assoc, sub_diag, add_0_r. Qed. -Theorem add_move_r : forall n m p, n + m == p <-> n == p - m. +Theorem add_move_r n m p : n + m == p <-> n == p - m. Proof. -intros n m p; rewrite add_comm; now apply add_move_l. +rewrite add_comm; now apply add_move_l. Qed. (** The two theorems above do not allow rewriting subformulas of the @@ -199,98 +196,98 @@ Qed. right-hand side of the equation. Hence the following two theorems. *) -Theorem sub_move_l : forall n m p, n - m == p <-> - m == p - n. +Theorem sub_move_l n m p : n - m == p <-> - m == p - n. Proof. -intros n m p; rewrite <- (add_opp_r n m); apply add_move_l. +rewrite <- (add_opp_r n m); apply add_move_l. Qed. -Theorem sub_move_r : forall n m p, n - m == p <-> n == p + m. +Theorem sub_move_r n m p : n - m == p <-> n == p + m. Proof. -intros n m p; rewrite <- (add_opp_r n m). now rewrite add_move_r, sub_opp_r. +rewrite <- (add_opp_r n m). now rewrite add_move_r, sub_opp_r. Qed. -Theorem add_move_0_l : forall n m, n + m == 0 <-> m == - n. +Theorem add_move_0_l n m : n + m == 0 <-> m == - n. Proof. -intros n m; now rewrite add_move_l, sub_0_l. +now rewrite add_move_l, sub_0_l. Qed. -Theorem add_move_0_r : forall n m, n + m == 0 <-> n == - m. +Theorem add_move_0_r n m : n + m == 0 <-> n == - m. Proof. -intros n m; now rewrite add_move_r, sub_0_l. +now rewrite add_move_r, sub_0_l. Qed. -Theorem sub_move_0_l : forall n m, n - m == 0 <-> - m == - n. +Theorem sub_move_0_l n m : n - m == 0 <-> - m == - n. Proof. -intros n m. now rewrite sub_move_l, sub_0_l. +now rewrite sub_move_l, sub_0_l. Qed. -Theorem sub_move_0_r : forall n m, n - m == 0 <-> n == m. +Theorem sub_move_0_r n m : n - m == 0 <-> n == m. Proof. -intros n m. now rewrite sub_move_r, add_0_l. +now rewrite sub_move_r, add_0_l. Qed. (** The following section is devoted to cancellation of like terms. The name includes the first operator and the position of the term being canceled. *) -Theorem add_simpl_l : forall n m, n + m - n == m. +Theorem add_simpl_l n m : n + m - n == m. Proof. -intros; now rewrite add_sub_swap, sub_diag, add_0_l. +now rewrite add_sub_swap, sub_diag, add_0_l. Qed. -Theorem add_simpl_r : forall n m, n + m - m == n. +Theorem add_simpl_r n m : n + m - m == n. Proof. -intros; now rewrite <- add_sub_assoc, sub_diag, add_0_r. +now rewrite <- add_sub_assoc, sub_diag, add_0_r. Qed. -Theorem sub_simpl_l : forall n m, - n - m + n == - m. +Theorem sub_simpl_l n m : - n - m + n == - m. Proof. -intros; now rewrite <- add_sub_swap, add_opp_diag_l, sub_0_l. +now rewrite <- add_sub_swap, add_opp_diag_l, sub_0_l. Qed. -Theorem sub_simpl_r : forall n m, n - m + m == n. +Theorem sub_simpl_r n m : n - m + m == n. Proof. -intros; now rewrite <- sub_sub_distr, sub_diag, sub_0_r. +now rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. -Theorem sub_add : forall n m, m - n + n == m. +Theorem sub_add n m : m - n + n == m. Proof. - intros. now rewrite <- add_sub_swap, add_simpl_r. +now rewrite <- add_sub_swap, add_simpl_r. Qed. (** Now we have two sums or differences; the name includes the two operators and the position of the terms being canceled *) -Theorem add_add_simpl_l_l : forall n m p, (n + m) - (n + p) == m - p. +Theorem add_add_simpl_l_l n m p : (n + m) - (n + p) == m - p. Proof. -intros n m p. now rewrite (add_comm n m), <- add_sub_assoc, +now rewrite (add_comm n m), <- add_sub_assoc, sub_add_distr, sub_diag, sub_0_l, add_opp_r. Qed. -Theorem add_add_simpl_l_r : forall n m p, (n + m) - (p + n) == m - p. +Theorem add_add_simpl_l_r n m p : (n + m) - (p + n) == m - p. Proof. -intros n m p. rewrite (add_comm p n); apply add_add_simpl_l_l. +rewrite (add_comm p n); apply add_add_simpl_l_l. Qed. -Theorem add_add_simpl_r_l : forall n m p, (n + m) - (m + p) == n - p. +Theorem add_add_simpl_r_l n m p : (n + m) - (m + p) == n - p. Proof. -intros n m p. rewrite (add_comm n m); apply add_add_simpl_l_l. +rewrite (add_comm n m); apply add_add_simpl_l_l. Qed. -Theorem add_add_simpl_r_r : forall n m p, (n + m) - (p + m) == n - p. +Theorem add_add_simpl_r_r n m p : (n + m) - (p + m) == n - p. Proof. -intros n m p. rewrite (add_comm p m); apply add_add_simpl_r_l. +rewrite (add_comm p m); apply add_add_simpl_r_l. Qed. -Theorem sub_add_simpl_r_l : forall n m p, (n - m) + (m + p) == n + p. +Theorem sub_add_simpl_r_l n m p : (n - m) + (m + p) == n + p. Proof. -intros n m p. now rewrite <- sub_sub_distr, sub_add_distr, sub_diag, +now rewrite <- sub_sub_distr, sub_add_distr, sub_diag, sub_0_l, sub_opp_r. Qed. -Theorem sub_add_simpl_r_r : forall n m p, (n - m) + (p + m) == n + p. +Theorem sub_add_simpl_r_r n m p : (n - m) + (p + m) == n + p. Proof. -intros n m p. rewrite (add_comm p m); apply sub_add_simpl_r_l. +rewrite (add_comm p m); apply sub_add_simpl_r_l. Qed. (** Of course, there are many other variants *) diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v index 40a37be5f9..5a293c6483 100644 --- a/theories/Numbers/Integer/Abstract/ZAddOrder.v +++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v @@ -241,25 +241,25 @@ Qed. Theorem sub_neg_cases : forall n m, n - m < 0 -> n < 0 \/ 0 < m. Proof. -intros. +intros n m ?. rewrite <- (opp_neg_pos m). apply add_neg_cases. now rewrite add_opp_r. Qed. Theorem sub_pos_cases : forall n m, 0 < n - m -> 0 < n \/ m < 0. Proof. -intros. +intros n m ?. rewrite <- (opp_pos_neg m). apply add_pos_cases. now rewrite add_opp_r. Qed. Theorem sub_nonpos_cases : forall n m, n - m <= 0 -> n <= 0 \/ 0 <= m. Proof. -intros. +intros n m ?. rewrite <- (opp_nonpos_nonneg m). apply add_nonpos_cases. now rewrite add_opp_r. Qed. Theorem sub_nonneg_cases : forall n m, 0 <= n - m -> 0 <= n \/ m <= 0. Proof. -intros. +intros n m ?. rewrite <- (opp_nonneg_nonpos m). apply add_nonneg_cases. now rewrite add_opp_r. Qed. diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v index 0f40d3d7b6..4d2361689d 100644 --- a/theories/Numbers/Integer/Abstract/ZBits.v +++ b/theories/Numbers/Integer/Abstract/ZBits.v @@ -244,7 +244,7 @@ Qed. Lemma bit0_odd : forall a, a.[0] = odd a. Proof. - intros. symmetry. + intros a. symmetry. destruct (exists_div2 a) as (a' & b & EQ). rewrite EQ, testbit_0_r, add_comm, odd_add_mul_2. destruct b; simpl; apply odd_1 || apply odd_0. @@ -428,14 +428,14 @@ Qed. Lemma mul_pow2_bits : forall a n m, 0<=n -> (a*2^n).[m] = a.[m-n]. Proof. - intros. + intros a n m ?. rewrite <- (add_simpl_r m n) at 1. rewrite add_sub_swap, add_comm. now apply mul_pow2_bits_add. Qed. Lemma mul_pow2_bits_low : forall a n m, m<n -> (a*2^n).[m] = false. Proof. - intros. + intros a n m ?. destruct (le_gt_cases 0 n). rewrite mul_pow2_bits by trivial. apply testbit_neg_r. now apply lt_sub_0. @@ -561,7 +561,10 @@ Proof. split. apply bits_inj'. intros EQ n Hn; now rewrite EQ. Qed. -Ltac bitwise := apply bits_inj'; intros ?m ?Hm; autorewrite with bitwise. +Tactic Notation "bitwise" "as" simple_intropattern(m) simple_intropattern(Hm) + := apply bits_inj'; intros m Hm; autorewrite with bitwise. + +Ltac bitwise := bitwise as ?m ?Hm. Hint Rewrite lxor_spec lor_spec land_spec ldiff_spec bits_0 : bitwise. @@ -619,7 +622,7 @@ Qed. Lemma shiftl_spec : forall a n m, 0<=m -> (a << n).[m] = a.[m-n]. Proof. - intros. + intros a n m ?. destruct (le_gt_cases n m). now apply shiftl_spec_high. rewrite shiftl_spec_low, testbit_neg_r; trivial. now apply lt_sub_0. @@ -693,7 +696,7 @@ Qed. Lemma shiftl_shiftl : forall a n m, 0<=n -> (a << n) << m == a << (n+m). Proof. - intros a n p Hn. bitwise. + intros a n p Hn. bitwise as m Hm. rewrite 2 (shiftl_spec _ _ m) by trivial. rewrite add_comm, sub_add_distr. destruct (le_gt_cases 0 (m-p)) as [H|H]. @@ -745,8 +748,8 @@ Qed. Lemma shiftl_0_l : forall n, 0 << n == 0. Proof. - intros. - destruct (le_ge_cases 0 n). + intros n. + destruct (le_ge_cases 0 n) as [H|H]. rewrite shiftl_mul_pow2 by trivial. now nzsimpl. rewrite shiftl_div_pow2 by trivial. rewrite <- opp_nonneg_nonpos in H. nzsimpl; order_nz. @@ -901,7 +904,7 @@ Qed. Lemma lor_eq_0_l : forall a b, lor a b == 0 -> a == 0. Proof. - intros a b H. bitwise. + intros a b H. bitwise as m ?. apply (orb_false_iff a.[m] b.[m]). now rewrite <- lor_spec, H, bits_0. Qed. @@ -909,7 +912,7 @@ Qed. Lemma lor_eq_0_iff : forall a b, lor a b == 0 <-> a == 0 /\ b == 0. Proof. intros a b. split. - split. now apply lor_eq_0_l in H. + intro H; split. now apply lor_eq_0_l in H. rewrite lor_comm in H. now apply lor_eq_0_l in H. intros (EQ,EQ'). now rewrite EQ, lor_0_l. Qed. @@ -1022,13 +1025,13 @@ Proof. unfold clearbit. solve_proper. Qed. Lemma pow2_bits_true : forall n, 0<=n -> (2^n).[n] = true. Proof. - intros. rewrite <- (mul_1_l (2^n)). + intros n ?. rewrite <- (mul_1_l (2^n)). now rewrite mul_pow2_bits, sub_diag, bit0_odd, odd_1. Qed. Lemma pow2_bits_false : forall n m, n~=m -> (2^n).[m] = false. Proof. - intros. + intros n m ?. destruct (le_gt_cases 0 n); [|now rewrite pow_neg_r, bits_0]. destruct (le_gt_cases n m). rewrite <- (mul_1_l (2^n)), mul_pow2_bits; trivial. @@ -1073,7 +1076,7 @@ Qed. Lemma clearbit_eqb : forall a n m, (clearbit a n).[m] = a.[m] && negb (eqb n m). Proof. - intros. + intros a n m. destruct (le_gt_cases 0 m); [| now rewrite 2 testbit_neg_r]. rewrite clearbit_spec', ldiff_spec. f_equal. f_equal. destruct (le_gt_cases 0 n) as [Hn|Hn]. @@ -1090,7 +1093,7 @@ Qed. Lemma clearbit_eq : forall a n, (clearbit a n).[n] = false. Proof. - intros. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)). + intros a n. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)). apply andb_false_r. Qed. @@ -1161,7 +1164,7 @@ Proof. unfold lnot. solve_proper. Qed. Lemma lnot_spec : forall a n, 0<=n -> (lnot a).[n] = negb a.[n]. Proof. - intros. unfold lnot. rewrite <- (opp_involutive a) at 2. + intros a n ?. unfold lnot. rewrite <- (opp_involutive a) at 2. rewrite bits_opp, negb_involutive; trivial. Qed. @@ -1214,7 +1217,7 @@ Qed. Lemma lor_lnot_diag : forall a, lor a (lnot a) == -1. Proof. - intros a. bitwise. rewrite lnot_spec, bits_m1; trivial. + intros a. bitwise as m ?. rewrite lnot_spec, bits_m1; trivial. now destruct a.[m]. Qed. @@ -1267,7 +1270,7 @@ Qed. Lemma lxor_m1_r : forall a, lxor a (-1) == lnot a. Proof. - intros. now rewrite <- (lxor_0_r (lnot a)), <- lnot_m1, lxor_lnot_lnot. + intros a. now rewrite <- (lxor_0_r (lnot a)), <- lnot_m1, lxor_lnot_lnot. Qed. Lemma lxor_m1_l : forall a, lxor (-1) a == lnot a. @@ -1278,7 +1281,7 @@ Qed. Lemma lxor_lor : forall a b, land a b == 0 -> lxor a b == lor a b. Proof. - intros a b H. bitwise. + intros a b H. bitwise as m ?. assert (a.[m] && b.[m] = false) by now rewrite <- land_spec, H, bits_0. now destruct a.[m], b.[m]. @@ -1299,7 +1302,7 @@ Proof. unfold ones. solve_proper. Qed. Lemma ones_equiv : forall n, ones n == P (2^n). Proof. - intros. unfold ones. + intros n. unfold ones. destruct (le_gt_cases 0 n). now rewrite shiftl_mul_pow2, mul_1_l. f_equiv. rewrite pow_neg_r; trivial. @@ -1367,7 +1370,7 @@ Qed. Lemma lor_ones_low : forall a n, 0<=a -> log2 a < n -> lor a (ones n) == ones n. Proof. - intros a n Ha H. bitwise. destruct (le_gt_cases n m). + intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). rewrite ones_spec_high, bits_above_log2; try split; trivial. now apply lt_le_trans with n. apply le_trans with (log2 a); order_pos. @@ -1376,7 +1379,7 @@ Qed. Lemma land_ones : forall a n, 0<=n -> land a (ones n) == a mod 2^n. Proof. - intros a n Hn. bitwise. destruct (le_gt_cases n m). + intros a n Hn. bitwise as m ?. destruct (le_gt_cases n m). rewrite ones_spec_high, mod_pow2_bits_high, andb_false_r; try split; trivial. rewrite ones_spec_low, mod_pow2_bits_low, andb_true_r; @@ -1396,7 +1399,7 @@ Qed. Lemma ldiff_ones_r : forall a n, 0<=n -> ldiff a (ones n) == (a >> n) << n. Proof. - intros a n Hn. bitwise. destruct (le_gt_cases n m). + intros a n Hn. bitwise as m ?. destruct (le_gt_cases n m). rewrite ones_spec_high, shiftl_spec_high, shiftr_spec; trivial. rewrite sub_add; trivial. apply andb_true_r. now apply le_0_sub. @@ -1408,7 +1411,7 @@ Qed. Lemma ldiff_ones_r_low : forall a n, 0<=a -> log2 a < n -> ldiff a (ones n) == 0. Proof. - intros a n Ha H. bitwise. destruct (le_gt_cases n m). + intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). rewrite ones_spec_high, bits_above_log2; trivial. now apply lt_le_trans with n. split; trivial. now apply le_trans with (log2 a); order_pos. @@ -1418,7 +1421,7 @@ Qed. Lemma ldiff_ones_l_low : forall a n, 0<=a -> log2 a < n -> ldiff (ones n) a == lxor a (ones n). Proof. - intros a n Ha H. bitwise. destruct (le_gt_cases n m). + intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). rewrite ones_spec_high, bits_above_log2; trivial. now apply lt_le_trans with n. split; trivial. now apply le_trans with (log2 a); order_pos. @@ -1585,7 +1588,7 @@ Qed. Lemma log2_shiftr : forall a n, 0<a -> log2 (a >> n) == max 0 (log2 a - n). Proof. intros a n Ha. - destruct (le_gt_cases 0 (log2 a - n)); + destruct (le_gt_cases 0 (log2 a - n)) as [H|H]; [rewrite max_r | rewrite max_l]; try order. apply log2_bits_unique. now rewrite shiftr_spec, sub_add, bit_log2. @@ -1698,7 +1701,7 @@ Qed. Lemma add_carry_div2 : forall a b (c0:bool), (a + b + c0)/2 == a/2 + b/2 + nextcarry a.[0] b.[0] c0. Proof. - intros. + intros a b c0. rewrite <- add3_bits_div2. rewrite (add_comm ((a/2)+_)). rewrite <- div_add by order'. @@ -1767,7 +1770,7 @@ Proof. apply div_lt_upper_bound. order'. now rewrite <- pow_succ_r. exists (c0 + 2*c). repeat split. (* step, add *) - bitwise. + bitwise as m Hm. le_elim Hm. rewrite <- (succ_pred m), lt_succ_r in Hm. rewrite <- (succ_pred m), <- !div2_bits, <- 2 lxor_spec by trivial. @@ -1777,7 +1780,7 @@ Proof. now rewrite add_b2z_double_bit0, add3_bit0, b2z_bit0. (* step, carry *) rewrite add_b2z_double_div2. - bitwise. + bitwise as m Hm. le_elim Hm. rewrite <- (succ_pred m), lt_succ_r in Hm. rewrite <- (succ_pred m), <- !div2_bits, IH2 by trivial. @@ -1905,7 +1908,7 @@ Proof. rewrite sub_add. symmetry. rewrite add_nocarry_lxor; trivial. - bitwise. + bitwise as m ?. apply bits_inj_iff in H. specialize (H m). rewrite ldiff_spec, bits_0 in H. now destruct a.[m], b.[m]. @@ -1938,7 +1941,7 @@ Lemma add_nocarry_mod_lt_pow2 : forall a b n, 0<=n -> land a b == 0 -> Proof. intros a b n Hn H. apply add_nocarry_lt_pow2. - bitwise. + bitwise as m ?. destruct (le_gt_cases n m). rewrite mod_pow2_bits_high; now split. now rewrite !mod_pow2_bits_low, <- land_spec, H, bits_0. diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v index 44cba37eb2..d28d010ae8 100644 --- a/theories/Numbers/Integer/Abstract/ZDivFloor.v +++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v @@ -51,7 +51,7 @@ Qed. Lemma mod_bound_abs : forall a b, b~=0 -> abs (a mod b) < abs b. Proof. -intros. +intros a b **. destruct (abs_spec b) as [(LE,EQ)|(LE,EQ)]; rewrite EQ. destruct (mod_pos_bound a b). order. now rewrite abs_eq. destruct (mod_neg_bound a b). order. rewrite abs_neq; trivial. @@ -87,11 +87,11 @@ Qed. Theorem div_unique_pos: forall a b q r, 0<=r<b -> a == b*q + r -> q == a/b. -Proof. intros; apply div_unique with r; auto. Qed. +Proof. intros a b q r **; apply div_unique with r; auto. Qed. Theorem div_unique_neg: forall a b q r, b<r<=0 -> a == b*q + r -> q == a/b. -Proof. intros; apply div_unique with r; auto. Qed. +Proof. intros a b q r **; apply div_unique with r; auto. Qed. Theorem mod_unique: forall a b q r, (0<=r<b \/ b<r<=0) -> a == b*q + r -> r == a mod b. @@ -106,11 +106,11 @@ Qed. Theorem mod_unique_pos: forall a b q r, 0<=r<b -> a == b*q + r -> r == a mod b. -Proof. intros; apply mod_unique with q; auto. Qed. +Proof. intros a b q r **; apply mod_unique with q; auto. Qed. Theorem mod_unique_neg: forall a b q r, b<r<=0 -> a == b*q + r -> r == a mod b. -Proof. intros; apply mod_unique with q; auto. Qed. +Proof. intros a b q r **; apply mod_unique with q; auto. Qed. (** Sign rules *) @@ -121,7 +121,7 @@ Ltac pos_or_neg a := Fact mod_bound_or : forall a b, b~=0 -> 0<=a mod b<b \/ b<a mod b<=0. Proof. -intros. +intros a b **. destruct (lt_ge_cases 0 b); [left|right]. apply mod_pos_bound; trivial. apply mod_neg_bound; order. Qed. @@ -129,7 +129,7 @@ Qed. Fact opp_mod_bound_or : forall a b, b~=0 -> 0 <= -(a mod b) < -b \/ -b < -(a mod b) <= 0. Proof. -intros. +intros a b **. destruct (lt_ge_cases 0 b); [right|left]. rewrite <- opp_lt_mono, opp_nonpos_nonneg. destruct (mod_pos_bound a b); intuition; order. @@ -139,14 +139,14 @@ Qed. Lemma div_opp_opp : forall a b, b~=0 -> -a/-b == a/b. Proof. -intros. symmetry. apply div_unique with (- (a mod b)). +intros a b **. symmetry. apply div_unique with (- (a mod b)). now apply opp_mod_bound_or. rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. Qed. Lemma mod_opp_opp : forall a b, b~=0 -> (-a) mod (-b) == - (a mod b). Proof. -intros. symmetry. apply mod_unique with (a/b). +intros a b **. symmetry. apply mod_unique with (a/b). now apply opp_mod_bound_or. rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. Qed. @@ -200,28 +200,28 @@ Qed. Lemma div_opp_r_z : forall a b, b~=0 -> a mod b == 0 -> a/(-b) == -(a/b). Proof. -intros. rewrite <- (opp_involutive a) at 1. +intros a b **. rewrite <- (opp_involutive a) at 1. rewrite div_opp_opp; auto using div_opp_l_z. Qed. Lemma div_opp_r_nz : forall a b, b~=0 -> a mod b ~= 0 -> a/(-b) == -(a/b)-1. Proof. -intros. rewrite <- (opp_involutive a) at 1. +intros a b **. rewrite <- (opp_involutive a) at 1. rewrite div_opp_opp; auto using div_opp_l_nz. Qed. Lemma mod_opp_r_z : forall a b, b~=0 -> a mod b == 0 -> a mod (-b) == 0. Proof. -intros. rewrite <- (opp_involutive a) at 1. +intros a b **. rewrite <- (opp_involutive a) at 1. now rewrite mod_opp_opp, mod_opp_l_z, opp_0. Qed. Lemma mod_opp_r_nz : forall a b, b~=0 -> a mod b ~= 0 -> a mod (-b) == (a mod b) - b. Proof. -intros. rewrite <- (opp_involutive a) at 1. +intros a b **. rewrite <- (opp_involutive a) at 1. rewrite mod_opp_opp, mod_opp_l_nz by trivial. now rewrite opp_sub_distr, add_comm, add_opp_r. Qed. @@ -247,7 +247,7 @@ Qed. Lemma mod_sign_mul : forall a b, b~=0 -> 0 <= (a mod b) * b. Proof. -intros. destruct (lt_ge_cases 0 b). +intros a b **. destruct (lt_ge_cases 0 b). apply mul_nonneg_nonneg; destruct (mod_pos_bound a b); order. apply mul_nonpos_nonpos; destruct (mod_neg_bound a b); order. Qed. @@ -256,7 +256,7 @@ Qed. Lemma div_same : forall a, a~=0 -> a/a == 1. Proof. -intros. pos_or_neg a. apply div_same; order. +intros a ?. pos_or_neg a. apply div_same; order. rewrite <- div_opp_opp by trivial. now apply div_same. Qed. @@ -279,7 +279,7 @@ Proof. exact mod_small. Qed. Lemma div_0_l: forall a, a~=0 -> 0/a == 0. Proof. -intros. pos_or_neg a. apply div_0_l; order. +intros a ?. pos_or_neg a. apply div_0_l; order. rewrite <- div_opp_opp, opp_0 by trivial. now apply div_0_l. Qed. @@ -308,7 +308,7 @@ Proof. exact mod_1_l. Qed. Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. Proof. -intros. symmetry. apply div_unique with 0. +intros a b ?. symmetry. apply div_unique with 0. destruct (lt_ge_cases 0 b); [left|right]; split; order. nzsimpl; apply mul_comm. Qed. @@ -350,7 +350,7 @@ Qed. Lemma mod_small_iff : forall a b, b~=0 -> (a mod b == a <-> 0<=a<b \/ b<a<=0). Proof. -intros. +intros a b **. rewrite <- div_small_iff, mod_eq by trivial. rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. rewrite eq_sym_iff, eq_mul_0. tauto. @@ -393,7 +393,7 @@ Qed. Lemma mul_div_le : forall a b, 0<b -> b*(a/b) <= a. Proof. -intros. +intros a b **. rewrite (div_mod a b) at 2; try order. rewrite <- (add_0_r (b*(a/b))) at 1. rewrite <- add_le_mono_l. @@ -412,7 +412,7 @@ Qed. Lemma mul_succ_div_gt: forall a b, 0<b -> a < b*(S (a/b)). Proof. -intros. +intros a b ?. nzsimpl. rewrite (div_mod a b) at 1; try order. rewrite <- add_lt_mono_l. @@ -432,7 +432,7 @@ Qed. Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). Proof. -intros. +intros a b **. rewrite (div_mod a b) at 1; try order. rewrite <- (add_0_r (b*(a/b))) at 2. apply add_cancel_l. @@ -443,7 +443,7 @@ Qed. Theorem div_lt_upper_bound: forall a b q, 0<b -> a < b*q -> a/b < q. Proof. -intros. +intros a b q **. rewrite (mul_lt_mono_pos_l b) by trivial. apply le_lt_trans with a; trivial. now apply mul_div_le. @@ -452,7 +452,7 @@ Qed. Theorem div_le_upper_bound: forall a b q, 0<b -> a <= b*q -> a/b <= q. Proof. -intros. +intros a b q **. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. @@ -460,7 +460,7 @@ Qed. Theorem div_le_lower_bound: forall a b q, 0<b -> b*q <= a -> q <= a/b. Proof. -intros. +intros a b q **. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. @@ -475,7 +475,7 @@ Proof. exact div_le_compat_l. Qed. Lemma mod_add : forall a b c, c~=0 -> (a + b * c) mod c == a mod c. Proof. -intros. +intros a b c **. symmetry. apply mod_unique with (a/c+b); trivial. now apply mod_bound_or. @@ -486,7 +486,7 @@ Qed. Lemma div_add : forall a b c, c~=0 -> (a + b * c) / c == a / c + b. Proof. -intros. +intros a b c **. apply (mul_cancel_l _ _ c); try order. apply (add_cancel_r _ _ ((a+b*c) mod c)). rewrite <- div_mod, mod_add by order. @@ -506,7 +506,7 @@ Qed. Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> (a*c)/(b*c) == a/b. Proof. -intros. +intros a b c **. symmetry. apply div_unique with ((a mod b)*c). (* ineqs *) @@ -525,13 +525,13 @@ Qed. Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> (c*a)/(c*b) == a/b. Proof. -intros. rewrite !(mul_comm c); now apply div_mul_cancel_r. +intros a b c **. rewrite !(mul_comm c); now apply div_mul_cancel_r. Qed. Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> (c*a) mod (c*b) == c * (a mod b). Proof. -intros. +intros a b c **. rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). rewrite <- div_mod. rewrite div_mul_cancel_l by trivial. @@ -543,7 +543,7 @@ Qed. Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> (a*c) mod (b*c) == (a mod b) * c. Proof. - intros. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. + intros a b c **. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. Qed. @@ -570,7 +570,7 @@ Qed. Lemma mul_mod_idemp_r : forall a b n, n~=0 -> (a*(b mod n)) mod n == (a*b) mod n. Proof. - intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l. + intros a b n **. rewrite !(mul_comm a). now apply mul_mod_idemp_l. Qed. Theorem mul_mod: forall a b n, n~=0 -> @@ -591,7 +591,7 @@ Qed. Lemma add_mod_idemp_r : forall a b n, n~=0 -> (a+(b mod n)) mod n == (a+b) mod n. Proof. - intros. rewrite !(add_comm a). now apply add_mod_idemp_l. + intros a b n **. rewrite !(add_comm a). now apply add_mod_idemp_l. Qed. Theorem add_mod: forall a b n, n~=0 -> diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v index 4915d69c5b..7d374bd4be 100644 --- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v +++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v @@ -69,7 +69,7 @@ Proof. intros. now rewrite rem_opp_r, rem_opp_l. Qed. Lemma quot_opp_l : forall a b, b ~= 0 -> (-a)÷b == -(a÷b). Proof. -intros. +intros a b ?. rewrite <- (mul_cancel_l _ _ b) by trivial. rewrite <- (add_cancel_r _ _ ((-a) rem b)). now rewrite <- quot_rem, rem_opp_l, mul_opp_r, <- opp_add_distr, <- quot_rem. @@ -77,7 +77,7 @@ Qed. Lemma quot_opp_r : forall a b, b ~= 0 -> a÷(-b) == -(a÷b). Proof. -intros. +intros a b ?. assert (-b ~= 0) by (now rewrite eq_opp_l, opp_0). rewrite <- (mul_cancel_l _ _ (-b)) by trivial. rewrite <- (add_cancel_r _ _ (a rem (-b))). @@ -105,17 +105,17 @@ Qed. Theorem quot_unique: forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> q == a÷b. -Proof. intros; now apply NZQuot.div_unique with r. Qed. +Proof. intros a b q r **; now apply NZQuot.div_unique with r. Qed. Theorem rem_unique: forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> r == a rem b. -Proof. intros; now apply NZQuot.mod_unique with q. Qed. +Proof. intros a b q r **; now apply NZQuot.mod_unique with q. Qed. (** A division by itself returns 1 *) Lemma quot_same : forall a, a~=0 -> a÷a == 1. Proof. -intros. pos_or_neg a. apply NZQuot.div_same; order. +intros a ?. pos_or_neg a. apply NZQuot.div_same; order. rewrite <- quot_opp_opp by trivial. now apply NZQuot.div_same. Qed. @@ -138,7 +138,7 @@ Proof. exact NZQuot.mod_small. Qed. Lemma quot_0_l: forall a, a~=0 -> 0÷a == 0. Proof. -intros. pos_or_neg a. apply NZQuot.div_0_l; order. +intros a ?. pos_or_neg a. apply NZQuot.div_0_l; order. rewrite <- quot_opp_opp, opp_0 by trivial. now apply NZQuot.div_0_l. Qed. @@ -149,7 +149,7 @@ Qed. Lemma quot_1_r: forall a, a÷1 == a. Proof. -intros. pos_or_neg a. now apply NZQuot.div_1_r. +intros a. pos_or_neg a. now apply NZQuot.div_1_r. apply opp_inj. rewrite <- quot_opp_l. apply NZQuot.div_1_r; order. intro EQ; symmetry in EQ; revert EQ; apply lt_neq, lt_0_1. Qed. @@ -168,7 +168,7 @@ Proof. exact NZQuot.mod_1_l. Qed. Lemma quot_mul : forall a b, b~=0 -> (a*b)÷b == a. Proof. -intros. pos_or_neg a; pos_or_neg b. apply NZQuot.div_mul; order. +intros a b ?. pos_or_neg a; pos_or_neg b. apply NZQuot.div_mul; order. rewrite <- quot_opp_opp, <- mul_opp_r by order. apply NZQuot.div_mul; order. rewrite <- opp_inj_wd, <- quot_opp_l, <- mul_opp_l by order. apply NZQuot.div_mul; order. @@ -190,7 +190,7 @@ Qed. Lemma rem_nonneg : forall a b, b~=0 -> 0 <= a -> 0 <= a rem b. Proof. - intros. pos_or_neg b. destruct (rem_bound_pos a b); order. + intros a b **. pos_or_neg b. destruct (rem_bound_pos a b); order. rewrite <- rem_opp_r; trivial. destruct (rem_bound_pos a (-b)); trivial. Qed. @@ -309,7 +309,7 @@ Proof. exact NZQuot.div_str_pos. Qed. Lemma quot_small_iff : forall a b, b~=0 -> (a÷b==0 <-> abs a < abs b). Proof. -intros. pos_or_neg a; pos_or_neg b. +intros a b ?. pos_or_neg a; pos_or_neg b. rewrite NZQuot.div_small_iff; try order. rewrite 2 abs_eq; intuition; order. rewrite <- opp_inj_wd, opp_0, <- quot_opp_r, NZQuot.div_small_iff by order. rewrite (abs_eq a), (abs_neq' b); intuition; order. @@ -321,7 +321,7 @@ Qed. Lemma rem_small_iff : forall a b, b~=0 -> (a rem b == a <-> abs a < abs b). Proof. -intros. rewrite rem_eq, <- quot_small_iff by order. +intros a b ?. rewrite rem_eq, <- quot_small_iff by order. rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. rewrite eq_sym_iff, eq_mul_0. tauto. Qed. @@ -336,7 +336,7 @@ Proof. exact NZQuot.div_lt. Qed. Lemma quot_le_mono : forall a b c, 0<c -> a<=b -> a÷c <= b÷c. Proof. -intros. pos_or_neg a. apply NZQuot.div_le_mono; auto. +intros a b c **. pos_or_neg a. apply NZQuot.div_le_mono; auto. pos_or_neg b. apply le_trans with 0. rewrite <- opp_nonneg_nonpos, <- quot_opp_l by order. apply quot_pos; order. @@ -350,7 +350,7 @@ Qed. Lemma mul_quot_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a÷b) <= a. Proof. -intros. pos_or_neg b. +intros a b **. pos_or_neg b. split. apply mul_nonneg_nonneg; [|apply quot_pos]; order. apply NZQuot.mul_div_le; order. @@ -362,7 +362,7 @@ Qed. Lemma mul_quot_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a÷b) <= 0. Proof. -intros. +intros a b **. rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-quot_opp_l by order. rewrite <- opp_nonneg_nonpos in *. destruct (mul_quot_le (-a) b); tauto. @@ -415,7 +415,7 @@ Proof. exact NZQuot.div_lt_upper_bound. Qed. Theorem quot_le_upper_bound: forall a b q, 0<b -> a <= b*q -> a÷b <= q. Proof. -intros. +intros a b q **. rewrite <- (quot_mul q b) by order. apply quot_le_mono; trivial. now rewrite mul_comm. Qed. @@ -423,7 +423,7 @@ Qed. Theorem quot_le_lower_bound: forall a b q, 0<b -> b*q <= a -> q <= a÷b. Proof. -intros. +intros a b q **. rewrite <- (quot_mul q b) by order. apply quot_le_mono; trivial. now rewrite mul_comm. Qed. @@ -443,7 +443,7 @@ Lemma rem_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> (a + b * c) rem c == a rem c. Proof. assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) rem c == a rem c). - intros. pos_or_neg c. apply NZQuot.mod_add; order. + intros a b c **. pos_or_neg c. apply NZQuot.mod_add; order. rewrite <- (rem_opp_r a), <- (rem_opp_r (a+b*c)) by order. rewrite <- mul_opp_opp in *. apply NZQuot.mod_add; order. @@ -457,7 +457,7 @@ Qed. Lemma quot_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> (a + b * c) ÷ c == a ÷ c + b. Proof. -intros. +intros a b c **. rewrite <- (mul_cancel_l _ _ c) by trivial. rewrite <- (add_cancel_r _ _ ((a+b*c) rem c)). rewrite <- quot_rem, rem_add by trivial. @@ -476,14 +476,14 @@ Lemma quot_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b. Proof. assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a*c)÷(b*c) == a÷b). - intros. pos_or_neg c. apply NZQuot.div_mul_cancel_r; order. + intros a b c **. pos_or_neg c. apply NZQuot.div_mul_cancel_r; order. rewrite <- quot_opp_opp, <- 2 mul_opp_r. apply NZQuot.div_mul_cancel_r; order. rewrite <- neq_mul_0; intuition order. assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b). - intros. pos_or_neg b. apply Aux1; order. + intros a b c **. pos_or_neg b. apply Aux1; order. apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_l; try order. apply Aux1; order. rewrite <- neq_mul_0; intuition order. -intros. pos_or_neg a. apply Aux2; order. +intros a b c **. pos_or_neg a. apply Aux2; order. apply opp_inj. rewrite <- 2 quot_opp_l, <- mul_opp_l; try order. apply Aux2; order. rewrite <- neq_mul_0; intuition order. Qed. @@ -491,13 +491,13 @@ Qed. Lemma quot_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> (c*a)÷(c*b) == a÷b. Proof. -intros. rewrite !(mul_comm c); now apply quot_mul_cancel_r. +intros a b c **. rewrite !(mul_comm c); now apply quot_mul_cancel_r. Qed. Lemma mul_rem_distr_r: forall a b c, b~=0 -> c~=0 -> (a*c) rem (b*c) == (a rem b) * c. Proof. -intros. +intros a b c **. assert (b*c ~= 0) by (rewrite <- neq_mul_0; tauto). rewrite ! rem_eq by trivial. rewrite quot_mul_cancel_r by order. @@ -507,7 +507,7 @@ Qed. Lemma mul_rem_distr_l: forall a b c, b~=0 -> c~=0 -> (c*a) rem (c*b) == c * (a rem b). Proof. -intros; rewrite !(mul_comm c); now apply mul_rem_distr_r. +intros a b c **; rewrite !(mul_comm c); now apply mul_rem_distr_r. Qed. (** Operations modulo. *) @@ -515,7 +515,7 @@ Qed. Theorem rem_rem: forall a n, n~=0 -> (a rem n) rem n == a rem n. Proof. -intros. pos_or_neg a; pos_or_neg n. apply NZQuot.mod_mod; order. +intros a n **. pos_or_neg a; pos_or_neg n. apply NZQuot.mod_mod; order. rewrite <- ! (rem_opp_r _ n) by trivial. apply NZQuot.mod_mod; order. apply opp_inj. rewrite <- !rem_opp_l by order. apply NZQuot.mod_mod; order. apply opp_inj. rewrite <- !rem_opp_opp by order. apply NZQuot.mod_mod; order. @@ -526,11 +526,11 @@ Lemma mul_rem_idemp_l : forall a b n, n~=0 -> Proof. assert (Aux1 : forall a b n, 0<=a -> 0<=b -> n~=0 -> ((a rem n)*b) rem n == (a*b) rem n). - intros. pos_or_neg n. apply NZQuot.mul_mod_idemp_l; order. + intros a b n **. pos_or_neg n. apply NZQuot.mul_mod_idemp_l; order. rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.mul_mod_idemp_l; order. assert (Aux2 : forall a b n, 0<=a -> n~=0 -> ((a rem n)*b) rem n == (a*b) rem n). - intros. pos_or_neg b. now apply Aux1. + intros a b n **. pos_or_neg b. now apply Aux1. apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_r by order. apply Aux1; order. intros a b n Hn. pos_or_neg a. now apply Aux2. @@ -541,7 +541,7 @@ Qed. Lemma mul_rem_idemp_r : forall a b n, n~=0 -> (a*(b rem n)) rem n == (a*b) rem n. Proof. -intros. rewrite !(mul_comm a). now apply mul_rem_idemp_l. +intros a b n **. rewrite !(mul_comm a). now apply mul_rem_idemp_l. Qed. Theorem mul_rem: forall a b n, n~=0 -> @@ -564,7 +564,7 @@ Lemma add_rem_idemp_l : forall a b n, n~=0 -> 0 <= a*b -> Proof. assert (Aux : forall a b n, 0<=a -> 0<=b -> n~=0 -> ((a rem n)+b) rem n == (a+b) rem n). - intros. pos_or_neg n. apply NZQuot.add_mod_idemp_l; order. + intros a b n **. pos_or_neg n. apply NZQuot.add_mod_idemp_l; order. rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.add_mod_idemp_l; order. intros a b n Hn Hab. destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)]. now apply Aux. @@ -576,7 +576,7 @@ Qed. Lemma add_rem_idemp_r : forall a b n, n~=0 -> 0 <= a*b -> (a+(b rem n)) rem n == (a+b) rem n. Proof. -intros. rewrite !(add_comm a). apply add_rem_idemp_l; trivial. +intros a b n **. rewrite !(add_comm a). apply add_rem_idemp_l; trivial. now rewrite mul_comm. Qed. @@ -598,16 +598,16 @@ Lemma quot_quot : forall a b c, b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c). Proof. assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a÷b)÷c == a÷(b*c)). - intros. pos_or_neg c. apply NZQuot.div_div; order. + intros a b c **. pos_or_neg c. apply NZQuot.div_div; order. apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_r; trivial. apply NZQuot.div_div; order. rewrite <- neq_mul_0; intuition order. assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c)). - intros. pos_or_neg b. apply Aux1; order. + intros a b c **. pos_or_neg b. apply Aux1; order. apply opp_inj. rewrite <- quot_opp_l, <- 2 quot_opp_r, <- mul_opp_l; trivial. apply Aux1; trivial. rewrite <- neq_mul_0; intuition order. -intros. pos_or_neg a. apply Aux2; order. +intros a b c **. pos_or_neg a. apply Aux2; order. apply opp_inj. rewrite <- 3 quot_opp_l; try order. apply Aux2; order. rewrite <- neq_mul_0. tauto. Qed. diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v index 09d28a18ec..755557ff17 100644 --- a/theories/Numbers/Integer/Abstract/ZGcd.v +++ b/theories/Numbers/Integer/Abstract/ZGcd.v @@ -98,7 +98,7 @@ Qed. Lemma gcd_abs_l : forall n m, gcd (abs n) m == gcd n m. Proof. - intros. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. + intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. easy. apply gcd_opp_l. Qed. @@ -125,7 +125,7 @@ Qed. Lemma gcd_add_mult_diag_r : forall n m p, gcd n (m+p*n) == gcd n m. Proof. - intros. apply gcd_unique_alt; try apply gcd_nonneg. + intros n m p. apply gcd_unique_alt; try apply gcd_nonneg. intros. rewrite gcd_divide_iff. split; intros (U,V); split; trivial. apply divide_add_r; trivial. now apply divide_mul_r. apply divide_add_cancel_r with (p*n); trivial. @@ -164,12 +164,12 @@ Proof. (* First, a version restricted to natural numbers *) assert (aux : forall n, 0<=n -> forall m, 0<=m -> Bezout n m (gcd n m)). intros n Hn; pattern n. - apply strong_right_induction with (z:=0); trivial. + apply (fun H => strong_right_induction _ H 0); trivial. unfold Bezout. solve_proper. clear n Hn. intros n Hn IHn. apply le_lteq in Hn; destruct Hn as [Hn|Hn]. intros m Hm; pattern m. - apply strong_right_induction with (z:=0); trivial. + apply (fun H => strong_right_induction _ H 0); trivial. unfold Bezout. solve_proper. clear m Hm. intros m Hm IHm. destruct (lt_trichotomy n m) as [LT|[EQ|LT]]. @@ -227,7 +227,7 @@ Qed. Lemma gcd_mul_mono_l_nonneg : forall n m p, 0<=p -> gcd (p*n) (p*m) == p * gcd n m. Proof. - intros. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_l. + intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_l. Qed. Lemma gcd_mul_mono_r : @@ -239,7 +239,7 @@ Qed. Lemma gcd_mul_mono_r_nonneg : forall n m p, 0<=p -> gcd (n*p) (m*p) == gcd n m * p. Proof. - intros. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_r. + intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_r. Qed. Lemma gauss : forall n m p, (n | m * p) -> gcd n m == 1 -> (n | p). diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v index 6aa828ebfc..c45ea12868 100644 --- a/theories/Numbers/Integer/Abstract/ZLcm.v +++ b/theories/Numbers/Integer/Abstract/ZLcm.v @@ -33,14 +33,14 @@ Module Type ZLcmProp Lemma quot_div_nonneg : forall a b, 0<=a -> 0<b -> a÷b == a/b. Proof. - intros. apply div_unique_pos with (a rem b). + intros a b **. apply div_unique_pos with (a rem b). now apply rem_bound_pos. apply quot_rem. order. Qed. Lemma rem_mod_nonneg : forall a b, 0<=a -> 0<b -> a rem b == a mod b. Proof. - intros. apply mod_unique_pos with (a÷b). + intros a b **. apply mod_unique_pos with (a÷b). now apply rem_bound_pos. apply quot_rem. order. Qed. @@ -290,7 +290,7 @@ Qed. Lemma lcm_divide_iff : forall n m p, (lcm n m | p) <-> (n | p) /\ (m | p). Proof. - intros. split. split. + intros n m p. split. split. transitivity (lcm n m); trivial using divide_lcm_l. transitivity (lcm n m); trivial using divide_lcm_r. intros (H,H'). now apply lcm_least. @@ -387,7 +387,7 @@ Qed. Lemma lcm_abs_l : forall n m, lcm (abs n) m == lcm n m. Proof. - intros. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. + intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. easy. apply lcm_opp_l. Qed. @@ -438,7 +438,7 @@ Qed. Lemma lcm_mul_mono_l_nonneg : forall n m p, 0<=p -> lcm (p*n) (p*m) == p * lcm n m. Proof. - intros. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_l. + intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_l. Qed. Lemma lcm_mul_mono_r : @@ -450,7 +450,7 @@ Qed. Lemma lcm_mul_mono_r_nonneg : forall n m p, 0<=p -> lcm (n*p) (m*p) == lcm n m * p. Proof. - intros. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_r. + intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_r. Qed. Lemma gcd_1_lcm_mul : forall n m, n~=0 -> m~=0 -> diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v index ed0b0c69a0..4af24b7754 100644 --- a/theories/Numbers/Integer/Abstract/ZMaxMin.v +++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v @@ -20,133 +20,133 @@ Include ZMulOrderProp Z. (** Succ *) -Lemma succ_max_distr : forall n m, S (max n m) == max (S n) (S m). +Lemma succ_max_distr n m : S (max n m) == max (S n) (S m). Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?succ_le_mono. Qed. -Lemma succ_min_distr : forall n m, S (min n m) == min (S n) (S m). +Lemma succ_min_distr n m : S (min n m) == min (S n) (S m). Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?succ_le_mono. Qed. (** Pred *) -Lemma pred_max_distr : forall n m, P (max n m) == max (P n) (P m). +Lemma pred_max_distr n m : P (max n m) == max (P n) (P m). Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?pred_le_mono. Qed. -Lemma pred_min_distr : forall n m, P (min n m) == min (P n) (P m). +Lemma pred_min_distr n m : P (min n m) == min (P n) (P m). Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?pred_le_mono. Qed. (** Add *) -Lemma add_max_distr_l : forall n m p, max (p + n) (p + m) == p + max n m. +Lemma add_max_distr_l n m p : max (p + n) (p + m) == p + max n m. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_l. Qed. -Lemma add_max_distr_r : forall n m p, max (n + p) (m + p) == max n m + p. +Lemma add_max_distr_r n m p : max (n + p) (m + p) == max n m + p. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; now rewrite <- ?add_le_mono_r. Qed. -Lemma add_min_distr_l : forall n m p, min (p + n) (p + m) == p + min n m. +Lemma add_min_distr_l n m p : min (p + n) (p + m) == p + min n m. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_l. Qed. -Lemma add_min_distr_r : forall n m p, min (n + p) (m + p) == min n m + p. +Lemma add_min_distr_r n m p : min (n + p) (m + p) == min n m + p. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; now rewrite <- ?add_le_mono_r. Qed. (** Opp *) -Lemma opp_max_distr : forall n m, -(max n m) == min (-n) (-m). +Lemma opp_max_distr n m : -(max n m) == min (-n) (-m). Proof. - intros. destruct (le_ge_cases n m). + destruct (le_ge_cases n m). rewrite max_r by trivial. symmetry. apply min_r. now rewrite <- opp_le_mono. rewrite max_l by trivial. symmetry. apply min_l. now rewrite <- opp_le_mono. Qed. -Lemma opp_min_distr : forall n m, -(min n m) == max (-n) (-m). +Lemma opp_min_distr n m : -(min n m) == max (-n) (-m). Proof. - intros. destruct (le_ge_cases n m). + destruct (le_ge_cases n m). rewrite min_l by trivial. symmetry. apply max_l. now rewrite <- opp_le_mono. rewrite min_r by trivial. symmetry. apply max_r. now rewrite <- opp_le_mono. Qed. (** Sub *) -Lemma sub_max_distr_l : forall n m p, max (p - n) (p - m) == p - min n m. +Lemma sub_max_distr_l n m p : max (p - n) (p - m) == p - min n m. Proof. - intros. destruct (le_ge_cases n m). + destruct (le_ge_cases n m). rewrite min_l by trivial. apply max_l. now rewrite <- sub_le_mono_l. rewrite min_r by trivial. apply max_r. now rewrite <- sub_le_mono_l. Qed. -Lemma sub_max_distr_r : forall n m p, max (n - p) (m - p) == max n m - p. +Lemma sub_max_distr_r n m p : max (n - p) (m - p) == max n m - p. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply sub_le_mono_r. Qed. -Lemma sub_min_distr_l : forall n m p, min (p - n) (p - m) == p - max n m. +Lemma sub_min_distr_l n m p : min (p - n) (p - m) == p - max n m. Proof. - intros. destruct (le_ge_cases n m). + destruct (le_ge_cases n m). rewrite max_r by trivial. apply min_r. now rewrite <- sub_le_mono_l. rewrite max_l by trivial. apply min_l. now rewrite <- sub_le_mono_l. Qed. -Lemma sub_min_distr_r : forall n m p, min (n - p) (m - p) == min n m - p. +Lemma sub_min_distr_r n m p : min (n - p) (m - p) == min n m - p. Proof. - intros. destruct (le_ge_cases n m); + destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply sub_le_mono_r. Qed. (** Mul *) -Lemma mul_max_distr_nonneg_l : forall n m p, 0 <= p -> +Lemma mul_max_distr_nonneg_l n m p : 0 <= p -> max (p * n) (p * m) == p * max n m. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_l. Qed. -Lemma mul_max_distr_nonneg_r : forall n m p, 0 <= p -> +Lemma mul_max_distr_nonneg_r n m p : 0 <= p -> max (n * p) (m * p) == max n m * p. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_r. Qed. -Lemma mul_min_distr_nonneg_l : forall n m p, 0 <= p -> +Lemma mul_min_distr_nonneg_l n m p : 0 <= p -> min (p * n) (p * m) == p * min n m. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_l. Qed. -Lemma mul_min_distr_nonneg_r : forall n m p, 0 <= p -> +Lemma mul_min_distr_nonneg_r n m p : 0 <= p -> min (n * p) (m * p) == min n m * p. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_r. Qed. -Lemma mul_max_distr_nonpos_l : forall n m p, p <= 0 -> +Lemma mul_max_distr_nonpos_l n m p : p <= 0 -> max (p * n) (p * m) == p * min n m. Proof. intros. destruct (le_ge_cases n m). @@ -154,7 +154,7 @@ Proof. rewrite min_r by trivial. rewrite max_r. reflexivity. now apply mul_le_mono_nonpos_l. Qed. -Lemma mul_max_distr_nonpos_r : forall n m p, p <= 0 -> +Lemma mul_max_distr_nonpos_r n m p : p <= 0 -> max (n * p) (m * p) == min n m * p. Proof. intros. destruct (le_ge_cases n m). @@ -162,7 +162,7 @@ Proof. rewrite min_r by trivial. rewrite max_r. reflexivity. now apply mul_le_mono_nonpos_r. Qed. -Lemma mul_min_distr_nonpos_l : forall n m p, p <= 0 -> +Lemma mul_min_distr_nonpos_l n m p : p <= 0 -> min (p * n) (p * m) == p * max n m. Proof. intros. destruct (le_ge_cases n m). @@ -170,7 +170,7 @@ Proof. rewrite max_l by trivial. rewrite min_l. reflexivity. now apply mul_le_mono_nonpos_l. Qed. -Lemma mul_min_distr_nonpos_r : forall n m p, p <= 0 -> +Lemma mul_min_distr_nonpos_r n m p : p <= 0 -> min (n * p) (m * p) == max n m * p. Proof. intros. destruct (le_ge_cases n m). diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v index 7d97d11818..0275a5fa65 100644 --- a/theories/Numbers/Integer/Abstract/ZMulOrder.v +++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v @@ -167,7 +167,7 @@ Qed. Theorem eq_mul_1 : forall n m, n * m == 1 -> n == 1 \/ n == -1. Proof. assert (F := lt_m1_0). -zero_pos_neg n. +intro n; zero_pos_neg n. (* n = 0 *) intros m. nzsimpl. now left. (* 0 < n, proving P n /\ P (-n) *) @@ -205,7 +205,7 @@ Qed. Theorem lt_mul_r : forall n m p, 0 < n -> 1 < p -> n < m -> n < m * p. Proof. -intros. stepl (n * 1) by now rewrite mul_1_r. +intros n m p **. stepl (n * 1) by now rewrite mul_1_r. apply mul_lt_mono_nonneg. now apply lt_le_incl. assumption. apply le_0_1. assumption. Qed. diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v index 4b61b18479..0f68278cf0 100644 --- a/theories/Numbers/Integer/Abstract/ZParity.v +++ b/theories/Numbers/Integer/Abstract/ZParity.v @@ -19,19 +19,19 @@ Include NZParityProp Z Z ZP. Lemma odd_pred : forall n, odd (P n) = even n. Proof. - intros. rewrite <- (succ_pred n) at 2. symmetry. apply even_succ. + intros n. rewrite <- (succ_pred n) at 2. symmetry. apply even_succ. Qed. Lemma even_pred : forall n, even (P n) = odd n. Proof. - intros. rewrite <- (succ_pred n) at 2. symmetry. apply odd_succ. + intros n. rewrite <- (succ_pred n) at 2. symmetry. apply odd_succ. Qed. Lemma even_opp : forall n, even (-n) = even n. Proof. assert (H : forall n, Even n -> Even (-n)). intros n (m,H). exists (-m). rewrite mul_opp_r. now f_equiv. - intros. rewrite eq_iff_eq_true, !even_spec. + intros n. rewrite eq_iff_eq_true, !even_spec. split. rewrite <- (opp_involutive n) at 2. apply H. apply H. Qed. diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v index bec77fd136..9557212a86 100644 --- a/theories/Numbers/Integer/Abstract/ZPow.v +++ b/theories/Numbers/Integer/Abstract/ZPow.v @@ -73,7 +73,7 @@ Qed. Lemma pow_even_abs : forall a b, Even b -> a^b == (abs a)^b. Proof. - intros. destruct (abs_eq_or_opp a) as [EQ|EQ]; rewrite EQ. + intros a b ?. destruct (abs_eq_or_opp a) as [EQ|EQ]; rewrite EQ. reflexivity. symmetry. now apply pow_opp_even. Qed. @@ -119,7 +119,7 @@ Qed. Lemma abs_pow : forall a b, abs (a^b) == (abs a)^b. Proof. intros a b. - destruct (Even_or_Odd b). + destruct (Even_or_Odd b) as [H|H]. rewrite pow_even_abs by trivial. apply abs_eq, pow_nonneg, abs_nonneg. rewrite pow_odd_abs_sgn by trivial. diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v index 03e0c0345d..3ebbec9397 100644 --- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v +++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v @@ -40,11 +40,11 @@ Module Type GenericSgn (Import Z : ZDecAxiomsSig') (Import ZP : ZMulOrderProp Z) <: HasSgn Z. Definition sgn n := match compare 0 n with Eq => 0 | Lt => 1 | Gt => -1 end. - Lemma sgn_null : forall n, n==0 -> sgn n == 0. + Lemma sgn_null n : n==0 -> sgn n == 0. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. - Lemma sgn_pos : forall n, 0<n -> sgn n == 1. + Lemma sgn_pos n : 0<n -> sgn n == 1. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. - Lemma sgn_neg : forall n, n<0 -> sgn n == -1. + Lemma sgn_neg n : n<0 -> sgn n == -1. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. End GenericSgn. @@ -101,7 +101,7 @@ Qed. Lemma abs_opp : forall n, abs (-n) == abs n. Proof. - intros. destruct_max n. + intros n. destruct_max n. rewrite (abs_neq (-n)), opp_involutive. reflexivity. now rewrite opp_nonpos_nonneg. rewrite (abs_eq (-n)). reflexivity. @@ -115,14 +115,14 @@ Qed. Lemma abs_0_iff : forall n, abs n == 0 <-> n==0. Proof. - split. destruct_max n; auto. + intros n; split. destruct_max n; auto. now rewrite eq_opp_l, opp_0. intros EQ; rewrite EQ. rewrite abs_eq; auto using eq_refl, le_refl. Qed. Lemma abs_pos : forall n, 0 < abs n <-> n~=0. Proof. - intros. rewrite <- abs_0_iff. split; [intros LT| intros NEQ]. + intros n. rewrite <- abs_0_iff. split; [intros LT| intros NEQ]. intro EQ. rewrite EQ in LT. now elim (lt_irrefl 0). assert (LE : 0 <= abs n) by apply abs_nonneg. rewrite lt_eq_cases in LE; destruct LE; auto. @@ -131,12 +131,12 @@ Qed. Lemma abs_eq_or_opp : forall n, abs n == n \/ abs n == -n. Proof. - intros. destruct_max n; auto with relations. + intros n. destruct_max n; auto with relations. Qed. Lemma abs_or_opp_abs : forall n, n == abs n \/ n == - abs n. Proof. - intros. destruct_max n; rewrite ? opp_involutive; auto with relations. + intros n. destruct_max n; rewrite ? opp_involutive; auto with relations. Qed. Lemma abs_involutive : forall n, abs (abs n) == abs n. @@ -147,7 +147,7 @@ Qed. Lemma abs_spec : forall n, (0 <= n /\ abs n == n) \/ (n < 0 /\ abs n == -n). Proof. - intros. destruct (le_gt_cases 0 n). + intros n. destruct (le_gt_cases 0 n). left; split; auto. now apply abs_eq. right; split; auto. apply abs_neq. now apply lt_le_incl. Qed. @@ -156,7 +156,7 @@ Lemma abs_case_strong : forall (P:t->Prop) n, Proper (eq==>iff) P -> (0<=n -> P n) -> (n<=0 -> P (-n)) -> P (abs n). Proof. - intros. destruct_max n; auto. + intros P n **. destruct_max n; auto. Qed. Lemma abs_case : forall (P:t->Prop) n, Proper (eq==>iff) P -> @@ -196,7 +196,7 @@ Qed. Lemma abs_triangle : forall n m, abs (n + m) <= abs n + abs m. Proof. - intros. destruct_max n; destruct_max m. + intros n m. destruct_max n; destruct_max m. rewrite abs_eq. apply le_refl. now apply add_nonneg_nonneg. destruct_max (n+m); try rewrite opp_add_distr; apply add_le_mono_l || apply add_le_mono_r. @@ -212,7 +212,7 @@ Qed. Lemma abs_sub_triangle : forall n m, abs n - abs m <= abs (n-m). Proof. - intros. + intros n m. rewrite le_sub_le_add_l, add_comm. rewrite <- (sub_simpl_r n m) at 1. apply abs_triangle. @@ -223,10 +223,10 @@ Qed. Lemma abs_mul : forall n m, abs (n * m) == abs n * abs m. Proof. assert (H : forall n m, 0<=n -> abs (n*m) == n * abs m). - intros. destruct_max m. + intros n m ?. destruct_max m. rewrite abs_eq. apply eq_refl. now apply mul_nonneg_nonneg. rewrite abs_neq, mul_opp_r. reflexivity. now apply mul_nonneg_nonpos . - intros. destruct_max n. now apply H. + intros n m. destruct_max n. now apply H. rewrite <- mul_opp_opp, H, abs_opp. reflexivity. now apply opp_nonneg_nonpos. Qed. @@ -271,7 +271,7 @@ Qed. Lemma sgn_pos_iff : forall n, sgn n == 1 <-> 0<n. Proof. - split; try apply sgn_pos. destruct_sgn n; auto. + intros n; split; try apply sgn_pos. destruct_sgn n; auto. intros. elim (lt_neq 0 1); auto. apply lt_0_1. intros. elim (lt_neq (-1) 1); auto. apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1. @@ -279,7 +279,7 @@ Qed. Lemma sgn_null_iff : forall n, sgn n == 0 <-> n==0. Proof. - split; try apply sgn_null. destruct_sgn n; auto with relations. + intros n; split; try apply sgn_null. destruct_sgn n; auto with relations. intros. elim (lt_neq 0 1); auto with relations. apply lt_0_1. intros. elim (lt_neq (-1) 0); auto. rewrite opp_neg_pos. apply lt_0_1. @@ -287,7 +287,7 @@ Qed. Lemma sgn_neg_iff : forall n, sgn n == -1 <-> n<0. Proof. - split; try apply sgn_neg. destruct_sgn n; auto with relations. + intros n; split; try apply sgn_neg. destruct_sgn n; auto with relations. intros. elim (lt_neq (-1) 1); auto with relations. apply lt_trans with 0. rewrite opp_neg_pos. apply lt_0_1. apply lt_0_1. intros. elim (lt_neq (-1) 0); auto with relations. @@ -296,7 +296,7 @@ Qed. Lemma sgn_opp : forall n, sgn (-n) == - sgn n. Proof. - intros. destruct_sgn n. + intros n. destruct_sgn n. apply sgn_neg. now rewrite opp_neg_pos. setoid_replace n with 0 by auto with relations. rewrite opp_0. apply sgn_0. @@ -305,7 +305,7 @@ Qed. Lemma sgn_nonneg : forall n, 0 <= sgn n <-> 0 <= n. Proof. - split. + intros n; split. destruct_sgn n; intros. now apply lt_le_incl. order. @@ -323,7 +323,7 @@ Qed. Lemma sgn_mul : forall n m, sgn (n*m) == sgn n * sgn m. Proof. - intros. destruct_sgn n; nzsimpl. + intros n m. destruct_sgn n; nzsimpl. destruct_sgn m. apply sgn_pos. now apply mul_pos_pos. apply sgn_null. rewrite eq_mul_0; auto with relations. @@ -337,7 +337,7 @@ Qed. Lemma sgn_abs : forall n, n * sgn n == abs n. Proof. - intros. symmetry. + intros n. symmetry. destruct_sgn n; try rewrite mul_opp_r; nzsimpl. apply abs_eq. now apply lt_le_incl. rewrite abs_0_iff; auto with relations. @@ -346,7 +346,7 @@ Qed. Lemma abs_sgn : forall n, abs n * sgn n == n. Proof. - intros. + intros n. destruct_sgn n; try rewrite mul_opp_r; nzsimpl; auto. apply abs_eq. now apply lt_le_incl. rewrite eq_opp_l. apply abs_neq. now apply lt_le_incl. @@ -354,7 +354,7 @@ Qed. Lemma sgn_sgn : forall x, sgn (sgn x) == sgn x. Proof. - intros. + intros x. destruct (sgn_spec x) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ. apply sgn_pos, lt_0_1. now apply sgn_null. diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v index b41cd571dc..2ec9f4d871 100644 --- a/theories/PArith/BinPosDef.v +++ b/theories/PArith/BinPosDef.v @@ -639,10 +639,10 @@ Fixpoint of_hex_uint (d:Hexadecimal.uint) : N := | Hexadecimal.Df l => Npos (of_hex_uint_acc l 1~1~1~1) end. -Definition of_num_uint (d:Numeral.uint) : N := +Definition of_num_uint (d:Number.uint) : N := match d with - | Numeral.UIntDec d => of_uint d - | Numeral.UIntHex d => of_hex_uint d + | Number.UIntDecimal d => of_uint d + | Number.UIntHexadecimal d => of_hex_uint d end. Definition of_int (d:Decimal.int) : option positive := @@ -665,10 +665,10 @@ Definition of_hex_int (d:Hexadecimal.int) : option positive := | Hexadecimal.Neg _ => None end. -Definition of_num_int (d:Numeral.int) : option positive := +Definition of_num_int (d:Number.int) : option positive := match d with - | Numeral.IntDec d => of_int d - | Numeral.IntHex d => of_hex_int d + | Number.IntDecimal d => of_int d + | Number.IntHexadecimal d => of_hex_int d end. Fixpoint to_little_uint p := @@ -689,13 +689,13 @@ Fixpoint to_little_hex_uint p := Definition to_hex_uint p := Hexadecimal.rev (to_little_hex_uint p). -Definition to_num_uint p := Numeral.UIntDec (to_uint p). +Definition to_num_uint p := Number.UIntDecimal (to_uint p). Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int p := Hexadecimal.Pos (to_hex_uint p). -Definition to_num_int n := Numeral.IntDec (to_int n). +Definition to_num_int n := Number.IntDecimal (to_int n). Number Notation positive of_num_int to_num_uint : positive_scope. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 192dcd885b..fa4f9134cc 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -18,6 +18,9 @@ Require Export Morphisms Setoid Bool. Record Q : Set := Qmake {Qnum : Z; Qden : positive}. +Declare Scope hex_Q_scope. +Delimit Scope hex_Q_scope with xQ. + Declare Scope Q_scope. Delimit Scope Q_scope with Q. Bind Scope Q_scope with Q. @@ -33,104 +36,6 @@ Ltac simpl_mult := rewrite ?Pos2Z.inj_mul. Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope. -Definition of_decimal (d:Decimal.decimal) : Q := - let '(i, f, e) := - match d with - | Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil) - | Decimal.DecimalExp i f e => (i, f, e) - end in - let num := Z.of_int (Decimal.app_int i f) in - let e := Z.sub (Z.of_int e) (Z.of_nat (Decimal.nb_digits f)) in - match e with - | Z0 => Qmake num 1 - | Zpos e => Qmake (Pos.iter (Z.mul 10) num e) 1 - | Zneg e => Qmake num (Pos.iter (Pos.mul 10) 1%positive e) - end. - -Definition to_decimal (q:Q) : option Decimal.decimal := - (* choose between 123e-2 and 1.23, this is purely heuristic - and doesn't play any soundness role *) - let choose_exponent i ne := - let i := match i with Decimal.Pos i | Decimal.Neg i => i end in - let li := Decimal.nb_digits i in - let le := Decimal.nb_digits (Nat.to_uint ne) in - Nat.ltb (Nat.add li le) ne in - (* print 123 / 100 as 123e-2 *) - let decimal_exponent i ne := - let e := Z.to_int (Z.opp (Z.of_nat ne)) in - Decimal.DecimalExp i Decimal.Nil e in - (* print 123 / 100 as 1.23 *) - let decimal_dot i ne := - let ai := match i with Decimal.Pos i | Decimal.Neg i => i end in - let ni := Decimal.nb_digits ai in - if Nat.ltb ne ni then - let i := Decimal.del_tail_int ne i in - let f := Decimal.del_head (Nat.sub ni ne) ai in - Decimal.Decimal i f - else - let z := match i with - | Decimal.Pos _ => Decimal.Pos (Decimal.zero) - | Decimal.Neg _ => Decimal.Neg (Decimal.zero) end in - Decimal.Decimal z (Nat.iter (Nat.sub ne ni) Decimal.D0 ai) in - let num := Z.to_int (Qnum q) in - let (den, e_den) := Decimal.nztail (Pos.to_uint (Qden q)) in - match den with - | Decimal.D1 Decimal.Nil => - match e_den with - | O => Some (Decimal.Decimal num Decimal.Nil) - | ne => - if choose_exponent num ne then Some (decimal_exponent num ne) - else Some (decimal_dot num ne) - end - | _ => None - end. - -Definition of_hexadecimal (d:Hexadecimal.hexadecimal) : Q := - let '(i, f, e) := - match d with - | Hexadecimal.Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) - | Hexadecimal.HexadecimalExp i f e => (i, f, e) - end in - let num := Z.of_hex_int (Hexadecimal.app_int i f) in - let e := Z.sub (Z.of_int e) (Z.mul 4 (Z.of_nat (Hexadecimal.nb_digits f))) in - match e with - | Z0 => Qmake num 1 - | Zpos e => Qmake (Pos.iter (Z.mul 2) num e) 1 - | Zneg e => Qmake num (Pos.iter (Pos.mul 2) 1%positive e) - end. - -Definition to_hexadecimal (q:Q) : option Hexadecimal.hexadecimal := - let mk_exp i e := - Hexadecimal.HexadecimalExp i Hexadecimal.Nil (Z.to_int (Z.opp e)) in - let num := Z.to_hex_int (Qnum q) in - let (den, e_den) := Hexadecimal.nztail (Pos.to_hex_uint (Qden q)) in - let e := Z.of_nat e_den in - match den with - | Hexadecimal.D1 Hexadecimal.Nil => - match e_den with - | O => Some (Hexadecimal.Hexadecimal num Hexadecimal.Nil) - | _ => Some (mk_exp num (4 * e)%Z) - end - | Hexadecimal.D2 Hexadecimal.Nil => Some (mk_exp num (1 + 4 * e)%Z) - | Hexadecimal.D4 Hexadecimal.Nil => Some (mk_exp num (2 + 4 * e)%Z) - | Hexadecimal.D8 Hexadecimal.Nil => Some (mk_exp num (3 + 4 * e)%Z) - | _ => None - end. - -Definition of_numeral (d:Numeral.numeral) : option Q := - match d with - | Numeral.Dec d => Some (of_decimal d) - | Numeral.Hex d => Some (of_hexadecimal d) - end. - -Definition to_numeral (q:Q) : option Numeral.numeral := - match to_decimal q with - | None => None - | Some q => Some (Numeral.Dec q) - end. - -Number Notation Q of_numeral to_numeral : Q_scope. - Definition inject_Z (x : Z) := Qmake x 1. Arguments inject_Z x%Z. @@ -316,7 +221,7 @@ Definition Qminus (x y : Q) := Qplus x (Qopp y). Definition Qinv (x : Q) := match Qnum x with - | Z0 => 0 + | Z0 => 0#1 | Zpos p => (QDen x)#p | Zneg p => (Zneg (Qden x))#p end. @@ -335,6 +240,188 @@ Register Qminus as rat.Q.Qminus. Register Qopp as rat.Q.Qopp. Register Qmult as rat.Q.Qmult. +(** Number notation for constants *) + +Inductive IZ := + | IZpow_pos : Z -> positive -> IZ + | IZ0 : IZ + | IZpos : positive -> IZ + | IZneg : positive -> IZ. + +Inductive IQ := + | IQmake : IZ -> positive -> IQ + | IQmult : IQ -> IQ -> IQ + | IQdiv : IQ -> IQ -> IQ. + +Definition IZ_of_Z z := + match z with + | Z0 => IZ0 + | Zpos e => IZpos e + | Zneg e => IZneg e + end. + +Definition IZ_to_Z z := + match z with + | IZ0 => Some Z0 + | IZpos e => Some (Zpos e) + | IZneg e => Some (Zneg e) + | IZpow_pos _ _ => None + end. + +Definition of_decimal (d:Decimal.decimal) : IQ := + let '(i, f, e) := + match d with + | Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil) + | Decimal.DecimalExp i f e => (i, f, e) + end in + let num := Z.of_int (Decimal.app_int i f) in + let den := Nat.iter (Decimal.nb_digits f) (Pos.mul 10) 1%positive in + let q := IQmake (IZ_of_Z num) den in + let e := Z.of_int e in + match e with + | Z0 => q + | Zpos e => IQmult q (IQmake (IZpow_pos 10 e) 1) + | Zneg e => IQdiv q (IQmake (IZpow_pos 10 e) 1) + end. + +Definition IQmake_to_decimal num den := + let num := Z.to_int num in + let (den, e_den) := Decimal.nztail (Pos.to_uint den) in + match den with + | Decimal.D1 Decimal.Nil => + match e_den with + | O => Some (Decimal.Decimal num Decimal.Nil) + | ne => + let ai := Decimal.abs num in + let ni := Decimal.nb_digits ai in + if Nat.ltb ne ni then + let i := Decimal.del_tail_int ne num in + let f := Decimal.del_head (Nat.sub ni ne) ai in + Some (Decimal.Decimal i f) + else + let z := match num with + | Decimal.Pos _ => Decimal.Pos (Decimal.zero) + | Decimal.Neg _ => Decimal.Neg (Decimal.zero) end in + Some (Decimal.Decimal z (Nat.iter (Nat.sub ne ni) Decimal.D0 ai)) + end + | _ => None + end. + +Definition IQmake_to_decimal' num den := + match IZ_to_Z num with + | None => None + | Some num => IQmake_to_decimal num den + end. + +Definition to_decimal (n : IQ) : option Decimal.decimal := + match n with + | IQmake num den => IQmake_to_decimal' num den + | IQmult (IQmake num den) (IQmake (IZpow_pos 10 e) 1) => + match IQmake_to_decimal' num den with + | Some (Decimal.Decimal i f) => + Some (Decimal.DecimalExp i f (Pos.to_int e)) + | _ => None + end + | IQdiv (IQmake num den) (IQmake (IZpow_pos 10 e) 1) => + match IQmake_to_decimal' num den with + | Some (Decimal.Decimal i f) => + Some (Decimal.DecimalExp i f (Decimal.Neg (Pos.to_uint e))) + | _ => None + end + | _ => None + end. + +Definition of_hexadecimal (d:Hexadecimal.hexadecimal) : IQ := + let '(i, f, e) := + match d with + | Hexadecimal.Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) + | Hexadecimal.HexadecimalExp i f e => (i, f, e) + end in + let num := Z.of_hex_int (Hexadecimal.app_int i f) in + let den := Nat.iter (Hexadecimal.nb_digits f) (Pos.mul 16) 1%positive in + let q := IQmake (IZ_of_Z num) den in + let e := Z.of_int e in + match e with + | Z0 => q + | Zpos e => IQmult q (IQmake (IZpow_pos 2 e) 1) + | Zneg e => IQdiv q (IQmake (IZpow_pos 2 e) 1) + end. + +Definition IQmake_to_hexadecimal num den := + let num := Z.to_hex_int num in + let (den, e_den) := Hexadecimal.nztail (Pos.to_hex_uint den) in + match den with + | Hexadecimal.D1 Hexadecimal.Nil => + match e_den with + | O => Some (Hexadecimal.Hexadecimal num Hexadecimal.Nil) + | ne => + let ai := Hexadecimal.abs num in + let ni := Hexadecimal.nb_digits ai in + if Nat.ltb ne ni then + let i := Hexadecimal.del_tail_int ne num in + let f := Hexadecimal.del_head (Nat.sub ni ne) ai in + Some (Hexadecimal.Hexadecimal i f) + else + let z := match num with + | Hexadecimal.Pos _ => Hexadecimal.Pos (Hexadecimal.zero) + | Hexadecimal.Neg _ => Hexadecimal.Neg (Hexadecimal.zero) end in + Some (Hexadecimal.Hexadecimal z (Nat.iter (Nat.sub ne ni) Hexadecimal.D0 ai)) + end + | _ => None + end. + +Definition IQmake_to_hexadecimal' num den := + match IZ_to_Z num with + | None => None + | Some num => IQmake_to_hexadecimal num den + end. + +Definition to_hexadecimal (n : IQ) : option Hexadecimal.hexadecimal := + match n with + | IQmake num den => IQmake_to_hexadecimal' num den + | IQmult (IQmake num den) (IQmake (IZpow_pos 2 e) 1) => + match IQmake_to_hexadecimal' num den with + | Some (Hexadecimal.Hexadecimal i f) => + Some (Hexadecimal.HexadecimalExp i f (Pos.to_int e)) + | _ => None + end + | IQdiv (IQmake num den) (IQmake (IZpow_pos 2 e) 1) => + match IQmake_to_hexadecimal' num den with + | Some (Hexadecimal.Hexadecimal i f) => + Some (Hexadecimal.HexadecimalExp i f (Decimal.Neg (Pos.to_uint e))) + | _ => None + end + | _ => None + end. + +Definition of_number (n : Number.number) : IQ := + match n with + | Number.Decimal d => of_decimal d + | Number.Hexadecimal h => of_hexadecimal h + end. + +Definition to_number (q:IQ) : option Number.number := + match to_decimal q with + | None => None + | Some q => Some (Number.Decimal q) + end. + +Definition to_hex_number q := + match to_hexadecimal q with + | None => None + | Some q => Some (Number.Hexadecimal q) + end. + +Number Notation Q of_number to_hex_number (via IQ + mapping [Qmake => IQmake, Qmult => IQmult, Qdiv => IQdiv, + Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) + : hex_Q_scope. + +Number Notation Q of_number to_number (via IQ + mapping [Qmake => IQmake, Qmult => IQmult, Qdiv => IQdiv, + Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) + : Q_scope. + (** A light notation for [Zpos] *) Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z (Zpos b). diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index 1baefd6bf7..20b5cb236b 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -13,8 +13,6 @@ Require Export QArith_base. (** Injection of rational numbers into real numbers. *) -Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R. - Lemma IZR_nz : forall p : positive, IZR (Zpos p) <> 0%R. Proof. intros. diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index affa129771..40736c61f2 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -22,11 +22,12 @@ Require Import ConstructiveRcomplete. Require Import ClassicalDedekindReals. -(* Declare primitive numeral notations for Scope R_scope *) +(* Declare primitive number notations for Scope R_scope *) +Declare Scope hex_R_scope. Declare Scope R_scope. -Declare ML Module "r_syntax_plugin". (* Declare Scope R_scope with Key R *) +Delimit Scope hex_R_scope with xR. Delimit Scope R_scope with R. Local Open Scope R_scope. @@ -224,3 +225,165 @@ Proof. - (* x = n-1 *) exact n. - exact (Z.pred n). Defined. + +(** Injection of rational numbers into real numbers. *) + +Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R. + +(**********************************************************) +(** * Number notation for constants *) +(**********************************************************) + +Inductive IR := + | IRZ : IZ -> IR + | IRQ : Q -> IR + | IRmult : IR -> IR -> IR + | IRdiv : IR -> IR -> IR. + +Definition of_decimal (d : Decimal.decimal) : IR := + let '(i, f, e) := + match d with + | Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil) + | Decimal.DecimalExp i f e => (i, f, e) + end in + let zq := match f with + | Decimal.Nil => IRZ (IZ_of_Z (Z.of_int i)) + | _ => + let num := Z.of_int (Decimal.app_int i f) in + let den := Nat.iter (Decimal.nb_digits f) (Pos.mul 10) 1%positive in + IRQ (Qmake num den) end in + let e := Z.of_int e in + match e with + | Z0 => zq + | Zpos e => IRmult zq (IRZ (IZpow_pos 10 e)) + | Zneg e => IRdiv zq (IRZ (IZpow_pos 10 e)) + end. + +Definition of_hexadecimal (d : Hexadecimal.hexadecimal) : IR := + let '(i, f, e) := + match d with + | Hexadecimal.Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) + | Hexadecimal.HexadecimalExp i f e => (i, f, e) + end in + let zq := match f with + | Hexadecimal.Nil => IRZ (IZ_of_Z (Z.of_hex_int i)) + | _ => + let num := Z.of_hex_int (Hexadecimal.app_int i f) in + let den := Nat.iter (Hexadecimal.nb_digits f) (Pos.mul 16) 1%positive in + IRQ (Qmake num den) end in + let e := Z.of_int e in + match e with + | Z0 => zq + | Zpos e => IRmult zq (IRZ (IZpow_pos 2 e)) + | Zneg e => IRdiv zq (IRZ (IZpow_pos 2 e)) + end. + +Definition of_number (n : Number.number) : IR := + match n with + | Number.Decimal d => of_decimal d + | Number.Hexadecimal h => of_hexadecimal h + end. + +Definition IQmake_to_decimal num den := + match den with + | 1%positive => None (* this should be encoded as IRZ *) + | _ => IQmake_to_decimal num den + end. + +Definition to_decimal (n : IR) : option Decimal.decimal := + match n with + | IRZ z => + match IZ_to_Z z with + | Some z => Some (Decimal.Decimal (Z.to_int z) Decimal.Nil) + | None => None + end + | IRQ (Qmake num den) => IQmake_to_decimal num den + | IRmult (IRZ z) (IRZ (IZpow_pos 10 e)) => + match IZ_to_Z z with + | Some z => + Some (Decimal.DecimalExp (Z.to_int z) Decimal.Nil (Pos.to_int e)) + | None => None + end + | IRmult (IRQ (Qmake num den)) (IRZ (IZpow_pos 10 e)) => + match IQmake_to_decimal num den with + | Some (Decimal.Decimal i f) => + Some (Decimal.DecimalExp i f (Pos.to_int e)) + | _ => None + end + | IRdiv (IRZ z) (IRZ (IZpow_pos 10 e)) => + match IZ_to_Z z with + | Some z => + Some (Decimal.DecimalExp (Z.to_int z) Decimal.Nil (Decimal.Neg (Pos.to_uint e))) + | None => None + end + | IRdiv (IRQ (Qmake num den)) (IRZ (IZpow_pos 10 e)) => + match IQmake_to_decimal num den with + | Some (Decimal.Decimal i f) => + Some (Decimal.DecimalExp i f (Decimal.Neg (Pos.to_uint e))) + | _ => None + end + | _ => None + end. + +Definition IQmake_to_hexadecimal num den := + match den with + | 1%positive => None (* this should be encoded as IRZ *) + | _ => IQmake_to_hexadecimal num den + end. + +Definition to_hexadecimal (n : IR) : option Hexadecimal.hexadecimal := + match n with + | IRZ z => + match IZ_to_Z z with + | Some z => Some (Hexadecimal.Hexadecimal (Z.to_hex_int z) Hexadecimal.Nil) + | None => None + end + | IRQ (Qmake num den) => IQmake_to_hexadecimal num den + | IRmult (IRZ z) (IRZ (IZpow_pos 2 e)) => + match IZ_to_Z z with + | Some z => + Some (Hexadecimal.HexadecimalExp (Z.to_hex_int z) Hexadecimal.Nil (Pos.to_int e)) + | None => None + end + | IRmult (IRQ (Qmake num den)) (IRZ (IZpow_pos 2 e)) => + match IQmake_to_hexadecimal num den with + | Some (Hexadecimal.Hexadecimal i f) => + Some (Hexadecimal.HexadecimalExp i f (Pos.to_int e)) + | _ => None + end + | IRdiv (IRZ z) (IRZ (IZpow_pos 2 e)) => + match IZ_to_Z z with + | Some z => + Some (Hexadecimal.HexadecimalExp (Z.to_hex_int z) Hexadecimal.Nil (Decimal.Neg (Pos.to_uint e))) + | None => None + end + | IRdiv (IRQ (Qmake num den)) (IRZ (IZpow_pos 2 e)) => + match IQmake_to_hexadecimal num den with + | Some (Hexadecimal.Hexadecimal i f) => + Some (Hexadecimal.HexadecimalExp i f (Decimal.Neg (Pos.to_uint e))) + | _ => None + end + | _ => None + end. + +Definition to_number q := + match to_decimal q with + | None => None + | Some q => Some (Number.Decimal q) + end. + +Definition to_hex_number q := + match to_hexadecimal q with + | None => None + | Some q => Some (Number.Hexadecimal q) + end. + +Number Notation R of_number to_hex_number (via IR + mapping [IZR => IRZ, Q2R => IRQ, Rmult => IRmult, Rdiv => IRdiv, + Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) + : hex_R_scope. + +Number Notation R of_number to_number (via IR + mapping [IZR => IRZ, Q2R => IRQ, Rmult => IRmult, Rdiv => IRdiv, + Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) + : R_scope. diff --git a/theories/Reals/Rregisternames.v b/theories/Reals/Rregisternames.v index 8b078f2cf3..8117d975fe 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 Raxioms Rfunctions Qreals. +Require Import Raxioms Rfunctions. (*****************************************************************) (** Register names for use in plugins *) @@ -31,4 +31,4 @@ Register IZR as reals.R.IZR. Register Rabs as reals.R.Rabs. Register powerRZ as reals.R.powerRZ. Register pow as reals.R.pow. -Register Qreals.Q2R as reals.R.Q2R. +Register Q2R as reals.R.Q2R. diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v index c155395ecd..06b02ab211 100644 --- a/theories/Strings/Ascii.v +++ b/theories/Strings/Ascii.v @@ -128,28 +128,28 @@ Definition nat_of_ascii (a : ascii) : nat := N.to_nat (N_of_ascii a). Theorem ascii_N_embedding : forall a : ascii, ascii_of_N (N_of_ascii a) = a. Proof. - destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. + intro a; destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. Qed. Theorem N_ascii_embedding : forall n:N, (n < 256)%N -> N_of_ascii (ascii_of_N n) = n. Proof. -destruct n. +intro n; destruct n as [|p]. reflexivity. -do 8 (destruct p; [ | | intros; vm_compute; reflexivity ]); +do 8 (destruct p as [p|p|]; [ | | intros; vm_compute; reflexivity ]); intro H; vm_compute in H; destruct p; discriminate. Qed. Theorem N_ascii_bounded : forall a : ascii, (N_of_ascii a < 256)%N. Proof. - destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. + intro a; destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. Qed. Theorem ascii_nat_embedding : forall a : ascii, ascii_of_nat (nat_of_ascii a) = a. Proof. - destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity. + intro a; destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity. Qed. Theorem nat_ascii_embedding : diff --git a/theories/Strings/String.v b/theories/Strings/String.v index a468a4fe87..b792acc9f9 100644 --- a/theories/Strings/String.v +++ b/theories/Strings/String.v @@ -54,7 +54,8 @@ Infix "=?" := eqb : string_scope. Lemma eqb_spec s1 s2 : Bool.reflect (s1 = s2) (s1 =? s2)%string. Proof. - revert s2. induction s1; destruct s2; try (constructor; easy); simpl. + revert s2. induction s1 as [|? s1 IHs1]; + intro s2; destruct s2; try (constructor; easy); simpl. case Ascii.eqb_spec; simpl; [intros -> | constructor; now intros [= ]]. case IHs1; [intros ->; now constructor | constructor; now intros [= ]]. Qed. @@ -117,7 +118,7 @@ intros s1; elim s1; simpl. intros s2; case s2; simpl; split; auto. intros H; generalize (H O); intros H1; inversion H1. intros; discriminate. -intros a s1' Rec s2; case s2; simpl; split; auto. +intros a s1' Rec s2; case s2 as [|? s]; simpl; split; auto. intros H; generalize (H O); intros H1; inversion H1. intros; discriminate. intros H; generalize (H O); simpl; intros H1; inversion H1. @@ -249,7 +250,7 @@ intros b s2'; case (ascii_dec a b); simpl; auto. intros e; case (Rec s2'); intros H1 H2; split; intros H3; auto. rewrite e; rewrite H1; auto. apply H2; injection H3; auto. -intros n; split; intros; try discriminate. +intros n; split; intros H; try discriminate. case n; injection H; auto. Qed. diff --git a/theories/Vectors/Fin.v b/theories/Vectors/Fin.v index 18e286b943..45fcbfb329 100644 --- a/theories/Vectors/Fin.v +++ b/theories/Vectors/Fin.v @@ -111,7 +111,7 @@ Qed. Lemma of_nat_to_nat_inv {m} (p : t m) : of_nat_lt (proj2_sig (to_nat p)) = p. Proof. -induction p; simpl. +induction p as [|? p]; simpl. - reflexivity. - destruct (to_nat p); simpl in *. f_equal. subst p. apply of_nat_ext. Qed. @@ -119,7 +119,7 @@ Qed. Lemma to_nat_of_nat {p}{n} (h : p < n) : to_nat (of_nat_lt h) = exist _ p h. Proof. revert n h. - induction p; (destruct n ; intros h; [ destruct (Lt.lt_n_O _ h) | cbn]); + induction p as [|p IHp]; (intro n; destruct n as [|n]; intros h; [ destruct (Lt.lt_n_O _ h) | cbn]); [ | rewrite (IHp _ (Lt.lt_S_n p n h))]; f_equal; apply Peano_dec.le_unique. Qed. @@ -153,7 +153,7 @@ Fixpoint L {m} n (p : t m) : t (m + n) := Lemma L_sanity {m} n (p : t m) : proj1_sig (to_nat (L n p)) = proj1_sig (to_nat p). Proof. -induction p. +induction p as [|? p IHp]. - reflexivity. - simpl; destruct (to_nat (L n p)); simpl in *; rewrite IHp. now destruct (to_nat p). Qed. @@ -163,7 +163,7 @@ Qed. Really really inefficient !!! *) Definition L_R {m} n (p : t m) : t (n + m). Proof. -induction n. +induction n as [|n IHn]. - exact p. - exact ((fix LS k (p: t k) := match p with @@ -179,7 +179,7 @@ Fixpoint R {m} n (p : t m) : t (n + m) := Lemma R_sanity {m} n (p : t m) : proj1_sig (to_nat (R n p)) = n + proj1_sig (to_nat p). Proof. -induction n. +induction n as [|n IHn]. - reflexivity. - simpl; destruct (to_nat (R n p)); simpl in *; rewrite IHn. now destruct (to_nat p). Qed. @@ -193,7 +193,7 @@ end. Lemma depair_sanity {m n} (o : t m) (p : t n) : proj1_sig (to_nat (depair o p)) = n * (proj1_sig (to_nat o)) + (proj1_sig (to_nat p)). Proof. -induction o ; simpl. +induction o as [|? o IHo] ; simpl. - rewrite L_sanity. now rewrite Mult.mult_0_r. - rewrite R_sanity. rewrite IHo. @@ -211,7 +211,8 @@ end. Lemma eqb_nat_eq : forall m n (p : t m) (q : t n), eqb p q = true -> m = n. Proof. -intros m n p; revert n; induction p; destruct q; simpl; intros; f_equal. +intros m n p; revert n; induction p as [|? p IHp]; + intros ? q; destruct q; simpl; intros; f_equal. - now apply EqNat.beq_nat_true. - easy. - easy. diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v index 57241e5f42..a154a2b269 100644 --- a/theories/Vectors/VectorDef.v +++ b/theories/Vectors/VectorDef.v @@ -167,7 +167,7 @@ Fixpoint take {A} {n} (p:nat) (le:p <= n) (v:t A n) : t A p := Lemma trunc : forall {A} {n} (p:nat), n > p -> t A n -> t A (n - p). Proof. - induction p as [| p f]; intros H v. + intros A n p; induction p as [| p f]; intros H v. rewrite <- minus_n_O. exact v. diff --git a/theories/Vectors/VectorEq.v b/theories/Vectors/VectorEq.v index 6bd2c30205..c36917aa90 100644 --- a/theories/Vectors/VectorEq.v +++ b/theories/Vectors/VectorEq.v @@ -36,7 +36,7 @@ Section BEQ. (Hbeq: eqb v1 v2 = true), m = n. Proof. intros m n v1; revert n. - induction v1; destruct v2; + induction v1; intros ? v2; destruct v2; [now constructor | discriminate | discriminate | simpl]. intros Hbeq; apply andb_prop in Hbeq; destruct Hbeq. f_equal; eauto. diff --git a/theories/Vectors/VectorSpec.v b/theories/Vectors/VectorSpec.v index 443931e5bb..10545332bb 100644 --- a/theories/Vectors/VectorSpec.v +++ b/theories/Vectors/VectorSpec.v @@ -26,7 +26,7 @@ Definition cons_inj {A} {a1 a2} {n} {v1 v2 : t A n} Lemma eta {A} {n} (v : t A (S n)) : v = hd v :: tl v. Proof. -intros; apply caseS with (v:=v); intros; reflexivity. +intros; apply (fun P IS => caseS P IS (n := n) v); intros; reflexivity. Defined. (** Lemmas are done for functions that use [Fin.t] but thanks to [Peano_dec.le_unique], all @@ -38,9 +38,9 @@ Lemma eq_nth_iff A n (v1 v2: t A n): (forall p1 p2, p1 = p2 -> v1 [@ p1 ] = v2 [@ p2 ]) <-> v1 = v2. Proof. split. -- revert n v1 v2; refine (@rect2 _ _ _ _ _); simpl; intros. +- revert n v1 v2; refine (@rect2 _ _ _ _ _); simpl. + reflexivity. - + f_equal. apply (H0 Fin.F1 Fin.F1 eq_refl). + + intros n ? ? H ? ? H0. f_equal. apply (H0 Fin.F1 Fin.F1 eq_refl). apply H. intros p1 p2 H1; apply (H0 (Fin.FS p1) (Fin.FS p2) (f_equal (@Fin.FS n) H1)). - intros; now f_equal. @@ -48,12 +48,12 @@ 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. +Proof. intros n v H; 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. +intros n; induction n; intros k v H HS. - inversion H. - rewrite (eta v). unfold nth_order; simpl. @@ -69,7 +69,7 @@ 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. +intros n k v H1 H2; unfold nth_order. now rewrite (Fin.of_nat_ext H1 H2). Qed. @@ -78,7 +78,7 @@ Qed. 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. -subst k2; induction k1. +subst k2; induction k1 as [n|n k1]. - generalize dependent n. apply caseS ; intros. now simpl. - generalize dependent n. refine (@caseS _ _ _) ; intros. now simpl. Qed. @@ -92,14 +92,14 @@ Lemma shiftrepeat_nth A: forall n k (v: t A (S n)), nth (shiftrepeat v) (Fin.L_R 1 k) = nth v k. Proof. refine (@Fin.rectS _ _ _); lazy beta; [ intros n v | intros n p H v ]. -- revert n v; refine (@caseS _ _ _); simpl; intros. now destruct t. +- revert n v; refine (@caseS _ _ _); simpl; intros ? ? t. now destruct t. - revert p H. refine (match v as v' in t _ m return match m as m' return t A m' -> Prop with |S (S n) => fun v => forall p : Fin.t (S n), (forall v0 : t A (S n), (shiftrepeat v0) [@ Fin.L_R 1 p ] = v0 [@p]) -> (shiftrepeat v) [@Fin.L_R 1 (Fin.FS p)] = v [@Fin.FS p] |_ => fun _ => True end v' with - |[] => I |h :: t => _ end). destruct n0. exact I. now simpl. + |[] => I | cons _ h n t => _ end). destruct n. exact I. now simpl. Qed. Lemma shiftrepeat_last A: forall n (v: t A (S n)), last (shiftrepeat v) = last v. @@ -112,7 +112,7 @@ Qed. 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; +intros n k; revert n; induction k as [|k IHk]; intros n v a H1 H2; (destruct n; [ inversion H1 | subst ]). - now rewrite nth_order_hd, (eta v). - rewrite <- (nth_order_tl _ _ _ _ (proj2 (Nat.succ_lt_mono _ _) H1)), (eta v). @@ -123,7 +123,7 @@ 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; +intros n k1; revert n; induction k1 as [|k1 IHk1]; intros n k2 H v a H1 H2; (destruct n ; [ inversion H1 | subst ]). - rewrite 2 nth_order_hd. destruct k2; intuition. @@ -137,15 +137,15 @@ 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. +intros n p; induction p as [|? p IHp]; intros v; 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. +intros n p v a b. +induction p as [|? p IHp]; rewrite 2 (eta v); simpl; auto. now rewrite IHp. Qed. @@ -161,7 +161,7 @@ apply (Fin.rect2 (fun n p1 p2 => forall v a b, - 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; + refine (@rectS _ _ _ _); simpl; intro n; [| do 3 intro]; intros ? ? IH p1 p2; intro Hneq; f_equal; apply IH; intros Heq; apply Hneq; now subst. Qed. @@ -177,19 +177,19 @@ Qed. Lemma map_id A: forall n (v : t A n), map (fun x => x) v = v. Proof. -induction v; simpl; [ | rewrite IHv ]; auto. +intros n v; induction v as [|? ? v IHv]; 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. +intros f g n v; induction v as [|? ? v IHv]; 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 f g n v H; induction v as [|? ? v IHv]; simpl; auto. intros; rewrite H by constructor; rewrite IHv; intuition. apply H; now constructor. Qed. @@ -203,7 +203,7 @@ 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. -subst p2; induction p1. +subst p2; induction p1 as [n|n p1 IHp1]. - revert n v; refine (@caseS _ _ _); now simpl. - revert n v p1 IHp1; refine (@caseS _ _ _); now simpl. Qed. @@ -225,10 +225,10 @@ Lemma fold_left_right_assoc_eq {A B} {f: A -> B -> A} {n} (v: t B n): forall a, fold_left f a v = fold_right (fun x y => f y x) v a. Proof. assert (forall n h (v: t B n) a, fold_left f (f a h) v = f (fold_left f a v) h). -- induction v0. +- intros n0 h v0; induction v0 as [|? ? v0 IHv0]. + now simpl. + intros; simpl. rewrite<- IHv0, assoc. now f_equal. -- induction v. +- induction v as [|? ? v IHv]. + reflexivity. + simpl. intros; now rewrite<- (IHv). Qed. @@ -245,31 +245,31 @@ Qed. (** ** Properties of [take] *) Lemma take_O : forall {A} {n} le (v:t A n), take 0 le v = []. -Proof. +Proof. reflexivity. -Qed. +Qed. Lemma take_idem : forall {A} p n (v:t A n) le le', take p le' (take p le v) = take p le v. -Proof. - induction p; intros n v le le'. - - auto. - - destruct v. inversion le. simpl. apply f_equal. apply IHp. +Proof. + intros A p; induction p as [|p IHp]; intros n v le le'. + - auto. + - destruct v. inversion le. simpl. apply f_equal. apply IHp. Qed. Lemma take_app : forall {A} {n} (v:t A n) {m} (w:t A m) le, take n le (append v w) = v. -Proof. - induction v; intros m w le. - - reflexivity. - - simpl. apply f_equal. apply IHv. +Proof. + intros a n v; induction v as [|? ? v IHv]; intros m w le. + - reflexivity. + - simpl. apply f_equal. apply IHv. Qed. (* Proof is irrelevant for [take] *) Lemma take_prf_irr : forall {A} p {n} (v:t A n) le le', take p le v = take p le' v. -Proof. - induction p; intros n v le le'. - - reflexivity. - - destruct v. inversion le. simpl. apply f_equal. apply IHp. +Proof. + intros A p; induction p as [|p IHp]; intros n v le le'. + - reflexivity. + - destruct v. inversion le. simpl. apply f_equal. apply IHp. Qed. (** ** Properties of [uncons] and [splitat] *) @@ -289,7 +289,7 @@ Lemma splitat_append {A} : forall {n m : nat} (v : t A n) (w : t A m), Proof with simpl; auto. intros n m v. generalize dependent m. - induction v; intros... + induction v as [|? ? v IHv]; intros... rewrite IHv... Qed. @@ -299,10 +299,10 @@ Lemma append_splitat {A} : forall {n m : nat} (v : t A n) (w : t A m) (vw : t A Proof with auto. intros n m v. generalize dependent m. - induction v; intros; inversion H... + induction v as [|a n v IHv]; intros m w vw H; inversion H as [H1]... destruct (splitat n (tl vw)) as [v' w'] eqn:Heq. apply pair_equal_spec in H1. - destruct H1; subst. + destruct H1 as [H0]; subst. rewrite <- append_comm_cons. rewrite (eta vw). apply cons_inj in H0. @@ -316,7 +316,7 @@ Qed. 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]]; +intros P Q H n v; induction v; intros HP; constructor; inversion HP as [| ? ? ? ? ? Heq1 [Heq2 He]]; apply (inj_pair2_eq_dec _ Nat.eq_dec) in He; subst; intuition. Qed. @@ -328,7 +328,7 @@ intros P n v; split. 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. +- induction v as [|? ? v IHv]; intros Hin; constructor. + apply Hin; constructor. + apply IHv; intros a Ha. apply Hin; now constructor. @@ -337,7 +337,7 @@ 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 P n v; split; induction n as [|n IHn]. - intros HF i Hi; inversion Hi. - intros HF i Hi. rewrite (eta v). @@ -354,7 +354,7 @@ split; induction n. rewrite (eta v); constructor. + specialize HP with 0 (Nat.lt_0_succ n). now rewrite nth_order_hd in HP. - + apply IHn; intros. + + apply IHn; intros i Hi. specialize HP with (S i) (proj1 (Nat.succ_lt_mono _ _) Hi). now rewrite <- (nth_order_tl _ _ _ _ Hi) in HP. Qed. @@ -363,7 +363,7 @@ 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 P n v1 v2; split; induction n as [|n IHn]. - intros HF i Hi1 Hi2; inversion Hi1. - intros HF i Hi1 Hi2. rewrite (eta v1), (eta v2). @@ -382,7 +382,7 @@ split; induction n. 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. + + apply IHn; intros i Hi1 Hi2. 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. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 9a30e011af..52998c8b95 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -126,7 +126,7 @@ Lemma pos_sub_spec p q : | Gt => pos (p - q) end. Proof. - revert q. induction p; destruct q; simpl; trivial; + revert q. induction p as [p IHp|p IHp|]; intros q; destruct q; simpl; trivial; rewrite ?Pos.compare_xI_xI, ?Pos.compare_xO_xI, ?Pos.compare_xI_xO, ?Pos.compare_xO_xO, IHp; simpl; case Pos.compare_spec; intros; simpl; trivial; @@ -168,7 +168,7 @@ Qed. Lemma pos_sub_opp p q : - pos_sub p q = pos_sub q p. Proof. - revert q; induction p; destruct q; simpl; trivial; + revert q; induction p as [p IHp|p IHp|]; intros q; destruct q; simpl; trivial; rewrite <- IHp; now destruct pos_sub. Qed. @@ -468,13 +468,13 @@ Lemma peano_ind (P : Z -> Prop) : (forall x, P x -> P (pred x)) -> forall z, P z. Proof. - intros H0 Hs Hp z; destruct z. + intros H0 Hs Hp z; destruct z as [|p|p]. assumption. - induction p using Pos.peano_ind. + induction p as [|p IHp] using Pos.peano_ind. now apply (Hs 0). rewrite <- Pos.add_1_r. now apply (Hs (pos p)). - induction p using Pos.peano_ind. + induction p as [|p IHp] using Pos.peano_ind. now apply (Hp 0). rewrite <- Pos.add_1_r. now apply (Hp (neg p)). @@ -486,7 +486,7 @@ Lemma bi_induction (P : Z -> Prop) : (forall x, P x <-> P (succ x)) -> forall z, P z. Proof. - intros _ H0 Hs. induction z using peano_ind. + intros _ H0 Hs z. induction z using peano_ind. assumption. now apply -> Hs. apply Hs. now rewrite succ_pred. @@ -569,7 +569,7 @@ Qed. Lemma sqrtrem_spec n : 0<=n -> let (s,r) := sqrtrem n in n = s*s + r /\ 0 <= r <= 2*s. Proof. - destruct n. now repeat split. + destruct n as [|p|p]. now repeat split. generalize (Pos.sqrtrem_spec p). simpl. destruct 1; simpl; subst; now repeat split. now destruct 1. @@ -578,7 +578,7 @@ Qed. Lemma sqrt_spec n : 0<=n -> let s := sqrt n in s*s <= n < (succ s)*(succ s). Proof. - destruct n. now repeat split. unfold sqrt. + destruct n as [|p|p]. now repeat split. unfold sqrt. intros _. simpl succ. rewrite Pos.add_1_r. apply (Pos.sqrt_spec p). now destruct 1. Qed. @@ -590,7 +590,7 @@ Qed. Lemma sqrtrem_sqrt n : fst (sqrtrem n) = sqrt n. Proof. - destruct n; try reflexivity. + destruct n as [|p|p]; try reflexivity. unfold sqrtrem, sqrt, Pos.sqrt. destruct (Pos.sqrtrem p) as (s,r). now destruct r. Qed. @@ -655,7 +655,7 @@ Lemma pos_div_eucl_eq a b : 0 < b -> let (q, r) := pos_div_eucl a b in pos a = q * b + r. Proof. intros Hb. - induction a; unfold pos_div_eucl; fold pos_div_eucl. + induction a as [a IHa|a IHa|]; unfold pos_div_eucl; fold pos_div_eucl. - (* ~1 *) destruct pos_div_eucl as (q,r). change (pos a~1) with (2*(pos a)+1). @@ -720,7 +720,7 @@ Proof. now rewrite Pos.add_diag. intros Hb. destruct b as [|b|b]; discriminate Hb || clear Hb. - induction a; unfold pos_div_eucl; fold pos_div_eucl. + induction a as [a IHa|a IHa|]; unfold pos_div_eucl; fold pos_div_eucl. (* ~1 *) destruct pos_div_eucl as (q,r). simpl in IHa; destruct IHa as (Hr,Hr'). @@ -996,7 +996,7 @@ Proof. intros Hn Hm. unfold shiftr. destruct n as [ |n|n]; (now destruct Hn) || clear Hn; simpl. now rewrite add_0_r. - assert (forall p, to_N (m + pos p) = (to_N m + N.pos p)%N). + assert (forall p, to_N (m + pos p) = (to_N m + N.pos p)%N) as H. destruct m; trivial; now destruct Hm. assert (forall p, 0 <= m + pos p). destruct m; easy || now destruct Hm. @@ -1054,7 +1054,7 @@ Proof. subst. now rewrite N.sub_diag. simpl. destruct (Pos.sub_mask_pos' m n H') as (p & -> & <-). f_equal. now rewrite Pos.add_comm, Pos.add_sub. - destruct a; unfold shiftl. + destruct a as [|p|p]; unfold shiftl. (* ... a = 0 *) replace (Pos.iter (mul 2) 0 n) with 0 by (apply Pos.iter_invariant; intros; subst; trivial). diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v index 69ed101f24..58bc75b62c 100644 --- a/theories/ZArith/BinIntDef.v +++ b/theories/ZArith/BinIntDef.v @@ -311,10 +311,10 @@ Definition of_uint (d:Decimal.uint) := of_N (Pos.of_uint d). Definition of_hex_uint (d:Hexadecimal.uint) := of_N (Pos.of_hex_uint d). -Definition of_num_uint (d:Numeral.uint) := +Definition of_num_uint (d:Number.uint) := match d with - | Numeral.UIntDec d => of_uint d - | Numeral.UIntHex d => of_hex_uint d + | Number.UIntDecimal d => of_uint d + | Number.UIntHexadecimal d => of_hex_uint d end. Definition of_int (d:Decimal.int) := @@ -329,10 +329,10 @@ Definition of_hex_int (d:Hexadecimal.int) := | Hexadecimal.Neg d => opp (of_hex_uint d) end. -Definition of_num_int (d:Numeral.int) := +Definition of_num_int (d:Number.int) := match d with - | Numeral.IntDec d => of_int d - | Numeral.IntHex d => of_hex_int d + | Number.IntDecimal d => of_int d + | Number.IntHexadecimal d => of_hex_int d end. Definition to_int n := @@ -349,7 +349,7 @@ Definition to_hex_int n := | neg p => Hexadecimal.Neg (Pos.to_hex_uint p) end. -Definition to_num_int n := Numeral.IntDec (to_int n). +Definition to_num_int n := Number.IntDecimal (to_int n). (** ** Iteration of a function diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v index 62fccf3ce2..9fa05dd2f7 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -67,7 +67,7 @@ Lemma natlike_ind : forall x:Z, 0 <= x -> P x. Proof. intros P Ho Hrec x Hx; apply Z_of_nat_prop; trivial. - induction n. exact Ho. + intros n; induction n. exact Ho. rewrite Nat2Z.inj_succ. apply Hrec; trivial using Nat2Z.is_nonneg. Qed. @@ -78,7 +78,7 @@ Lemma natlike_rec : forall x:Z, 0 <= x -> P x. Proof. intros P Ho Hrec x Hx; apply Z_of_nat_set; trivial. - induction n. exact Ho. + intros n; induction n. exact Ho. rewrite Nat2Z.inj_succ. apply Hrec; trivial using Nat2Z.is_nonneg. Qed. @@ -101,9 +101,9 @@ Section Efficient_Rec. (forall z:Z, 0 <= z -> P z -> P (Z.succ z)) -> forall z:Z, 0 <= z -> P z. Proof. - intros P Ho Hrec. + intros P Ho Hrec z. induction z as [z IH] using (well_founded_induction_type R_wf). - destruct z; intros Hz. + destruct z as [|p|p]; intros Hz. - apply Ho. - set (y:=Z.pred (Zpos p)). assert (LE : 0 <= y) by (unfold y; now apply Z.lt_le_pred). @@ -121,9 +121,9 @@ Section Efficient_Rec. (forall z:Z, 0 < z -> P (Z.pred z) -> P z) -> forall z:Z, 0 <= z -> P z. Proof. - intros P Ho Hrec. + intros P Ho Hrec z. induction z as [z IH] using (well_founded_induction_type R_wf). - destruct z; intros Hz. + destruct z as [|p|p]; intros Hz. - apply Ho. - assert (EQ : 0 <= Z.pred (Zpos p)) by now apply Z.lt_le_pred. apply Hrec. easy. apply IH; trivial. split; trivial. @@ -138,7 +138,7 @@ Section Efficient_Rec. (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) -> forall x:Z, 0 <= x -> P x. Proof. - intros P Hrec. + intros P Hrec x. induction x as [x IH] using (well_founded_induction_type R_wf). destruct x; intros Hx. - apply Hrec; trivial. intros y (Hy,Hy'). @@ -196,7 +196,7 @@ Section Efficient_Rec. (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) -> forall x:Z, z <= x -> P x. Proof. - intros; now apply Zlt_lower_bound_rec with z. + intros P z ? x ?; now apply Zlt_lower_bound_rec with z. Qed. End Efficient_Rec. diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index 834f16cd9e..dc40f9ea51 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -19,7 +19,7 @@ Local Open Scope Z_scope. (* Trivial, to deprecate? *) Lemma Dcompare_inf : forall r:comparison, {r = Eq} + {r = Lt} + {r = Gt}. Proof. - induction r; auto. + intros r; induction r; auto. Defined. (* end hide *) @@ -92,7 +92,7 @@ Section decidability. Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}. Proof. intro H. - apply Zcompare_rec with (n := x) (m := y). + apply (Zcompare_rec _ x y). intro. right. elim (Z.compare_eq_iff x y); auto with arith. intro. left. elim (Z.compare_eq_iff x y); auto with arith. intro H1. absurd (x > y); auto with arith. @@ -111,7 +111,7 @@ Proof. assumption. intro. right. - apply Z.le_lt_trans with (m := x). + apply (Z.le_lt_trans _ x). apply Z.ge_le. assumption. assumption. @@ -123,14 +123,14 @@ Proof. case (Zlt_cotrans 0 (x + y) H x). - now left. - right. - apply Z.add_lt_mono_l with (p := x). + apply (Z.add_lt_mono_l _ _ x). now rewrite Z.add_0_r. Defined. Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}. Proof. intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy; - [ right; apply Z.add_lt_mono_l with (p := x); rewrite Z.add_0_r | left ]; + [ right; apply (Z.add_lt_mono_l _ _ x); rewrite Z.add_0_r | left ]; assumption. Defined. @@ -143,7 +143,7 @@ Proof. assumption. intro H0. generalize (Z.ge_le _ _ H0). - intro. + intro H1. case (Z_le_lt_eq_dec _ _ H1). intro. right. diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index 21086d9b61..f869e15023 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -49,12 +49,12 @@ Qed. Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Z.abs n). Proof. - now destruct n. + intros P n; now destruct n. Qed. Definition Zabs_dec : forall x:Z, {x = Z.abs x} + {x = - Z.abs x}. Proof. - destruct x; auto. + intros x; destruct x; auto. Defined. Lemma Zabs_spec x : diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index c9e1b340a6..c848623d06 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -13,7 +13,6 @@ Require Import ZArith_base. Require Import Wf_nat. Local Open Scope Z_scope. - (**********************************************************************) (** About parity *) @@ -39,7 +38,7 @@ Proof. reflexivity. Qed. Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. Proof. - unfold floor. induction p as [p [IH1p IH2p]|p [IH1p IH2]|]; simpl. + unfold floor. intros p; induction p as [p [IH1p IH2p]|p [IH1p IH2]|]; simpl. - rewrite !Pos2Z.inj_xI, (Pos2Z.inj_xO (xO _)), Pos2Z.inj_xO. split. + apply Z.le_trans with (2 * Z.pos p); auto with zarith. @@ -69,10 +68,10 @@ Proof. apply (Z_lt_rec Q); auto with zarith. subst Q; intros x H. split; apply HP. - - rewrite Z.abs_eq; auto; intros. + - rewrite Z.abs_eq; auto; intros m ?. destruct (H (Z.abs m)); auto with zarith. destruct (Zabs_dec m) as [-> | ->]; trivial. - - rewrite Z.abs_neq, Z.opp_involutive; intros. + - rewrite Z.abs_neq, Z.opp_involutive; [intros m ?|]. + destruct (H (Z.abs m)); auto with zarith. destruct (Zabs_dec m) as [-> | ->]; trivial. + apply Z.opp_le_mono; rewrite Z.opp_involutive; auto. @@ -85,15 +84,15 @@ Theorem Z_lt_abs_induction : Proof. intros P HP p. set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *. - enough (Q (Z.abs p)) by + enough (Q (Z.abs p)) as H by (destruct (Zabs_dec p) as [-> | ->]; elim H; auto with zarith). apply (Z_lt_induction Q); auto with zarith. - subst Q; intros. + subst Q; intros ? H. split; apply HP. - - rewrite Z.abs_eq; auto; intros. + - rewrite Z.abs_eq; auto; intros m ?. elim (H (Z.abs m)); intros; auto with zarith. elim (Zabs_dec m); intro eq; rewrite eq; trivial. - - rewrite Z.abs_neq, Z.opp_involutive; intros. + - rewrite Z.abs_neq, Z.opp_involutive; [intros m ?|]. + destruct (H (Z.abs m)); auto with zarith. destruct (Zabs_dec m) as [-> | ->]; trivial. + apply Z.opp_le_mono; rewrite Z.opp_involutive; auto. @@ -136,7 +135,7 @@ Section Zlength_properties. Lemma Zlength_correct l : Zlength l = Z.of_nat (length l). Proof. assert (H : forall l acc, Zlength_aux acc A l = acc + Z.of_nat (length l)). - clear l. induction l. + clear l. intros l; induction l as [|? ? IHl]. auto with zarith. intros. simpl length; simpl Zlength_aux. rewrite IHl, Nat2Z.inj_succ, Z.add_succ_comm; auto. diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index b6fbe64499..2039dc0bee 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -174,22 +174,22 @@ Proof. intros; eapply Zmod_unique_full; eauto. Qed. Lemma Zmod_0_l: forall a, 0 mod a = 0. Proof. - destruct a; simpl; auto. + intros a; destruct a; simpl; auto. Qed. Lemma Zmod_0_r: forall a, a mod 0 = 0. Proof. - destruct a; simpl; auto. + intros a; destruct a; simpl; auto. Qed. Lemma Zdiv_0_l: forall a, 0/a = 0. Proof. - destruct a; simpl; auto. + intros a; destruct a; simpl; auto. Qed. Lemma Zdiv_0_r: forall a, a/0 = 0. Proof. - destruct a; simpl; auto. + intros a; destruct a; simpl; auto. Qed. Ltac zero_or_not a := @@ -198,10 +198,10 @@ Ltac zero_or_not a := auto with zarith|]. Lemma Zmod_1_r: forall a, a mod 1 = 0. -Proof. intros. zero_or_not a. apply Z.mod_1_r. Qed. +Proof. intros a. zero_or_not a. apply Z.mod_1_r. Qed. Lemma Zdiv_1_r: forall a, a/1 = a. -Proof. intros. zero_or_not a. apply Z.div_1_r. Qed. +Proof. intros a. zero_or_not a. apply Z.div_1_r. Qed. Hint Resolve Zmod_0_l Zmod_0_r Zdiv_0_l Zdiv_0_r Zdiv_1_r Zmod_1_r : zarith. @@ -216,10 +216,10 @@ Lemma Z_div_same_full : forall a:Z, a<>0 -> a/a = 1. Proof Z.div_same. Lemma Z_mod_same_full : forall a, a mod a = 0. -Proof. intros. zero_or_not a. apply Z.mod_same; auto. Qed. +Proof. intros a. zero_or_not a. apply Z.mod_same; auto. Qed. Lemma Z_mod_mult : forall a b, (a*b) mod b = 0. -Proof. intros. zero_or_not b. apply Z.mod_mul. auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.mod_mul. auto. Qed. Lemma Z_div_mult_full : forall a b:Z, b <> 0 -> (a*b)/b = a. Proof Z.div_mul. @@ -313,7 +313,7 @@ Proof. intros; apply Z.div_le_compat_l; intuition auto using Z.lt_le_incl. Qed. Theorem Zdiv_sgn: forall a b, 0 <= Z.sgn (a/b) * Z.sgn a * Z.sgn b. Proof. - destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; + intros a b; destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; generalize (Z.div_pos (Zpos a) (Zpos b)); unfold Z.div, Z.div_eucl; destruct Z.pos_div_eucl as (q,r); destruct r; rewrite ?Z.mul_1_r, <-?Z.opp_eq_mul_m1, ?Z.sgn_opp, ?Z.opp_involutive; @@ -325,7 +325,7 @@ Qed. (** * Relations between usual operations and Z.modulo and Z.div *) Lemma Z_mod_plus_full : forall a b c:Z, (a + b * c) mod c = a mod c. -Proof. intros. zero_or_not c. apply Z.mod_add; auto. Qed. +Proof. intros a b c. zero_or_not c. apply Z.mod_add; auto. Qed. Lemma Z_div_plus_full : forall a b c:Z, c <> 0 -> (a + b * c) / c = a / c + b. Proof Z.div_add. @@ -338,34 +338,34 @@ Proof Z.div_add_l. some of the relations about [Z.opp] and divisions are rather complex. *) Lemma Zdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b. -Proof. intros. zero_or_not b. apply Z.div_opp_opp; auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.div_opp_opp; auto. Qed. Lemma Zmod_opp_opp : forall a b:Z, (-a) mod (-b) = - (a mod b). -Proof. intros. zero_or_not b. apply Z.mod_opp_opp; auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.mod_opp_opp; auto. Qed. Lemma Z_mod_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a) mod b = 0. -Proof. intros. zero_or_not b. apply Z.mod_opp_l_z; auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.mod_opp_l_z; auto. Qed. Lemma Z_mod_nz_opp_full : forall a b:Z, a mod b <> 0 -> (-a) mod b = b - (a mod b). -Proof. intros. zero_or_not b. apply Z.mod_opp_l_nz; auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.mod_opp_l_nz; auto. Qed. Lemma Z_mod_zero_opp_r : forall a b:Z, a mod b = 0 -> a mod (-b) = 0. -Proof. intros. zero_or_not b. apply Z.mod_opp_r_z; auto. Qed. +Proof. intros a b. zero_or_not b. apply Z.mod_opp_r_z; auto. Qed. Lemma Z_mod_nz_opp_r : forall a b:Z, a mod b <> 0 -> a mod (-b) = (a mod b) - b. -Proof. intros. zero_or_not b. apply Z.mod_opp_r_nz; auto. Qed. +Proof. intros a b ?. zero_or_not b. apply Z.mod_opp_r_nz; auto. Qed. Lemma Z_div_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a)/b = -(a/b). -Proof. intros. zero_or_not b. apply Z.div_opp_l_z; auto. Qed. +Proof. intros a b ?. zero_or_not b. apply Z.div_opp_l_z; auto. Qed. Lemma Z_div_nz_opp_full : forall a b:Z, a mod b <> 0 -> (-a)/b = -(a/b)-1. Proof. intros a b. zero_or_not b. easy. intros; rewrite Z.div_opp_l_nz; auto. Qed. Lemma Z_div_zero_opp_r : forall a b:Z, a mod b = 0 -> a/(-b) = -(a/b). -Proof. intros. zero_or_not b. apply Z.div_opp_r_z; auto. Qed. +Proof. intros a b ?. zero_or_not b. apply Z.div_opp_r_z; auto. Qed. Lemma Z_div_nz_opp_r : forall a b:Z, a mod b <> 0 -> a/(-b) = -(a/b)-1. @@ -375,19 +375,19 @@ Proof. intros a b. zero_or_not b. easy. intros; rewrite Z.div_opp_r_nz; auto. Qe Lemma Zdiv_mult_cancel_r : forall a b c:Z, c <> 0 -> (a*c)/(b*c) = a/b. -Proof. intros. zero_or_not b. apply Z.div_mul_cancel_r; auto. Qed. +Proof. intros a b c ?. zero_or_not b. apply Z.div_mul_cancel_r; auto. Qed. Lemma Zdiv_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)/(c*b) = a/b. Proof. - intros. rewrite (Z.mul_comm c b); zero_or_not b. + intros a b c ?. rewrite (Z.mul_comm c b); zero_or_not b. rewrite (Z.mul_comm b c). apply Z.div_mul_cancel_l; auto. Qed. Lemma Zmult_mod_distr_l: forall a b c, (c*a) mod (c*b) = c * (a mod b). Proof. - intros. zero_or_not c. rewrite (Z.mul_comm c b); zero_or_not b. + intros a b c. zero_or_not c. rewrite (Z.mul_comm c b); zero_or_not b. + now rewrite Z.mul_0_r. + rewrite (Z.mul_comm b c). apply Z.mul_mod_distr_l; auto. Qed. @@ -395,7 +395,7 @@ Qed. Lemma Zmult_mod_distr_r: forall a b c, (a*c) mod (b*c) = (a mod b) * c. Proof. - intros. zero_or_not b. rewrite (Z.mul_comm b c); zero_or_not c. + intros a b c. zero_or_not b. rewrite (Z.mul_comm b c); zero_or_not c. + now rewrite Z.mul_0_r. + rewrite (Z.mul_comm c b). apply Z.mul_mod_distr_r; auto. Qed. @@ -403,27 +403,27 @@ Qed. (** Operations modulo. *) Theorem Zmod_mod: forall a n, (a mod n) mod n = a mod n. -Proof. intros. zero_or_not n. apply Z.mod_mod; auto. Qed. +Proof. intros a n. zero_or_not n. apply Z.mod_mod; auto. Qed. Theorem Zmult_mod: forall a b n, (a * b) mod n = ((a mod n) * (b mod n)) mod n. -Proof. intros. zero_or_not n. apply Z.mul_mod; auto. Qed. +Proof. intros a b n. zero_or_not n. apply Z.mul_mod; auto. Qed. Theorem Zplus_mod: forall a b n, (a + b) mod n = (a mod n + b mod n) mod n. -Proof. intros. zero_or_not n. apply Z.add_mod; auto. Qed. +Proof. intros a b n. zero_or_not n. apply Z.add_mod; auto. Qed. Theorem Zminus_mod: forall a b n, (a - b) mod n = (a mod n - b mod n) mod n. Proof. - intros. + intros a b n. replace (a - b) with (a + (-1) * b); auto with zarith. replace (a mod n - b mod n) with (a mod n + (-1) * (b mod n)); auto with zarith. rewrite Zplus_mod. rewrite Zmult_mod. - rewrite Zplus_mod with (b:=(-1) * (b mod n)). + rewrite (Zplus_mod _ ((-1) * (b mod n))). rewrite Zmult_mod. - rewrite Zmult_mod with (b:= b mod n). + rewrite (Zmult_mod _ (b mod n)). repeat rewrite Zmod_mod; auto. Qed. @@ -483,17 +483,20 @@ Qed. Instance Zplus_eqm : Proper (eqm ==> eqm ==> eqm) Z.add. Proof. - unfold eqm; repeat red; intros. rewrite Zplus_mod, H, H0, <- Zplus_mod; auto. + unfold eqm; repeat red; intros ? ? H ? ? H0. + rewrite Zplus_mod, H, H0, <- Zplus_mod; auto. Qed. Instance Zminus_eqm : Proper (eqm ==> eqm ==> eqm) Z.sub. Proof. - unfold eqm; repeat red; intros. rewrite Zminus_mod, H, H0, <- Zminus_mod; auto. + unfold eqm; repeat red; intros ? ? H ? ? H0. + rewrite Zminus_mod, H, H0, <- Zminus_mod; auto. Qed. Instance Zmult_eqm : Proper (eqm ==> eqm ==> eqm) Z.mul. Proof. - unfold eqm; repeat red; intros. rewrite Zmult_mod, H, H0, <- Zmult_mod; auto. + unfold eqm; repeat red; intros ? ? H ? ? H0. + rewrite Zmult_mod, H, H0, <- Zmult_mod; auto. Qed. Instance Zopp_eqm : Proper (eqm ==> eqm) Z.opp. @@ -503,7 +506,7 @@ Qed. Lemma Zmod_eqm : forall a, (a mod N) == a. Proof. - intros; exact (Zmod_mod a N). + intros a; exact (Zmod_mod a N). Qed. (* NB: Z.modulo and Z.div are not morphisms with respect to eqm. @@ -518,7 +521,7 @@ End EqualityModulo. Lemma Zdiv_Zdiv : forall a b c, 0<=b -> 0<=c -> (a/b)/c = a/(b*c). Proof. - intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c. + intros a b c ? ?. zero_or_not b. rewrite Z.mul_comm. zero_or_not c. rewrite Z.mul_comm. apply Z.div_div; auto. apply Z.le_neq; auto. Qed. @@ -538,7 +541,7 @@ Qed. Theorem Zdiv_mult_le: forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b. Proof. - intros. zero_or_not b. now rewrite Z.mul_0_r. + intros a b c ? ? ?. zero_or_not b. now rewrite Z.mul_0_r. apply Z.div_mul_le; auto. apply Z.le_neq; auto. Qed. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index 6a82645ba6..7f72d42d1f 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -50,7 +50,7 @@ Qed. Lemma N_nat_Z n : Z.of_nat (N.to_nat n) = Z.of_N n. Proof. - destruct n; trivial. simpl. + destruct n as [|p]; trivial. simpl. destruct (Pos2Nat.is_succ p) as (m,H). rewrite H. simpl. f_equal. now apply SuccNat2Pos.inv. Qed. @@ -668,7 +668,7 @@ Qed. Lemma inj_abs_nat z : Z.of_nat (Z.abs_nat z) = Z.abs z. Proof. - destruct z; simpl; trivial; + destruct z as [|p|p]; simpl; trivial; destruct (Pos2Nat.is_succ p) as (n,H); rewrite H; simpl; f_equal; now apply SuccNat2Pos.inv. Qed. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index 6ba58df721..cad9454906 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -256,15 +256,15 @@ Qed. Lemma Zis_gcd_for_euclid : forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d. Proof. - simple induction 1; constructor; intuition. + intros a b d q; simple induction 1; constructor; intuition. replace a with (a - q * b + q * b). auto with zarith. ring. Qed. Lemma Zis_gcd_for_euclid2 : forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d. Proof. - simple induction 1; constructor; intuition. - apply H2; auto. + intros b d q r; destruct 1 as [? ? H]; constructor; intuition. + apply H; auto. replace r with (b * q + r - b * q). auto with zarith. ring. Qed. @@ -300,9 +300,9 @@ Section extended_euclid_algorithm. Proof. intros v3 Hv3; generalize Hv3; pattern v3. apply Zlt_0_rec. - clear v3 Hv3; intros. + clear v3 Hv3; intros x H ? ? u1 u2 u3 v1 v2 H1 H2 H3. destruct (Z_zerop x) as [Heq|Hneq]. - apply Euclid_intro with (u := u1) (v := u2) (d := u3). + apply (Euclid_intro u1 u2 u3). assumption. apply H3. rewrite Heq; auto with zarith. @@ -333,12 +333,10 @@ Section extended_euclid_algorithm. Proof. case (Z_le_gt_dec 0 b); intro. intros; - apply euclid_rec with - (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b); + apply (fun H => euclid_rec b H 1 0 a 0 1); auto; ring. intros; - apply euclid_rec with - (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b); + apply (fun H => euclid_rec (- b) H 1 0 a 0 (-1)); auto; try ring. now apply Z.opp_nonneg_nonpos, Z.lt_le_incl, Z.gt_lt. auto with zarith. @@ -349,8 +347,8 @@ End extended_euclid_algorithm. Theorem Zis_gcd_uniqueness_apart_sign : forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'. Proof. - simple induction 1. - intros H1 H2 H3; simple induction 1; intros. + intros a b d d'; simple induction 1. + intros H1 H2 H3; destruct 1 as [H4 H5 H6]. generalize (H3 d' H4 H5); intro Hd'd. generalize (H6 d H1 H2); intro Hdd'. exact (Z.divide_antisym d d' Hdd' Hd'd). @@ -368,7 +366,7 @@ Proof. intros a b d Hgcd. elim (euclid a b); intros u v d0 e g. generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g). - intro H; elim H; clear H; intros. + intro H; elim H; clear H; intros H. apply Bezout_intro with u v. rewrite H; assumption. apply Bezout_intro with (- u) (- v). @@ -380,7 +378,7 @@ Qed. Lemma Zis_gcd_mult : forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d). Proof. - intros a b c d; simple induction 1. constructor; auto with zarith. + intros a b c d; intro H; generalize H; simple induction 1. constructor; auto with zarith. intros x Ha Hb. elim (Zis_gcd_bezout a b d H). intros u v Huv. elim Ha; intros a' Ha'. @@ -407,7 +405,7 @@ Qed. Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b. Proof. - simple induction 1; constructor; auto with zarith. + simple induction 1; intros ? ? H0; constructor; auto with zarith. intros. rewrite <- H0; auto with zarith. Qed. @@ -416,7 +414,7 @@ Qed. Theorem Gauss : forall a b c:Z, (a | b * c) -> rel_prime a b -> (a | c). Proof. - intros. elim (rel_prime_bezout a b H0); intros. + intros a b c H H0. elim (rel_prime_bezout a b H0); intros u v H1. replace c with (c * 1); [ idtac | ring ]. rewrite <- H1. replace (c * (u * a + v * b)) with (c * u * a + v * (b * c)); @@ -429,11 +427,11 @@ Lemma rel_prime_mult : forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c). Proof. intros a b c Hb Hc. - elim (rel_prime_bezout a b Hb); intros. - elim (rel_prime_bezout a c Hc); intros. + elim (rel_prime_bezout a b Hb); intros u v H. + elim (rel_prime_bezout a c Hc); intros u0 v0 H0. apply bezout_rel_prime. - apply Bezout_intro with - (u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0). + apply (Bezout_intro _ _ _ + (u * u0 * a + v0 * c * u + u0 * v * b) (v * v0)). rewrite <- H. replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ]. rewrite <- H0. @@ -447,7 +445,7 @@ Lemma rel_prime_cross_prod : Proof. intros a b c d; intros H H0 H1 H2 H3. elim (Z.divide_antisym b d). - - split; auto with zarith. + - intros H4; split; auto with zarith. rewrite H4 in H3. rewrite Z.mul_comm in H3. apply Z.mul_reg_l with d; auto. @@ -473,9 +471,9 @@ Lemma Zis_gcd_rel_prime : Proof. intros a b g; intros H H0 H1. assert (H2 : g <> 0) by - (intro; - elim H1; intros; - elim H4; intros; + (intro H2; + elim H1; intros ? H4 ?; + elim H4; intros ? H6; rewrite H2 in H6; subst b; contradict H; rewrite Z.mul_0_r; discriminate). assert (H3 : g > 0) by @@ -578,7 +576,7 @@ Lemma prime_divisors : forall p:Z, prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p. Proof. - destruct 1; intros. + intros p; destruct 1 as [H H0]; intros a ?. assert (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p). { assert (Z.abs a <= Z.abs p) as H2. @@ -602,12 +600,13 @@ Proof. } intuition idtac. (* -p < a < -1 *) - - absurd (rel_prime (- a) p). + - match goal with [hyp : a < -1 |- _] => rename hyp into H4 end. + absurd (rel_prime (- a) p). + intros [H1p H2p H3p]. assert (- a | - a) by auto with zarith. - assert (- a | p) by auto with zarith. + assert (- a | p) as H5 by auto with zarith. apply H3p, Z.divide_1_r in H5; auto with zarith. - destruct H5. + destruct H5 as [H5|H5]. * contradict H4; rewrite <- (Z.opp_involutive a), H5 . apply Z.lt_irrefl. * contradict H4; rewrite <- (Z.opp_involutive a), H5 . @@ -616,16 +615,18 @@ Proof. * now apply Z.opp_le_mono; rewrite Z.opp_involutive; apply Z.lt_le_incl. * now apply Z.opp_lt_mono; rewrite Z.opp_involutive. (* a = 0 *) - - contradict H. + - match goal with [hyp : a = 0 |- _] => rename hyp into H2 end. + contradict H. replace p with 0; try discriminate. now apply sym_equal, Z.divide_0_l; rewrite <-H2. (* 1 < a < p *) - - absurd (rel_prime a p). + - match goal with [hyp : 1 < a |- _] => rename hyp into H3 end. + absurd (rel_prime a p). + intros [H1p H2p H3p]. assert (a | a) by auto with zarith. - assert (a | p) by auto with zarith. + assert (a | p) as H5 by auto with zarith. apply H3p, Z.divide_1_r in H5; auto with zarith. - destruct H5. + destruct H5 as [H5|H5]. * contradict H3; rewrite <- (Z.opp_involutive a), H5 . apply Z.lt_irrefl. * contradict H3; rewrite <- (Z.opp_involutive a), H5 . @@ -639,7 +640,7 @@ Qed. Lemma prime_rel_prime : forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a. Proof. - intros; constructor; intros; auto with zarith. + intros p H a H0; constructor; auto with zarith; intros ? H1 H2. apply prime_divisors in H1; intuition; subst; auto with zarith. - absurd (p | a); auto with zarith. - absurd (p | a); intuition. @@ -671,7 +672,7 @@ Qed. Lemma prime_mult : forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b). Proof. - intro p; simple induction 1; intros. + intro p; simple induction 1; intros ? ? a b ?. case (Zdivide_dec p a); intuition. right; apply Gauss with a; auto with zarith. Qed. @@ -743,9 +744,9 @@ Proof. + now exists 1. + elim (H x); auto. split; trivial. - apply Z.le_lt_trans with n; try intuition. + apply Z.le_lt_trans with n; try tauto. apply Z.divide_pos_le; auto with zarith. - apply Z.lt_le_trans with (2 := H0); red; auto. + apply Z.lt_le_trans with (2 := proj1 Hn); red; auto. - (* prime' -> prime *) constructor; trivial. intros n Hn Hnp. case (Zis_gcd_unique n p n 1). @@ -870,7 +871,7 @@ Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith. Theorem Zgcd_1_rel_prime : forall a b, Z.gcd a b = 1 <-> rel_prime a b. Proof. - unfold rel_prime; split; intro H. + unfold rel_prime; intros a b; split; intro H. rewrite <- H; apply Zgcd_is_gcd. case (Zis_gcd_unique a b (Z.gcd a b) 1); auto. apply Zgcd_is_gcd. @@ -894,10 +895,10 @@ Definition prime_dec_aux: Proof. intros p m. case (Z_lt_dec 1 m); intros H1; - [ | left; intros; exfalso; + [ | left; intros n ?; exfalso; contradict H1; apply Z.lt_trans with n; intuition]. pattern m; apply natlike_rec; auto with zarith. - - left; intros; exfalso. + - left; intros n ?; exfalso. absurd (1 < 0); try discriminate. apply Z.lt_trans with n; intuition. - intros x Hx IH; destruct IH as [F|E]. diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index 7e33fe2b4c..949a01860f 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -354,7 +354,7 @@ Qed. Lemma Zle_0_nat : forall n:nat, 0 <= Z.of_nat n. Proof. - induction n; simpl; intros. apply Z.le_refl. easy. + intros n; induction n; simpl; intros. apply Z.le_refl. easy. Qed. Hint Immediate Z.eq_le_incl: zarith. diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v index 8609a6af98..d4f58c3b04 100644 --- a/theories/ZArith/Zpow_def.v +++ b/theories/ZArith/Zpow_def.v @@ -25,9 +25,9 @@ Notation Zpower_Ppow := Pos2Z.inj_pow (only parsing). Lemma Zpower_theory : power_theory 1 Z.mul (@eq Z) Z.of_N Z.pow. Proof. - constructor. intros. - destruct n;simpl;trivial. + constructor. intros z n. + destruct n as [|p];simpl;trivial. unfold Z.pow_pos. rewrite <- (Z.mul_1_r (pow_pos _ _ _)). generalize 1. - induction p; simpl; intros; rewrite ?IHp, ?Z.mul_assoc; trivial. + induction p as [p IHp|p IHp|]; simpl; intros; rewrite ?IHp, ?Z.mul_assoc; trivial. Qed. diff --git a/theories/dune b/theories/dune index c2d8197ee4..18e000cfe1 100644 --- a/theories/dune +++ b/theories/dune @@ -14,10 +14,8 @@ coq.plugins.cc coq.plugins.firstorder - coq.plugins.numeral_notation - coq.plugins.string_notation + coq.plugins.number_string_notation coq.plugins.int63_syntax - coq.plugins.r_syntax coq.plugins.float_syntax coq.plugins.btauto diff --git a/theories/micromega/EnvRing.v b/theories/micromega/EnvRing.v index 7bef11e89a..bb21472e57 100644 --- a/theories/micromega/EnvRing.v +++ b/theories/micromega/EnvRing.v @@ -557,7 +557,8 @@ Section MakeRingPol. Lemma Peq_ok P P' : (P ?== P') = true -> forall l, P@l == P'@ l. Proof. - revert P';induction P;destruct P';simpl; intros H l; try easy. + revert P';induction P as [|p P IHP|P2 IHP1 p P3 IHP2]; + intro P';destruct P' as [|p0 P'|P'1 p0 P'2];simpl; intros H l; try easy. - now apply (morph_eq CRmorph). - destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. now rewrite IHP. @@ -587,7 +588,7 @@ Section MakeRingPol. Lemma env_morph p e1 e2 : (forall x, e1 x = e2 x) -> p @ e1 = p @ e2. Proof. - revert e1 e2. induction p ; simpl. + revert e1 e2. induction p as [|? ? IHp|? IHp1 ? ? IHp2]; simpl. - reflexivity. - intros e1 e2 EQ. apply IHp. intros. apply EQ. - intros e1 e2 EQ. f_equal; [f_equal|]. @@ -664,13 +665,13 @@ Qed. Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c]. Proof. - revert l;induction P;simpl;intros;Esimpl;trivial. + revert l;induction P as [| |? ? ? ? IHP2];simpl;intros;Esimpl;trivial. rewrite IHP2;rsimpl. Qed. Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c]. Proof. - revert l;induction P;simpl;intros. + revert l;induction P as [|? ? IHP|? ? ? ? IHP2];simpl;intros. - Esimpl. - rewrite IHP;rsimpl. - rewrite IHP2;rsimpl. @@ -678,7 +679,7 @@ Qed. Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c]. Proof. - revert l;induction P;simpl;intros;Esimpl;trivial. + revert l;induction P as [| |? IHP1 ? ? IHP2];simpl;intros;Esimpl;trivial. rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut. Qed. @@ -694,7 +695,7 @@ Qed. Lemma Popp_ok P l : (--P)@l == - P@l. Proof. - revert l;induction P;simpl;intros. + revert l;induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros. - Esimpl. - apply IHP. - rewrite IHP1, IHP2;rsimpl. @@ -707,7 +708,7 @@ Qed. (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k. Proof. intros IHP'. - revert k l. induction P;simpl;intros. + revert k l. induction P as [|p|? IHP1];simpl;intros. - add_permut. - destruct p; simpl; rewrite ?Pjump_xO_tail, ?Pjump_pred_double; add_permut. @@ -719,8 +720,8 @@ Qed. Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l. Proof. - revert P l; induction P';simpl;intros;Esimpl. - - revert p l; induction P;simpl;intros. + revert P l; induction P' as [|p P' IHP'|? IHP'1 ? ? IHP'2];simpl;intros P l;Esimpl. + - revert p l; induction P as [|? P IHP|? IHP1 p ? IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * now rewrite IHP'. @@ -730,7 +731,7 @@ Qed. * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl. * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - - destruct P;simpl. + - destruct P as [|p0|];simpl. + Esimpl. add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rewrite Pjump_xO_tail. rsimpl. add_permut. @@ -749,7 +750,7 @@ Qed. (PsubX Psub P' k P) @ l == P@l - P'@l * (hd l)^k. Proof. intros IHP'. - revert k l. induction P;simpl;intros. + revert k l. induction P as [|p|? IHP1];simpl;intros. - rewrite Popp_ok;rsimpl; add_permut. - destruct p; simpl; rewrite Popp_ok;rsimpl; @@ -762,8 +763,8 @@ Qed. Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l. Proof. - revert P l; induction P';simpl;intros;Esimpl. - - revert p l; induction P;simpl;intros. + revert P l; induction P' as [|p P' IHP'|? IHP'1 ? ? IHP'2];simpl;intros P l;Esimpl. + - revert p l; induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * rewrite IHP';rsimpl. @@ -773,7 +774,7 @@ Qed. * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl. * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - - destruct P;simpl. + - destruct P as [|p0|];simpl. + Esimpl; add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rewrite Pjump_xO_tail. rsimpl. add_permut. @@ -791,8 +792,8 @@ Qed. (forall P l, (Pmul P P') @ l == P @ l * P' @ l) -> forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l). Proof. - intros IHP'. - induction P;simpl;intros. + intros IHP' P. + induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. - Esimpl; mul_permut. - destr_pos_sub; intros ->;Esimpl. + now rewrite IHP'. @@ -806,10 +807,10 @@ Qed. Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l. Proof. - revert P l;induction P';simpl;intros. + revert P l;induction P' as [| |? IHP'1 ? ? IHP'2];simpl;intros P l. - apply PmulC_ok. - apply PmulI_ok;trivial. - - destruct P. + - destruct P as [|p0|]. + rewrite (ARmul_comm ARth). Esimpl. + Esimpl. rewrite IHP'1;Esimpl. f_equiv. destruct p0;rewrite IHP'2;Esimpl. @@ -823,7 +824,7 @@ Qed. Lemma Psquare_ok P l : (Psquare P)@l == P@l * P@l. Proof. - revert l;induction P;simpl;intros;Esimpl. + revert l;induction P as [|? ? IHP|P2 IHP1 p ? IHP2];simpl;intros l;Esimpl. - apply IHP. - rewrite Padd_ok, Pmul_ok;Esimpl. rewrite IHP1, IHP2. @@ -833,7 +834,7 @@ Qed. Lemma Mphi_morph M e1 e2 : (forall x, e1 x = e2 x) -> M @@ e1 = M @@ e2. Proof. - revert e1 e2; induction M; simpl; intros e1 e2 EQ; trivial. + revert e1 e2; induction M as [|? ? IHM|? ? IHM]; simpl; intros e1 e2 EQ; trivial. - apply IHM. intros; apply EQ. - f_equal. * apply IHM. intros; apply EQ. @@ -890,7 +891,8 @@ Qed. let (Q,R) := MFactor P M in P@l == Q@l + M@@l * R@l. Proof. - revert M l; induction P; destruct M; intros l; simpl; auto; Esimpl. + revert M l; induction P as [|? ? IHP|? IHP1 ? ? IHP2]; + intros M; destruct M; intros l; simpl; auto; Esimpl. - case Pos.compare_spec; intros He; simpl. * destr_mfactor R1 S1. now rewrite IHP, He, !mkPinj_ok. * destr_mfactor R1 S1. rewrite IHP; simpl. @@ -922,7 +924,7 @@ Qed. Lemma PNSubst1_ok n P1 M1 P2 l : M1@@l == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l. Proof. - revert P1. induction n; simpl; intros P1; + revert P1. induction n as [|n IHn]; simpl; intros P1; generalize (POneSubst_ok P1 M1 P2); destruct POneSubst; intros; rewrite <- ?IHn; auto; reflexivity. Qed. @@ -953,7 +955,7 @@ Qed. Lemma PSubstL_ok n LM1 P1 P2 l : PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l. Proof. - revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros. + revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros P3 H **. - discriminate. - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst. * injection H as [= <-]. rewrite <- PSubstL1_ok; intuition. @@ -963,7 +965,7 @@ Qed. Lemma PNSubstL_ok m n LM1 P1 l : MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l. Proof. - revert LM1 P1. induction m; simpl; intros; + revert LM1 P1. induction m as [|m IHm]; simpl; intros LM1 P2 **; assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL; auto; try reflexivity. rewrite <- IHm; auto. @@ -1017,7 +1019,7 @@ Section POWER. forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l. Proof. intros subst_l_ok res P p. revert res. - induction p;simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; + induction p as [p IHp|p IHp|];simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; mul_permut. Qed. @@ -1025,7 +1027,7 @@ Section POWER. (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l. Proof. - destruct n;simpl. + intros ? P n;destruct n;simpl. - reflexivity. - rewrite Ppow_pos_ok by trivial. Esimpl. Qed. @@ -1092,7 +1094,7 @@ Section POWER. PEeval l pe == (norm_aux pe)@l. Proof. intros. - induction pe. + induction pe as [| |pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2|? IHpe|? IHpe n0]. - reflexivity. - apply mkX_ok. - simpl PEeval. rewrite IHpe1, IHpe2. @@ -1104,8 +1106,8 @@ Section POWER. - simpl. rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - simpl. rewrite IHpe. Esimpl. - simpl. rewrite Ppow_N_ok by reflexivity. - rewrite (rpow_pow_N pow_th). destruct n0; simpl; Esimpl. - induction p;simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. + rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. + induction p as [p IHp|p IHp|];simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. Qed. End NORM_SUBST_REC. diff --git a/theories/micromega/OrderedRing.v b/theories/micromega/OrderedRing.v index ea9b20847b..5fa3740ab1 100644 --- a/theories/micromega/OrderedRing.v +++ b/theories/micromega/OrderedRing.v @@ -235,13 +235,13 @@ Qed. Theorem Rle_lt_trans : forall n m p : R, n <= m -> m < p -> n < p. Proof. intros n m p H1 H2; le_elim H1. -now apply Rlt_trans with (m := m). now rewrite H1. +now apply (Rlt_trans (m := m)). now rewrite H1. Qed. Theorem Rlt_le_trans : forall n m p : R, n < m -> m <= p -> n < p. Proof. intros n m p H1 H2; le_elim H2. -now apply Rlt_trans with (m := m). now rewrite <- H2. +now apply (Rlt_trans (m := m)). now rewrite <- H2. Qed. Theorem Rle_gt_cases : forall n m : R, n <= m \/ m < n. diff --git a/theories/micromega/Refl.v b/theories/micromega/Refl.v index 1189309af1..0f82f9e578 100644 --- a/theories/micromega/Refl.v +++ b/theories/micromega/Refl.v @@ -31,7 +31,7 @@ Fixpoint make_impl (A : Type) (eval : A -> Prop) (l : list A) (goal : Prop) {str Theorem make_impl_true : forall (A : Type) (eval : A -> Prop) (l : list A), make_impl eval l True. Proof. -induction l as [| a l IH]; simpl. +intros A eval l; induction l as [| a l IH]; simpl. trivial. intro; apply IH. Qed. @@ -42,9 +42,9 @@ Theorem make_impl_map : (EVAL : forall x, eval' x <-> eval (fst x)), make_impl eval' l r <-> make_impl eval (List.map fst l) r. Proof. -induction l as [| a l IH]; simpl. +intros A B eval eval' l; induction l as [| a l IH]; simpl. - tauto. -- intros. +- intros r EVAL. rewrite EVAL. rewrite IH. tauto. @@ -61,18 +61,18 @@ Fixpoint make_conj (A : Type) (eval : A -> Prop) (l : list A) {struct l} : Prop Theorem make_conj_cons : forall (A : Type) (eval : A -> Prop) (a : A) (l : list A), make_conj eval (a :: l) <-> eval a /\ make_conj eval l. Proof. -intros; destruct l; simpl; tauto. +intros A eval a l; destruct l; simpl; tauto. Qed. Lemma make_conj_impl : forall (A : Type) (eval : A -> Prop) (l : list A) (g : Prop), (make_conj eval l -> g) <-> make_impl eval l g. Proof. - induction l. + intros A eval l; induction l as [|? l IHl]. simpl. tauto. simpl. - intros. + intros g. destruct l. simpl. tauto. @@ -83,11 +83,11 @@ Qed. Lemma make_conj_in : forall (A : Type) (eval : A -> Prop) (l : list A), make_conj eval l -> (forall p, In p l -> eval p). Proof. - induction l. + intros A eval l; induction l as [|? l IHl]. simpl. tauto. simpl. - intros. + intros H ? H0. destruct l. simpl in H0. destruct H0. @@ -101,10 +101,10 @@ Qed. Lemma make_conj_app : forall A eval l1 l2, @make_conj A eval (l1 ++ l2) <-> @make_conj A eval l1 /\ @make_conj A eval l2. Proof. - induction l1. + intros A eval l1; induction l1 as [|a l1 IHl1]. simpl. tauto. - intros. + intros l2. change ((a::l1) ++ l2) with (a :: (l1 ++ l2)). rewrite make_conj_cons. rewrite IHl1. @@ -116,7 +116,7 @@ Infix "+++" := rev_append (right associativity, at level 60) : list_scope. Lemma make_conj_rapp : forall A eval l1 l2, @make_conj A eval (l1 +++ l2) <-> @make_conj A eval (l1++l2). Proof. - induction l1. + intros A eval l1; induction l1 as [|? ? IHl1]. - simpl. tauto. - intros. simpl rev_append at 1. @@ -141,10 +141,10 @@ Lemma not_make_conj_app : forall (A:Type) (t:list A) a eval (no_middle_eval : forall d, eval d \/ ~ eval d) , ~ make_conj eval (t ++ a) <-> (~ make_conj eval t) \/ (~ make_conj eval a). Proof. - induction t. + intros A t; induction t as [|a t IHt]. - simpl. tauto. - - intros. + - intros a0 **. simpl ((a::t)++a0). rewrite !not_make_conj_cons by auto. rewrite IHt by auto. diff --git a/theories/micromega/RingMicromega.v b/theories/micromega/RingMicromega.v index f7a848d7a5..b5289b5800 100644 --- a/theories/micromega/RingMicromega.v +++ b/theories/micromega/RingMicromega.v @@ -215,7 +215,7 @@ Lemma OpMult_sound : forall (o o' om: Op1) (x y : R), eval_op1 o x -> eval_op1 o' y -> OpMult o o' = Some om -> eval_op1 om (x * y). Proof. -unfold eval_op1; destruct o; simpl; intros o' om x y H1 H2 H3. +unfold eval_op1; intros o; destruct o; simpl; intros o' om x y H1 H2 H3. (* x == 0 *) inversion H3. rewrite H1. now rewrite (Rtimes_0_l sor). (* x ~= 0 *) @@ -246,9 +246,9 @@ Lemma OpAdd_sound : forall (o o' oa : Op1) (e e' : R), eval_op1 o e -> eval_op1 o' e' -> OpAdd o o' = Some oa -> eval_op1 oa (e + e'). Proof. -unfold eval_op1; destruct o; simpl; intros o' oa e e' H1 H2 Hoa. +unfold eval_op1; intros o; destruct o; simpl; intros o' oa e e' H1 H2 Hoa. (* e == 0 *) -inversion Hoa. rewrite <- H0. +inversion Hoa as [H0]. rewrite <- H0. destruct o' ; rewrite H1 ; now rewrite (Rplus_0_l sor). (* e ~= 0 *) destruct o'. @@ -373,8 +373,8 @@ Lemma pexpr_times_nformula_correct : forall (env: PolEnv) (e: PolC) (f f' : NFor eval_nformula env f'. Proof. unfold pexpr_times_nformula. - destruct f. - intros. destruct o ; inversion H0 ; try discriminate. + intros env e f; destruct f as [? o]. + intros f' H H0. destruct o ; inversion H0 ; try discriminate. simpl in *. unfold eval_pol in *. rewrite (Pmul_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)). @@ -388,9 +388,9 @@ Lemma nformula_times_nformula_correct : forall (env:PolEnv) eval_nformula env f. Proof. unfold nformula_times_nformula. - destruct f1 ; destruct f2. + intros env f1 f2; destruct f1 as [? o]; destruct f2 as [? o0]. case_eq (OpMult o o0) ; simpl ; try discriminate. - intros. inversion H2 ; simpl. + intros o1 H ? H0 H1 H2. inversion H2 ; simpl. unfold eval_pol. destruct o1; simpl; rewrite (Pmul_ok (SORsetoid sor) Rops_wd @@ -405,9 +405,9 @@ Lemma nformula_plus_nformula_correct : forall (env:PolEnv) eval_nformula env f. Proof. unfold nformula_plus_nformula. - destruct f1 ; destruct f2. + intros env f1 f2; destruct f1 as [? o] ; destruct f2 as [? o0]. case_eq (OpAdd o o0) ; simpl ; try discriminate. - intros. inversion H2 ; simpl. + intros o1 H ? H0 H1 H2. inversion H2 ; simpl. unfold eval_pol. destruct o1; simpl; rewrite (Padd_ok (SORsetoid sor) Rops_wd @@ -421,9 +421,10 @@ Lemma eval_Psatz_Sound : forall (e : Psatz) (f : NFormula), eval_Psatz l e = Some f -> eval_nformula env f. Proof. - induction e. + intros l env H e; + induction e as [n|?|? e IHe|e1 IHe1 e2 IHe2|e1 IHe1 e2 IHe2|c|]. (* PsatzIn *) - simpl ; intros. + simpl ; intros f H0. destruct (nth_in_or_default n l (Pc cO, Equal)) as [Hin|Heq]. (* index is in bounds *) apply H. congruence. @@ -432,7 +433,7 @@ Proof. rewrite Heq. simpl. now apply (morph0 (SORrm addon)). (* PsatzSquare *) - simpl. intros. inversion H0. + simpl. intros ? H0. inversion H0. simpl. unfold eval_pol. rewrite (Psquare_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)); @@ -440,7 +441,7 @@ Proof. (* PsatzMulC *) simpl. intro. - case_eq (eval_Psatz l e) ; simpl ; intros. + case_eq (eval_Psatz l e) ; simpl ; intros ? H0; [intros H1|]. apply IHe in H0. apply pexpr_times_nformula_correct with (1:=H0) (2:= H1). discriminate. @@ -448,24 +449,24 @@ Proof. simpl ; intro. case_eq (eval_Psatz l e1) ; simpl ; try discriminate. case_eq (eval_Psatz l e2) ; simpl ; try discriminate. - intros. + intros n H0 n0 H1 ?. apply IHe1 in H1. apply IHe2 in H0. apply (nformula_times_nformula_correct env n0 n) ; assumption. (* PsatzAdd *) simpl ; intro. case_eq (eval_Psatz l e1) ; simpl ; try discriminate. case_eq (eval_Psatz l e2) ; simpl ; try discriminate. - intros. + intros n H0 n0 H1 ?. apply IHe1 in H1. apply IHe2 in H0. apply (nformula_plus_nformula_correct env n0 n) ; assumption. (* PsatzC *) simpl. intro. case_eq (cO [<] c). - intros. inversion H1. simpl. + intros H0 H1. inversion H1. simpl. rewrite <- (morph0 (SORrm addon)). now apply cltb_sound. discriminate. (* PsatzZ *) - simpl. intros. inversion H0. + simpl. intros ? H0. inversion H0. simpl. apply (morph0 (SORrm addon)). Qed. @@ -484,7 +485,8 @@ Fixpoint ge_bool (n m : nat) : bool := Lemma ge_bool_cases : forall n m, (if ge_bool n m then n >= m else n < m)%nat. Proof. - induction n; destruct m ; simpl; auto with arith. + intros n; induction n as [|n IHn]; + intros m; destruct m as [|m]; simpl; auto with arith. specialize (IHn m). destruct (ge_bool); auto with arith. Qed. @@ -511,26 +513,27 @@ Fixpoint extract_hyps (l: list NFormula) (ln : list nat) : list NFormula := | nil => nil | n::ln => nth n l (Pc cO, Equal) :: extract_hyps l ln end. - + Lemma extract_hyps_app : forall l ln1 ln2, extract_hyps l (ln1 ++ ln2) = (extract_hyps l ln1) ++ (extract_hyps l ln2). Proof. - induction ln1. + intros l ln1; induction ln1 as [|? ln1 IHln1]. reflexivity. simpl. intros. rewrite IHln1. reflexivity. Qed. - + Ltac inv H := inversion H ; try subst ; clear H. Lemma nhyps_of_psatz_correct : forall (env : PolEnv) (e:Psatz) (l : list NFormula) (f: NFormula), - eval_Psatz l e = Some f -> + eval_Psatz l e = Some f -> ((forall f', In f' (extract_hyps l (nhyps_of_psatz e)) -> eval_nformula env f') -> eval_nformula env f). Proof. - induction e ; intros. + intros env e; induction e as [n|?|? e IHe|e1 IHe1 e2 IHe2|e1 IHe1 e2 IHe2|c|]; + intros l f H H0. (*PsatzIn*) - simpl in *. + simpl in *. apply H0. intuition congruence. (* PsatzSquare *) simpl in *. @@ -543,15 +546,15 @@ Proof. (* PsatzMulC *) simpl in *. case_eq (eval_Psatz l e). - intros. rewrite H1 in H. simpl in H. + intros ? H1. rewrite H1 in H. simpl in H. apply pexpr_times_nformula_correct with (2:= H). apply IHe with (1:= H1); auto. - intros. rewrite H1 in H. simpl in H ; discriminate. + intros H1. rewrite H1 in H. simpl in H ; discriminate. (* PsatzMulE *) simpl in *. revert H. case_eq (eval_Psatz l e1). - case_eq (eval_Psatz l e2) ; simpl ; intros. + case_eq (eval_Psatz l e2) ; simpl ; intros ? H ? H1; [intros H2|]. apply nformula_times_nformula_correct with (3:= H2). apply IHe1 with (1:= H1) ; auto. intros. apply H0. rewrite extract_hyps_app. @@ -564,7 +567,7 @@ Proof. simpl in *. revert H. case_eq (eval_Psatz l e1). - case_eq (eval_Psatz l e2) ; simpl ; intros. + case_eq (eval_Psatz l e2) ; simpl ; intros ? H ? H1; [intros H2|]. apply nformula_plus_nformula_correct with (3:= H2). apply IHe1 with (1:= H1) ; auto. intros. apply H0. rewrite extract_hyps_app. @@ -576,16 +579,16 @@ Proof. (* PsatzC *) simpl in H. case_eq (cO [<] c). - intros. rewrite H1 in H. inv H. + intros H1. rewrite H1 in H. inv H. unfold eval_nformula. simpl. rewrite <- (morph0 (SORrm addon)). now apply cltb_sound. - intros. rewrite H1 in H. discriminate. + intros H1. rewrite H1 in H. discriminate. (* PsatzZ *) simpl in *. inv H. unfold eval_nformula. simpl. apply (morph0 (SORrm addon)). Qed. - + @@ -663,8 +666,8 @@ intros l cm H env. unfold check_normalised_formulas in H. revert H. case_eq (eval_Psatz l cm) ; [|discriminate]. -intros nf. intros. -rewrite <- make_conj_impl. intro. +intros nf. intros H H0. +rewrite <- make_conj_impl. intro H1. assert (H1' := make_conj_in _ _ H1). assert (Hnf := @eval_Psatz_Sound _ _ H1' _ _ H). destruct nf. @@ -861,7 +864,7 @@ Proof. set (F := (fun (x : NFormula) (acc : list (list (NFormula * T))) => if check_inconsistent x then acc else ((x, tg) :: nil) :: acc)). set (G := ((fun x : NFormula => eval_nformula env x -> False))). - induction l. + induction l as [|a l IHl]. - compute. tauto. - rewrite make_conj_cons. @@ -896,13 +899,13 @@ Definition cnf_negate {T: Type} (t: Formula C) (tg: T) : cnf NFormula T := Lemma eq0_cnf : forall x, (0 < x -> False) /\ (0 < - x -> False) <-> x == 0. Proof. - split ; intros. + intros x; split ; intros H. + apply (SORle_antisymm sor). * now rewrite (Rle_ngt sor). * rewrite (Rle_ngt sor). rewrite (Rlt_lt_minus sor). setoid_replace (0 - x) with (-x) by ring. tauto. - + split; intro. + + split; intro H0. * rewrite (SORlt_le_neq sor) in H0. apply (proj2 H0). now rewrite H. @@ -918,7 +921,7 @@ Proof. destruct f as [e o]; destruct o eqn:Op; cbn - [psub]; repeat rewrite eval_pol_sub; fold eval_pol; repeat rewrite eval_pol_Pc; repeat rewrite eval_pol_opp; - generalize (eval_pol env e) as x; intro. + generalize (eval_pol env e) as x; intro x. - apply eq0_cnf. - unfold not. tauto. - symmetry. rewrite (Rlt_nge sor). @@ -955,7 +958,7 @@ Proof. intros T env t tg. unfold cnf_normalise. rewrite normalise_sound. - generalize (normalise t) as f;intro. + generalize (normalise t) as f;intro f. destruct (check_inconsistent f) eqn:U. - destruct f as [e op]. assert (US := check_inconsistent_sound _ _ U env). @@ -970,7 +973,7 @@ Proof. intros T env t tg. rewrite normalise_sound. unfold cnf_negate. - generalize (normalise t) as f;intro. + generalize (normalise t) as f;intro f. destruct (check_inconsistent f) eqn:U. - destruct f as [e o]. @@ -983,9 +986,9 @@ Qed. Lemma eval_nformula_dec : forall env d, (eval_nformula env d) \/ ~ (eval_nformula env d). Proof. - intros. - destruct d ; simpl. - generalize (eval_pol env p); intros. + intros env d. + destruct d as [p o]; simpl. + generalize (eval_pol env p); intros r. destruct o ; simpl. apply (Req_em sor r 0). destruct (Req_em sor r 0) ; tauto. @@ -1008,7 +1011,7 @@ Lemma xdenorm_correct : forall p i env, eval_pol (jump i env) p == eval_pexpr env (xdenorm (Pos.succ i) p). Proof. unfold eval_pol. - induction p. + intros p; induction p as [|? p IHp|p2 IHp1 ? p3 IHp2]. simpl. reflexivity. (* Pinj *) simpl. @@ -1037,7 +1040,7 @@ Definition denorm := xdenorm xH. Lemma denorm_correct : forall p env, eval_pol env p == eval_pexpr env (denorm p). Proof. unfold denorm. - induction p. + intros p; induction p as [| |? IHp1 ? ? IHp2]. reflexivity. simpl. rewrite Pos.add_1_r. @@ -1092,7 +1095,9 @@ Definition eval_sformula (env : PolEnv) (f : Formula S) : Prop := Lemma eval_pexprSC : forall env s, eval_sexpr env s = eval_pexpr env (map_PExpr s). Proof. unfold eval_pexpr, eval_sexpr. - induction s ; simpl ; try (rewrite IHs1 ; rewrite IHs2) ; try reflexivity. + intros env s; + induction s as [| |? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs|? IHs ?]; + simpl ; try (rewrite IHs1 ; rewrite IHs2) ; try reflexivity. apply phi_C_of_S. rewrite IHs. reflexivity. rewrite IHs. reflexivity. @@ -1101,7 +1106,7 @@ Qed. (** equality might be (too) strong *) Lemma eval_formulaSC : forall env f, eval_sformula env f = eval_formula env (map_Formula f). Proof. - destruct f. + intros env f; destruct f. simpl. repeat rewrite eval_pexprSC. reflexivity. diff --git a/theories/micromega/Tauto.v b/theories/micromega/Tauto.v index dddced5739..99af214396 100644 --- a/theories/micromega/Tauto.v +++ b/theories/micromega/Tauto.v @@ -185,7 +185,7 @@ Section S. | EQ f1 f2 => (eval_f f1) = (eval_f f2) end. Proof. - destruct f ; reflexivity. + intros k f; destruct f ; reflexivity. Qed. End EVAL. @@ -197,23 +197,23 @@ Section S. Definition eiff (k: kind) : rtyp k -> rtyp k -> Prop := if k as k' return rtyp k' -> rtyp k' -> Prop then iff else @eq bool. - Lemma eiff_refl : forall (k: kind) (x : rtyp k), + Lemma eiff_refl (k: kind) (x : rtyp k) : eiff k x x. Proof. destruct k ; simpl; tauto. Qed. - Lemma eiff_sym : forall k (x y : rtyp k), eiff k x y -> eiff k y x. + Lemma eiff_sym k (x y : rtyp k) : eiff k x y -> eiff k y x. Proof. destruct k ; simpl; intros ; intuition. Qed. - Lemma eiff_trans : forall k (x y z : rtyp k), eiff k x y -> eiff k y z -> eiff k x z. + Lemma eiff_trans k (x y z : rtyp k) : eiff k x y -> eiff k y z -> eiff k x z. Proof. destruct k ; simpl; intros ; intuition congruence. Qed. - Lemma hold_eiff : forall (k: kind) (x y : rtyp k), + Lemma hold_eiff (k: kind) (x y : rtyp k) : (hold k x <-> hold k y) <-> eiff k x y. Proof. destruct k ; simpl. @@ -266,7 +266,10 @@ Section S. forall (k: kind)(f : GFormula k), (eiff k (eval_f ev f) (eval_f ev' f)). Proof. - induction f ; simpl. + intros ev ev' H k f; + induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf + |? ? IHf1 ? ? IHf2|? ? IHf1 ? IHf2|]; + simpl. - reflexivity. - reflexivity. - reflexivity. @@ -319,7 +322,7 @@ Lemma map_simpl : forall A B f l, @map A B f l = match l with | a :: l=> (f a) :: (@map A B f l) end. Proof. - destruct l ; reflexivity. + intros A B f l; destruct l ; reflexivity. Qed. @@ -469,7 +472,7 @@ Section S. Lemma is_bool_inv : forall {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) res, is_bool f = Some res -> f = if res then TT _ else FF _. Proof. - intros. + intros TX AF k f res H. destruct f ; inversion H; reflexivity. Qed. @@ -689,7 +692,7 @@ Section S. Definition is_X_inv : forall (k: kind) (f: TFormula TX AF k) x, is_X f = Some x -> f = X k x. Proof. - destruct f ; simpl ; try congruence. + intros k f; destruct f ; simpl ; try congruence. Qed. Variable needA : Annot -> bool. @@ -786,7 +789,7 @@ Section S. Lemma if_same : forall {A: Type} (b: bool) (t:A), (if b then t else t) = t. Proof. - destruct b ; reflexivity. + intros A b; destruct b ; reflexivity. Qed. Lemma is_cnf_tt_cnf_ff : @@ -806,14 +809,14 @@ Section S. is_cnf_tt f1 = true -> f1 = cnf_tt. Proof. unfold cnf_tt. - destruct f1 ; simpl ; try congruence. + intros f1; destruct f1 ; simpl ; try congruence. Qed. Lemma is_cnf_ff_inv : forall f1, is_cnf_ff f1 = true -> f1 = cnf_ff. Proof. unfold cnf_ff. - destruct f1 ; simpl ; try congruence. + intros f1 ; destruct f1 as [|c f1] ; simpl ; try congruence. destruct c ; simpl ; try congruence. destruct f1 ; try congruence. reflexivity. @@ -822,7 +825,7 @@ Section S. Lemma if_cnf_tt : forall f, (if is_cnf_tt f then cnf_tt else f) = f. Proof. - intros. + intros f. destruct (is_cnf_tt f) eqn:EQ. apply is_cnf_tt_inv in EQ;auto. reflexivity. @@ -831,7 +834,7 @@ Section S. Lemma or_cnf_opt_cnf_ff : forall f, or_cnf_opt cnf_ff f = f. Proof. - intros. + intros f. unfold or_cnf_opt. rewrite is_cnf_tt_cnf_ff. simpl. @@ -848,7 +851,7 @@ Section S. and_cnf_opt (xcnf pol f1) (xcnf pol f2) = xcnf pol (abs_and f1 f2 (if pol then AND else OR)). Proof. - unfold abs_and; intros. + unfold abs_and; intros k f1 f2 pol. destruct (is_X f1) eqn:EQ1. apply is_X_inv in EQ1. subst. @@ -868,7 +871,7 @@ Section S. or_cnf_opt (xcnf pol f1) (xcnf pol f2) = xcnf pol (abs_or f1 f2 (if pol then OR else AND)). Proof. - unfold abs_or; intros. + unfold abs_or; intros k f1 f2 pol. destruct (is_X f1) eqn:EQ1. apply is_X_inv in EQ1. subst. @@ -889,7 +892,7 @@ Section S. Lemma xcnf_true_mk_arrow_l : forall b o t (f:TFormula TX AF b), xcnf true (mk_arrow o (X b t) f) = xcnf true f. Proof. - destruct o ; simpl; auto. + intros b o; destruct o ; simpl; auto. intros. rewrite or_cnf_opt_cnf_ff. reflexivity. Qed. @@ -907,8 +910,8 @@ Section S. Lemma xcnf_true_mk_arrow_r : forall b o t (f:TFormula TX AF b), xcnf true (mk_arrow o f (X b t)) = xcnf false f. Proof. - destruct o ; simpl; auto. - - intros. + intros b o; destruct o ; simpl; auto. + - intros t f. destruct (is_X f) eqn:EQ. apply is_X_inv in EQ. subst. reflexivity. simpl. @@ -939,7 +942,7 @@ Section S. Lemma and_cnf_opt_cnf_tt : forall f, and_cnf_opt f cnf_tt = f. Proof. - intros. + intros f. unfold and_cnf_opt. simpl. rewrite orb_comm. simpl. @@ -951,7 +954,7 @@ Section S. Lemma is_bool_abst_simpl : forall b (f:TFormula TX AF b), is_bool (abst_simpl f) = is_bool f. Proof. - induction f ; simpl ; auto. + intros b f; induction f ; simpl ; auto. rewrite needA_all. reflexivity. Qed. @@ -959,7 +962,10 @@ Section S. Lemma abst_simpl_correct : forall b (f:TFormula TX AF b) pol, xcnf pol f = xcnf pol (abst_simpl f). Proof. - induction f; simpl;intros; + intros b f; + induction f as [| | | |? ? IHf1 f2 IHf2|? ? IHf1 f2 IHf2 + |? ? IHf|? ? IHf1 ? f2 IHf2|? ? IHf1 f2 IHf2|f1 IHf1 f2 IHf2]; + simpl;intros; unfold mk_and,mk_or,mk_impl, mk_iff; rewrite <- ?IHf; try (rewrite <- !IHf1; rewrite <- !IHf2); @@ -972,11 +978,11 @@ Section S. destruct (is_bool f2); auto. Qed. - Ltac is_X := + Ltac is_X t := match goal with | |-context[is_X ?X] => let f := fresh "EQ" in - destruct (is_X X) eqn:f ; + destruct (is_X X) as [t|] eqn:f ; [apply is_X_inv in f|] end. @@ -995,10 +1001,10 @@ Section S. Proof. unfold or_is_X. intros k f1 f2. - repeat is_X. - exists t ; intuition. + is_X t; is_X t0. exists t ; intuition. exists t ; intuition. + exists t0 ; intuition. congruence. Qed. @@ -1008,8 +1014,8 @@ Section S. | None => mk_iff xcnf pol f1 f2 end = mk_iff xcnf pol f1 f2. Proof. - intros. - destruct (is_bool f2) eqn:EQ; auto. + intros k f1 f2 pol. + destruct (is_bool f2) as [b|] eqn:EQ; auto. apply is_bool_inv in EQ. subst. unfold mk_iff. @@ -1024,7 +1030,7 @@ Section S. (pol : bool), xcnf pol (IFF f1 f2) = xcnf pol (abst_iff abst_form pol f1 f2). Proof. - intros; simpl. + intros k f1 f2 IHf1 IHf2 pol; simpl. assert (D1 :mk_iff xcnf pol f1 f2 = mk_iff xcnf pol (abst_simpl f1) (abst_simpl f2)). { simpl. @@ -1066,7 +1072,7 @@ Section S. (pol : bool), xcnf pol (EQ f1 f2) = xcnf pol (abst_form pol (EQ f1 f2)). Proof. - intros. + intros f1 f2 IHf1 IHf2 pol. change (xcnf pol (IFF f1 f2) = xcnf pol (abst_form pol (EQ f1 f2))). rewrite abst_iff_correct by assumption. simpl. unfold abst_iff, abst_eq. @@ -1080,7 +1086,10 @@ Section S. Lemma abst_form_correct : forall b (f:TFormula TX AF b) pol, xcnf pol f = xcnf pol (abst_form pol f). Proof. - induction f;intros. + intros b f; + induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? f IHf + |? f1 IHf1 o f2 IHf2|? IHf1 ? IHf2|]; + intros pol. - simpl. destruct pol ; reflexivity. - simpl. destruct pol ; reflexivity. - simpl. reflexivity. @@ -1178,14 +1187,14 @@ Section S. Lemma radd_term_term : forall a' a cl, radd_term a a' = inl cl -> add_term a a' = Some cl. Proof. - induction a' ; simpl. - - intros. - destruct (deduce (fst a) (fst a)). + intros a'; induction a' as [|a a' IHa']; simpl. + - intros a cl H. + destruct (deduce (fst a) (fst a)) as [t|]. destruct (unsat t). congruence. inversion H. reflexivity. inversion H ;reflexivity. - - intros. - destruct (deduce (fst a0) (fst a)). + - intros a0 cl H. + destruct (deduce (fst a0) (fst a)) as [t|]. destruct (unsat t). congruence. destruct (radd_term a0 a') eqn:RADD; try congruence. inversion H. subst. @@ -1201,14 +1210,14 @@ Section S. Lemma radd_term_term' : forall a' a cl, add_term a a' = Some cl -> radd_term a a' = inl cl. Proof. - induction a' ; simpl. - - intros. - destruct (deduce (fst a) (fst a)). + intros a'; induction a' as [|a a' IHa']; simpl. + - intros a cl H. + destruct (deduce (fst a) (fst a)) as [t|]. destruct (unsat t). congruence. inversion H. reflexivity. inversion H ;reflexivity. - - intros. - destruct (deduce (fst a0) (fst a)). + - intros a0 cl H. + destruct (deduce (fst a0) (fst a)) as [t|]. destruct (unsat t). congruence. destruct (add_term a0 a') eqn:RADD; try congruence. inversion H. subst. @@ -1229,7 +1238,7 @@ Section S. unfold xor_clause_cnf. assert (ACC: fst (@nil clause,@nil Annot) = nil). reflexivity. - intros. + intros a f. set (F1:= (fun '(acc, tg) (e : clause) => match ror_clause a e with | inl cl => (cl :: acc, tg) @@ -1243,15 +1252,15 @@ Section S. revert ACC. generalize (@nil clause,@nil Annot). generalize (@nil clause). - induction f ; simpl ; auto. - intros. + induction f as [|a0 f IHf]; simpl ; auto. + intros ? p ?. apply IHf. unfold F1 , F2. destruct p ; simpl in * ; subst. clear. revert a0. - induction a; simpl; auto. - intros. + induction a as [|a a0 IHa]; simpl; auto. + intros a1. destruct (radd_term a a1) eqn:RADD. apply radd_term_term in RADD. rewrite RADD. @@ -1266,14 +1275,14 @@ Section S. fst (ror_clause_cnf a f) = or_clause_cnf a f. Proof. unfold ror_clause_cnf,or_clause_cnf. - destruct a ; auto. + intros a; destruct a ; auto. apply xror_clause_clause. Qed. Lemma ror_cnf_cnf : forall f1 f2, fst (ror_cnf f1 f2) = or_cnf f1 f2. Proof. - induction f1 ; simpl ; auto. - intros. + intros f1; induction f1 as [|a f1 IHf1] ; simpl ; auto. + intros f2. specialize (IHf1 f2). destruct(ror_cnf f1 f2). rewrite <- ror_clause_clause. @@ -1286,7 +1295,7 @@ Section S. Lemma ror_opt_cnf_cnf : forall f1 f2, fst (ror_cnf_opt f1 f2) = or_cnf_opt f1 f2. Proof. unfold ror_cnf_opt, or_cnf_opt. - intros. + intros f1 f2. destruct (is_cnf_tt f1). - simpl ; auto. - simpl. destruct (is_cnf_tt f2) ; simpl ; auto. @@ -1299,7 +1308,7 @@ Section S. fst (ratom f a) = f. Proof. unfold ratom. - intros. + intros f a. destruct (is_cnf_ff f || is_cnf_tt f); auto. Qed. @@ -1308,7 +1317,7 @@ Section S. (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_and rxcnf pol f1 f2) = mk_and xcnf pol f1 f2. Proof. - intros. + intros TX AF k f1 f2 IHf1 IHf2 pol. unfold mk_and, rxcnf_and. specialize (IHf1 pol). specialize (IHf2 pol). @@ -1327,7 +1336,7 @@ Section S. (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_or rxcnf pol f1 f2) = mk_or xcnf pol f1 f2. Proof. - intros. + intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_or, mk_or. specialize (IHf1 pol). specialize (IHf2 pol). @@ -1346,7 +1355,7 @@ Section S. (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_impl rxcnf pol f1 f2) = mk_impl xcnf pol f1 f2. Proof. - intros. + intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_impl, mk_impl, mk_or. specialize (IHf1 (negb pol)). specialize (IHf2 pol). @@ -1359,7 +1368,7 @@ Section S. destruct pol;auto. generalize (is_cnf_ff_inv (xcnf (negb true) f1)). destruct (is_cnf_ff (xcnf (negb true) f1)). - + intros. + + intros H. rewrite H by auto. unfold or_cnf_opt. simpl. @@ -1384,18 +1393,18 @@ Section S. (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_iff rxcnf pol f1 f2) = mk_iff xcnf pol f1 f2. Proof. - intros. + intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_iff. unfold mk_iff. rewrite <- (IHf1 (negb pol)). rewrite <- (IHf1 pol). rewrite <- (IHf2 false). rewrite <- (IHf2 true). - destruct (rxcnf (negb pol) f1). - destruct (rxcnf false f2). - destruct (rxcnf pol f1). - destruct (rxcnf true f2). - destruct (ror_cnf_opt (and_cnf_opt c c0) (and_cnf_opt c1 c2)) eqn:EQ. + destruct (rxcnf (negb pol) f1) as [c ?]. + destruct (rxcnf false f2) as [c0 ?]. + destruct (rxcnf pol f1) as [c1 ?]. + destruct (rxcnf true f2) as [c2 ?]. + destruct (ror_cnf_opt (and_cnf_opt c c0) (and_cnf_opt c1 c2)) as [c3 l3] eqn:EQ. simpl. change c3 with (fst (c3,l3)). rewrite <- EQ. rewrite ror_opt_cnf_cnf. @@ -1405,7 +1414,7 @@ Section S. Lemma rxcnf_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f:TFormula TX AF k) pol, fst (rxcnf pol f) = xcnf pol f. Proof. - induction f ; simpl ; auto. + intros TX AF k f; induction f ; simpl ; auto; intros pol. - destruct pol; simpl ; auto. - destruct pol; simpl ; auto. - destruct pol ; simpl ; auto. @@ -1463,7 +1472,7 @@ Section S. Lemma eval_cnf_and_opt : forall env x y, eval_cnf env (and_cnf_opt x y) <-> eval_cnf env (and_cnf x y). Proof. unfold and_cnf_opt. - intros. + intros env x y. destruct (is_cnf_ff x) eqn:F1. { apply is_cnf_ff_inv in F1. simpl. subst. @@ -1501,14 +1510,14 @@ Section S. Lemma add_term_correct : forall env t cl , eval_opt_clause env (add_term t cl) <-> eval_clause env (t::cl). Proof. - induction cl. + intros env t cl; induction cl as [|a cl IHcl]. - (* BC *) simpl. case_eq (deduce (fst t) (fst t)) ; try tauto. - intros. + intros t0 H. generalize (@deduce_prop _ _ _ H env). case_eq (unsat t0) ; try tauto. - { intros. + { intros H0 ?. generalize (@unsat_prop _ H0 env). unfold eval_clause. rewrite make_conj_cons. @@ -1518,9 +1527,9 @@ Section S. - (* IC *) simpl. case_eq (deduce (fst t) (fst a)); - intros. + intros t0; [intros H|]. generalize (@deduce_prop _ _ _ H env). - case_eq (unsat t0); intros. + case_eq (unsat t0); intros H0 H1. { generalize (@unsat_prop _ H0 env). simpl. @@ -1557,9 +1566,9 @@ Section S. Lemma or_clause_correct : forall cl cl' env, eval_opt_clause env (or_clause cl cl') <-> eval_clause env cl \/ eval_clause env cl'. Proof. - induction cl. + intros cl; induction cl as [|a cl IHcl]. - simpl. unfold eval_clause at 2. simpl. tauto. - - intros *. + - intros cl' env. simpl. assert (HH := add_term_correct env a cl'). assert (eval_tt env a \/ ~ eval_tt env a) by (apply no_middle_eval'). @@ -1579,17 +1588,17 @@ Section S. Proof. unfold eval_cnf. unfold or_clause_cnf. - intros until t. + intros env t. set (F := (fun (acc : list clause) (e : clause) => match or_clause t e with | Some cl => cl :: acc | None => acc end)). intro f. - assert ( make_conj (eval_clause env) (fold_left F f nil) <-> (eval_clause env t \/ make_conj (eval_clause env) f) /\ make_conj (eval_clause env) nil). + assert ( make_conj (eval_clause env) (fold_left F f nil) <-> (eval_clause env t \/ make_conj (eval_clause env) f) /\ make_conj (eval_clause env) nil) as H. { generalize (@nil clause) as acc. - induction f. + induction f as [|a f IHf]. - simpl. intros ; tauto. - intros. @@ -1634,7 +1643,7 @@ Section S. Lemma or_cnf_correct : forall env f f', eval_cnf env (or_cnf f f') <-> (eval_cnf env f) \/ (eval_cnf env f'). Proof. - induction f. + intros env f; induction f as [|a f IHf]. unfold eval_cnf. simpl. tauto. @@ -1652,7 +1661,7 @@ Section S. Lemma or_cnf_opt_correct : forall env f f', eval_cnf env (or_cnf_opt f f') <-> eval_cnf env (or_cnf f f'). Proof. unfold or_cnf_opt. - intros. + intros env f f'. destruct (is_cnf_tt f) eqn:TF. { simpl. apply is_cnf_tt_inv in TF. @@ -1690,7 +1699,7 @@ Section S. Lemma hold_eTT : forall k, hold k (eTT k). Proof. - destruct k ; simpl; auto. + intros k; destruct k ; simpl; auto. Qed. Hint Resolve hold_eTT : tauto. @@ -1698,7 +1707,7 @@ Section S. Lemma hold_eFF : forall k, hold k (eNOT k (eFF k)). Proof. - destruct k ; simpl;auto. + intros k; destruct k ; simpl;auto. Qed. Hint Resolve hold_eFF : tauto. @@ -1706,7 +1715,7 @@ Section S. Lemma hold_eAND : forall k r1 r2, hold k (eAND k r1 r2) <-> (hold k r1 /\ hold k r2). Proof. - destruct k ; simpl. + intros k; destruct k ; simpl. - intros. apply iff_refl. - apply andb_true_iff. Qed. @@ -1714,7 +1723,7 @@ Section S. Lemma hold_eOR : forall k r1 r2, hold k (eOR k r1 r2) <-> (hold k r1 \/ hold k r2). Proof. - destruct k ; simpl. + intros k; destruct k ; simpl. - intros. apply iff_refl. - apply orb_true_iff. Qed. @@ -1722,9 +1731,9 @@ Section S. Lemma hold_eNOT : forall k e, hold k (eNOT k e) <-> not (hold k e). Proof. - destruct k ; simpl. + intros k; destruct k ; simpl. - intros. apply iff_refl. - - intros. unfold is_true. + - intros e. unfold is_true. rewrite negb_true_iff. destruct e ; intuition congruence. Qed. @@ -1732,9 +1741,9 @@ Section S. Lemma hold_eIMPL : forall k e1 e2, hold k (eIMPL k e1 e2) <-> (hold k e1 -> hold k e2). Proof. - destruct k ; simpl. + intros k; destruct k ; simpl. - intros. apply iff_refl. - - intros. + - intros e1 e2. unfold is_true. destruct e1,e2 ; simpl ; intuition congruence. Qed. @@ -1742,9 +1751,9 @@ Section S. Lemma hold_eIFF : forall k e1 e2, hold k (eIFF k e1 e2) <-> (hold k e1 <-> hold k e2). Proof. - destruct k ; simpl. + intros k; destruct k ; simpl. - intros. apply iff_refl. - - intros. + - intros e1 e2. unfold is_true. rewrite eqb_true_iff. destruct e1,e2 ; simpl ; intuition congruence. @@ -1768,7 +1777,7 @@ Section S. eval_cnf env (xcnf pol (IMPL f1 o f2)) -> hold k (eval_f e_rtyp (eval env) (if pol then IMPL f1 o f2 else NOT (IMPL f1 o f2))). Proof. - simpl; intros. unfold mk_impl in H. + simpl; intros k f1 o f2 IHf1 IHf2 pol env H. unfold mk_impl in H. destruct pol. + simpl. rewrite hold_eIMPL. @@ -1810,7 +1819,7 @@ Section S. hold isBool (eIFF isBool e1 e2) <-> e1 = e2. Proof. simpl. - destruct e1,e2 ; simpl ; intuition congruence. + intros e1 e2; destruct e1,e2 ; simpl ; intuition congruence. Qed. @@ -1828,7 +1837,7 @@ Section S. hold k (eval_f e_rtyp (eval env) (if pol then IFF f1 f2 else NOT (IFF f1 f2))). Proof. simpl. - intros. + intros k f1 f2 IHf1 IHf2 pol env H. rewrite mk_iff_is_bool in H. unfold mk_iff in H. destruct pol; @@ -1858,7 +1867,10 @@ Section S. Lemma xcnf_correct : forall (k: kind) (f : @GFormula Term rtyp Annot unit k) pol env, eval_cnf env (xcnf pol f) -> hold k (eval_f e_rtyp (eval env) (if pol then f else NOT f)). Proof. - induction f. + intros k f; + induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf + |? ? IHf1 ? ? IHf2|? ? IHf1 f2 IHf2|f1 IHf1 f2 IHf2]; + intros pol env H. - (* TT *) unfold eval_cnf. simpl. @@ -1881,13 +1893,13 @@ Section S. intros. eapply negate_correct ; eauto. - (* AND *) - destruct pol ; simpl. + destruct pol ; simpl in H. + (* pol = true *) intros. rewrite eval_cnf_and_opt in H. unfold and_cnf in H. rewrite eval_cnf_app in H. - destruct H. + destruct H as [H H0]. apply hold_eAND; split. apply (IHf1 _ _ H). apply (IHf2 _ _ H0). @@ -1907,7 +1919,7 @@ Section S. rewrite hold_eNOT. tauto. - (* OR *) - simpl. + simpl in H. destruct pol. + (* pol = true *) intros. unfold mk_or in H. @@ -1947,8 +1959,8 @@ Section S. - (* IMPL *) apply xcnf_impl; auto. - apply xcnf_iff ; auto. - - simpl. - destruct (is_bool f2) eqn:EQ. + - simpl in H. + destruct (is_bool f2) as [b|] eqn:EQ. + apply is_bool_inv in EQ. destruct b; subst; intros; apply IHf1 in H; @@ -1996,17 +2008,17 @@ Section S. Lemma cnf_checker_sound : forall t w, cnf_checker t w = true -> forall env, eval_cnf env t. Proof. unfold eval_cnf. - induction t. + intros t; induction t as [|a t IHt]. (* bc *) simpl. auto. (* ic *) simpl. - destruct w. + intros w; destruct w as [|w ?]. intros ; discriminate. - case_eq (checker a w) ; intros ; try discriminate. + case_eq (checker a w) ; intros H H0 env ** ; try discriminate. generalize (@checker_sound _ _ H env). - generalize (IHt _ H0 env) ; intros. + generalize (IHt _ H0 env) ; intros H1 H2. destruct t. red ; intro. rewrite <- make_conj_impl in H2. @@ -2021,7 +2033,7 @@ Section S. Lemma tauto_checker_sound : forall t w, tauto_checker t w = true -> forall env, eval_f e_rtyp (eval env) t. Proof. unfold tauto_checker. - intros. + intros t w H env. change (eval_f e_rtyp (eval env) t) with (eval_f e_rtyp (eval env) (if true then t else TT isProp)). apply (xcnf_correct t true). eapply cnf_checker_sound ; eauto. @@ -2032,7 +2044,10 @@ Section S. Lemma eval_bf_map : forall T U (fct: T-> U) env (k: kind) (f:BFormula T k) , eval_bf env (map_bformula fct f) = eval_bf (fun b x => env b (fct x)) f. Proof. - induction f ; simpl ; try (rewrite IHf1 ; rewrite IHf2) ; auto. + intros T U fct env k f; + induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf + |? ? IHf1 ? ? IHf2|? ? IHf1 ? IHf2|? IHf1 ? IHf2]; + simpl ; try (rewrite IHf1 ; rewrite IHf2) ; auto. rewrite <- IHf. auto. Qed. diff --git a/theories/micromega/ZCoeff.v b/theories/micromega/ZCoeff.v index 4e04adaddb..aaaeb9e118 100644 --- a/theories/micromega/ZCoeff.v +++ b/theories/micromega/ZCoeff.v @@ -121,7 +121,7 @@ Qed. Lemma phi_pos1_pos : forall x : positive, 0 < phi_pos1 x. Proof. -induction x as [x IH | x IH |]; simpl; +intros x; induction x as [x IH | x IH |]; simpl; try apply (Rplus_pos_pos sor); try apply (Rtimes_pos_pos sor); try apply (Rplus_pos_pos sor); try apply (Rlt_0_1 sor); assumption. Qed. diff --git a/theories/micromega/ZifyClasses.v b/theories/micromega/ZifyClasses.v index 37eef12381..f6ade67c5f 100644 --- a/theories/micromega/ZifyClasses.v +++ b/theories/micromega/ZifyClasses.v @@ -210,7 +210,7 @@ Qed. Lemma eq_iff : forall (P Q : Prop), P = Q -> (P <-> Q). Proof. - intros. + intros P Q H. rewrite H. apply iff_refl. Defined. diff --git a/theories/micromega/ZifyInst.v b/theories/micromega/ZifyInst.v index 0e135ba793..9881e73f76 100644 --- a/theories/micromega/ZifyInst.v +++ b/theories/micromega/ZifyInst.v @@ -139,7 +139,7 @@ Add Zify BinRel Op_pos_le. Lemma eq_pos_inj : forall (x y:positive), x = y <-> Z.pos x = Z.pos y. Proof. - intros. + intros x y. apply (iff_sym (Pos2Z.inj_iff x y)). Qed. @@ -186,7 +186,7 @@ Add Zify UnOp Op_pos_pred. Instance Op_pos_predN : UnOp Pos.pred_N := { TUOp := fun x => x - 1 ; - TUOpInj := ltac: (now destruct x; rewrite N.pos_pred_spec) }. + TUOpInj x := ltac: (now destruct x; rewrite N.pos_pred_spec) }. Add Zify UnOp Op_pos_predN. Instance Op_pos_of_succ_nat : UnOp Pos.of_succ_nat := @@ -195,7 +195,7 @@ Add Zify UnOp Op_pos_of_succ_nat. Instance Op_pos_of_nat : UnOp Pos.of_nat := { TUOp := fun x => Z.max 1 x ; - TUOpInj := ltac: (now destruct x; + TUOpInj x := ltac: (now destruct x; [|rewrite <- Pos.of_nat_succ, <- (Nat2Z.inj_max 1)]) }. Add Zify UnOp Op_pos_of_nat. @@ -445,7 +445,7 @@ Add Zify UnOp Op_Z_quot2. Lemma of_nat_to_nat_eq : forall x, Z.of_nat (Z.to_nat x) = Z.max 0 x. Proof. - destruct x. + intros x; destruct x. - reflexivity. - rewrite Z2Nat.id. reflexivity. diff --git a/theories/micromega/Ztac.v b/theories/micromega/Ztac.v index 5fb92aba44..a97ea85ceb 100644 --- a/theories/micromega/Ztac.v +++ b/theories/micromega/Ztac.v @@ -26,7 +26,7 @@ Qed. Lemma elim_concl_eq : forall x y, (x < y \/ y < x -> False) -> x = y. Proof. - intros. + intros x y H. destruct (Z_lt_le_dec x y). exfalso. apply H ; auto. destruct (Zle_lt_or_eq y x);auto. @@ -37,7 +37,7 @@ Qed. Lemma elim_concl_le : forall x y, (y < x -> False) -> x <= y. Proof. - intros. + intros x y H. destruct (Z_lt_le_dec y x). exfalso ; auto. auto. @@ -46,7 +46,7 @@ Qed. Lemma elim_concl_lt : forall x y, (y <= x -> False) -> x < y. Proof. - intros. + intros x y H. destruct (Z_lt_le_dec x y). auto. exfalso ; auto. @@ -93,7 +93,7 @@ Qed. Lemma mul_le : forall e1 e2, 0 <= e1 -> 0 <= e2 -> 0 <= e1*e2. Proof. - intros. + intros e1 e2 H H0. change 0 with (0* e2). apply Zmult_le_compat_r; auto. Qed. diff --git a/theories/setoid_ring/InitialRing.v b/theories/setoid_ring/InitialRing.v index bb98a447dc..c33beaf8cd 100644 --- a/theories/setoid_ring/InitialRing.v +++ b/theories/setoid_ring/InitialRing.v @@ -104,7 +104,7 @@ Section ZMORPHISM. Lemma get_signZ_th : sign_theory Z.opp Zeq_bool get_signZ. Proof. constructor. - destruct c;intros;try discriminate. + intros c;destruct c;intros ? H;try discriminate. injection H as [= <-]. simpl. unfold Zeq_bool. rewrite Z.compare_refl. trivial. Qed. @@ -119,7 +119,7 @@ Section ZMORPHISM. Lemma same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x. Proof. - induction x;simpl. + intros x;induction x as [x IHx|x IHx|];simpl. rewrite IHx;destruct x;simpl;norm. rewrite IHx;destruct x;simpl;norm. rrefl. @@ -128,7 +128,7 @@ Section ZMORPHISM. Lemma ARgen_phiPOS_Psucc : forall x, gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x). Proof. - induction x;simpl;norm. + intros x;induction x as [x IHx|x IHx|];simpl;norm. rewrite IHx;norm. add_push 1;rrefl. Qed. @@ -136,7 +136,8 @@ Section ZMORPHISM. Lemma ARgen_phiPOS_add : forall x y, gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y). Proof. - induction x;destruct y;simpl;norm. + intros x;induction x as [x IHx|x IHx|]; + intros y;destruct y as [y|y|];simpl;norm. rewrite Pos.add_carry_spec. rewrite ARgen_phiPOS_Psucc. rewrite IHx;norm. @@ -152,7 +153,7 @@ Section ZMORPHISM. Lemma ARgen_phiPOS_mult : forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y. Proof. - induction x;intros;simpl;norm. + intros x;induction x as [x IHx|x IHx|];intros;simpl;norm. rewrite ARgen_phiPOS_add;simpl;rewrite IHx;norm. rewrite IHx;rrefl. Qed. @@ -169,7 +170,7 @@ Section ZMORPHISM. (*morphisms are extensionally equal*) Lemma same_genZ : forall x, [x] == gen_phiZ1 x. Proof. - destruct x;simpl; try rewrite (same_gen ARth);rrefl. + intros x;destruct x;simpl; try rewrite (same_gen ARth);rrefl. Qed. Lemma gen_Zeqb_ok : forall x y, @@ -198,7 +199,7 @@ Section ZMORPHISM. Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y]. Proof. intros x y; repeat rewrite same_genZ; generalize x y;clear x y. - destruct x, y; simpl; norm. + intros x y;destruct x, y; simpl; norm. apply (ARgen_phiPOS_add ARth). apply gen_phiZ1_pos_sub. rewrite gen_phiZ1_pos_sub. apply (Radd_comm Rth). @@ -301,7 +302,7 @@ Section NMORPHISM. Lemma same_genN : forall x, [x] == gen_phiN1 x. Proof. - destruct x;simpl. reflexivity. + intros x;destruct x;simpl. reflexivity. now rewrite (same_gen Rsth Reqe ARth). Qed. @@ -421,7 +422,7 @@ Section NWORDMORPHISM. Lemma gen_phiNword0_ok : forall w, Nw_is0 w = true -> gen_phiNword w == 0. Proof. -induction w; simpl; intros; auto. +intros w; induction w as [|a w IHw]; simpl; intros; auto. reflexivity. destruct a. @@ -436,17 +437,17 @@ Qed. Lemma gen_phiNword_cons : forall w n, gen_phiNword (n::w) == gen_phiN rO rI radd rmul n - gen_phiNword w. -induction w. - destruct n; simpl; norm. +intros w; induction w. + intros n; destruct n; simpl; norm. - intros. + intros n. destruct n; norm. Qed. Lemma gen_phiNword_Nwcons : forall w n, gen_phiNword (Nwcons n w) == gen_phiN rO rI radd rmul n - gen_phiNword w. -destruct w; intros. - destruct n; norm. +intros w; destruct w; intros n0. + destruct n0; norm. unfold Nwcons. rewrite gen_phiNword_cons. @@ -455,13 +456,13 @@ Qed. Lemma gen_phiNword_ok : forall w1 w2, Nweq_bool w1 w2 = true -> gen_phiNword w1 == gen_phiNword w2. -induction w1; intros. +intros w1; induction w1 as [|a w1 IHw1]; intros w2 H. simpl. rewrite (gen_phiNword0_ok _ H). reflexivity. rewrite gen_phiNword_cons. - destruct w2. + destruct w2 as [|n w2]. simpl in H. destruct a; try discriminate. rewrite (gen_phiNword0_ok _ H). @@ -481,7 +482,7 @@ Qed. Lemma Nwadd_ok : forall x y, gen_phiNword (Nwadd x y) == gen_phiNword x + gen_phiNword y. -induction x; intros. +intros x; induction x as [|n x IHx]; intros y. simpl. norm. @@ -507,7 +508,7 @@ Qed. Lemma Nwscal_ok : forall n x, gen_phiNword (Nwscal n x) == gen_phiN rO rI radd rmul n * gen_phiNword x. -induction x; intros. +intros n x; induction x as [|a x IHx]; intros. norm. simpl Nwscal. @@ -521,7 +522,7 @@ Qed. Lemma Nwmul_ok : forall x y, gen_phiNword (Nwmul x y) == gen_phiNword x * gen_phiNword y. -induction x; intros. +intros x; induction x as [|a x IHx]; intros. norm. destruct a. @@ -626,7 +627,7 @@ Qed. Lemma Ztriv_div_th : div_theory req Z.add Z.mul zphi Z.quotrem. Proof. constructor. - intros; generalize (Z.quotrem_eq a b); case Z.quotrem; intros; subst. + intros a b; generalize (Z.quotrem_eq a b); case Z.quotrem; intros; subst. rewrite Z.mul_comm; rsimpl. Qed. @@ -634,7 +635,7 @@ Qed. Lemma Ntriv_div_th : div_theory req N.add N.mul nphi N.div_eucl. constructor. - intros; generalize (N.div_eucl_spec a b); case N.div_eucl; intros; subst. + intros a b; generalize (N.div_eucl_spec a b); case N.div_eucl; intros; subst. rewrite N.mul_comm; rsimpl. Qed. diff --git a/theories/setoid_ring/Ring.v b/theories/setoid_ring/Ring.v index a66037a956..25b79d1fb2 100644 --- a/theories/setoid_ring/Ring.v +++ b/theories/setoid_ring/Ring.v @@ -17,22 +17,22 @@ Require Export Ring_tac. Lemma BoolTheory : ring_theory false true xorb andb xorb (fun b:bool => b) (eq(A:=bool)). split; simpl. -destruct x; reflexivity. -destruct x; destruct y; reflexivity. -destruct x; destruct y; destruct z; reflexivity. +intros x; destruct x; reflexivity. +intros x y; destruct x; destruct y; reflexivity. +intros x y z; destruct x; destruct y; destruct z; reflexivity. reflexivity. -destruct x; destruct y; reflexivity. -destruct x; destruct y; reflexivity. -destruct x; destruct y; destruct z; reflexivity. +intros x y; destruct x; destruct y; reflexivity. +intros x y; destruct x; destruct y; reflexivity. +intros x y z; destruct x; destruct y; destruct z; reflexivity. reflexivity. -destruct x; reflexivity. +intros x; destruct x; reflexivity. Qed. Definition bool_eq (b1 b2:bool) := if b1 then b2 else negb b2. Lemma bool_eq_ok : forall b1 b2, bool_eq b1 b2 = true -> b1 = b2. -destruct b1; destruct b2; auto. +intros b1 b2; destruct b1; destruct b2; auto. Qed. Ltac bool_cst t := diff --git a/theories/setoid_ring/Ring_polynom.v b/theories/setoid_ring/Ring_polynom.v index a13b1fc738..0efd82c9bd 100644 --- a/theories/setoid_ring/Ring_polynom.v +++ b/theories/setoid_ring/Ring_polynom.v @@ -559,7 +559,9 @@ Section MakeRingPol. Lemma Peq_ok P P' : (P ?== P') = true -> P === P'. Proof. unfold Pequiv. - revert P';induction P;destruct P';simpl; intros H l; try easy. + revert P';induction P as [|p P IHP|P2 IHP1 p P3 IHP2]; + intros P';destruct P' as [|p0 P'|P'1 p0 P'2];simpl; + intros H l; try easy. - now apply (morph_eq CRmorph). - destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. now rewrite IHP. @@ -643,13 +645,13 @@ Section MakeRingPol. Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c]. Proof. - revert l;induction P;simpl;intros;Esimpl;trivial. + revert l;induction P as [| |P2 IHP1 p P3 IHP2];simpl;intros;Esimpl;trivial. rewrite IHP2;rsimpl. Qed. Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c]. Proof. - revert l;induction P;simpl;intros. + revert l;induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - Esimpl. - rewrite IHP;rsimpl. - rewrite IHP2;rsimpl. @@ -657,7 +659,7 @@ Section MakeRingPol. Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c]. Proof. - revert l;induction P;simpl;intros;Esimpl;trivial. + revert l;induction P as [| |P2 IHP1 p P3 IHP2];simpl;intros;Esimpl;trivial. rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut. Qed. @@ -673,7 +675,7 @@ Section MakeRingPol. Lemma Popp_ok P l : (--P)@l == - P@l. Proof. - revert l;induction P;simpl;intros. + revert l;induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - Esimpl. - apply IHP. - rewrite IHP1, IHP2;rsimpl. @@ -686,7 +688,7 @@ Section MakeRingPol. (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k. Proof. intros IHP'. - revert k l. induction P;simpl;intros. + revert k l. induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - add_permut. - destruct p; simpl; rewrite ?jump_pred_double; add_permut. @@ -698,8 +700,9 @@ Section MakeRingPol. Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l. Proof. - revert P l; induction P';simpl;intros;Esimpl. - - revert p l; induction P;simpl;intros. + revert P l; induction P' as [|p P' IHP'|P'1 IHP'1 p P'2 IHP'2]; + simpl;intros P l;Esimpl. + - revert p l; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * now rewrite IHP'. @@ -709,7 +712,7 @@ Section MakeRingPol. * rewrite IHP2;simpl. rsimpl. * rewrite IHP2;simpl. rewrite jump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - - destruct P;simpl. + - destruct P as [|p0 ?|? ? ?];simpl. + Esimpl. add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rsimpl. add_permut. @@ -725,14 +728,15 @@ Section MakeRingPol. Lemma Psub_opp P' P : P -- P' === P ++ (--P'). Proof. - revert P; induction P'; simpl; intros. + revert P; induction P' as [|p P' IHP'|P'1 IHP'1 p P'2 IHP'2]; simpl; intros P. - intro l; Esimpl. - - revert p; induction P; simpl; intros; try reflexivity. + - revert p; induction P; simpl; intros p0; try reflexivity. + destr_pos_sub; intros ->; now apply mkPinj_ext. + destruct p0; now apply PX_ext. - - destruct P; simpl; try reflexivity. + - destruct P as [|p0 P|P2 p0 P3]; simpl; try reflexivity. + destruct p0; now apply PX_ext. + destr_pos_sub; intros ->; apply mkPX_ext; auto. + let p1 := match goal with |- PsubX _ _ ?p1 _ === _ => p1 end in revert p1. induction P2; simpl; intros; try reflexivity. destr_pos_sub; intros ->; now apply mkPX_ext. Qed. @@ -746,8 +750,8 @@ Section MakeRingPol. (forall P l, (Pmul P P') @ l == P @ l * P' @ l) -> forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l). Proof. - intros IHP'. - induction P;simpl;intros. + intros IHP' P. + induction P as [|p P IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. - Esimpl; mul_permut. - destr_pos_sub; intros ->;Esimpl. + now rewrite IHP'. @@ -761,10 +765,10 @@ Section MakeRingPol. Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l. Proof. - revert P l;induction P';simpl;intros. + revert P l;induction P' as [| |? IHP'1 ? ? IHP'2];simpl;intros P l. - apply PmulC_ok. - apply PmulI_ok;trivial. - - destruct P. + - destruct P as [|p0|]. + rewrite (ARmul_comm ARth). Esimpl. + Esimpl. f_equiv. rewrite IHP'1; Esimpl. destruct p0;rewrite IHP'2;Esimpl. @@ -821,7 +825,8 @@ Section MakeRingPol. P@l == Q@l + [c] * M@@l * R@l. Proof. destruct cM as (c,M). revert M l. - induction P; destruct M; intros l; simpl; auto; + induction P as [c0|p P ?|P2 ? ? P3 ?]; intros M; destruct M; intros l; + simpl; auto; try (case ceqb_spec; intro He); try (case Pos.compare_spec; intros He); rewrite ?He; @@ -858,7 +863,7 @@ Section MakeRingPol. [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == (PNSubst1 P1 cM1 P2 n)@l. Proof. - revert P1. induction n; simpl; intros P1; + revert P1. induction n as [|n IHn]; simpl; intros P1; generalize (POneSubst_ok P1 cM1 P2); destruct POneSubst; intros; rewrite <- ?IHn; auto; reflexivity. Qed. @@ -890,7 +895,7 @@ Section MakeRingPol. Lemma PSubstL_ok n LM1 P1 P2 l : PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l. Proof. - revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros. + revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros P3 H **. - discriminate. - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst. * injection H as [= <-]. rewrite <- PSubstL1_ok; intuition. @@ -900,7 +905,7 @@ Section MakeRingPol. Lemma PNSubstL_ok m n LM1 P1 l : MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l. Proof. - revert LM1 P1. induction m; simpl; intros; + revert LM1 P1. induction m as [|m IHm]; simpl; intros LM1 P2 H; assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL; auto; try reflexivity. rewrite <- IHm; auto. @@ -979,7 +984,8 @@ Section POWER. forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l. Proof. intros subst_l_ok res P p. revert res. - induction p;simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; + induction p as [p IHp|p IHp|];simpl;intros; + rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; mul_permut. Qed. @@ -987,7 +993,7 @@ Section POWER. (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l. Proof. - destruct n;simpl. + intros ? P n; destruct n;simpl. - reflexivity. - rewrite Ppow_pos_ok by trivial. Esimpl. Qed. @@ -1057,8 +1063,9 @@ Section POWER. PEeval l pe == (norm_aux pe)@l. Proof. intros. - induction pe; cbn. - - now rewrite (morph0 CRmorph). + induction pe as [| |c|p|pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2 + |? IHpe|? IHpe n0]; cbn. + - now rewrite (morph0 CRmorph). - now rewrite (morph1 CRmorph). - reflexivity. - apply mkX_ok. @@ -1071,8 +1078,9 @@ Section POWER. - rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - rewrite IHpe. Esimpl. - rewrite Ppow_N_ok by reflexivity. - rewrite (rpow_pow_N pow_th). destruct n0; simpl; Esimpl. - induction p;simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. + rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. + induction p as [p IHp|p IHp|];simpl; + now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. Qed. Lemma norm_subst_spec : @@ -1125,7 +1133,7 @@ Section POWER. Lemma mon_of_pol_ok : forall P m, mon_of_pol P = Some m -> forall l, [fst m] * Mphi l (snd m) == P@l. Proof. - induction P;simpl;intros;Esimpl. + intros P; induction P as [c|p P IHP|P2 IHP1 ? P3 ?];simpl;intros m H l;Esimpl. assert (H1 := (morph_eq CRmorph) c cO). destruct (c ?=! cO). discriminate. @@ -1142,7 +1150,7 @@ Section POWER. end with (P3 ?== P0). assert (H := Peq_ok P3 P0). destruct (P3 ?== P0). - case_eq (mon_of_pol P2);try intros (cc, pp); intros. + case_eq (mon_of_pol P2);try intros (cc, pp); intros H0 H1. inversion H1. simpl. rewrite mkVmon_ok;simpl. @@ -1155,16 +1163,16 @@ Section POWER. Lemma interp_PElist_ok : forall l lpe, interp_PElist l lpe -> MPcond (mk_monpol_list lpe) l. Proof. - induction lpe;simpl. trivial. - destruct a;simpl;intros. + intros l lpe; induction lpe as [|a lpe IHlpe];simpl. trivial. + destruct a as [p p0];simpl;intros H. assert (HH:=mon_of_pol_ok (norm_subst 0 nil p)); destruct (mon_of_pol (norm_subst 0 nil p)). split. rewrite <- norm_subst_spec by exact I. - destruct lpe;try destruct H;rewrite <- H; + destruct lpe;try destruct H as [H H0];rewrite <- H; rewrite (norm_subst_spec 0 nil); try exact I;apply HH;trivial. - apply IHlpe. destruct lpe;simpl;trivial. destruct H. exact H0. - apply IHlpe. destruct lpe;simpl;trivial. destruct H. exact H0. + apply IHlpe. destruct lpe;simpl;trivial. destruct H as [H H0]. exact H0. + apply IHlpe. destruct lpe;simpl;trivial. destruct H as [H H0]. exact H0. Qed. Lemma norm_subst_ok : forall n l lpe pe, @@ -1180,7 +1188,7 @@ Section POWER. norm_subst n lmp pe1 ?== norm_subst n lmp pe2) = true -> PEeval l pe1 == PEeval l pe2. Proof. - simpl;intros. + simpl;intros n l lpe pe1 pe2 **. do 2 (rewrite (norm_subst_ok n l lpe);trivial). apply Peq_ok;trivial. Qed. @@ -1285,36 +1293,36 @@ Section POWER. Lemma mkmult_rec_ok : forall lm r, mkmult_rec r lm == r * r_list_pow lm. Proof. - induction lm;intros;simpl;Esimpl. + intros lm; induction lm as [|a lm IHlm];intros;simpl;Esimpl. destruct a as (x,p);Esimpl. rewrite IHlm. rewrite mkmult_pow_spec. Esimpl. Qed. Lemma mkmult1_ok : forall lm, mkmult1 lm == r_list_pow lm. Proof. - destruct lm;simpl;Esimpl. + intros lm; destruct lm as [|p lm];simpl;Esimpl. destruct p. rewrite mkmult_rec_ok;rewrite mkpow_spec;Esimpl. Qed. Lemma mkmultm1_ok : forall lm, mkmultm1 lm == - r_list_pow lm. Proof. - destruct lm;simpl;Esimpl. + intros lm; destruct lm as [|p lm];simpl;Esimpl. destruct p;rewrite mkmult_rec_ok. rewrite mkopp_pow_spec;Esimpl. Qed. Lemma r_list_pow_rev : forall l, r_list_pow (rev' l) == r_list_pow l. Proof. assert - (forall l lr : list (R * positive), r_list_pow (rev_append l lr) == r_list_pow lr * r_list_pow l). - induction l;intros;simpl;Esimpl. - destruct a;rewrite IHl;Esimpl. + (forall l lr : list (R * positive), r_list_pow (rev_append l lr) == r_list_pow lr * r_list_pow l) as H. + intros l; induction l as [|a l IHl];intros;simpl;Esimpl. + destruct a as [r p];rewrite IHl;Esimpl. rewrite (ARmul_comm ARth (pow_pos rmul r p)). reflexivity. intros;unfold rev'. rewrite H;simpl;Esimpl. Qed. Lemma mkmult_c_pos_ok : forall c lm, mkmult_c_pos c lm == [c]* r_list_pow lm. Proof. - intros;unfold mkmult_c_pos;simpl. + intros c lm;unfold mkmult_c_pos;simpl. assert (H := (morph_eq CRmorph) c cI). rewrite <- r_list_pow_rev; destruct (c ?=! cI). rewrite H;trivial;Esimpl. @@ -1323,8 +1331,8 @@ Section POWER. Lemma mkmult_c_ok : forall c lm, mkmult_c c lm == [c] * r_list_pow lm. Proof. - intros;unfold mkmult_c;simpl. - case_eq (get_sign c);intros. + intros c lm;unfold mkmult_c;simpl. + case_eq (get_sign c);intros c0; try intros H. assert (H1 := (morph_eq CRmorph) c0 cI). destruct (c0 ?=! cI). rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H)). Esimpl. rewrite H1;trivial. @@ -1336,8 +1344,8 @@ Qed. Lemma mkadd_mult_ok : forall rP c lm, mkadd_mult rP c lm == rP + [c]*r_list_pow lm. Proof. - intros;unfold mkadd_mult. - case_eq (get_sign c);intros. + intros rP c lm;unfold mkadd_mult. + case_eq (get_sign c);intros c0; try intros H. rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H));Esimpl. rewrite mkmult_c_pos_ok;Esimpl. rewrite mkmult_c_pos_ok;Esimpl. @@ -1346,13 +1354,13 @@ Qed. Lemma add_pow_list_ok : forall r n l, r_list_pow (add_pow_list r n l) == pow_N rI rmul r n * r_list_pow l. Proof. - destruct n;simpl;intros;Esimpl. + intros r n; destruct n;simpl;intros;Esimpl. Qed. Lemma add_mult_dev_ok : forall P rP fv n lm, add_mult_dev rP P fv n lm == rP + P@fv*pow_N rI rmul (hd fv) n * r_list_pow lm. Proof. - induction P;simpl;intros. + intros P; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros rP fv n lm. rewrite mkadd_mult_ok. rewrite add_pow_list_ok; Esimpl. rewrite IHP. simpl. rewrite add_pow_list_ok; Esimpl. change (match P3 with @@ -1377,7 +1385,7 @@ Qed. Lemma mult_dev_ok : forall P fv n lm, mult_dev P fv n lm == P@fv * pow_N rI rmul (hd fv) n * r_list_pow lm. Proof. - induction P;simpl;intros;Esimpl. + intros P; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros fv n lm;Esimpl. rewrite mkmult_c_ok;rewrite add_pow_list_ok;Esimpl. rewrite IHP. simpl;rewrite add_pow_list_ok;Esimpl. change (match P3 with @@ -1463,7 +1471,7 @@ Qed. Lemma mkmult_pow_ok p r x : mkmult_pow r x p == r * x^p. Proof. - revert r; induction p;intros;simpl;Esimpl;rewrite !IHp;Esimpl. + revert r; induction p as [p IHp|p IHp|];intros;simpl;Esimpl;rewrite !IHp;Esimpl. Qed. Lemma mkpow_ok p x : mkpow x p == x^p. diff --git a/user-contrib/Ltac2/g_ltac2.mlg b/user-contrib/Ltac2/g_ltac2.mlg index 6749169e8c..65b61a0d93 100644 --- a/user-contrib/Ltac2/g_ltac2.mlg +++ b/user-contrib/Ltac2/g_ltac2.mlg @@ -146,6 +146,8 @@ GRAMMAR EXTEND Gram { CAst.make ~loc @@ CTacLet (isrec, lc, e) } | "match"; e = ltac2_expr LEVEL "5"; "with"; bl = branches; "end" -> { CAst.make ~loc @@ CTacCse (e, bl) } + | "if"; e = ltac2_expr LEVEL "5"; "then"; e1 = ltac2_expr LEVEL "5"; "else"; e2 = ltac2_expr LEVEL "5" -> + { CAst.make ~loc @@ CTacIft (e, e1, e2) } ] | "4" LEFTA [ ] | "3" [ e0 = SELF; ","; el = LIST1 NEXT SEP "," -> diff --git a/user-contrib/Ltac2/tac2expr.mli b/user-contrib/Ltac2/tac2expr.mli index 548655f561..0ae016265a 100644 --- a/user-contrib/Ltac2/tac2expr.mli +++ b/user-contrib/Ltac2/tac2expr.mli @@ -105,6 +105,7 @@ type raw_tacexpr_r = | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * raw_tacexpr | CTacCnv of raw_tacexpr * raw_typexpr | CTacSeq of raw_tacexpr * raw_tacexpr +| CTacIft of raw_tacexpr * raw_tacexpr * raw_tacexpr | CTacCse of raw_tacexpr * raw_taccase list | CTacRec of raw_recexpr | CTacPrj of raw_tacexpr * ltac_projection or_relid diff --git a/user-contrib/Ltac2/tac2intern.ml b/user-contrib/Ltac2/tac2intern.ml index 797f72702d..ddf70a5a65 100644 --- a/user-contrib/Ltac2/tac2intern.ml +++ b/user-contrib/Ltac2/tac2intern.ml @@ -29,6 +29,7 @@ let t_string = coq_type "string" let t_constr = coq_type "constr" let t_ltac1 = ltac1_type "t" let t_preterm = coq_type "preterm" +let t_bool = coq_type "bool" (** Union find *) @@ -749,6 +750,15 @@ let rec intern_rec env {loc;v=e} = match e with let (e2, t2) = intern_rec env e2 in let () = check_elt_unit loc1 env t1 in (GTacLet (false, [Anonymous, e1], e2), t2) +| CTacIft (e, e1, e2) -> + let loc = e.loc in + let loc1 = e1.loc in + let (e, t) = intern_rec env e in + let (e1, t1) = intern_rec env e1 in + let (e2, t2) = intern_rec env e2 in + let () = unify ?loc env t (GTypRef (Other t_bool, [])) in + let () = unify ?loc:loc1 env t1 t2 in + (GTacCse (e, Other t_bool, [|e1; e2|], [||]), t2) | CTacCse (e, pl) -> intern_case env loc e pl | CTacRec fs -> @@ -1271,6 +1281,11 @@ let rec globalize ids ({loc;v=er} as e) = match er with let e1 = globalize ids e1 in let e2 = globalize ids e2 in CAst.make ?loc @@ CTacSeq (e1, e2) +| CTacIft (e, e1, e2) -> + let e = globalize ids e in + let e1 = globalize ids e1 in + let e2 = globalize ids e2 in + CAst.make ?loc @@ CTacIft (e, e1, e2) | CTacCse (e, bl) -> let e = globalize ids e in let bl = List.map (fun b -> globalize_case ids b) bl in @@ -1486,6 +1501,11 @@ let rec subst_rawexpr subst ({loc;v=tr} as t) = match tr with let e1' = subst_rawexpr subst e1 in let e2' = subst_rawexpr subst e2 in if e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacSeq (e1', e2') +| CTacIft (e, e1, e2) -> + let e' = subst_rawexpr subst e in + let e1' = subst_rawexpr subst e1 in + let e2' = subst_rawexpr subst e2 in + if e' == e && e1' == e1 && e2' == e2 then t else CAst.make ?loc @@ CTacIft (e', e1', e2') | CTacCse (e, bl) -> let map (p, e as x) = let p' = subst_rawpattern subst p in diff --git a/vernac/classes.ml b/vernac/classes.ml index d5509e2697..a100352145 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -57,7 +57,7 @@ let is_local_for_hint i = let add_instance_base inst = let locality = if is_local_for_hint inst then Goptions.OptLocal else Goptions.OptGlobal in - add_instance_hint (Hints.IsGlobRef inst.is_impl) [inst.is_impl] ~locality + add_instance_hint (Hints.hint_globref inst.is_impl) [inst.is_impl] ~locality inst.is_info let mk_instance cl info glob impl = diff --git a/vernac/comHints.ml b/vernac/comHints.ml index 9eac558908..f642411fa4 100644 --- a/vernac/comHints.ml +++ b/vernac/comHints.ml @@ -62,7 +62,7 @@ let project_hint ~poly pri l2r r = cb in let info = {Typeclasses.hint_priority = pri; hint_pattern = None} in - (info, true, Hints.PathAny, Hints.IsGlobRef (GlobRef.ConstRef c)) + (info, true, Hints.PathAny, Hints.hint_globref (GlobRef.ConstRef c)) let warn_deprecated_hint_constr = CWarnings.create ~name:"fragile-hint-constr" ~category:"automation" @@ -84,16 +84,6 @@ let soft_evaluable = 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, Some diff) [@ocaml.warning "-3"]) - else - let () = DeclareUctx.declare_universe_context ~poly:false diff in - (Hints.IsConstr (c, None) [@ocaml.warning "-3"]) - in let fref r = let gr = Smartlocate.global_with_alias r in Dumpglob.add_glob ?loc:r.CAst.loc gr; @@ -106,10 +96,22 @@ let interp_hints ~poly h = match c with | HintsReference c -> let gr = Smartlocate.global_with_alias c in - (PathHints [gr], IsGlobRef gr) + (PathHints [gr], hint_globref gr) | HintsConstr c -> let () = warn_deprecated_hint_constr () in - (PathAny, f poly c) + let env = Global.env () in + let sigma = Evd.from_env env in + let c, uctx = Constrintern.interp_constr env sigma c in + let subst, uctx = UState.normalize_variables uctx in + let c = EConstr.Vars.subst_univs_constr subst c in + let diff = UState.context_set uctx in + let c = + if poly then (c, Some diff) + else + let () = DeclareUctx.declare_universe_context ~poly:false diff in + (c, None) + in + (PathAny, Hints.hint_constr c) [@ocaml.warning "-3"] in let fp = Constrintern.intern_constr_pattern env sigma in let fres (info, b, r) = @@ -149,7 +151,7 @@ let interp_hints ~poly h = ( empty_hint_info , true , PathHints [gr] - , IsGlobRef gr )) + , hint_globref gr )) in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid)) | HintsExtern (pri, patcom, tacexp) -> diff --git a/vernac/comSearch.ml b/vernac/comSearch.ml index 9de8d6fbc3..f3b21eb813 100644 --- a/vernac/comSearch.ml +++ b/vernac/comSearch.ml @@ -53,7 +53,16 @@ let kind_searcher = Decls.(function let interp_search_item env sigma = function | SearchSubPattern ((where,head),pat) -> - let _,pat = Constrintern.intern_constr_pattern env sigma pat in + let expected_type = Pretyping.(if head then IsType else WithoutTypeConstraint) in + let pat = + try Constrintern.interp_constr_pattern env sigma ~expected_type pat + with e when CErrors.noncritical e -> + (* We cannot ensure (yet?) that a typable pattern will + actually be typed, consider e.g. (forall A, A -> A /\ A) + which fails, not seeing that A can be Prop; so we use an + untyped pattern as a fallback (i.e w/o no insertion of + coercions, no compilation of pattern-matching) *) + snd (Constrintern.intern_constr_pattern env sigma ~as_type:head pat) in GlobSearchSubPattern (where,head,pat) | SearchString ((Anywhere,false),s,None) when Id.is_valid s -> GlobSearchString s diff --git a/vernac/egramcoq.ml b/vernac/egramcoq.ml index 123ea2c24e..efe4e17d0b 100644 --- a/vernac/egramcoq.ml +++ b/vernac/egramcoq.ml @@ -408,8 +408,8 @@ match e with | TTClosedBinderList _ -> { subst with binderlists = List.flatten v :: subst.binderlists } | TTBigint -> begin match forpat with - | ForConstr -> push_constr subst (CAst.make @@ CPrim (Numeral (NumTok.Signed.of_int_string v))) - | ForPattern -> push_constr subst (CAst.make @@ CPatPrim (Numeral (NumTok.Signed.of_int_string v))) + | ForConstr -> push_constr subst (CAst.make @@ CPrim (Number (NumTok.Signed.of_int_string v))) + | ForPattern -> push_constr subst (CAst.make @@ CPatPrim (Number (NumTok.Signed.of_int_string v))) end | TTReference -> begin match forpat with diff --git a/vernac/search.ml b/vernac/search.ml index abefeab779..501e5b1a91 100644 --- a/vernac/search.ml +++ b/vernac/search.ml @@ -216,18 +216,16 @@ let name_of_reference ref = Id.to_string (Nametab.basename_of_global ref) let search_filter query gr kind env sigma typ = match query with | GlobSearchSubPattern (where,head,pat) -> let open Context.Rel.Declaration in - let collect_hyps ctx = - List.fold_left (fun acc d -> match get_value d with - | None -> get_type d :: acc - | Some b -> b :: get_type d :: acc) [] ctx in + let rec collect env hyps typ = + match Constr.kind typ with + | LetIn (na,b,t,c) -> collect (push_rel (LocalDef (na,b,t)) env) ((env,b) :: (env,t) :: hyps) c + | Prod (na,t,c) -> collect (push_rel (LocalAssum (na,t)) env) ((env,t) :: hyps) c + | _ -> (hyps,(env,typ)) in let typl= match where with - | InHyp -> collect_hyps (fst (Term.decompose_prod_assum typ)) - | InConcl -> [snd (Term.decompose_prod_assum typ)] - | Anywhere -> - if head then - let ctx, ccl = Term.decompose_prod_assum typ in ccl :: collect_hyps ctx - else [typ] in - List.exists (fun typ -> + | InHyp -> fst (collect env [] typ) + | InConcl -> [snd (collect env [] typ)] + | Anywhere -> if head then let hyps, ccl = collect env [] typ in ccl :: hyps else [env,typ] in + List.exists (fun (env,typ) -> let f = if head then Constr_matching.is_matching_head else Constr_matching.is_matching_appsubterm ~closed:false in diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index bc03994ca6..ef8631fbb6 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -985,9 +985,15 @@ let interp_filter_in m = function let vernac_import export refl = let import_mod (qid,f) = - let m = try Nametab.locate_module qid + let loc = qid.loc in + let m = try + let m = Nametab.locate_module qid in + let () = if Modops.is_functor (Global.lookup_module m).Declarations.mod_type + then CErrors.user_err ?loc Pp.(str "Cannot import functor " ++ pr_qualid qid ++ str".") + in + m with Not_found -> - CErrors.user_err Pp.(str "Cannot find module " ++ pr_qualid qid) + CErrors.user_err ?loc Pp.(str "Cannot find module " ++ pr_qualid qid) in let f = interp_filter_in m f in Declaremods.import_module f ~export m |