diff options
1436 files changed, 23404 insertions, 24291 deletions
diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 51fc2b035c..412bed8334 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -9,6 +9,7 @@ ########## Build system ########## /Makefile* @gares +/dev/tools/make_git_revision.sh @gares /configure* @ejgallego diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 4a8606a38a..73b61ee0d9 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -16,4 +16,4 @@ Fixes / closes #???? <!-- If this is a feature pull request / breaks compatibility: --> <!-- (Otherwise, remove these lines.) --> - [ ] Corresponding documentation was added / updated (including any warning and error messages added / removed / modified). -- [ ] Entry added in CHANGES. +- [ ] Entry added in CHANGES.md. @@ -18,6 +18,7 @@ Yves Bertot <yves.bertot@inria.fr> bertot <bertot@85f007b7-540e- Yves Bertot <yves.bertot@inria.fr> Yves Bertot <bertot@inria.fr> Yves Bertot <yves.bertot@inria.fr> Yves Bertot <Yves.Bertot@inria.fr> Frédéric Besson <frederic.besson@inria.fr> fbesson <fbesson@85f007b7-540e-0410-9357-904b9bb8a0f7> +Siddharth Bhat <siddu.druid@gmail.com> Siddharth <siddu.druid@gmail.com> Pierre Boutillier <pierre.boutillier@ens-lyon.org> pboutill <pboutill@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre <pierre.boutillier@ens-lyon.org> Pierre Boutillier <pierre.boutillier@ens-lyon.org> Pierre Boutillier <pierre.boutillier@pps.univ-paris-diderot.fr> @@ -31,6 +32,8 @@ Maxime Dénès <mail@maximedenes.fr> mdenes <mdenes@85f007b7-540 Maxime Dénès <mail@maximedenes.fr> Maxime Denes <maximedenes@gillespie.inria.fr> Olivier Desmettre <desmettr@gforge> desmettr <desmettr@85f007b7-540e-0410-9357-904b9bb8a0f7> Damien Doligez <doligez@gforge> doligez <doligez@85f007b7-540e-0410-9357-904b9bb8a0f7> +Andres Erbsen <andreser@mit.edu> Andres Erbsen <andres@kevix.co> +Jim Fehrle <jfehrle@sbcglobal.net> Jim <jfehrle@sbcglobal.net> Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> filliatr <filliatr@85f007b7-540e-0410-9357-904b9bb8a0f7> Jean-Christophe Filliâtre <Jean-Christophe.Filliatre@lri.fr> Jean-Christophe Filliatre <Jean-Christophe.Filliatre@lri.fr> Julien Forest <julien.forest@ensiie.fr> jforest <jforest@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -43,6 +46,7 @@ Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> <gaetan.gilbert@ens-lyon.fr> Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> <gaetan.gilbert@skyskimmer.net> Stéphane Glondu <steph@glondu.net> glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> Stéphane Glondu <steph@glondu.net> Stephane Glondu <steph@glondu.net> +Matěj Grabovský <mgrabovsky@yahoo.com> Matěj G <mgrabovsky@users.noreply.github.com> Benjamin Grégoire <benjamin.gregoire@inria.fr> Benjamin Gregoire <Benjamin.Gregoire@inria.fr> Benjamin Grégoire <benjamin.gregoire@inria.fr> bgregoir <bgregoir@85f007b7-540e-0410-9357-904b9bb8a0f7> Benjamin Grégoire <benjamin.gregoire@inria.fr> gregoire <gregoire@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -51,6 +55,7 @@ Jason Gross <jgross@mit.edu> Jason Gross <jasongross9@gmai Vincent Gross <vgross@gforge> vgross <vgross@85f007b7-540e-0410-9357-904b9bb8a0f7> Huang Guan-Shieng <huang@gforge> huang <huang@85f007b7-540e-0410-9357-904b9bb8a0f7> Hugo Herbelin <Hugo.Herbelin@inria.fr> herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> +Jasper Hugunin <jasperh@cs.washington.edu> Jasper Hugunin <jasper@hashplex.com> Tom Hutchinson <thutchin@gforge> thutchin <thutchin@85f007b7-540e-0410-9357-904b9bb8a0f7> Cezary Kaliszyk <cek@gforge> cek <cek@85f007b7-540e-0410-9357-904b9bb8a0f7> Florent Kirchner <fkirchne@gforge> fkirchne <fkirchne@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -58,6 +63,7 @@ Florent Kirchner <fkirchne@gforge> kirchner <kirchner@85f007b7-5 Johannes Kloos <jkloos@mpi-sws.org> jkloos <jkloos@mpi-sws.org> Matej Košík <matej.kosik@inria.fr> Matej Kosik <m4tej.kosik@gmail.com> Matej Košík <matej.kosik@inria.fr> Matej Kosik <matej.kosik@inria.fr> +Vincent Laporte <Vincent.Laporte@fondation-inria.fr> Vincent Laporte <Vincent.Laporte@gmail.com> Marc Lasson <marc.lasson@gmail.com> mlasson <marc.lasson@gmail.com> William Lawvere <mundungus.corleone@gmail.com> william-lawvere <mundungus.corleone@gmail.com> Pierre Letouzey <pierre.letouzey@inria.fr> letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -70,6 +76,7 @@ Lionel Elie Mamane <lmamane@gforge> lmamane <lmamane@85f007b7-540 Claude Marché <marche@gforge> marche <marche@85f007b7-540e-0410-9357-904b9bb8a0f7> Micaela Mayero <mayero@gforge> mayero <mayero@85f007b7-540e-0410-9357-904b9bb8a0f7> Guillaume Melquiond <guillaume.melquiond@inria.fr> gmelquio <gmelquio@85f007b7-540e-0410-9357-904b9bb8a0f7> +Guillaume Melquiond <guillaume.melquiond@inria.fr> Guillaume Melquiond <guillaume.melquiond@gmail.com> Alexandre Miquel <miquel@gforge> miquel <miquel@85f007b7-540e-0410-9357-904b9bb8a0f7> Benjamin Monate <monate@gforge> monate <monate@85f007b7-540e-0410-9357-904b9bb8a0f7> Julien Narboux <jnarboux@gforge> jnarboux <jnarboux@85f007b7-540e-0410-9357-904b9bb8a0f7> @@ -81,6 +88,7 @@ Russell O'Connor <roconnor@blockstream.io> roconnor-blockstream <roconno Christine Paulin <cpaulin@gforge> cpaulin <cpaulin@85f007b7-540e-0410-9357-904b9bb8a0f7> Christine Paulin <cpaulin@gforge> mohring <mohring@85f007b7-540e-0410-9357-904b9bb8a0f7> Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7> +Clément Pit-Claudel <clement.pitclaudel@live.com> Clément Pit--Claudel <clement.pitclaudel@live.com> Loïc Pottier <pottier@gforge> pottier <pottier@85f007b7-540e-0410-9357-904b9bb8a0f7> Matthias Puech <puech@gforge> puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7> Lars Rasmusson <lars.rasmusson@sics.se> larsr <Lars.Rasmusson@sics.se> @@ -91,16 +99,23 @@ Yann Régis-Gianas <yrg@pps.univ-paris-diderot.fr> regisgia <regisgia@85f007b7- Yann Régis-Gianas <yrg@pps.univ-paris-diderot.fr> Regis-Gianas <yrg@pps.univ-paris-diderot.fr> Clément Renard <clrenard@gforge> clrenard <clrenard@85f007b7-540e-0410-9357-904b9bb8a0f7> Claudio Sacerdoti Coen <sacerdot@gforge> sacerdot <sacerdot@85f007b7-540e-0410-9357-904b9bb8a0f7> +Kazuhiko Sakaguchi <pi8027@gmail.com> Kazuhiko Sakaguchi <sakaguchi@coins.tsukuba.ac.jp> Vincent Siles <vsiles@gforge> vsiles <vsiles@85f007b7-540e-0410-9357-904b9bb8a0f7> +Michael Soegtrop <michael.soegtrop@intel.com> Michael Soegtrop <7895506+MSoegtropIMC@users.noreply.github.com> Elie Soubiran <soubiran@gforge> soubiran <soubiran@85f007b7-540e-0410-9357-904b9bb8a0f7> Matthieu Sozeau <mattam@mattam.org> msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> Matthieu Sozeau <mattam@mattam.org> Matthieu Sozeau <matthieu.sozeau@inria.fr> +Matthieu Sozeau <mattam@mattam.org> Matthieu Sozeau <mattam@eduroam-prg-sg-1-46-137.net.univ-paris-diderot.fr> Arnaud Spiwack <arnaud@spiwack.net> aspiwack <aspiwack@85f007b7-540e-0410-9357-904b9bb8a0f7> +Paul Steckler <steck@stecksoft.com> Paul Steckler <psteck@mit.edu> Enrico Tassi <Enrico.Tassi@inria.fr> gareuselesinge <gareuselesinge@85f007b7-540e-0410-9357-904b9bb8a0f7> Enrico Tassi <Enrico.Tassi@inria.fr> Enrico Tassi <enrico.tassi@inria.fr> Enrico Tassi <Enrico.Tassi@inria.fr> Enrico Tassi <gares@fettunta.org> +Enrico Tassi <Enrico.Tassi@inria.fr> Enrico <gares@fettunta.org> Laurent Théry <laurent.thery@inria.fr> thery <thery@85f007b7-540e-0410-9357-904b9bb8a0f7> Laurent Théry <laurent.thery@inria.fr> thery <thery@sophia.inria.fr> +Laurent Théry <laurent.thery@inria.fr> Laurent Théry <thery@sophia.inria.fr> +Anton Trunov <anton.a.trunov@gmail.com> Anton Trunov <anton.trunov@imdea.org> Benjamin Werner <werner@gforge> werner <werner@85f007b7-540e-0410-9357-904b9bb8a0f7> Théo Zimmermann <theo.zimmermann@univ-paris-diderot.fr> Theo Zimmermann <theo.zimmermann@ens.fr> Théo Zimmermann <theo.zimmermann@univ-paris-diderot.fr> Théo Zimmermann <theo.zimmi@gmail.com> diff --git a/CHANGES b/CHANGES deleted file mode 100644 index 5c664b7e2a..0000000000 --- a/CHANGES +++ /dev/null @@ -1,4045 +0,0 @@ -Changes from 8.9 to 8.10 -======================== - -OCaml - -- Coq 8.10 requires OCaml >= 4.05.0, bumped from 4.02.3 See the - INSTALL file for more information on dependencies. - -Plugins - -- The quote plugin (https://coq.inria.fr/distrib/V8.8.1/refman/proof-engine/detailed-tactic-examples.html#quote) - was removed. If some users are interested in maintaining this plugin - externally, the Coq development team can provide assistance for extracting - the plugin and setting up a new repository. - -Tactics - -- Removed the deprecated `romega` tactics. - -Changes from 8.8.2 to 8.9+beta1 -=============================== - -Kernel - -- Mutually defined records are now supported. - -Notations - -- New support for autonomous grammars of terms, called "custom - entries" (see chapter "Syntax extensions" of the reference manual). - -- New command "Declare Scope" to explicitly declare a scope name - before any use of it. Implicit declaration of a scope at the time of - "Bind Scope", "Delimit Scope", "Undelimit Scope", or "Notation" is - deprecated. - -Tactics - -- Added toplevel goal selector ! which expects a single focused goal. - Use with Set Default Goal Selector to force focusing before tactics - are called. - -- The undocumented "nameless" forms `fix N`, `cofix` that were - deprecated in 8.8 have been removed from LTAC's syntax; please use - `fix ident N/cofix ident` to explicitly name the (co)fixpoint - hypothesis to be introduced. - -- Introduction tactics "intro"/"intros" on a goal which is an - existential variable now force a refinement of the goal into a - dependent product rather than failing. - -- Support for fix/cofix added in Ltac "match" and "lazymatch". - -- Ltac backtraces now include trace information about tactics - called by OCaml-defined tactics. - -- Option "Ltac Debug" now applies also to terms built using Ltac functions. - -- Deprecated the Implicit Tactic family of commands. - -- The default program obligation tactic uses a bounded proof search - instead of an unbounded and potentially non-terminating one now - (source of incompatibility). - -- The `simple apply` tactic now respects the `Opaque` flag when called from - Ltac (`auto` still does not respect it). - -- Tactic `constr_eq` now adds universe constraints needed for the - identity to the context (it used to ignore them). New tactic - `constr_eq_strict` checks that the required constraints already hold - without adding new ones. Preexisting tactic `constr_eq_nounivs` can - still be used if you really want to ignore universe constraints. - -- Tactics and tactic notations now understand the `deprecated` attribute. -- The `fourier` tactic has been removed. Please now use `lra` instead. You - may need to add `Require Import Lra` to your developments. For compatibility, - we now define `fourier` as a deprecated alias of `lra`. - -- The `romega` tactics have been deprecated; please use `lia` instead. - -- Names of existential variables occurring in Ltac functions - (e.g. "?[n]" or "?n" in terms - not in patterns) are now interpreted - the same way as other variable names occurring in Ltac functions. - -Focusing - -- Focusing bracket `{` now supports named goal selectors, - e.g. `[x]: {` will focus on a goal (existential variable) named `x`. - As usual, unfocus with `}` once the sub-goal is fully solved. - -Specification language, type inference - -- A fix to unification (which was sensitive to the ascii name of - variables) may occasionally change type inference in incompatible - ways, especially regarding the inference of the return clause of "match". - -- Fixing a missing check in interpreting instances of existential - variables which are bound to local definitions might exceptionally - induce an overhead if the cost of checking the conversion of the - corresponding definitions is additionally high (PR #8215). - -- A few improvements in inference of the return clause of "match" can - exceptionally introduce incompatibilities (PR #262). This can be - solved by writing an explicit "return" clause, sometimes even simply - an explicit "return _" clause. - -Standard Library - -- Added `Ascii.eqb` and `String.eqb` and the `=?` notation for them, - and proved some lemmas about them. Note that this might cause - incompatibilities if you have, e.g., string_scope and Z_scope both - open with string_scope on top, and expect `=?` to refer to `Z.eqb`. - Solution: wrap `_ =? _` in `(_ =? _)%Z` (or whichever scope you - want). - -- Added `Ndigits.N2Bv_sized`, and proved some lemmas about it. - Deprecated `Ndigits.N2Bv_gen`. - -- The scopes `int_scope` and `uint_scope` have been renamed to - `dec_int_scope` and `dec_uint_scope`, to clash less with ssreflect - and other packages. They are still delimited by `%int` and `%uint`. - -- Syntax notations for `string`, `ascii`, `Z`, `positive`, `N`, `R`, - and `int31` are no longer available merely by `Require`ing the files - that define the inductives. You must `Import` `Coq.Strings.String`, - `Coq.Strings.Ascii`, `Coq.ZArith.BinIntDef`, `Coq.PArith.BinPosDef`, - `Coq.NArith.BinNatDef`, `Coq.Reals.Rdefinitions`, and - `Coq.Numbers.Cyclic.Int31.Int31`, respectively, to be able to use - these notations. Note that passing `-compat 8.8` or issuing - `Require Import Coq.Compat.Coq88` will make these notations - available. Users wishing to port their developments automatically - may download `fix.py` from - <https://gist.github.com/JasonGross/5d4558edf8f5c2c548a3d96c17820169> - and run a command like `while true; do make -Okj 2>&1 | - /path/to/fix.py; done` and get a cup of coffee. (This command must - be manually interrupted once the build finishes all the way though. - Note also that this method is not fail-proof; you may have to adjust - some scopes if you were relying on string notations not being - available even when `string_scope` was open.) - -- Numeral syntax for `nat` is no longer available without loading the - entire prelude (`Require Import Coq.Init.Prelude`). This only - impacts users running Coq without the init library (`-nois` or - `-noinit`) and also issuing `Require Import Coq.Init.Datatypes`. - -- Added `Bvector.BVeq` that decides whether two `Bvector`s are equal. -- Added notations for `BVxor`, `BVand`, `BVor`, `BVeq` and `BVneg`. - -Tools - -- Coq_makefile lets one override or extend the following variables from - the command line: COQFLAGS, COQCHKFLAGS, COQDOCFLAGS. - COQFLAGS is now entirely separate from COQLIBS, so in custom Makefiles - $(COQFLAGS) should be replaced by $(COQFLAGS) $(COQLIBS). - -- Removed the gallina utility (extracts specification from Coq vernacular files). - If you would like to maintain this tool externally, please contact us. - -- Removed the Emacs modes distributed with Coq. You are advised to - use Proof-General <https://proofgeneral.github.io/> (and optionally - Company-Coq <https://github.com/cpitclaudel/company-coq>) instead. - If your use case is not covered by these alternative Emacs modes, - please open an issue. We can help set up external maintenance as part - of Proof-General, or independently as part of coq-community. - - -Vernacular Commands - -- Removed deprecated commands Arguments Scope and Implicit Arguments - (not the option). Use the Arguments command instead. -- Nested proofs may be enabled through the option `Nested Proofs Allowed`. - By default, they are disabled and produce an error. The deprecation - warning which used to occur when using nested proofs has been removed. -- Added option Uniform Inductive Parameters which abstracts over parameters - before typechecking constructors, allowing to write for example - `Inductive list (A : Type) := nil : list | cons : A -> list -> list.` -- New Set Hint Variables/Constants Opaque/Transparent commands for setting - globally the opacity flag of variables and constants in hint databases, - overwritting the opacity set of the hint database. -- Added generic syntax for “attributes”, as in: - `#[local] Lemma foo : bar.` -- Added the `Numeral Notation` command for registering decimal numeral - notations for custom types -- The `Set SsrHave NoTCResolution` command no longer has special global - scope. If you want the previous behavior, use `Global Set SsrHave - NoTCResolution`. -- Multiple sections with the same name are allowed. -- Combined Scheme can now work when inductive schemes are generated in sort - Type. It used to be limited to sort Prop. - -Coq binaries and process model - -- Before 8.9, Coq distributed a single `coqtop` binary and a set of - dynamically loadable plugins that used to take over the main loop - for tasks such as IDE language server or parallel proof checking. - - These plugins have been turned into full-fledged binaries so each - different process has associated a particular binary now, in - particular `coqidetop` is the CoqIDE language server, and - `coq{proof,tactic,query}worker` are in charge of task-specific and - parallel proof checking. - -SSReflect - -- The implementation of delayed clear switches in intro patterns - is now simpler to explain: - 1. The immediate effect of a clear switch like {x} is to rename the - variable x to _x_ (i.e. a reserved identifier that cannot be mentioned - explicitly) - 2. The delayed effect of {x} is that _x_ is cleared at the end of the intro - pattern - 3. A clear switch immediately before a view application like {x}/v is - translated to /v{x}. - In particular rule 3 lets one write {x}/v even if v uses the variable x: - indeed the view is executed before the renaming. - -- An empty clear switch is now accepted in intro patterns before a - view application whenever the view is a variable. - One can now write {}/v to mean {v}/v. Remark that {}/x is very similar - to the idiom {}e for the rewrite tactic (the equation e is used for - rewriting and then discarded). - -Standard Library - -- There are now conversions between [string] and [positive], [Z], - [nat], and [N] in binary, octal, and hex. - -Display diffs between proof steps - -- coqtop and coqide can now highlight the differences between proof steps - in color. This can be enabled from the command line or the - `Set Diffs "on"|"off"|"removed"` command. Please see the documentation for - details. Showing diffs in Proof General requires small changes to PG - (under discussion). - -Notations - -- Added `++` infix for `VectorDef.append`. - Note that this might cause incompatibilities if you have, e.g., list_scope - and vector_scope both open with vector_scope on top, and expect `++` to - refer to `app`. - Solution: wrap `_ ++ _` in `(_ ++ _)%list` (or whichever scope you want). - -Changes from 8.8.1 to 8.8.2 -=========================== - -Documentation - -- A PDF version of the reference manual is available once again. - -Tools - -- The coq-makefile targets `print-pretty-timed`, `print-pretty-timed-diff`, - and `print-pretty-single-time-diff` now correctly label the "before" and - "after" columns, rather than swapping them. - -Kernel - -- The kernel does not tolerate capture of global universes by - polymorphic universe binders, fixing a soundness break (triggered - only through custom plugins) - -Windows installer - -- The Windows installer now includes many more external packages that can be -individually selected for installation. - -Many other bug fixes and lots of documentation improvements (for details, -see the 8.8.2 milestone at https://github.com/coq/coq/milestone/15?closed=1). - -Changes from 8.8.0 to 8.8.1 -=========================== - -Kernel - -- Fix a critical bug with cofixpoints and vm_compute/native_compute (#7333). -- Fix a critical bug with modules and algebraic universes (#7695) -- Fix a critical bug with inlining of polymorphic constants (#7615). -- Fix a critical bug with universe polymorphism and vm_compute (#7723). Was - present since 8.5. - -Notations - -- Fixed unexpected collision between only-parsing and only-printing - notations (issue #7462). - -Windows installer - -- The Windows installer now includes external packages Ltac2 and Equations - (it included the Bignums package since 8.8+beta1). - -Many other bug fixes, documentation improvements (including fixes of -regressions due to the Sphinx migration), and user message improvements -(for details, see the 8.8.1 milestone at -https://github.com/coq/coq/milestone/13?closed=1). - -Changes from 8.8+beta1 to 8.8.0 -=============================== - -Tools - -- Asynchronous proof delegation policy was fixed. Since version 8.7 - Coq was ignoring previous runs and the -async-proofs-delegation-threshold - option did not have the expected behavior. - -Tactic language - -- The undocumented "nameless" forms `fix N`, `cofix` have been - deprecated; please use `fix ident N /cofix ident` to explicitely - name the (co)fixpoint hypothesis to be introduced. - -Documentation - -- The reference manual is now fully ported to Sphinx. - -Other small deprecations and bug fixes. - -Changes from 8.7.2 to 8.8+beta1 -=============================== - -Kernel - -- Support for template polymorphism for definitions was removed. May trigger - more "universe inconsistency" errors in rare occasions. -- Fixpoints are no longer allowed on non-recursive inductive types. - -Notations - -- Recursive notations with the recursive pattern repeating on the - right (e.g. "( x ; .. ; y ; z )") now supported. -- Notations with a specific level for the leftmost nonterminal, - when printing-only, are supported. -- Notations can now refer to the syntactic category of patterns (as in - "fun 'pat =>" or "match p with pat => ... end"). Two variants are - available, depending on whether a single variable is considered as a - pattern or not. -- Recursive notations now support ".." patterns with several - occurrences of the recursive term or binder, possibly mixing terms - and binders, possibly in reverse left-to-right order. -- "Locate" now working also on notations of the form "x + y" (rather - than "_ + _"). - -Specification language - -- When printing clauses of a "match", clauses with same right-hand - side are factorized and the last most factorized clause with no - variables, if it exists, is turned into a default clause. - Use "Unset Printing Allow Default Clause" do deactivate printing - of a default clause. - Use "Unset Printing Factorizable Match Patterns" to deactivate - factorization of clauses with same right-hand side. - -Tactics - -- On Linux, "native_compute" calls can be profiled using the "perf" - utility. The command "Set NativeCompute Profiling" enables - profiling, and "Set NativeCompute Profile Filename" customizes - the profile filename. -- The tactic "omega" is now aware of the bodies of context variables - such as "x := 5 : Z" (see #1362). This could be disabled via - Unset Omega UseLocalDefs. -- The tactic "romega" is also aware now of the bodies of context variables. -- The tactic "zify" resp. "omega with N" is now aware of N.pred. -- Tactic "decide equality" now able to manage constructors which - contain proofs. -- Added tactics reset ltac profile, show ltac profile (and variants) -- Added tactics restart_timer, finish_timing, and time_constr as an - experimental way of timing Ltac's evaluation phase -- Added tactic optimize_heap, analogous to the Vernacular Optimize - Heap, which performs a major garbage collection and heap compaction - in the OCaml run-time system. -- The tactics "dtauto", "dintuition", "firstorder" now handle inductive types - with let bindings in the parameters. -- The tactic "dtauto" now handles some inductives such as - "@sigT A (fun _ => B)" as non-dependent conjunctions. -- A bug fixed in "rewrite H in *" and "rewrite H in * |-" may cause a - few rare incompatibilities (it was unintendedly recursively - rewriting in the side conditions generated by H). -- Added tactics "assert_succeeds tac" and "assert_fails tac" to ensure - properties of the executation of a tactic without keeping the effect - of the execution. -- `vm_compute` now supports existential variables. -- Calls to `shelve` and `give_up` within calls to tactic `refine` now working. -- Deprecated tactic `appcontext` was removed. - -Focusing - -- Focusing bracket `{` now supports single-numbered goal selector, - e.g. `2: {` will focus on the second sub-goal. As usual, unfocus - with `}` once the sub-goal is fully solved. - The `Focus` and `Unfocus` commands are now deprecated. - -Vernacular Commands - -- Proofs ending in "Qed exporting ident, .., ident" are not supported - anymore. Constants generated during `abstract` are kept private to the - local environment. -- The deprecated Coercion Local, Open Local Scope, Notation Local syntax - was removed. Use Local as a prefix instead. -- For the Extraction Language command, "OCaml" is spelled correctly. - The older "Ocaml" is still accepted, but deprecated. -- Using “Require” inside a section is deprecated. -- An experimental command "Show Extraction" allows to extract the content - of the current ongoing proof (grant wish #4129). -- Coercion now accepts the type of its argument to be "Prop" or "Type". -- The "Export" modifier can now be used when setting and unsetting options, and - will result in performing the same change when the module corresponding the - command is imported. -- The `Axiom` command does not automatically declare axioms as instances when - their type is a class. Previous behavior can be restored using `Set - Typeclasses Axioms Are Instances`. - -Universes - -- Qualified naming of global universes now works like other namespaced - objects (e.g. constants), with a separate namespace, inside and across - module and library boundaries. Global universe names introduced in an - inductive / constant / Let declaration get qualified with the name of - the declaration. -- Universe cumulativity for inductive types is now specified as a - variance for each polymorphic universe. See the reference manual for - more information. -- Inference of universe constraints with cumulative inductive types - produces more general constraints. Unsetting new option Cumulativity - Weak Constraints produces even more general constraints (but may - produce too many universes to be practical). -- Fix #5726: Notations that start with `Type` now support universe instances - with `@{u}`. -- `with Definition` now understands universe declarations - (like `@{u| Set < u}`). - -Tools - -- Coq can now be run with the option -mangle-names to change the auto-generated - name scheme. This is intended to function as a linter for developments that - want to be robust to changes in auto-generated names. This feature is experimental, - and may change or disappear without warning. -- GeoProof support was removed. - -Checker - -- The checker now accepts filenames in addition to logical paths. - -CoqIDE - -- Find and Replace All report the number of occurrences found; Find indicates - when it wraps. - -coqdep - -- Learned to read -I, -Q, -R and filenames from _CoqProject files. - This is used by coq_makefile when generating dependencies for .v - files (but not other files). - -Documentation - -- The Coq FAQ, formerly located at https://coq.inria.fr/faq, has been - moved to the GitHub wiki section of this repository; the main entry - page is https://github.com/coq/coq/wiki/The-Coq-FAQ. -- Documentation: a large community effort resulted in the migration - of the reference manual to the Sphinx documentation tool. The result - is partially integrated in this version. - -Standard Library - -- New libraries Coq.Init.Decimal, Coq.Numbers.DecimalFacts, - Coq.Numbers.DecimalNat, Coq.Numbers.DecimalPos, - Coq.Numbers.DecimalN, Coq.Numbers.DecimalZ, - Coq.Numbers.DecimalString providing a type of decimal numbers, some - facts about them, and conversions between decimal numbers and nat, - positive, N, Z, and string. -- Added [Coq.Strings.String.concat] to concatenate a list of strings - inserting a separator between each item -- Notation `'` for Zpos in QArith was removed. - -- Some deprecated aliases are now emitting warnings when used. - -Compatibility support - -- Support for compatibility with versions before 8.6 was dropped. - -Options - -- The following deprecated options have been removed: - - + `Refolding Reduction` - + `Standard Proposition Elimination` - + `Dependent Propositions Elimination` - + `Discriminate Introduction` - + `Shrink Abstract` - + `Tactic Pattern Unification` - + `Intuition Iff Unfolding` - + `Injection L2R Pattern Order` - + `Record Elimination Schemes` - + `Match Strict` - + `Tactic Compat Context` - + `Typeclasses Legacy Resolution` - + `Typeclasses Module Eta` - + `Typeclass Resolution After Apply` - -Changes from 8.7.1 to 8.7.2 -=========================== - -Fixed a critical bug in the VM handling of universes (#6677). This bug -affected all releases since 8.5. - -Improved support for building with OCaml 4.06.0 and external num package. - -Many other bug fixes, documentation improvements, and user -message improvements (for details, see the 8.7.2 milestone at -https://github.com/coq/coq/milestone/11?closed=1). - -Changes from 8.7.0 to 8.7.1 -=========================== - -Compatibility with OCaml 4.06.0. - -Many bug fixes, documentation improvements, and user message improvements (for -details see the 8.7.1 milestone at https://github.com/coq/coq/milestone/10?closed=1). - -Changes from 8.7+beta2 to 8.7.0 -=============================== - -OCaml - -- Users can pass specific flags to the OCaml optimizing compiler by - -using the flambda-opts configure-time option. - - Beware that compiling Coq with a flambda-enabled compiler is - experimental and may require large amounts of RAM and CPU, see - INSTALL for more details. - -Changes from 8.7+beta1 to 8.7+beta2 -=================================== - -Tools - -- In CoqIDE, the "Compile Buffer" command takes account of flags in - _CoqProject or other project file. - -Improvements around some error messages. - -Many bug fixes including two important ones: - -- Bug #5730: CoqIDE becomes unresponsive on file open. -- coq_makefile: make sure compile flags for Coq and coq_makefile are in sync - (in particular, make sure the `-safe-string` option is used to compile plugins). - -Changes from 8.6.1 to 8.7+beta1 -=============================== - -Tactics - -- New tactic "extensionality in H" which applies (possibly dependent) - functional extensionality in H supposed to be a quantified equality - until giving a bare equality. -- New tactic "inversion_sigma" which turns equalities of dependent - pairs (e.g., "existT P x p = existT P y q", frequently left over by - "inversion" on a dependent type family) into pairs of equalities - (e.g., a hypothesis "H : x = y" and a hypothesis of type "rew H in p - = q"); these hypotheses can subsequently be simplified using - "subst", without ever invoking any kind of axiom asserting - uniqueness of identity proofs. If you want to explicitly specify the - hypothesis to be inverted, or name the generated hypotheses, you can - invoke "induction H as [H1 H2] using eq_sigT_rect". The tactic also - works for "sig", "sigT2", and "sig2", and there are similar - "eq_sig*_rect" induction lemmas. -- Tactic "specialize with ..." now accepts any partial bindings. - Missing bindings are either solved by unification or left quantified - in the hypothesis. -- New representation of terms that statically ensure stability by - evar-expansion. This has several consequences. - * In terms of performance, this adds a cost to every term destructuration, - but at the same time most eager evar normalizations were removed, which - couterbalances this drawback and even sometimes outperforms the old - implementation. For instance, many operations that would require O(n) - normalization of the term are now O(1) in tactics. YMMV. - * This triggers small changes in unification, which was not evar-insensitive. - Most notably, the new implementation recognizes Miller patterns that were - missed before because of a missing normalization step. Hopefully this should - be fairly uncommon. -- Tactic "auto with real" can now discharge comparisons of literals. -- The types of variables in patterns of "match" are now - beta-iota-reduced after type-checking. This has an impact on the - type of the variables that the tactic "refine" introduces in the - context, producing types a priori closer to the expectations. -- In "Tactic Notation" or "TACTIC EXTEND", entry "constr_with_bindings" - now uses type classes and rejects terms with unresolved holes, like - entry "constr" does. To get the former behavior use - "open_constr_with_bindings" (possible source of incompatibility). -- New e-variants eassert, eenough, epose proof, eset, eremember, epose - which behave like the corresponding variants with no "e" but turn - unresolved implicit arguments into existential variables, on the - shelf, rather than failing. -- Tactic injection has become more powerful (closes bug #4890) and its - documentation has been updated. -- New variants of the `first` and `solve` tacticals that do not rely - on parsing rules, meant to define tactic notations. -- Added support for side effects hooks in `cbv`, `cbn` and `simpl`. - The side effects are provided via a plugin: - https://github.com/herbelin/reduction-effects/ -- It is now possible to take hint database names as parameters in a - Ltac definition or a Tactic Notation. -- New option `Set Ltac Batch Debug` on top of `Set Ltac Debug` for - non-interactive Ltac debug output. - -Gallina - -- Now supporting all kinds of binders, including 'pat, in syntax of record fields. - -Vernacular Commands - -- Goals context can be printed in a more compact way when `Set - Printing Compact Contexts` is activated. -- Unfocused goals can be printed with the `Set Printing Unfocused` - option. -- `Print` now shows the types of let-bindings. -- The compatibility options for printing primitive projections - (`Set Printing Primitive Projection Parameters` and - `Set Printing Primitive Projection Compatibility`) are now off by default. -- Possibility to unset the printing of notations in a more fine grained - fashion than `Unset Printing Notations` is provided without any - user-syntax. The goal is that someone creates a plugin to experiment - such a user-syntax, to be later integrated in Coq when stabilized. -- `About` now tells if a reference is a coercion. -- The deprecated `Save` vernacular and its form `Save Theorem id` to - close proofs have been removed from the syntax. Please use `Qed`. -- `Search` now sorts results by relevance (the relevance metric is a - weighted sum of number of distinct symbols and size of the term). - -Standard Library - -- New file PropExtensionality.v to explicitly work in the axiomatic - context of propositional extensionality. -- New file SetoidChoice.v axiomatically providing choice over setoids, - and, consequently, choice of representatives in equivalence classes. - Various proof-theoretic characterizations of choice over setoids in - file ChoiceFacts.v. -- New lemmas about iff and about orders on positive and Z. -- New lemmas on powerRZ. -- Strengthened statement of JMeq_eq_dep (closes bug #4912). -- The BigN, BigZ, BigZ libraries are no longer part of the Coq standard - library, they are now provided by a separate repository - https://github.com/coq/bignums - The split has been done just after the Int31 library. - -- IZR (Reals) has been changed to produce a compact representation of - integers. As a consequence, IZR is no longer convertible to INR and - lemmas such as INR_IZR_INZ should be used instead. -- Real constants are now represented using IZR rather than R0 and R1; - this might cause rewriting rules to fail to apply to constants. -- Added new notation {x & P} for sigT (without a type for x) - -Plugins - -- The Ssreflect plugin is now distributed with Coq. Its documentation has - been integrated as a chapter of the reference manual. This chapter is - work in progress so feedback is welcome. -- The mathematical proof language (also known as declarative mode) was removed. -- A new command Extraction TestCompile has been introduced, not meant - for the general user but instead for Coq's test-suite. -- The extraction plugin is no longer loaded by default. It must be - explicitly loaded with [Require Extraction], which is backwards - compatible. -- The functional induction plugin (which provides the [Function] - vernacular) is no longer loaded by default. It must be explicitly - loaded with [Require FunInd], which is backwards compatible. - - -Dependencies - -- Support for camlp4 has been removed. - -Tools - -- coq_makefile was completely redesigned to improve its maintainability and - the extensibility of generated Makefiles, and to make _CoqProject files - more palatable to IDEs. Overview: - * _CoqProject files contain only Coq specific data (i.e. the list of - files, -R options, ...) - * coq_makefile translates _CoqProject to Makefile.conf and copies in the - desired location a standard Makefile (that reads Makefile.conf) - * Makefile extensions can be implemented in a Makefile.local file (read - by the main Makefile) by installing a hook in the extension points - provided by the standard Makefile - The current version contains code for retro compatibility that prints - warnings when a deprecated feature is used. Please upgrade your _CoqProject - accordingly. - * Additionally, coq_makefile-made Makefiles now support experimental timing - targets `pretty-timed`, `pretty-timed-before`, `pretty-timed-after`, - `print-pretty-timed-diff`, `print-pretty-single-time-diff`, - `all.timing.diff`, and the variable `TIMING=1` (or `TIMING=before` or - `TIMING=after`); see the documentation for more details. - -Build Infrastructure - -- Note that 'make world' does not build the bytecode binaries anymore. - For that, you can use 'make byte' (and 'make install-byte' afterwards). - Warning: native and byte compilations should *not* be mixed in the same - instance of 'make -j', otherwise both ocamlc and ocamlopt might race for - access to the same .cmi files. In short, use "make -j && make -j byte" - instead of "make -j world byte". - -Universes - -- Cumulative inductive types. see prefixes "Cumulative", "NonCumulative" - for inductive definitions and the option "Set Polymorphic Inductive Cumulativity" - in the reference manual. -- New syntax `foo@{_}` to instantiate a polymorphic definition with - anonymous universes (can also be used with `Type`). - -XML Protocol and internal changes - -See dev/doc/changes.txt - -Many bugfixes including #1859, #2884, #3613, #3943, #3994, -#4250, #4709, #4720, #4824, #4844, #4911, #5026, #5233, -#5275, #5315, #5336, #5360, #5390, #5414, #5417, #5420, -#5439, #5449, #5475, #5476, #5482, #5501, #5507, #5520, -#5523, #5524, #5553, #5577, #5578, #5589, #5597, #5598, -#5607, #5618, #5619, #5620, #5641, #5648, #5651, #5671. - -Many bugfixes on OS X and Windows (now the test-suite passes on these -platforms too). - -Many optimizations. - -Many documentation improvements. - -Changes from 8.6 to 8.6.1 -========================= - -- Fix #5380: Default colors for CoqIDE are actually applied. -- Fix plugin warnings -- Document named evars (including Show ident) -- Fix Bug #5574, document function scope -- Adding a test case as requested in bug 5205. -- Fix Bug #5568, no dup notation warnings on repeated module imports -- Fix documentation of Typeclasses eauto := -- Refactor documentation of records. -- Protecting from warnings while compiling 8.6 -- Fixing an inconsistency between configure and configure.ml -- Add test-suite checks for coqchk with constraints -- Fix bug #5019 (looping zify on dependent types) -- Fix bug 5550: "typeclasses eauto with" does not work with section variables. -- Bug 5546, qualify datatype constructors when needed in Show Match -- Bug #5535, test for Show with -emacs -- Fix bug #5486, don't reverse ids in tuples -- Fixing #5522 (anomaly with free vars of pat) -- Fix bug #5526, don't check for nonlinearity in notation if printing only -- Fix bug #5255 -- Fix bug #3659: -time should understand multibyte encodings. -- FIx bug #5300: Anomaly: Uncaught exception Not_found" in "Print Assumptions". -- Fix outdated description in RefMan. -- Repairing `Set Rewriting Schemes` -- Fixing #5487 (v8.5 regression on ltac-matching expressions with evars). -- Fix description of command-line arguments for Add (Rec) LoadPath -- Fix bug #5377: @? patterns broken. -- add XML protocol doc -- Fix anomaly when doing [all:Check _.] during a proof. -- Correction of bug #4306 -- Fix #5435: [Eval native_compute in] raises anomaly. -- Instances should obey universe binders even when defined by tactics. -- Intern names bound in match patterns -- funind: Ignore missing info for current function -- Do not typecheck twice the type of opaque constants. -- show unused intro pattern warning -- [future] Be eager when "chaining" already resolved future values. -- Opaque side effects -- Fix #5132: coq_makefile generates incorrect install goal -- Run non-tactic comands without resilient_command -- Univs: fix bug #5365, generation of u+k <= v constraints -- make `emit' tail recursive -- Don't require printing-only notation to be productive -- Fix the way setoid_rewrite handles bindings. -- Fix for bug 5244 - set printing width ignored when given enough space -- Fix bug 4969, autoapply was not tagging shelved subgoals correctly - -Changes from V8.6beta1 to V8.6 -============================== - -Kernel - -- Fixed critical bug #5248 in VM long multiplication on 32-bit - architectures. Was there only since 8.6beta1, so no stable release impacted. - -Other bug fixes in universes, type class shelving,... - -Changes from V8.5 to V8.6beta1 -============================== - -Kernel - -- A new, faster state-of-the-art universe constraint checker. - -Specification language - -- Giving implicit arguments explicitly to a constant with multiple - choices of implicit arguments does not break any more insertion of - further maximal implicit arguments. -- Ability to put any pattern in binders, prefixed by quote, e.g. - "fun '(a,b) => ...", "λ '(a,(b,c)), ...", "Definition foo '(x,y) := ...". - It expands into a "let 'pattern := ..." - -Tactics - -- Flag "Bracketing Last Introduction Pattern" is now on by default. -- Flag "Regular Subst Tactic" is now on by default: it respects the - initial order of hypothesis, it contracts cycles, it unfolds no - local definitions (common source of incompatibilities, fixable by - "Unset Regular Subst Tactic"). -- New flag "Refolding Reduction", now disabled by default, which turns - on refolding of constants/fixpoints (as in cbn) during the reductions - done during type inference and tactic retyping. Can be extremely - expensive. When set off, this recovers the 8.4 behaviour of unification - and type inference. Potential source of incompatibility with 8.5 developments - (the option is set on in Compat/Coq85.v). -- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract - tactical w.r.t. variables appearing in the body of the proof. - On by default and deprecated. Minor source of incompatibility - for code relying on the precise arguments of abstracted proofs. -- Serious bugs are fixed in tactic "double induction" (source of - incompatibilities as soon as the inductive types have dependencies in - the type of their constructors; "double induction" remains however - deprecated). -- In introduction patterns of the form (pat1,...,patn), n should match - the exact number of hypotheses introduced (except for local definitions - for which pattern can be omitted, as in regular pattern-matching). -- Tactic scopes in Ltac like constr: and ltac: now require parentheses around - their argument. -- Every generic argument type declares a tactic scope of the form "name:(...)" - where name is the name of the argument. This generalizes the constr: and ltac: - instances. -- When in strict mode (i.e. in a Ltac definition), if the "intro" tactic is - given a free identifier, it is not bound in subsequent tactics anymore. - In order to introduce a binding, use e.g. the "fresh" primitive instead - (potential source of incompatibilities). -- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac. -- New goal selectors. Sets of goals can be selected by listing integers - ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. -- For uniformity with "destruct"/"induction" and for a more natural - behavior, "injection" can now work in place by activating option - "Structural Injection". In this case, hypotheses are also put in the - context in the natural left-to-right order and the hypothesis on - which injection applies is cleared. -- Tactic "contradiction" (hence "easy") now also solve goals with - hypotheses of the form "~True" or "t<>t" (possible source of - incompatibilities because of more successes in automation, but - generally a more intuitive strategy). -- Option "Injection On Proofs" was renamed "Keep Proof Equalities". When - enabled, injection and inversion do not drop equalities between objects - in Prop. Still disabled by default. -- New tactics "notypeclasses refine" and "simple notypeclasses refine" that - disallow typeclass resolution when typechecking their argument, for use - in typeclass hints. -- Integration of LtacProf, a profiler for Ltac. -- Reduction tactics now accept more fine-grained flags: iota is now a shorthand - for the new flags match, fix and cofix. -- The ssreflect subterm selection algorithm is now accessible to tactic writers - through the ssrmatching plugin. -- When used as an argument of an ltac function, "auto" without "with" - nor "using" clause now correctly uses only the core hint database by - default. - -Hints - -- Revised the syntax of [Hint Cut] to follow standard notation for regexps. -- Hint Mode now accepts "!" which means that the mode matches only if the - argument's head is not an evar (it goes under applications, casts, and - scrutinees of matches and projections). -- Hints can now take an optional user-given pattern, used only by - [typeclasses eauto] with the [Filtered Unification] option on. - -Typeclasses - -- Many new options and new engine based on the proof monad. The - [typeclasses eauto] tactic is now a multi-goal, multi-success tactic. - See reference manual for more information. It is planned to - replace auto and eauto in the following version. The 8.5 resolution - engine is still available to help solve compatibility issues. - -Program - -- The "Shrink Obligations" flag now applies to all obligations, not only - those solved by the automatic tactic. -- "Shrink Obligations" is on by default and deprecated. Minor source of - incompatibility for code relying on the precise arguments of - obligations. - -Notations - -- "Bind Scope" can once again bind "Funclass" and "Sortclass". - -General infrastructure - -- New configurable warning system which can be controlled with the vernacular - command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In - particular, the default is now that warnings are printed by coqc. -- In asynchronous mode, Coq is now capable of recovering from errors and - continue processing the document. - -Tools - -- coqc accepts a -o option to specify the output file name -- coqtop accepts --print-version to print Coq and OCaml versions in - easy to parse format -- Setting [Printing Dependent Evars Line] can be unset to disable the - computation associated with printing the "dependent evars: " line in - -emacs mode -- Removed the -verbose-compat-notations flag and the corresponding Set - Verbose Compat vernacular, since these warnings can now be silenced or - turned into errors using "-w". - -XML protocol - -- message format has changed, see dev/doc/changes.txt for more details. - -Many bug fixes, minor changes and documentation improvements are not mentioned -here. - -Changes from V8.5pl2 to V8.5pl3 -=============================== - -Critical bugfix - -- #4876: Guard checker incompleteness when using primitive projections - -Other bugfixes - -- #4780: Induction with universe polymorphism on was creating ill-typed terms. -- #4673: regression in setoid_rewrite, unfolding let-ins for type unification. -- #4754: Regression in setoid_rewrite, allow postponed unification problems to remain. -- #4769: Anomaly with universe polymorphic schemes defined inside sections. -- #3886: Program: duplicate obligations of mutual fixpoints. -- #4994: Documentation typo. -- #5008: Use the "md5" command on OpenBSD. -- #5007: Do not assume the "TERM" environment variable is always set. -- #4606: Output a break before a list only if there was an empty line. -- #5001: metas not cleaned properly in clenv_refine_in. -- #2336: incorrect glob data for module symbols (bug #2336). -- #4832: Remove extraneous dot in error message. -- Anomaly in printing a unification error message. -- #4947: Options which take string arguments are not backwards compatible. -- #4156: micromega cache files are now hidden files. -- #4871: interrupting par:abstract kills coqtop. -- #5043: [Admitted] lemmas pick up section variables. -- Fix name of internal refine ("simple refine"). -- #5062: probably a typo in Strict Proofs mode. -- #5065: Anomaly: Not a proof by induction. -- Restore native compiler optimizations, they were disabled since 8.5! -- #5077: failure on typing a fixpoint with evars in its type. -- Fix recursive notation bug. -- #5095: non relevant too strict test in let-in abstraction. -- Ensuring that the evar name is preserved by "rename". -- #4887: confusion between using and with in documentation of firstorder. -- Bug in subst with let-ins. -- #4762: eauto weaker than auto. -- Remove if_then_else (was buggy). Use tryif instead. -- #4970: confusion between special "{" and non special "{{" in notations. -- #4529: primitive projections unfolding. -- #4416: Incorrect "Error: Incorrect number of goals". -- #4863: abstract in typeclass hint fails. -- #5123: unshelve can impact typeclass resolution -- Fix a collision about the meta-variable ".." in recursive notations. -- Fix printing of info_auto. -- #3209: Not_found due to an occur-check cycle. -- #5097: status of evars refined by "clear" in ltac: closed wrt evars. -- #5150: Missing dependency of the test-suite subsystems in prerequisite. -- Fix a bug in error printing of unif constraints -- #3941: Do not stop propagation of signals when Coq is busy. -- #4822: Incorrect assertion in cbn. -- #3479 parsing of "{" and "}" when a keyword starts with "{" or "}". -- #5127: Memory corruption with the VM. -- #5102: bullets parsing broken by calls to parse_entry. - -Various documentation improvements - - -Changes from V8.5pl1 to V8.5pl2 -=============================== - -Critical bugfix -- Checksums of .vo files dependencies were not correctly checked. -- Unicode-to-ASCII translation was not injective, leading in a soundness bug in - the native compiler. - -Other bugfixes - -- #4097: more efficient occur-check in presence of primitive projections -- #4398: type_scope used consistently in "match goal". -- #4450: eauto does not work with polymorphic lemmas -- #4677: fix alpha-conversion in notations needing eta-expansion. -- Fully preserve initial order of hypotheses in "Regular Subst Tactic" mode. -- #4644: a regression in unification. -- #4725: Function (Error: Conversion test raised an anomaly) and Program - (Error: Cannot infer this placeholder of type) -- #4747: Problem building Coq 8.5pl1 with OCaml 4.03.0: Fatal warnings -- #4752: CoqIDE crash on files not ended by ".v". -- #4777: printing inefficiency with implicit arguments -- #4818: "Admitted" fails due to undefined universe anomaly after calling - "destruct" -- #4823: remote counter: avoid thread race on sockets -- #4841: -verbose flag changed semantics in 8.5, is much harder to use -- #4851: [nsatz] cannot handle duplicated hypotheses -- #4858: Anomaly: Uncaught exception Failure("hd"). Please report. in variant - of nsatz -- #4880: [nsatz_compute] generates invalid certificates if given redundant - hypotheses -- #4881: synchronizing "Declare Implicit Tactic" with backtrack. -- #4882: anomaly with Declare Implicit Tactic on hole of type with evars -- Fix use of "Declare Implicit Tactic" in refine. - triggered by CoqIDE -- #4069, #4718: congruence fails when universes are involved. - -Universes -- Disallow silently dropping universe instances applied to variables - (forward compatible) -- Allow explicit universe instances on notations, when they can apply - to the head reference of their expansion. - -Build infrastructure -- New update on how to find camlp5 binary and library at configure time. - -Changes from V8.5 to V8.5pl1 -============================ - -Critical bugfix -- The subterm relation for the guard condition was incorrectly defined on - primitive projections (#4588) - -Plugin development tools -- add a .merlin target to the makefile - -Various performance improvements (time, space used by .vo files) - -Other bugfixes - -- Fix order of arguments to Big.compare_case in ExtrOcamlZBigInt.v -- Added compatibility coercions from Specif.v which were present in Coq 8.4. -- Fixing a source of inefficiency and an artificial dependency in the printer in the congruence tactic. -- Allow to unset the refinement mode of Instance in ML -- Fixing an incorrect use of prod_appvect on a term which was not a product in setoid_rewrite. -- Add -compat 8.4 econstructor tactics, and tests -- Add compatibility Nonrecursive Elimination Schemes -- Fixing the "No applicable tactic" non informative error message regression on apply. -- Univs: fix get_current_context (bug #4603, part I) -- Fix a bug in Program coercion code -- Fix handling of arity of definitional classes. -- #4630: Some tactics are 20x slower in 8.5 than 8.4. -- #4627: records with no declared arity can be template polymorphic. -- #4623: set tactic too weak with universes (regression) -- Fix incorrect behavior of CS resolution -- #4591: Uncaught exception in directory browsing. -- CoqIDE is more resilient to initialization errors. -- #4614: "Fully check the document" is uninterruptable. -- Try eta-expansion of records only on non-recursive ones -- Fix bug when a sort is ascribed to a Record -- Primitive projections: protect kernel from erroneous definitions. -- Fixed bug #4533 with previous Keyed Unification commit -- Win: kill unreliable hence do not waitpid after kill -9 (Close #4369) -- Fix strategy of Keyed Unification -- #4608: Anomaly "output_value: abstract value (outside heap)". -- #4607: do not read native code files if native compiler was disabled. -- #4105: poor escaping in the protocol between CoqIDE and coqtop. -- #4596: [rewrite] broke in the past few weeks. -- #4533 (partial): respect declared global transparency of projections in unification.ml -- #4544: Backtrack on using full betaiota reduction during keyed unification. -- #4540: CoqIDE bottom progress bar does not update. -- Fix regression from 8.4 in reflexivity -- #4580: [Set Refine Instance Mode] also used for Program Instance. -- #4582: cannot override notation [ x ]. MAY CREATE INCOMPATIBILITIES, see #4683. -- STM: Print/Extraction have to be skipped if -quick -- #4542: CoqIDE: STOP button also stops workers -- STM: classify some variants of Instance as regular `Fork nodes. -- #4574: Anomaly: Uncaught exception Invalid_argument("splay_arity"). -- Do not give a name to anonymous evars anymore. See bug #4547. -- STM: always stock in vio files the first node (state) of a proof -- STM: not delegate proofs that contain Vernac(Module|Require|Import), #4530 -- Don't fail fatally if PATH is not set. -- #4537: Coq 8.5 is slower in typeclass resolution. -- #4522: Incorrect "Warning..." on windows. -- #4373: coqdep does not know about .vio files. -- #3826: "Incompatible module types" is uninformative. -- #4495: Failed assertion in metasyntax.ml. -- #4511: evar tactic can create non-typed evars. -- #4503: mixing universe polymorphic and monomorphic variables and definitions in sections is unsupported. -- #4519: oops, global shadowed local universe level bindings. -- #4506: Anomaly: File "pretyping/indrec.ml", line 169, characters 14-20: Assertion failed. -- #4548: Coqide crashes when going back one command - -Changes from V8.5beta3 to V8.5 -============================== - -Tools - -- Flag "-compat 8.4" now loads Coq.Compat.Coq84. The standard way of - putting Coq in v8.4 compatibility mode is to pass the command line flag - "-compat 8.4". It can be followed by "-require Coq.Compat.AdmitAxiom" - if the 8.4 behavior of admit is needed, in which case it uses an axiom. - -Specification language - -- Syntax "$(tactic)$" changed to "ltac:(tactic)". - -Tactics - -- Syntax "destruct !hyp" changed to "destruct (hyp)", and similarly - for induction (rare source of incompatibilities easily solvable by - removing parentheses around "hyp" when not for the purpose of keeping - the hypothesis). -- Syntax "p/c" for on-the-fly application of a lemma c before - introducing along pattern p changed to p%c1..%cn. The feature and - syntax are in experimental stage. -- "Proof using" does not clear unused section variables. -- Tactic "refine" has been changed back to the 8.4 behavior of shelving subgoals - that occur in other subgoals. The "refine" tactic of 8.5beta3 has been - renamed "simple refine"; it does not shelve any subgoal. -- New tactical "unshelve tac" which grab existential variables put on - the tactic shelve by the execution of "tac". - -Changes from V8.5beta2 to V8.5beta3 -=================================== - -Vernacular commands - -- New command "Redirect" to redirect the output of a command to a file. -- New command "Undelimit Scope" to remove the delimiter of a scope. -- New option "Strict Universe Declaration", set by default. It enforces the - declaration of all polymorphic universes appearing in a definition when - introducing it. -- New command "Show id" to show goal named id. -- Option "Virtual Machine" removed. - -Tactics - -- New flag "Regular Subst Tactic" which fixes "subst" in situations where - it failed to substitute all substitutable equations or failed to simplify - cycles, or accidentally unfolded local definitions (flag is off by default). -- New flag "Loose Hint Behavior" to handle hints loaded but not imported in a - special way. It accepts three distinct flags: - * "Lax", which is the default one, sets the old behavior, i.e. a non-imported - hint behaves the same as an imported one. - * "Warn" outputs a warning when a non-imported hint is used. Note that this is - an over-approximation, because a hint may be triggered by an eauto run that - will eventually fail and backtrack. - * "Strict" changes the behavior of an unloaded hint to the one of the fail - tactic, allowing to emulate the hopefully future import-scoped hint mechanism. -- New compatibility flag "Universal Lemma Under Conjunction" which - let tactics working under conjunctions apply sublemmas of the form - "forall A, ... -> A". -- New compatibility flag "Bracketing Last Introduction Pattern" which can be - set so that the last disjunctive-conjunctive introduction pattern given to - "intros" automatically complete the introduction of its subcomponents, as the - the disjunctive-conjunctive introduction patterns in non-terminal position - already do. -- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract - tactical w.r.t. variables appearing in the body of the proof. - -Program - -- The "Shrink Obligations" flag now applies to all obligations, not only those -solved by the automatic tactic. -- Importing Program no longer overrides the "exists" tactic (potential source - of incompatibilities). -- Hints costs are now correctly taken into account (potential source of - incompatibilities). -- Documented the Hint Cut command that allows control of the - proof-search during typeclass resolution (see reference manual). - -API - -- Some functions from pretyping/typing.ml and their derivatives were potential - source of evarmap leaks, as they dropped their resulting evarmap. The - situation was clarified by renaming them according to a unsafe_* scheme. Their - sound variant is likewise renamed to their old name. The following renamings - were made. - * Typing.type_of -> unsafe_type_of - * Typing.e_type_of -> type_of - * A new e_type_of function that matches the e_ prefix policy - * Tacmach.pf_type_of -> pf_unsafe_type_of - * A new safe pf_type_of function. - All uses of unsafe_* functions should be eventually eliminated. - -Tools - -- Added an option -w to control the output of coqtop warnings. -- Configure now takes an optional -native-compiler (yes|no) flag replacing - -no-native-compiler. The new flag is set to no by default under Windows. -- Flag -no-native-compiler was removed and became the default for coqc. If - precompilation of files for native conversion test is desired, use - -native-compiler. -- The -compile command-line option now takes the full path of the considered - file, including the ".v" extension, and outputs a warning if such an extension - is lacking. -- The -require and -load-vernac-object command-line options now take a logical - path of a given library rather than a physical path, thus they behave like - Require [Import] path. -- The -vm command-line option has been removed. - -Standard Library - - - There is now a Coq.Compat.Coq84 library, which sets the various compatibility - options and does a few redefinitions to make Coq behave more like Coq v8.4. - The standard way of putting Coq in v8.4 compatibility mode is to pass the command - line flags "-require Coq.Compat.Coq84 -compat 8.4". - -Changes from V8.5beta1 to V8.5beta2 -=================================== - -Logic - -- The VM now supports inductive types with up to 8388851 non-constant - constructors and up to 8388607 constant ones. - -Specification language - -- Syntax "$(tactic)$" changed to "ltac: tactic". - -Tactics - -- A script using the admit tactic can no longer be concluded by either - Qed or Defined. In the first case, Admitted can be used instead. In - the second case, a subproof should be used. -- The easy tactic and the now tactical now have a more predictable - behavior, but they might now discharge some previously unsolved goals. - -Extraction - -- Definitions extracted to Haskell GHC should no longer randomly - segfault when some Coq types cannot be represented by Haskell types. -- Definitions can now be extracted to Json for post-processing. - -Tools - -- Option -I -as has been removed, and option -R -as has been - deprecated. In both cases, option -R can be used instead. -- coq_makefile now generates double-colon rules for rules such as clean. - -API - -- The interface of [change] has changed to take a [change_arg], which - can be built from a [constr] using [make_change_arg]. - -Changes from V8.4 to V8.5beta1 -============================== - -Logic - -- Primitive projections for records allow for a compact representation - of projections, without parameters and avoid the behavior of defined - projections that can unfold to a case expression. To turn the use of - native projections on, use [Set Primitive Projections]. Record, - Class and Structure types defined while this option is set will be - defined with primitive projections instead of the usual encoding as - a case expression. For compatibility, when p is a primitive - projection, @p can be used to refer to the projection with explicit - parameters, i.e. [@p] is definitionally equal to [λ params r. r.(p)]. - Records with primitive projections have eta-conversion, the - canonical form being [mkR pars (p1 t) ... (pn t)]. -- New universe polymorphism (see reference manual) -- New option -type-in-type to collapse the universe hierarchy (this makes the - logic inconsistent). -- The guard condition for fixpoints is now a bit stricter. Propagation - of subterm value through pattern matching is restricted according to - the return predicate. Restores compatibility of Coq's logic with the - propositional extensionality axiom. May create incompatibilities in - recursive programs heavily using dependent types. -- Trivial inductive types are no longer defined in Type but in Prop, which - leads to a non-dependent induction principle being generated in place of - the dependent one. To recover the old behavior, explicitly define your - inductive types in Set. - -Vernacular commands - -- A command "Variant" allows to define non-recursive variant types. -- The command "Record foo ..." does not generate induction principles - (foo_rect, foo_rec, foo_ind) anymore by default (feature wish - #2693). The command "Variant foo ..." does not either. A flag - "Set/Unset Nonrecursive Elimination Schemes" allows changing this. - The tactic "induction" on a "Record" or a "Variant" is now actually - doing "destruct". -- The "Open Scope" command can now be given also a delimiter (e.g. Z). -- The "Definition" command now allows the "Local" modifier, allowing - for non-importable definitions. The same goes for "Axiom" and "Parameter". -- Section-specific commands such as "Let" (resp. "Variable", "Hypothesis") used - out of a section now behave like the corresponding "Local" command, i.e. - "Local Definition" (resp. "Local Parameter", "Local Axiom"). (potential source - of rare incompatibilities). -- The "Let" command can now define local (co)fixpoints. -- Command "Search" has been renamed into "SearchHead". The command - name "Search" now behaves like former "SearchAbout". The latter name - is deprecated. -- "Search", "About", "SearchHead", "SearchRewrite" and "SearchPattern" - now search for hypothesis (of the current goal by default) first. - They now also support the goal selector prefix to specify another - goal to search: e.g. "n:Search id". This is also true for - SearchAbout although it is deprecated. -- The coq/user-contrib directory and the XDG directories are no longer - recursively added to the load path, so files from installed libraries - now need to be fully qualified for the "Require" command to find them. - The tools/update-require script can be used to convert a development. -- A new Print Strategies command allows visualizing the opacity status - of the whole engine. -- The "Locate" command now searches through all sorts of qualified namespaces of - Coq: terms, modules, tactics, etc. The old behavior of the command can be - retrieved using the "Locate Term" command. -- New "Derive" command to help writing program by derivation. -- New "Refine Instance Mode" option that allows to deactivate the generation of - obligations in incomplete typeclass instances, raising an error instead. -- "Collection" command to name sets of section hypotheses. Named collections - can be used in the syntax of "Proof using" to assert which section variables - are used in a proof. -- The "Optimize Proof" command can be placed in the middle of a proof to - force the compaction of the data structure used to represent the ongoing - proof (evar map). This may result in a lower memory footprint and speed up - the execution of the following tactics. -- "Optimize Heap" command to tell the OCaml runtime to perform a major - garbage collection step and heap compaction. -- "Instance" no longer treats the {|...|} syntax specially; it handles it - in the same way as other commands, e.g. "Definition". Use the {...} - syntax (no pipe symbols) to recover the old behavior. - -Specification Language - -- Slight changes in unification error messages. -- Added a syntax $(...)$ that allows putting tactics in terms (may - break user notations using "$(", fixable by inserting a space or - rewriting the notation). -- Constructors in pattern-matching patterns now respect the same rules - regarding implicit arguments as in applicative position. The old - behavior can be recovered by the command "Set Asymmetric - Patterns". As a side effect, notations for constructors explicitly - mentioning non-implicit parameters can now be used in patterns. - Considering that the pattern language is already rich enough, binding - local definitions is however now forbidden in patterns (source of - incompatibilities for local definitions that delta-reduce to a constructor). -- Type inference algorithm now granting opacity of constants. This might also - affect behavior of tactics (source of incompatibilities, solvable by - re-declaring transparent constants which were set opaque). -- Existential variables are now referred to by an identifier and the - relevant part of their instance is displayed by default. They can be - reparsed. The naming policy is yet unstable and subject to changes - in future releases. - -Tactics - -- New tactic engine allowing dependent subgoals, fully backtracking - (also known as multiple success) tactics, as well as tactics which - can consider multiple goals together. In the new tactic engine, - instantiation information of existential variables is always - propagated to tactics, removing the need to manually use the - "instantiate" tactics to mark propagation points. - * New tactical (a+b) inserts a backtracking point. When (a+b);c fails - during the execution of c, it can backtrack and try b instead of a. - * New tactical (once a) removes all the backtracking points from a - (i.e. it selects the first success of a). - * Tactic "constructor" is now fully backtracking. In case of - incompatibilities (e.g. combinatoric explosion), the former - behavior of "constructor" can be retrieved by using instead - "[> once constructor ..]". Thanks to backtracking, undocumented - "constructor <tac>" syntax is now equivalent to - "[> once (constructor; tac) ..]". - * New "multimatch" variant of "match" tactic which backtracks to - new branches in case of a later failure. The "match" tactic is - equivalent to "once multimatch". - * New selector "all:" such that "all:tac" applies tactic "tac" to - all the focused goals, instead of just the first one as is the - default. - * A corresponding new option Set Default Goal Selector "all" makes - the tactics in scripts be applied to all the focused goal by default - * New selector "par:" such that "par:tac" applies the (terminating) - tactic "tac" to all the focused goal in parallel. The number of worker - can be selected with -async-proofs-tac-j and also limited using the - coqworkmgr utility. - * New tactics "revgoals", "cycle" and "swap" to reorder goals. - * The semantics of recursive tactics (introduced with "Ltac t := ..." - or "let rec t := ... in ...") changed slightly as t is now - applied to every goal, not each goal independently. In particular - it may be applied when no goals are left. This may cause tactics - such as "let rec t := constructor;t" to loop indefinitely. The - simple fix is to rewrite the recursive calls as follows: - "let rec t := constructor;[t..]" which recovers the earlier behavior - (source of rare incompatibilities). - * New tactic language feature "numgoals" to count number of goals. It is - accompanied by a "guard" tactic which fails if a Boolean test over - integers does not pass. - * New tactical "[> ... ]" to apply tactics to individual goals. - * New tactic "gfail" which works like "fail" except it will also - fail if every goal has been solved. - * The refine tactic is changed not to use an ad hoc typing algorithm - to generate subgoals. It also uses the dependent subgoal feature - to generate goals to materialize every existential variable which - is introduced by the refinement (source of incompatibilities). - * A tactic shelve is introduced to manage the subgoals which may be - solved by unification: shelve removes every goal it is applied to - from focus. These goals can later be called back into focus by the - Unshelve command. - * A variant shelve_unifiable only removes those goals which appear - as existential variables in other goals. To emulate the old - refine, use "refine c;shelve_unifiable". This can still cause - incompatibilities in rare occasions. - * New "give_up" tactic to skip over a goal. A proof containing - given up goals cannot be closed with "Qed", but only with "Admitted". -- The implementation of the admit tactic has changed: no axiom is - generated for the admitted sub proof. "admit" is now an alias for - "give_up". Code relying on this specific behavior of "admit" - can be made to work by: - * Adding an "Axiom" for each admitted subproof. - * Adding a single "Axiom proof_admitted : False." and the Ltac definition - "Ltac admit := case proof_admitted.". -- Matching using "lazymatch" was fundamentally modified. It now behaves - like "match" (immediate execution of the matching branch) but without - the backtracking mechanism in case of failure. -- New "tryif t then u else v" tactical which executes "u" in case of success - of "t" and "v" in case of failure. -- New conversion tactic "native_compute": evaluates the goal (or an hypothesis) - with a call-by-value strategy, using the OCaml native compiler. Useful on - very intensive computations. -- New "cbn" tactic, a well-behaved simpl. -- Repeated identical calls to omega should now produce identical proof terms. -- Tactics btauto, a reflexive Boolean tautology solver. -- Tactic "tauto" was exceptionally able to destruct other connectives - than the binary connectives "and", "or", "prod", "sum", "iff". This - non-uniform behavior has been fixed (bug #2680) and tauto is - slightly weaker (possible source of incompatibilities). On the - opposite side, new tactic "dtauto" is able to destruct any - record-like inductive types, superseding the old version of "tauto". -- Similarly, "intuition" has been made more uniform and, where it now - fails, "dintuition" can be used (possible source of incompatibilities). -- New option "Unset Intuition Negation Unfolding" for deactivating automatic - unfolding of "not" in intuition. -- Tactic notations can now be defined locally to a module (use "Local" prefix). -- Tactic "red" now reduces head beta-iota redexes (potential source of - rare incompatibilities). -- Tactic "hnf" now reduces inner beta-iota redexes - (potential source of rare incompatibilities). -- Tactic "intro H" now reduces beta-iota redexes if these hide a product - (potential source of rare incompatibilities). -- In Ltac matching on patterns of the form "_ pat1 ... patn" now - behaves like if matching on "?X pat1 ... patn", i.e. accepting "_" - to be instantiated by an applicative term (experimental at this - stage, potential source of incompatibilities). -- In Ltac matching on goal, types of hypotheses are now interpreted in - the %type scope (possible source of incompatibilities). -- "change ... in ..." and "simpl ... in ..." now properly consider nested - occurrences (possible source of incompatibilities since this alters - the numbering of occurrences), but do not support nested occurrences. -- Tactics simpl, vm_compute and native_compute can be given a notation string - to a constant as argument. -- When given a reference as argument, simpl, vm_compute and - native_compute now strictly interpret it as the head of a pattern - starting with this reference. -- The "change p with c" tactic semantics changed, now type-checking - "c" at each matching occurrence "t" of the pattern "p", and - converting "t" with "c". -- Now "appcontext" and "context" behave the same. The old buggy behavior of - "context" can be retrieved at parse time by setting the - "Tactic Compat Context" flag (possible source of incompatibilities). -- New introduction pattern p/c which applies lemma c on the fly on the - hypothesis under consideration before continuing with introduction pattern p. -- New introduction pattern [= x1 .. xn] applies "injection as [x1 .. xn]" - on the fly if injection is applicable to the hypothesis under consideration - (idea borrowed from Georges Gonthier). Introduction pattern [=] applies - "discriminate" if a discriminable equality. -- New introduction patterns * and ** to respectively introduce all forthcoming - dependent variables and all variables/hypotheses dependent or not. -- Tactic "injection c as ipats" now clears c if c refers to an - hypothesis and moves the resulting equations in the hypotheses - independently of the number of ipats, which has itself to be less - than the number of new hypotheses (possible source of incompatibilities; - former behavior obtainable by "Unset Injection L2R Pattern Order"). -- Tactic "injection" now automatically simplifies subgoals - "existT n p = existT n p'" into "p = p'" when "n" is in an inductive type for - which a decidable equality scheme has been generated with "Scheme Equality" - (possible source of incompatibilities). -- New tactic "rewrite_strat" for generalized rewriting with user-defined - strategies, subsuming autorewrite. -- Injection can now also deduce equality of arguments of sort Prop, by using - the option "Set Injection On Proofs" (disabled by default). Also improved the - error messages. -- Tactic "subst id" now supports id occurring in dependent local definitions. -- Bugs fixed about intro-pattern "*" might lead to some rare incompatibilities. -- New tactical "time" to display time spent executing its argument. -- Tactics referring or using a constant dependent in a section variable which - has been cleared or renamed in the current goal context now fail - (possible source of incompatibilities solvable by avoiding clearing - the relevant hypotheses). -- New construct "uconstr:c" and "type_term c" to build untyped terms. -- Binders in terms defined in Ltac (either "constr" or "uconstr") can - now take their names from identifiers defined in Ltac. As a - consequence, a name cannot be used in a binder "constr:(fun x => - ...)" if an Ltac variable of that name already exists and does not - contain an identifier. Source of occasional incompatibilities. -- The "refine" tactic now accepts untyped terms built with "uconstr" - so that terms with holes can be constructed piecewise in Ltac. -- New bullets --, ++, **, ---, +++, ***, ... made available. -- More informative messages when wrong bullet is used. -- Bullet suggestion when a subgoal is solved. -- New tactic "enough", symmetric to "assert", but with subgoals - swapped, as a more friendly replacement of "cut". -- In destruct/induction, experimental modifier "!" prefixing the - hypothesis name to tell not erasing the hypothesis. -- Bug fixes in "inversion as" may occasionally lead to incompatibilities. -- Behavior of introduction patterns -> and <- made more uniform - (hypothesis is cleared, rewrite in hypotheses and conclusion and - erasing the variable when rewriting a variable). -- New experimental option "Set Standard Proposition Elimination Names" - so that case analysis or induction on schemes in Type containing - propositions now produces "H"-based names. -- Tactics from plugins are now active only when the corresponding module - is imported (source of incompatibilities, solvable by adding an "Import"; - in the particular case of Omega, use "Require Import OmegaTactic"). -- Semantics of destruct/induction has been made more regular in some - edge cases, possibly leading to incompatibilities: - - new goals are now opened when the term does not match a subterm of - the goal and has unresolved holes, while in 8.4 these holes were - turned into existential variables - - when no "at" option is given, the historical semantics which - selects all subterms syntactically identical to the first subterm - matching the given pattern is used - - non-dependent destruct/induction on an hypothesis with premises in - an inductive type with indices is fixed - - residual local definitions are now correctly removed. -- The rename tactic may now replace variables in parallel. -- A new "Info" command replaces the "info" tactical discontinued in - v8.4. It still gives informative results in many cases. -- The "info_auto" tactic is known to be broken and does not print a - trace anymore. Use "Info 1 auto" instead. The same goes for - "info_trivial". On the other hand "info_eauto" still works fine, - while "Info 1 eauto" prints a trivial trace. -- When using a lemma of the prototypical form "forall A, {a:A & P a}", - "apply" and "apply in" do not instantiate anymore "A" with the - current goal and use "a" as the proof, as they were sometimes doing, - now considering that it is a too powerful decision. - -Program - -- "Solve Obligations using" changed to "Solve Obligations with", - consistent with "Proof with". -- Program Lemma, Definition now respect automatic introduction. -- Program Lemma, Definition, etc.. now interpret "->" like Lemma and - Definition as a non-dependent arrow (potential source of - incompatibility). -- Add/document "Set Hide Obligations" (to hide obligations in the final - term inside an implicit argument) and "Set Shrink Obligations" (to - minimize dependencies of obligations defined by tactics). - -Notations - -- The syntax "x -> y" is now declared at level 99. In particular, it has - now a lower priority than "<->": "A -> B <-> C" is now "A -> (B <-> C)" - (possible source of incompatibilities) -- Notations accept term-providing tactics using the $(...)$ syntax. -- "Bind Scope" can no longer bind "Funclass" and "Sortclass". -- A notation can be given a (compat "8.x") annotation, making it behave - like a "only parsing" notation, but the annotation may lead to eventually - issue warnings or errors in further versions when this notation is used. -- More systematic insertion of spaces as a default for printing - notations ("format" still available to override the default). -- In notations, a level modifier referring to a non-existent variable is - now considered an error rather than silently ignored. - -Tools - -- Option -I now only adds directories to the ml path. -- Option -Q behaves as -R, except that the logical path of any loaded file has - to be fully qualified. -- Option -R no longer adds recursively to the ml path; only the root - directory is added. (Behavior with respect to the load path is - unchanged.) -- Option -nois prevents coq/theories and coq/plugins to be recursively - added to the load path. (Same behavior as with coq/user-contrib.) -- coqdep accepts a -dumpgraph option generating a dot file. -- Makefiles generated through coq_makefile have three new targets "quick" - "checkproofs" and "vio2vo", allowing respectively to asynchronously compile - the files without playing the proof scripts, asynchronously checking - that the quickly generated proofs are correct and generating the object - files from the quickly generated proofs. -- The XML plugin was discontinued and removed from the source. -- A new utility called coqworkmgr can be used to limit the number of - concurrent workers started by independent processes, like make and CoqIDE. - This is of interest for users of the par: goal selector. - -Interfaces - -- CoqIDE supports asynchronous edition of the document, ongoing tasks and - errors are reported in the bottom right window. The number of workers - taking care of processing proofs can be selected with -async-proofs-j. -- CoqIDE highlights in yellow "unsafe" commands such as axiom - declarations, and tactics like "give_up". -- CoqIDE supports Proof General like key bindings; - to activate the PG mode go to Edit -> Preferences -> Editor. - For the documentation see Help -> Help for PG mode. -- CoqIDE automatically retracts the locked area when one edits the - locked text. -- CoqIDE search and replace got regular expressions power. See the - documentation of OCaml's Str module for the supported syntax. -- Many CoqIDE windows, including the query one, are now detachable to - improve usability on multi screen work stations. -- Coqtop/coqc outputs highlighted syntax. Colors can be configured thanks - to the COQ_COLORS environment variable, and their current state can - be displayed with the -list-tags command line option. -- Third party user interfaces can install their main loop in $COQLIB/toploop - and call coqtop with the -toploop flag to select it. - -Internal Infrastructure - -- Many reorganizations in the ocaml source files. For instance, - many internal a.s.t. of Coq are now placed in mli files in - a new directory intf/, for instance constrexpr.mli or glob_term.mli. - More details in dev/doc/changes. -- The file states/initial.coq does not exist anymore. Instead, coqtop - initially does a "Require" of Prelude.vo (or nothing when given - the options -noinit or -nois). -- The format of vo files has slightly changed: cf final comments in - checker/cic.mli. -- The build system does not produce anymore programs named coqtop.opt - and a symbolic link to coqtop. Instead, coqtop is now directly - an executable compiled with the best OCaml compiler available. - The bytecode program coqtop.byte is still produced. Same for other - utilities. -- Some options of the ./configure script slightly changed: - * The -coqrunbyteflags and its blank-separated argument is replaced - by option -vmbyteflags which expects a comma-separated argument. - * The -coqtoolsbyteflags option is discontinued, see -no-custom instead. - -Miscellaneous - -- ML plugins now require a "DECLARE PLUGIN \"foo\"" statement. The "foo" name - must be exactly the name of the ML module that will be loaded through a - "Declare ML \"foo\"" command. - -Changes from V8.4beta2 to V8.4 -============================== - -Vernacular commands - -- The "Reset" command is now supported again in files given to coqc or Load. -- "Show Script" now indents again the displayed scripts. It can also work - correctly across Load'ed files if the option "Unset Atomic Load" is used. -- "Open Scope" can now be given the delimiter (e.g. Z) instead of the full - scope name (e.g. Z_scope). - -Notations - -- Most compatibility notations of the standard library are now tagged as - (compat xyz), where xyz is a former Coq version, for instance "8.3". - These notations behave as (only parsing) notations, except that they may - triggers warnings (or errors) when used while Coq is not in a corresponding - -compat mode. -- To activate these compatibility warnings, use "Set Verbose Compat Notations" - or the command-line flag -verbose-compat-notations. -- For a strict mode without these compatibility notations, use - "Unset Compat Notations" or the command-line flag -no-compat-notations. - -Tactics - -- An annotation "eqn:H" or "eqn:?" can be added to a "destruct" - or "induction" to make it generate equations in the spirit of "case_eq". - The former syntax "_eqn" is discontinued. -- The name of the hypothesis introduced by tactic "remember" can be - set via the new syntax "remember t as x eqn:H" (wish #2489). - -Libraries - -- Reals: changed definition of PI, no more axiom about sin(PI/2). -- SetoidPermutation: a notion of permutation for lists modulo a setoid equality. -- BigN: fixed the ocaml code doing the parsing/printing of big numbers. -- List: a couple of lemmas added especially about no-duplication, partitions. -- Init: Removal of the coercions between variants of sigma-types and - subset types (possible source of incompatibility). - -Changes from V8.4beta to V8.4beta2 -================================== - -Vernacular commands - -- Commands "Back" and "BackTo" are now handling the proof states. They may - perform some extra steps of backtrack to avoid states where the proof - state is unavailable (typically a closed proof). -- The commands "Suspend" and "Resume" have been removed. -- A basic Show Script has been reintroduced (no indentation). -- New command "Set Parsing Explicit" for deactivating parsing (and printing) - of implicit arguments (useful for teaching). -- New command "Grab Existential Variables" to transform the unresolved evars - at the end of a proof into goals. - -Tactics - -- Still no general "info" tactical, but new specific tactics info_auto, - info_eauto, info_trivial which provides information on the proofs found - by auto/eauto/trivial. Display of these details could also be activated by - "Set Info Auto"/"Set Info Eauto"/"Set Info Trivial". -- Details on everything tried by auto/eauto/trivial during a proof search - could be obtained by "debug auto", "debug eauto", "debug trivial" or by a - global "Set Debug Auto"/"Set Debug Eauto"/"Set Debug Trivial". -- New command "r string" in Ltac debugger that interprets "idtac - string" in Ltac code as a breakpoint and jumps to its next use. -- Tactics from the Dp plugin (simplify, ergo, yices, cvc3, z3, cvcl, - harvey, zenon, gwhy) have been removed, since Why2 has not been - maintained for the last few years. The Why3 plugin should be a suitable - replacement in most cases. - -Libraries - -- MSetRBT: a new implementation of MSets via Red-Black trees (initial - contribution by Andrew Appel). -- MSetAVL: for maximal sharing with the new MSetRBT, the argument order - of Node has changed (this should be transparent to regular MSets users). - -Module System - -- The names of modules (and module types) are now in a fully separated - namespace from ordinary definitions: "Definition E:=0. Module E. End E." - is now accepted. - -CoqIDE - -- Coqide now supports the "Restart" command, and "Undo" (with a warning). - Better support for "Abort". - -Changes from V8.3 to V8.4beta -============================= - -Logic - -- Standard eta-conversion now supported (dependent product only). -- Guard condition improvement: subterm property is propagated through beta-redex - blocked by pattern-matching, as in "(match v with C .. => fun x => u end) x"; - this allows for instance to use "rewrite ... in ..." without breaking - the guard condition. - -Specification language and notations - -- Maximal implicit arguments can now be set locally by { }. The registration - traverses fixpoints and lambdas. Because there is conversion in types, - maximal implicit arguments are not taken into account in partial - applications (use eta expanded form with explicit { } instead). -- Added support for recursive notations with binders (allows for instance - to write "exists x y z, P"). -- Structure/Record printing can be disable by "Unset Printing Records". - In addition, it can be controlled on type by type basis using - "Add Printing Record" or "Add Printing Constructor". -- Pattern-matching compilation algorithm: in "match x, y with ... end", - possible dependencies of x (or of the indices of its type) in the type - of y are now taken into account. - -Tactics - -- New proof engine. -- Scripts can now be structured thanks to bullets - * + and to subgoal - delimitation via { }. Note: for use with Proof General, a cvs version of - Proof General no older than mid-July 2011 is currently required. -- Support for tactical "info" is suspended. -- Support for command "Show Script" is suspended. -- New tactics constr_eq, is_evar and has_evar for use in Ltac (DOC TODO). -- Removed the two-argument variant of "decide equality". -- New experimental tactical "timeout <n> <tac>". Since <n> is a time - in second for the moment, this feature should rather be avoided - in scripts meant to be machine-independent. -- Fix in "destruct": removal of unexpected local definitions in context might - result in some rare incompatibilities (solvable by adapting name hypotheses). -- Introduction pattern "_" made more robust. -- Tactic (and Eval command) vm_compute can now be interrupted via Ctrl-C. -- Unification in "apply" supports unification of patterns of the form - ?f x y = g(x,y) (compatibility ensured by using - "Unset Tactic Pattern Unification"). It also supports (full) betaiota. -- Tactic autorewrite does no longer instantiate pre-existing - existential variables (theoretical source of possible incompatibilities). -- Tactic "dependent rewrite" now supports equality in "sig". -- Tactic omega now understands Zpred (wish #1912) and can prove any goal - from a context containing an arithmetical contradiction (wish #2236). -- Using "auto with nocore" disables the use of the "core" database (wish #2188). - This pseudo-database "nocore" can also be used with trivial and eauto. -- Tactics "set", "destruct" and "induction" accepts incomplete terms and - use the goal to complete the pattern assuming it is non ambiguous. -- When used on arguments with a dependent type, tactics such as - "destruct", "induction", "case", "elim", etc. now try to abstract - automatically the dependencies over the arguments of the types - (based on initial ideas from Chung-Kil Hur, extension to nested - dependencies suggested by Dan Grayson) -- Tactic "injection" now failing on an equality showing no constructors while - it was formerly generalizing again the goal over the given equality. -- In Ltac, the "context [...]" syntax has now a variant "appcontext [...]" - allowing to match partial applications in larger applications. -- When applying destruct or inversion on a fixpoint hiding an inductive - type, recursive calls to the fixpoint now remain folded by default (rare - source of incompatibility generally solvable by adding a call to simpl). -- In an ltac pattern containing a "match", a final "| _ => _" branch could be - used now instead of enumerating all remaining constructors. Moreover, the - pattern "match _ with _ => _ end" now allows to match any "match". A "in" - annotation can also be added to restrict to a precise inductive type. -- The behavior of "simpl" can be tuned using the "Arguments" vernacular. - In particular constants can be marked so that they are always/never unfolded - by "simpl", or unfolded only when a set of arguments evaluates to a - constructor. Last one can mark a constant so that it is unfolded only if the - simplified term does not expose a match in head position. - -Vernacular commands - -- It is now mandatory to have a space (or tabulation or newline or end-of-file) - after a "." ending a sentence. -- In SearchAbout, the [ ] delimiters are now optional. -- New command "Add/Remove Search Blacklist <substring> ...": - a Search or SearchAbout or similar query will never mention lemmas - whose qualified names contain any of the declared substrings. - The default blacklisted substrings are "_subproof" "Private_". -- When the output file of "Print Universes" ends in ".dot" or ".gv", - the universe graph is printed in the DOT language, and can be - processed by Graphviz tools. -- New command "Print Sorted Universes". -- The undocumented and obsolete option "Set/Unset Boxed Definitions" has - been removed, as well as syntaxes like "Boxed Fixpoint foo". -- A new option "Set Default Timeout n / Unset Default Timeout". -- Qed now uses information from the reduction tactics used in proof script - to avoid conversion at Qed time to go into a very long computation. -- New command "Show Goal ident" to display the statement of a goal, even - a closed one (available from Proof General). -- Command "Proof" accept a new modifier "using" to force generalization - over a given list of section variables at section ending (DOC TODO). -- New command "Arguments" generalizing "Implicit Arguments" and - "Arguments Scope" and that also allows to rename the parameters of a - definition and to tune the behavior of the tactic "simpl". - -Module System - -- During subtyping checks, an opaque constant in a module type could now - be implemented by anything of the right type, even if bodies differ. - Said otherwise, with respect to subtyping, an opaque constant behaves - just as a parameter. Coqchk was already implementing this, but not coqtop. -- The inlining done during application of functors can now be controlled - more precisely, by the annotations (no inline) or (inline at level XX). - With the latter annotation, only functor parameters whose levels - are lower or equal than XX will be inlined. - The level of a parameter can be fixed by "Parameter Inline(30) foo". - When levels aren't given, the default value is 100. One can also use - the flag "Set Inline Level ..." to set a level (DOC TODO). -- Print Assumptions should now handle correctly opaque modules (#2168). -- Print Module (Type) now tries to print more details, such as types and - bodies of the module elements. Note that Print Module Type could be - used on a module to display only its interface. The option - "Set Short Module Printing" could be used to switch back to the earlier - behavior were only field names were displayed. - -Libraries - -- Extension of the abstract part of Numbers, which now provide axiomatizations - and results about many more integer functions, such as pow, gcd, lcm, sqrt, - log2 and bitwise functions. These functions are implemented for nat, N, BigN, - Z, BigZ. See in particular file NPeano for new functions about nat. -- The definition of types positive, N, Z is now in file BinNums.v -- Major reorganization of ZArith. The initial file ZArith/BinInt.v now contains - an internal module Z implementing the Numbers interface for integers. - This module Z regroups: - * all functions over type Z : Z.add, Z.mul, ... - * the minimal proofs of specifications for these functions : Z.add_0_l, ... - * an instantation of all derived properties proved generically in Numbers : - Z.add_comm, Z.add_assoc, ... - A large part of ZArith is now simply compatibility notations, for instance - Zplus_comm is an alias for Z.add_comm. The direct use of module Z is now - recommended instead of relying on these compatibility notations. -- Similar major reorganization of NArith, via a module N in NArith/BinNat.v -- Concerning the positive datatype, BinPos.v is now in a specific directory - PArith, and contains an internal submodule Pos. We regroup there functions - such as Pos.add Pos.mul etc as well as many results about them. These results - are here proved directly (no Number interface for strictly positive numbers). -- Note that in spite of the compatibility layers, all these reorganizations - may induce some marginal incompatibilies in scripts. In particular: - * the "?=" notation for positive now refers to a binary function Pos.compare, - instead of the infamous ternary Pcompare (now Pos.compare_cont). - * some hypothesis names generated by the system may changed (typically for - a "destruct Z_le_gt_dec") since naming is done after the short name of - the head predicate (here now "le" in module Z instead of "Zle", etc). - * the internals of Z.add has changed, now relying of Z.pos_sub. -- Also note these new notations: - * "<?" "<=?" "=?" for boolean tests such as Z.ltb Z.leb Z.eqb. - * "÷" for the alternative integer division Z.quot implementing the Truncate - convention (former ZOdiv), while the notation for the Coq usual division - Z.div implementing the Flooring convention remains "/". Their corresponding - modulo functions are Z.rem (no notations) for Z.quot and Z.modulo (infix - "mod" notation) for Z.div. -- Lemmas about conversions between these datatypes are also organized - in modules, see for instance modules Z2Nat, N2Z, etc. -- When creating BigN, the macro-generated part NMake_gen is much smaller. - The generic part NMake has been reworked and improved. Some changes - may introduce incompatibilities. In particular, the order of the arguments - for BigN.shiftl and BigN.shiftr is now reversed: the number to shift now - comes first. By default, the power function now takes two BigN. -- Creation of Vector, an independent library for lists indexed by their length. - Vectors' names overwrite lists' one so you should not "Import" the library. - All old names changed: function names follow the ocaml ones and, for example, - Vcons becomes Vector.cons. You can get [..;..;..]-style notations by importing - Vector.VectorNotations. -- Removal of TheoryList. Requiring List instead should work most of the time. -- New syntax "rew Heq in H" and "rew <- Heq in H" for eq_rect and - eq_rect_r (available by importing module EqNotations). -- Wf.iter_nat is now Peano.nat_iter (with an implicit type argument). - -Internal infrastructure - -- Opaque proofs are now loaded lazily by default. This allows to be almost as - fast as -dont-load-proofs, while being safer (no creation of axioms) and - avoiding feature restrictions (Print and Print Assumptions work ok). -- Revised hash-consing code allowing more sharing of memory -- Experimental support added for camlp4 (the one provided alongside ocaml), - simply pass option -usecamlp4 to ./configure. By default camlp5 is used. -- Revised build system: no more stages in Makefile thanks to some recursive - aspect of recent gnu make, use of vo.itarget files containing .v to compile - for both make and ocamlbuild, etc. -- Support of cross-compilation via mingw from unix toward Windows, - contact P. Letouzey for more informations. -- New Makefile rules mli-doc to make html of mli in dev/doc/html and - full-stdlib to get a (huge) pdf reflecting the whole standard library. - -Extraction - -- By default, opaque terms are now truly considered opaque by extraction: - instead of accessing their body, they are now considered as axioms. - The previous behaviour can be reactivated via the option - "Set Extraction AccessOpaque". -- The pretty-printer for Haskell now produces layout-independent code -- A new command "Separate Extraction cst1 cst2 ..." that mixes a - minimal extracted environment a la "Recursive Extraction" and the - production of several files (one per coq source) a la "Extraction Library" - (DOC TODO). -- New option "Set/Unset Extraction KeepSingleton" for preventing the - extraction to optimize singleton container types (DOC TODO). -- The extraction now identifies and properly rejects a particular case of - universe polymorphism it cannot handle yet (the pair (I,I) being Prop). -- Support of anonymous fields in record (#2555). - -CoqIDE - -- Coqide now runs coqtop as separated process, making it more robust: - coqtop subprocess can be interrupted, or even killed and relaunched - (cf button "Restart Coq", ex-"Go to Start"). For allowing such - interrupts, the Windows version of coqide now requires Windows >= XP - SP1. -- The communication between CoqIDE and Coqtop is now done via a dialect - of XML (DOC TODO). -- The backtrack engine of CoqIDE has been reworked, it now uses the - "Backtrack" command similarly to Proof General. -- The Coqide parsing of sentences has be reworked and now supports - tactic delimitation via { }. -- Coqide now accepts the Abort command (wish #2357). -- Coqide can read coq_makefile files as "project file" and use it to - set automatically options to send to coqtop. -- Preference files have moved to $XDG_CONFIG_HOME/coq and accelerators - are not stored as a list anymore. - -Tools - -- Coq now searches directories specified in COQPATH, $XDG_DATA_HOME/coq, - $XDG_DATA_DIRS/coq, and user-contribs before the standard library. -- Coq rc file has moved to $XDG_CONFIG_HOME/coq. -- Major changes to coq_makefile: - * mli/mlpack/mllib taken into account, ml not preproccessed anymore, ml4 work; - * mlihtml generates doc of mli, install-doc install the html doc in DOCDIR - with the same policy as vo in COQLIB; - * More variables are given by coqtop -config, others are defined only if the - users doesn't have defined them elsewhere. Consequently, generated makefile - should work directly on any architecture; - * Packagers can take advantage of $(DSTROOT) introduction. Installation can - be made in $XDG_DATA_HOME/coq; - * -arg option allows to send option as argument to coqc. - -Changes from V8.2 to V8.3 -========================= - -Rewriting tactics - -- Tactic "rewrite" now supports rewriting on ad hoc equalities such as eq_true. -- "Hint Rewrite" now checks that the lemma looks like an equation. -- New tactic "etransitivity". -- Support for heterogeneous equality (JMeq) in "injection" and "discriminate". -- Tactic "subst" now supports heterogeneous equality and equality - proofs that are dependent (use "simple subst" for preserving compatibility). -- Added support for Leibniz-rewriting of dependent hypotheses. -- Renamed "Morphism" into "Proper" and "respect" into "proper_prf" - (possible source of incompatibility). A partial fix is to define - "Notation Morphism R f := (Proper (R%signature) f)." -- New tactic variants "rewrite* by" and "autorewrite*" that rewrite - respectively the first and all matches whose side-conditions are - solved. -- "Require Import Setoid" does not export all of "Morphisms" and - "RelationClasses" anymore (possible source of incompatibility, fixed - by importing "Morphisms" too). -- Support added for using Chung-Kil Hur's Heq library for rewriting over - heterogeneous equality (courtesy of the library's author). -- Tactic "replace" supports matching terms with holes. - -Automation tactics - -- Tactic "intuition" now preserves inner "iff" and "not" (exceptional - source of incompatibilities solvable by redefining "intuition" as - "unfold iff, not in *; intuition", or, for iff only, by using - "Set Intuition Iff Unfolding".) -- Tactic "tauto" now proves classical tautologies as soon as classical logic - (i.e. library Classical_Prop or Classical) is loaded. -- Tactic "gappa" has been removed from the Dp plugin. -- Tactic "firstorder" now supports the combination of its "using" and - "with" options. -- New "Hint Resolve ->" (or "<-") for declaring iff's as oriented - hints (wish #2104). -- An inductive type as argument of the "using" option of "auto/eauto/firstorder" - is interpreted as using the collection of its constructors. -- New decision tactic "nsatz" to prove polynomial equations - by computation of Groebner bases. - -Other tactics - -- Tactic "discriminate" now performs intros before trying to discriminate an - hypothesis of the goal (previously it applied intro only if the goal - had the form t1<>t2) (exceptional source of incompatibilities - former - behavior can be obtained by "Unset Discriminate Introduction"). -- Tactic "quote" now supports quotation of arbitrary terms (not just the - goal). -- Tactic "idtac" now displays its "list" arguments. -- New introduction patterns "*" for introducing the next block of dependent - variables and "**" for introducing all quantified variables and hypotheses. -- Pattern Unification for existential variables activated in tactics and - new option "Unset Tactic Evars Pattern Unification" to deactivate it. -- Resolution of canonical structure is now part of the tactic's unification - algorithm. -- New tactic "decide lemma with hyp" for rewriting decidability lemmas - when one knows which side is true. -- Improved support of dependent goals over objects in dependent types for - "destruct" (rare source of incompatibility that can be avoided by unsetting - option "Dependent Propositions Elimination"). -- Tactic "exists", "eexists", "destruct" and "edestruct" supports iteration - using comma-separated arguments. -- Tactic names "case" and "elim" now support clauses "as" and "in" and become - then synonymous of "destruct" and "induction" respectively. -- A new tactic name "exfalso" for the use of 'ex-falso quodlibet' principle. - This tactic is simply a shortcut for "elimtype False". -- Made quantified hypotheses get the name they would have if introduced in - the context (possible but rare source of incompatibilities). -- When applying a component of a conjunctive lemma, "apply in" (and - sequences of "apply in") now leave the side conditions of the lemmas - uniformly after the main goal (possible source of rare incompatibilities). -- In "simpl c" and "change c with d", c can be a pattern. -- Tactic "revert" now preserves let-in's making it the exact inverse of - "intro". -- New tactics "clear dependent H" and "revert dependent H" that - clears (resp. reverts) H and all the hypotheses that depend on H. -- Ltac's pattern-matching now supports matching metavariables that - depend on variables bound upwards in the pattern. - -Tactic definitions - -- Ltac definitions support Local option for non-export outside modules. -- Support for parsing non-empty lists with separators in tactic notations. -- New command "Locate Ltac" to get the full name of an Ltac definition. - -Notations - -- Record syntax "{|x=...; y=...|}" now works inside patterns too. -- Abbreviations from non-imported module now invisible at printing time. -- Abbreviations now use implicit arguments and arguments scopes for printing. -- Abbreviations to pure names now strictly behave like the name they refer to - (make redirections of qualified names easier). -- Abbreviations for applied constant now propagate the implicit arguments - and arguments scope of the underlying reference (possible source of - incompatibilities generally solvable by changing such abbreviations from - e.g. "Notation foo' := (foo x)" to "Notation foo' y := (foo x (y:=y))"). -- The "where" clause now supports multiple notations per defined object. -- Recursive notations automatically expand one step on the left for better - factorization; recursion notations inner separators now ensured being tokens. -- Added "Reserved Infix" as a specific shortcut of the corresponding - "Reserved Notation". -- Open/Close Scope command supports Global option in sections. - -Specification language - -- New support for local binders in the syntax of Record/Structure fields. -- Fixpoint/CoFixpoint now support building part or all of bodies using tactics. -- Binders given before ":" in lemmas and in definitions built by tactics are - now automatically introduced (possible source of incompatibility that can - be resolved by invoking "Unset Automatic Introduction"). -- New support for multiple implicit arguments signatures per reference. - -Module system - -- Include Type is now deprecated since Include now accept both modules and - module types. -- Declare ML Module supports Local option. -- The sharing between non-logical object and the management of the - name-space has been improved by the new "Delta-equivalence" on - qualified name. -- The include operator has been extended to high-order structures -- Sequences of Include can be abbreviated via new syntax "<+". -- A module (or module type) can be given several "<:" signatures. -- Interactive proofs are now permitted in module type. Functors can hence - be declared as Module Type and be used later to type themselves. -- A functor application can be prefixed by a "!" to make it ignore any - "Inline" annotation in the type of its argument(s) (for examples of - use of the new features, see libraries Structures and Numbers). -- Coercions are now active only when modules are imported (use "Set Automatic - Coercions Import" to get the behavior of the previous versions of Coq). - -Extraction - -- When using (Recursive) Extraction Library, the filenames are directly the - Coq ones with new appropriate extensions : we do not force anymore - uncapital first letters for Ocaml and capital ones for Haskell. -- The extraction now tries harder to avoid code transformations that can be - dangerous for the complexity. In particular many eta-expansions at the top - of functions body are now avoided, clever partial applications will likely - be preserved, let-ins are almost always kept, etc. -- In the same spirit, auto-inlining is now disabled by default, except for - induction principles, since this feature was producing more frequently - weird code than clear gain. The previous behavior can be restored via - "Set Extraction AutoInline". -- Unicode characters in identifiers are now transformed into ascii strings - that are legal in Ocaml and other languages. -- Harsh support of module extraction to Haskell and Scheme: module hierarchy - is flattened, module abbreviations and functor applications are expanded, - module types and unapplied functors are discarded. -- Less unsupported situations when extracting modules to Ocaml. In particular - module parameters might be alpha-renamed if a name clash is detected. -- Extract Inductive is now possible toward non-inductive types (e.g. nat => int) -- Extraction Implicit: this new experimental command allows to mark - some arguments of a function or constructor for removed during - extraction, even if these arguments don't fit the usual elimination - principles of extraction, for instance the length n of a vector. -- Files ExtrOcaml*.v in plugins/extraction try to provide a library of common - extraction commands: mapping of basics types toward Ocaml's counterparts, - conversions from/to int and big_int, or even complete mapping of nat,Z,N - to int or big_int, or mapping of ascii to char and string to char list - (in this case recognition of ascii constants is hard-wired in the extraction). - -Program - -- Streamlined definitions using well-founded recursion and measures so - that they can work on any subset of the arguments directly (uses currying). -- Try to automatically clear structural fixpoint prototypes in - obligations to avoid issues with opacity. -- Use return type clause inference in pattern-matching as in the standard - typing algorithm. -- Support [Local Obligation Tactic] and [Next Obligation with tactic]. -- Use [Show Obligation Tactic] to print the current default tactic. -- [fst] and [snd] have maximal implicit arguments in Program now (possible - source of incompatibility). - -Type classes - -- Declaring axiomatic type class instances in Module Type should be now - done via new command "Declare Instance", while the syntax "Instance" - now always provides a concrete instance, both in and out of Module Type. -- Use [Existing Class foo] to declare foo as a class a posteriori. - [foo] can be an inductive type or a constant definition. No - projections or instances are defined. -- Various bug fixes and improvements: support for defined fields, - anonymous instances, declarations giving terms, better handling of - sections and [Context]. - -Vernacular commands - -- New command "Timeout <n> <command>." interprets a command and a timeout - interrupts the interpretation after <n> seconds. -- New command "Compute <expr>." is a shortcut for "Eval vm_compute in <expr>". -- New command "Fail <command>." interprets a command and is successful iff - the command fails on an error (but not an anomaly). Handy for tests and - illustration of wrong commands. -- Most commands referring to constant (e.g. Print or About) now support - referring to the constant by a notation string. -- New option "Boolean Equality Schemes" to make generation of boolean - equality automatic for datatypes (together with option "Decidable - Equality Schemes", this replaces deprecated option "Equality Scheme"). -- Made support for automatic generation of case analysis schemes available - to user (governed by option "Set Case Analysis Schemes"). -- New command "(Global?) Generalizable [All|No] Variable(s)? ident(s)?" to - declare which identifiers are generalizable in `{} and `() binders. -- New command "Print Opaque Dependencies" to display opaque constants in - addition to all variables, parameters or axioms a theorem or - definition relies on. -- New command "Declare Reduction <id> := <conv_expr>", allowing to write - later "Eval <id> in ...". This command accepts a Local variant. -- Syntax of Implicit Type now supports more than one block of variables of - a given type. -- Command "Canonical Structure" now warns when it has no effects. -- Commands of the form "Set X" or "Unset X" now support "Local" and "Global" - prefixes. - -Library - -- Use "standard" Coq names for the properties of eq and identity - (e.g. refl_equal is now eq_refl). Support for compatibility is provided. -- The function Compare_dec.nat_compare is now defined directly, - instead of relying on lt_eq_lt_dec. The earlier version is still - available under the name nat_compare_alt. -- Lemmas in library Relations and Reals have been homogenized a bit. -- The implicit argument of Logic.eq is now maximally inserted, allowing - to simply write "eq" instead of "@eq _" in morphism signatures. -- Wrongly named lemmas (Zlt_gt_succ and Zlt_succ_gt) fixed (potential source - of incompatibilities) -- List library: - - Definitions of list, length and app are now in Init/Datatypes. - Support for compatibility is provided. - - Definition of Permutation is now in Sorting/Permtation.v - - Some other light revisions and extensions (possible source - of incompatibilities solvable by qualifying names accordingly). -- In ListSet, set_map has been fixed (source of incompatibilities if used). -- Sorting library: - - new mergesort of worst-case complexity O(n*ln(n)) made available in - Mergesort.v; - - former notion of permutation up to setoid from Permutation.v is - deprecated and moved to PermutSetoid.v; - - heapsort from Heap.v of worst-case complexity O(n*n) is deprecated; - - new file Sorted.v for some definitions of being sorted. -- Structure library. This new library is meant to contain generic - structures such as types with equalities or orders, either - in Module version (for now) or Type Classes (still to do): - - DecidableType.v and OrderedType.v: initial notions for FSets/FMaps, - left for compatibility but considered as deprecated. - - Equalities.v and Orders.v: evolutions of the previous files, - with fine-grain Module architecture, many variants, use of - Equivalence and other relevant Type Classes notions. - - OrdersTac.v: a generic tactic for solving chains of (in)equalities - over variables. See {Nat,N,Z,P}OrderedType.v for concrete instances. - - GenericMinMax.v: any ordered type can be equipped with min and max. - We derived here all the generic properties of these functions. -- MSets library: an important evolution of the FSets library. - "MSets" stands for Modular (Finite) Sets, by contrast with a forthcoming - library of Class (Finite) Sets contributed by S. Lescuyer which will be - integrated with the next release of Coq. The main features of MSets are: - - The use of Equivalence, Proper and other Type Classes features - easing the handling of setoid equalities. - - The interfaces are now stated in iff-style. Old specifications - are now derived properties. - - The compare functions are now pure, and return a "comparison" value. - Thanks to the CompSpec inductive type, reasoning on them remains easy. - - Sets structures requiring invariants (i.e. sorted lists) are - built first as "Raw" sets (pure objects and separate proofs) and - attached with their proofs thanks to a generic functor. "Raw" sets - have now a proper interface and can be manipulated directly. - Note: No Maps yet in MSets. The FSets library is still provided - for compatibility, but will probably be considered as deprecated in the - next release of Coq. -- Numbers library: - - The abstract layer (NatInt, Natural/Abstract, Integer/Abstract) has - been simplified and enhance thanks to new features of the module - system such as Include (see above). It has been extended to Euclidean - division (three flavors for integers: Trunc, Floor and Math). - - The arbitrary-large efficient numbers (BigN, BigZ, BigQ) has also - been reworked. They benefit from the abstract layer improvements - (especially for div and mod). Note that some specifications have - slightly changed (compare, div, mod, shift{r,l}). Ring/Field should - work better (true recognition of constants). - -Tools - -- Option -R now supports binding Coq root read-only. -- New coqtop/coqc option -beautify to reformat .v files (usable - e.g. to globally update notations). -- New tool beautify-archive to beautify a full archive of developments. -- New coqtop/coqc option -compat X.Y to simulate the general behavior - of previous versions of Coq (provides e.g. support for 8.2 compatibility). - -Coqdoc - -- List have been revamped. List depth and scope is now determined by - an "offside" whitespace rule. -- Text may be italicized by placing it in _underscores_. -- The "--index <string>" flag changes the filename of the index. -- The "--toc-depth <int>" flag limits the depth of headers which are - included in the table of contents. -- The "--lib-name <string>" flag prints "<string> Foo" instead of - "Library Foo" where library titles are called for. The - "--no-lib-name" flag eliminates the extra title. -- New option "--parse-comments" to allow parsing of regular "(* *)" - comments. -- New option "--plain-comments" to disable interpretation inside comments. -- New option "--interpolate" to try and typeset identifiers in Coq escapings - using the available globalization information. -- New option "--external url root" to refer to external libraries. -- Links to section variables and notations now supported. - -Internal infrastructure - -- To avoid confusion with the repository of user's contributions, - the subdirectory "contrib" has been renamed into "plugins". - On platforms supporting ocaml native dynlink, code located there - is built as loadable plugins for coqtop. -- An experimental build mechanism via ocamlbuild is provided. - From the top of the archive, run ./configure as usual, and - then ./build. Feedback about this build mechanism is most welcome. - Compiling Coq on platforms such as Windows might be simpler - this way, but this remains to be tested. -- The Makefile system has been simplified and factorized with - the ocamlbuild system. In particular "make" takes advantage - of .mllib files for building .cma/.cmxa. The .vo files to - compile are now listed in several vo.itarget files. - -Changes from V8.1 to V8.2 -========================= - -Language - -- If a fixpoint is not written with an explicit { struct ... }, then - all arguments are tried successively (from left to right) until one is - found that satisfies the structural decreasing condition. -- New experimental typeclass system giving ad-hoc polymorphism and - overloading based on dependent records and implicit arguments. -- New syntax "let 'pat := b in c" for let-binding using irrefutable patterns. -- New syntax "forall {A}, T" for specifying maximally inserted implicit - arguments in terms. -- Sort of Record/Structure, Inductive and CoInductive defaults to Type - if omitted. -- (Co)Inductive types can be defined as records - (e.g. "CoInductive stream := { hd : nat; tl : stream }.") -- New syntax "Theorem id1:t1 ... with idn:tn" for proving mutually dependent - statements. -- Support for sort-polymorphism on constants denoting inductive types. -- Several evolutions of the module system (handling of module aliases, - functorial module types, an Include feature, etc). -- Prop now a subtype of Set (predicative and impredicative forms). -- Recursive inductive types in Prop with a single constructor of which - all arguments are in Prop is now considered to be a singleton - type. It consequently supports all eliminations to Prop, Set and Type. - As a consequence, Acc_rect has now a more direct proof [possible source - of easily fixed incompatibility in case of manual definition of a recursor - in a recursive singleton inductive type]. - -Vernacular commands - -- Added option Global to "Arguments Scope" for section surviving. -- Added option "Unset Elimination Schemes" to deactivate the automatic - generation of elimination schemes. -- Modification of the Scheme command so you can ask for the name to be - automatically computed (e.g. Scheme Induction for nat Sort Set). -- New command "Combined Scheme" to build combined mutual induction - principles from existing mutual induction principles. -- New command "Scheme Equality" to build a decidable (boolean) equality - for simple inductive datatypes and a decision property over this equality - (e.g. Scheme Equality for nat). -- Added option "Set Equality Scheme" to make automatic the declaration - of the boolean equality when possible. -- Source of universe inconsistencies now printed when option - "Set Printing Universes" is activated. -- New option "Set Printing Existential Instances" for making the display of - existential variable instances explicit. -- Support for option "[id1 ... idn]", and "-[id1 ... idn]", for the - "compute"/"cbv" reduction strategy, respectively meaning reduce only, or - everything but, the constants id1 ... idn. "lazy" alone or followed by - "[id1 ... idn]", and "-[id1 ... idn]" also supported, meaning apply - all of beta-iota-zeta-delta, possibly restricting delta. -- New command "Strategy" to control the expansion of constants during - conversion tests. It generalizes commands Opaque and Transparent by - introducing a range of levels. Lower levels are assigned to constants - that should be expanded first. -- New options Global and Local to Opaque and Transparent. -- New command "Print Assumptions" to display all variables, parameters - or axioms a theorem or definition relies on. -- "Add Rec LoadPath" now provides references to libraries using partially - qualified names (this holds also for coqtop/coqc option -R). -- SearchAbout supports negated search criteria, reference to logical objects - by their notation, and more generally search of subterms. -- "Declare ML Module" now allows to import .cmxs files when Coq is - compiled in native code with a version of OCaml that supports native - Dynlink (>= 3.11). -- Specific sort constraints on Record now taken into account. -- "Print LoadPath" supports a path argument to filter the display. - -Libraries - -- Several parts of the libraries are now in Type, in particular FSets, - SetoidList, ListSet, Sorting, Zmisc. This may induce a few - incompatibilities. In case of trouble while fixing existing development, - it may help to simply declare Set as an alias for Type (see file - SetIsType). -- New arithmetical library in theories/Numbers. It contains: - * an abstract modular development of natural and integer arithmetics - in Numbers/Natural/Abstract and Numbers/Integer/Abstract - * an implementation of efficient computational bounded and unbounded - integers that can be mapped to processor native arithmetics. - See Numbers/Cyclic/Int31 for 31-bit integers and Numbers/Natural/BigN - for unbounded natural numbers and Numbers/Integer/BigZ for unbounded - integers. - * some proofs that both older libraries Arith, ZArith and NArith and - newer BigN and BigZ implement the abstract modular development. - This allows in particular BigN and BigZ to already come with a - large database of basic lemmas and some generic tactics (ring), - This library has still an experimental status, as well as the - processor-acceleration mechanism, but both its abstract and its - concrete parts are already quite usable and could challenge the use - of nat, N and Z in actual developments. Moreover, an extension of - this framework to rational numbers is ongoing, and an efficient - Q structure is already provided (see Numbers/Rational/BigQ), but - this part is currently incomplete (no abstract layer and generic - lemmas). -- Many changes in FSets/FMaps. In practice, compatibility with earlier - version should be fairly good, but some adaptations may be required. - * Interfaces of unordered ("weak") and ordered sets have been factorized - thanks to new features of Coq modules (in particular Include), see - FSetInterface. Same for maps. Hints in these interfaces have been - reworked (they are now placed in a "set" database). - * To allow full subtyping between weak and ordered sets, a field - "eq_dec" has been added to OrderedType. The old version of OrderedType - is now called MiniOrderedType and functor MOT_to_OT allow to - convert to the new version. The interfaces and implementations - of sets now contain also such a "eq_dec" field. - * FSetDecide, contributed by Aaron Bohannon, contains a decision - procedure allowing to solve basic set-related goals (for instance, - is a point in a particular set ?). See FSetProperties for examples. - * Functors of properties have been improved, especially the ones about - maps, that now propose some induction principles. Some properties - of fold need less hypothesis. - * More uniformity in implementations of sets and maps: they all use - implicit arguments, and no longer export unnecessary scopes (see - bug #1347) - * Internal parts of the implementations based on AVL have evolved a - lot. The main files FSetAVL and FMapAVL are now much more - lightweight now. In particular, minor changes in some functions - has allowed to fully separate the proofs of operational - correctness from the proofs of well-balancing: well-balancing is - critical for efficiency, but not anymore for proving that these - trees implement our interfaces, hence we have moved these proofs - into appendix files FSetFullAVL and FMapFullAVL. Moreover, a few - functions like union and compare have been modified in order to be - structural yet efficient. The appendix files also contains - alternative versions of these few functions, much closer to the - initial Ocaml code and written via the Function framework. -- Library IntMap, subsumed by FSets/FMaps, has been removed from - Coq Standard Library and moved into a user contribution Cachan/IntMap -- Better computational behavior of some constants (eq_nat_dec and - le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare - transparent, ...) (exceptional source of incompatibilities). -- Boolean operators moved from module Bool to module Datatypes (may need - to rename qualified references in script and force notations || and && - to be at levels 50 and 40 respectively). -- The constructors xI and xO of type positive now have postfix notations - "~1" and "~0", allowing to write numbers in binary form easily, for instance - 6 is 1~1~0 and 4*p is p~0~0 (see BinPos.v). -- Improvements to NArith (Nminus, Nmin, Nmax), and to QArith (in particular - a better power function). -- Changes in ZArith: several additional lemmas (used in theories/Numbers), - especially in Zdiv, Znumtheory, Zpower. Moreover, many results in - Zdiv have been generalized: the divisor may simply be non-null - instead of strictly positive (see lemmas with name ending by - "_full"). An alternative file ZOdiv proposes a different behavior - (the one of Ocaml) when dividing by negative numbers. -- Changes in Arith: EqNat and Wf_nat now exported from Arith, some - constructions on nat that were outside Arith are now in (e.g. iter_nat). -- In SetoidList, eqlistA now expresses that two lists have similar elements - at the same position, while the predicate previously called eqlistA - is now equivlistA (this one only states that the lists contain the same - elements, nothing more). -- Changes in Reals: - * Most statement in "sigT" (including the - completeness axiom) are now in "sig" (in case of incompatibility, - use proj1_sig instead of projT1, sig instead of sigT, etc). - * More uniform naming scheme (identifiers in French moved to English, - consistent use of 0 -- zero -- instead of O -- letter O --, etc). - * Lemma on prod_f_SO is now on prod_f_R0. - * Useless hypothesis of ln_exists1 dropped. - * New Rlogic.v states a few logical properties about R axioms. - * RIneq.v extended and made cleaner. -- Slight restructuration of the Logic library regarding choice and classical - logic. Addition of files providing intuitionistic axiomatizations of - descriptions: Epsilon.v, Description.v and IndefiniteDescription.v. -- Definition of pred and minus made compatible with the structural - decreasing criterion for use in fixpoints. -- Files Relations/Rstar.v and Relations/Newman.v moved out to the user - contribution repository (contribution CoC_History). New lemmas about - transitive closure added and some bound variables renamed (exceptional - risk of incompatibilities). -- Syntax for binders in terms (e.g. for "exists") supports anonymous names. - -Notations, coercions, implicit arguments and type inference - -- More automation in the inference of the return clause of dependent - pattern-matching problems. -- Experimental allowance for omission of the clauses easily detectable as - impossible in pattern-matching problems. -- Improved inference of implicit arguments. -- New options "Set Maximal Implicit Insertion", "Set Reversible Pattern - Implicit", "Set Strongly Strict Implicit" and "Set Printing Implicit - Defensive" for controlling inference and use of implicit arguments. -- New modifier in "Implicit Arguments" to force an implicit argument to - be maximally inserted. -- New modifier of "Implicit Arguments" to enrich the set of implicit arguments. -- New options Global and Local to "Implicit Arguments" for section - surviving or non export outside module. -- Level "constr" moved from 9 to 8. -- Structure/Record now printed as Record (unless option Printing All is set). -- Support for parametric notations defining constants. -- Insertion of coercions below product types refrains to unfold - constants (possible source of incompatibility). -- New support for fix/cofix in notations. - -Tactic Language - -- Second-order pattern-matching now working in Ltac "match" clauses - (syntax for second-order unification variable is "@?X"). -- Support for matching on let bindings in match context using syntax - "H := body" or "H := body : type". -- Ltac accepts integer arguments (syntax is "ltac:nnn" for nnn an integer). -- The general sequence tactical "expr_0 ; [ expr_1 | ... | expr_n ]" - is extended so that at most one expr_i may have the form "expr .." - or just "..". Also, n can be different from the number of subgoals - generated by expr_0. In this case, the value of expr (or idtac in - case of just "..") is applied to the intermediate subgoals to make - the number of tactics equal to the number of subgoals. -- A name used as the name of the parameter of a lemma (like f in - "apply f_equal with (f:=t)") is now interpreted as a ltac variable - if such a variable exists (this is a possible source of - incompatibility and it can be fixed by renaming the variables of a - ltac function into names that do not clash with the lemmas - parameter names used in the tactic). -- New syntax "Ltac tac ::= ..." to rebind a tactic to a new expression. -- "let rec ... in ... " now supported for expressions without explicit - parameters; interpretation is lazy to the contrary of "let ... in ..."; - hence, the "rec" keyword can be used to turn the argument of a - "let ... in ..." into a lazy one. -- Patterns for hypotheses types in "match goal" are now interpreted in - type_scope. -- A bound variable whose name is not used elsewhere now serves as - metavariable in "match" and it gets instantiated by an identifier - (allow e.g. to extract the name of a statement like "exists x, P x"). -- New printing of Ltac call trace for better debugging. - -Tactics - -- New tactics "apply -> term", "apply <- term", "apply -> term in - ident", "apply <- term in ident" for applying equivalences (iff). -- Slight improvement of the hnf and simpl tactics when applied on - expressions with explicit occurrences of match or fix. -- New tactics "eapply in", "erewrite", "erewrite in". -- New tactics "ediscriminate", "einjection", "esimplify_eq". -- Tactics "discriminate", "injection", "simplify_eq" now support any - term as argument. Clause "with" is also supported. -- Unfoldable references can be given by notation's string rather than by name - in unfold. -- The "with" arguments are now typed using informations from the current goal: - allows support for coercions and more inference of implicit arguments. -- Application of "f_equal"-style lemmas works better. -- Tactics elim, case, destruct and induction now support variants eelim, - ecase, edestruct and einduction. -- Tactics destruct and induction now support the "with" option and the - "in" clause option. If the option "in" is used, an equality is added - to remember the term to which the induction or case analysis applied - (possible source of parsing incompatibilities when destruct or induction is - part of a let-in expression in Ltac; extra parentheses are then required). -- New support for "as" clause in tactics "apply in" and "eapply in". -- Some new intro patterns: - * intro pattern "?A" genererates a fresh name based on A. - Caveat about a slight loss of compatibility: - Some intro patterns don't need space between them. In particular - intros ?a?b used to be legal and equivalent to intros ? a ? b. Now it - is still legal but equivalent to intros ?a ?b. - * intro pattern "(A & ... & Y & Z)" synonym to "(A,....,(Y,Z)))))" - for right-associative constructs like /\ or exists. -- Several syntax extensions concerning "rewrite": - * "rewrite A,B,C" can be used to rewrite A, then B, then C. These rewrites - occur only on the first subgoal: in particular, side-conditions of the - "rewrite A" are not concerned by the "rewrite B,C". - * "rewrite A by tac" allows to apply tac on all side-conditions generated by - the "rewrite A". - * "rewrite A at n" allows to select occurrences to rewrite: rewrite only - happen at the n-th exact occurrence of the first successful matching of - A in the goal. - * "rewrite 3 A" or "rewrite 3!A" is equivalent to "rewrite A,A,A". - * "rewrite !A" means rewriting A as long as possible (and at least once). - * "rewrite 3?A" means rewriting A at most three times. - * "rewrite ?A" means rewriting A as long as possible (possibly never). - * many of the above extensions can be combined with each other. -- Introduction patterns better respect the structure of context in presence of - missing or extra names in nested disjunction-conjunction patterns [possible - source of rare incompatibilities]. -- New syntax "rename a into b, c into d" for "rename a into b; rename c into d" -- New tactics "dependent induction/destruction H [ generalizing id_1 .. id_n ]" - to do induction-inversion on instantiated inductive families à la BasicElim. -- Tactics "apply" and "apply in" now able to reason modulo unfolding of - constants (possible source of incompatibility in situations where apply - may fail, e.g. as argument of a try or a repeat and in a ltac function); - versions that do not unfold are renamed into "simple apply" and - "simple apply in" (usable for compatibility or for automation). -- Tactics "apply" and "apply in" now able to traverse conjunctions and to - select the first matching lemma among the components of the conjunction; - tactic "apply" also able to apply lemmas of conclusion an empty type. -- Tactic "apply" now supports application of several lemmas in a row. -- Tactics "set" and "pose" can set functions using notation "(f x1..xn := c)". -- New tactic "instantiate" (without argument). -- Tactic firstorder "with" and "using" options have their meaning swapped for - consistency with auto/eauto (source of incompatibility). -- Tactic "generalize" now supports "at" options to specify occurrences - and "as" options to name the quantified hypotheses. -- New tactic "specialize H with a" or "specialize (H a)" allows to transform - in-place a universally-quantified hypothesis (H : forall x, T x) into its - instantiated form (H : T a). Nota: "specialize" was in fact there in earlier - versions of Coq, but was undocumented, and had a slightly different behavior. -- New tactic "contradict H" can be used to solve any kind of goal as long as - the user can provide afterwards a proof of the negation of the hypothesis H. - If H is already a negation, say ~T, then a proof of T is asked. - If the current goal is a negation, say ~U, then U is saved in H afterwards, - hence this new tactic "contradict" extends earlier tactic "swap", which is - now obsolete. -- Tactics f_equal is now done in ML instead of Ltac: it now works on any - equality of functions, regardless of the arity of the function. -- New options "before id", "at top", "at bottom" for tactics "move"/"intro". -- Some more debug of reflexive omega (romega), and internal clarifications. - Moreover, romega now has a variant "romega with *" that can be also used - on non-Z goals (nat, N, positive) via a call to a translation tactic named - zify (its purpose is to Z-ify your goal...). This zify may also be used - independently of romega. -- Tactic "remember" now supports an "in" clause to remember only selected - occurrences of a term. -- Tactic "pose proof" supports name overwriting in case of specialization of an - hypothesis. -- Semi-decision tactic "jp" for first-order intuitionistic logic moved to user - contributions (subsumed by "firstorder"). - -Program - -- Moved useful tactics in theories/Program and documented them. -- Add Program.Basics which contains standard definitions for functional - programming (id, apply, flip...) -- More robust obligation handling, dependent pattern-matching and - well-founded definitions. -- New syntax " dest term as pat in term " for destructing objects using - an irrefutable pattern while keeping equalities (use this instead of - "let" in Programs). -- Program CoFixpoint is accepted, Program Fixpoint uses the new way to infer - which argument decreases structurally. -- Program Lemma, Axiom etc... now permit to have obligations in the statement - iff they can be automatically solved by the default tactic. -- Renamed "Obligations Tactic" command to "Obligation Tactic". -- New command "Preterm [ of id ]" to see the actual term fed to Coq for - debugging purposes. -- New option "Transparent Obligations" to control the declaration of - obligations as transparent or opaque. All obligations are now transparent - by default, otherwise the system declares them opaque if possible. -- Changed the notations "left" and "right" to "in_left" and "in_right" to hide - the proofs in standard disjunctions, to avoid breaking existing scripts when - importing Program. Also, put them in program_scope. - -Type Classes - -- New "Class", "Instance" and "Program Instance" commands to define - classes and instances documented in the reference manual. -- New binding construct " [ Class_1 param_1 .. param_n, Class_2 ... ] " - for binding type classes, usable everywhere. -- New command " Print Classes " and " Print Instances some_class " to - print tables for typeclasses. -- New default eauto hint database "typeclass_instances" used by the default - typeclass instance search tactic. -- New theories directory "theories/Classes" for standard typeclasses - declarations. Module Classes.RelationClasses is a typeclass port of - Relation_Definitions plus a generic development of algebra on - n-ary heterogeneous predicates. - -Setoid rewriting - -- Complete (and still experimental) rewrite of the tactic - based on typeclasses. The old interface and semantics are - almost entirely respected, except: - - - Import Setoid is now mandatory to be able to call setoid_replace - and declare morphisms. - - - "-->", "++>" and "==>" are now right associative notations - declared at level 55 in scope signature_scope. - Their introduction may break existing scripts that defined - them as notations with different levels. - - - One needs to use [Typeclasses unfold [cst]] if [cst] is used - as an abbreviation hiding products in types of morphisms, - e.g. if ones redefines [relation] and declares morphisms - whose type mentions [relation]. - - - The [setoid_rewrite]'s semantics change when rewriting with - a lemma: it can rewrite two different instantiations of the lemma - at once. Use [setoid_rewrite H at 1] for (almost) the usual semantics. - [setoid_rewrite] will also try to rewrite under binders now, and can - succeed on different terms than before. In particular, it will unify under - let-bound variables. When called through [rewrite], the semantics are - unchanged though. - - - [Add Morphism term : id] has different semantics when used with - parametric morphism: it will try to find a relation on the parameters - too. The behavior has also changed with respect to default relations: - the most recently declared Setoid/Relation will be used, the documentation - explains how to customize this behavior. - - - Parametric Relation and Morphism are declared differently, using the - new [Add Parametric] commands, documented in the manual. - - - Setoid_Theory is now an alias to Equivalence, scripts building objects - of type Setoid_Theory need to unfold (or "red") the definitions - of Reflexive, Symmetric and Transitive in order to get the same goals - as before. Scripts which introduced variables explicitely will not break. - - - The order of subgoals when doing [setoid_rewrite] with side-conditions - is always the same: first the new goal, then the conditions. - -- New standard library modules Classes.Morphisms declares - standard morphisms on refl/sym/trans relations. - Classes.Morphisms_Prop declares morphisms on propositional - connectives and Classes.Morphisms_Relations on generalized predicate - connectives. Classes.Equivalence declares notations and tactics - related to equivalences and Classes.SetoidTactics defines the - setoid_replace tactics and some support for the "Add *" interface, - notably the tactic applied automatically before each "Add Morphism" - proof. - -- User-defined subrelations are supported, as well as higher-order morphisms - and rewriting under binders. The tactic is also extensible entirely in Ltac. - The documentation has been updated to cover these features. - -- [setoid_rewrite] and [rewrite] now support the [at] modifier to select - occurrences to rewrite, and both use the [setoid_rewrite] code, even when - rewriting with leibniz equality if occurrences are specified. - -Extraction - -- Improved behavior of the Caml extraction of modules: name clashes should - not happen anymore. -- The command Extract Inductive has now a syntax for infix notations. This - allows in particular to map Coq lists and pairs onto Caml ones: - Extract Inductive list => list [ "[]" "(::)" ]. - Extract Inductive prod => "(*)" [ "(,)" ]. -- In pattern matchings, a default pattern "| _ -> ..." is now used whenever - possible if several branches are identical. For instance, functions - corresponding to decidability of equalities are now linear instead of - quadratic. -- A new instruction Extraction Blacklist id1 .. idn allows to prevent filename - conflits with existing code, for instance when extracting module List - to Ocaml. - -CoqIDE - -- CoqIDE font defaults to monospace so as indentation to be meaningful. -- CoqIDE supports nested goals and any other kind of declaration in the middle - of a proof. -- Undoing non-tactic commands in CoqIDE works faster. -- New CoqIDE menu for activating display of various implicit informations. -- Added the possibility to choose the location of tabs in coqide: - (in Edit->Preferences->Misc) -- New Open and Save As dialogs in CoqIDE which filter *.v files. - -Tools - -- New stand-alone .vo files verifier "coqchk". -- Extended -I coqtop/coqc option to specify a logical dir: "-I dir -as coqdir". -- New coqtop/coqc option -exclude-dir to exclude subdirs for option -R. -- The binary "parser" has been renamed to "coq-parser". -- Improved coqdoc and dump of globalization information to give more - meta-information on identifiers. All categories of Coq definitions are - supported, which makes typesetting trivial in the generated documentation. - Support for hyperlinking and indexing developments in the tex output - has been implemented as well. - -Miscellaneous - -- Coq installation provides enough files so that Ocaml's extensions need not - the Coq sources to be compiled (this assumes O'Caml 3.10 and Camlp5). -- New commands "Set Whelp Server" and "Set Whelp Getter" to customize the - Whelp search tool. -- Syntax of "Test Printing Let ref" and "Test Printing If ref" changed into - "Test Printing Let for ref" and "Test Printing If for ref". -- An overhauled build system (new Makefiles); see dev/doc/build-system.txt. -- Add -browser option to configure script. -- Build a shared library for the C part of Coq, and use it by default on - non-(Windows or MacOS) systems. Bytecode executables are now pure. The - behaviour is configurable with -coqrunbyteflags, -coqtoolsbyteflags and - -custom configure options. -- Complexity tests can be skipped by setting the environment variable - COQTEST_SKIPCOMPLEXITY. - -Changes from V8.1gamma to V8.1 -============================== - -Bug fixes - -- Many bugs have been fixed (cf coq-bugs web page) - -Tactics - -- New tactics ring, ring_simplify and new tactic field now able to manage - power to a positive integer constant. Tactic ring on Z and R, and - field on R manage power (may lead to incompatibilities with V8.1gamma). -- Tactic field_simplify now applicable in hypotheses. -- New field_simplify_eq for simplifying field equations into ring equations. -- Tactics ring, ring_simplify, field, field_simplify and field_simplify_eq - all able to apply user-given equations to rewrite monoms on the fly - (see documentation). - -Libraries - -- New file ConstructiveEpsilon.v defining an epsilon operator and - proving the axiom of choice constructively for a countable domain - and a decidable predicate. - -Changes from V8.1beta to V8.1gamma -================================== - -Syntax - -- changed parsing precedence of let/in and fun constructions of Ltac: - let x := t in e1; e2 is now parsed as let x := t in (e1;e2). - -Language and commands - -- Added sort-polymorphism for definitions in Type (but finally abandonned). -- Support for implicit arguments in the types of parameters in - (co-)fixpoints and (co-)inductive declarations. -- Improved type inference: use as much of possible general information. - before applying irreversible unification heuristics (allow e.g. to - infer the predicate in "(exist _ 0 (refl_equal 0) : {n:nat | n=0 })"). -- Support for Miller-Pfenning's patterns unification in type synthesis - (e.g. can infer P such that P x y = phi(x,y)). -- Support for "where" clause in cofixpoint definitions. -- New option "Set Printing Universes" for making Type levels explicit. - -Tactics - -- Improved implementation of the ring and field tactics. For compatibility - reasons, the previous tactics are renamed as legacy ring and legacy field, - but should be considered as deprecated. -- New declarative mathematical proof language. -- Support for argument lists of arbitrary length in Tactic Notation. -- [rewrite ... in H] now fails if [H] is used either in an hypothesis - or in the goal. -- The semantics of [rewrite ... in *] has been slightly modified (see doc). -- Support for "as" clause in tactic injection. -- New forward-reasoning tactic "apply in". -- Ltac fresh operator now builds names from a concatenation of its arguments. -- New ltac tactic "remember" to abstract over a subterm and keep an equality -- Support for Miller-Pfenning's patterns unification in apply/rewrite/... - (may lead to few incompatibilities - generally now useless tactic calls). - -Bug fixes - -- Fix for notations involving basic "match" expressions. -- Numerous other bugs solved (a few fixes may lead to incompatibilities). - - -Changes from V8.0 to V8.1beta -============================= - -Logic - -- Added sort-polymorphism on inductive families -- Allowance for recursively non uniform parameters in inductive types - -Syntax - -- No more support for version 7 syntax and for translation to version 8 syntax. -- In fixpoints, the { struct ... } annotation is not mandatory any more when - only one of the arguments has an inductive type -- Added disjunctive patterns in match-with patterns -- Support for primitive interpretation of string literals -- Extended support for Unicode ranges - -Vernacular commands - -- Added "Print Ltac qualid" to print a user defined tactic. -- Added "Print Rewrite HintDb" to print the content of a DB used by - autorewrite. -- Added "Print Canonical Projections". -- Added "Example" as synonym of "Definition". -- Added "Proposition" and "Corollary" as extra synonyms of "Lemma". -- New command "Whelp" to send requests to the Helm database of proofs - formalized in the Calculus of Inductive Constructions. -- Command "functional induction" has been re-implemented from the new - "Function" command. - -Ltac and tactic syntactic extensions - -- New primitive "external" for communication with tool external to Coq -- New semantics for "match t with": if a clause returns a - tactic, it is now applied to the current goal. If it fails, the next - clause or next matching subterm is tried (i.e. it behaves as "match - goal with" does). The keyword "lazymatch" can be used to delay the - evaluation of tactics occurring in matching clauses. -- Hint base names can be parametric in auto and trivial. -- Occurrence values can be parametric in unfold, pattern, etc. -- Added entry constr_may_eval for tactic extensions. -- Low-priority term printer made available in ML-written tactic extensions. -- "Tactic Notation" extended to allow notations of tacticals. - -Tactics - -- New implementation and generalization of [setoid_]* (setoid_rewrite, - setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite). - New syntax for declaring relations and morphisms (old syntax still working - with minor modifications, but deprecated). -- New implementation (still experimental) of the ring tactic with a built-in - notion of coefficients and a better usage of setoids. -- New conversion tactic "vm_compute": evaluates the goal (or an hypothesis) - with a call-by-value strategy, using the compiled version of terms. -- When rewriting H where H is not directly a Coq equality, search first H for - a registered setoid equality before starting to reduce in H. This is unlikely - to break any script. Should this happen nonetheless, one can insert manually - some "unfold ... in H" before rewriting. -- Fixed various bugs about (setoid) rewrite ... in ... (in particular bug #5941) -- "rewrite ... in" now accepts a clause as place where to rewrite instead of - juste a simple hypothesis name. For instance: - rewrite H in H1,H2 |- * means rewrite H in H1; rewrite H in H2; rewrite H - rewrite H in * |- will do try rewrite H in Hi for all hypothesis Hi <> H. -- Added "dependent rewrite term" and "dependent rewrite term in hyp". -- Added "autorewrite with ... in hyp [using ...]". -- Tactic "replace" now accepts a "by" tactic clause. -- Added "clear - id" to clear all hypotheses except the ones depending in id. -- The argument of Declare Left Step and Declare Right Step is now a term - (it used to be a reference). -- Omega now handles arbitrary precision integers. -- Several bug fixes in Reflexive Omega (romega). -- Idtac can now be left implicit in a [...|...] construct: for instance, - [ foo | | bar ] stands for [ foo | idtac | bar ]. -- Fixed a "fold" bug (non critical but possible source of incompatibilities). -- Added classical_left and classical_right which transforms |- A \/ B into - ~B |- A and ~A |- B respectively. -- Added command "Declare Implicit Tactic" to set up a default tactic to be - used to solve unresolved subterms of term arguments of tactics. -- Better support for coercions to Sortclass in tactics expecting type - arguments. -- Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses. -- New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns. -- New introduction pattern "?" for letting Coq choose a name. -- Introduction patterns now support side hypotheses (e.g. intros [|] on - "(nat -> nat) -> nat" works). -- New introduction patterns "->" and "<-" for immediate rewriting of - introduced hypotheses. -- Introduction patterns coming after non trivial introduction patterns now - force full introduction of the first pattern (e.g. "intros [[|] p]" on - "nat->nat->nat" now behaves like "intros [[|?] p]") -- Added "eassumption". -- Added option 'using lemmas' to auto, trivial and eauto. -- Tactic "congruence" is now complete for its intended scope (ground - equalities and inequalities with constructors). Furthermore, it - tries to equates goal and hypotheses. -- New tactic "rtauto" solves pure propositional logic and gives a - reflective version of the available proof. -- Numbering of "pattern", "unfold", "simpl", ... occurrences in "match - with" made consistent with the printing of the return clause after - the term to match in the "match-with" construct (use "Set Printing All" - to see hidden occurrences). -- Generalization of induction "induction x1...xn using scheme" where - scheme is an induction principle with complex predicates (like the - ones generated by function induction). -- Some small Ltac tactics has been added to the standard library - (file Tactics.v): - * f_equal : instead of using the different f_equalX lemmas - * case_eq : a "case" without loss of information. An equality - stating the current situation is generated in every sub-cases. - * swap : for a negated goal ~B and a negated hypothesis H:~A, - swap H asks you to prove A from hypothesis B - * revert : revert H is generalize H; clear H. - -Extraction - -- All type parts should now disappear instead of sometimes producing _ - (for instance in Map.empty). -- Haskell extraction: types of functions are now printed, better - unsafeCoerce mechanism, both for hugs and ghc. -- Scheme extraction improved, see http://www.pps.jussieu.fr/~letouzey/scheme. -- Many bug fixes. - -Modules - -- Added "Locate Module qualid" to get the full path of a module. -- Module/Declare Module syntax made more uniform. -- Added syntactic sugar "Declare Module Export/Import" and - "Module Export/Import". -- Added syntactic sugar "Module M(Export/Import X Y: T)" and - "Module Type M(Export/Import X Y: T)" - (only for interactive definitions) -- Construct "with" generalized to module paths: - T with (Definition|Module) M1.M2....Mn.l := l'. - -Notations - -- Option "format" aware of recursive notations. -- Added insertion of spaces by default in recursive notations w/o separators. -- No more automatic printing box in case of user-provided printing "format". -- New notation "exists! x:A, P" for unique existence. -- Notations for specific numerals now compatible with generic notations of - numerals (e.g. "1" can be used to denote the unit of a group without - hiding 1%nat) - -Libraries - -- New library on String and Ascii characters (contributed by L. Thery). -- New library FSets+FMaps of finite sets and maps. -- New library QArith on rational numbers. -- Small extension of Zmin.V, new Zmax.v, new Zminmax.v. -- Reworking and extension of the files on classical logic and - description principles (possible incompatibilities) -- Few other improvements in ZArith potentially exceptionally breaking the - compatibility (useless hypothesys of Zgt_square_simpl and - Zlt_square_simpl removed; fixed names mentioning letter O instead of - digit 0; weaken premises in Z_lt_induction). -- Restructuration of Eqdep_dec.v and Eqdep.v: more lemmas in Type. -- Znumtheory now contains a gcd function that can compute within Coq. -- More lemmas stated on Type in Wf.v, removal of redundant Acc_iter and - Acc_iter2. -- Change of the internal names of lemmas in OmegaLemmas. -- Acc in Wf.v and clos_refl_trans in Relation_Operators.v now rely on - the allowance for recursively non uniform parameters (possible - source of incompatibilities: explicit pattern-matching on these - types may require to remove the occurrence associated to their - recursively non uniform parameter). -- Coq.List.In_dec has been set transparent (this may exceptionally break - proof scripts, set it locally opaque for compatibility). -- More on permutations of lists in List.v and Permutation.v. -- List.v has been much expanded. -- New file SetoidList.v now contains results about lists seen with - respect to a setoid equality. -- Library NArith has been expanded, mostly with results coming from - Intmap (for instance a bitwise xor), plus also a bridge between N and - Bitvector. -- Intmap has been reorganized. In particular its address type "addr" is - now N. User contributions known to use Intmap have been adapted - accordingly. If you're using this library please contact us. - A wrapper FMapIntMap now presents Intmap as a particular implementation - of FMaps. New developments are strongly encouraged to use either this - wrapper or any other implementations of FMap instead of using directly - this obsolete Intmap. - -Tools - -- New semantics for coqtop options ("-batch" expects option "-top dir" - for loading vernac file that contains definitions). -- Tool coq_makefile now removes custom targets that are file names in - "make clean" -- New environment variable COQREMOTEBROWSER to set the command invoked - to start the remote browser both in Coq and coqide. Standard syntax: - "%s" is the placeholder for the URL. - - -Changes from V8.0beta to V8.0 -============================= - -Vernacular commands - -- New option "Set Printing All" to deactivate all high-level forms of - printing (implicit arguments, coercions, destructing let, - if-then-else, notations, projections) -- "Functional Scheme" and "Functional Induction" extended to polymorphic - types and dependent types -- Notation now allows recursive patterns, hence recovering parts of the - fonctionalities of pre-V8 Grammar/Syntax commands -- Command "Print." discontinued. -- Redundant syntax "Implicit Arguments On/Off" discontinued - -New syntax - -- Semantics change of the if-then-else construction in new syntax: - "if c then t1 else t2" now stands for - "match c with c1 _ ... _ => t1 | c2 _ ... _ => t2 end" - with no dependency of t1 and t2 in the arguments of the constructors; - this may cause incompatibilities for files translated using coq 8.0beta - -Interpretation scopes - -- Delimiting key %bool for bool_scope added -- Import no more needed to activate argument scopes from a module - -Tactics and the tactic Language - -- Semantics of "assert" is now consistent with the reference manual -- New tactics stepl and stepr for chaining transitivity steps -- Tactic "replace ... with ... in" added -- Intro patterns now supported in Ltac (parsed with prefix "ipattern:") - -Executables and tools - -- Added option -top to change the name of the toplevel module "Top" -- Coqdoc updated to new syntax and now part of Coq sources -- XML exportation tool now exports the structure of vernacular files - (cf chapter 13 in the reference manual) - -User contributions - -- User contributions have been updated to the new syntax - -Bug fixes - -- Many bugs have been fixed (cf coq-bugs web page) - -Changes from V8.0beta old syntax to V8.0beta -============================================ - -New concrete syntax - -- A completely new syntax for terms -- A more uniform syntax for tactics and the tactic language -- A few syntactic changes for vernacular commands -- A smart automatic translator translating V8.0 files in old syntax to - files valid for V8.0 - -Syntax extensions - -- "Grammar" for terms disappears -- "Grammar" for tactics becomes "Tactic Notation" -- "Syntax" disappears -- Introduction of a notion of interpretation scope allowing to use the - same notations in various contexts without using specific delimiters - (e.g the same expression "4<=3+x" is interpreted either in "nat", - "positive", "N" (previously "entier"), "Z", "R", depending on which - interpretation scope is currently open) [see documentation for details] -- Notation now mandatorily requires a precedence and associativity - (default was to set precedence to 1 and associativity to none) - -Revision of the standard library - -- Many lemmas and definitions names have been made more uniform mostly - in Arith, NArith, ZArith and Reals (e.g : "times" -> "Pmult", - "times_sym" -> "Pmult_comm", "Zle_Zmult_pos_right" -> - "Zmult_le_compat_r", "SUPERIEUR" -> "Gt", "ZERO" -> "Z0") -- Order and names of arguments of basic lemmas on nat, Z, positive and R - have been made uniform. -- Notions of Coq initial state are declared with (strict) implicit arguments -- eq merged with eqT: old eq disappear, new eq (written =) is old eqT - and new eqT is syntactic sugar for new eq (notation == is an alias - for = and is written as it, exceptional source of incompatibilities) -- Similarly, ex, ex2, all, identity are merged with exT, exT2, allT, identityT -- Arithmetical notations for nat, positive, N, Z, R, without needing - any backquote or double-backquotes delimiters. -- In Lists: new concrete notations; argument of nil is now implicit -- All changes in the library are taken in charge by the translator - -Semantical changes during translation - -- Recursive keyword set by default (and no longer needed) in Tactic Definition -- Set Implicit Arguments is strict by default in new syntax -- reductions in hypotheses of the form "... in H" now apply to the type - also if H is a local definition -- etc - -Gallina - -- New syntax of the form "Inductive bool : Set := true, false : bool." for - enumerated types -- Experimental syntax of the form p.(fst) for record projections - (activable with option "Set Printing Projections" which is - recognized by the translator) - -Known problems of the automatic translation - -- iso-latin-1 characters are no longer supported: move your files to - 7-bits ASCII or unicode before translation (swith to unicode is - automatically done if a file is loaded and saved again by coqide) -- Renaming in ZArith: incompatibilities in Coq user contribs due to - merging names INZ, from Reals, and inject_nat. -- Renaming and new lemmas in ZArith: may clash with names used by users -- Restructuration of ZArith: replace requirement of specific modules - in ZArith by "Require Import ZArith_base" or "Require Import ZArith" -- Some implicit arguments must be made explicit before translation: typically - for "length nil", the implicit argument of length must be made explicit -- Grammar rules, Infix notations and V7.4 Notations must be updated wrt the - new scheme for syntactic extensions (see translator documentation) -- Unsafe for annotation Cases when constructors coercions are used or when - annotations are eta-reduced predicates - - -Changes from V7.4 to V8.0beta old syntax -======================================== - -Logic - -- Set now predicative by default -- New option -impredicative-set to set Set impredicative -- The standard library doesn't need impredicativity of Set and is - compatible with the classical axioms which contradict Set impredicativity - -Syntax for arithmetic - -- Notation "=" and "<>" in Z and R are no longer implicitly in Z or R - (with possible introduction of a coercion), use <Z>...=... or - <Z>...<>... instead -- Locate applied to a simple string (e.g. "+") searches for all - notations containing this string - -Vernacular commands - -- "Declare ML Module" now allows to import .cma files. This avoids to use a - bunch of "Declare ML Module" statements when using several ML files. -- "Set Printing Width n" added, allows to change the size of width printing. -- "Implicit Variables Type x,y:t" (new syntax: "Implicit Types x y:t") - assigns default types for binding variables. -- Declarations of Hints and Notation now accept a "Local" flag not to - be exported outside the current file even if not in section -- "Print Scopes" prints all notations -- New command "About name" for light printing of type, implicit arguments, etc. -- New command "Admitted" to declare incompletely proven statement as axioms -- New keyword "Conjecture" to declare an axiom intended to be provable -- SearchAbout can now search for lemmas referring to more than one constant - and on substrings of the name of the lemma -- "Print Implicit" displays the implicit arguments of a constant -- Locate now searches for all names having a given suffix -- New command "Functional Scheme" for building an induction principle - from a function defined by case analysis and fix. - -Commands - -- new coqtop/coqc option -dont-load-proofs not to load opaque proofs in memory - -Implicit arguments - -- Inductive in sections declared with implicits now "discharged" with - implicits (like constants and variables) -- Implicit Arguments flags are now synchronous with reset -- New switch "Unset/Set Printing Implicits" (new syntax: "Unset/Set Printing - Implicit") to globally control printing of implicits - -Grammar extensions - -- Many newly supported UTF-8 encoded unicode blocks - - Greek letters (0380-03FF), Hebrew letters (U05D0-05EF), letter-like - symbols (2100-214F, that includes double N,Z,Q,R), prime - signs (from 2080-2089) and characters from many written languages - are valid in identifiers - - mathematical operators (2200-22FF), supplemental mathematical - operators (2A00-2AFF), miscellaneous technical (2300-23FF that - includes sqrt symbol), miscellaneous symbols (2600-26FF), arrows - (2190-21FF and 2900-297F), invisible mathematical operators (from - 2080-2089), ... are valid symbols - -Library - -- New file about the factorial function in Arith -- An additional elimination Acc_iter for Acc, simplier than Acc_rect. - This new elimination principle is used for definition well_founded_induction. -- New library NArith on binary natural numbers -- R is now of type Set -- Restructuration in ZArith library - - "true_sub" used in Zplus now a definition, not a local one (source - of incompatibilities in proof referring to true_sub, may need extra Unfold) - - Some lemmas about minus moved from fast_integer to Arith/Minus.v - (le_minus, lt_mult_left) (theoretical source of incompatibilities) - - Several lemmas moved from auxiliary.v and zarith_aux.v to - fast_integer.v (theoretical source of incompatibilities) - - Variables names of iff_trans changed (source of incompatibilities) - - ZArith lemmas named OMEGA something or fast_ something, and lemma new_var - are now out of ZArith (except OMEGA2) - - Redundant ZArith lemmas have been renamed: for the following pairs, - use the second name (Zle_Zmult_right2, Zle_mult_simpl), (OMEGA2, - Zle_0_plus), (Zplus_assoc_l, Zplus_assoc), (Zmult_one, Zmult_1_n), - (Zmult_assoc_l, Zmult_assoc), (Zmult_minus_distr, Zmult_Zminus_distr_l) - (add_un_double_moins_un_xO, is_double_moins_un), - (Rlt_monotony_rev,Rlt_monotony_contra) (source of incompatibilities) -- Few minor changes (no more implicit arguments in - Zmult_Zminus_distr_l and Zmult_Zminus_distr_r, lemmas moved from - Zcomplements to other files) (rare source of incompatibilities) -- New lemmas provided by users added - -Tactic language - -- Fail tactic now accepts a failure message -- Idtac tactic now accepts a message -- New primitive tactic "FreshId" (new syntax: "fresh") to generate new names -- Debugger prints levels of calls - -Tactics - -- Replace can now replace proofs also -- Fail levels are now decremented at "Match Context" blocks only and - if the right-hand-side of "Match term With" are tactics, these - tactics are never evaluated immediately and do not induce - backtracking (in contrast with "Match Context") -- Quantified names now avoid global names of the current module (like - Intro names did) [source of rare incompatibilities: 2 changes in the set of - user contribs] -- NewDestruct/NewInduction accepts intro patterns as introduction names -- NewDestruct/NewInduction now work for non-inductive type using option "using" -- A NewInduction naming bug for inductive types with functional - arguments (e.g. the accessibility predicate) has been fixed (source - of incompatibilities) -- Symmetry now applies to hypotheses too -- Inversion now accept option "as [ ... ]" to name the hypotheses -- Contradiction now looks also for contradictory hypotheses stating ~A and A - (source of incompatibility) -- "Contradiction c" try to find an hypothesis in context which - contradicts the type of c -- Ring applies to new library NArith (require file NArithRing) -- Field now works on types in Set -- Auto with reals now try to replace le by ge (Rge_le is no longer an - immediate hint), resulting in shorter proofs -- Instantiate now works in hyps (syntax : Instantiate in ...) -- Some new tactics : EConstructor, ELeft, Eright, ESplit, EExists -- New tactic "functional induction" to perform case analysis and - induction following the definition of a function. -- Clear now fails when trying to remove a local definition used by - a constant appearing in the current goal - -Extraction (See details in plugins/extraction/CHANGES) - -- The old commands: (Recursive) Extraction Module M. - are now: (Recursive) Extraction Library M. - To use these commands, M should come from a library M.v -- The other syntax Extraction & Recursive Extraction now accept - module names as arguments. - -Bugs - -- see coq-bugs server for the complete list of fixed bugs - -Miscellaneous - -- Implicit parameters of inductive types definition now taken into - account for infering other implicit arguments - -Incompatibilities - -- Persistence of true_sub (4 incompatibilities in Coq user contributions) -- Variable names of some constants changed for a better uniformity (2 changes - in Coq user contributions) -- Naming of quantified names in goal now avoid global names (2 occurrences) -- NewInduction naming for inductive types with functional arguments - (no incompatibility in Coq user contributions) -- Contradiction now solve more goals (source of 2 incompatibilities) -- Merge of eq and eqT may exceptionally result in subgoals now - solved automatically -- Redundant pairs of ZArith lemmas may have different names: it may - cause "Apply/Rewrite with" to fail if using the first name of a pair - of redundant lemmas (this is solved by renaming the variables bound by - "with"; 3 incompatibilities in Coq user contribs) -- ML programs referring to constants from fast_integer.v must use - "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead - -Changes from V7.3.1 to V7.4 -=========================== - -Symbolic notations - -- Introduction of a notion of scope gathering notations in a consistent set; - a notation sets has been developed for nat, Z and R (undocumented) -- New command "Notation" for declaring notations simultaneously for - parsing and printing (see chap 10 of the reference manual) -- Declarations with only implicit arguments now handled (e.g. the - argument of nil can be set implicit; use !nil to refer to nil - without arguments) -- "Print Scope sc" and "Locate ntn" allows to know to what expression a - notation is bound -- New defensive strategy for printing or not implicit arguments to ensure - re-type-checkability of the printed term -- In Grammar command, the only predefined non-terminal entries are ident, - global, constr and pattern (e.g. nvar, numarg disappears); the only - allowed grammar types are constr and pattern; ast and ast list are no - longer supported; some incompatibilities in Grammar: when a syntax is a - initial segment of an other one, Grammar does not work, use Notation - -Library - -- Lemmas in Set from Compare_dec.v (le_lt_dec, ...) and Wf_nat.v - (lt_wf_rec, ...) are now transparent. This may be source of - incompatibilities. -- Syntactic Definitions Fst, Snd, Ex, All, Ex2, AllT, ExT, ExT2, - ProjS1, ProjS2, Error, Value and Except are turned to - notations. They now must be applied (incompatibilities only in - unrealistic cases). -- More efficient versions of Zmult and times (30% faster) -- Reals: the library is now divided in 6 parts (Rbase, Rfunctions, - SeqSeries, Rtrigo, Ranalysis, Integration). New tactics: Sup and - RCompute. See Reals.v for details. - -Modules - -- Beta version, see doc chap 2.5 for commands and chap 5 for theory - -Language - -- Inductive definitions now accept ">" in constructor types to declare - the corresponding constructor as a coercion. -- Idem for assumptions declarations and constants when the type is mentionned. -- The "Coercion" and "Canonical Structure" keywords now accept the - same syntax as "Definition", i.e. "hyps :=c (:t)?" or "hyps :t". -- Theorem-like declaration now accepts the syntax "Theorem thm [x:t;...] : u". -- Remark's and Fact's now definitively behave as Theorem and Lemma: when - sections are closed, the full name of a Remark or a Fact has no longer a - section part (source of incompatibilities) -- Opaque Local's (i.e. built by tactics and ended by Qed), do not - survive section closing any longer; as a side-effect, Opaque Local's - now appear in the local context of proofs; their body is hidden - though (source of incompatibilities); use one of Remark/Fact/Lemma/Theorem - instead to simulate the old behaviour of Local (the section part of - the name is not kept though) - -ML tactic and vernacular commands - -- "Grammar tactic" and "Grammar vernac" of type "ast" are no longer - supported (only "Grammar tactic simple_tactic" of type "tactic" - remains available). -- Concrete syntax for ML written vernacular commands and tactics is - now declared at ML level using camlp4 macros TACTIC EXTEND et VERNAC - COMMAND EXTEND. -- "Check n c" now "n:Check c", "Eval n ..." now "n:Eval ..." -- "Proof with T" (* no documentation *) -- SearchAbout id - prints all theorems which contain id in their type - -Tactic definitions - -- Static globalisation of identifiers and global references (source of - incompatibilities, especially, Recursive keyword is required for - mutually recursive definitions). -- New evaluation semantics: no more partial evaluation at definition time; - evaluation of all Tactic/Meta Definition, even producing terms, expect - a proof context to be evaluated (especially "()" is no longer needed). -- Debugger now shows the nesting level and the reasons of failure - -Tactics - -- Equality tactics (Rewrite, Reflexivity, Symmetry, Transitivity) now - understand JM equality -- Simpl and Change now apply to subterms also -- "Simpl f" reduces subterms whose head constant is f -- Double Induction now referring to hypotheses like "Intros until" -- "Inversion" now applies also on quantified hypotheses (naming as - for Intros until) -- NewDestruct now accepts terms with missing hypotheses -- NewDestruct and NewInduction now accept user-provided elimination scheme -- NewDestruct and NewInduction now accept user-provided introduction names -- Omega could solve goals such as ~`x<y` |- `x>=y` but failed when the - hypothesis was unfolded to `x < y` -> False. This is fixed. In addition, - it can also recognize 'False' in the hypothesis and use it to solve the - goal. -- Coercions now handled in "with" bindings -- "Subst x" replaces all ocurrences of x by t in the goal and hypotheses - when an hypothesis x=t or x:=t or t=x exists -- Fresh names for Assert and Pose now based on collision-avoiding - Intro naming strategy (exceptional source of incompatibilities) -- LinearIntuition (* no documentation *) -- Unfold expects a correct evaluable argument -- Clear expects existing hypotheses - -Extraction (See details in plugins/extraction/CHANGES and README): - -- An experimental Scheme extraction is provided. -- Concerning Ocaml, extracted code is now ensured to always type-check, - thanks to automatic inserting of Obj.magic. -- Experimental extraction of Coq new modules to Ocaml modules. - -Proof rendering in natural language - -- Export of theories to XML for publishing and rendering purposes now - includes proof-trees (see http://www.cs.unibo.it/helm) - -Miscellaneous - -- Printing Coercion now used through the standard keywords Set/Add, Test, Print -- "Print Term id" is an alias for "Print id" -- New switch "Unset/Set Printing Symbols" to control printing of - symbolic notations -- Two new variants of implicit arguments are available - - "Unset/Set Contextual Implicits" tells to consider implicit also the - arguments inferable from the context (e.g. for nil or refl_eq) - - "Unset/Set Strict Implicits" tells to consider implicit only the - arguments that are inferable in any case (i.e. arguments that occurs - as argument of rigid constants in the type of the remaining arguments; - e.g. the witness of an existential is not strict since it can vanish when - applied to a predicate which does not use its argument) - -Incompatibilities - -- "Grammar tactic ... : ast" and "Grammar vernac ... : ast" are no - longer supported, use TACTIC EXTEND and VERNAC COMMAND EXTEND on the - ML-side instead -- Transparency of le_lt_dec and co (leads to some simplification in - proofs; in some cases, incompatibilites is solved by declaring locally - opaque the relevant constant) -- Opaque Local do not now survive section closing (rename them into - Remark/Lemma/... to get them still surviving the sections; this - renaming allows also to solve incompatibilites related to now - forbidden calls to the tactic Clear) -- Remark and Fact have no longer (very) long names (use Local instead in case - of name conflict) - -Bugs - -- Improved localisation of errors in Syntactic Definitions -- Induction principle creation failure in presence of let-in fixed (#1459) -- Inversion bugs fixed (#1427 and #1437) -- Omega bug related to Set fixed (#1384) -- Type-checking inefficiency of nested destructuring let-in fixed (#1435) -- Improved handling of let-in during holes resolution phase (#1460) - -Efficiency - -- Implementation of a memory sharing strategy reducing memory - requirements by an average ratio of 3. - -Changes from V7.3 to V7.3.1 -=========================== - -Bug fixes - - - Corrupted Field tactic and Match Context tactic construction fixed - - Checking of names already existing in Assert added (#1386) - - Invalid argument bug in Exact tactic solved (#1387) - - Colliding bound names bug fixed (#1412) - - Wrong non-recursivity test for Record fixed (#1394) - - Out of memory/seg fault bug related to parametric inductive fixed (#1404) - - Setoid_replace/Setoid_rewrite bug wrt "==" fixed - -Misc - - - Ocaml version >= 3.06 is needed to compile Coq from sources - - Simplification of fresh names creation strategy for Assert, Pose and - LetTac (#1402) - -Changes from V7.2 to V7.3 -========================= - -Language - -- Slightly improved compilation of pattern-matching (slight source of - incompatibilities) -- Record's now accept anonymous fields "_" which does not build projections -- Changes in the allowed elimination sorts for certain class of inductive - definitions : an inductive definition without constructors - of Sort Prop can be eliminated on sorts Set and Type A "singleton" - inductive definition (one constructor with arguments in the sort Prop - like conjunction of two propositions or equality) can be eliminated - directly on sort Type (In V7.2, only the sorts Prop and Set were allowed) - -Tactics - -- New tactic "Rename x into y" for renaming hypotheses -- New tactics "Pose x:=u" and "Pose u" to add definitions to local context -- Pattern now working on partially applied subterms -- Ring no longer applies irreversible congruence laws of mult but - better applies congruence laws of plus (slight source of incompatibilities). -- Field now accepts terms to be simplified as arguments (as for Ring). This - extension has been also implemented using the toplevel tactic language. -- Intuition does no longer unfold constants except "<->" and "~". It - can be parameterized by a tactic. It also can introduce dependent - product if needed (source of incompatibilities) -- "Match Context" now matching more recent hypotheses first and failing only - on user errors and Fail tactic (possible source of incompatibilities) -- Tactic Definition's without arguments now allowed in Coq states -- Better simplification and discrimination made by Inversion (source - of incompatibilities) - -Bugs - -- "Intros H" now working like "Intro H" trying first to reduce if not a product -- Forward dependencies in Cases now taken into account -- Known bugs related to Inversion and let-in's fixed -- Bug unexpected Delta with let-in now fixed - -Extraction (details in plugins/extraction/CHANGES or documentation) - -- Signatures of extracted terms are now mostly expunged from dummy arguments. -- Haskell extraction is now operational (tested & debugged). - -Standard library - -- Some additions in [ZArith]: three files (Zcomplements.v, Zpower.v - and Zlogarithms.v) moved from plugins/omega in order to be more - visible, one Zsgn function, more induction principles (Wf_Z.v and - tail of Zcomplements.v), one more general Euclid theorem -- Peano_dec.v and Compare_dec.v now part of Arith.v - -Tools - -- new option -dump-glob to coqtop to dump globalizations (to be used by the - new documentation tool coqdoc; see http://www.lri.fr/~filliatr/coqdoc) - -User Contributions - -- CongruenceClosure (congruence closure decision procedure) - [Pierre Corbineau, ENS Cachan] -- MapleMode (an interface to embed Maple simplification procedures over - rational fractions in Coq) - [David Delahaye, Micaela Mayero, Chalmers University] -- Presburger: A formalization of Presburger's algorithm - [Laurent Thery, INRIA Sophia Antipolis] -- Chinese has been rewritten using Z from ZArith as datatype - ZChinese is the new version, Chinese the obsolete one - [Pierre Letouzey, LRI Orsay] - -Incompatibilities - -- Ring: exceptional incompatibilities (1 above 650 in submitted user - contribs, leading to a simplification) -- Intuition: does not unfold any definition except "<->" and "~" -- Cases: removal of some extra Cases in configurations of the form - "Cases ... of C _ => ... | _ D => ..." (effects on 2 definitions of - submitted user contributions necessitating the removal of now superfluous - proof steps in 3 different proofs) -- Match Context, in case of incompatibilities because of a now non - trapped error (e.g. Not_found or Failure), use instead tactic Fail - to force Match Context trying the next clause -- Inversion: better simplification and discrimination may occasionally - lead to less subgoals and/or hypotheses and different naming of hypotheses -- Unification done by Apply/Elim has been changed and may exceptionally lead - to incompatible instantiations -- Peano_dec.v and Compare_dec.v parts of Arith.v make Auto more - powerful if these files were not already required (1 occurrence of - this in submitted user contribs) - -Changes from V7.1 to V7.2 -========================= - -Language - -- Automatic insertion of patterns for local definitions in the type of - the constructors of an inductive types (for compatibility with V6.3 - let-in style) -- Coercions allowed in Cases patterns -- New declaration "Canonical Structure id = t : I" to help resolution of - equations of the form (proj ?)=a; if proj(e)=a then a is canonically - equipped with the remaining fields in e, i.e. ? is instantiated by e - -Tactics - -- New tactic "ClearBody H" to clear the body of definitions in local context -- New tactic "Assert H := c" for forward reasoning -- Slight improvement in naming strategy for NewInduction/NewDestruct -- Intuition/Tauto do not perform useless unfolding and work up to conversion - -Extraction (details in plugins/extraction/CHANGES or documentation) - -- Syntax changes: there are no more options inside the extraction commands. - New commands for customization and options have been introduced instead. -- More optimizations on extracted code. -- Extraction tests are now embedded in 14 user contributions. - -Standard library - -- In [Relations], Rstar.v and Newman.v now axiom-free. -- In [Sets], Integers.v now based on nat -- In [Arith], more lemmas in Min.v, new file Max.v, tail-recursive - plus and mult added to Plus.v and Mult.v respectively -- New directory [Sorting] with a proof of heapsort (dragged from 6.3.1 lib) -- In [Reals], more lemmas in Rbase.v, new lemmas on square, square root and - trigonometric functions (R_sqr.v - Rtrigo.v); a complementary approach - and new theorems about continuity and derivability in Ranalysis.v; some - properties in plane geometry such as translation, rotation or similarity - in Rgeom.v; finite sums and Chasles property in Rsigma.v - -Bugs - -- Confusion between implicit args of locals and globals of same base name fixed -- Various incompatibilities wrt inference of "?" in V6.3.1 fixed -- Implicits in infix section variables bug fixed -- Known coercions bugs fixed - -- Apply "universe anomaly" bug fixed -- NatRing now working -- "Discriminate 1", "Injection 1", "Simplify_eq 1" now working -- NewInduction bugs with let-in and recursively dependent hypotheses fixed -- Syntax [x:=t:T]u now allowed as mentioned in documentation - -- Bug with recursive inductive types involving let-in fixed -- Known pattern-matching bugs fixed -- Known Cases elimination predicate bugs fixed -- Improved errors messages for pattern-matching and projections -- Better error messages for ill-typed Cases expressions - -Incompatibilities - -- New naming strategy for NewInduction/NewDestruct may affect 7.1 compatibility -- Extra parentheses may exceptionally be needed in tactic definitions. -- Coq extensions written in Ocaml need to be updated (see dev/changements.txt - for a description of the main changes in the interface files of V7.2) -- New behaviour of Intuition/Tauto may exceptionally lead to incompatibilities - ----------------------------------------------------------------------------- -Changes from V6.3.1 and V7.0 to V7.1 -==================================== - -Notes: - -- items followed by (**) are important sources of incompatibilities -- items followed by (*) may exceptionally be sources of incompatibilities -- items followed by (+) have been introduced in version 7.0 - - -Main novelties -============== - -References are to Coq V7.1 reference manual - -- New primitive let-in construct (see sections 1.2.8 and ) -- Long names (see sections 2.6 and 2.7) -- New high-level tactic language (see chapter 10) -- Improved search facilities (see section 5.2) -- New extraction algorithm managing the Type level (see chapter 17) -- New rewriting tactic for arbitrary equalities (see chapter 19) -- New tactic Field to decide equalities on commutative fields (see 7.11) -- New tactic Fourier to solve linear inequalities on reals numbers (see 7.11) -- New tactics for induction/case analysis in "natural" style (see 7.7) -- Deep restructuration of the code (safer, simpler and more efficient) -- Export of theories to XML for publishing and rendering purposes - (see http://www.cs.unibo.it/helm) - - -Details of changes -================== - -Language: new "let-in" construction ------------------------------------ - -- New construction for local definitions (let-in) with syntax [x:=u]t (*)(+) - -- Local definitions allowed in Record (a.k.a. record à la Randy Pollack) - - -Language: long names --------------------- - -- Each construction has a unique absolute names built from a base - name, the name of the module in which they are defined (Top if in - coqtop), and possibly an arbitrary long sequence of directory (e.g. - "Coq.Lists.PolyList.flat_map" where "Coq" means that "flat_map" is part - of Coq standard library, "Lists" means it is defined in the Lists - library and "PolyList" means it is in the file Polylist) (+) - -- Constructions can be referred by their base name, or, in case of - conflict, by a "qualified" name, where the base name is prefixed - by the module name (and possibly by a directory name, and so - on). A fully qualified name is an absolute name which always refer - to the construction it denotes (to preserve the visibility of - all constructions, no conflict is allowed for an absolute name) (+) - -- Long names are available for modules with the possibility of using - the directory name as a component of the module full name (with - option -R to coqtop and coqc, or command Add LoadPath) (+) - -- Improved conflict resolution strategy (the Unix PATH model), - allowing more constructions to be referred just by their base name - - -Language: miscellaneous ------------------------ - -- The names of variables for Record projections _and_ for induction principles - (e.g. sum_ind) is now based on the first letter of their type (main - source of incompatibility) (**)(+) - -- Most typing errors have now a precise location in the source (+) - -- Slightly different mechanism to solve "?" (*)(+) - -- More arguments may be considered implicit at section closing (*)(+) - -- Bug with identifiers ended by a number greater than 2^30 fixed (+) - -- New visibility discipline for Remark, Fact and Local: Remark's and - Fact's now survive at the end of section, but are only accessible using a - qualified names as soon as their strength expires; Local's disappear and - are moved into local definitions for each construction persistent at - section closing - - -Language: Cases ---------------- - -- Cases no longer considers aliases inferable from dependencies in types (*)(+) - -- A redundant clause in Cases is now an error (*) - - -Reduction ---------- - -- New reduction flags "Zeta" and "Evar" in Eval Compute, for inlining of - local definitions and instantiation of existential variables - -- Delta reduction flag does not perform Zeta and Evar reduction any more (*) - -- Constants declared as opaque (using Qed) can no longer become - transparent (a constant intended to be alternatively opaque and - transparent must be declared as transparent (using Defined)); a risk - exists (until next Coq version) that Simpl and Hnf reduces opaque - constants (*) - - -New tactics ------------ - -- New set of tactics to deal with types equipped with specific - equalities (a.k.a. Setoids, e.g. nat equipped with eq_nat) [by C. Renard] - -- New tactic Assert, similar to Cut but expected to be more user-friendly - -- New tactic NewDestruct and NewInduction intended to replace Elim - and Induction, Case and Destruct in a more user-friendly way (see - restrictions in the reference manual) - -- New tactic ROmega: an experimental alternative (based on reflexion) to Omega - [by P. Crégut] - -- New tactic language Ltac (see reference manual) (+) - -- New versions of Tauto and Intuition, fully rewritten in the new Ltac - language; they run faster and produce more compact proofs; Tauto is - fully compatible but, in exchange of a better uniformity, Intuition - is slightly weaker (then use Tauto instead) (**)(+) - -- New tactic Field to decide equalities on commutative fields (as a - special case, it works on real numbers) (+) - -- New tactic Fourier to solve linear inequalities on reals numbers - [by L. Pottier] (+) - -- New tactics dedicated to real numbers: DiscrR, SplitRmult, SplitAbsolu (+) - - -Changes in existing tactics ---------------------------- - -- Reduction tactics in local definitions apply only to the body - -- New syntax of the form "Compute in Type of H." to require a reduction on - the types of local definitions - -- Inversion, Injection, Discriminate, ... apply also on the - quantified premises of a goal (using the "Intros until" syntax) - -- Decompose has been fixed but hypotheses may get different names (*)(+) - -- Tauto now manages uniformly hypotheses and conclusions of the form - "t=t" which all are considered equivalent to "True". Especially, - Tauto now solves goals of the form "H : ~ t = t |- A". - -- The "Let" tactic has been renamed "LetTac" and is now based on the - primitive "let-in" (+) - -- Elim can no longer be used with an elimination schema different from - the one defined at definition time of the inductive type. To overload - an elimination schema, use "Elim <hyp> using <name of the new schema>" - (*)(+) - -- Simpl no longer unfolds the recursive calls of a mutually defined - fixpoint (*)(+) - -- Intro now fails if the hypothesis name already exists (*)(+) - -- "Require Prolog" is no longer needed (i.e. it is available by default) (*)(+) - -- Unfold now fails on a non unfoldable identifier (*)(+) - -- Unfold also applies on definitions of the local context - -- AutoRewrite now deals only with the main goal and it is the purpose of - Hint Rewrite to deal with generated subgoals (+) - -- Redundant or incompatible instantiations in Apply ... with ... are now - correctly managed (+) - - -Efficiency ----------- - -- Excessive memory uses specific to V7.0 fixed - -- Sizes of .vo files vary a lot compared to V6.3 (from -30% to +300% - depending on the developments) - -- An improved reduction strategy for lazy evaluation - -- A more economical mechanism to ensure logical consistency at the Type level; - warning: this is experimental and may produce "universes" anomalies - (please report) - - -Concrete syntax of constructions --------------------------------- - -- Only identifiers starting with "_" or a letter, and followed by letters, - digits, "_" or "'" are allowed (e.g. "$" and "@" are no longer allowed) (*) - -- A multiple binder like (a:A)(a,b:(P a))(Q a) is no longer parsed as - (a:A)(a0:(P a))(b:(P a))(Q a0) but as (a:A)(a0:(P a))(b:(P a0))(Q a0) (*)(+) - -- A dedicated syntax has been introduced for Reals (e.g ``3+1/x``) (+) - -- Pretty-printing of Infix notations fixed. (+) - - -Parsing and grammar extension ------------------------------ - -- More constraints when writing ast - - - "{...}" and the macros $LIST, $VAR, etc. now expect a metavariable - (an identifier starting with $) (*) - - identifiers should starts with a letter or "_" and be followed - by letters, digits, "_" or "'" (other characters are still - supported but it is not advised to use them) (*)(+) - -- Entry "command" in "Grammar" and quotations (<<...>> stuff) is - renamed "constr" as in "Syntax" (+) - -- New syntax "[" sentence_1 ... sentence_n"]." to group sentences (useful - for Time and to write grammar rules abbreviating several commands) (+) - -- The default parser for actions in the grammar rules (and for - patterns in the pretty-printing rules) is now the one associated to - the grammar (i.e. vernac, tactic or constr); no need then for - quotations as in <:vernac:<...>>; to return an "ast", the grammar - must be explicitly typed with tag ": ast" or ": ast list", or if a - syntax rule, by using <<...>> in the patterns (expression inside - these angle brackets are parsed as "ast"); for grammars other than - vernac, tactic or constr, you may explicitly type the action with - tags ": constr", ": tactic", or ":vernac" (**)(+) - -- Interpretation of names in Grammar rule is now based on long names, - which allows to avoid problems (or sometimes tricks;) related to - overloaded names (+) - - -New commands ------------- - -- New commands "Print XML All", "Show XML Proof", ... to show or - export theories to XML to be used with Helm's publishing and rendering - tools (see http://www.cs.unibo.it/helm) (by Claudio Sacerdoti Coen) (+) - -- New commands to manually set implicit arguments (+) - - - "Implicits ident." to activate the implicit arguments mode just for ident - - "Implicits ident [num1 num2 ...]." to explicitly give which - arguments have to be considered as implicit - -- New SearchPattern/SearchRewrite (by Yves Bertot) (+) - -- New commands "Debug on"/"Debug off" to activate/deactivate the tactic - language debugger (+) - -- New commands to map physical paths to logical paths (+) - - Add LoadPath physical_dir as logical_dir - - Add Rec LoadPath physical_dir as logical_dir - - -Changes in existing commands ----------------------------- - -- Generalization of the usage of qualified identifiers in tactics - and commands about globals, e.g. Decompose, Eval Delta; - Hints Unfold, Transparent, Require - -- Require synchronous with Reset; Require's scope stops at Section ending (*) - -- For a module indirectly loaded by a "Require" but not exported, - the command "Import module" turns the constructions defined in the - module accessible by their short name, and activates the Grammar, - Syntax, Hint, ... declared in the module (+) - -- The scope of the "Search" command can be restricted to some modules (+) - -- Final dot in command (full stop/period) must be followed by a blank - (newline, tabulation or whitespace) (+) - -- Slight restriction of the syntax for Cbv Delta: if present, option [-myconst] - must immediately follow the Delta keyword (*)(+) - -- SearchIsos currently not supported - -- Add ML Path is now implied by Add LoadPath (+) - -- New names for the following commands (+) - - AddPath -> Add LoadPath - Print LoadPath -> Print LoadPath - DelPath -> Remove LoadPath - AddRecPath -> Add Rec LoadPath - Print Path -> Print Coercion Paths - - Implicit Arguments On -> Set Implicit Arguments - Implicit Arguments Off -> Unset Implicit Arguments - - Begin Silent -> Set Silent - End Silent -> Unset Silent. - - -Tools ------ - -- coqtop (+) - - - Two executables: coqtop.byte and coqtop.opt (if supported by the platform) - - coqtop is a link to the more efficient executable (coqtop.opt if present) - - option -full is obsolete (+) - -- do_Makefile renamed into coq_makefile (+) - -- New option -R to coqtop and coqc to map a physical directory to a logical - one (+) - -- coqc no longer needs to create a temporary file - -- No more warning if no initialization file .coqrc exists - - -Extraction ----------- - -- New algorithm for extraction able to deal with "Type" (+) - (by J.-C. Filliâtre and P. Letouzey) - - -Standard library ----------------- - -- New library on maps on integers (IntMap, contributed by Jean Goubault) - -- New lemmas about integer numbers [ZArith] - -- New lemmas and a "natural" syntax for reals [Reals] (+) - -- Exc/Error/Value renamed into Option/Some/None (*) - - -New user contributions ----------------------- - -- Constructive complex analysis and the Fundamental Theorem of Algebra [FTA] - (Herman Geuvers, Freek Wiedijk, Jan Zwanenburg, Randy Pollack, - Henk Barendregt, Nijmegen) - -- A new axiomatization of ZFC set theory [Functions_in_ZFC] - (C. Simpson, Sophia-Antipolis) - -- Basic notions of graph theory [GRAPHS-BASICS] (Jean Duprat, Lyon) - -- A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, - Sophia-Antipolis) - -- Formalisation of CTL and TCTL temporal logic [CtlTctl] (Carlos - Daniel Luna,Montevideo) - -- Specification and verification of the Railroad Crossing Problem - in CTL and TCTL [RailroadCrossing] (Carlos Daniel Luna,Montevideo) - -- P-automaton and the ABR algorithm [PAutomata] - (Christine Paulin, Emmanuel Freund, Orsay) - -- Semantics of a subset of the C language [MiniC] - (Eduardo Giménez, Emmanuel Ledinot, Suresnes) - -- Correctness proofs of the following imperative algorithms: - Bresenham line drawing algorithm [Bresenham], Marché's minimal edition - distance algorithm [Diff] (Jean-Christophe Filliâtre, Orsay) - -- Correctness proofs of Buchberger's algorithm [Buchberger] and RSA - cryptographic algorithm [Rsa] (Laurent Théry, Sophia-Antipolis) - -- Correctness proof of Stalmarck tautology checker algorithm - [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 index 0000000000..67e0e06caa --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,4048 @@ +Changes from 8.9 to 8.10 +======================== + +OCaml + +- Coq 8.10 requires OCaml >= 4.05.0, bumped from 4.02.3 See the + INSTALL file for more information on dependencies. + +Plugins + +- The quote plugin (https://coq.inria.fr/distrib/V8.8.1/refman/proof-engine/detailed-tactic-examples.html#quote) + was removed. If some users are interested in maintaining this plugin + externally, the Coq development team can provide assistance for extracting + the plugin and setting up a new repository. + +Tactics + +- Removed the deprecated `romega` tactics. +- Tactic names are no longer allowed to clash, even if they are not defined in + the same section. For example, the following is no longer accepted: + `Ltac foo := idtac. Section S. Ltac foo := fail. End S.` + +Changes from 8.8.2 to 8.9+beta1 +=============================== + +Kernel + +- Mutually defined records are now supported. + +Notations + +- New support for autonomous grammars of terms, called "custom + entries" (see chapter "Syntax extensions" of the reference manual). + +- New command `Declare Scope` to explicitly declare a scope name + before any use of it. Implicit declaration of a scope at the time of + `Bind Scope`, `Delimit Scope`, `Undelimit Scope`, or `Notation` is + deprecated. + +Tactics + +- Added toplevel goal selector `!` which expects a single focused goal. + Use with `Set Default Goal Selector` to force focusing before tactics + are called. + +- The undocumented "nameless" forms `fix N`, `cofix` that were + deprecated in 8.8 have been removed from Ltac's syntax; please use + `fix ident N/cofix ident` to explicitly name the (co)fixpoint + hypothesis to be introduced. + +- Introduction tactics `intro`/`intros` on a goal that is an + existential variable now force a refinement of the goal into a + dependent product rather than failing. + +- Support for `fix`/`cofix` added in Ltac `match` and `lazymatch`. + +- Ltac backtraces now include trace information about tactics + called by OCaml-defined tactics. + +- Option `Ltac Debug` now applies also to terms built using Ltac functions. + +- Deprecated the `Implicit Tactic` family of commands. + +- The default program obligation tactic uses a bounded proof search + instead of an unbounded and potentially non-terminating one now + (source of incompatibility). + +- The `simple apply` tactic now respects the `Opaque` flag when called from + Ltac (`auto` still does not respect it). + +- Tactic `constr_eq` now adds universe constraints needed for the + identity to the context (it used to ignore them). New tactic + `constr_eq_strict` checks that the required constraints already hold + without adding new ones. Preexisting tactic `constr_eq_nounivs` can + still be used if you really want to ignore universe constraints. + +- Tactics and tactic notations now understand the `deprecated` attribute. +- The `fourier` tactic has been removed. Please now use `lra` instead. You + may need to add `Require Import Lra` to your developments. For compatibility, + we now define `fourier` as a deprecated alias of `lra`. + +- The `romega` tactics have been deprecated; please use `lia` instead. + +- Names of existential variables occurring in Ltac functions + (e.g. `?[n]` or `?n` in terms - not in patterns) are now interpreted + the same way as other variable names occurring in Ltac functions. + +Focusing + +- Focusing bracket `{` now supports named goal selectors, + e.g. `[x]: {` will focus on a goal (existential variable) named `x`. + As usual, unfocus with `}` once the sub-goal is fully solved. + +Specification language, type inference + +- A fix to unification (which was sensitive to the ascii name of + variables) may occasionally change type inference in incompatible + ways, especially regarding the inference of the return clause of `match`. + +- Fixing a missing check in interpreting instances of existential + variables that are bound to local definitions might exceptionally + induce an overhead if the cost of checking the conversion of the + corresponding definitions is additionally high (PR #8215). + +- A few improvements in inference of the return clause of `match` can + exceptionally introduce incompatibilities (PR #262). This can be + solved by writing an explicit `return` clause, sometimes even simply + an explicit `return _` clause. + +Standard Library + +- Added `Ascii.eqb` and `String.eqb` and the `=?` notation for them, + and proved some lemmas about them. Note that this might cause + incompatibilities if you have, e.g., `string_scope` and `Z_scope` both + open with `string_scope` on top, and expect `=?` to refer to `Z.eqb`. + Solution: wrap `_ =? _` in `(_ =? _)%Z` (or whichever scope you + want). + +- Added `Ndigits.N2Bv_sized`, and proved some lemmas about it. + Deprecated `Ndigits.N2Bv_gen`. + +- The scopes `int_scope` and `uint_scope` have been renamed to + `dec_int_scope` and `dec_uint_scope`, to clash less with ssreflect + and other packages. They are still delimited by `%int` and `%uint`. + +- Syntax notations for `string`, `ascii`, `Z`, `positive`, `N`, `R`, + and `int31` are no longer available merely by `Require`ing the files + that define the inductives. You must `Import` `Coq.Strings.String`, + `Coq.Strings.Ascii`, `Coq.ZArith.BinIntDef`, `Coq.PArith.BinPosDef`, + `Coq.NArith.BinNatDef`, `Coq.Reals.Rdefinitions`, and + `Coq.Numbers.Cyclic.Int31.Int31`, respectively, to be able to use + these notations. Note that passing `-compat 8.8` or issuing + `Require Import Coq.Compat.Coq88` will make these notations + available. Users wishing to port their developments automatically + may download `fix.py` from + <https://gist.github.com/JasonGross/5d4558edf8f5c2c548a3d96c17820169> + and run a command like `while true; do make -Okj 2>&1 | + /path/to/fix.py; done` and get a cup of coffee. (This command must + be manually interrupted once the build finishes all the way though. + Note also that this method is not fail-proof; you may have to adjust + some scopes if you were relying on string notations not being + available even when `string_scope` was open.) + +- Numeral syntax for `nat` is no longer available without loading the + entire prelude (`Require Import Coq.Init.Prelude`). This only + impacts users running Coq without the init library (`-nois` or + `-noinit`) and also issuing `Require Import Coq.Init.Datatypes`. + +- Added `Bvector.BVeq` that decides whether two `Bvector`s are equal. +- Added notations for `BVxor`, `BVand`, `BVor`, `BVeq` and `BVneg`. + +Tools + +- Coq_makefile lets one override or extend the following variables from + the command line: `COQFLAGS`, `COQCHKFLAGS`, `COQDOCFLAGS`. + `COQFLAGS` is now entirely separate from `COQLIBS`, so in custom Makefiles + `$(COQFLAGS)` should be replaced by `$(COQFLAGS) $(COQLIBS)`. + +- Removed the `gallina` utility (extracts specification from Coq vernacular files). + If you would like to maintain this tool externally, please contact us. + +- Removed the Emacs modes distributed with Coq. You are advised to + use [Proof-General](https://proofgeneral.github.io/) (and optionally + [Company-Coq](https://github.com/cpitclaudel/company-coq)) instead. + If your use case is not covered by these alternative Emacs modes, + please open an issue. We can help set up external maintenance as part + of Proof-General, or independently as part of coq-community. + +Vernacular Commands + +- Removed deprecated commands `Arguments Scope` and `Implicit Arguments` + (not the option). Use the `Arguments` command instead. +- Nested proofs may be enabled through the option `Nested Proofs Allowed`. + By default, they are disabled and produce an error. The deprecation + warning which used to occur when using nested proofs has been removed. +- Added option `Uniform Inductive Parameters` which abstracts over parameters + before typechecking constructors, allowing to write for example + `Inductive list (A : Type) := nil : list | cons : A -> list -> list.` +- New `Set Hint Variables/Constants Opaque/Transparent` commands for setting + globally the opacity flag of variables and constants in hint databases, + overwritting the opacity set of the hint database. +- Added generic syntax for "attributes", as in: + `#[local] Lemma foo : bar.` +- Added the `Numeral Notation` command for registering decimal numeral + notations for custom types +- The `Set SsrHave NoTCResolution` command no longer has special global + scope. If you want the previous behavior, use `Global Set SsrHave + NoTCResolution`. +- Multiple sections with the same name are allowed. +- `Combined Scheme` can now work when inductive schemes are generated in sort + `Type`. It used to be limited to sort `Prop`. + +Coq binaries and process model + +- Before 8.9, Coq distributed a single `coqtop` binary and a set of + dynamically loadable plugins that used to take over the main loop + for tasks such as IDE language server or parallel proof checking. + + These plugins have been turned into full-fledged binaries so each + different process has associated a particular binary now, in + particular `coqidetop` is the CoqIDE language server, and + `coq{proof,tactic,query}worker` are in charge of task-specific and + parallel proof checking. + +SSReflect + +- The implementation of delayed clear switches in intro patterns + is now simpler to explain: + 1. The immediate effect of a clear switch like `{x}` is to rename the + variable `x` to `_x_` (i.e. a reserved identifier that cannot be mentioned + explicitly) + 2. The delayed effect of `{x}` is that `_x_` is cleared at the end of the intro + pattern + 3. A clear switch immediately before a view application like `{x}/v` is + translated to `/v{x}`. + + In particular, the third rule lets one write `{x}/v` even if `v` uses the variable `x`: + indeed the view is executed before the renaming. + +- An empty clear switch is now accepted in intro patterns before a + view application whenever the view is a variable. + One can now write `{}/v` to mean `{v}/v`. Remark that `{}/x` is very similar + to the idiom `{}e` for the rewrite tactic (the equation `e` is used for + rewriting and then discarded). + +Standard Library + +- There are now conversions between `string` and `positive`, `Z`, + `nat`, and `N` in binary, octal, and hex. + +Display diffs between proof steps + +- `coqtop` and `coqide` can now highlight the differences between proof steps + in color. This can be enabled from the command line or the + `Set Diffs "on"/"off"/"removed"` command. Please see the documentation for + details. Showing diffs in Proof General requires small changes to PG + (under discussion). + +Notations + +- Added `++` infix for `VectorDef.append`. + Note that this might cause incompatibilities if you have, e.g., `list_scope` + and `vector_scope` both open with `vector_scope` on top, and expect `++` to + refer to `app`. + Solution: wrap `_ ++ _` in `(_ ++ _)%list` (or whichever scope you want). + +Changes from 8.8.1 to 8.8.2 +=========================== + +Documentation + +- A PDF version of the reference manual is available once again. + +Tools + +- The coq-makefile targets `print-pretty-timed`, `print-pretty-timed-diff`, + and `print-pretty-single-time-diff` now correctly label the "before" and + "after" columns, rather than swapping them. + +Kernel + +- The kernel does not tolerate capture of global universes by + polymorphic universe binders, fixing a soundness break (triggered + only through custom plugins) + +Windows installer + +- The Windows installer now includes many more external packages that can be + individually selected for installation. + +Many other bug fixes and lots of documentation improvements (for details, +see the 8.8.2 milestone at https://github.com/coq/coq/milestone/15?closed=1). + +Changes from 8.8.0 to 8.8.1 +=========================== + +Kernel + +- Fix a critical bug with cofixpoints and `vm_compute`/`native_compute` (#7333). +- Fix a critical bug with modules and algebraic universes (#7695) +- Fix a critical bug with inlining of polymorphic constants (#7615). +- Fix a critical bug with universe polymorphism and `vm_compute` (#7723). Was + present since 8.5. + +Notations + +- Fixed unexpected collision between only-parsing and only-printing + notations (issue #7462). + +Windows installer + +- The Windows installer now includes external packages Ltac2 and Equations + (it included the Bignums package since 8.8+beta1). + +Many other bug fixes, documentation improvements (including fixes of +regressions due to the Sphinx migration), and user message improvements +(for details, see the 8.8.1 milestone at +https://github.com/coq/coq/milestone/13?closed=1). + +Changes from 8.8+beta1 to 8.8.0 +=============================== + +Tools + +- Asynchronous proof delegation policy was fixed. Since version 8.7 + Coq was ignoring previous runs and the `-async-proofs-delegation-threshold` + option did not have the expected behavior. + +Tactic language + +- The undocumented "nameless" forms `fix N`, `cofix` have been + deprecated; please use `fix ident N /cofix ident` to explicitely + name the (co)fixpoint hypothesis to be introduced. + +Documentation + +- The reference manual is now fully ported to Sphinx. + +Other small deprecations and bug fixes. + +Changes from 8.7.2 to 8.8+beta1 +=============================== + +Kernel + +- Support for template polymorphism for definitions was removed. May trigger + more "universe inconsistency" errors in rare occasions. +- Fixpoints are no longer allowed on non-recursive inductive types. + +Notations + +- Recursive notations with the recursive pattern repeating on the + right (e.g. "( x ; .. ; y ; z )") now supported. +- Notations with a specific level for the leftmost nonterminal, + when printing-only, are supported. +- Notations can now refer to the syntactic category of patterns (as in + "fun 'pat =>" or "match p with pat => ... end"). Two variants are + available, depending on whether a single variable is considered as a + pattern or not. +- Recursive notations now support ".." patterns with several + occurrences of the recursive term or binder, possibly mixing terms + and binders, possibly in reverse left-to-right order. +- "Locate" now working also on notations of the form "x + y" (rather + than "_ + _"). + +Specification language + +- When printing clauses of a "match", clauses with same right-hand + side are factorized and the last most factorized clause with no + variables, if it exists, is turned into a default clause. + Use "Unset Printing Allow Default Clause" do deactivate printing + of a default clause. + Use "Unset Printing Factorizable Match Patterns" to deactivate + factorization of clauses with same right-hand side. + +Tactics + +- On Linux, "native_compute" calls can be profiled using the "perf" + utility. The command "Set NativeCompute Profiling" enables + profiling, and "Set NativeCompute Profile Filename" customizes + the profile filename. +- The tactic "omega" is now aware of the bodies of context variables + such as "x := 5 : Z" (see #1362). This could be disabled via + Unset Omega UseLocalDefs. +- The tactic "romega" is also aware now of the bodies of context variables. +- The tactic "zify" resp. "omega with N" is now aware of N.pred. +- Tactic "decide equality" now able to manage constructors which + contain proofs. +- Added tactics reset ltac profile, show ltac profile (and variants) +- Added tactics restart_timer, finish_timing, and time_constr as an + experimental way of timing Ltac's evaluation phase +- Added tactic optimize_heap, analogous to the Vernacular Optimize + Heap, which performs a major garbage collection and heap compaction + in the OCaml run-time system. +- The tactics "dtauto", "dintuition", "firstorder" now handle inductive types + with let bindings in the parameters. +- The tactic "dtauto" now handles some inductives such as + "@sigT A (fun _ => B)" as non-dependent conjunctions. +- A bug fixed in "rewrite H in *" and "rewrite H in * |-" may cause a + few rare incompatibilities (it was unintendedly recursively + rewriting in the side conditions generated by H). +- Added tactics "assert_succeeds tac" and "assert_fails tac" to ensure + properties of the executation of a tactic without keeping the effect + of the execution. +- `vm_compute` now supports existential variables. +- Calls to `shelve` and `give_up` within calls to tactic `refine` now working. +- Deprecated tactic `appcontext` was removed. + +Focusing + +- Focusing bracket `{` now supports single-numbered goal selector, + e.g. `2: {` will focus on the second sub-goal. As usual, unfocus + with `}` once the sub-goal is fully solved. + The `Focus` and `Unfocus` commands are now deprecated. + +Vernacular Commands + +- Proofs ending in "Qed exporting ident, .., ident" are not supported + anymore. Constants generated during `abstract` are kept private to the + local environment. +- The deprecated Coercion Local, Open Local Scope, Notation Local syntax + was removed. Use Local as a prefix instead. +- For the Extraction Language command, "OCaml" is spelled correctly. + The older "Ocaml" is still accepted, but deprecated. +- Using “Require” inside a section is deprecated. +- An experimental command "Show Extraction" allows to extract the content + of the current ongoing proof (grant wish #4129). +- Coercion now accepts the type of its argument to be "Prop" or "Type". +- The "Export" modifier can now be used when setting and unsetting options, and + will result in performing the same change when the module corresponding the + command is imported. +- The `Axiom` command does not automatically declare axioms as instances when + their type is a class. Previous behavior can be restored using `Set + Typeclasses Axioms Are Instances`. + +Universes + +- Qualified naming of global universes now works like other namespaced + objects (e.g. constants), with a separate namespace, inside and across + module and library boundaries. Global universe names introduced in an + inductive / constant / Let declaration get qualified with the name of + the declaration. +- Universe cumulativity for inductive types is now specified as a + variance for each polymorphic universe. See the reference manual for + more information. +- Inference of universe constraints with cumulative inductive types + produces more general constraints. Unsetting new option Cumulativity + Weak Constraints produces even more general constraints (but may + produce too many universes to be practical). +- Fix #5726: Notations that start with `Type` now support universe instances + with `@{u}`. +- `with Definition` now understands universe declarations + (like `@{u| Set < u}`). + +Tools + +- Coq can now be run with the option -mangle-names to change the auto-generated + name scheme. This is intended to function as a linter for developments that + want to be robust to changes in auto-generated names. This feature is experimental, + and may change or disappear without warning. +- GeoProof support was removed. + +Checker + +- The checker now accepts filenames in addition to logical paths. + +CoqIDE + +- Find and Replace All report the number of occurrences found; Find indicates + when it wraps. + +coqdep + +- Learned to read -I, -Q, -R and filenames from _CoqProject files. + This is used by coq_makefile when generating dependencies for .v + files (but not other files). + +Documentation + +- The Coq FAQ, formerly located at https://coq.inria.fr/faq, has been + moved to the GitHub wiki section of this repository; the main entry + page is https://github.com/coq/coq/wiki/The-Coq-FAQ. +- Documentation: a large community effort resulted in the migration + of the reference manual to the Sphinx documentation tool. The result + is partially integrated in this version. + +Standard Library + +- New libraries Coq.Init.Decimal, Coq.Numbers.DecimalFacts, + Coq.Numbers.DecimalNat, Coq.Numbers.DecimalPos, + Coq.Numbers.DecimalN, Coq.Numbers.DecimalZ, + Coq.Numbers.DecimalString providing a type of decimal numbers, some + facts about them, and conversions between decimal numbers and nat, + positive, N, Z, and string. +- Added [Coq.Strings.String.concat] to concatenate a list of strings + inserting a separator between each item +- Notation `'` for Zpos in QArith was removed. + +- Some deprecated aliases are now emitting warnings when used. + +Compatibility support + +- Support for compatibility with versions before 8.6 was dropped. + +Options + +- The following deprecated options have been removed: + + + `Refolding Reduction` + + `Standard Proposition Elimination` + + `Dependent Propositions Elimination` + + `Discriminate Introduction` + + `Shrink Abstract` + + `Tactic Pattern Unification` + + `Intuition Iff Unfolding` + + `Injection L2R Pattern Order` + + `Record Elimination Schemes` + + `Match Strict` + + `Tactic Compat Context` + + `Typeclasses Legacy Resolution` + + `Typeclasses Module Eta` + + `Typeclass Resolution After Apply` + +Changes from 8.7.1 to 8.7.2 +=========================== + +Fixed a critical bug in the VM handling of universes (#6677). This bug +affected all releases since 8.5. + +Improved support for building with OCaml 4.06.0 and external num package. + +Many other bug fixes, documentation improvements, and user +message improvements (for details, see the 8.7.2 milestone at +https://github.com/coq/coq/milestone/11?closed=1). + +Changes from 8.7.0 to 8.7.1 +=========================== + +Compatibility with OCaml 4.06.0. + +Many bug fixes, documentation improvements, and user message improvements (for +details see the 8.7.1 milestone at https://github.com/coq/coq/milestone/10?closed=1). + +Changes from 8.7+beta2 to 8.7.0 +=============================== + +OCaml + +- Users can pass specific flags to the OCaml optimizing compiler by + -using the flambda-opts configure-time option. + + Beware that compiling Coq with a flambda-enabled compiler is + experimental and may require large amounts of RAM and CPU, see + INSTALL for more details. + +Changes from 8.7+beta1 to 8.7+beta2 +=================================== + +Tools + +- In CoqIDE, the "Compile Buffer" command takes account of flags in + _CoqProject or other project file. + +Improvements around some error messages. + +Many bug fixes including two important ones: + +- Bug #5730: CoqIDE becomes unresponsive on file open. +- coq_makefile: make sure compile flags for Coq and coq_makefile are in sync + (in particular, make sure the `-safe-string` option is used to compile plugins). + +Changes from 8.6.1 to 8.7+beta1 +=============================== + +Tactics + +- New tactic "extensionality in H" which applies (possibly dependent) + functional extensionality in H supposed to be a quantified equality + until giving a bare equality. +- New tactic "inversion_sigma" which turns equalities of dependent + pairs (e.g., "existT P x p = existT P y q", frequently left over by + "inversion" on a dependent type family) into pairs of equalities + (e.g., a hypothesis "H : x = y" and a hypothesis of type "rew H in p + = q"); these hypotheses can subsequently be simplified using + "subst", without ever invoking any kind of axiom asserting + uniqueness of identity proofs. If you want to explicitly specify the + hypothesis to be inverted, or name the generated hypotheses, you can + invoke "induction H as [H1 H2] using eq_sigT_rect". The tactic also + works for "sig", "sigT2", and "sig2", and there are similar + "eq_sig*_rect" induction lemmas. +- Tactic "specialize with ..." now accepts any partial bindings. + Missing bindings are either solved by unification or left quantified + in the hypothesis. +- New representation of terms that statically ensure stability by + evar-expansion. This has several consequences. + * In terms of performance, this adds a cost to every term destructuration, + but at the same time most eager evar normalizations were removed, which + couterbalances this drawback and even sometimes outperforms the old + implementation. For instance, many operations that would require O(n) + normalization of the term are now O(1) in tactics. YMMV. + * This triggers small changes in unification, which was not evar-insensitive. + Most notably, the new implementation recognizes Miller patterns that were + missed before because of a missing normalization step. Hopefully this should + be fairly uncommon. +- Tactic "auto with real" can now discharge comparisons of literals. +- The types of variables in patterns of "match" are now + beta-iota-reduced after type-checking. This has an impact on the + type of the variables that the tactic "refine" introduces in the + context, producing types a priori closer to the expectations. +- In "Tactic Notation" or "TACTIC EXTEND", entry "constr_with_bindings" + now uses type classes and rejects terms with unresolved holes, like + entry "constr" does. To get the former behavior use + "open_constr_with_bindings" (possible source of incompatibility). +- New e-variants eassert, eenough, epose proof, eset, eremember, epose + which behave like the corresponding variants with no "e" but turn + unresolved implicit arguments into existential variables, on the + shelf, rather than failing. +- Tactic injection has become more powerful (closes bug #4890) and its + documentation has been updated. +- New variants of the `first` and `solve` tacticals that do not rely + on parsing rules, meant to define tactic notations. +- Added support for side effects hooks in `cbv`, `cbn` and `simpl`. + The side effects are provided via a plugin: + https://github.com/herbelin/reduction-effects/ +- It is now possible to take hint database names as parameters in a + Ltac definition or a Tactic Notation. +- New option `Set Ltac Batch Debug` on top of `Set Ltac Debug` for + non-interactive Ltac debug output. + +Gallina + +- Now supporting all kinds of binders, including 'pat, in syntax of record fields. + +Vernacular Commands + +- Goals context can be printed in a more compact way when `Set + Printing Compact Contexts` is activated. +- Unfocused goals can be printed with the `Set Printing Unfocused` + option. +- `Print` now shows the types of let-bindings. +- The compatibility options for printing primitive projections + (`Set Printing Primitive Projection Parameters` and + `Set Printing Primitive Projection Compatibility`) are now off by default. +- Possibility to unset the printing of notations in a more fine grained + fashion than `Unset Printing Notations` is provided without any + user-syntax. The goal is that someone creates a plugin to experiment + such a user-syntax, to be later integrated in Coq when stabilized. +- `About` now tells if a reference is a coercion. +- The deprecated `Save` vernacular and its form `Save Theorem id` to + close proofs have been removed from the syntax. Please use `Qed`. +- `Search` now sorts results by relevance (the relevance metric is a + weighted sum of number of distinct symbols and size of the term). + +Standard Library + +- New file PropExtensionality.v to explicitly work in the axiomatic + context of propositional extensionality. +- New file SetoidChoice.v axiomatically providing choice over setoids, + and, consequently, choice of representatives in equivalence classes. + Various proof-theoretic characterizations of choice over setoids in + file ChoiceFacts.v. +- New lemmas about iff and about orders on positive and Z. +- New lemmas on powerRZ. +- Strengthened statement of JMeq_eq_dep (closes bug #4912). +- The BigN, BigZ, BigZ libraries are no longer part of the Coq standard + library, they are now provided by a separate repository + https://github.com/coq/bignums + The split has been done just after the Int31 library. + +- IZR (Reals) has been changed to produce a compact representation of + integers. As a consequence, IZR is no longer convertible to INR and + lemmas such as INR_IZR_INZ should be used instead. +- Real constants are now represented using IZR rather than R0 and R1; + this might cause rewriting rules to fail to apply to constants. +- Added new notation {x & P} for sigT (without a type for x) + +Plugins + +- The Ssreflect plugin is now distributed with Coq. Its documentation has + been integrated as a chapter of the reference manual. This chapter is + work in progress so feedback is welcome. +- The mathematical proof language (also known as declarative mode) was removed. +- A new command Extraction TestCompile has been introduced, not meant + for the general user but instead for Coq's test-suite. +- The extraction plugin is no longer loaded by default. It must be + explicitly loaded with [Require Extraction], which is backwards + compatible. +- The functional induction plugin (which provides the [Function] + vernacular) is no longer loaded by default. It must be explicitly + loaded with [Require FunInd], which is backwards compatible. + + +Dependencies + +- Support for camlp4 has been removed. + +Tools + +- coq_makefile was completely redesigned to improve its maintainability and + the extensibility of generated Makefiles, and to make _CoqProject files + more palatable to IDEs. Overview: + * _CoqProject files contain only Coq specific data (i.e. the list of + files, -R options, ...) + * coq_makefile translates _CoqProject to Makefile.conf and copies in the + desired location a standard Makefile (that reads Makefile.conf) + * Makefile extensions can be implemented in a Makefile.local file (read + by the main Makefile) by installing a hook in the extension points + provided by the standard Makefile + The current version contains code for retro compatibility that prints + warnings when a deprecated feature is used. Please upgrade your _CoqProject + accordingly. + * Additionally, coq_makefile-made Makefiles now support experimental timing + targets `pretty-timed`, `pretty-timed-before`, `pretty-timed-after`, + `print-pretty-timed-diff`, `print-pretty-single-time-diff`, + `all.timing.diff`, and the variable `TIMING=1` (or `TIMING=before` or + `TIMING=after`); see the documentation for more details. + +Build Infrastructure + +- Note that 'make world' does not build the bytecode binaries anymore. + For that, you can use 'make byte' (and 'make install-byte' afterwards). + Warning: native and byte compilations should *not* be mixed in the same + instance of 'make -j', otherwise both ocamlc and ocamlopt might race for + access to the same .cmi files. In short, use "make -j && make -j byte" + instead of "make -j world byte". + +Universes + +- Cumulative inductive types. see prefixes "Cumulative", "NonCumulative" + for inductive definitions and the option "Set Polymorphic Inductive Cumulativity" + in the reference manual. +- New syntax `foo@{_}` to instantiate a polymorphic definition with + anonymous universes (can also be used with `Type`). + +XML Protocol and internal changes + +See dev/doc/changes.txt + +Many bugfixes including #1859, #2884, #3613, #3943, #3994, +#4250, #4709, #4720, #4824, #4844, #4911, #5026, #5233, +#5275, #5315, #5336, #5360, #5390, #5414, #5417, #5420, +#5439, #5449, #5475, #5476, #5482, #5501, #5507, #5520, +#5523, #5524, #5553, #5577, #5578, #5589, #5597, #5598, +#5607, #5618, #5619, #5620, #5641, #5648, #5651, #5671. + +Many bugfixes on OS X and Windows (now the test-suite passes on these +platforms too). + +Many optimizations. + +Many documentation improvements. + +Changes from 8.6 to 8.6.1 +========================= + +- Fix #5380: Default colors for CoqIDE are actually applied. +- Fix plugin warnings +- Document named evars (including Show ident) +- Fix Bug #5574, document function scope +- Adding a test case as requested in bug 5205. +- Fix Bug #5568, no dup notation warnings on repeated module imports +- Fix documentation of Typeclasses eauto := +- Refactor documentation of records. +- Protecting from warnings while compiling 8.6 +- Fixing an inconsistency between configure and configure.ml +- Add test-suite checks for coqchk with constraints +- Fix bug #5019 (looping zify on dependent types) +- Fix bug 5550: "typeclasses eauto with" does not work with section variables. +- Bug 5546, qualify datatype constructors when needed in Show Match +- Bug #5535, test for Show with -emacs +- Fix bug #5486, don't reverse ids in tuples +- Fixing #5522 (anomaly with free vars of pat) +- Fix bug #5526, don't check for nonlinearity in notation if printing only +- Fix bug #5255 +- Fix bug #3659: -time should understand multibyte encodings. +- FIx bug #5300: Anomaly: Uncaught exception Not_found" in "Print Assumptions". +- Fix outdated description in RefMan. +- Repairing `Set Rewriting Schemes` +- Fixing #5487 (v8.5 regression on ltac-matching expressions with evars). +- Fix description of command-line arguments for Add (Rec) LoadPath +- Fix bug #5377: @? patterns broken. +- add XML protocol doc +- Fix anomaly when doing [all:Check _.] during a proof. +- Correction of bug #4306 +- Fix #5435: [Eval native_compute in] raises anomaly. +- Instances should obey universe binders even when defined by tactics. +- Intern names bound in match patterns +- funind: Ignore missing info for current function +- Do not typecheck twice the type of opaque constants. +- show unused intro pattern warning +- [future] Be eager when "chaining" already resolved future values. +- Opaque side effects +- Fix #5132: coq_makefile generates incorrect install goal +- Run non-tactic comands without resilient_command +- Univs: fix bug #5365, generation of u+k <= v constraints +- make `emit' tail recursive +- Don't require printing-only notation to be productive +- Fix the way setoid_rewrite handles bindings. +- Fix for bug 5244 - set printing width ignored when given enough space +- Fix bug 4969, autoapply was not tagging shelved subgoals correctly + +Changes from V8.6beta1 to V8.6 +============================== + +Kernel + +- Fixed critical bug #5248 in VM long multiplication on 32-bit + architectures. Was there only since 8.6beta1, so no stable release impacted. + +Other bug fixes in universes, type class shelving,... + +Changes from V8.5 to V8.6beta1 +============================== + +Kernel + +- A new, faster state-of-the-art universe constraint checker. + +Specification language + +- Giving implicit arguments explicitly to a constant with multiple + choices of implicit arguments does not break any more insertion of + further maximal implicit arguments. +- Ability to put any pattern in binders, prefixed by quote, e.g. + "fun '(a,b) => ...", "λ '(a,(b,c)), ...", "Definition foo '(x,y) := ...". + It expands into a "let 'pattern := ..." + +Tactics + +- Flag "Bracketing Last Introduction Pattern" is now on by default. +- Flag "Regular Subst Tactic" is now on by default: it respects the + initial order of hypothesis, it contracts cycles, it unfolds no + local definitions (common source of incompatibilities, fixable by + "Unset Regular Subst Tactic"). +- New flag "Refolding Reduction", now disabled by default, which turns + on refolding of constants/fixpoints (as in cbn) during the reductions + done during type inference and tactic retyping. Can be extremely + expensive. When set off, this recovers the 8.4 behaviour of unification + and type inference. Potential source of incompatibility with 8.5 developments + (the option is set on in Compat/Coq85.v). +- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract + tactical w.r.t. variables appearing in the body of the proof. + On by default and deprecated. Minor source of incompatibility + for code relying on the precise arguments of abstracted proofs. +- Serious bugs are fixed in tactic "double induction" (source of + incompatibilities as soon as the inductive types have dependencies in + the type of their constructors; "double induction" remains however + deprecated). +- In introduction patterns of the form (pat1,...,patn), n should match + the exact number of hypotheses introduced (except for local definitions + for which pattern can be omitted, as in regular pattern-matching). +- Tactic scopes in Ltac like constr: and ltac: now require parentheses around + their argument. +- Every generic argument type declares a tactic scope of the form "name:(...)" + where name is the name of the argument. This generalizes the constr: and ltac: + instances. +- When in strict mode (i.e. in a Ltac definition), if the "intro" tactic is + given a free identifier, it is not bound in subsequent tactics anymore. + In order to introduce a binding, use e.g. the "fresh" primitive instead + (potential source of incompatibilities). +- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac. +- New goal selectors. Sets of goals can be selected by listing integers + ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. +- For uniformity with "destruct"/"induction" and for a more natural + behavior, "injection" can now work in place by activating option + "Structural Injection". In this case, hypotheses are also put in the + context in the natural left-to-right order and the hypothesis on + which injection applies is cleared. +- Tactic "contradiction" (hence "easy") now also solve goals with + hypotheses of the form "~True" or "t<>t" (possible source of + incompatibilities because of more successes in automation, but + generally a more intuitive strategy). +- Option "Injection On Proofs" was renamed "Keep Proof Equalities". When + enabled, injection and inversion do not drop equalities between objects + in Prop. Still disabled by default. +- New tactics "notypeclasses refine" and "simple notypeclasses refine" that + disallow typeclass resolution when typechecking their argument, for use + in typeclass hints. +- Integration of LtacProf, a profiler for Ltac. +- Reduction tactics now accept more fine-grained flags: iota is now a shorthand + for the new flags match, fix and cofix. +- The ssreflect subterm selection algorithm is now accessible to tactic writers + through the ssrmatching plugin. +- When used as an argument of an ltac function, "auto" without "with" + nor "using" clause now correctly uses only the core hint database by + default. + +Hints + +- Revised the syntax of [Hint Cut] to follow standard notation for regexps. +- Hint Mode now accepts "!" which means that the mode matches only if the + argument's head is not an evar (it goes under applications, casts, and + scrutinees of matches and projections). +- Hints can now take an optional user-given pattern, used only by + [typeclasses eauto] with the [Filtered Unification] option on. + +Typeclasses + +- Many new options and new engine based on the proof monad. The + [typeclasses eauto] tactic is now a multi-goal, multi-success tactic. + See reference manual for more information. It is planned to + replace auto and eauto in the following version. The 8.5 resolution + engine is still available to help solve compatibility issues. + +Program + +- The "Shrink Obligations" flag now applies to all obligations, not only + those solved by the automatic tactic. +- "Shrink Obligations" is on by default and deprecated. Minor source of + incompatibility for code relying on the precise arguments of + obligations. + +Notations + +- "Bind Scope" can once again bind "Funclass" and "Sortclass". + +General infrastructure + +- New configurable warning system which can be controlled with the vernacular + command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In + particular, the default is now that warnings are printed by coqc. +- In asynchronous mode, Coq is now capable of recovering from errors and + continue processing the document. + +Tools + +- coqc accepts a -o option to specify the output file name +- coqtop accepts --print-version to print Coq and OCaml versions in + easy to parse format +- Setting [Printing Dependent Evars Line] can be unset to disable the + computation associated with printing the "dependent evars: " line in + -emacs mode +- Removed the -verbose-compat-notations flag and the corresponding Set + Verbose Compat vernacular, since these warnings can now be silenced or + turned into errors using "-w". + +XML protocol + +- message format has changed, see dev/doc/changes.txt for more details. + +Many bug fixes, minor changes and documentation improvements are not mentioned +here. + +Changes from V8.5pl2 to V8.5pl3 +=============================== + +Critical bugfix + +- #4876: Guard checker incompleteness when using primitive projections + +Other bugfixes + +- #4780: Induction with universe polymorphism on was creating ill-typed terms. +- #4673: regression in setoid_rewrite, unfolding let-ins for type unification. +- #4754: Regression in setoid_rewrite, allow postponed unification problems to remain. +- #4769: Anomaly with universe polymorphic schemes defined inside sections. +- #3886: Program: duplicate obligations of mutual fixpoints. +- #4994: Documentation typo. +- #5008: Use the "md5" command on OpenBSD. +- #5007: Do not assume the "TERM" environment variable is always set. +- #4606: Output a break before a list only if there was an empty line. +- #5001: metas not cleaned properly in clenv_refine_in. +- #2336: incorrect glob data for module symbols (bug #2336). +- #4832: Remove extraneous dot in error message. +- Anomaly in printing a unification error message. +- #4947: Options which take string arguments are not backwards compatible. +- #4156: micromega cache files are now hidden files. +- #4871: interrupting par:abstract kills coqtop. +- #5043: [Admitted] lemmas pick up section variables. +- Fix name of internal refine ("simple refine"). +- #5062: probably a typo in Strict Proofs mode. +- #5065: Anomaly: Not a proof by induction. +- Restore native compiler optimizations, they were disabled since 8.5! +- #5077: failure on typing a fixpoint with evars in its type. +- Fix recursive notation bug. +- #5095: non relevant too strict test in let-in abstraction. +- Ensuring that the evar name is preserved by "rename". +- #4887: confusion between using and with in documentation of firstorder. +- Bug in subst with let-ins. +- #4762: eauto weaker than auto. +- Remove if_then_else (was buggy). Use tryif instead. +- #4970: confusion between special "{" and non special "{{" in notations. +- #4529: primitive projections unfolding. +- #4416: Incorrect "Error: Incorrect number of goals". +- #4863: abstract in typeclass hint fails. +- #5123: unshelve can impact typeclass resolution +- Fix a collision about the meta-variable ".." in recursive notations. +- Fix printing of info_auto. +- #3209: Not_found due to an occur-check cycle. +- #5097: status of evars refined by "clear" in ltac: closed wrt evars. +- #5150: Missing dependency of the test-suite subsystems in prerequisite. +- Fix a bug in error printing of unif constraints +- #3941: Do not stop propagation of signals when Coq is busy. +- #4822: Incorrect assertion in cbn. +- #3479 parsing of "{" and "}" when a keyword starts with "{" or "}". +- #5127: Memory corruption with the VM. +- #5102: bullets parsing broken by calls to parse_entry. + +Various documentation improvements + + +Changes from V8.5pl1 to V8.5pl2 +=============================== + +Critical bugfix +- Checksums of .vo files dependencies were not correctly checked. +- Unicode-to-ASCII translation was not injective, leading in a soundness bug in + the native compiler. + +Other bugfixes + +- #4097: more efficient occur-check in presence of primitive projections +- #4398: type_scope used consistently in "match goal". +- #4450: eauto does not work with polymorphic lemmas +- #4677: fix alpha-conversion in notations needing eta-expansion. +- Fully preserve initial order of hypotheses in "Regular Subst Tactic" mode. +- #4644: a regression in unification. +- #4725: Function (Error: Conversion test raised an anomaly) and Program + (Error: Cannot infer this placeholder of type) +- #4747: Problem building Coq 8.5pl1 with OCaml 4.03.0: Fatal warnings +- #4752: CoqIDE crash on files not ended by ".v". +- #4777: printing inefficiency with implicit arguments +- #4818: "Admitted" fails due to undefined universe anomaly after calling + "destruct" +- #4823: remote counter: avoid thread race on sockets +- #4841: -verbose flag changed semantics in 8.5, is much harder to use +- #4851: [nsatz] cannot handle duplicated hypotheses +- #4858: Anomaly: Uncaught exception Failure("hd"). Please report. in variant + of nsatz +- #4880: [nsatz_compute] generates invalid certificates if given redundant + hypotheses +- #4881: synchronizing "Declare Implicit Tactic" with backtrack. +- #4882: anomaly with Declare Implicit Tactic on hole of type with evars +- Fix use of "Declare Implicit Tactic" in refine. + triggered by CoqIDE +- #4069, #4718: congruence fails when universes are involved. + +Universes +- Disallow silently dropping universe instances applied to variables + (forward compatible) +- Allow explicit universe instances on notations, when they can apply + to the head reference of their expansion. + +Build infrastructure +- New update on how to find camlp5 binary and library at configure time. + +Changes from V8.5 to V8.5pl1 +============================ + +Critical bugfix +- The subterm relation for the guard condition was incorrectly defined on + primitive projections (#4588) + +Plugin development tools +- add a .merlin target to the makefile + +Various performance improvements (time, space used by .vo files) + +Other bugfixes + +- Fix order of arguments to Big.compare_case in ExtrOcamlZBigInt.v +- Added compatibility coercions from Specif.v which were present in Coq 8.4. +- Fixing a source of inefficiency and an artificial dependency in the printer in the congruence tactic. +- Allow to unset the refinement mode of Instance in ML +- Fixing an incorrect use of prod_appvect on a term which was not a product in setoid_rewrite. +- Add -compat 8.4 econstructor tactics, and tests +- Add compatibility Nonrecursive Elimination Schemes +- Fixing the "No applicable tactic" non informative error message regression on apply. +- Univs: fix get_current_context (bug #4603, part I) +- Fix a bug in Program coercion code +- Fix handling of arity of definitional classes. +- #4630: Some tactics are 20x slower in 8.5 than 8.4. +- #4627: records with no declared arity can be template polymorphic. +- #4623: set tactic too weak with universes (regression) +- Fix incorrect behavior of CS resolution +- #4591: Uncaught exception in directory browsing. +- CoqIDE is more resilient to initialization errors. +- #4614: "Fully check the document" is uninterruptable. +- Try eta-expansion of records only on non-recursive ones +- Fix bug when a sort is ascribed to a Record +- Primitive projections: protect kernel from erroneous definitions. +- Fixed bug #4533 with previous Keyed Unification commit +- Win: kill unreliable hence do not waitpid after kill -9 (Close #4369) +- Fix strategy of Keyed Unification +- #4608: Anomaly "output_value: abstract value (outside heap)". +- #4607: do not read native code files if native compiler was disabled. +- #4105: poor escaping in the protocol between CoqIDE and coqtop. +- #4596: [rewrite] broke in the past few weeks. +- #4533 (partial): respect declared global transparency of projections in unification.ml +- #4544: Backtrack on using full betaiota reduction during keyed unification. +- #4540: CoqIDE bottom progress bar does not update. +- Fix regression from 8.4 in reflexivity +- #4580: [Set Refine Instance Mode] also used for Program Instance. +- #4582: cannot override notation [ x ]. MAY CREATE INCOMPATIBILITIES, see #4683. +- STM: Print/Extraction have to be skipped if -quick +- #4542: CoqIDE: STOP button also stops workers +- STM: classify some variants of Instance as regular `Fork nodes. +- #4574: Anomaly: Uncaught exception Invalid_argument("splay_arity"). +- Do not give a name to anonymous evars anymore. See bug #4547. +- STM: always stock in vio files the first node (state) of a proof +- STM: not delegate proofs that contain Vernac(Module|Require|Import), #4530 +- Don't fail fatally if PATH is not set. +- #4537: Coq 8.5 is slower in typeclass resolution. +- #4522: Incorrect "Warning..." on windows. +- #4373: coqdep does not know about .vio files. +- #3826: "Incompatible module types" is uninformative. +- #4495: Failed assertion in metasyntax.ml. +- #4511: evar tactic can create non-typed evars. +- #4503: mixing universe polymorphic and monomorphic variables and definitions in sections is unsupported. +- #4519: oops, global shadowed local universe level bindings. +- #4506: Anomaly: File "pretyping/indrec.ml", line 169, characters 14-20: Assertion failed. +- #4548: Coqide crashes when going back one command + +Changes from V8.5beta3 to V8.5 +============================== + +Tools + +- Flag "-compat 8.4" now loads Coq.Compat.Coq84. The standard way of + putting Coq in v8.4 compatibility mode is to pass the command line flag + "-compat 8.4". It can be followed by "-require Coq.Compat.AdmitAxiom" + if the 8.4 behavior of admit is needed, in which case it uses an axiom. + +Specification language + +- Syntax "$(tactic)$" changed to "ltac:(tactic)". + +Tactics + +- Syntax "destruct !hyp" changed to "destruct (hyp)", and similarly + for induction (rare source of incompatibilities easily solvable by + removing parentheses around "hyp" when not for the purpose of keeping + the hypothesis). +- Syntax "p/c" for on-the-fly application of a lemma c before + introducing along pattern p changed to p%c1..%cn. The feature and + syntax are in experimental stage. +- "Proof using" does not clear unused section variables. +- Tactic "refine" has been changed back to the 8.4 behavior of shelving subgoals + that occur in other subgoals. The "refine" tactic of 8.5beta3 has been + renamed "simple refine"; it does not shelve any subgoal. +- New tactical "unshelve tac" which grab existential variables put on + the tactic shelve by the execution of "tac". + +Changes from V8.5beta2 to V8.5beta3 +=================================== + +Vernacular commands + +- New command "Redirect" to redirect the output of a command to a file. +- New command "Undelimit Scope" to remove the delimiter of a scope. +- New option "Strict Universe Declaration", set by default. It enforces the + declaration of all polymorphic universes appearing in a definition when + introducing it. +- New command "Show id" to show goal named id. +- Option "Virtual Machine" removed. + +Tactics + +- New flag "Regular Subst Tactic" which fixes "subst" in situations where + it failed to substitute all substitutable equations or failed to simplify + cycles, or accidentally unfolded local definitions (flag is off by default). +- New flag "Loose Hint Behavior" to handle hints loaded but not imported in a + special way. It accepts three distinct flags: + * "Lax", which is the default one, sets the old behavior, i.e. a non-imported + hint behaves the same as an imported one. + * "Warn" outputs a warning when a non-imported hint is used. Note that this is + an over-approximation, because a hint may be triggered by an eauto run that + will eventually fail and backtrack. + * "Strict" changes the behavior of an unloaded hint to the one of the fail + tactic, allowing to emulate the hopefully future import-scoped hint mechanism. +- New compatibility flag "Universal Lemma Under Conjunction" which + let tactics working under conjunctions apply sublemmas of the form + "forall A, ... -> A". +- New compatibility flag "Bracketing Last Introduction Pattern" which can be + set so that the last disjunctive-conjunctive introduction pattern given to + "intros" automatically complete the introduction of its subcomponents, as the + the disjunctive-conjunctive introduction patterns in non-terminal position + already do. +- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract + tactical w.r.t. variables appearing in the body of the proof. + +Program + +- The "Shrink Obligations" flag now applies to all obligations, not only those +solved by the automatic tactic. +- Importing Program no longer overrides the "exists" tactic (potential source + of incompatibilities). +- Hints costs are now correctly taken into account (potential source of + incompatibilities). +- Documented the Hint Cut command that allows control of the + proof-search during typeclass resolution (see reference manual). + +API + +- Some functions from pretyping/typing.ml and their derivatives were potential + source of evarmap leaks, as they dropped their resulting evarmap. The + situation was clarified by renaming them according to a unsafe_* scheme. Their + sound variant is likewise renamed to their old name. The following renamings + were made. + * Typing.type_of -> unsafe_type_of + * Typing.e_type_of -> type_of + * A new e_type_of function that matches the e_ prefix policy + * Tacmach.pf_type_of -> pf_unsafe_type_of + * A new safe pf_type_of function. + All uses of unsafe_* functions should be eventually eliminated. + +Tools + +- Added an option -w to control the output of coqtop warnings. +- Configure now takes an optional -native-compiler (yes|no) flag replacing + -no-native-compiler. The new flag is set to no by default under Windows. +- Flag -no-native-compiler was removed and became the default for coqc. If + precompilation of files for native conversion test is desired, use + -native-compiler. +- The -compile command-line option now takes the full path of the considered + file, including the ".v" extension, and outputs a warning if such an extension + is lacking. +- The -require and -load-vernac-object command-line options now take a logical + path of a given library rather than a physical path, thus they behave like + Require [Import] path. +- The -vm command-line option has been removed. + +Standard Library + + - There is now a Coq.Compat.Coq84 library, which sets the various compatibility + options and does a few redefinitions to make Coq behave more like Coq v8.4. + The standard way of putting Coq in v8.4 compatibility mode is to pass the command + line flags "-require Coq.Compat.Coq84 -compat 8.4". + +Changes from V8.5beta1 to V8.5beta2 +=================================== + +Logic + +- The VM now supports inductive types with up to 8388851 non-constant + constructors and up to 8388607 constant ones. + +Specification language + +- Syntax "$(tactic)$" changed to "ltac: tactic". + +Tactics + +- A script using the admit tactic can no longer be concluded by either + Qed or Defined. In the first case, Admitted can be used instead. In + the second case, a subproof should be used. +- The easy tactic and the now tactical now have a more predictable + behavior, but they might now discharge some previously unsolved goals. + +Extraction + +- Definitions extracted to Haskell GHC should no longer randomly + segfault when some Coq types cannot be represented by Haskell types. +- Definitions can now be extracted to Json for post-processing. + +Tools + +- Option -I -as has been removed, and option -R -as has been + deprecated. In both cases, option -R can be used instead. +- coq_makefile now generates double-colon rules for rules such as clean. + +API + +- The interface of [change] has changed to take a [change_arg], which + can be built from a [constr] using [make_change_arg]. + +Changes from V8.4 to V8.5beta1 +============================== + +Logic + +- Primitive projections for records allow for a compact representation + of projections, without parameters and avoid the behavior of defined + projections that can unfold to a case expression. To turn the use of + native projections on, use [Set Primitive Projections]. Record, + Class and Structure types defined while this option is set will be + defined with primitive projections instead of the usual encoding as + a case expression. For compatibility, when p is a primitive + projection, @p can be used to refer to the projection with explicit + parameters, i.e. [@p] is definitionally equal to [λ params r. r.(p)]. + Records with primitive projections have eta-conversion, the + canonical form being [mkR pars (p1 t) ... (pn t)]. +- New universe polymorphism (see reference manual) +- New option -type-in-type to collapse the universe hierarchy (this makes the + logic inconsistent). +- The guard condition for fixpoints is now a bit stricter. Propagation + of subterm value through pattern matching is restricted according to + the return predicate. Restores compatibility of Coq's logic with the + propositional extensionality axiom. May create incompatibilities in + recursive programs heavily using dependent types. +- Trivial inductive types are no longer defined in Type but in Prop, which + leads to a non-dependent induction principle being generated in place of + the dependent one. To recover the old behavior, explicitly define your + inductive types in Set. + +Vernacular commands + +- A command "Variant" allows to define non-recursive variant types. +- The command "Record foo ..." does not generate induction principles + (foo_rect, foo_rec, foo_ind) anymore by default (feature wish + #2693). The command "Variant foo ..." does not either. A flag + "Set/Unset Nonrecursive Elimination Schemes" allows changing this. + The tactic "induction" on a "Record" or a "Variant" is now actually + doing "destruct". +- The "Open Scope" command can now be given also a delimiter (e.g. Z). +- The "Definition" command now allows the "Local" modifier, allowing + for non-importable definitions. The same goes for "Axiom" and "Parameter". +- Section-specific commands such as "Let" (resp. "Variable", "Hypothesis") used + out of a section now behave like the corresponding "Local" command, i.e. + "Local Definition" (resp. "Local Parameter", "Local Axiom"). (potential source + of rare incompatibilities). +- The "Let" command can now define local (co)fixpoints. +- Command "Search" has been renamed into "SearchHead". The command + name "Search" now behaves like former "SearchAbout". The latter name + is deprecated. +- "Search", "About", "SearchHead", "SearchRewrite" and "SearchPattern" + now search for hypothesis (of the current goal by default) first. + They now also support the goal selector prefix to specify another + goal to search: e.g. "n:Search id". This is also true for + SearchAbout although it is deprecated. +- The coq/user-contrib directory and the XDG directories are no longer + recursively added to the load path, so files from installed libraries + now need to be fully qualified for the "Require" command to find them. + The tools/update-require script can be used to convert a development. +- A new Print Strategies command allows visualizing the opacity status + of the whole engine. +- The "Locate" command now searches through all sorts of qualified namespaces of + Coq: terms, modules, tactics, etc. The old behavior of the command can be + retrieved using the "Locate Term" command. +- New "Derive" command to help writing program by derivation. +- New "Refine Instance Mode" option that allows to deactivate the generation of + obligations in incomplete typeclass instances, raising an error instead. +- "Collection" command to name sets of section hypotheses. Named collections + can be used in the syntax of "Proof using" to assert which section variables + are used in a proof. +- The "Optimize Proof" command can be placed in the middle of a proof to + force the compaction of the data structure used to represent the ongoing + proof (evar map). This may result in a lower memory footprint and speed up + the execution of the following tactics. +- "Optimize Heap" command to tell the OCaml runtime to perform a major + garbage collection step and heap compaction. +- "Instance" no longer treats the {|...|} syntax specially; it handles it + in the same way as other commands, e.g. "Definition". Use the {...} + syntax (no pipe symbols) to recover the old behavior. + +Specification Language + +- Slight changes in unification error messages. +- Added a syntax $(...)$ that allows putting tactics in terms (may + break user notations using "$(", fixable by inserting a space or + rewriting the notation). +- Constructors in pattern-matching patterns now respect the same rules + regarding implicit arguments as in applicative position. The old + behavior can be recovered by the command "Set Asymmetric + Patterns". As a side effect, notations for constructors explicitly + mentioning non-implicit parameters can now be used in patterns. + Considering that the pattern language is already rich enough, binding + local definitions is however now forbidden in patterns (source of + incompatibilities for local definitions that delta-reduce to a constructor). +- Type inference algorithm now granting opacity of constants. This might also + affect behavior of tactics (source of incompatibilities, solvable by + re-declaring transparent constants which were set opaque). +- Existential variables are now referred to by an identifier and the + relevant part of their instance is displayed by default. They can be + reparsed. The naming policy is yet unstable and subject to changes + in future releases. + +Tactics + +- New tactic engine allowing dependent subgoals, fully backtracking + (also known as multiple success) tactics, as well as tactics which + can consider multiple goals together. In the new tactic engine, + instantiation information of existential variables is always + propagated to tactics, removing the need to manually use the + "instantiate" tactics to mark propagation points. + * New tactical (a+b) inserts a backtracking point. When (a+b);c fails + during the execution of c, it can backtrack and try b instead of a. + * New tactical (once a) removes all the backtracking points from a + (i.e. it selects the first success of a). + * Tactic "constructor" is now fully backtracking. In case of + incompatibilities (e.g. combinatoric explosion), the former + behavior of "constructor" can be retrieved by using instead + "[> once constructor ..]". Thanks to backtracking, undocumented + "constructor <tac>" syntax is now equivalent to + "[> once (constructor; tac) ..]". + * New "multimatch" variant of "match" tactic which backtracks to + new branches in case of a later failure. The "match" tactic is + equivalent to "once multimatch". + * New selector "all:" such that "all:tac" applies tactic "tac" to + all the focused goals, instead of just the first one as is the + default. + * A corresponding new option Set Default Goal Selector "all" makes + the tactics in scripts be applied to all the focused goal by default + * New selector "par:" such that "par:tac" applies the (terminating) + tactic "tac" to all the focused goal in parallel. The number of worker + can be selected with -async-proofs-tac-j and also limited using the + coqworkmgr utility. + * New tactics "revgoals", "cycle" and "swap" to reorder goals. + * The semantics of recursive tactics (introduced with "Ltac t := ..." + or "let rec t := ... in ...") changed slightly as t is now + applied to every goal, not each goal independently. In particular + it may be applied when no goals are left. This may cause tactics + such as "let rec t := constructor;t" to loop indefinitely. The + simple fix is to rewrite the recursive calls as follows: + "let rec t := constructor;[t..]" which recovers the earlier behavior + (source of rare incompatibilities). + * New tactic language feature "numgoals" to count number of goals. It is + accompanied by a "guard" tactic which fails if a Boolean test over + integers does not pass. + * New tactical "[> ... ]" to apply tactics to individual goals. + * New tactic "gfail" which works like "fail" except it will also + fail if every goal has been solved. + * The refine tactic is changed not to use an ad hoc typing algorithm + to generate subgoals. It also uses the dependent subgoal feature + to generate goals to materialize every existential variable which + is introduced by the refinement (source of incompatibilities). + * A tactic shelve is introduced to manage the subgoals which may be + solved by unification: shelve removes every goal it is applied to + from focus. These goals can later be called back into focus by the + Unshelve command. + * A variant shelve_unifiable only removes those goals which appear + as existential variables in other goals. To emulate the old + refine, use "refine c;shelve_unifiable". This can still cause + incompatibilities in rare occasions. + * New "give_up" tactic to skip over a goal. A proof containing + given up goals cannot be closed with "Qed", but only with "Admitted". +- The implementation of the admit tactic has changed: no axiom is + generated for the admitted sub proof. "admit" is now an alias for + "give_up". Code relying on this specific behavior of "admit" + can be made to work by: + * Adding an "Axiom" for each admitted subproof. + * Adding a single "Axiom proof_admitted : False." and the Ltac definition + "Ltac admit := case proof_admitted.". +- Matching using "lazymatch" was fundamentally modified. It now behaves + like "match" (immediate execution of the matching branch) but without + the backtracking mechanism in case of failure. +- New "tryif t then u else v" tactical which executes "u" in case of success + of "t" and "v" in case of failure. +- New conversion tactic "native_compute": evaluates the goal (or an hypothesis) + with a call-by-value strategy, using the OCaml native compiler. Useful on + very intensive computations. +- New "cbn" tactic, a well-behaved simpl. +- Repeated identical calls to omega should now produce identical proof terms. +- Tactics btauto, a reflexive Boolean tautology solver. +- Tactic "tauto" was exceptionally able to destruct other connectives + than the binary connectives "and", "or", "prod", "sum", "iff". This + non-uniform behavior has been fixed (bug #2680) and tauto is + slightly weaker (possible source of incompatibilities). On the + opposite side, new tactic "dtauto" is able to destruct any + record-like inductive types, superseding the old version of "tauto". +- Similarly, "intuition" has been made more uniform and, where it now + fails, "dintuition" can be used (possible source of incompatibilities). +- New option "Unset Intuition Negation Unfolding" for deactivating automatic + unfolding of "not" in intuition. +- Tactic notations can now be defined locally to a module (use "Local" prefix). +- Tactic "red" now reduces head beta-iota redexes (potential source of + rare incompatibilities). +- Tactic "hnf" now reduces inner beta-iota redexes + (potential source of rare incompatibilities). +- Tactic "intro H" now reduces beta-iota redexes if these hide a product + (potential source of rare incompatibilities). +- In Ltac matching on patterns of the form "_ pat1 ... patn" now + behaves like if matching on "?X pat1 ... patn", i.e. accepting "_" + to be instantiated by an applicative term (experimental at this + stage, potential source of incompatibilities). +- In Ltac matching on goal, types of hypotheses are now interpreted in + the %type scope (possible source of incompatibilities). +- "change ... in ..." and "simpl ... in ..." now properly consider nested + occurrences (possible source of incompatibilities since this alters + the numbering of occurrences), but do not support nested occurrences. +- Tactics simpl, vm_compute and native_compute can be given a notation string + to a constant as argument. +- When given a reference as argument, simpl, vm_compute and + native_compute now strictly interpret it as the head of a pattern + starting with this reference. +- The "change p with c" tactic semantics changed, now type-checking + "c" at each matching occurrence "t" of the pattern "p", and + converting "t" with "c". +- Now "appcontext" and "context" behave the same. The old buggy behavior of + "context" can be retrieved at parse time by setting the + "Tactic Compat Context" flag (possible source of incompatibilities). +- New introduction pattern p/c which applies lemma c on the fly on the + hypothesis under consideration before continuing with introduction pattern p. +- New introduction pattern [= x1 .. xn] applies "injection as [x1 .. xn]" + on the fly if injection is applicable to the hypothesis under consideration + (idea borrowed from Georges Gonthier). Introduction pattern [=] applies + "discriminate" if a discriminable equality. +- New introduction patterns * and ** to respectively introduce all forthcoming + dependent variables and all variables/hypotheses dependent or not. +- Tactic "injection c as ipats" now clears c if c refers to an + hypothesis and moves the resulting equations in the hypotheses + independently of the number of ipats, which has itself to be less + than the number of new hypotheses (possible source of incompatibilities; + former behavior obtainable by "Unset Injection L2R Pattern Order"). +- Tactic "injection" now automatically simplifies subgoals + "existT n p = existT n p'" into "p = p'" when "n" is in an inductive type for + which a decidable equality scheme has been generated with "Scheme Equality" + (possible source of incompatibilities). +- New tactic "rewrite_strat" for generalized rewriting with user-defined + strategies, subsuming autorewrite. +- Injection can now also deduce equality of arguments of sort Prop, by using + the option "Set Injection On Proofs" (disabled by default). Also improved the + error messages. +- Tactic "subst id" now supports id occurring in dependent local definitions. +- Bugs fixed about intro-pattern "*" might lead to some rare incompatibilities. +- New tactical "time" to display time spent executing its argument. +- Tactics referring or using a constant dependent in a section variable which + has been cleared or renamed in the current goal context now fail + (possible source of incompatibilities solvable by avoiding clearing + the relevant hypotheses). +- New construct "uconstr:c" and "type_term c" to build untyped terms. +- Binders in terms defined in Ltac (either "constr" or "uconstr") can + now take their names from identifiers defined in Ltac. As a + consequence, a name cannot be used in a binder "constr:(fun x => + ...)" if an Ltac variable of that name already exists and does not + contain an identifier. Source of occasional incompatibilities. +- The "refine" tactic now accepts untyped terms built with "uconstr" + so that terms with holes can be constructed piecewise in Ltac. +- New bullets --, ++, **, ---, +++, ***, ... made available. +- More informative messages when wrong bullet is used. +- Bullet suggestion when a subgoal is solved. +- New tactic "enough", symmetric to "assert", but with subgoals + swapped, as a more friendly replacement of "cut". +- In destruct/induction, experimental modifier "!" prefixing the + hypothesis name to tell not erasing the hypothesis. +- Bug fixes in "inversion as" may occasionally lead to incompatibilities. +- Behavior of introduction patterns -> and <- made more uniform + (hypothesis is cleared, rewrite in hypotheses and conclusion and + erasing the variable when rewriting a variable). +- New experimental option "Set Standard Proposition Elimination Names" + so that case analysis or induction on schemes in Type containing + propositions now produces "H"-based names. +- Tactics from plugins are now active only when the corresponding module + is imported (source of incompatibilities, solvable by adding an "Import"; + in the particular case of Omega, use "Require Import OmegaTactic"). +- Semantics of destruct/induction has been made more regular in some + edge cases, possibly leading to incompatibilities: + - new goals are now opened when the term does not match a subterm of + the goal and has unresolved holes, while in 8.4 these holes were + turned into existential variables + - when no "at" option is given, the historical semantics which + selects all subterms syntactically identical to the first subterm + matching the given pattern is used + - non-dependent destruct/induction on an hypothesis with premises in + an inductive type with indices is fixed + - residual local definitions are now correctly removed. +- The rename tactic may now replace variables in parallel. +- A new "Info" command replaces the "info" tactical discontinued in + v8.4. It still gives informative results in many cases. +- The "info_auto" tactic is known to be broken and does not print a + trace anymore. Use "Info 1 auto" instead. The same goes for + "info_trivial". On the other hand "info_eauto" still works fine, + while "Info 1 eauto" prints a trivial trace. +- When using a lemma of the prototypical form "forall A, {a:A & P a}", + "apply" and "apply in" do not instantiate anymore "A" with the + current goal and use "a" as the proof, as they were sometimes doing, + now considering that it is a too powerful decision. + +Program + +- "Solve Obligations using" changed to "Solve Obligations with", + consistent with "Proof with". +- Program Lemma, Definition now respect automatic introduction. +- Program Lemma, Definition, etc.. now interpret "->" like Lemma and + Definition as a non-dependent arrow (potential source of + incompatibility). +- Add/document "Set Hide Obligations" (to hide obligations in the final + term inside an implicit argument) and "Set Shrink Obligations" (to + minimize dependencies of obligations defined by tactics). + +Notations + +- The syntax "x -> y" is now declared at level 99. In particular, it has + now a lower priority than "<->": "A -> B <-> C" is now "A -> (B <-> C)" + (possible source of incompatibilities) +- Notations accept term-providing tactics using the $(...)$ syntax. +- "Bind Scope" can no longer bind "Funclass" and "Sortclass". +- A notation can be given a (compat "8.x") annotation, making it behave + like a "only parsing" notation, but the annotation may lead to eventually + issue warnings or errors in further versions when this notation is used. +- More systematic insertion of spaces as a default for printing + notations ("format" still available to override the default). +- In notations, a level modifier referring to a non-existent variable is + now considered an error rather than silently ignored. + +Tools + +- Option -I now only adds directories to the ml path. +- Option -Q behaves as -R, except that the logical path of any loaded file has + to be fully qualified. +- Option -R no longer adds recursively to the ml path; only the root + directory is added. (Behavior with respect to the load path is + unchanged.) +- Option -nois prevents coq/theories and coq/plugins to be recursively + added to the load path. (Same behavior as with coq/user-contrib.) +- coqdep accepts a -dumpgraph option generating a dot file. +- Makefiles generated through coq_makefile have three new targets "quick" + "checkproofs" and "vio2vo", allowing respectively to asynchronously compile + the files without playing the proof scripts, asynchronously checking + that the quickly generated proofs are correct and generating the object + files from the quickly generated proofs. +- The XML plugin was discontinued and removed from the source. +- A new utility called coqworkmgr can be used to limit the number of + concurrent workers started by independent processes, like make and CoqIDE. + This is of interest for users of the par: goal selector. + +Interfaces + +- CoqIDE supports asynchronous edition of the document, ongoing tasks and + errors are reported in the bottom right window. The number of workers + taking care of processing proofs can be selected with -async-proofs-j. +- CoqIDE highlights in yellow "unsafe" commands such as axiom + declarations, and tactics like "give_up". +- CoqIDE supports Proof General like key bindings; + to activate the PG mode go to Edit -> Preferences -> Editor. + For the documentation see Help -> Help for PG mode. +- CoqIDE automatically retracts the locked area when one edits the + locked text. +- CoqIDE search and replace got regular expressions power. See the + documentation of OCaml's Str module for the supported syntax. +- Many CoqIDE windows, including the query one, are now detachable to + improve usability on multi screen work stations. +- Coqtop/coqc outputs highlighted syntax. Colors can be configured thanks + to the COQ_COLORS environment variable, and their current state can + be displayed with the -list-tags command line option. +- Third party user interfaces can install their main loop in $COQLIB/toploop + and call coqtop with the -toploop flag to select it. + +Internal Infrastructure + +- Many reorganizations in the ocaml source files. For instance, + many internal a.s.t. of Coq are now placed in mli files in + a new directory intf/, for instance constrexpr.mli or glob_term.mli. + More details in dev/doc/changes. +- The file states/initial.coq does not exist anymore. Instead, coqtop + initially does a "Require" of Prelude.vo (or nothing when given + the options -noinit or -nois). +- The format of vo files has slightly changed: cf final comments in + checker/cic.mli. +- The build system does not produce anymore programs named coqtop.opt + and a symbolic link to coqtop. Instead, coqtop is now directly + an executable compiled with the best OCaml compiler available. + The bytecode program coqtop.byte is still produced. Same for other + utilities. +- Some options of the ./configure script slightly changed: + * The -coqrunbyteflags and its blank-separated argument is replaced + by option -vmbyteflags which expects a comma-separated argument. + * The -coqtoolsbyteflags option is discontinued, see -no-custom instead. + +Miscellaneous + +- ML plugins now require a "DECLARE PLUGIN \"foo\"" statement. The "foo" name + must be exactly the name of the ML module that will be loaded through a + "Declare ML \"foo\"" command. + +Changes from V8.4beta2 to V8.4 +============================== + +Vernacular commands + +- The "Reset" command is now supported again in files given to coqc or Load. +- "Show Script" now indents again the displayed scripts. It can also work + correctly across Load'ed files if the option "Unset Atomic Load" is used. +- "Open Scope" can now be given the delimiter (e.g. Z) instead of the full + scope name (e.g. Z_scope). + +Notations + +- Most compatibility notations of the standard library are now tagged as + (compat xyz), where xyz is a former Coq version, for instance "8.3". + These notations behave as (only parsing) notations, except that they may + triggers warnings (or errors) when used while Coq is not in a corresponding + -compat mode. +- To activate these compatibility warnings, use "Set Verbose Compat Notations" + or the command-line flag -verbose-compat-notations. +- For a strict mode without these compatibility notations, use + "Unset Compat Notations" or the command-line flag -no-compat-notations. + +Tactics + +- An annotation "eqn:H" or "eqn:?" can be added to a "destruct" + or "induction" to make it generate equations in the spirit of "case_eq". + The former syntax "_eqn" is discontinued. +- The name of the hypothesis introduced by tactic "remember" can be + set via the new syntax "remember t as x eqn:H" (wish #2489). + +Libraries + +- Reals: changed definition of PI, no more axiom about sin(PI/2). +- SetoidPermutation: a notion of permutation for lists modulo a setoid equality. +- BigN: fixed the ocaml code doing the parsing/printing of big numbers. +- List: a couple of lemmas added especially about no-duplication, partitions. +- Init: Removal of the coercions between variants of sigma-types and + subset types (possible source of incompatibility). + +Changes from V8.4beta to V8.4beta2 +================================== + +Vernacular commands + +- Commands "Back" and "BackTo" are now handling the proof states. They may + perform some extra steps of backtrack to avoid states where the proof + state is unavailable (typically a closed proof). +- The commands "Suspend" and "Resume" have been removed. +- A basic Show Script has been reintroduced (no indentation). +- New command "Set Parsing Explicit" for deactivating parsing (and printing) + of implicit arguments (useful for teaching). +- New command "Grab Existential Variables" to transform the unresolved evars + at the end of a proof into goals. + +Tactics + +- Still no general "info" tactical, but new specific tactics info_auto, + info_eauto, info_trivial which provides information on the proofs found + by auto/eauto/trivial. Display of these details could also be activated by + "Set Info Auto"/"Set Info Eauto"/"Set Info Trivial". +- Details on everything tried by auto/eauto/trivial during a proof search + could be obtained by "debug auto", "debug eauto", "debug trivial" or by a + global "Set Debug Auto"/"Set Debug Eauto"/"Set Debug Trivial". +- New command "r string" in Ltac debugger that interprets "idtac + string" in Ltac code as a breakpoint and jumps to its next use. +- Tactics from the Dp plugin (simplify, ergo, yices, cvc3, z3, cvcl, + harvey, zenon, gwhy) have been removed, since Why2 has not been + maintained for the last few years. The Why3 plugin should be a suitable + replacement in most cases. + +Libraries + +- MSetRBT: a new implementation of MSets via Red-Black trees (initial + contribution by Andrew Appel). +- MSetAVL: for maximal sharing with the new MSetRBT, the argument order + of Node has changed (this should be transparent to regular MSets users). + +Module System + +- The names of modules (and module types) are now in a fully separated + namespace from ordinary definitions: "Definition E:=0. Module E. End E." + is now accepted. + +CoqIDE + +- Coqide now supports the "Restart" command, and "Undo" (with a warning). + Better support for "Abort". + +Changes from V8.3 to V8.4beta +============================= + +Logic + +- Standard eta-conversion now supported (dependent product only). +- Guard condition improvement: subterm property is propagated through beta-redex + blocked by pattern-matching, as in "(match v with C .. => fun x => u end) x"; + this allows for instance to use "rewrite ... in ..." without breaking + the guard condition. + +Specification language and notations + +- Maximal implicit arguments can now be set locally by { }. The registration + traverses fixpoints and lambdas. Because there is conversion in types, + maximal implicit arguments are not taken into account in partial + applications (use eta expanded form with explicit { } instead). +- Added support for recursive notations with binders (allows for instance + to write "exists x y z, P"). +- Structure/Record printing can be disable by "Unset Printing Records". + In addition, it can be controlled on type by type basis using + "Add Printing Record" or "Add Printing Constructor". +- Pattern-matching compilation algorithm: in "match x, y with ... end", + possible dependencies of x (or of the indices of its type) in the type + of y are now taken into account. + +Tactics + +- New proof engine. +- Scripts can now be structured thanks to bullets - * + and to subgoal + delimitation via { }. Note: for use with Proof General, a cvs version of + Proof General no older than mid-July 2011 is currently required. +- Support for tactical "info" is suspended. +- Support for command "Show Script" is suspended. +- New tactics constr_eq, is_evar and has_evar for use in Ltac (DOC TODO). +- Removed the two-argument variant of "decide equality". +- New experimental tactical "timeout <n> <tac>". Since <n> is a time + in second for the moment, this feature should rather be avoided + in scripts meant to be machine-independent. +- Fix in "destruct": removal of unexpected local definitions in context might + result in some rare incompatibilities (solvable by adapting name hypotheses). +- Introduction pattern "_" made more robust. +- Tactic (and Eval command) vm_compute can now be interrupted via Ctrl-C. +- Unification in "apply" supports unification of patterns of the form + ?f x y = g(x,y) (compatibility ensured by using + "Unset Tactic Pattern Unification"). It also supports (full) betaiota. +- Tactic autorewrite does no longer instantiate pre-existing + existential variables (theoretical source of possible incompatibilities). +- Tactic "dependent rewrite" now supports equality in "sig". +- Tactic omega now understands Zpred (wish #1912) and can prove any goal + from a context containing an arithmetical contradiction (wish #2236). +- Using "auto with nocore" disables the use of the "core" database (wish #2188). + This pseudo-database "nocore" can also be used with trivial and eauto. +- Tactics "set", "destruct" and "induction" accepts incomplete terms and + use the goal to complete the pattern assuming it is non ambiguous. +- When used on arguments with a dependent type, tactics such as + "destruct", "induction", "case", "elim", etc. now try to abstract + automatically the dependencies over the arguments of the types + (based on initial ideas from Chung-Kil Hur, extension to nested + dependencies suggested by Dan Grayson) +- Tactic "injection" now failing on an equality showing no constructors while + it was formerly generalizing again the goal over the given equality. +- In Ltac, the "context [...]" syntax has now a variant "appcontext [...]" + allowing to match partial applications in larger applications. +- When applying destruct or inversion on a fixpoint hiding an inductive + type, recursive calls to the fixpoint now remain folded by default (rare + source of incompatibility generally solvable by adding a call to simpl). +- In an ltac pattern containing a "match", a final "| _ => _" branch could be + used now instead of enumerating all remaining constructors. Moreover, the + pattern "match _ with _ => _ end" now allows to match any "match". A "in" + annotation can also be added to restrict to a precise inductive type. +- The behavior of "simpl" can be tuned using the "Arguments" vernacular. + In particular constants can be marked so that they are always/never unfolded + by "simpl", or unfolded only when a set of arguments evaluates to a + constructor. Last one can mark a constant so that it is unfolded only if the + simplified term does not expose a match in head position. + +Vernacular commands + +- It is now mandatory to have a space (or tabulation or newline or end-of-file) + after a "." ending a sentence. +- In SearchAbout, the [ ] delimiters are now optional. +- New command "Add/Remove Search Blacklist <substring> ...": + a Search or SearchAbout or similar query will never mention lemmas + whose qualified names contain any of the declared substrings. + The default blacklisted substrings are "_subproof" "Private_". +- When the output file of "Print Universes" ends in ".dot" or ".gv", + the universe graph is printed in the DOT language, and can be + processed by Graphviz tools. +- New command "Print Sorted Universes". +- The undocumented and obsolete option "Set/Unset Boxed Definitions" has + been removed, as well as syntaxes like "Boxed Fixpoint foo". +- A new option "Set Default Timeout n / Unset Default Timeout". +- Qed now uses information from the reduction tactics used in proof script + to avoid conversion at Qed time to go into a very long computation. +- New command "Show Goal ident" to display the statement of a goal, even + a closed one (available from Proof General). +- Command "Proof" accept a new modifier "using" to force generalization + over a given list of section variables at section ending (DOC TODO). +- New command "Arguments" generalizing "Implicit Arguments" and + "Arguments Scope" and that also allows to rename the parameters of a + definition and to tune the behavior of the tactic "simpl". + +Module System + +- During subtyping checks, an opaque constant in a module type could now + be implemented by anything of the right type, even if bodies differ. + Said otherwise, with respect to subtyping, an opaque constant behaves + just as a parameter. Coqchk was already implementing this, but not coqtop. +- The inlining done during application of functors can now be controlled + more precisely, by the annotations (no inline) or (inline at level XX). + With the latter annotation, only functor parameters whose levels + are lower or equal than XX will be inlined. + The level of a parameter can be fixed by "Parameter Inline(30) foo". + When levels aren't given, the default value is 100. One can also use + the flag "Set Inline Level ..." to set a level (DOC TODO). +- Print Assumptions should now handle correctly opaque modules (#2168). +- Print Module (Type) now tries to print more details, such as types and + bodies of the module elements. Note that Print Module Type could be + used on a module to display only its interface. The option + "Set Short Module Printing" could be used to switch back to the earlier + behavior were only field names were displayed. + +Libraries + +- Extension of the abstract part of Numbers, which now provide axiomatizations + and results about many more integer functions, such as pow, gcd, lcm, sqrt, + log2 and bitwise functions. These functions are implemented for nat, N, BigN, + Z, BigZ. See in particular file NPeano for new functions about nat. +- The definition of types positive, N, Z is now in file BinNums.v +- Major reorganization of ZArith. The initial file ZArith/BinInt.v now contains + an internal module Z implementing the Numbers interface for integers. + This module Z regroups: + * all functions over type Z : Z.add, Z.mul, ... + * the minimal proofs of specifications for these functions : Z.add_0_l, ... + * an instantation of all derived properties proved generically in Numbers : + Z.add_comm, Z.add_assoc, ... + A large part of ZArith is now simply compatibility notations, for instance + Zplus_comm is an alias for Z.add_comm. The direct use of module Z is now + recommended instead of relying on these compatibility notations. +- Similar major reorganization of NArith, via a module N in NArith/BinNat.v +- Concerning the positive datatype, BinPos.v is now in a specific directory + PArith, and contains an internal submodule Pos. We regroup there functions + such as Pos.add Pos.mul etc as well as many results about them. These results + are here proved directly (no Number interface for strictly positive numbers). +- Note that in spite of the compatibility layers, all these reorganizations + may induce some marginal incompatibilies in scripts. In particular: + * the "?=" notation for positive now refers to a binary function Pos.compare, + instead of the infamous ternary Pcompare (now Pos.compare_cont). + * some hypothesis names generated by the system may changed (typically for + a "destruct Z_le_gt_dec") since naming is done after the short name of + the head predicate (here now "le" in module Z instead of "Zle", etc). + * the internals of Z.add has changed, now relying of Z.pos_sub. +- Also note these new notations: + * "<?" "<=?" "=?" for boolean tests such as Z.ltb Z.leb Z.eqb. + * "÷" for the alternative integer division Z.quot implementing the Truncate + convention (former ZOdiv), while the notation for the Coq usual division + Z.div implementing the Flooring convention remains "/". Their corresponding + modulo functions are Z.rem (no notations) for Z.quot and Z.modulo (infix + "mod" notation) for Z.div. +- Lemmas about conversions between these datatypes are also organized + in modules, see for instance modules Z2Nat, N2Z, etc. +- When creating BigN, the macro-generated part NMake_gen is much smaller. + The generic part NMake has been reworked and improved. Some changes + may introduce incompatibilities. In particular, the order of the arguments + for BigN.shiftl and BigN.shiftr is now reversed: the number to shift now + comes first. By default, the power function now takes two BigN. +- Creation of Vector, an independent library for lists indexed by their length. + Vectors' names overwrite lists' one so you should not "Import" the library. + All old names changed: function names follow the ocaml ones and, for example, + Vcons becomes Vector.cons. You can get [..;..;..]-style notations by importing + Vector.VectorNotations. +- Removal of TheoryList. Requiring List instead should work most of the time. +- New syntax "rew Heq in H" and "rew <- Heq in H" for eq_rect and + eq_rect_r (available by importing module EqNotations). +- Wf.iter_nat is now Peano.nat_iter (with an implicit type argument). + +Internal infrastructure + +- Opaque proofs are now loaded lazily by default. This allows to be almost as + fast as -dont-load-proofs, while being safer (no creation of axioms) and + avoiding feature restrictions (Print and Print Assumptions work ok). +- Revised hash-consing code allowing more sharing of memory +- Experimental support added for camlp4 (the one provided alongside ocaml), + simply pass option -usecamlp4 to ./configure. By default camlp5 is used. +- Revised build system: no more stages in Makefile thanks to some recursive + aspect of recent gnu make, use of vo.itarget files containing .v to compile + for both make and ocamlbuild, etc. +- Support of cross-compilation via mingw from unix toward Windows, + contact P. Letouzey for more informations. +- New Makefile rules mli-doc to make html of mli in dev/doc/html and + full-stdlib to get a (huge) pdf reflecting the whole standard library. + +Extraction + +- By default, opaque terms are now truly considered opaque by extraction: + instead of accessing their body, they are now considered as axioms. + The previous behaviour can be reactivated via the option + "Set Extraction AccessOpaque". +- The pretty-printer for Haskell now produces layout-independent code +- A new command "Separate Extraction cst1 cst2 ..." that mixes a + minimal extracted environment a la "Recursive Extraction" and the + production of several files (one per coq source) a la "Extraction Library" + (DOC TODO). +- New option "Set/Unset Extraction KeepSingleton" for preventing the + extraction to optimize singleton container types (DOC TODO). +- The extraction now identifies and properly rejects a particular case of + universe polymorphism it cannot handle yet (the pair (I,I) being Prop). +- Support of anonymous fields in record (#2555). + +CoqIDE + +- Coqide now runs coqtop as separated process, making it more robust: + coqtop subprocess can be interrupted, or even killed and relaunched + (cf button "Restart Coq", ex-"Go to Start"). For allowing such + interrupts, the Windows version of coqide now requires Windows >= XP + SP1. +- The communication between CoqIDE and Coqtop is now done via a dialect + of XML (DOC TODO). +- The backtrack engine of CoqIDE has been reworked, it now uses the + "Backtrack" command similarly to Proof General. +- The Coqide parsing of sentences has be reworked and now supports + tactic delimitation via { }. +- Coqide now accepts the Abort command (wish #2357). +- Coqide can read coq_makefile files as "project file" and use it to + set automatically options to send to coqtop. +- Preference files have moved to $XDG_CONFIG_HOME/coq and accelerators + are not stored as a list anymore. + +Tools + +- Coq now searches directories specified in COQPATH, $XDG_DATA_HOME/coq, + $XDG_DATA_DIRS/coq, and user-contribs before the standard library. +- Coq rc file has moved to $XDG_CONFIG_HOME/coq. +- Major changes to coq_makefile: + * mli/mlpack/mllib taken into account, ml not preproccessed anymore, ml4 work; + * mlihtml generates doc of mli, install-doc install the html doc in DOCDIR + with the same policy as vo in COQLIB; + * More variables are given by coqtop -config, others are defined only if the + users doesn't have defined them elsewhere. Consequently, generated makefile + should work directly on any architecture; + * Packagers can take advantage of $(DSTROOT) introduction. Installation can + be made in $XDG_DATA_HOME/coq; + * -arg option allows to send option as argument to coqc. + +Changes from V8.2 to V8.3 +========================= + +Rewriting tactics + +- Tactic "rewrite" now supports rewriting on ad hoc equalities such as eq_true. +- "Hint Rewrite" now checks that the lemma looks like an equation. +- New tactic "etransitivity". +- Support for heterogeneous equality (JMeq) in "injection" and "discriminate". +- Tactic "subst" now supports heterogeneous equality and equality + proofs that are dependent (use "simple subst" for preserving compatibility). +- Added support for Leibniz-rewriting of dependent hypotheses. +- Renamed "Morphism" into "Proper" and "respect" into "proper_prf" + (possible source of incompatibility). A partial fix is to define + "Notation Morphism R f := (Proper (R%signature) f)." +- New tactic variants "rewrite* by" and "autorewrite*" that rewrite + respectively the first and all matches whose side-conditions are + solved. +- "Require Import Setoid" does not export all of "Morphisms" and + "RelationClasses" anymore (possible source of incompatibility, fixed + by importing "Morphisms" too). +- Support added for using Chung-Kil Hur's Heq library for rewriting over + heterogeneous equality (courtesy of the library's author). +- Tactic "replace" supports matching terms with holes. + +Automation tactics + +- Tactic "intuition" now preserves inner "iff" and "not" (exceptional + source of incompatibilities solvable by redefining "intuition" as + "unfold iff, not in *; intuition", or, for iff only, by using + "Set Intuition Iff Unfolding".) +- Tactic "tauto" now proves classical tautologies as soon as classical logic + (i.e. library Classical_Prop or Classical) is loaded. +- Tactic "gappa" has been removed from the Dp plugin. +- Tactic "firstorder" now supports the combination of its "using" and + "with" options. +- New "Hint Resolve ->" (or "<-") for declaring iff's as oriented + hints (wish #2104). +- An inductive type as argument of the "using" option of "auto/eauto/firstorder" + is interpreted as using the collection of its constructors. +- New decision tactic "nsatz" to prove polynomial equations + by computation of Groebner bases. + +Other tactics + +- Tactic "discriminate" now performs intros before trying to discriminate an + hypothesis of the goal (previously it applied intro only if the goal + had the form t1<>t2) (exceptional source of incompatibilities - former + behavior can be obtained by "Unset Discriminate Introduction"). +- Tactic "quote" now supports quotation of arbitrary terms (not just the + goal). +- Tactic "idtac" now displays its "list" arguments. +- New introduction patterns "*" for introducing the next block of dependent + variables and "**" for introducing all quantified variables and hypotheses. +- Pattern Unification for existential variables activated in tactics and + new option "Unset Tactic Evars Pattern Unification" to deactivate it. +- Resolution of canonical structure is now part of the tactic's unification + algorithm. +- New tactic "decide lemma with hyp" for rewriting decidability lemmas + when one knows which side is true. +- Improved support of dependent goals over objects in dependent types for + "destruct" (rare source of incompatibility that can be avoided by unsetting + option "Dependent Propositions Elimination"). +- Tactic "exists", "eexists", "destruct" and "edestruct" supports iteration + using comma-separated arguments. +- Tactic names "case" and "elim" now support clauses "as" and "in" and become + then synonymous of "destruct" and "induction" respectively. +- A new tactic name "exfalso" for the use of 'ex-falso quodlibet' principle. + This tactic is simply a shortcut for "elimtype False". +- Made quantified hypotheses get the name they would have if introduced in + the context (possible but rare source of incompatibilities). +- When applying a component of a conjunctive lemma, "apply in" (and + sequences of "apply in") now leave the side conditions of the lemmas + uniformly after the main goal (possible source of rare incompatibilities). +- In "simpl c" and "change c with d", c can be a pattern. +- Tactic "revert" now preserves let-in's making it the exact inverse of + "intro". +- New tactics "clear dependent H" and "revert dependent H" that + clears (resp. reverts) H and all the hypotheses that depend on H. +- Ltac's pattern-matching now supports matching metavariables that + depend on variables bound upwards in the pattern. + +Tactic definitions + +- Ltac definitions support Local option for non-export outside modules. +- Support for parsing non-empty lists with separators in tactic notations. +- New command "Locate Ltac" to get the full name of an Ltac definition. + +Notations + +- Record syntax "{|x=...; y=...|}" now works inside patterns too. +- Abbreviations from non-imported module now invisible at printing time. +- Abbreviations now use implicit arguments and arguments scopes for printing. +- Abbreviations to pure names now strictly behave like the name they refer to + (make redirections of qualified names easier). +- Abbreviations for applied constant now propagate the implicit arguments + and arguments scope of the underlying reference (possible source of + incompatibilities generally solvable by changing such abbreviations from + e.g. "Notation foo' := (foo x)" to "Notation foo' y := (foo x (y:=y))"). +- The "where" clause now supports multiple notations per defined object. +- Recursive notations automatically expand one step on the left for better + factorization; recursion notations inner separators now ensured being tokens. +- Added "Reserved Infix" as a specific shortcut of the corresponding + "Reserved Notation". +- Open/Close Scope command supports Global option in sections. + +Specification language + +- New support for local binders in the syntax of Record/Structure fields. +- Fixpoint/CoFixpoint now support building part or all of bodies using tactics. +- Binders given before ":" in lemmas and in definitions built by tactics are + now automatically introduced (possible source of incompatibility that can + be resolved by invoking "Unset Automatic Introduction"). +- New support for multiple implicit arguments signatures per reference. + +Module system + +- Include Type is now deprecated since Include now accept both modules and + module types. +- Declare ML Module supports Local option. +- The sharing between non-logical object and the management of the + name-space has been improved by the new "Delta-equivalence" on + qualified name. +- The include operator has been extended to high-order structures +- Sequences of Include can be abbreviated via new syntax "<+". +- A module (or module type) can be given several "<:" signatures. +- Interactive proofs are now permitted in module type. Functors can hence + be declared as Module Type and be used later to type themselves. +- A functor application can be prefixed by a "!" to make it ignore any + "Inline" annotation in the type of its argument(s) (for examples of + use of the new features, see libraries Structures and Numbers). +- Coercions are now active only when modules are imported (use "Set Automatic + Coercions Import" to get the behavior of the previous versions of Coq). + +Extraction + +- When using (Recursive) Extraction Library, the filenames are directly the + Coq ones with new appropriate extensions : we do not force anymore + uncapital first letters for Ocaml and capital ones for Haskell. +- The extraction now tries harder to avoid code transformations that can be + dangerous for the complexity. In particular many eta-expansions at the top + of functions body are now avoided, clever partial applications will likely + be preserved, let-ins are almost always kept, etc. +- In the same spirit, auto-inlining is now disabled by default, except for + induction principles, since this feature was producing more frequently + weird code than clear gain. The previous behavior can be restored via + "Set Extraction AutoInline". +- Unicode characters in identifiers are now transformed into ascii strings + that are legal in Ocaml and other languages. +- Harsh support of module extraction to Haskell and Scheme: module hierarchy + is flattened, module abbreviations and functor applications are expanded, + module types and unapplied functors are discarded. +- Less unsupported situations when extracting modules to Ocaml. In particular + module parameters might be alpha-renamed if a name clash is detected. +- Extract Inductive is now possible toward non-inductive types (e.g. nat => int) +- Extraction Implicit: this new experimental command allows to mark + some arguments of a function or constructor for removed during + extraction, even if these arguments don't fit the usual elimination + principles of extraction, for instance the length n of a vector. +- Files ExtrOcaml*.v in plugins/extraction try to provide a library of common + extraction commands: mapping of basics types toward Ocaml's counterparts, + conversions from/to int and big_int, or even complete mapping of nat,Z,N + to int or big_int, or mapping of ascii to char and string to char list + (in this case recognition of ascii constants is hard-wired in the extraction). + +Program + +- Streamlined definitions using well-founded recursion and measures so + that they can work on any subset of the arguments directly (uses currying). +- Try to automatically clear structural fixpoint prototypes in + obligations to avoid issues with opacity. +- Use return type clause inference in pattern-matching as in the standard + typing algorithm. +- Support [Local Obligation Tactic] and [Next Obligation with tactic]. +- Use [Show Obligation Tactic] to print the current default tactic. +- [fst] and [snd] have maximal implicit arguments in Program now (possible + source of incompatibility). + +Type classes + +- Declaring axiomatic type class instances in Module Type should be now + done via new command "Declare Instance", while the syntax "Instance" + now always provides a concrete instance, both in and out of Module Type. +- Use [Existing Class foo] to declare foo as a class a posteriori. + [foo] can be an inductive type or a constant definition. No + projections or instances are defined. +- Various bug fixes and improvements: support for defined fields, + anonymous instances, declarations giving terms, better handling of + sections and [Context]. + +Vernacular commands + +- New command "Timeout <n> <command>." interprets a command and a timeout + interrupts the interpretation after <n> seconds. +- New command "Compute <expr>." is a shortcut for "Eval vm_compute in <expr>". +- New command "Fail <command>." interprets a command and is successful iff + the command fails on an error (but not an anomaly). Handy for tests and + illustration of wrong commands. +- Most commands referring to constant (e.g. Print or About) now support + referring to the constant by a notation string. +- New option "Boolean Equality Schemes" to make generation of boolean + equality automatic for datatypes (together with option "Decidable + Equality Schemes", this replaces deprecated option "Equality Scheme"). +- Made support for automatic generation of case analysis schemes available + to user (governed by option "Set Case Analysis Schemes"). +- New command "(Global?) Generalizable [All|No] Variable(s)? ident(s)?" to + declare which identifiers are generalizable in `{} and `() binders. +- New command "Print Opaque Dependencies" to display opaque constants in + addition to all variables, parameters or axioms a theorem or + definition relies on. +- New command "Declare Reduction <id> := <conv_expr>", allowing to write + later "Eval <id> in ...". This command accepts a Local variant. +- Syntax of Implicit Type now supports more than one block of variables of + a given type. +- Command "Canonical Structure" now warns when it has no effects. +- Commands of the form "Set X" or "Unset X" now support "Local" and "Global" + prefixes. + +Library + +- Use "standard" Coq names for the properties of eq and identity + (e.g. refl_equal is now eq_refl). Support for compatibility is provided. +- The function Compare_dec.nat_compare is now defined directly, + instead of relying on lt_eq_lt_dec. The earlier version is still + available under the name nat_compare_alt. +- Lemmas in library Relations and Reals have been homogenized a bit. +- The implicit argument of Logic.eq is now maximally inserted, allowing + to simply write "eq" instead of "@eq _" in morphism signatures. +- Wrongly named lemmas (Zlt_gt_succ and Zlt_succ_gt) fixed (potential source + of incompatibilities) +- List library: + - Definitions of list, length and app are now in Init/Datatypes. + Support for compatibility is provided. + - Definition of Permutation is now in Sorting/Permtation.v + - Some other light revisions and extensions (possible source + of incompatibilities solvable by qualifying names accordingly). +- In ListSet, set_map has been fixed (source of incompatibilities if used). +- Sorting library: + - new mergesort of worst-case complexity O(n*ln(n)) made available in + Mergesort.v; + - former notion of permutation up to setoid from Permutation.v is + deprecated and moved to PermutSetoid.v; + - heapsort from Heap.v of worst-case complexity O(n*n) is deprecated; + - new file Sorted.v for some definitions of being sorted. +- Structure library. This new library is meant to contain generic + structures such as types with equalities or orders, either + in Module version (for now) or Type Classes (still to do): + - DecidableType.v and OrderedType.v: initial notions for FSets/FMaps, + left for compatibility but considered as deprecated. + - Equalities.v and Orders.v: evolutions of the previous files, + with fine-grain Module architecture, many variants, use of + Equivalence and other relevant Type Classes notions. + - OrdersTac.v: a generic tactic for solving chains of (in)equalities + over variables. See {Nat,N,Z,P}OrderedType.v for concrete instances. + - GenericMinMax.v: any ordered type can be equipped with min and max. + We derived here all the generic properties of these functions. +- MSets library: an important evolution of the FSets library. + "MSets" stands for Modular (Finite) Sets, by contrast with a forthcoming + library of Class (Finite) Sets contributed by S. Lescuyer which will be + integrated with the next release of Coq. The main features of MSets are: + - The use of Equivalence, Proper and other Type Classes features + easing the handling of setoid equalities. + - The interfaces are now stated in iff-style. Old specifications + are now derived properties. + - The compare functions are now pure, and return a "comparison" value. + Thanks to the CompSpec inductive type, reasoning on them remains easy. + - Sets structures requiring invariants (i.e. sorted lists) are + built first as "Raw" sets (pure objects and separate proofs) and + attached with their proofs thanks to a generic functor. "Raw" sets + have now a proper interface and can be manipulated directly. + Note: No Maps yet in MSets. The FSets library is still provided + for compatibility, but will probably be considered as deprecated in the + next release of Coq. +- Numbers library: + - The abstract layer (NatInt, Natural/Abstract, Integer/Abstract) has + been simplified and enhance thanks to new features of the module + system such as Include (see above). It has been extended to Euclidean + division (three flavors for integers: Trunc, Floor and Math). + - The arbitrary-large efficient numbers (BigN, BigZ, BigQ) has also + been reworked. They benefit from the abstract layer improvements + (especially for div and mod). Note that some specifications have + slightly changed (compare, div, mod, shift{r,l}). Ring/Field should + work better (true recognition of constants). + +Tools + +- Option -R now supports binding Coq root read-only. +- New coqtop/coqc option -beautify to reformat .v files (usable + e.g. to globally update notations). +- New tool beautify-archive to beautify a full archive of developments. +- New coqtop/coqc option -compat X.Y to simulate the general behavior + of previous versions of Coq (provides e.g. support for 8.2 compatibility). + +Coqdoc + +- List have been revamped. List depth and scope is now determined by + an "offside" whitespace rule. +- Text may be italicized by placing it in _underscores_. +- The "--index <string>" flag changes the filename of the index. +- The "--toc-depth <int>" flag limits the depth of headers which are + included in the table of contents. +- The "--lib-name <string>" flag prints "<string> Foo" instead of + "Library Foo" where library titles are called for. The + "--no-lib-name" flag eliminates the extra title. +- New option "--parse-comments" to allow parsing of regular "(* *)" + comments. +- New option "--plain-comments" to disable interpretation inside comments. +- New option "--interpolate" to try and typeset identifiers in Coq escapings + using the available globalization information. +- New option "--external url root" to refer to external libraries. +- Links to section variables and notations now supported. + +Internal infrastructure + +- To avoid confusion with the repository of user's contributions, + the subdirectory "contrib" has been renamed into "plugins". + On platforms supporting ocaml native dynlink, code located there + is built as loadable plugins for coqtop. +- An experimental build mechanism via ocamlbuild is provided. + From the top of the archive, run ./configure as usual, and + then ./build. Feedback about this build mechanism is most welcome. + Compiling Coq on platforms such as Windows might be simpler + this way, but this remains to be tested. +- The Makefile system has been simplified and factorized with + the ocamlbuild system. In particular "make" takes advantage + of .mllib files for building .cma/.cmxa. The .vo files to + compile are now listed in several vo.itarget files. + +Changes from V8.1 to V8.2 +========================= + +Language + +- If a fixpoint is not written with an explicit { struct ... }, then + all arguments are tried successively (from left to right) until one is + found that satisfies the structural decreasing condition. +- New experimental typeclass system giving ad-hoc polymorphism and + overloading based on dependent records and implicit arguments. +- New syntax "let 'pat := b in c" for let-binding using irrefutable patterns. +- New syntax "forall {A}, T" for specifying maximally inserted implicit + arguments in terms. +- Sort of Record/Structure, Inductive and CoInductive defaults to Type + if omitted. +- (Co)Inductive types can be defined as records + (e.g. "CoInductive stream := { hd : nat; tl : stream }.") +- New syntax "Theorem id1:t1 ... with idn:tn" for proving mutually dependent + statements. +- Support for sort-polymorphism on constants denoting inductive types. +- Several evolutions of the module system (handling of module aliases, + functorial module types, an Include feature, etc). +- Prop now a subtype of Set (predicative and impredicative forms). +- Recursive inductive types in Prop with a single constructor of which + all arguments are in Prop is now considered to be a singleton + type. It consequently supports all eliminations to Prop, Set and Type. + As a consequence, Acc_rect has now a more direct proof [possible source + of easily fixed incompatibility in case of manual definition of a recursor + in a recursive singleton inductive type]. + +Vernacular commands + +- Added option Global to "Arguments Scope" for section surviving. +- Added option "Unset Elimination Schemes" to deactivate the automatic + generation of elimination schemes. +- Modification of the Scheme command so you can ask for the name to be + automatically computed (e.g. Scheme Induction for nat Sort Set). +- New command "Combined Scheme" to build combined mutual induction + principles from existing mutual induction principles. +- New command "Scheme Equality" to build a decidable (boolean) equality + for simple inductive datatypes and a decision property over this equality + (e.g. Scheme Equality for nat). +- Added option "Set Equality Scheme" to make automatic the declaration + of the boolean equality when possible. +- Source of universe inconsistencies now printed when option + "Set Printing Universes" is activated. +- New option "Set Printing Existential Instances" for making the display of + existential variable instances explicit. +- Support for option "[id1 ... idn]", and "-[id1 ... idn]", for the + "compute"/"cbv" reduction strategy, respectively meaning reduce only, or + everything but, the constants id1 ... idn. "lazy" alone or followed by + "[id1 ... idn]", and "-[id1 ... idn]" also supported, meaning apply + all of beta-iota-zeta-delta, possibly restricting delta. +- New command "Strategy" to control the expansion of constants during + conversion tests. It generalizes commands Opaque and Transparent by + introducing a range of levels. Lower levels are assigned to constants + that should be expanded first. +- New options Global and Local to Opaque and Transparent. +- New command "Print Assumptions" to display all variables, parameters + or axioms a theorem or definition relies on. +- "Add Rec LoadPath" now provides references to libraries using partially + qualified names (this holds also for coqtop/coqc option -R). +- SearchAbout supports negated search criteria, reference to logical objects + by their notation, and more generally search of subterms. +- "Declare ML Module" now allows to import .cmxs files when Coq is + compiled in native code with a version of OCaml that supports native + Dynlink (>= 3.11). +- Specific sort constraints on Record now taken into account. +- "Print LoadPath" supports a path argument to filter the display. + +Libraries + +- Several parts of the libraries are now in Type, in particular FSets, + SetoidList, ListSet, Sorting, Zmisc. This may induce a few + incompatibilities. In case of trouble while fixing existing development, + it may help to simply declare Set as an alias for Type (see file + SetIsType). +- New arithmetical library in theories/Numbers. It contains: + * an abstract modular development of natural and integer arithmetics + in Numbers/Natural/Abstract and Numbers/Integer/Abstract + * an implementation of efficient computational bounded and unbounded + integers that can be mapped to processor native arithmetics. + See Numbers/Cyclic/Int31 for 31-bit integers and Numbers/Natural/BigN + for unbounded natural numbers and Numbers/Integer/BigZ for unbounded + integers. + * some proofs that both older libraries Arith, ZArith and NArith and + newer BigN and BigZ implement the abstract modular development. + This allows in particular BigN and BigZ to already come with a + large database of basic lemmas and some generic tactics (ring), + This library has still an experimental status, as well as the + processor-acceleration mechanism, but both its abstract and its + concrete parts are already quite usable and could challenge the use + of nat, N and Z in actual developments. Moreover, an extension of + this framework to rational numbers is ongoing, and an efficient + Q structure is already provided (see Numbers/Rational/BigQ), but + this part is currently incomplete (no abstract layer and generic + lemmas). +- Many changes in FSets/FMaps. In practice, compatibility with earlier + version should be fairly good, but some adaptations may be required. + * Interfaces of unordered ("weak") and ordered sets have been factorized + thanks to new features of Coq modules (in particular Include), see + FSetInterface. Same for maps. Hints in these interfaces have been + reworked (they are now placed in a "set" database). + * To allow full subtyping between weak and ordered sets, a field + "eq_dec" has been added to OrderedType. The old version of OrderedType + is now called MiniOrderedType and functor MOT_to_OT allow to + convert to the new version. The interfaces and implementations + of sets now contain also such a "eq_dec" field. + * FSetDecide, contributed by Aaron Bohannon, contains a decision + procedure allowing to solve basic set-related goals (for instance, + is a point in a particular set ?). See FSetProperties for examples. + * Functors of properties have been improved, especially the ones about + maps, that now propose some induction principles. Some properties + of fold need less hypothesis. + * More uniformity in implementations of sets and maps: they all use + implicit arguments, and no longer export unnecessary scopes (see + bug #1347) + * Internal parts of the implementations based on AVL have evolved a + lot. The main files FSetAVL and FMapAVL are now much more + lightweight now. In particular, minor changes in some functions + has allowed to fully separate the proofs of operational + correctness from the proofs of well-balancing: well-balancing is + critical for efficiency, but not anymore for proving that these + trees implement our interfaces, hence we have moved these proofs + into appendix files FSetFullAVL and FMapFullAVL. Moreover, a few + functions like union and compare have been modified in order to be + structural yet efficient. The appendix files also contains + alternative versions of these few functions, much closer to the + initial Ocaml code and written via the Function framework. +- Library IntMap, subsumed by FSets/FMaps, has been removed from + Coq Standard Library and moved into a user contribution Cachan/IntMap +- Better computational behavior of some constants (eq_nat_dec and + le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare + transparent, ...) (exceptional source of incompatibilities). +- Boolean operators moved from module Bool to module Datatypes (may need + to rename qualified references in script and force notations || and && + to be at levels 50 and 40 respectively). +- The constructors xI and xO of type positive now have postfix notations + "~1" and "~0", allowing to write numbers in binary form easily, for instance + 6 is 1~1~0 and 4*p is p~0~0 (see BinPos.v). +- Improvements to NArith (Nminus, Nmin, Nmax), and to QArith (in particular + a better power function). +- Changes in ZArith: several additional lemmas (used in theories/Numbers), + especially in Zdiv, Znumtheory, Zpower. Moreover, many results in + Zdiv have been generalized: the divisor may simply be non-null + instead of strictly positive (see lemmas with name ending by + "_full"). An alternative file ZOdiv proposes a different behavior + (the one of Ocaml) when dividing by negative numbers. +- Changes in Arith: EqNat and Wf_nat now exported from Arith, some + constructions on nat that were outside Arith are now in (e.g. iter_nat). +- In SetoidList, eqlistA now expresses that two lists have similar elements + at the same position, while the predicate previously called eqlistA + is now equivlistA (this one only states that the lists contain the same + elements, nothing more). +- Changes in Reals: + * Most statement in "sigT" (including the + completeness axiom) are now in "sig" (in case of incompatibility, + use proj1_sig instead of projT1, sig instead of sigT, etc). + * More uniform naming scheme (identifiers in French moved to English, + consistent use of 0 -- zero -- instead of O -- letter O --, etc). + * Lemma on prod_f_SO is now on prod_f_R0. + * Useless hypothesis of ln_exists1 dropped. + * New Rlogic.v states a few logical properties about R axioms. + * RIneq.v extended and made cleaner. +- Slight restructuration of the Logic library regarding choice and classical + logic. Addition of files providing intuitionistic axiomatizations of + descriptions: Epsilon.v, Description.v and IndefiniteDescription.v. +- Definition of pred and minus made compatible with the structural + decreasing criterion for use in fixpoints. +- Files Relations/Rstar.v and Relations/Newman.v moved out to the user + contribution repository (contribution CoC_History). New lemmas about + transitive closure added and some bound variables renamed (exceptional + risk of incompatibilities). +- Syntax for binders in terms (e.g. for "exists") supports anonymous names. + +Notations, coercions, implicit arguments and type inference + +- More automation in the inference of the return clause of dependent + pattern-matching problems. +- Experimental allowance for omission of the clauses easily detectable as + impossible in pattern-matching problems. +- Improved inference of implicit arguments. +- New options "Set Maximal Implicit Insertion", "Set Reversible Pattern + Implicit", "Set Strongly Strict Implicit" and "Set Printing Implicit + Defensive" for controlling inference and use of implicit arguments. +- New modifier in "Implicit Arguments" to force an implicit argument to + be maximally inserted. +- New modifier of "Implicit Arguments" to enrich the set of implicit arguments. +- New options Global and Local to "Implicit Arguments" for section + surviving or non export outside module. +- Level "constr" moved from 9 to 8. +- Structure/Record now printed as Record (unless option Printing All is set). +- Support for parametric notations defining constants. +- Insertion of coercions below product types refrains to unfold + constants (possible source of incompatibility). +- New support for fix/cofix in notations. + +Tactic Language + +- Second-order pattern-matching now working in Ltac "match" clauses + (syntax for second-order unification variable is "@?X"). +- Support for matching on let bindings in match context using syntax + "H := body" or "H := body : type". +- Ltac accepts integer arguments (syntax is "ltac:nnn" for nnn an integer). +- The general sequence tactical "expr_0 ; [ expr_1 | ... | expr_n ]" + is extended so that at most one expr_i may have the form "expr .." + or just "..". Also, n can be different from the number of subgoals + generated by expr_0. In this case, the value of expr (or idtac in + case of just "..") is applied to the intermediate subgoals to make + the number of tactics equal to the number of subgoals. +- A name used as the name of the parameter of a lemma (like f in + "apply f_equal with (f:=t)") is now interpreted as a ltac variable + if such a variable exists (this is a possible source of + incompatibility and it can be fixed by renaming the variables of a + ltac function into names that do not clash with the lemmas + parameter names used in the tactic). +- New syntax "Ltac tac ::= ..." to rebind a tactic to a new expression. +- "let rec ... in ... " now supported for expressions without explicit + parameters; interpretation is lazy to the contrary of "let ... in ..."; + hence, the "rec" keyword can be used to turn the argument of a + "let ... in ..." into a lazy one. +- Patterns for hypotheses types in "match goal" are now interpreted in + type_scope. +- A bound variable whose name is not used elsewhere now serves as + metavariable in "match" and it gets instantiated by an identifier + (allow e.g. to extract the name of a statement like "exists x, P x"). +- New printing of Ltac call trace for better debugging. + +Tactics + +- New tactics "apply -> term", "apply <- term", "apply -> term in + ident", "apply <- term in ident" for applying equivalences (iff). +- Slight improvement of the hnf and simpl tactics when applied on + expressions with explicit occurrences of match or fix. +- New tactics "eapply in", "erewrite", "erewrite in". +- New tactics "ediscriminate", "einjection", "esimplify_eq". +- Tactics "discriminate", "injection", "simplify_eq" now support any + term as argument. Clause "with" is also supported. +- Unfoldable references can be given by notation's string rather than by name + in unfold. +- The "with" arguments are now typed using informations from the current goal: + allows support for coercions and more inference of implicit arguments. +- Application of "f_equal"-style lemmas works better. +- Tactics elim, case, destruct and induction now support variants eelim, + ecase, edestruct and einduction. +- Tactics destruct and induction now support the "with" option and the + "in" clause option. If the option "in" is used, an equality is added + to remember the term to which the induction or case analysis applied + (possible source of parsing incompatibilities when destruct or induction is + part of a let-in expression in Ltac; extra parentheses are then required). +- New support for "as" clause in tactics "apply in" and "eapply in". +- Some new intro patterns: + * intro pattern "?A" genererates a fresh name based on A. + Caveat about a slight loss of compatibility: + Some intro patterns don't need space between them. In particular + intros ?a?b used to be legal and equivalent to intros ? a ? b. Now it + is still legal but equivalent to intros ?a ?b. + * intro pattern "(A & ... & Y & Z)" synonym to "(A,....,(Y,Z)))))" + for right-associative constructs like /\ or exists. +- Several syntax extensions concerning "rewrite": + * "rewrite A,B,C" can be used to rewrite A, then B, then C. These rewrites + occur only on the first subgoal: in particular, side-conditions of the + "rewrite A" are not concerned by the "rewrite B,C". + * "rewrite A by tac" allows to apply tac on all side-conditions generated by + the "rewrite A". + * "rewrite A at n" allows to select occurrences to rewrite: rewrite only + happen at the n-th exact occurrence of the first successful matching of + A in the goal. + * "rewrite 3 A" or "rewrite 3!A" is equivalent to "rewrite A,A,A". + * "rewrite !A" means rewriting A as long as possible (and at least once). + * "rewrite 3?A" means rewriting A at most three times. + * "rewrite ?A" means rewriting A as long as possible (possibly never). + * many of the above extensions can be combined with each other. +- Introduction patterns better respect the structure of context in presence of + missing or extra names in nested disjunction-conjunction patterns [possible + source of rare incompatibilities]. +- New syntax "rename a into b, c into d" for "rename a into b; rename c into d" +- New tactics "dependent induction/destruction H [ generalizing id_1 .. id_n ]" + to do induction-inversion on instantiated inductive families à la BasicElim. +- Tactics "apply" and "apply in" now able to reason modulo unfolding of + constants (possible source of incompatibility in situations where apply + may fail, e.g. as argument of a try or a repeat and in a ltac function); + versions that do not unfold are renamed into "simple apply" and + "simple apply in" (usable for compatibility or for automation). +- Tactics "apply" and "apply in" now able to traverse conjunctions and to + select the first matching lemma among the components of the conjunction; + tactic "apply" also able to apply lemmas of conclusion an empty type. +- Tactic "apply" now supports application of several lemmas in a row. +- Tactics "set" and "pose" can set functions using notation "(f x1..xn := c)". +- New tactic "instantiate" (without argument). +- Tactic firstorder "with" and "using" options have their meaning swapped for + consistency with auto/eauto (source of incompatibility). +- Tactic "generalize" now supports "at" options to specify occurrences + and "as" options to name the quantified hypotheses. +- New tactic "specialize H with a" or "specialize (H a)" allows to transform + in-place a universally-quantified hypothesis (H : forall x, T x) into its + instantiated form (H : T a). Nota: "specialize" was in fact there in earlier + versions of Coq, but was undocumented, and had a slightly different behavior. +- New tactic "contradict H" can be used to solve any kind of goal as long as + the user can provide afterwards a proof of the negation of the hypothesis H. + If H is already a negation, say ~T, then a proof of T is asked. + If the current goal is a negation, say ~U, then U is saved in H afterwards, + hence this new tactic "contradict" extends earlier tactic "swap", which is + now obsolete. +- Tactics f_equal is now done in ML instead of Ltac: it now works on any + equality of functions, regardless of the arity of the function. +- New options "before id", "at top", "at bottom" for tactics "move"/"intro". +- Some more debug of reflexive omega (romega), and internal clarifications. + Moreover, romega now has a variant "romega with *" that can be also used + on non-Z goals (nat, N, positive) via a call to a translation tactic named + zify (its purpose is to Z-ify your goal...). This zify may also be used + independently of romega. +- Tactic "remember" now supports an "in" clause to remember only selected + occurrences of a term. +- Tactic "pose proof" supports name overwriting in case of specialization of an + hypothesis. +- Semi-decision tactic "jp" for first-order intuitionistic logic moved to user + contributions (subsumed by "firstorder"). + +Program + +- Moved useful tactics in theories/Program and documented them. +- Add Program.Basics which contains standard definitions for functional + programming (id, apply, flip...) +- More robust obligation handling, dependent pattern-matching and + well-founded definitions. +- New syntax " dest term as pat in term " for destructing objects using + an irrefutable pattern while keeping equalities (use this instead of + "let" in Programs). +- Program CoFixpoint is accepted, Program Fixpoint uses the new way to infer + which argument decreases structurally. +- Program Lemma, Axiom etc... now permit to have obligations in the statement + iff they can be automatically solved by the default tactic. +- Renamed "Obligations Tactic" command to "Obligation Tactic". +- New command "Preterm [ of id ]" to see the actual term fed to Coq for + debugging purposes. +- New option "Transparent Obligations" to control the declaration of + obligations as transparent or opaque. All obligations are now transparent + by default, otherwise the system declares them opaque if possible. +- Changed the notations "left" and "right" to "in_left" and "in_right" to hide + the proofs in standard disjunctions, to avoid breaking existing scripts when + importing Program. Also, put them in program_scope. + +Type Classes + +- New "Class", "Instance" and "Program Instance" commands to define + classes and instances documented in the reference manual. +- New binding construct " [ Class_1 param_1 .. param_n, Class_2 ... ] " + for binding type classes, usable everywhere. +- New command " Print Classes " and " Print Instances some_class " to + print tables for typeclasses. +- New default eauto hint database "typeclass_instances" used by the default + typeclass instance search tactic. +- New theories directory "theories/Classes" for standard typeclasses + declarations. Module Classes.RelationClasses is a typeclass port of + Relation_Definitions plus a generic development of algebra on + n-ary heterogeneous predicates. + +Setoid rewriting + +- Complete (and still experimental) rewrite of the tactic + based on typeclasses. The old interface and semantics are + almost entirely respected, except: + + - Import Setoid is now mandatory to be able to call setoid_replace + and declare morphisms. + + - "-->", "++>" and "==>" are now right associative notations + declared at level 55 in scope signature_scope. + Their introduction may break existing scripts that defined + them as notations with different levels. + + - One needs to use [Typeclasses unfold [cst]] if [cst] is used + as an abbreviation hiding products in types of morphisms, + e.g. if ones redefines [relation] and declares morphisms + whose type mentions [relation]. + + - The [setoid_rewrite]'s semantics change when rewriting with + a lemma: it can rewrite two different instantiations of the lemma + at once. Use [setoid_rewrite H at 1] for (almost) the usual semantics. + [setoid_rewrite] will also try to rewrite under binders now, and can + succeed on different terms than before. In particular, it will unify under + let-bound variables. When called through [rewrite], the semantics are + unchanged though. + + - [Add Morphism term : id] has different semantics when used with + parametric morphism: it will try to find a relation on the parameters + too. The behavior has also changed with respect to default relations: + the most recently declared Setoid/Relation will be used, the documentation + explains how to customize this behavior. + + - Parametric Relation and Morphism are declared differently, using the + new [Add Parametric] commands, documented in the manual. + + - Setoid_Theory is now an alias to Equivalence, scripts building objects + of type Setoid_Theory need to unfold (or "red") the definitions + of Reflexive, Symmetric and Transitive in order to get the same goals + as before. Scripts which introduced variables explicitely will not break. + + - The order of subgoals when doing [setoid_rewrite] with side-conditions + is always the same: first the new goal, then the conditions. + +- New standard library modules Classes.Morphisms declares + standard morphisms on refl/sym/trans relations. + Classes.Morphisms_Prop declares morphisms on propositional + connectives and Classes.Morphisms_Relations on generalized predicate + connectives. Classes.Equivalence declares notations and tactics + related to equivalences and Classes.SetoidTactics defines the + setoid_replace tactics and some support for the "Add *" interface, + notably the tactic applied automatically before each "Add Morphism" + proof. + +- User-defined subrelations are supported, as well as higher-order morphisms + and rewriting under binders. The tactic is also extensible entirely in Ltac. + The documentation has been updated to cover these features. + +- [setoid_rewrite] and [rewrite] now support the [at] modifier to select + occurrences to rewrite, and both use the [setoid_rewrite] code, even when + rewriting with leibniz equality if occurrences are specified. + +Extraction + +- Improved behavior of the Caml extraction of modules: name clashes should + not happen anymore. +- The command Extract Inductive has now a syntax for infix notations. This + allows in particular to map Coq lists and pairs onto Caml ones: + Extract Inductive list => list [ "[]" "(::)" ]. + Extract Inductive prod => "(*)" [ "(,)" ]. +- In pattern matchings, a default pattern "| _ -> ..." is now used whenever + possible if several branches are identical. For instance, functions + corresponding to decidability of equalities are now linear instead of + quadratic. +- A new instruction Extraction Blacklist id1 .. idn allows to prevent filename + conflits with existing code, for instance when extracting module List + to Ocaml. + +CoqIDE + +- CoqIDE font defaults to monospace so as indentation to be meaningful. +- CoqIDE supports nested goals and any other kind of declaration in the middle + of a proof. +- Undoing non-tactic commands in CoqIDE works faster. +- New CoqIDE menu for activating display of various implicit informations. +- Added the possibility to choose the location of tabs in coqide: + (in Edit->Preferences->Misc) +- New Open and Save As dialogs in CoqIDE which filter *.v files. + +Tools + +- New stand-alone .vo files verifier "coqchk". +- Extended -I coqtop/coqc option to specify a logical dir: "-I dir -as coqdir". +- New coqtop/coqc option -exclude-dir to exclude subdirs for option -R. +- The binary "parser" has been renamed to "coq-parser". +- Improved coqdoc and dump of globalization information to give more + meta-information on identifiers. All categories of Coq definitions are + supported, which makes typesetting trivial in the generated documentation. + Support for hyperlinking and indexing developments in the tex output + has been implemented as well. + +Miscellaneous + +- Coq installation provides enough files so that Ocaml's extensions need not + the Coq sources to be compiled (this assumes O'Caml 3.10 and Camlp5). +- New commands "Set Whelp Server" and "Set Whelp Getter" to customize the + Whelp search tool. +- Syntax of "Test Printing Let ref" and "Test Printing If ref" changed into + "Test Printing Let for ref" and "Test Printing If for ref". +- An overhauled build system (new Makefiles); see dev/doc/build-system.txt. +- Add -browser option to configure script. +- Build a shared library for the C part of Coq, and use it by default on + non-(Windows or MacOS) systems. Bytecode executables are now pure. The + behaviour is configurable with -coqrunbyteflags, -coqtoolsbyteflags and + -custom configure options. +- Complexity tests can be skipped by setting the environment variable + COQTEST_SKIPCOMPLEXITY. + +Changes from V8.1gamma to V8.1 +============================== + +Bug fixes + +- Many bugs have been fixed (cf coq-bugs web page) + +Tactics + +- New tactics ring, ring_simplify and new tactic field now able to manage + power to a positive integer constant. Tactic ring on Z and R, and + field on R manage power (may lead to incompatibilities with V8.1gamma). +- Tactic field_simplify now applicable in hypotheses. +- New field_simplify_eq for simplifying field equations into ring equations. +- Tactics ring, ring_simplify, field, field_simplify and field_simplify_eq + all able to apply user-given equations to rewrite monoms on the fly + (see documentation). + +Libraries + +- New file ConstructiveEpsilon.v defining an epsilon operator and + proving the axiom of choice constructively for a countable domain + and a decidable predicate. + +Changes from V8.1beta to V8.1gamma +================================== + +Syntax + +- changed parsing precedence of let/in and fun constructions of Ltac: + let x := t in e1; e2 is now parsed as let x := t in (e1;e2). + +Language and commands + +- Added sort-polymorphism for definitions in Type (but finally abandonned). +- Support for implicit arguments in the types of parameters in + (co-)fixpoints and (co-)inductive declarations. +- Improved type inference: use as much of possible general information. + before applying irreversible unification heuristics (allow e.g. to + infer the predicate in "(exist _ 0 (refl_equal 0) : {n:nat | n=0 })"). +- Support for Miller-Pfenning's patterns unification in type synthesis + (e.g. can infer P such that P x y = phi(x,y)). +- Support for "where" clause in cofixpoint definitions. +- New option "Set Printing Universes" for making Type levels explicit. + +Tactics + +- Improved implementation of the ring and field tactics. For compatibility + reasons, the previous tactics are renamed as legacy ring and legacy field, + but should be considered as deprecated. +- New declarative mathematical proof language. +- Support for argument lists of arbitrary length in Tactic Notation. +- [rewrite ... in H] now fails if [H] is used either in an hypothesis + or in the goal. +- The semantics of [rewrite ... in *] has been slightly modified (see doc). +- Support for "as" clause in tactic injection. +- New forward-reasoning tactic "apply in". +- Ltac fresh operator now builds names from a concatenation of its arguments. +- New ltac tactic "remember" to abstract over a subterm and keep an equality +- Support for Miller-Pfenning's patterns unification in apply/rewrite/... + (may lead to few incompatibilities - generally now useless tactic calls). + +Bug fixes + +- Fix for notations involving basic "match" expressions. +- Numerous other bugs solved (a few fixes may lead to incompatibilities). + + +Changes from V8.0 to V8.1beta +============================= + +Logic + +- Added sort-polymorphism on inductive families +- Allowance for recursively non uniform parameters in inductive types + +Syntax + +- No more support for version 7 syntax and for translation to version 8 syntax. +- In fixpoints, the { struct ... } annotation is not mandatory any more when + only one of the arguments has an inductive type +- Added disjunctive patterns in match-with patterns +- Support for primitive interpretation of string literals +- Extended support for Unicode ranges + +Vernacular commands + +- Added "Print Ltac qualid" to print a user defined tactic. +- Added "Print Rewrite HintDb" to print the content of a DB used by + autorewrite. +- Added "Print Canonical Projections". +- Added "Example" as synonym of "Definition". +- Added "Proposition" and "Corollary" as extra synonyms of "Lemma". +- New command "Whelp" to send requests to the Helm database of proofs + formalized in the Calculus of Inductive Constructions. +- Command "functional induction" has been re-implemented from the new + "Function" command. + +Ltac and tactic syntactic extensions + +- New primitive "external" for communication with tool external to Coq +- New semantics for "match t with": if a clause returns a + tactic, it is now applied to the current goal. If it fails, the next + clause or next matching subterm is tried (i.e. it behaves as "match + goal with" does). The keyword "lazymatch" can be used to delay the + evaluation of tactics occurring in matching clauses. +- Hint base names can be parametric in auto and trivial. +- Occurrence values can be parametric in unfold, pattern, etc. +- Added entry constr_may_eval for tactic extensions. +- Low-priority term printer made available in ML-written tactic extensions. +- "Tactic Notation" extended to allow notations of tacticals. + +Tactics + +- New implementation and generalization of [setoid_]* (setoid_rewrite, + setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite). + New syntax for declaring relations and morphisms (old syntax still working + with minor modifications, but deprecated). +- New implementation (still experimental) of the ring tactic with a built-in + notion of coefficients and a better usage of setoids. +- New conversion tactic "vm_compute": evaluates the goal (or an hypothesis) + with a call-by-value strategy, using the compiled version of terms. +- When rewriting H where H is not directly a Coq equality, search first H for + a registered setoid equality before starting to reduce in H. This is unlikely + to break any script. Should this happen nonetheless, one can insert manually + some "unfold ... in H" before rewriting. +- Fixed various bugs about (setoid) rewrite ... in ... (in particular bug #5941) +- "rewrite ... in" now accepts a clause as place where to rewrite instead of + juste a simple hypothesis name. For instance: + rewrite H in H1,H2 |- * means rewrite H in H1; rewrite H in H2; rewrite H + rewrite H in * |- will do try rewrite H in Hi for all hypothesis Hi <> H. +- Added "dependent rewrite term" and "dependent rewrite term in hyp". +- Added "autorewrite with ... in hyp [using ...]". +- Tactic "replace" now accepts a "by" tactic clause. +- Added "clear - id" to clear all hypotheses except the ones depending in id. +- The argument of Declare Left Step and Declare Right Step is now a term + (it used to be a reference). +- Omega now handles arbitrary precision integers. +- Several bug fixes in Reflexive Omega (romega). +- Idtac can now be left implicit in a [...|...] construct: for instance, + [ foo | | bar ] stands for [ foo | idtac | bar ]. +- Fixed a "fold" bug (non critical but possible source of incompatibilities). +- Added classical_left and classical_right which transforms |- A \/ B into + ~B |- A and ~A |- B respectively. +- Added command "Declare Implicit Tactic" to set up a default tactic to be + used to solve unresolved subterms of term arguments of tactics. +- Better support for coercions to Sortclass in tactics expecting type + arguments. +- Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses. +- New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns. +- New introduction pattern "?" for letting Coq choose a name. +- Introduction patterns now support side hypotheses (e.g. intros [|] on + "(nat -> nat) -> nat" works). +- New introduction patterns "->" and "<-" for immediate rewriting of + introduced hypotheses. +- Introduction patterns coming after non trivial introduction patterns now + force full introduction of the first pattern (e.g. "intros [[|] p]" on + "nat->nat->nat" now behaves like "intros [[|?] p]") +- Added "eassumption". +- Added option 'using lemmas' to auto, trivial and eauto. +- Tactic "congruence" is now complete for its intended scope (ground + equalities and inequalities with constructors). Furthermore, it + tries to equates goal and hypotheses. +- New tactic "rtauto" solves pure propositional logic and gives a + reflective version of the available proof. +- Numbering of "pattern", "unfold", "simpl", ... occurrences in "match + with" made consistent with the printing of the return clause after + the term to match in the "match-with" construct (use "Set Printing All" + to see hidden occurrences). +- Generalization of induction "induction x1...xn using scheme" where + scheme is an induction principle with complex predicates (like the + ones generated by function induction). +- Some small Ltac tactics has been added to the standard library + (file Tactics.v): + * f_equal : instead of using the different f_equalX lemmas + * case_eq : a "case" without loss of information. An equality + stating the current situation is generated in every sub-cases. + * swap : for a negated goal ~B and a negated hypothesis H:~A, + swap H asks you to prove A from hypothesis B + * revert : revert H is generalize H; clear H. + +Extraction + +- All type parts should now disappear instead of sometimes producing _ + (for instance in Map.empty). +- Haskell extraction: types of functions are now printed, better + unsafeCoerce mechanism, both for hugs and ghc. +- Scheme extraction improved, see http://www.pps.jussieu.fr/~letouzey/scheme. +- Many bug fixes. + +Modules + +- Added "Locate Module qualid" to get the full path of a module. +- Module/Declare Module syntax made more uniform. +- Added syntactic sugar "Declare Module Export/Import" and + "Module Export/Import". +- Added syntactic sugar "Module M(Export/Import X Y: T)" and + "Module Type M(Export/Import X Y: T)" + (only for interactive definitions) +- Construct "with" generalized to module paths: + T with (Definition|Module) M1.M2....Mn.l := l'. + +Notations + +- Option "format" aware of recursive notations. +- Added insertion of spaces by default in recursive notations w/o separators. +- No more automatic printing box in case of user-provided printing "format". +- New notation "exists! x:A, P" for unique existence. +- Notations for specific numerals now compatible with generic notations of + numerals (e.g. "1" can be used to denote the unit of a group without + hiding 1%nat) + +Libraries + +- New library on String and Ascii characters (contributed by L. Thery). +- New library FSets+FMaps of finite sets and maps. +- New library QArith on rational numbers. +- Small extension of Zmin.V, new Zmax.v, new Zminmax.v. +- Reworking and extension of the files on classical logic and + description principles (possible incompatibilities) +- Few other improvements in ZArith potentially exceptionally breaking the + compatibility (useless hypothesys of Zgt_square_simpl and + Zlt_square_simpl removed; fixed names mentioning letter O instead of + digit 0; weaken premises in Z_lt_induction). +- Restructuration of Eqdep_dec.v and Eqdep.v: more lemmas in Type. +- Znumtheory now contains a gcd function that can compute within Coq. +- More lemmas stated on Type in Wf.v, removal of redundant Acc_iter and + Acc_iter2. +- Change of the internal names of lemmas in OmegaLemmas. +- Acc in Wf.v and clos_refl_trans in Relation_Operators.v now rely on + the allowance for recursively non uniform parameters (possible + source of incompatibilities: explicit pattern-matching on these + types may require to remove the occurrence associated to their + recursively non uniform parameter). +- Coq.List.In_dec has been set transparent (this may exceptionally break + proof scripts, set it locally opaque for compatibility). +- More on permutations of lists in List.v and Permutation.v. +- List.v has been much expanded. +- New file SetoidList.v now contains results about lists seen with + respect to a setoid equality. +- Library NArith has been expanded, mostly with results coming from + Intmap (for instance a bitwise xor), plus also a bridge between N and + Bitvector. +- Intmap has been reorganized. In particular its address type "addr" is + now N. User contributions known to use Intmap have been adapted + accordingly. If you're using this library please contact us. + A wrapper FMapIntMap now presents Intmap as a particular implementation + of FMaps. New developments are strongly encouraged to use either this + wrapper or any other implementations of FMap instead of using directly + this obsolete Intmap. + +Tools + +- New semantics for coqtop options ("-batch" expects option "-top dir" + for loading vernac file that contains definitions). +- Tool coq_makefile now removes custom targets that are file names in + "make clean" +- New environment variable COQREMOTEBROWSER to set the command invoked + to start the remote browser both in Coq and coqide. Standard syntax: + "%s" is the placeholder for the URL. + + +Changes from V8.0beta to V8.0 +============================= + +Vernacular commands + +- New option "Set Printing All" to deactivate all high-level forms of + printing (implicit arguments, coercions, destructing let, + if-then-else, notations, projections) +- "Functional Scheme" and "Functional Induction" extended to polymorphic + types and dependent types +- Notation now allows recursive patterns, hence recovering parts of the + fonctionalities of pre-V8 Grammar/Syntax commands +- Command "Print." discontinued. +- Redundant syntax "Implicit Arguments On/Off" discontinued + +New syntax + +- Semantics change of the if-then-else construction in new syntax: + "if c then t1 else t2" now stands for + "match c with c1 _ ... _ => t1 | c2 _ ... _ => t2 end" + with no dependency of t1 and t2 in the arguments of the constructors; + this may cause incompatibilities for files translated using coq 8.0beta + +Interpretation scopes + +- Delimiting key %bool for bool_scope added +- Import no more needed to activate argument scopes from a module + +Tactics and the tactic Language + +- Semantics of "assert" is now consistent with the reference manual +- New tactics stepl and stepr for chaining transitivity steps +- Tactic "replace ... with ... in" added +- Intro patterns now supported in Ltac (parsed with prefix "ipattern:") + +Executables and tools + +- Added option -top to change the name of the toplevel module "Top" +- Coqdoc updated to new syntax and now part of Coq sources +- XML exportation tool now exports the structure of vernacular files + (cf chapter 13 in the reference manual) + +User contributions + +- User contributions have been updated to the new syntax + +Bug fixes + +- Many bugs have been fixed (cf coq-bugs web page) + +Changes from V8.0beta old syntax to V8.0beta +============================================ + +New concrete syntax + +- A completely new syntax for terms +- A more uniform syntax for tactics and the tactic language +- A few syntactic changes for vernacular commands +- A smart automatic translator translating V8.0 files in old syntax to + files valid for V8.0 + +Syntax extensions + +- "Grammar" for terms disappears +- "Grammar" for tactics becomes "Tactic Notation" +- "Syntax" disappears +- Introduction of a notion of interpretation scope allowing to use the + same notations in various contexts without using specific delimiters + (e.g the same expression "4<=3+x" is interpreted either in "nat", + "positive", "N" (previously "entier"), "Z", "R", depending on which + interpretation scope is currently open) [see documentation for details] +- Notation now mandatorily requires a precedence and associativity + (default was to set precedence to 1 and associativity to none) + +Revision of the standard library + +- Many lemmas and definitions names have been made more uniform mostly + in Arith, NArith, ZArith and Reals (e.g : "times" -> "Pmult", + "times_sym" -> "Pmult_comm", "Zle_Zmult_pos_right" -> + "Zmult_le_compat_r", "SUPERIEUR" -> "Gt", "ZERO" -> "Z0") +- Order and names of arguments of basic lemmas on nat, Z, positive and R + have been made uniform. +- Notions of Coq initial state are declared with (strict) implicit arguments +- eq merged with eqT: old eq disappear, new eq (written =) is old eqT + and new eqT is syntactic sugar for new eq (notation == is an alias + for = and is written as it, exceptional source of incompatibilities) +- Similarly, ex, ex2, all, identity are merged with exT, exT2, allT, identityT +- Arithmetical notations for nat, positive, N, Z, R, without needing + any backquote or double-backquotes delimiters. +- In Lists: new concrete notations; argument of nil is now implicit +- All changes in the library are taken in charge by the translator + +Semantical changes during translation + +- Recursive keyword set by default (and no longer needed) in Tactic Definition +- Set Implicit Arguments is strict by default in new syntax +- reductions in hypotheses of the form "... in H" now apply to the type + also if H is a local definition +- etc + +Gallina + +- New syntax of the form "Inductive bool : Set := true, false : bool." for + enumerated types +- Experimental syntax of the form p.(fst) for record projections + (activable with option "Set Printing Projections" which is + recognized by the translator) + +Known problems of the automatic translation + +- iso-latin-1 characters are no longer supported: move your files to + 7-bits ASCII or unicode before translation (swith to unicode is + automatically done if a file is loaded and saved again by coqide) +- Renaming in ZArith: incompatibilities in Coq user contribs due to + merging names INZ, from Reals, and inject_nat. +- Renaming and new lemmas in ZArith: may clash with names used by users +- Restructuration of ZArith: replace requirement of specific modules + in ZArith by "Require Import ZArith_base" or "Require Import ZArith" +- Some implicit arguments must be made explicit before translation: typically + for "length nil", the implicit argument of length must be made explicit +- Grammar rules, Infix notations and V7.4 Notations must be updated wrt the + new scheme for syntactic extensions (see translator documentation) +- Unsafe for annotation Cases when constructors coercions are used or when + annotations are eta-reduced predicates + + +Changes from V7.4 to V8.0beta old syntax +======================================== + +Logic + +- Set now predicative by default +- New option -impredicative-set to set Set impredicative +- The standard library doesn't need impredicativity of Set and is + compatible with the classical axioms which contradict Set impredicativity + +Syntax for arithmetic + +- Notation "=" and "<>" in Z and R are no longer implicitly in Z or R + (with possible introduction of a coercion), use <Z>...=... or + <Z>...<>... instead +- Locate applied to a simple string (e.g. "+") searches for all + notations containing this string + +Vernacular commands + +- "Declare ML Module" now allows to import .cma files. This avoids to use a + bunch of "Declare ML Module" statements when using several ML files. +- "Set Printing Width n" added, allows to change the size of width printing. +- "Implicit Variables Type x,y:t" (new syntax: "Implicit Types x y:t") + assigns default types for binding variables. +- Declarations of Hints and Notation now accept a "Local" flag not to + be exported outside the current file even if not in section +- "Print Scopes" prints all notations +- New command "About name" for light printing of type, implicit arguments, etc. +- New command "Admitted" to declare incompletely proven statement as axioms +- New keyword "Conjecture" to declare an axiom intended to be provable +- SearchAbout can now search for lemmas referring to more than one constant + and on substrings of the name of the lemma +- "Print Implicit" displays the implicit arguments of a constant +- Locate now searches for all names having a given suffix +- New command "Functional Scheme" for building an induction principle + from a function defined by case analysis and fix. + +Commands + +- new coqtop/coqc option -dont-load-proofs not to load opaque proofs in memory + +Implicit arguments + +- Inductive in sections declared with implicits now "discharged" with + implicits (like constants and variables) +- Implicit Arguments flags are now synchronous with reset +- New switch "Unset/Set Printing Implicits" (new syntax: "Unset/Set Printing + Implicit") to globally control printing of implicits + +Grammar extensions + +- Many newly supported UTF-8 encoded unicode blocks + - Greek letters (0380-03FF), Hebrew letters (U05D0-05EF), letter-like + symbols (2100-214F, that includes double N,Z,Q,R), prime + signs (from 2080-2089) and characters from many written languages + are valid in identifiers + - mathematical operators (2200-22FF), supplemental mathematical + operators (2A00-2AFF), miscellaneous technical (2300-23FF that + includes sqrt symbol), miscellaneous symbols (2600-26FF), arrows + (2190-21FF and 2900-297F), invisible mathematical operators (from + 2080-2089), ... are valid symbols + +Library + +- New file about the factorial function in Arith +- An additional elimination Acc_iter for Acc, simplier than Acc_rect. + This new elimination principle is used for definition well_founded_induction. +- New library NArith on binary natural numbers +- R is now of type Set +- Restructuration in ZArith library + - "true_sub" used in Zplus now a definition, not a local one (source + of incompatibilities in proof referring to true_sub, may need extra Unfold) + - Some lemmas about minus moved from fast_integer to Arith/Minus.v + (le_minus, lt_mult_left) (theoretical source of incompatibilities) + - Several lemmas moved from auxiliary.v and zarith_aux.v to + fast_integer.v (theoretical source of incompatibilities) + - Variables names of iff_trans changed (source of incompatibilities) + - ZArith lemmas named OMEGA something or fast_ something, and lemma new_var + are now out of ZArith (except OMEGA2) + - Redundant ZArith lemmas have been renamed: for the following pairs, + use the second name (Zle_Zmult_right2, Zle_mult_simpl), (OMEGA2, + Zle_0_plus), (Zplus_assoc_l, Zplus_assoc), (Zmult_one, Zmult_1_n), + (Zmult_assoc_l, Zmult_assoc), (Zmult_minus_distr, Zmult_Zminus_distr_l) + (add_un_double_moins_un_xO, is_double_moins_un), + (Rlt_monotony_rev,Rlt_monotony_contra) (source of incompatibilities) +- Few minor changes (no more implicit arguments in + Zmult_Zminus_distr_l and Zmult_Zminus_distr_r, lemmas moved from + Zcomplements to other files) (rare source of incompatibilities) +- New lemmas provided by users added + +Tactic language + +- Fail tactic now accepts a failure message +- Idtac tactic now accepts a message +- New primitive tactic "FreshId" (new syntax: "fresh") to generate new names +- Debugger prints levels of calls + +Tactics + +- Replace can now replace proofs also +- Fail levels are now decremented at "Match Context" blocks only and + if the right-hand-side of "Match term With" are tactics, these + tactics are never evaluated immediately and do not induce + backtracking (in contrast with "Match Context") +- Quantified names now avoid global names of the current module (like + Intro names did) [source of rare incompatibilities: 2 changes in the set of + user contribs] +- NewDestruct/NewInduction accepts intro patterns as introduction names +- NewDestruct/NewInduction now work for non-inductive type using option "using" +- A NewInduction naming bug for inductive types with functional + arguments (e.g. the accessibility predicate) has been fixed (source + of incompatibilities) +- Symmetry now applies to hypotheses too +- Inversion now accept option "as [ ... ]" to name the hypotheses +- Contradiction now looks also for contradictory hypotheses stating ~A and A + (source of incompatibility) +- "Contradiction c" try to find an hypothesis in context which + contradicts the type of c +- Ring applies to new library NArith (require file NArithRing) +- Field now works on types in Set +- Auto with reals now try to replace le by ge (Rge_le is no longer an + immediate hint), resulting in shorter proofs +- Instantiate now works in hyps (syntax : Instantiate in ...) +- Some new tactics : EConstructor, ELeft, Eright, ESplit, EExists +- New tactic "functional induction" to perform case analysis and + induction following the definition of a function. +- Clear now fails when trying to remove a local definition used by + a constant appearing in the current goal + +Extraction (See details in plugins/extraction/CHANGES) + +- The old commands: (Recursive) Extraction Module M. + are now: (Recursive) Extraction Library M. + To use these commands, M should come from a library M.v +- The other syntax Extraction & Recursive Extraction now accept + module names as arguments. + +Bugs + +- see coq-bugs server for the complete list of fixed bugs + +Miscellaneous + +- Implicit parameters of inductive types definition now taken into + account for infering other implicit arguments + +Incompatibilities + +- Persistence of true_sub (4 incompatibilities in Coq user contributions) +- Variable names of some constants changed for a better uniformity (2 changes + in Coq user contributions) +- Naming of quantified names in goal now avoid global names (2 occurrences) +- NewInduction naming for inductive types with functional arguments + (no incompatibility in Coq user contributions) +- Contradiction now solve more goals (source of 2 incompatibilities) +- Merge of eq and eqT may exceptionally result in subgoals now + solved automatically +- Redundant pairs of ZArith lemmas may have different names: it may + cause "Apply/Rewrite with" to fail if using the first name of a pair + of redundant lemmas (this is solved by renaming the variables bound by + "with"; 3 incompatibilities in Coq user contribs) +- ML programs referring to constants from fast_integer.v must use + "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead + +Changes from V7.3.1 to V7.4 +=========================== + +Symbolic notations + +- Introduction of a notion of scope gathering notations in a consistent set; + a notation sets has been developed for nat, Z and R (undocumented) +- New command "Notation" for declaring notations simultaneously for + parsing and printing (see chap 10 of the reference manual) +- Declarations with only implicit arguments now handled (e.g. the + argument of nil can be set implicit; use !nil to refer to nil + without arguments) +- "Print Scope sc" and "Locate ntn" allows to know to what expression a + notation is bound +- New defensive strategy for printing or not implicit arguments to ensure + re-type-checkability of the printed term +- In Grammar command, the only predefined non-terminal entries are ident, + global, constr and pattern (e.g. nvar, numarg disappears); the only + allowed grammar types are constr and pattern; ast and ast list are no + longer supported; some incompatibilities in Grammar: when a syntax is a + initial segment of an other one, Grammar does not work, use Notation + +Library + +- Lemmas in Set from Compare_dec.v (le_lt_dec, ...) and Wf_nat.v + (lt_wf_rec, ...) are now transparent. This may be source of + incompatibilities. +- Syntactic Definitions Fst, Snd, Ex, All, Ex2, AllT, ExT, ExT2, + ProjS1, ProjS2, Error, Value and Except are turned to + notations. They now must be applied (incompatibilities only in + unrealistic cases). +- More efficient versions of Zmult and times (30% faster) +- Reals: the library is now divided in 6 parts (Rbase, Rfunctions, + SeqSeries, Rtrigo, Ranalysis, Integration). New tactics: Sup and + RCompute. See Reals.v for details. + +Modules + +- Beta version, see doc chap 2.5 for commands and chap 5 for theory + +Language + +- Inductive definitions now accept ">" in constructor types to declare + the corresponding constructor as a coercion. +- Idem for assumptions declarations and constants when the type is mentionned. +- The "Coercion" and "Canonical Structure" keywords now accept the + same syntax as "Definition", i.e. "hyps :=c (:t)?" or "hyps :t". +- Theorem-like declaration now accepts the syntax "Theorem thm [x:t;...] : u". +- Remark's and Fact's now definitively behave as Theorem and Lemma: when + sections are closed, the full name of a Remark or a Fact has no longer a + section part (source of incompatibilities) +- Opaque Local's (i.e. built by tactics and ended by Qed), do not + survive section closing any longer; as a side-effect, Opaque Local's + now appear in the local context of proofs; their body is hidden + though (source of incompatibilities); use one of Remark/Fact/Lemma/Theorem + instead to simulate the old behaviour of Local (the section part of + the name is not kept though) + +ML tactic and vernacular commands + +- "Grammar tactic" and "Grammar vernac" of type "ast" are no longer + supported (only "Grammar tactic simple_tactic" of type "tactic" + remains available). +- Concrete syntax for ML written vernacular commands and tactics is + now declared at ML level using camlp4 macros TACTIC EXTEND et VERNAC + COMMAND EXTEND. +- "Check n c" now "n:Check c", "Eval n ..." now "n:Eval ..." +- "Proof with T" (* no documentation *) +- SearchAbout id - prints all theorems which contain id in their type + +Tactic definitions + +- Static globalisation of identifiers and global references (source of + incompatibilities, especially, Recursive keyword is required for + mutually recursive definitions). +- New evaluation semantics: no more partial evaluation at definition time; + evaluation of all Tactic/Meta Definition, even producing terms, expect + a proof context to be evaluated (especially "()" is no longer needed). +- Debugger now shows the nesting level and the reasons of failure + +Tactics + +- Equality tactics (Rewrite, Reflexivity, Symmetry, Transitivity) now + understand JM equality +- Simpl and Change now apply to subterms also +- "Simpl f" reduces subterms whose head constant is f +- Double Induction now referring to hypotheses like "Intros until" +- "Inversion" now applies also on quantified hypotheses (naming as + for Intros until) +- NewDestruct now accepts terms with missing hypotheses +- NewDestruct and NewInduction now accept user-provided elimination scheme +- NewDestruct and NewInduction now accept user-provided introduction names +- Omega could solve goals such as ~`x<y` |- `x>=y` but failed when the + hypothesis was unfolded to `x < y` -> False. This is fixed. In addition, + it can also recognize 'False' in the hypothesis and use it to solve the + goal. +- Coercions now handled in "with" bindings +- "Subst x" replaces all ocurrences of x by t in the goal and hypotheses + when an hypothesis x=t or x:=t or t=x exists +- Fresh names for Assert and Pose now based on collision-avoiding + Intro naming strategy (exceptional source of incompatibilities) +- LinearIntuition (* no documentation *) +- Unfold expects a correct evaluable argument +- Clear expects existing hypotheses + +Extraction (See details in plugins/extraction/CHANGES and README): + +- An experimental Scheme extraction is provided. +- Concerning Ocaml, extracted code is now ensured to always type-check, + thanks to automatic inserting of Obj.magic. +- Experimental extraction of Coq new modules to Ocaml modules. + +Proof rendering in natural language + +- Export of theories to XML for publishing and rendering purposes now + includes proof-trees (see http://www.cs.unibo.it/helm) + +Miscellaneous + +- Printing Coercion now used through the standard keywords Set/Add, Test, Print +- "Print Term id" is an alias for "Print id" +- New switch "Unset/Set Printing Symbols" to control printing of + symbolic notations +- Two new variants of implicit arguments are available + - "Unset/Set Contextual Implicits" tells to consider implicit also the + arguments inferable from the context (e.g. for nil or refl_eq) + - "Unset/Set Strict Implicits" tells to consider implicit only the + arguments that are inferable in any case (i.e. arguments that occurs + as argument of rigid constants in the type of the remaining arguments; + e.g. the witness of an existential is not strict since it can vanish when + applied to a predicate which does not use its argument) + +Incompatibilities + +- "Grammar tactic ... : ast" and "Grammar vernac ... : ast" are no + longer supported, use TACTIC EXTEND and VERNAC COMMAND EXTEND on the + ML-side instead +- Transparency of le_lt_dec and co (leads to some simplification in + proofs; in some cases, incompatibilites is solved by declaring locally + opaque the relevant constant) +- Opaque Local do not now survive section closing (rename them into + Remark/Lemma/... to get them still surviving the sections; this + renaming allows also to solve incompatibilites related to now + forbidden calls to the tactic Clear) +- Remark and Fact have no longer (very) long names (use Local instead in case + of name conflict) + +Bugs + +- Improved localisation of errors in Syntactic Definitions +- Induction principle creation failure in presence of let-in fixed (#1459) +- Inversion bugs fixed (#1427 and #1437) +- Omega bug related to Set fixed (#1384) +- Type-checking inefficiency of nested destructuring let-in fixed (#1435) +- Improved handling of let-in during holes resolution phase (#1460) + +Efficiency + +- Implementation of a memory sharing strategy reducing memory + requirements by an average ratio of 3. + +Changes from V7.3 to V7.3.1 +=========================== + +Bug fixes + + - Corrupted Field tactic and Match Context tactic construction fixed + - Checking of names already existing in Assert added (#1386) + - Invalid argument bug in Exact tactic solved (#1387) + - Colliding bound names bug fixed (#1412) + - Wrong non-recursivity test for Record fixed (#1394) + - Out of memory/seg fault bug related to parametric inductive fixed (#1404) + - Setoid_replace/Setoid_rewrite bug wrt "==" fixed + +Misc + + - Ocaml version >= 3.06 is needed to compile Coq from sources + - Simplification of fresh names creation strategy for Assert, Pose and + LetTac (#1402) + +Changes from V7.2 to V7.3 +========================= + +Language + +- Slightly improved compilation of pattern-matching (slight source of + incompatibilities) +- Record's now accept anonymous fields "_" which does not build projections +- Changes in the allowed elimination sorts for certain class of inductive + definitions : an inductive definition without constructors + of Sort Prop can be eliminated on sorts Set and Type A "singleton" + inductive definition (one constructor with arguments in the sort Prop + like conjunction of two propositions or equality) can be eliminated + directly on sort Type (In V7.2, only the sorts Prop and Set were allowed) + +Tactics + +- New tactic "Rename x into y" for renaming hypotheses +- New tactics "Pose x:=u" and "Pose u" to add definitions to local context +- Pattern now working on partially applied subterms +- Ring no longer applies irreversible congruence laws of mult but + better applies congruence laws of plus (slight source of incompatibilities). +- Field now accepts terms to be simplified as arguments (as for Ring). This + extension has been also implemented using the toplevel tactic language. +- Intuition does no longer unfold constants except "<->" and "~". It + can be parameterized by a tactic. It also can introduce dependent + product if needed (source of incompatibilities) +- "Match Context" now matching more recent hypotheses first and failing only + on user errors and Fail tactic (possible source of incompatibilities) +- Tactic Definition's without arguments now allowed in Coq states +- Better simplification and discrimination made by Inversion (source + of incompatibilities) + +Bugs + +- "Intros H" now working like "Intro H" trying first to reduce if not a product +- Forward dependencies in Cases now taken into account +- Known bugs related to Inversion and let-in's fixed +- Bug unexpected Delta with let-in now fixed + +Extraction (details in plugins/extraction/CHANGES or documentation) + +- Signatures of extracted terms are now mostly expunged from dummy arguments. +- Haskell extraction is now operational (tested & debugged). + +Standard library + +- Some additions in [ZArith]: three files (Zcomplements.v, Zpower.v + and Zlogarithms.v) moved from plugins/omega in order to be more + visible, one Zsgn function, more induction principles (Wf_Z.v and + tail of Zcomplements.v), one more general Euclid theorem +- Peano_dec.v and Compare_dec.v now part of Arith.v + +Tools + +- new option -dump-glob to coqtop to dump globalizations (to be used by the + new documentation tool coqdoc; see http://www.lri.fr/~filliatr/coqdoc) + +User Contributions + +- CongruenceClosure (congruence closure decision procedure) + [Pierre Corbineau, ENS Cachan] +- MapleMode (an interface to embed Maple simplification procedures over + rational fractions in Coq) + [David Delahaye, Micaela Mayero, Chalmers University] +- Presburger: A formalization of Presburger's algorithm + [Laurent Thery, INRIA Sophia Antipolis] +- Chinese has been rewritten using Z from ZArith as datatype + ZChinese is the new version, Chinese the obsolete one + [Pierre Letouzey, LRI Orsay] + +Incompatibilities + +- Ring: exceptional incompatibilities (1 above 650 in submitted user + contribs, leading to a simplification) +- Intuition: does not unfold any definition except "<->" and "~" +- Cases: removal of some extra Cases in configurations of the form + "Cases ... of C _ => ... | _ D => ..." (effects on 2 definitions of + submitted user contributions necessitating the removal of now superfluous + proof steps in 3 different proofs) +- Match Context, in case of incompatibilities because of a now non + trapped error (e.g. Not_found or Failure), use instead tactic Fail + to force Match Context trying the next clause +- Inversion: better simplification and discrimination may occasionally + lead to less subgoals and/or hypotheses and different naming of hypotheses +- Unification done by Apply/Elim has been changed and may exceptionally lead + to incompatible instantiations +- Peano_dec.v and Compare_dec.v parts of Arith.v make Auto more + powerful if these files were not already required (1 occurrence of + this in submitted user contribs) + +Changes from V7.1 to V7.2 +========================= + +Language + +- Automatic insertion of patterns for local definitions in the type of + the constructors of an inductive types (for compatibility with V6.3 + let-in style) +- Coercions allowed in Cases patterns +- New declaration "Canonical Structure id = t : I" to help resolution of + equations of the form (proj ?)=a; if proj(e)=a then a is canonically + equipped with the remaining fields in e, i.e. ? is instantiated by e + +Tactics + +- New tactic "ClearBody H" to clear the body of definitions in local context +- New tactic "Assert H := c" for forward reasoning +- Slight improvement in naming strategy for NewInduction/NewDestruct +- Intuition/Tauto do not perform useless unfolding and work up to conversion + +Extraction (details in plugins/extraction/CHANGES or documentation) + +- Syntax changes: there are no more options inside the extraction commands. + New commands for customization and options have been introduced instead. +- More optimizations on extracted code. +- Extraction tests are now embedded in 14 user contributions. + +Standard library + +- In [Relations], Rstar.v and Newman.v now axiom-free. +- In [Sets], Integers.v now based on nat +- In [Arith], more lemmas in Min.v, new file Max.v, tail-recursive + plus and mult added to Plus.v and Mult.v respectively +- New directory [Sorting] with a proof of heapsort (dragged from 6.3.1 lib) +- In [Reals], more lemmas in Rbase.v, new lemmas on square, square root and + trigonometric functions (R_sqr.v - Rtrigo.v); a complementary approach + and new theorems about continuity and derivability in Ranalysis.v; some + properties in plane geometry such as translation, rotation or similarity + in Rgeom.v; finite sums and Chasles property in Rsigma.v + +Bugs + +- Confusion between implicit args of locals and globals of same base name fixed +- Various incompatibilities wrt inference of "?" in V6.3.1 fixed +- Implicits in infix section variables bug fixed +- Known coercions bugs fixed + +- Apply "universe anomaly" bug fixed +- NatRing now working +- "Discriminate 1", "Injection 1", "Simplify_eq 1" now working +- NewInduction bugs with let-in and recursively dependent hypotheses fixed +- Syntax [x:=t:T]u now allowed as mentioned in documentation + +- Bug with recursive inductive types involving let-in fixed +- Known pattern-matching bugs fixed +- Known Cases elimination predicate bugs fixed +- Improved errors messages for pattern-matching and projections +- Better error messages for ill-typed Cases expressions + +Incompatibilities + +- New naming strategy for NewInduction/NewDestruct may affect 7.1 compatibility +- Extra parentheses may exceptionally be needed in tactic definitions. +- Coq extensions written in Ocaml need to be updated (see dev/changements.txt + for a description of the main changes in the interface files of V7.2) +- New behaviour of Intuition/Tauto may exceptionally lead to incompatibilities + +---------------------------------------------------------------------------- +Changes from V6.3.1 and V7.0 to V7.1 +==================================== + +Notes: + +- items followed by (**) are important sources of incompatibilities +- items followed by (*) may exceptionally be sources of incompatibilities +- items followed by (+) have been introduced in version 7.0 + + +Main novelties +============== + +References are to Coq V7.1 reference manual + +- New primitive let-in construct (see sections 1.2.8 and ) +- Long names (see sections 2.6 and 2.7) +- New high-level tactic language (see chapter 10) +- Improved search facilities (see section 5.2) +- New extraction algorithm managing the Type level (see chapter 17) +- New rewriting tactic for arbitrary equalities (see chapter 19) +- New tactic Field to decide equalities on commutative fields (see 7.11) +- New tactic Fourier to solve linear inequalities on reals numbers (see 7.11) +- New tactics for induction/case analysis in "natural" style (see 7.7) +- Deep restructuration of the code (safer, simpler and more efficient) +- Export of theories to XML for publishing and rendering purposes + (see http://www.cs.unibo.it/helm) + + +Details of changes +================== + +Language: new "let-in" construction +----------------------------------- + +- New construction for local definitions (let-in) with syntax [x:=u]t (*)(+) + +- Local definitions allowed in Record (a.k.a. record à la Randy Pollack) + + +Language: long names +-------------------- + +- Each construction has a unique absolute names built from a base + name, the name of the module in which they are defined (Top if in + coqtop), and possibly an arbitrary long sequence of directory (e.g. + "Coq.Lists.PolyList.flat_map" where "Coq" means that "flat_map" is part + of Coq standard library, "Lists" means it is defined in the Lists + library and "PolyList" means it is in the file Polylist) (+) + +- Constructions can be referred by their base name, or, in case of + conflict, by a "qualified" name, where the base name is prefixed + by the module name (and possibly by a directory name, and so + on). A fully qualified name is an absolute name which always refer + to the construction it denotes (to preserve the visibility of + all constructions, no conflict is allowed for an absolute name) (+) + +- Long names are available for modules with the possibility of using + the directory name as a component of the module full name (with + option -R to coqtop and coqc, or command Add LoadPath) (+) + +- Improved conflict resolution strategy (the Unix PATH model), + allowing more constructions to be referred just by their base name + + +Language: miscellaneous +----------------------- + +- The names of variables for Record projections _and_ for induction principles + (e.g. sum_ind) is now based on the first letter of their type (main + source of incompatibility) (**)(+) + +- Most typing errors have now a precise location in the source (+) + +- Slightly different mechanism to solve "?" (*)(+) + +- More arguments may be considered implicit at section closing (*)(+) + +- Bug with identifiers ended by a number greater than 2^30 fixed (+) + +- New visibility discipline for Remark, Fact and Local: Remark's and + Fact's now survive at the end of section, but are only accessible using a + qualified names as soon as their strength expires; Local's disappear and + are moved into local definitions for each construction persistent at + section closing + + +Language: Cases +--------------- + +- Cases no longer considers aliases inferable from dependencies in types (*)(+) + +- A redundant clause in Cases is now an error (*) + + +Reduction +--------- + +- New reduction flags "Zeta" and "Evar" in Eval Compute, for inlining of + local definitions and instantiation of existential variables + +- Delta reduction flag does not perform Zeta and Evar reduction any more (*) + +- Constants declared as opaque (using Qed) can no longer become + transparent (a constant intended to be alternatively opaque and + transparent must be declared as transparent (using Defined)); a risk + exists (until next Coq version) that Simpl and Hnf reduces opaque + constants (*) + + +New tactics +----------- + +- New set of tactics to deal with types equipped with specific + equalities (a.k.a. Setoids, e.g. nat equipped with eq_nat) [by C. Renard] + +- New tactic Assert, similar to Cut but expected to be more user-friendly + +- New tactic NewDestruct and NewInduction intended to replace Elim + and Induction, Case and Destruct in a more user-friendly way (see + restrictions in the reference manual) + +- New tactic ROmega: an experimental alternative (based on reflexion) to Omega + [by P. Crégut] + +- New tactic language Ltac (see reference manual) (+) + +- New versions of Tauto and Intuition, fully rewritten in the new Ltac + language; they run faster and produce more compact proofs; Tauto is + fully compatible but, in exchange of a better uniformity, Intuition + is slightly weaker (then use Tauto instead) (**)(+) + +- New tactic Field to decide equalities on commutative fields (as a + special case, it works on real numbers) (+) + +- New tactic Fourier to solve linear inequalities on reals numbers + [by L. Pottier] (+) + +- New tactics dedicated to real numbers: DiscrR, SplitRmult, SplitAbsolu (+) + + +Changes in existing tactics +--------------------------- + +- Reduction tactics in local definitions apply only to the body + +- New syntax of the form "Compute in Type of H." to require a reduction on + the types of local definitions + +- Inversion, Injection, Discriminate, ... apply also on the + quantified premises of a goal (using the "Intros until" syntax) + +- Decompose has been fixed but hypotheses may get different names (*)(+) + +- Tauto now manages uniformly hypotheses and conclusions of the form + "t=t" which all are considered equivalent to "True". Especially, + Tauto now solves goals of the form "H : ~ t = t |- A". + +- The "Let" tactic has been renamed "LetTac" and is now based on the + primitive "let-in" (+) + +- Elim can no longer be used with an elimination schema different from + the one defined at definition time of the inductive type. To overload + an elimination schema, use "Elim <hyp> using <name of the new schema>" + (*)(+) + +- Simpl no longer unfolds the recursive calls of a mutually defined + fixpoint (*)(+) + +- Intro now fails if the hypothesis name already exists (*)(+) + +- "Require Prolog" is no longer needed (i.e. it is available by default) (*)(+) + +- Unfold now fails on a non unfoldable identifier (*)(+) + +- Unfold also applies on definitions of the local context + +- AutoRewrite now deals only with the main goal and it is the purpose of + Hint Rewrite to deal with generated subgoals (+) + +- Redundant or incompatible instantiations in Apply ... with ... are now + correctly managed (+) + + +Efficiency +---------- + +- Excessive memory uses specific to V7.0 fixed + +- Sizes of .vo files vary a lot compared to V6.3 (from -30% to +300% + depending on the developments) + +- An improved reduction strategy for lazy evaluation + +- A more economical mechanism to ensure logical consistency at the Type level; + warning: this is experimental and may produce "universes" anomalies + (please report) + + +Concrete syntax of constructions +-------------------------------- + +- Only identifiers starting with "_" or a letter, and followed by letters, + digits, "_" or "'" are allowed (e.g. "$" and "@" are no longer allowed) (*) + +- A multiple binder like (a:A)(a,b:(P a))(Q a) is no longer parsed as + (a:A)(a0:(P a))(b:(P a))(Q a0) but as (a:A)(a0:(P a))(b:(P a0))(Q a0) (*)(+) + +- A dedicated syntax has been introduced for Reals (e.g ``3+1/x``) (+) + +- Pretty-printing of Infix notations fixed. (+) + + +Parsing and grammar extension +----------------------------- + +- More constraints when writing ast + + - "{...}" and the macros $LIST, $VAR, etc. now expect a metavariable + (an identifier starting with $) (*) + - identifiers should starts with a letter or "_" and be followed + by letters, digits, "_" or "'" (other characters are still + supported but it is not advised to use them) (*)(+) + +- Entry "command" in "Grammar" and quotations (<<...>> stuff) is + renamed "constr" as in "Syntax" (+) + +- New syntax "[" sentence_1 ... sentence_n"]." to group sentences (useful + for Time and to write grammar rules abbreviating several commands) (+) + +- The default parser for actions in the grammar rules (and for + patterns in the pretty-printing rules) is now the one associated to + the grammar (i.e. vernac, tactic or constr); no need then for + quotations as in <:vernac:<...>>; to return an "ast", the grammar + must be explicitly typed with tag ": ast" or ": ast list", or if a + syntax rule, by using <<...>> in the patterns (expression inside + these angle brackets are parsed as "ast"); for grammars other than + vernac, tactic or constr, you may explicitly type the action with + tags ": constr", ": tactic", or ":vernac" (**)(+) + +- Interpretation of names in Grammar rule is now based on long names, + which allows to avoid problems (or sometimes tricks;) related to + overloaded names (+) + + +New commands +------------ + +- New commands "Print XML All", "Show XML Proof", ... to show or + export theories to XML to be used with Helm's publishing and rendering + tools (see http://www.cs.unibo.it/helm) (by Claudio Sacerdoti Coen) (+) + +- New commands to manually set implicit arguments (+) + + - "Implicits ident." to activate the implicit arguments mode just for ident + - "Implicits ident [num1 num2 ...]." to explicitly give which + arguments have to be considered as implicit + +- New SearchPattern/SearchRewrite (by Yves Bertot) (+) + +- New commands "Debug on"/"Debug off" to activate/deactivate the tactic + language debugger (+) + +- New commands to map physical paths to logical paths (+) + - Add LoadPath physical_dir as logical_dir + - Add Rec LoadPath physical_dir as logical_dir + + +Changes in existing commands +---------------------------- + +- Generalization of the usage of qualified identifiers in tactics + and commands about globals, e.g. Decompose, Eval Delta; + Hints Unfold, Transparent, Require + +- Require synchronous with Reset; Require's scope stops at Section ending (*) + +- For a module indirectly loaded by a "Require" but not exported, + the command "Import module" turns the constructions defined in the + module accessible by their short name, and activates the Grammar, + Syntax, Hint, ... declared in the module (+) + +- The scope of the "Search" command can be restricted to some modules (+) + +- Final dot in command (full stop/period) must be followed by a blank + (newline, tabulation or whitespace) (+) + +- Slight restriction of the syntax for Cbv Delta: if present, option [-myconst] + must immediately follow the Delta keyword (*)(+) + +- SearchIsos currently not supported + +- Add ML Path is now implied by Add LoadPath (+) + +- New names for the following commands (+) + + AddPath -> Add LoadPath + Print LoadPath -> Print LoadPath + DelPath -> Remove LoadPath + AddRecPath -> Add Rec LoadPath + Print Path -> Print Coercion Paths + + Implicit Arguments On -> Set Implicit Arguments + Implicit Arguments Off -> Unset Implicit Arguments + + Begin Silent -> Set Silent + End Silent -> Unset Silent. + + +Tools +----- + +- coqtop (+) + + - Two executables: coqtop.byte and coqtop.opt (if supported by the platform) + - coqtop is a link to the more efficient executable (coqtop.opt if present) + - option -full is obsolete (+) + +- do_Makefile renamed into coq_makefile (+) + +- New option -R to coqtop and coqc to map a physical directory to a logical + one (+) + +- coqc no longer needs to create a temporary file + +- No more warning if no initialization file .coqrc exists + + +Extraction +---------- + +- New algorithm for extraction able to deal with "Type" (+) + (by J.-C. Filliâtre and P. Letouzey) + + +Standard library +---------------- + +- New library on maps on integers (IntMap, contributed by Jean Goubault) + +- New lemmas about integer numbers [ZArith] + +- New lemmas and a "natural" syntax for reals [Reals] (+) + +- Exc/Error/Value renamed into Option/Some/None (*) + + +New user contributions +---------------------- + +- Constructive complex analysis and the Fundamental Theorem of Algebra [FTA] + (Herman Geuvers, Freek Wiedijk, Jan Zwanenburg, Randy Pollack, + Henk Barendregt, Nijmegen) + +- A new axiomatization of ZFC set theory [Functions_in_ZFC] + (C. Simpson, Sophia-Antipolis) + +- Basic notions of graph theory [GRAPHS-BASICS] (Jean Duprat, Lyon) + +- A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, + Sophia-Antipolis) + +- Formalisation of CTL and TCTL temporal logic [CtlTctl] (Carlos + Daniel Luna,Montevideo) + +- Specification and verification of the Railroad Crossing Problem + in CTL and TCTL [RailroadCrossing] (Carlos Daniel Luna,Montevideo) + +- P-automaton and the ABR algorithm [PAutomata] + (Christine Paulin, Emmanuel Freund, Orsay) + +- Semantics of a subset of the C language [MiniC] + (Eduardo Giménez, Emmanuel Ledinot, Suresnes) + +- Correctness proofs of the following imperative algorithms: + Bresenham line drawing algorithm [Bresenham], Marché's minimal edition + distance algorithm [Diff] (Jean-Christophe Filliâtre, Orsay) + +- Correctness proofs of Buchberger's algorithm [Buchberger] and RSA + cryptographic algorithm [Rsa] (Laurent Théry, Sophia-Antipolis) + +- Correctness proof of Stalmarck tautology checker algorithm + [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) diff --git a/Makefile.dev b/Makefile.dev index 82b81908ac..6a2a1b2101 100644 --- a/Makefile.dev +++ b/Makefile.dev @@ -34,33 +34,8 @@ dev/camlp5.dbg: revision: $(SHOW)'CHECK revision' $(HIDE)rm -f revision.new -ifeq ($(CHECKEDOUT),svn) $(HIDE)set -e; \ - if test -x "`which svn`"; then \ - export LC_ALL=C;\ - svn info . | sed -ne '/URL/s/.*\/\([^\/]\{1,\}\)/\1/p' > revision.new; \ - svn info . | sed -ne '/Revision/s/Revision: \([0-9]\{1,\}\)/\1/p'>> revision.new; \ - fi -endif -ifeq ($(CHECKEDOUT),gnuarch) - $(HIDE)set -e; \ - if test -x "`which tla`"; then \ - LANG=C; export LANG; \ - tla tree-version > revision.new ; \ - tla tree-revision | sed -ne 's|.*--||p' >> revision.new ; \ - fi -endif -ifeq ($(CHECKEDOUT),git) - $(HIDE)set -e; \ - if test -x "`which git`"; then \ - LANG=C; export LANG; \ - GIT_BRANCH=$$(git branch -a | sed -ne '/^\* /s/^\* \(.*\)/\1/p'); \ - GIT_HOST=$$(hostname); \ - GIT_PATH=$$(pwd); \ - (echo "$${GIT_HOST}:$${GIT_PATH},$${GIT_BRANCH}") > revision.new; \ - (echo "$$(git log -1 --pretty='format:%H')") >> revision.new; \ - fi -endif + ./dev/tools/make_git_revision.sh > revision.new $(HIDE)set -e; \ if test -e revision.new; then \ if test -e revision; then \ @@ -27,7 +27,7 @@ and the [Coq FAQ](https://github.com/coq/coq/wiki/The-Coq-FAQ), for additional user-contributed documentation. ## Changes -There is a file named [`CHANGES`](CHANGES) that explains the differences and the +There is a file named [`CHANGES.md`](CHANGES.md) that explains the differences and the incompatibilities since last versions. If you upgrade Coq, please read it carefully. diff --git a/checker/declarations.ml b/checker/declarations.ml index 03fee1ab51..93d5f8bfa2 100644 --- a/checker/declarations.ml +++ b/checker/declarations.ml @@ -70,12 +70,12 @@ let solve_delta_kn resolve kn = | Equiv kn1 -> kn1 | Inline _ -> raise Not_found with Not_found -> - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in let new_mp = find_prefix resolve mp in if mp == new_mp then kn else - KerName.make new_mp dir l + KerName.make new_mp l let gen_of_delta resolve x kn fix_can = let new_kn = solve_delta_kn resolve kn in @@ -129,17 +129,17 @@ let subst_mp sub mp = | Some (mp',_) -> mp' let subst_kn_delta sub kn = - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in match subst_mp0 sub mp with Some (mp',resolve) -> - solve_delta_kn resolve (KerName.make mp' dir l) + solve_delta_kn resolve (KerName.make mp' l) | None -> kn let subst_kn sub kn = - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in match subst_mp0 sub mp with Some (mp',_) -> - KerName.make mp' dir l + KerName.make mp' l | None -> kn exception No_subst @@ -156,16 +156,16 @@ let gen_subst_mp f sub mp1 mp2 = | None, Some (mp',resolve) -> Canonical, (f mp1 mp'), resolve | Some (mp1',_), Some (mp2',resolve2) -> Canonical, (f mp1' mp2'), resolve2 -let make_mind_equiv mpu mpc dir l = - let knu = KerName.make mpu dir l in +let make_mind_equiv mpu mpc l = + let knu = KerName.make mpu l in if mpu == mpc then MutInd.make1 knu - else MutInd.make knu (KerName.make mpc dir l) + else MutInd.make knu (KerName.make mpc l) let subst_ind sub mind = let kn1,kn2 = MutInd.user mind, MutInd.canonical mind in - let mp1,dir,l = KerName.repr kn1 in - let mp2,_,_ = KerName.repr kn2 in - let rebuild_mind mp1 mp2 = make_mind_equiv mp1 mp2 dir l in + let mp1,l = KerName.repr kn1 in + let mp2,_ = KerName.repr kn2 in + let rebuild_mind mp1 mp2 = make_mind_equiv mp1 mp2 l in try let side,mind',resolve = gen_subst_mp rebuild_mind sub mp1 mp2 in match side with @@ -173,16 +173,16 @@ let subst_ind sub mind = | Canonical -> mind_of_delta2 resolve mind' with No_subst -> mind -let make_con_equiv mpu mpc dir l = - let knu = KerName.make mpu dir l in +let make_con_equiv mpu mpc l = + let knu = KerName.make mpu l in if mpu == mpc then Constant.make1 knu - else Constant.make knu (KerName.make mpc dir l) + else Constant.make knu (KerName.make mpc l) let subst_con0 sub con u = let kn1,kn2 = Constant.user con, Constant.canonical con in - let mp1,dir,l = KerName.repr kn1 in - let mp2,_,_ = KerName.repr kn2 in - let rebuild_con mp1 mp2 = make_con_equiv mp1 mp2 dir l in + let mp1,l = KerName.repr kn1 in + let mp2,_ = KerName.repr kn2 in + let rebuild_con mp1 mp2 = make_con_equiv mp1 mp2 l in let dup con = con, Const (con, u) in let side,con',resolve = gen_subst_mp rebuild_con sub mp1 mp2 in match constant_of_delta_with_inline resolve con' with diff --git a/checker/indtypes.ml b/checker/indtypes.ml index 1fd86bc368..0478765a81 100644 --- a/checker/indtypes.ml +++ b/checker/indtypes.ml @@ -34,7 +34,7 @@ let string_of_mp mp = if !Flags.debug then debug_string_of_mp mp else string_of_mp mp let prkn kn = - let (mp,_,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in str(string_of_mp mp ^ "." ^ Label.to_string l) let prcon c = let ck = Constant.canonical c in diff --git a/checker/modops.ml b/checker/modops.ml index b92d7bbf1f..541d009ff9 100644 --- a/checker/modops.ml +++ b/checker/modops.ml @@ -55,7 +55,7 @@ let module_body_of_type mp mtb = let rec add_structure mp sign resolver env = let add_one env (l,elem) = - let kn = KerName.make2 mp l in + let kn = KerName.make mp l in let con = Constant.make1 kn in let mind = mind_of_delta resolver (MutInd.make1 kn) in match elem with diff --git a/checker/values.ml b/checker/values.ml index 35027d5bfb..24f10b7a87 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -98,7 +98,7 @@ let rec v_mp = Sum("module_path",0, [|[|v_dp|]; [|v_uid|]; [|v_mp;v_id|]|]) -let v_kn = v_tuple "kernel_name" [|v_mp;v_dp;v_id;Int|] +let v_kn = v_tuple "kernel_name" [|v_mp;v_id;Int|] let v_cst = v_sum "cst|mind" 0 [|[|v_kn|];[|v_kn;v_kn|]|] let v_ind = v_tuple "inductive" [|v_cst;Int|] let v_cons = v_tuple "constructor" [|v_ind;Int|] diff --git a/clib/cArray.ml b/clib/cArray.ml index b9dcfd61d1..d3fa4ef65e 100644 --- a/clib/cArray.ml +++ b/clib/cArray.ml @@ -49,10 +49,6 @@ sig val map_to_list : ('a -> 'b) -> 'a array -> 'b list val map_of_list : ('a -> 'b) -> 'a list -> 'b array val chop : int -> 'a array -> 'a array * 'a array - val smartmap : ('a -> 'a) -> 'a array -> 'a array - [@@ocaml.deprecated "Same as [Smart.map]"] - val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array - [@@ocaml.deprecated "Same as [Smart.fold_left_map]"] val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val map3 : @@ -65,13 +61,6 @@ sig val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array val fold_left2_map_i : (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c - val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array - [@@ocaml.deprecated "Same as [fold_left_map]"] - val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c - [@@ocaml.deprecated "Same as [fold_right_map]"] - val fold_map2' : - ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c - [@@ocaml.deprecated "Same as [fold_right2_map]"] val distinct : 'a array -> bool val rev_of_list : 'a list -> 'a array val rev_to_list : 'a array -> 'a list @@ -86,8 +75,6 @@ sig module Fun1 : sig val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array - val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array - [@@ocaml.deprecated "Same as [Fun1.Smart.map]"] val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit module Smart : @@ -429,15 +416,11 @@ else let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in (v',!e') -let fold_map' = fold_right_map - let fold_left_map f e v = let e' = ref e in let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in (!e',v') -let fold_map = fold_left_map - let fold_right2_map f v1 v2 e = let e' = ref e in let v' = @@ -445,8 +428,6 @@ let fold_right2_map f v1 v2 e = in (v',!e') -let fold_map2' = fold_right2_map - let fold_left2_map f e v1 v2 = let e' = ref e in let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in @@ -617,10 +598,6 @@ struct end -(* Deprecated aliases *) -let smartmap = Smart.map -let smartfoldmap = Smart.fold_left_map - module Fun1 = struct @@ -687,6 +664,4 @@ struct end - let smartmap = Smart.map - end diff --git a/clib/cArray.mli b/clib/cArray.mli index 163191681a..f5b015b206 100644 --- a/clib/cArray.mli +++ b/clib/cArray.mli @@ -82,12 +82,6 @@ sig (** [chop i a] returns [(a1, a2)] s.t. [a = a1 + a2] and [length a1 = n]. Raise [Failure "Array.chop"] if [i] is not a valid index. *) - val smartmap : ('a -> 'a) -> 'a array -> 'a array - [@@ocaml.deprecated "Same as [Smart.map]"] - - val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array - [@@ocaml.deprecated "Same as [Smart.fold_left_map]"] - val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array (** See also [Smart.map2] *) @@ -121,16 +115,6 @@ sig val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c (** Same with two arrays, folding on the left *) - val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array - [@@ocaml.deprecated "Same as [fold_left_map]"] - - val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c - [@@ocaml.deprecated "Same as [fold_right_map]"] - - val fold_map2' : - ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c - [@@ocaml.deprecated "Same as [fold_right2_map]"] - val distinct : 'a array -> bool (** Return [true] if every element of the array is unique (for default equality). *) @@ -175,9 +159,6 @@ sig val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array (** [Fun1.map f x v = map (f x) v] *) - val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array - [@@ocaml.deprecated "Same as [Fun1.Smart.map]"] - val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit (** [Fun1.iter f x v = iter (f x) v] *) diff --git a/clib/cEphemeron.ml b/clib/cEphemeron.ml index 3136d66e34..d7cc0a4dc2 100644 --- a/clib/cEphemeron.ml +++ b/clib/cEphemeron.ml @@ -8,84 +8,103 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -type key_type = int - -type boxed_key = key_type ref ref - -let mk_key : unit -> boxed_key = - (* TODO: take a random value here. Is there a random function in OCaml? *) - let bid = ref 0 in - (* According to OCaml Gc module documentation, Pervasives.ref is one of the - few ways of getting a boxed value the compiler will never alias. *) - fun () -> incr bid; Pervasives.ref (Pervasives.ref !bid) - -(* A phantom type to preserve type safety *) -type 'a key = boxed_key - -(* Comparing keys with == grants that if a key is unmarshalled (in the same - process where it was created or in another one) it is not mistaken for - an already existing one (unmarshal has no right to alias). If the initial - value of bid is taken at random, then one also avoids potential collisions *) -module HT = Hashtbl.Make(struct - type t = key_type ref - let equal k1 k2 = k1 == k2 - let hash id = !id +(* Type-safe implementation by whitequark *) + +(* An extensible variant has an internal representation equivalent + to the following: + + type constr = { + name: string, + id: int + } + type value = (*Object_tag*) constr * v1 * v2... + + and the code generated by the compiler looks like: + + (* type X += Y *) + let constr_Y = alloc { "Y", %caml_fresh_oo_id () } + (* match x with Y -> a | _ -> b *) + if x.0 == constr_Y then a else b + + and the polymorphic comparison function works like: + + let equal = fun (c1, ...) (c2, ...) -> + c1.id == c2.id + + In every new extension constructor, the name field is a constant + string and the id field is filled with an unique[1] value returned + by %caml_fresh_oo_id. Moreover, every value of an extensible variant + type is allocated as a new block. + + [1]: On 64-bit systems. On 32-bit systems, calling %caml_fresh_oo_id + 2**30 times will result in a wraparound. Note that this does + not affect soundness because constructors are compared by + physical equality during matching. See OCaml PR7809 for code + demonstrating this. + + An extensible variant can be marshalled and unmarshalled, and + is guaranteed to not be equal to itself after unmarshalling, + since the id field is filled with another unique value. + + Note that the explanation above is purely informative and we + do not depend on the exact representation of extensible variants, + only on the fact that no two constructor representations ever + alias. In particular, if the definition of constr is replaced with: + + type constr = int + + (where the value is truly unique for every created constructor), + correctness is preserved. + *) +type 'a typ = .. + +(* Erases the contained type so that the key can be put in a hash table. *) +type boxkey = Box : 'a typ -> boxkey [@@unboxed] + +(* Carry the type we just erased with the actual key. *) +type 'a key = 'a typ * boxkey + +module EHashtbl = Ephemeron.K1.Make(struct + type t = boxkey + let equal = (==) + let hash = Hashtbl.hash end) -(* A key is the (unique) value inside a boxed key, hence it does not - keep its corresponding boxed key reachable (replacing key_type by boxed_key - would make the key always reachable) *) -let values : Obj.t HT.t = HT.create 1001 - -(* To avoid a race condition between the finalization function and - get/create on the values hashtable, the finalization function just - enqueues in an imperative list the item to be collected. Being the list - imperative, even if the Gc enqueues an item while run_collection is operating, - the tail of the list is eventually set to Empty on completion. - Kudos to the authors of Why3 that came up with this solution for their - implementation of weak hash tables! *) -type imperative_list = cell ref -and cell = Empty | Item of key_type ref * imperative_list - -let collection_queue : imperative_list ref = ref (ref Empty) - -let enqueue x = collection_queue := ref (Item (!x, !collection_queue)) - -let run_collection () = - let rec aux l = match !l with - | Empty -> () - | Item (k, tl) -> HT.remove values k; aux tl in - let l = !collection_queue in - aux l; - l := Empty - -(* The only reference to the boxed key is the one returned, when the user drops - it the value eventually disappears from the values table above *) -let create (v : 'a) : 'a key = - run_collection (); - let k = mk_key () in - HT.add values !k (Obj.repr v); - Gc.finalise enqueue k; - k +type value = { get : 'k. 'k typ -> 'k } [@@unboxed] + +let values : value EHashtbl.t = + EHashtbl.create 1001 + +let create : type v. v -> v key = + fun value -> + let module M = struct + type _ typ += Typ : v typ + + let get : type k. k typ -> k = + fun typ -> + match typ with + | Typ -> value + | _ -> assert false + + let boxkey = Box Typ + let key = Typ, boxkey + let value = { get } + end in + EHashtbl.add values M.boxkey M.value; + M.key (* Avoid raising Not_found *) exception InvalidKey -let get (k : 'a key) : 'a = - run_collection (); - try Obj.obj (HT.find values !k) +let get (typ, boxkey) = + try (EHashtbl.find values boxkey).get typ with Not_found -> raise InvalidKey -(* Simple utils *) -let default k v = - try get k - with InvalidKey -> v +let default (typ, boxkey) default = + try (EHashtbl.find values boxkey).get typ + with Not_found -> default -let iter_opt k f = - match - try Some (get k) - with InvalidKey -> None - with - | None -> () - | Some v -> f v +let iter_opt (typ, boxkey) f = + try f ((EHashtbl.find values boxkey).get typ) + with Not_found -> () -let clear () = run_collection () +let clean () = EHashtbl.clean values diff --git a/clib/cEphemeron.mli b/clib/cEphemeron.mli index 8e753d0b62..96391e10fa 100644 --- a/clib/cEphemeron.mli +++ b/clib/cEphemeron.mli @@ -33,7 +33,7 @@ An ['a key] can always be marshalled. When marshalled, a key loses its value. The function [get] raises Not_found on unmarshalled keys. - + If a key is garbage collected, the corresponding value is garbage collected too (unless extra references to it exist). In short no memory management hassle, keys can just replace their @@ -48,7 +48,7 @@ exception InvalidKey val get : 'a key -> 'a (* These never fail. *) -val iter_opt : 'a key -> ('a -> unit) -> unit val default : 'a key -> 'a -> 'a +val iter_opt : 'a key -> ('a -> unit) -> unit -val clear : unit -> unit +val clean : unit -> unit diff --git a/clib/cList.ml b/clib/cList.ml index dc59ff2970..aba3e46bd5 100644 --- a/clib/cList.ml +++ b/clib/cList.ml @@ -36,16 +36,12 @@ sig val filteri : (int -> 'a -> bool) -> 'a list -> 'a list val filter_with : bool list -> 'a list -> 'a list - val smartfilter : ('a -> bool) -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [filter]"] val map_filter : ('a -> 'b option) -> 'a list -> 'b list val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list val map : ('a -> 'b) -> 'a list -> 'b list val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - val smartmap : ('a -> 'a) -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [Smart.map]"] val map_left : ('a -> 'b) -> 'a list -> 'b list val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list val map2_i : @@ -75,10 +71,6 @@ sig val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list - val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list - [@@ocaml.deprecated "Same as [fold_left_map]"] - val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a - [@@ocaml.deprecated "Same as [fold_right_map]"] val except : 'a eq -> 'a -> 'a list -> 'a list val remove : 'a eq -> 'a -> 'a list -> 'a list val remove_first : ('a -> bool) -> 'a list -> 'a list @@ -116,8 +108,6 @@ sig val unionq : 'a list -> 'a list -> 'a list val subtract : 'a eq -> 'a list -> 'a list -> 'a list val subtractq : 'a list -> 'a list -> 'a list - val merge_uniq : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [merge_set]"] val distinct : 'a list -> bool val distinct_f : 'a cmp -> 'a list -> bool val duplicates : 'a eq -> 'a list -> 'a list @@ -337,8 +327,6 @@ let filteri p = in filter_i_rec 0 -let smartfilter = filter (* Alias *) - let rec filter_with_loop filter p l = match filter, l with | [], [] -> () | b :: filter, x :: l' -> @@ -618,8 +606,6 @@ let rec fold_left_map f e = function let e'',t' = fold_left_map f e' t in e'',h' :: t' -let fold_map = fold_left_map - (* (* tail-recursive version of the above function *) let fold_left_map f e l = let g (e,b') h = @@ -634,8 +620,6 @@ let fold_left_map f e l = let fold_right_map f l e = List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e) -let fold_map' = fold_right_map - let on_snd f (x,y) = (x,f y) let fold_left2_map f e l l' = @@ -905,8 +889,6 @@ let rec merge_set cmp l1 l2 = match l1, l2 with then h1 :: merge_set cmp t1 l2 else h2 :: merge_set cmp l1 t2 -let merge_uniq = merge_set - let intersect cmp l1 l2 = filter (fun x -> mem_f cmp x l2) l1 @@ -1047,8 +1029,6 @@ struct end -let smartmap = Smart.map - module type MonoS = sig type elt val equal : elt list -> elt list -> bool diff --git a/clib/cList.mli b/clib/cList.mli index 39d9a5e535..8582e6cd65 100644 --- a/clib/cList.mli +++ b/clib/cList.mli @@ -91,9 +91,6 @@ sig (** [filter_with bl l] selects elements of [l] whose corresponding element in [bl] is [true]. Raise [Invalid_argument _] if sizes differ. *) - val smartfilter : ('a -> bool) -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [filter]"] - val map_filter : ('a -> 'b option) -> 'a list -> 'b list (** Like [map] but keeping only non-[None] elements *) @@ -111,9 +108,6 @@ sig val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** Like OCaml [List.map2] but tail-recursive *) - val smartmap : ('a -> 'a) -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [Smart.map]"] - val map_left : ('a -> 'b) -> 'a list -> 'b list (** As [map] but ensures the left-to-right order of evaluation. *) @@ -208,12 +202,6 @@ sig val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list (** Same with four lists, folding on the left *) - val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list - [@@ocaml.deprecated "Same as [fold_left_map]"] - - val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a - [@@ocaml.deprecated "Same as [fold_right_map]"] - (** {6 Splitting} *) val except : 'a eq -> 'a -> 'a list -> 'a list @@ -357,9 +345,6 @@ sig val subtractq : 'a list -> 'a list -> 'a list (** [subtract] specialized to physical equality *) - val merge_uniq : 'a cmp -> 'a list -> 'a list -> 'a list - [@@ocaml.deprecated "Same as [merge_set]"] - (** {6 Uniqueness and duplication} *) val distinct : 'a list -> bool diff --git a/clib/cMap.ml b/clib/cMap.ml index 54a8b25851..040dede0a2 100644 --- a/clib/cMap.ml +++ b/clib/cMap.ml @@ -34,10 +34,6 @@ sig val bind : (key -> 'a) -> Set.t -> 'a t val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val smartmap : ('a -> 'a) -> 'a t -> 'a t - [@@ocaml.deprecated "Same as [Smart.map]"] - val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t - [@@ocaml.deprecated "Same as [Smart.mapi]"] val height : 'a t -> int module Smart : sig @@ -65,10 +61,6 @@ sig val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b - val smartmap : ('a -> 'a) -> 'a map -> 'a map - [@@ocaml.deprecated "Same as [Smart.map]"] - val smartmapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map - [@@ocaml.deprecated "Same as [Smart.mapi]"] val height : 'a map -> int module Smart : sig @@ -195,9 +187,6 @@ struct end - let smartmap = Smart.map - let smartmapi = Smart.mapi - module Unsafe = struct diff --git a/clib/cMap.mli b/clib/cMap.mli index 127bf23ab6..f5496239f6 100644 --- a/clib/cMap.mli +++ b/clib/cMap.mli @@ -57,12 +57,6 @@ sig val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** Folding keys in decreasing order. *) - val smartmap : ('a -> 'a) -> 'a t -> 'a t - [@@ocaml.deprecated "Same as [Smart.map]"] - - val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t - [@@ocaml.deprecated "Same as [Smart.mapi]"] - val height : 'a t -> int (** An indication of the logarithmic size of a map *) diff --git a/clib/hMap.ml b/clib/hMap.ml index b2cf474304..33cb6d0131 100644 --- a/clib/hMap.ml +++ b/clib/hMap.ml @@ -396,9 +396,6 @@ struct end - let smartmap = Smart.map - let smartmapi = Smart.mapi - let height s = Int.Map.height s module Unsafe = diff --git a/clib/option.ml b/clib/option.ml index 7a3d5f934f..3e57fd5c85 100644 --- a/clib/option.ml +++ b/clib/option.ml @@ -131,8 +131,6 @@ let fold_right_map f x a = | Some y -> let z, a = f y a in Some z, a | _ -> None, a -let fold_map = fold_left_map - (** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *) let cata f a = function | Some c -> f c @@ -183,8 +181,6 @@ struct end -let smartmap = Smart.map - (** {6 Operations with Lists} *) module List = diff --git a/clib/option.mli b/clib/option.mli index 8f82bf090b..e99c8015c4 100644 --- a/clib/option.mli +++ b/clib/option.mli @@ -75,9 +75,6 @@ val iter2 : ('a -> 'b -> unit) -> 'a option -> 'b option -> unit (** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *) val map : ('a -> 'b) -> 'a option -> 'b option -val smartmap : ('a -> 'a) -> 'a option -> 'a option -[@@ocaml.deprecated "Same as [Smart.map]"] - (** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *) val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a option -> 'b @@ -95,10 +92,6 @@ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option (** Same as [fold_left_map] on the right *) val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a -(** @deprecated Same as [fold_left_map] *) -val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option -[@@ocaml.deprecated "Same as [fold_left_map]"] - (** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *) val cata : ('a -> 'b) -> 'b -> 'a option -> 'b diff --git a/configure.ml b/configure.ml index a508ac6071..7cc58a3506 100644 --- a/configure.ml +++ b/configure.ml @@ -525,22 +525,10 @@ let arch_is_win32 = (arch = "win32") let exe = exe := if arch_is_win32 then ".exe" else ""; !exe let dll = if os_type_win32 then ".dll" else ".so" -(** * VCS - - Is the source tree checked out from a recognised - Version Control System ? *) - -let vcs = - let git_dir = try Sys.getenv "GIT_DIR" with Not_found -> ".git" in - if Sys.file_exists git_dir then "git" - else if Sys.file_exists ".svn/entries" then "svn" - else if dir_exists "{arch}" then "gnuarch" - else "none" - (** * Git Precommit Hook *) let _ = let f = ".git/hooks/pre-commit" in - if vcs = "git" && dir_exists ".git/hooks" && not (Sys.file_exists f) then begin + if dir_exists ".git/hooks" && not (Sys.file_exists f) then begin cprintf "Creating pre-commit hook in %s" f; let o = open_out f in let pr s = fprintf o s in @@ -1341,7 +1329,6 @@ let write_makefile f = pr "IDECDEPSFLAGS=%s\n" !idecdepsflags; pr "IDEINT=%s\n\n" !idearchdef; pr "# Defining REVISION\n"; - pr "CHECKEDOUT=%s\n\n" vcs; pr "# Option to control compilation and installation of the documentation\n"; pr "WITHDOC=%s\n\n" (if !prefs.withdoc then "all" else "no"); pr "# Option to produce precompiled files for native_compute\n"; diff --git a/dev/base_include b/dev/base_include index 6f54ecb241..67a7e87d78 100644 --- a/dev/base_include +++ b/dev/base_include @@ -99,7 +99,6 @@ open Evarutil open Evarsolve open Tacred open Evd -open Universes open Termops open Namegen open Indrec diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index 5f07aa8fca..b8bea755e0 100755 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -1374,7 +1374,7 @@ function copy_coq_license { # FIXME: this is not the micromega license # It only applies to code that was copied into one single file! install -D README.md "$PREFIXCOQ/license_readme/coq/ReadMe.md" - install -D CHANGES "$PREFIXCOQ/license_readme/coq/Changes.txt" + install -D CHANGES.md "$PREFIXCOQ/license_readme/coq/Changes.md" install -D INSTALL "$PREFIXCOQ/license_readme/coq/Install.txt" install -D doc/README.md "$PREFIXCOQ/license_readme/coq/ReadMeDoc.md" || true fi diff --git a/dev/ci/README.md b/dev/ci/README.md index 1c098e5f46..7853866f62 100644 --- a/dev/ci/README.md +++ b/dev/ci/README.md @@ -126,7 +126,7 @@ patch (or ask someone to prepare a patch) to fix the project: developer who merges the PR on Coq. There are plans to improve this, cf. [#6724](https://github.com/coq/coq/issues/6724). -Moreover your PR must absolutely update the [`CHANGES`](../../CHANGES) file. +Moreover your PR must absolutely update the [`CHANGES.md`](../../CHANGES.md) file. Advanced GitLab CI information ------------------------------ diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh index 1b1aeafa0d..511eaaba9c 100755 --- a/dev/ci/ci-basic-overlay.sh +++ b/dev/ci/ci-basic-overlay.sh @@ -49,11 +49,12 @@ ######################################################################## # Iris ######################################################################## -: "${stdpp_CI_REF:=master}" + +# NB: stdpp and Iris refs are gotten from the opam files in the Iris +# and lambdaRust repos respectively. : "${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp}" : "${stdpp_CI_ARCHIVEURL:=${stdpp_CI_GITURL}/-/archive}" -: "${Iris_CI_REF:=master}" : "${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/FP/iris-coq}" : "${Iris_CI_ARCHIVEURL:=${Iris_CI_GITURL}/-/archive}" diff --git a/dev/ci/ci-iris-lambda-rust.sh b/dev/ci/ci-iris-lambda-rust.sh index 6960a8b98a..95f143bb95 100755 --- a/dev/ci/ci-iris-lambda-rust.sh +++ b/dev/ci/ci-iris-lambda-rust.sh @@ -9,13 +9,13 @@ install_ssreflect git_download lambdaRust # Extract required version of Iris -Iris_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambdaRust/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') +Iris_CI_REF=$(grep -F coq-iris < "${CI_BUILD_DIR}/lambdaRust/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') # Setup Iris git_download Iris # Extract required version of std++ -stdpp_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/Iris/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') +stdpp_CI_REF=$(grep -F coq-stdpp < "${CI_BUILD_DIR}/Iris/opam" | sed 's/.*"dev\.[0-9.-]\+\.\([0-9a-z]\+\)".*/\1/') # Setup std++ git_download stdpp diff --git a/dev/ci/user-overlays/08554-herbelin-master+fix8553-change-under-binders.sh b/dev/ci/user-overlays/08554-herbelin-master+fix8553-change-under-binders.sh new file mode 100644 index 0000000000..484ad8f9e6 --- /dev/null +++ b/dev/ci/user-overlays/08554-herbelin-master+fix8553-change-under-binders.sh @@ -0,0 +1,11 @@ +if [ "$CI_PULL_REQUEST" = "8554" ] || [ "$CI_BRANCH" = "master+fix8553-change-under-binders" ]; then + + ltac2_CI_BRANCH=master+fix-pr8554-change-takes-env + ltac2_CI_REF=master+fix-pr8554-change-takes-env + ltac2_CI_GITURL=https://github.com/herbelin/ltac2 + + Equations_CI_BRANCH=master+fix-pr8554-change-takes-env + Equations_CI_REF=master+fix-pr8554-change-takes-env + Equations_CI_GITURL=https://github.com/herbelin/Coq-Equations + +fi diff --git a/dev/ci/user-overlays/08555-maximedenes-rm-section-path.sh b/dev/ci/user-overlays/08555-maximedenes-rm-section-path.sh new file mode 100644 index 0000000000..41c2ad6fef --- /dev/null +++ b/dev/ci/user-overlays/08555-maximedenes-rm-section-path.sh @@ -0,0 +1,9 @@ +if [ "$CI_PULL_REQUEST" = "8555" ] || [ "$CI_BRANCH" = "rm-section-path" ]; then + + ltac2_CI_REF=rm-section-path + ltac2_CI_GITURL=https://github.com/maximedenes/ltac2 + + Equations_CI_REF=rm-section-path + Equations_CI_GITURL=https://github.com/maximedenes/Coq-Equations + +fi diff --git a/dev/doc/MERGING.md b/dev/doc/MERGING.md index c0cd9c8cdd..000f21c254 100644 --- a/dev/doc/MERGING.md +++ b/dev/doc/MERGING.md @@ -54,7 +54,7 @@ those external projects should have been prepared (cf. the relevant sub-section in the [CI README](../ci/README.md#Breaking-changes) and the PR can be tested with these fixes thanks to ["overlays"](../ci/user-overlays/README.md). -Moreover the PR must absolutely update the [`CHANGES`](../../CHANGES) file. +Moreover the PR must absolutely update the [`CHANGES.md`](../../CHANGES.md) file. If overlays are missing, ask the author to prepare them and label the PR with the [needs: overlay](https://github.com/coq/coq/labels/needs%3A%20overlay) label. @@ -93,7 +93,7 @@ When the PR has conflicts, the assignee can either: In both cases, CI should be run again. -In some rare cases (e.g. the conflicts are in the CHANGES file), it is ok to fix +In some rare cases (e.g. the conflicts are in the `CHANGES.md` file), it is ok to fix the conflicts in the merge commit (following the same steps as below), and push to `master` directly. Don't use the GitHub interface to fix these conflicts. diff --git a/dev/doc/changes.md b/dev/doc/changes.md index fdeb0abed4..7e64f80ac5 100644 --- a/dev/doc/changes.md +++ b/dev/doc/changes.md @@ -2,10 +2,22 @@ ### ML API -Termops: +General deprecation -- Internal printing functions have been placed under the - `Termops.Internal` namespace. +- All functions marked [@@ocaml.deprecated] in 8.8 have been + removed. Please, make sure your plugin is warning-free in 8.8 before + trying to port it over 8.9. + +Names + +- Kernel names no longer contain a section path. They now have only two + components (module path and label), which led to some changes in the API: + + KerName.make takes only 2 components + KerName.repr returns only 2 components + KerName.make2 is now KerName.make + Constant.make3 has been removed, use Constant.make2 + Constant.repr3 has been removed, use Constant.repr2 ## Changes between Coq 8.8 and Coq 8.9 @@ -16,8 +28,8 @@ Names - In `Libnames`, the type `reference` and its two constructors `Qualid` and `Ident` have been removed in favor of `qualid`. `Qualid` is now the identity, `Ident` can be replaced by `qualid_of_ident`. Matching over `reference` can be - replaced by a test using `qualid_is_ident`. Extracting the ident part of a - qualid can be done using `qualid_basename`. + replaced by a test using `qualid_is_ident`. Extracting the `ident` part of a + `qualid` can be done using `qualid_basename`. Misctypes @@ -51,20 +63,20 @@ Proof engine ML Libraries used by Coq -- Introduction of a "Smart" module for collecting "smart*" functions, e.g. - Array.Smart.map. -- Uniformization of some names, e.g. Array.Smart.fold_left_map instead - of Array.smartfoldmap. +- Introduction of a `Smart` module for collecting `smart*` functions, e.g. + `Array.Smart.map`. +- Uniformization of some names, e.g. `Array.Smart.fold_left_map` instead + of `Array.smartfoldmap`. Printer.ml API -- The mechanism in Printer that allowed dynamically overriding pr_subgoals, - pr_subgoal and pr_goal was removed to simplify the code. It was - earlierly used by PCoq. +- The mechanism in `Printer` that allowed dynamically overriding `pr_subgoals`, + `pr_subgoal` and `pr_goal` was removed to simplify the code. It was + earlier used by PCoq. Kernel - The following renamings happened: +- The following renamings happened: - `Context.Rel.t` into `Constr.rel_context` - `Context.Named.t` into `Constr.named_context` - `Context.Compacted.t` into `Constr.compacted_context` @@ -93,19 +105,24 @@ Vernacular commands Primitive number parsers -- For better modularity, the primitive parsers for positive, N and Z - have been split over three files (plugins/syntax/positive_syntax.ml, - plugins/syntax/n_syntax.ml, plugins/syntax/z_syntax.ml). +- For better modularity, the primitive parsers for `positive`, `N` and `Z` + have been split over three files (`plugins/syntax/positive_syntax.ml`, + `plugins/syntax/n_syntax.ml`, `plugins/syntax/z_syntax.ml`). Parsing -- Manual uses of the Pcoq.Gram module have been deprecated. Wrapper modules - Pcoq.Entry and Pcoq.Parsable were introduced to replace it. +- Manual uses of the `Pcoq.Gram` module have been deprecated. Wrapper modules + `Pcoq.Entry` and `Pcoq.Parsable` were introduced to replace it. + +Termops + +- Internal printing functions have been placed under the + `Termops.Internal` namespace. ### Unit testing - The test suite now allows writing unit tests against OCaml code in the Coq - code base. Those unit tests create a dependency on the OUnit test framework. +The test suite now allows writing unit tests against OCaml code in the Coq +code base. Those unit tests create a dependency on the OUnit test framework. ### Transitioning away from Camlp5 @@ -140,7 +157,7 @@ let myval = 0 Steps to perform: - replace the brackets enclosing OCaml code in actions with braces -- if not there yet, add a leading `|̀ to the first rule +- if not there yet, add a leading `|` to the first rule For instance, code of the form: ``` @@ -171,8 +188,8 @@ Most plugin writers do not need this low-level interface, but for the sake of completeness we document it. Steps to perform are: -- replace GEXTEND with GRAMMAR EXTEND -- wrap every occurrence of OCaml code in actions into braces { } +- replace `GEXTEND` with `GRAMMAR EXTEND` +- wrap every occurrence of OCaml code in actions into braces `{ }` For instance, code of the form ``` @@ -222,7 +239,7 @@ All the other bugs kept their number. General deprecation -- All functions marked [@@ocaml.deprecated] in 8.7 have been +- All functions marked `[@@ocaml.deprecated]` in 8.7 have been removed. Please, make sure your plugin is warning-free in 8.7 before trying to port it over 8.8. @@ -250,8 +267,8 @@ We changed the type of the following functions: - `Global.body_of_constant`: same as above. -- `Constrinterp.*` generally, many functions that used to take an - `evar_map ref` have been now switched to functions that will work in +- `Constrinterp.*`: generally, many functions that used to take an + `evar_map ref` have now been switched to functions that will work in a functional way. The old style of passing `evar_map`s as references is not supported anymore. @@ -269,16 +286,16 @@ We have changed the representation of the following types: Some tactics and related functions now support static configurability, e.g.: -- injectable, dEq, etc. takes an argument ~keep_proofs which, - - if None, tells to behave as told with the flag Keep Proof Equalities - - if Some b, tells to keep proof equalities iff b is true +- `injectable`, `dEq`, etc. take an argument `~keep_proofs` which, + - if `None`, tells to behave as told with the flag `Keep Proof Equalities` + - if `Some b`, tells to keep proof equalities iff `b` is true Declaration of printers for arguments used only in vernac command -- It should now use "declare_extra_vernac_genarg_pprule" rather than - "declare_extra_genarg_pprule", otherwise, a failure at runtime might +- It should now use `declare_extra_vernac_genarg_pprule` rather than + `declare_extra_genarg_pprule`, otherwise, a failure at runtime might happen. An alternative is to register the corresponding argument as - a value, using "Geninterp.register_val0 wit None". + a value, using `Geninterp.register_val0 wit None`. Types Alias deprecation and type relocation. @@ -321,7 +338,7 @@ functions when some given constants are traversed: * `declare_reduction_effect`: to declare a hook to be applied when some constant are visited during the execution of some reduction functions - (primarily cbv). + (primarily `cbv`). * `set_reduction_effect`: to declare a constant on which a given effect hook should be called. diff --git a/dev/tools/make_git_revision.sh b/dev/tools/make_git_revision.sh new file mode 100755 index 0000000000..84982f89b9 --- /dev/null +++ b/dev/tools/make_git_revision.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash + +if [ -x `which git` ] && [ -d .git ] || git rev-parse --git-dir > /dev/null 2>&1 +then + export LANG=C + GIT_BRANCH=$(git branch -a | sed -ne '/^\* /s/^\* \(.*\)/\1/p') + GIT_HOST=$(hostname) + GIT_PATH=$(pwd) + echo "${GIT_HOST}:${GIT_PATH},${GIT_BRANCH}" + echo $(git log -1 --pretty='format:%H') +fi diff --git a/dev/tools/update-compat.py b/dev/tools/update-compat.py index 7c8b9f025c..14094553a2 100755 --- a/dev/tools/update-compat.py +++ b/dev/tools/update-compat.py @@ -17,7 +17,7 @@ FLAGS_ML_PATH = os.path.join(ROOT_PATH, 'lib', 'flags.ml') COQARGS_ML_PATH = os.path.join(ROOT_PATH, 'toplevel', 'coqargs.ml') G_VERNAC_PATH = os.path.join(ROOT_PATH, 'vernac', 'g_vernac.mlg') DOC_INDEX_PATH = os.path.join(ROOT_PATH, 'doc', 'stdlib', 'index-list.html.template') -BUG_4798_PATH = os.path.join(ROOT_PATH, 'test-suite', 'bugs', 'closed', '4798.v') +BUG_4798_PATH = os.path.join(ROOT_PATH, 'test-suite', 'bugs', 'closed', 'bug_4798.v') TEST_SUITE_PATHS = tuple(os.path.join(ROOT_PATH, 'test-suite', 'success', i) for i in ('CompatOldOldFlag.v', 'CompatOldFlag.v', 'CompatPreviousFlag.v', 'CompatCurrentFlag.v')) TEST_SUITE_DESCRIPTIONS = ('current-minus-three', 'current-minus-two', 'current-minus-one', 'current') diff --git a/dev/top_printers.ml b/dev/top_printers.ml index e15fd776b2..8129a4a867 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -552,23 +552,22 @@ open Libnames let encode_path ?loc prefix mpdir suffix id = let dir = match mpdir with | None -> [] - | Some (mp,dir) -> - (DirPath.repr (dirpath_of_string (ModPath.to_string mp))@ - DirPath.repr dir) in + | Some mp -> DirPath.repr (dirpath_of_string (ModPath.to_string mp)) + in make_qualid ?loc (DirPath.make (List.rev (Id.of_string prefix::dir@suffix))) id let raw_string_of_ref ?loc _ = function | ConstRef cst -> - let (mp,dir,id) = Constant.repr3 cst in - encode_path ?loc "CST" (Some (mp,dir)) [] (Label.to_id id) + let (mp,id) = Constant.repr2 cst in + encode_path ?loc "CST" (Some mp) [] (Label.to_id id) | IndRef (kn,i) -> - let (mp,dir,id) = MutInd.repr3 kn in - encode_path ?loc "IND" (Some (mp,dir)) [Label.to_id id] + let (mp,id) = MutInd.repr2 kn in + encode_path ?loc "IND" (Some mp) [Label.to_id id] (Id.of_string ("_"^string_of_int i)) | ConstructRef ((kn,i),j) -> - let (mp,dir,id) = MutInd.repr3 kn in - encode_path ?loc "CSTR" (Some (mp,dir)) + let (mp,id) = MutInd.repr2 kn in + encode_path ?loc "CSTR" (Some mp) [Label.to_id id;Id.of_string ("_"^string_of_int i)] (Id.of_string ("_"^string_of_int j)) | VarRef id -> @@ -576,14 +575,14 @@ let raw_string_of_ref ?loc _ = function let short_string_of_ref ?loc _ = function | VarRef id -> qualid_of_ident ?loc id - | ConstRef cst -> qualid_of_ident ?loc (Label.to_id (pi3 (Constant.repr3 cst))) - | IndRef (kn,0) -> qualid_of_ident ?loc (Label.to_id (pi3 (MutInd.repr3 kn))) + | ConstRef cst -> qualid_of_ident ?loc (Label.to_id (Constant.label cst)) + | IndRef (kn,0) -> qualid_of_ident ?loc (Label.to_id (MutInd.label kn)) | IndRef (kn,i) -> - encode_path ?loc "IND" None [Label.to_id (pi3 (MutInd.repr3 kn))] + encode_path ?loc "IND" None [Label.to_id (MutInd.label kn)] (Id.of_string ("_"^string_of_int i)) | ConstructRef ((kn,i),j) -> encode_path ?loc "CSTR" None - [Label.to_id (pi3 (MutInd.repr3 kn));Id.of_string ("_"^string_of_int i)] + [Label.to_id (MutInd.label kn);Id.of_string ("_"^string_of_int i)] (Id.of_string ("_"^string_of_int j)) (* Anticipate that printers can be used from ocamldebug and that diff --git a/doc/sphinx/credits-contents.rst b/doc/sphinx/credits-contents.rst index 212f0a65b0..d1df0657aa 100644 --- a/doc/sphinx/credits-contents.rst +++ b/doc/sphinx/credits-contents.rst @@ -1238,7 +1238,7 @@ of integers and real constants are now represented using `IZR` (work by Guillaume Melquiond). Standard library additions and improvements by Jason Gross, Pierre Letouzey and -others, documented in the `CHANGES` file. +others, documented in the ``CHANGES.md`` file. The mathematical proof language/declarative mode plugin was removed from the archive. @@ -1352,7 +1352,7 @@ version. Version 8.8 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system. -Most important ones are documented in the ``CHANGES`` file. +Most important ones are documented in the ``CHANGES.md`` file. The efficiency of the whole system has seen improvements thanks to contributions from Gaëtan Gilbert, Pierre-Marie Pédrot, Maxime Dénès and @@ -9,3 +9,13 @@ (name vodeps) (deps tools/coq_dune.exe .vfiles.d)) ; (action (run coq_dune .vfiles.d)))) + +(install + (section lib) + (files + revision)) + +(rule + (targets revision) + (deps (:rev-script dev/tools/make_git_revision.sh)) + (action (with-stdout-to revision (run %{rev-script})))) diff --git a/engine/evarutil.ml b/engine/evarutil.ml index b1d880b0ad..fc2189f870 100644 --- a/engine/evarutil.ml +++ b/engine/evarutil.ml @@ -11,7 +11,6 @@ open CErrors open Util open Names -open Term open Constr open Environ open Evd @@ -43,9 +42,6 @@ let evd_comb2 f evdref x y = evdref := evd'; z -let e_new_global evdref x = - evd_comb1 (Evd.fresh_global (Global.env())) evdref x - let new_global evd x = let (evd, c) = Evd.fresh_global (Global.env()) evd x in (evd, c) @@ -87,23 +83,6 @@ let tj_nf_evar sigma {utj_val=v;utj_type=t} = let nf_evars_universes evm = UnivSubst.nf_evars_and_universes_opt_subst (safe_evar_value evm) (Evd.universe_subst evm) - -let nf_evars_and_universes evm = - let evm = Evd.minimize_universes evm in - evm, nf_evars_universes evm - -let e_nf_evars_and_universes evdref = - evdref := Evd.minimize_universes !evdref; - nf_evars_universes !evdref, Evd.universe_subst !evdref - -let nf_evar_map_universes evm = - let evm = Evd.minimize_universes evm in - let subst = Evd.universe_subst evm in - if Univ.LMap.is_empty subst then evm, nf_evar0 evm - else - let f = nf_evars_universes evm in - let f' c = EConstr.of_constr (f (EConstr.Unsafe.to_constr c)) in - Evd.raw_map (fun _ -> map_evar_info f') evm, f let nf_named_context_evar sigma ctx = Context.Named.map (nf_evar0 sigma) ctx @@ -490,26 +469,11 @@ let new_type_evar ?src ?filter ?naming ?principal ?hypnaming env evd rigid = let (evd', e) = new_evar env evd' ?src ?filter ?naming ?principal ?hypnaming (EConstr.mkSort s) in evd', (e, s) -let e_new_type_evar env evdref ?src ?filter ?naming ?principal ?hypnaming rigid = - let (evd, c) = new_type_evar env !evdref ?src ?filter ?naming ?principal ?hypnaming rigid in - evdref := evd; - c - let new_Type ?(rigid=Evd.univ_flexible) evd = let open EConstr in let (evd, s) = new_sort_variable rigid evd in (evd, mkSort s) -let e_new_Type ?(rigid=Evd.univ_flexible) evdref = - let evd', s = new_sort_variable rigid !evdref in - evdref := evd'; EConstr.mkSort s - - (* The same using side-effect *) -let e_new_evar env evdref ?(src=default_source) ?filter ?candidates ?store ?naming ?principal ?hypnaming ty = - let (evd',ev) = new_evar env !evdref ~src:src ?filter ?candidates ?store ?naming ?principal ?hypnaming ty in - evdref := evd'; - ev - (* Safe interface to unification problems *) type unification_pb = conv_pb * env * EConstr.constr * EConstr.constr @@ -853,7 +817,7 @@ let occur_evar_upto sigma n c = let judge_of_new_Type evd = let open EConstr in let (evd', s) = new_univ_variable univ_rigid evd in - (evd', { uj_val = mkSort (Type s); uj_type = mkSort (Type (Univ.super s)) }) + (evd', { uj_val = mkSort (Sorts.Type s); uj_type = mkSort (Sorts.Type (Univ.super s)) }) let subterm_source evk ?where (loc,k) = let evk = match k with diff --git a/engine/evarutil.mli b/engine/evarutil.mli index 0ad323ac4b..11e07175e3 100644 --- a/engine/evarutil.mli +++ b/engine/evarutil.mli @@ -173,14 +173,6 @@ val nf_evar_map_undefined : evar_map -> evar_map val nf_evars_universes : evar_map -> Constr.constr -> Constr.constr -val nf_evars_and_universes : evar_map -> evar_map * (Constr.constr -> Constr.constr) -[@@ocaml.deprecated "Use Evd.minimize_universes and nf_evars_universes"] - -(** Normalize the evar map w.r.t. universes, after simplification of constraints. - Return the substitution function for constrs as well. *) -val nf_evar_map_universes : evar_map -> evar_map * (Constr.constr -> Constr.constr) -[@@ocaml.deprecated "Use Evd.minimize_universes and nf_evar_map and nf_evars_universes"] - (** Replacing all evars, possibly raising [Uninstantiated_evar] *) exception Uninstantiated_evar of Evar.t val flush_and_check_evars : evar_map -> constr -> Constr.constr @@ -266,32 +258,13 @@ val generalize_evar_over_rels : evar_map -> existential -> types * constr list (** Evar combinators *) val evd_comb0 : (evar_map -> evar_map * 'a) -> evar_map ref -> 'a +[@@ocaml.deprecated "References to [evar_map] are deprecated, please update your API calls"] val evd_comb1 : (evar_map -> 'b -> evar_map * 'a) -> evar_map ref -> 'b -> 'a +[@@ocaml.deprecated "References to [evar_map] are deprecated, please update your API calls"] val evd_comb2 : (evar_map -> 'b -> 'c -> evar_map * 'a) -> evar_map ref -> 'b -> 'c -> 'a +[@@ocaml.deprecated "References to [evar_map] are deprecated, please update your API calls"] val subterm_source : Evar.t -> ?where:Evar_kinds.subevar_kind -> Evar_kinds.t Loc.located -> Evar_kinds.t Loc.located val meta_counter_summary_tag : int Summary.Dyn.tag - -val e_new_evar : - env -> evar_map ref -> ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> - ?candidates:constr list -> ?store:Store.t -> - ?naming:intro_pattern_naming_expr -> - ?principal:bool -> ?hypnaming:naming_mode -> types -> constr -[@@ocaml.deprecated "Use [Evarutil.new_evar]"] - -val e_new_type_evar : env -> evar_map ref -> - ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> - ?naming:intro_pattern_naming_expr -> - ?principal:bool -> ?hypnaming:naming_mode -> rigid -> constr * Sorts.t -[@@ocaml.deprecated "Use [Evarutil.new_type_evar]"] - -val e_new_Type : ?rigid:rigid -> evar_map ref -> constr -[@@ocaml.deprecated "Use [Evarutil.new_Type]"] - -val e_new_global : evar_map ref -> GlobRef.t -> constr -[@@ocaml.deprecated "Use [Evarutil.new_global]"] - -val e_nf_evars_and_universes : evar_map ref -> (Constr.constr -> Constr.constr) * UnivSubst.universe_opt_subst -[@@ocaml.deprecated "Use Evd.minimize_universes and nf_evars_universes"] diff --git a/engine/namegen.ml b/engine/namegen.ml index 2a59b914db..7ce759a3fb 100644 --- a/engine/namegen.ml +++ b/engine/namegen.ml @@ -76,9 +76,9 @@ let is_imported_ref = function | VarRef _ -> false | IndRef (kn,_) | ConstructRef ((kn,_),_) -> - let (mp,_,_) = MutInd.repr3 kn in is_imported_modpath mp + let mp = MutInd.modpath kn in is_imported_modpath mp | ConstRef kn -> - let (mp,_,_) = Constant.repr3 kn in is_imported_modpath mp + let mp = Constant.modpath kn in is_imported_modpath mp let is_global id = try diff --git a/engine/termops.mli b/engine/termops.mli index 0e5d564d3f..64e3977d68 100644 --- a/engine/termops.mli +++ b/engine/termops.mli @@ -335,16 +335,4 @@ val pr_rel_decl : env -> Constr.rel_declaration -> Pp.t val print_rel_context : env -> Pp.t val print_env : env -> Pp.t -val print_constr : constr -> Pp.t -[@@deprecated "use print_constr_env"] - end - -val print_constr : constr -> Pp.t -[@@deprecated "This is an internal, debug printer. WARNING, it is *extremely* likely that you want to use [Printer.pr_econstr_env] instead"] - -val print_constr_env : env -> Evd.evar_map -> constr -> Pp.t -[@@deprecated "This is an internal, debug printer. WARNING, it is *extremely* likely that you want to use [Printer.pr_econstr_env] instead"] - -val print_rel_context : env -> Pp.t -[@@deprecated "This is an internal, debug printer. WARNING, this function is not suitable for plugin code, if you still want to use it then call [Internal.print_rel_context] instead"] diff --git a/engine/univNames.ml b/engine/univNames.ml index 70cdd3a2db..e89dcedb9c 100644 --- a/engine/univNames.ml +++ b/engine/univNames.ml @@ -69,7 +69,7 @@ let discharge_ubinder (_,(ref,l)) = with Not_found -> name_universe lvl in let l = List.map map sec_inst @ l in - Some (Lib.discharge_global ref, l) + Some (ref, l) let ubinder_obj : GlobRef.t * Id.t list -> Libobject.obj = let open Libobject in diff --git a/engine/universes.ml b/engine/universes.ml deleted file mode 100644 index 5d0157b2db..0000000000 --- a/engine/universes.ml +++ /dev/null @@ -1,92 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) -(* <O___,, * (see CREDITS file for the list of authors) *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(* * (see LICENSE file for the text of the license) *) -(************************************************************************) - -open Univ - -(** Deprecated *) - -(** UnivNames *) -type universe_binders = UnivNames.universe_binders -type univ_name_list = UnivNames.univ_name_list - -let pr_with_global_universes = UnivNames.pr_with_global_universes -let reference_of_level = UnivNames.qualid_of_level - -let empty_binders = UnivNames.empty_binders - -let register_universe_binders = UnivNames.register_universe_binders - -let universe_binders_with_opt_names = UnivNames.universe_binders_with_opt_names - -(** UnivGen *) -type universe_id = UnivGen.universe_id - -let set_remote_new_univ_id = UnivGen.set_remote_new_univ_id -let new_univ_id = UnivGen.new_univ_id -let new_univ_level = UnivGen.new_univ_level -let new_univ = UnivGen.new_univ -let new_Type = UnivGen.new_Type -let new_Type_sort = UnivGen.new_Type_sort -let new_global_univ = UnivGen.new_global_univ -let new_sort_in_family = UnivGen.new_sort_in_family -let fresh_instance_from_context = UnivGen.fresh_instance_from_context -let fresh_instance_from = UnivGen.fresh_instance_from -let fresh_sort_in_family = UnivGen.fresh_sort_in_family -let fresh_constant_instance = UnivGen.fresh_constant_instance -let fresh_inductive_instance = UnivGen.fresh_inductive_instance -let fresh_constructor_instance = UnivGen.fresh_constructor_instance -let fresh_global_instance = UnivGen.fresh_global_instance -let fresh_global_or_constr_instance = UnivGen.fresh_global_or_constr_instance -let fresh_universe_context_set_instance = UnivGen.fresh_universe_context_set_instance -let global_of_constr = UnivGen.global_of_constr -let constr_of_global_univ = UnivGen.constr_of_global_univ -let extend_context = UnivGen.extend_context -let constr_of_global = UnivGen.constr_of_global -let constr_of_reference = UnivGen.constr_of_global -let type_of_global = UnivGen.type_of_global - -(** UnivSubst *) - -let level_subst_of = UnivSubst.level_subst_of -let subst_univs_constraints = UnivSubst.subst_univs_constraints -let subst_univs_constr = UnivSubst.subst_univs_constr -type universe_opt_subst = UnivSubst.universe_opt_subst -let make_opt_subst = UnivSubst.make_opt_subst -let subst_opt_univs_constr = UnivSubst.subst_opt_univs_constr -let normalize_univ_variables = UnivSubst.normalize_univ_variables -let normalize_univ_variable = UnivSubst.normalize_univ_variable -let normalize_univ_variable_opt_subst = UnivSubst.normalize_univ_variable_opt_subst -let normalize_univ_variable_subst = UnivSubst.normalize_univ_variable_subst -let normalize_universe_opt_subst = UnivSubst.normalize_universe_opt_subst -let normalize_universe_subst = UnivSubst.normalize_universe_subst -let nf_evars_and_universes_opt_subst = UnivSubst.nf_evars_and_universes_opt_subst -let pr_universe_opt_subst = UnivSubst.pr_universe_opt_subst - -(** UnivProblem *) - -type universe_constraint = UnivProblem.t = - | ULe of Universe.t * Universe.t - | UEq of Universe.t * Universe.t - | ULub of Level.t * Level.t - | UWeak of Level.t * Level.t - -module Constraints = UnivProblem.Set -type 'a constraint_accumulator = 'a UnivProblem.accumulator -type 'a universe_constrained = 'a UnivProblem.constrained -type 'a universe_constraint_function = 'a UnivProblem.constraint_function -let subst_univs_universe_constraints = UnivProblem.Set.subst_univs -let enforce_eq_instances_univs = UnivProblem.enforce_eq_instances_univs -let to_constraints = UnivProblem.to_constraints -let eq_constr_univs_infer_with = UnivProblem.eq_constr_univs_infer_with - -(** UnivMinim *) -module UPairSet = UnivMinim.UPairSet - -let normalize_context_set = UnivMinim.normalize_context_set diff --git a/engine/universes.mli b/engine/universes.mli deleted file mode 100644 index 0d3bae4c95..0000000000 --- a/engine/universes.mli +++ /dev/null @@ -1,230 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) -(* <O___,, * (see CREDITS file for the list of authors) *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(* * (see LICENSE file for the text of the license) *) -(************************************************************************) - -open Names -open Constr -open Environ -open Univ - -(** ************************************** *) -(** This entire module is deprecated. **** *) -(** ************************************** *) -[@@@ocaml.warning "-3"] - -(** ****** Deprecated: moved to [UnivNames] *) - -val pr_with_global_universes : Level.t -> Pp.t -[@@ocaml.deprecated "Use [UnivNames.pr_with_global_universes]"] -val reference_of_level : Level.t -> Libnames.qualid -[@@ocaml.deprecated "Use [UnivNames.qualid_of_level]"] - -type universe_binders = UnivNames.universe_binders -[@@ocaml.deprecated "Use [UnivNames.universe_binders]"] - -val empty_binders : universe_binders -[@@ocaml.deprecated "Use [UnivNames.empty_binders]"] - -val register_universe_binders : Globnames.global_reference -> universe_binders -> unit -[@@ocaml.deprecated "Use [UnivNames.register_universe_binders]"] - -type univ_name_list = UnivNames.univ_name_list -[@@ocaml.deprecated "Use [UnivNames.univ_name_list]"] - -val universe_binders_with_opt_names : Globnames.global_reference -> - univ_name_list option -> universe_binders -[@@ocaml.deprecated "Use [UnivNames.universe_binders_with_opt_names]"] - -(** ****** Deprecated: moved to [UnivGen] *) - -type universe_id = UnivGen.universe_id -[@@ocaml.deprecated "Use [UnivGen.universe_id]"] - -val set_remote_new_univ_id : universe_id RemoteCounter.installer -[@@ocaml.deprecated "Use [UnivGen.set_remote_new_univ_id]"] - -val new_univ_id : unit -> universe_id -[@@ocaml.deprecated "Use [UnivGen.new_univ_id]"] - -val new_univ_level : unit -> Level.t -[@@ocaml.deprecated "Use [UnivGen.new_univ_level]"] - -val new_univ : unit -> Universe.t -[@@ocaml.deprecated "Use [UnivGen.new_univ]"] - -val new_Type : unit -> types -[@@ocaml.deprecated "Use [UnivGen.new_Type]"] - -val new_Type_sort : unit -> Sorts.t -[@@ocaml.deprecated "Use [UnivGen.new_Type_sort]"] - -val new_global_univ : unit -> Universe.t in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.new_global_univ]"] - -val new_sort_in_family : Sorts.family -> Sorts.t -[@@ocaml.deprecated "Use [UnivGen.new_sort_in_family]"] - -val fresh_instance_from_context : AUContext.t -> - Instance.t constrained -[@@ocaml.deprecated "Use [UnivGen.fresh_instance_from_context]"] - -val fresh_instance_from : AUContext.t -> Instance.t option -> - Instance.t in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_instance_from]"] - -val fresh_sort_in_family : Sorts.family -> - Sorts.t in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_sort_in_family]"] - -val fresh_constant_instance : env -> Constant.t -> - pconstant in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_constant_instance]"] - -val fresh_inductive_instance : env -> inductive -> - pinductive in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_inductive_instance]"] - -val fresh_constructor_instance : env -> constructor -> - pconstructor in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_constructor_instance]"] - -val fresh_global_instance : ?names:Univ.Instance.t -> env -> Globnames.global_reference -> - constr in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_global_instance]"] - -val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_constr -> - constr in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.fresh_global_or_constr_instance]"] - -val fresh_universe_context_set_instance : ContextSet.t -> - universe_level_subst * ContextSet.t -[@@ocaml.deprecated "Use [UnivGen.fresh_universe_context_set_instance]"] - -val global_of_constr : constr -> Globnames.global_reference puniverses -[@@ocaml.deprecated "Use [UnivGen.global_of_constr]"] - -val constr_of_global_univ : Globnames.global_reference puniverses -> constr -[@@ocaml.deprecated "Use [UnivGen.constr_of_global_univ]"] - -val extend_context : 'a in_universe_context_set -> ContextSet.t -> - 'a in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.extend_context]"] - -val constr_of_global : Globnames.global_reference -> constr -[@@ocaml.deprecated "Use [UnivGen.constr_of_global]"] - -val constr_of_reference : Globnames.global_reference -> constr -[@@ocaml.deprecated "Use [UnivGen.constr_of_global]"] - -val type_of_global : Globnames.global_reference -> types in_universe_context_set -[@@ocaml.deprecated "Use [UnivGen.type_of_global]"] - -(** ****** Deprecated: moved to [UnivSubst] *) - -val level_subst_of : universe_subst_fn -> universe_level_subst_fn -[@@ocaml.deprecated "Use [UnivSubst.level_subst_of]"] - -val subst_univs_constraints : universe_subst_fn -> Constraint.t -> Constraint.t -[@@ocaml.deprecated "Use [UnivSubst.subst_univs_constraints]"] - -val subst_univs_constr : universe_subst -> constr -> constr -[@@ocaml.deprecated "Use [UnivSubst.subst_univs_constr]"] - -type universe_opt_subst = UnivSubst.universe_opt_subst -[@@ocaml.deprecated "Use [UnivSubst.universe_opt_subst]"] - -val make_opt_subst : universe_opt_subst -> universe_subst_fn -[@@ocaml.deprecated "Use [UnivSubst.make_opt_subst]"] - -val subst_opt_univs_constr : universe_opt_subst -> constr -> constr -[@@ocaml.deprecated "Use [UnivSubst.subst_opt_univs_constr]"] - -val normalize_univ_variables : universe_opt_subst -> - universe_opt_subst * LSet.t * universe_subst -[@@ocaml.deprecated "Use [UnivSubst.normalize_univ_variables]"] - -val normalize_univ_variable : - find:(Level.t -> Universe.t) -> - Level.t -> Universe.t -[@@ocaml.deprecated "Use [UnivSubst.normalize_univ_variable]"] - -val normalize_univ_variable_opt_subst : universe_opt_subst -> - (Level.t -> Universe.t) -[@@ocaml.deprecated "Use [UnivSubst.normalize_univ_variable_opt_subst]"] - -val normalize_univ_variable_subst : universe_subst -> - (Level.t -> Universe.t) -[@@ocaml.deprecated "Use [UnivSubst.normalize_univ_variable_subst]"] - -val normalize_universe_opt_subst : universe_opt_subst -> - (Universe.t -> Universe.t) -[@@ocaml.deprecated "Use [UnivSubst.normalize_universe_opt_subst]"] - -val normalize_universe_subst : universe_subst -> - (Universe.t -> Universe.t) -[@@ocaml.deprecated "Use [UnivSubst.normalize_universe_subst]"] - -val nf_evars_and_universes_opt_subst : (existential -> constr option) -> - universe_opt_subst -> constr -> constr -[@@ocaml.deprecated "Use [UnivSubst.nf_evars_and_universes_opt_subst]"] - -val pr_universe_opt_subst : universe_opt_subst -> Pp.t -[@@ocaml.deprecated "Use [UnivSubst.pr_universe_opt_subst]"] - -(** ****** Deprecated: moved to [UnivProblem] *) - -type universe_constraint = UnivProblem.t = - | ULe of Universe.t * Universe.t [@ocaml.deprecated "Use [UnivProblem.ULe]"] - | UEq of Universe.t * Universe.t [@ocaml.deprecated "Use [UnivProblem.UEq]"] - | ULub of Level.t * Level.t [@ocaml.deprecated "Use [UnivProblem.ULub]"] - | UWeak of Level.t * Level.t [@ocaml.deprecated "Use [UnivProblem.UWeak]"] -[@@ocaml.deprecated "Use [UnivProblem.t]"] - -module Constraints = UnivProblem.Set -[@@ocaml.deprecated "Use [UnivProblem.Set]"] - -type 'a constraint_accumulator = 'a UnivProblem.accumulator -[@@ocaml.deprecated "Use [UnivProblem.accumulator]"] -type 'a universe_constrained = 'a UnivProblem.constrained -[@@ocaml.deprecated "Use [UnivProblem.constrained]"] -type 'a universe_constraint_function = 'a UnivProblem.constraint_function -[@@ocaml.deprecated "Use [UnivProblem.constraint_function]"] - -val subst_univs_universe_constraints : universe_subst_fn -> - Constraints.t -> Constraints.t -[@@ocaml.deprecated "Use [UnivProblem.Set.subst_univs]"] - -val enforce_eq_instances_univs : bool -> Instance.t universe_constraint_function -[@@ocaml.deprecated "Use [UnivProblem.enforce_eq_instances_univs]"] - -(** With [force_weak] UWeak constraints are turned into equalities, - otherwise they're forgotten. *) -val to_constraints : force_weak:bool -> UGraph.t -> Constraints.t -> Constraint.t -[@@ocaml.deprecated "Use [UnivProblem.to_constraints]"] - -(** [eq_constr_univs_infer_With kind1 kind2 univs m n] is a variant of - {!eq_constr_univs_infer} taking kind-of-term functions, to expose - subterms of [m] and [n], arguments. *) -val eq_constr_univs_infer_with : - (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) -> - (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) -> - UGraph.t -> 'a constraint_accumulator -> constr -> constr -> 'a -> 'a option -[@@ocaml.deprecated "Use [UnivProblem.eq_constr_univs_infer_with]"] - -(** ****** Deprecated: moved to [UnivMinim] *) - -module UPairSet = UnivMinim.UPairSet -[@@ocaml.deprecated "Use [UnivMinim.UPairSet]"] - -val normalize_context_set : UGraph.t -> ContextSet.t -> - universe_opt_subst (* The defined and undefined variables *) -> - LSet.t (* univ variables that can be substituted by algebraics *) -> - UPairSet.t (* weak equality constraints *) -> - (universe_opt_subst * LSet.t) in_universe_context_set -[@@ocaml.deprecated "Use [UnivMinim.normalize_context_set]"] diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml index 23d0536df8..d5f0b7bff6 100644 --- a/interp/constrexpr_ops.ml +++ b/interp/constrexpr_ops.ml @@ -526,6 +526,14 @@ let mkAppC (f,l) = | CApp (g,l') -> CAst.make @@ CApp (g, l' @ l) | _ -> CAst.make @@ CApp ((None, f), l) +let mkProdCN ?loc bll c = + if bll = [] then c else + CAst.make ?loc @@ CProdN (bll,c) + +let mkLambdaCN ?loc bll c = + if bll = [] then c else + CAst.make ?loc @@ CLambdaN (bll,c) + let mkCProdN ?loc bll c = CAst.make ?loc @@ CProdN (bll,c) diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli index 61e8aa1b51..9e83bde8b2 100644 --- a/interp/constrexpr_ops.mli +++ b/interp/constrexpr_ops.mli @@ -38,22 +38,36 @@ val constr_loc : constr_expr -> Loc.t option val cases_pattern_expr_loc : cases_pattern_expr -> Loc.t option val local_binders_loc : local_binder_expr list -> Loc.t option -(** {6 Constructors}*) +(** {6 Constructors} *) + +(** {7 Term constructors} *) + +(** Basic form of the corresponding constructors *) val mkIdentC : Id.t -> constr_expr val mkRefC : qualid -> constr_expr -val mkAppC : constr_expr * constr_expr list -> constr_expr val mkCastC : constr_expr * constr_expr Glob_term.cast_type -> constr_expr val mkLambdaC : lname list * binder_kind * constr_expr * constr_expr -> constr_expr val mkLetInC : lname * constr_expr * constr_expr option * constr_expr -> constr_expr val mkProdC : lname list * binder_kind * constr_expr * constr_expr -> constr_expr -val mkCLambdaN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr -(** Same as [abstract_constr_expr], with location *) +val mkAppC : constr_expr * constr_expr list -> constr_expr +(** Basic form of application, collapsing nested applications *) +(** Optimized constructors: does not add a constructor for an empty binder list *) + +val mkLambdaCN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr +val mkProdCN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr + +(** Aliases for the corresponding constructors; generally [mkLambdaCN] and + [mkProdCN] should be preferred *) + +val mkCLambdaN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr val mkCProdN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr -(** Same as [prod_constr_expr], with location *) +(** {7 Pattern constructors} *) + +(** Interpretation of a list of patterns as a disjunctive pattern (optimized) *) val mkCPatOr : ?loc:Loc.t -> cases_pattern_expr list -> cases_pattern_expr val mkAppPattern : ?loc:Loc.t -> cases_pattern_expr -> cases_pattern_expr list -> cases_pattern_expr diff --git a/interp/declare.ml b/interp/declare.ml index 23c68b5e18..07a0066ea8 100644 --- a/interp/declare.ml +++ b/interp/declare.ml @@ -78,7 +78,6 @@ let check_exists sp = let cache_constant ((sp,kn), obj) = let id = basename sp in - let _,dir,_ = KerName.repr kn in let kn' = match obj.cst_decl with | None -> @@ -87,7 +86,7 @@ let cache_constant ((sp,kn), obj) = else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp) ++ str".") | Some decl -> let () = check_exists sp in - Global.add_constant dir id decl + Global.add_constant ~in_section:(Lib.sections_are_opened ()) id decl in assert (Constant.equal kn' (Constant.make1 kn)); Nametab.push (Nametab.Until 1) sp (ConstRef (Constant.make1 kn)); @@ -136,7 +135,7 @@ let register_side_effect (c, role) = cst_kind = IsProof Theorem; cst_locl = false; } in - let id = Label.to_id (pi3 (Constant.repr3 c)) in + let id = Label.to_id (Constant.label c) in ignore(add_leaf id o); update_tables c; match role with @@ -311,8 +310,7 @@ let cache_inductive ((sp,kn),mie) = let names = inductive_names sp kn mie in List.iter check_exists (List.map fst names); let id = basename sp in - let _,dir,_ = KerName.repr kn in - let kn' = Global.add_mind dir id mie in + let kn' = Global.add_mind id mie in assert (MutInd.equal kn' (MutInd.make1 kn)); let mind = Global.lookup_mind kn' in add_section_kn (Declareops.inductive_is_polymorphic mind) kn' mind.mind_hyps; @@ -479,20 +477,7 @@ type universe_source = | QualifiedUniv of Id.t (* global universe introduced by some global value *) | UnqualifiedUniv (* other global universe *) -type universe_decl = universe_source * Nametab.universe_id - -let add_universe src (dp, i) = - let level = Univ.Level.make dp i in - let optpoly = match src with - | BoundUniv -> Some true - | UnqualifiedUniv -> Some false - | QualifiedUniv _ -> None - in - Option.iter (fun poly -> - let ctx = Univ.ContextSet.add_universe level Univ.ContextSet.empty in - Global.push_context_set poly ctx; - if poly then Lib.add_section_context ctx) - optpoly +type universe_name_decl = universe_source * (Id.t * Nametab.universe_id) list let check_exists sp = let depth = sections_depth () in @@ -501,41 +486,42 @@ let check_exists sp = alreadydeclared (str "Universe " ++ Id.print (basename sp) ++ str " already exists") else () -let qualify_univ src (sp,i as orig) = +let qualify_univ i sp src id = + let open Libnames in match src with - | BoundUniv | UnqualifiedUniv -> orig + | BoundUniv | UnqualifiedUniv -> + let sp = dirpath sp in + i, make_path sp id | QualifiedUniv l -> - let sp0, id = Libnames.repr_path sp in - let sp0 = DirPath.repr sp0 in - Libnames.make_path (DirPath.make (l::sp0)) id, i+1 - -let cache_universe ((sp, _), (src, id)) = - let sp, i = qualify_univ src (sp,1) in - let () = check_exists sp in - let () = Nametab.push_universe (Nametab.Until i) sp id in - add_universe src id - -let load_universe i ((sp, _), (src, id)) = - let sp, i = qualify_univ src (sp,i) in - let () = Nametab.push_universe (Nametab.Until i) sp id in - add_universe src id - -let open_universe i ((sp, _), (src, id)) = - let sp, i = qualify_univ src (sp,i) in - let () = Nametab.push_universe (Nametab.Exactly i) sp id in - () - -let discharge_universe = function + let sp = dirpath sp in + let sp = DirPath.repr sp in + Nametab.map_visibility succ i, make_path (DirPath.make (l::sp)) id + +let do_univ_name ~check i sp src (id,univ) = + let i, sp = qualify_univ i sp src id in + if check then check_exists sp; + Nametab.push_universe i sp univ + +let cache_univ_names ((sp, _), (src, univs)) = + List.iter (do_univ_name ~check:true (Nametab.Until 1) sp src) univs + +let load_univ_names i ((sp, _), (src, univs)) = + List.iter (do_univ_name ~check:false (Nametab.Until i) sp src) univs + +let open_univ_names i ((sp, _), (src, univs)) = + List.iter (do_univ_name ~check:false (Nametab.Exactly i) sp src) univs + +let discharge_univ_names = function | _, (BoundUniv, _) -> None | _, ((QualifiedUniv _ | UnqualifiedUniv), _ as x) -> Some x -let input_universe : universe_decl -> Libobject.obj = +let input_univ_names : universe_name_decl -> Libobject.obj = declare_object { (default_object "Global universe name state") with - cache_function = cache_universe; - load_function = load_universe; - open_function = open_universe; - discharge_function = discharge_universe; + cache_function = cache_univ_names; + load_function = load_univ_names; + open_function = open_univ_names; + discharge_function = discharge_univ_names; subst_function = (fun (subst, a) -> (** Actually the name is generated once and for all. *) a); classify_function = (fun a -> Substitute a) } @@ -551,12 +537,12 @@ let declare_univ_binders gr pl = anomaly ~label:"declare_univ_binders" Pp.(str "declare_univ_binders on an constructor reference") in - Id.Map.iter (fun id lvl -> - match Univ.Level.name lvl with - | None -> () - | Some na -> - ignore (Lib.add_leaf id (input_universe (QualifiedUniv l, na)))) - pl + let univs = Id.Map.fold (fun id univ univs -> + match Univ.Level.name univ with + | None -> assert false (* having Prop/Set/Var as binders is nonsense *) + | Some univ -> (id,univ)::univs) pl [] + in + Lib.add_anonymous_leaf (input_univ_names (QualifiedUniv l, univs)) let do_universe poly l = let in_section = Lib.sections_are_opened () in @@ -570,10 +556,12 @@ let do_universe poly l = let lev = UnivGen.new_univ_id () in (id, lev)) l in + let ctx = List.fold_left (fun ctx (_,(dp,i)) -> Univ.LSet.add (Univ.Level.make dp i) ctx) + Univ.LSet.empty l, Univ.Constraint.empty + in + let () = declare_universe_context poly ctx in let src = if poly then BoundUniv else UnqualifiedUniv in - List.iter (fun (id,lev) -> - ignore(Lib.add_leaf id (input_universe (src, lev)))) - l + Lib.add_anonymous_leaf (input_univ_names (src, l)) let do_constraint poly l = let open Univ in diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml index ccad6b19eb..f5be0ddbae 100644 --- a/interp/dumpglob.ml +++ b/interp/dumpglob.ml @@ -234,7 +234,7 @@ let add_glob ?loc ref = add_glob_gen ?loc sp lib_dp ty let mp_of_kn kn = - let mp,sec,l = Names.KerName.repr kn in + let mp,l = Names.KerName.repr kn in Names.MPdot (mp,l) let add_glob_kn ?loc kn = diff --git a/interp/impargs.ml b/interp/impargs.ml index 3603367cf1..ce33cb8731 100644 --- a/interp/impargs.ml +++ b/interp/impargs.ml @@ -561,29 +561,27 @@ let discharge_implicits (_,(req,l)) = | ImplInteractive (ref,flags,exp) -> (try let vars = variable_section_segment_of_reference ref in - let ref' = if isVarRef ref then ref else pop_global_reference ref in let extra_impls = impls_of_context vars in - let l' = [ref', List.map (add_section_impls vars extra_impls) (snd (List.hd l))] in - Some (ImplInteractive (ref',flags,exp),l') + let l' = [ref, List.map (add_section_impls vars extra_impls) (snd (List.hd l))] in + Some (ImplInteractive (ref,flags,exp),l') with Not_found -> (* ref not defined in this section *) Some (req,l)) | ImplConstant (con,flags) -> (try - let con' = pop_con con in let vars = variable_section_segment_of_reference (ConstRef con) in let extra_impls = impls_of_context vars in let newimpls = List.map (add_section_impls vars extra_impls) (snd (List.hd l)) in - let l' = [ConstRef con',newimpls] in - Some (ImplConstant (con',flags),l') + let l' = [ConstRef con,newimpls] in + Some (ImplConstant (con,flags),l') with Not_found -> (* con not defined in this section *) Some (req,l)) | ImplMutualInductive (kn,flags) -> (try let l' = List.map (fun (gr, l) -> let vars = variable_section_segment_of_reference gr in let extra_impls = impls_of_context vars in - ((if isVarRef gr then gr else pop_global_reference gr), + (gr, List.map (add_section_impls vars extra_impls) l)) l in - Some (ImplMutualInductive (pop_kn kn,flags),l') + Some (ImplMutualInductive (kn,flags),l') with Not_found -> (* ref not defined in this section *) Some (req,l)) let rebuild_implicits (req,l) = diff --git a/interp/notation.ml b/interp/notation.ml index 02c7812e21..6104ab16c7 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -1304,7 +1304,7 @@ let discharge_arguments_scope (_,(req,r,n,l,_)) = vars |> List.map fst |> List.filter is_local_assum |> List.length with Not_found (* Not a ref defined in this section *) -> 0 in - Some (req,Lib.discharge_global r,n,l,[]) + Some (req,r,n,l,[]) let classify_arguments_scope (req,_,_,_,_ as obj) = if req == ArgsScopeNoDischarge then Dispose else Substitute obj diff --git a/kernel/constr.mli b/kernel/constr.mli index 2efdae007c..3c9cc96a0d 100644 --- a/kernel/constr.mli +++ b/kernel/constr.mli @@ -13,20 +13,12 @@ open Names -(** {6 Value under universe substitution } *) -type 'a puniverses = 'a Univ.puniverses -[@@ocaml.deprecated "use Univ.puniverses"] - (** {6 Simply type aliases } *) type pconstant = Constant.t Univ.puniverses type pinductive = inductive Univ.puniverses type pconstructor = constructor Univ.puniverses (** {6 Existential variables } *) -type existential_key = Evar.t -[@@ocaml.deprecated "use Evar.t"] - -(** {6 Existential variables } *) type metavariable = int (** {6 Case annotation } *) diff --git a/kernel/cooking.ml b/kernel/cooking.ml index b361e36bbf..b39aed01e8 100644 --- a/kernel/cooking.ml +++ b/kernel/cooking.ml @@ -15,7 +15,6 @@ (* This module implements kernel-level discharching of local declarations over global constants and inductive types *) -open CErrors open Util open Names open Term @@ -28,18 +27,6 @@ module RelDecl = Context.Rel.Declaration (*s Cooking the constants. *) -let pop_dirpath p = match DirPath.repr p with - | [] -> anomaly ~label:"dirpath_prefix" (Pp.str "empty dirpath.") - | _::l -> DirPath.make l - -let pop_mind kn = - let (mp,dir,l) = MutInd.repr3 kn in - MutInd.make3 mp (pop_dirpath dir) l - -let pop_con con = - let (mp,dir,l) = Constant.repr3 con in - Constant.make3 mp (pop_dirpath dir) l - type my_global_reference = | ConstRef of Constant.t | IndRef of inductive @@ -71,29 +58,26 @@ let instantiate_my_gr gr u = let share cache r (cstl,knl) = try RefTable.find cache r with Not_found -> - let f,(u,l) = + let (u,l) = match r with - | IndRef (kn,i) -> - IndRef (pop_mind kn,i), Mindmap.find kn knl - | ConstructRef ((kn,i),j) -> - ConstructRef ((pop_mind kn,i),j), Mindmap.find kn knl + | IndRef (kn,_i) -> + Mindmap.find kn knl + | ConstructRef ((kn,_i),_j) -> + Mindmap.find kn knl | ConstRef cst -> - ConstRef (pop_con cst), Cmap.find cst cstl in - let c = (f, (u, Array.map mkVar l)) in + Cmap.find cst cstl in + let c = (u, Array.map mkVar l) in RefTable.add cache r c; c let share_univs cache r u l = - let r', (u', args) = share cache r l in - mkApp (instantiate_my_gr r' (Instance.append u' u), args) + let (u', args) = share cache r l in + mkApp (instantiate_my_gr r (Instance.append u' u), args) let update_case_info cache ci modlist = try - let ind, n = - match share cache (IndRef ci.ci_ind) modlist with - | (IndRef f,(_u,l)) -> (f, Array.length l) - | _ -> assert false in - { ci with ci_ind = ind; ci_npar = ci.ci_npar + n } + let (_u,l) = share cache (IndRef ci.ci_ind) modlist in + { ci with ci_npar = ci.ci_npar + Array.length l } with Not_found -> ci @@ -129,7 +113,7 @@ let expmod_constr cache modlist c = | Proj (p, c') -> let map cst npars = let _, newpars = Mindmap.find cst (snd modlist) in - pop_mind cst, npars + Array.length newpars + (cst, npars + Array.length newpars) in let p' = try Projection.map_npars map p with Not_found -> p in let c'' = substrec c' in diff --git a/kernel/environ.mli b/kernel/environ.mli index 1343b9029b..55ff7ff162 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -320,8 +320,6 @@ val remove_hyps : Id.Set.t -> (Constr.named_declaration -> Constr.named_declarat open Retroknowledge (** functions manipulating the retroknowledge @author spiwack *) -val retroknowledge : (retroknowledge->'a) -> env -> 'a -[@@ocaml.deprecated "Use the record projection."] val registered : env -> field -> bool diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml index bff3092655..2a91c7dab0 100644 --- a/kernel/mod_subst.ml +++ b/kernel/mod_subst.ml @@ -173,12 +173,12 @@ let solve_delta_kn resolve kn = | Inline (lev, Some c) -> raise (Change_equiv_to_inline (lev,c)) | Inline (_, None) -> raise Not_found with Not_found -> - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in let new_mp = find_prefix resolve mp in if mp == new_mp then kn else - KerName.make new_mp dir l + KerName.make new_mp l let kn_of_delta resolve kn = try solve_delta_kn resolve kn @@ -245,18 +245,18 @@ let subst_mp sub mp = | Some (mp',_) -> mp' let subst_kn_delta sub kn = - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in match subst_mp0 sub mp with Some (mp',resolve) -> - solve_delta_kn resolve (KerName.make mp' dir l) + solve_delta_kn resolve (KerName.make mp' l) | None -> kn let subst_kn sub kn = - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in match subst_mp0 sub mp with Some (mp',_) -> - (KerName.make mp' dir l) + (KerName.make mp' l) | None -> kn exception No_subst @@ -275,12 +275,12 @@ let progress f x ~orelse = if y != x then y else orelse let subst_mind sub mind = - let mpu,dir,l = MutInd.repr3 mind in + let mpu,l = MutInd.repr2 mind in let mpc = KerName.modpath (MutInd.canonical mind) in try let mpu,mpc,resolve,user = subst_dual_mp sub mpu mpc in - let knu = KerName.make mpu dir l in - let knc = if mpu == mpc then knu else KerName.make mpc dir l in + let knu = KerName.make mpu l in + let knc = if mpu == mpc then knu else KerName.make mpc l in let knc' = progress (kn_of_delta resolve) (if user then knu else knc) ~orelse:knc in @@ -295,11 +295,11 @@ let subst_pind sub (ind,u) = (subst_ind sub ind, u) let subst_con0 sub (cst,u) = - let mpu,dir,l = Constant.repr3 cst in + let mpu,l = Constant.repr2 cst in let mpc = KerName.modpath (Constant.canonical cst) in let mpu,mpc,resolve,user = subst_dual_mp sub mpu mpc in - let knu = KerName.make mpu dir l in - let knc = if mpu == mpc then knu else KerName.make mpc dir l in + let knu = KerName.make mpu l in + let knc = if mpu == mpc then knu else KerName.make mpc l in match search_delta_inline resolve knu knc with | Some (ctx, t) -> (* In case of inlining, discard the canonical part (cf #2608) *) @@ -433,10 +433,10 @@ let rec replace_mp_in_mp mpfrom mpto mp = | _ -> mp let replace_mp_in_kn mpfrom mpto kn = - let mp,dir,l = KerName.repr kn in + let mp,l = KerName.repr kn in let mp'' = replace_mp_in_mp mpfrom mpto mp in if mp==mp'' then kn - else KerName.make mp'' dir l + else KerName.make mp'' l let rec mp_in_mp mp mp1 = match mp1 with diff --git a/kernel/modops.ml b/kernel/modops.ml index 424d329e09..bab2eae3df 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -289,10 +289,10 @@ let add_retroknowledge = let rec add_structure mp sign resolver linkinfo env = let add_one env (l,elem) = match elem with |SFBconst cb -> - let c = constant_of_delta_kn resolver (KerName.make2 mp l) in + let c = constant_of_delta_kn resolver (KerName.make mp l) in Environ.add_constant_key c cb linkinfo env |SFBmind mib -> - let mind = mind_of_delta_kn resolver (KerName.make2 mp l) in + let mind = mind_of_delta_kn resolver (KerName.make mp l) in let mib = if mib.mind_private != None then { mib with mind_private = Some true } @@ -331,7 +331,7 @@ let strengthen_const mp_from l cb resolver = match cb.const_body with |Def _ -> cb |_ -> - let kn = KerName.make2 mp_from l in + let kn = KerName.make mp_from l in let con = constant_of_delta_kn resolver kn in let u = match cb.const_universes with @@ -450,8 +450,8 @@ and strengthen_and_subst_struct str subst mp_from mp_to alias incl reso = (* If we are performing an inclusion we need to add the fact that the constant mp_to.l is \Delta-equivalent to reso(mp_from.l) *) - let kn_from = KerName.make2 mp_from l in - let kn_to = KerName.make2 mp_to l in + let kn_from = KerName.make mp_from l in + let kn_to = KerName.make mp_to l in let old_name = kn_of_delta reso kn_from in add_kn_delta_resolver kn_to old_name reso', str' else @@ -471,8 +471,8 @@ and strengthen_and_subst_struct str subst mp_from mp_to alias incl reso = in (* Same as constant *) if incl then - let kn_from = KerName.make2 mp_from l in - let kn_to = KerName.make2 mp_to l in + let kn_from = KerName.make mp_from l in + let kn_to = KerName.make mp_to l in let old_name = kn_of_delta reso kn_from in add_kn_delta_resolver kn_to old_name reso', str' else diff --git a/kernel/names.ml b/kernel/names.ml index 6d33f233e9..7cd749de1d 100644 --- a/kernel/names.ml +++ b/kernel/names.ml @@ -365,7 +365,6 @@ module KerName = struct type t = { modpath : ModPath.t; - dirpath : DirPath.t; knlabel : Label.t; mutable refhash : int; (** Lazily computed hash. If unset, it is set to negative values. *) @@ -373,22 +372,18 @@ module KerName = struct type kernel_name = t - let make modpath dirpath knlabel = - { modpath; dirpath; knlabel; refhash = -1; } - let repr kn = (kn.modpath, kn.dirpath, kn.knlabel) + let make modpath knlabel = + { modpath; knlabel; refhash = -1; } + let repr kn = (kn.modpath, kn.knlabel) - let make2 modpath knlabel = - { modpath; dirpath = DirPath.empty; knlabel; refhash = -1; } + let make2 = make + [@@ocaml.deprecated "Please use [KerName.make]"] let modpath kn = kn.modpath let label kn = kn.knlabel let to_string_gen mp_to_string kn = - let dp = - if DirPath.is_empty kn.dirpath then "." - else "#" ^ DirPath.to_string kn.dirpath ^ "#" - in - mp_to_string kn.modpath ^ dp ^ Label.to_string kn.knlabel + mp_to_string kn.modpath ^ "." ^ Label.to_string kn.knlabel let to_string kn = to_string_gen ModPath.to_string kn @@ -402,9 +397,7 @@ module KerName = struct let c = String.compare kn1.knlabel kn2.knlabel in if not (Int.equal c 0) then c else - let c = DirPath.compare kn1.dirpath kn2.dirpath in - if not (Int.equal c 0) then c - else ModPath.compare kn1.modpath kn2.modpath + ModPath.compare kn1.modpath kn2.modpath let equal kn1 kn2 = let h1 = kn1.refhash in @@ -412,7 +405,6 @@ module KerName = struct if 0 <= h1 && 0 <= h2 && not (Int.equal h1 h2) then false else Label.equal kn1.knlabel kn2.knlabel && - DirPath.equal kn1.dirpath kn2.dirpath && ModPath.equal kn1.modpath kn2.modpath open Hashset.Combine @@ -420,8 +412,8 @@ module KerName = struct let hash kn = let h = kn.refhash in if h < 0 then - let { modpath = mp; dirpath = dp; knlabel = lbl; _ } = kn in - let h = combine3 (ModPath.hash mp) (DirPath.hash dp) (Label.hash lbl) in + let { modpath = mp; knlabel = lbl; _ } = kn in + let h = combine (ModPath.hash mp) (Label.hash lbl) in (* Ensure positivity on all platforms. *) let h = h land 0x3FFFFFFF in let () = kn.refhash <- h in @@ -432,12 +424,11 @@ module KerName = struct type t = kernel_name type u = (ModPath.t -> ModPath.t) * (DirPath.t -> DirPath.t) * (string -> string) - let hashcons (hmod,hdir,hstr) kn = - let { modpath = mp; dirpath = dp; knlabel = l; refhash; } = kn in - { modpath = hmod mp; dirpath = hdir dp; knlabel = hstr l; refhash; } + let hashcons (hmod,_hdir,hstr) kn = + let { modpath = mp; knlabel = l; refhash; } = kn in + { modpath = hmod mp; knlabel = hstr l; refhash; } let eq kn1 kn2 = - kn1.modpath == kn2.modpath && kn1.dirpath == kn2.dirpath && - kn1.knlabel == kn2.knlabel + kn1.modpath == kn2.modpath && kn1.knlabel == kn2.knlabel let hash = hash end @@ -492,21 +483,20 @@ module KerPair = struct let make knu knc = if KerName.equal knu knc then Same knc else Dual (knu,knc) let make1 = same - let make2 mp l = same (KerName.make2 mp l) - let make3 mp dir l = same (KerName.make mp dir l) - let repr3 kp = KerName.repr (user kp) + let make2 mp l = same (KerName.make mp l) + let repr2 kp = KerName.repr (user kp) let label kp = KerName.label (user kp) let modpath kp = KerName.modpath (user kp) let change_label kp lbl = - let (mp1,dp1,l1) = KerName.repr (user kp) - and (mp2,dp2,l2) = KerName.repr (canonical kp) in - assert (String.equal l1 l2 && DirPath.equal dp1 dp2); + let (mp1,l1) = KerName.repr (user kp) + and (mp2,l2) = KerName.repr (canonical kp) in + assert (String.equal l1 l2); if String.equal lbl l1 then kp else - let kn = KerName.make mp1 dp1 lbl in + let kn = KerName.make mp1 lbl in if mp1 == mp2 then same kn - else make kn (KerName.make mp2 dp2 lbl) + else make kn (KerName.make mp2 lbl) let to_string kp = KerName.to_string (user kp) let print kp = str (to_string kp) @@ -749,15 +739,12 @@ let eq_table_key f ik1 ik2 = | RelKey k1, RelKey k2 -> Int.equal k1 k2 | _ -> false -let eq_con_chk = Constant.UserOrd.equal let eq_mind_chk = MutInd.UserOrd.equal let eq_ind_chk (kn1,i1) (kn2,i2) = Int.equal i1 i2 && eq_mind_chk kn1 kn2 - (*******************************************************************) (** Compatibility layers *) -type mod_bound_id = MBId.t let eq_constant_key = Constant.UserOrd.equal (** Compatibility layer for [ModPath] *) @@ -933,8 +920,6 @@ struct end -type projection = Projection.t - module GlobRefInternal = struct type t = @@ -1025,10 +1010,6 @@ module GlobRef = struct end -type global_reference = GlobRef.t -[@@ocaml.deprecated "Alias for [GlobRef.t]"] - - type evaluable_global_reference = | EvalVarRef of Id.t | EvalConstRef of Constant.t diff --git a/kernel/names.mli b/kernel/names.mli index 2ea8108734..37930c12e2 100644 --- a/kernel/names.mli +++ b/kernel/names.mli @@ -274,9 +274,11 @@ sig type t (** Constructor and destructor *) - val make : ModPath.t -> DirPath.t -> Label.t -> t + val make : ModPath.t -> Label.t -> t + val repr : t -> ModPath.t * Label.t + val make2 : ModPath.t -> Label.t -> t - val repr : t -> ModPath.t * DirPath.t * Label.t + [@@ocaml.deprecated "Please use [KerName.make]"] (** Projections *) val modpath : t -> ModPath.t @@ -317,15 +319,12 @@ sig val make2 : ModPath.t -> Label.t -> t (** Shortcut for [(make1 (KerName.make2 ...))] *) - val make3 : ModPath.t -> DirPath.t -> Label.t -> t - (** Shortcut for [(make1 (KerName.make ...))] *) - (** Projections *) val user : t -> KerName.t val canonical : t -> KerName.t - val repr3 : t -> ModPath.t * DirPath.t * Label.t + val repr2 : t -> ModPath.t * Label.t (** Shortcut for [KerName.repr (user ...)] *) val modpath : t -> ModPath.t @@ -403,15 +402,12 @@ sig val make2 : ModPath.t -> Label.t -> t (** Shortcut for [(make1 (KerName.make2 ...))] *) - val make3 : ModPath.t -> DirPath.t -> Label.t -> t - (** Shortcut for [(make1 (KerName.make ...))] *) - (** Projections *) val user : t -> KerName.t val canonical : t -> KerName.t - val repr3 : t -> ModPath.t * DirPath.t * Label.t + val repr2 : t -> ModPath.t * Label.t (** Shortcut for [KerName.repr (user ...)] *) val modpath : t -> ModPath.t @@ -531,15 +527,8 @@ val eq_constant_key : Constant.t -> Constant.t -> bool (** equalities on constant and inductive names (for the checker) *) -val eq_con_chk : Constant.t -> Constant.t -> bool -[@@ocaml.deprecated "Same as [Constant.UserOrd.equal]."] - val eq_ind_chk : inductive -> inductive -> bool -(** {6 Deprecated functions. For backward compatibility.} *) - -type mod_bound_id = MBId.t -[@@ocaml.deprecated "Same as [MBId.t]."] (** {5 Module paths} *) type module_path = ModPath.t = @@ -629,9 +618,6 @@ module Projection : sig end -type projection = Projection.t -[@@ocaml.deprecated "Alias for [Projection.t]"] - (** {6 Global reference is a kernel side type for all references together } *) (* XXX: Should we define GlobRefCan GlobRefUser? *) @@ -669,9 +655,6 @@ module GlobRef : sig end -type global_reference = GlobRef.t -[@@ocaml.deprecated "Alias for [GlobRef.t]"] - (** Better to have it here that in Closure, since required in grammar.cma *) (* XXX: Move to a module *) type evaluable_global_reference = diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml index 74b075f4a5..482a2f3a3c 100644 --- a/kernel/nativecode.ml +++ b/kernel/nativecode.ml @@ -1561,7 +1561,7 @@ let rec list_of_mp acc = function let list_of_mp mp = list_of_mp [] mp let string_of_kn kn = - let (mp,_dp,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in let mp = list_of_mp mp in String.concat "_" mp ^ "_" ^ string_of_label l diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml index 8ac3538fc5..5d1b882361 100644 --- a/kernel/nativelibrary.ml +++ b/kernel/nativelibrary.ml @@ -27,7 +27,7 @@ let rec translate_mod prefix mp env mod_expr acc = and translate_field prefix mp env acc (l,x) = match x with | SFBconst cb -> - let con = Constant.make3 mp DirPath.empty l in + let con = Constant.make2 mp l in (if !Flags.debug then let msg = Printf.sprintf "Compiling constant %s..." (Constant.to_string con) in Feedback.msg_debug (Pp.str msg)); diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index b036aa6a67..820c5b3a2b 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -479,10 +479,10 @@ type global_declaration = type exported_private_constant = Constant.t * Entries.side_effect_role -let add_constant_aux no_section senv (kn, cb) = - let l = pi3 (Constant.repr3 kn) in +let add_constant_aux ~in_section senv (kn, cb) = + let l = Constant.label kn in let cb, otab = match cb.const_body with - | OpaqueDef lc when no_section -> + | OpaqueDef lc when not in_section -> (* In coqc, opaque constants outside sections will be stored indirectly in a specific table *) let od, otab = @@ -505,13 +505,11 @@ let export_private_constants ~in_section ce senv = let exported, ce = Term_typing.export_side_effects senv.revstruct senv.env ce in let bodies = List.map (fun (kn, cb, _) -> (kn, cb)) exported in let exported = List.map (fun (kn, _, r) -> (kn, r)) exported in - let no_section = not in_section in - let senv = List.fold_left (add_constant_aux no_section) senv bodies in + let senv = List.fold_left (add_constant_aux ~in_section) senv bodies in (ce, exported), senv -let add_constant dir l decl senv = - let kn = Constant.make3 senv.modpath dir l in - let no_section = DirPath.is_empty dir in +let add_constant ~in_section l decl senv = + let kn = Constant.make2 senv.modpath l in let senv = let cb = match decl with @@ -520,9 +518,9 @@ let add_constant dir l decl senv = | ConstantEntry (PureEntry, ce) -> Term_typing.translate_constant Term_typing.Pure senv.env kn ce | GlobalRecipe r -> - let cb = Term_typing.translate_recipe senv.env kn r in - if no_section then Declareops.hcons_const_body cb else cb in - add_constant_aux no_section senv (kn, cb) in + let cb = Term_typing.translate_recipe ~hcons:(not in_section) senv.env kn r in + if in_section then cb else Declareops.hcons_const_body cb in + add_constant_aux ~in_section senv (kn, cb) in kn, senv (** Insertion of inductive types *) @@ -535,9 +533,9 @@ let check_mind mie lab = (* The label and the first inductive type name should match *) assert (Id.equal (Label.to_id lab) oie.mind_entry_typename) -let add_mind dir l mie senv = +let add_mind l mie senv = let () = check_mind mie l in - let kn = MutInd.make3 senv.modpath dir l in + let kn = MutInd.make2 senv.modpath l in let mib = Term_typing.translate_mind senv.env kn mie in let mib = match mib.mind_hyps with [] -> Declareops.hcons_mind mib | _ -> mib @@ -770,9 +768,9 @@ let add_include me is_module inl senv = let add senv ((l,elem) as field) = let new_name = match elem with | SFBconst _ -> - C (Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp_sup l)) + C (Mod_subst.constant_of_delta_kn resolver (KerName.make mp_sup l)) | SFBmind _ -> - I (Mod_subst.mind_of_delta_kn resolver (KerName.make2 mp_sup l)) + I (Mod_subst.mind_of_delta_kn resolver (KerName.make mp_sup l)) | SFBmodule _ -> M | SFBmodtype _ -> MT in @@ -885,12 +883,6 @@ let typing senv = Typeops.infer (env_of_senv senv) (** {6 Retroknowledge / native compiler } *) -[@@@ocaml.warning "-3"] -(** universal lifting, used for the "get" operations mostly *) -let retroknowledge f senv = - Environ.retroknowledge f (env_of_senv senv) -[@@@ocaml.warning "+3"] - let register field value senv = (* todo : value closed *) (* spiwack : updates the safe_env with the information that the register diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index 6e0febaa3f..0f150ea971 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -105,13 +105,13 @@ val export_private_constants : in_section:bool -> (** returns the main constant plus a list of auxiliary constants (empty unless one requires the side effects to be exported) *) val add_constant : - DirPath.t -> Label.t -> global_declaration -> + in_section:bool -> Label.t -> global_declaration -> Constant.t safe_transformer (** Adding an inductive type *) val add_mind : - DirPath.t -> Label.t -> Entries.mutual_inductive_entry -> + Label.t -> Entries.mutual_inductive_entry -> MutInd.t safe_transformer (** Adding a module or a module type *) @@ -208,9 +208,6 @@ val delta_of_senv : open Retroknowledge -val retroknowledge : (retroknowledge-> 'a) -> safe_environment -> 'a -[@@ocaml.deprecated "Use the projection of Environ.env"] - val register : field -> GlobRef.t -> safe_transformer0 diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index bfe68671a2..d64342dbb0 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -103,8 +103,8 @@ let check_polymorphic_instance error env auctx1 auctx2 = (* for now we do not allow reorderings *) let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2= - let kn1 = KerName.make2 mp1 l in - let kn2 = KerName.make2 mp2 l in + let kn1 = KerName.make mp1 l in + let kn2 = KerName.make mp2 l in let error why = error_signature_mismatch l spec2 why in let check_conv why cst poly f = check_conv_error error why cst poly f in let mib1 = diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml index 47247ff25e..5ccc23eefc 100644 --- a/kernel/term_typing.ml +++ b/kernel/term_typing.ml @@ -531,11 +531,7 @@ let translate_local_assum env t = let t = Typeops.assumption_of_judgment env j in t -let translate_recipe env kn r = - (** We only hashcons the term when outside of a section, otherwise this would - be useless. It is detected by the dirpath of the constant being empty. *) - let (_, dir, _) = Constant.repr3 kn in - let hcons = DirPath.is_empty dir in +let translate_recipe ~hcons env kn r = build_constant_declaration kn env (Cooking.cook_constant ~hcons r) let translate_local_def env _id centry = diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli index b05e05e4dc..ab25090b00 100644 --- a/kernel/term_typing.mli +++ b/kernel/term_typing.mli @@ -64,7 +64,7 @@ val export_side_effects : val translate_mind : env -> MutInd.t -> mutual_inductive_entry -> mutual_inductive_body -val translate_recipe : env -> Constant.t -> Cooking.recipe -> constant_body +val translate_recipe : hcons:bool -> env -> Constant.t -> Cooking.recipe -> constant_body (** Internal functions, mentioned here for debug purpose only *) diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli index 752bf76270..4336a22b8c 100644 --- a/kernel/uGraph.mli +++ b/kernel/uGraph.mli @@ -12,8 +12,6 @@ open Univ (** {6 Graphs of universes. } *) type t -type universes = t -[@@ocaml.deprecated "Use UGraph.t"] type 'a check_function = t -> 'a -> 'a -> bool diff --git a/kernel/univ.ml b/kernel/univ.ml index 61ad1d0a82..fa37834a23 100644 --- a/kernel/univ.ml +++ b/kernel/univ.ml @@ -574,11 +574,8 @@ struct pp_std ++ prl u1 ++ pr_constraint_type op ++ prl u2 ++ fnl () ) c (str "") - let universes_of c = - fold (fun (u1, _op, u2) unvs -> LSet.add u2 (LSet.add u1 unvs)) c LSet.empty end -let universes_of_constraints = Constraint.universes_of let empty_constraint = Constraint.empty let union_constraint = Constraint.union let eq_constraint = Constraint.equal @@ -897,8 +894,6 @@ let subst_instance_constraints s csts = (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) csts Constraint.empty -type universe_instance = Instance.t - type 'a puniverses = 'a * Instance.t let out_punivs (x, _y) = x let in_punivs x = (x, Instance.empty) @@ -955,7 +950,6 @@ struct end -type abstract_universe_context = AUContext.t let hcons_abstract_universe_context = AUContext.hcons (** Universe info for cumulative inductive types: A context of @@ -997,12 +991,10 @@ struct end -type cumulativity_info = CumulativityInfo.t let hcons_cumulativity_info = CumulativityInfo.hcons module ACumulativityInfo = CumulativityInfo -type abstract_cumulativity_info = ACumulativityInfo.t let hcons_abstract_cumulativity_info = ACumulativityInfo.hcons (** A set of universes with universe constraints. @@ -1238,7 +1230,3 @@ let explain_universe_inconsistency prl (o,u,v,p) = in str "Cannot enforce" ++ spc() ++ pr_uni u ++ spc() ++ pr_rel o ++ spc() ++ pr_uni v ++ reason - -let compare_levels = Level.compare -let eq_levels = Level.equal -let equal_universes = Universe.equal diff --git a/kernel/univ.mli b/kernel/univ.mli index b68bbdf359..1aa53b8aa8 100644 --- a/kernel/univ.mli +++ b/kernel/univ.mli @@ -51,9 +51,6 @@ sig val name : t -> (Names.DirPath.t * int) option end -type universe_level = Level.t -[@@ocaml.deprecated "Use Level.t"] - (** Sets of universe levels *) module LSet : sig @@ -63,9 +60,6 @@ sig (** Pretty-printing *) end -type universe_set = LSet.t -[@@ocaml.deprecated "Use LSet.t"] - module Universe : sig type t @@ -130,9 +124,6 @@ sig end -type universe = Universe.t -[@@ocaml.deprecated "Use Universe.t"] - (** Alias name. *) val pr_uni : Universe.t -> Pp.t @@ -171,9 +162,6 @@ module Constraint : sig include Set.S with type elt = univ_constraint end -type constraints = Constraint.t -[@@ocaml.deprecated "Use Constraint.t"] - val empty_constraint : Constraint.t val union_constraint : Constraint.t -> Constraint.t -> Constraint.t val eq_constraint : Constraint.t -> Constraint.t -> bool @@ -301,9 +289,6 @@ sig end -type universe_instance = Instance.t -[@@ocaml.deprecated "Use Instance.t"] - val enforce_eq_instances : Instance.t constraint_function val enforce_eq_variance_instances : Variance.t array -> Instance.t constraint_function @@ -340,9 +325,6 @@ sig end -type universe_context = UContext.t -[@@ocaml.deprecated "Use UContext.t"] - module AUContext : sig type t @@ -367,9 +349,6 @@ sig end -type abstract_universe_context = AUContext.t -[@@ocaml.deprecated "Use AUContext.t"] - (** Universe info for cumulative inductive types: A context of universe levels with universe constraints, representing local universe variables and constraints, together with an array of @@ -398,9 +377,6 @@ sig val eq_constraints : t -> Instance.t constraint_function end -type cumulativity_info = CumulativityInfo.t -[@@ocaml.deprecated "Use CumulativityInfo.t"] - module ACumulativityInfo : sig type t @@ -411,11 +387,13 @@ sig val eq_constraints : t -> Instance.t constraint_function end -type abstract_cumulativity_info = ACumulativityInfo.t -[@@ocaml.deprecated "Use ACumulativityInfo.t"] - (** Universe contexts (as sets) *) +(** A set of universes with universe Constraint.t. + We linearize the set to a list after typechecking. + Beware, representation could change. +*) + module ContextSet : sig type t = LSet.t constrained @@ -451,13 +429,6 @@ sig val size : t -> int end -(** A set of universes with universe Constraint.t. - We linearize the set to a list after typechecking. - Beware, representation could change. -*) -type universe_context_set = ContextSet.t -[@@ocaml.deprecated "Use ContextSet.t"] - (** A value in a universe context (resp. context set). *) type 'a in_universe_context = 'a * UContext.t type 'a in_universe_context_set = 'a * ContextSet.t @@ -532,20 +503,3 @@ val hcons_abstract_universe_context : AUContext.t -> AUContext.t val hcons_universe_context_set : ContextSet.t -> ContextSet.t val hcons_cumulativity_info : CumulativityInfo.t -> CumulativityInfo.t val hcons_abstract_cumulativity_info : ACumulativityInfo.t -> ACumulativityInfo.t - -(******) - -(* deprecated: use qualified names instead *) -val compare_levels : Level.t -> Level.t -> int -[@@ocaml.deprecated "Use Level.compare"] - -val eq_levels : Level.t -> Level.t -> bool -[@@ocaml.deprecated "Use Level.equal"] - -(** deprecated: Equality of formal universe expressions. *) -val equal_universes : Universe.t -> Universe.t -> bool -[@@ocaml.deprecated "Use Universe.equal"] - -(** Universes of Constraint.t *) -val universes_of_constraints : Constraint.t -> LSet.t -[@@ocaml.deprecated "Use Constraint.universes_of"] diff --git a/lib/feedback.ml b/lib/feedback.ml index cb8f8aad1e..9654711ebb 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -84,7 +84,7 @@ let feedback_logger ?loc lvl msg = let msg_info ?loc x = feedback_logger ?loc Info x let msg_notice ?loc x = feedback_logger ?loc Notice x let msg_warning ?loc x = feedback_logger ?loc Warning x -let msg_error ?loc x = feedback_logger ?loc Error x +(* let msg_error ?loc x = feedback_logger ?loc Error x *) let msg_debug ?loc x = feedback_logger ?loc Debug x (* Helper for tools willing to understand only the messages *) diff --git a/lib/feedback.mli b/lib/feedback.mli index 64fdf3724d..f407e2fd5b 100644 --- a/lib/feedback.mli +++ b/lib/feedback.mli @@ -95,11 +95,6 @@ val msg_warning : ?loc:Loc.t -> Pp.t -> unit (** Message indicating that something went wrong, but without serious consequences. *) -val msg_error : ?loc:Loc.t -> Pp.t -> unit -[@@ocaml.deprecated "msg_error is an internal function and should not be \ - used unless you know what you are doing. Use \ - [CErrors.user_err] instead."] - val msg_debug : ?loc:Loc.t -> Pp.t -> unit (** For debugging purposes *) @@ -42,9 +42,6 @@ type doc_view = internal representation opaque here. *) type t = doc_view -type std_ppcmds = t -[@@ocaml.deprecated "alias of Pp.t"] - let repr x = x let unrepr x = x diff --git a/lib/pp.mli b/lib/pp.mli index ed31daa561..4ce6a535c8 100644 --- a/lib/pp.mli +++ b/lib/pp.mli @@ -42,9 +42,6 @@ type pp_tag = string internal representation opaque here. *) type t -type std_ppcmds = t -[@@ocaml.deprecated "alias of Pp.t"] - type block_type = | Pp_hbox of int | Pp_vbox of int diff --git a/library/coqlib.ml b/library/coqlib.ml index 026b7aa316..e71de4d77e 100644 --- a/library/coqlib.ml +++ b/library/coqlib.ml @@ -119,29 +119,26 @@ let prelude_module_name = init_dir@["Prelude"] let prelude_module = make_dir prelude_module_name let logic_module_name = init_dir@["Logic"] -let logic_module = make_dir logic_module_name +let logic_module = MPfile (make_dir logic_module_name) let logic_type_module_name = init_dir@["Logic_Type"] let logic_type_module = make_dir logic_type_module_name let datatypes_module_name = init_dir@["Datatypes"] -let datatypes_module = make_dir datatypes_module_name +let datatypes_module = MPfile (make_dir datatypes_module_name) let jmeq_module_name = [coq;"Logic";"JMeq"] -let jmeq_module = make_dir jmeq_module_name - -(* TODO: temporary hack. Works only if the module isn't an alias *) -let make_ind dir id = Globnames.encode_mind dir (Id.of_string id) -let make_con dir id = Globnames.encode_con dir (Id.of_string id) +let jmeq_library_path = make_dir jmeq_module_name +let jmeq_module = MPfile jmeq_library_path (** Identity *) -let id = make_con datatypes_module "idProp" -let type_of_id = make_con datatypes_module "IDProp" +let id = Constant.make2 datatypes_module @@ Label.make "idProp" +let type_of_id = Constant.make2 datatypes_module @@ Label.make "IDProp" (** Natural numbers *) -let nat_kn = make_ind datatypes_module "nat" -let nat_path = Libnames.make_path datatypes_module (Id.of_string "nat") +let nat_kn = MutInd.make2 datatypes_module @@ Label.make "nat" +let nat_path = Libnames.make_path (make_dir datatypes_module_name) (Id.of_string "nat") let glob_nat = IndRef (nat_kn,0) @@ -151,7 +148,7 @@ let glob_O = ConstructRef path_of_O let glob_S = ConstructRef path_of_S (** Booleans *) -let bool_kn = make_ind datatypes_module "bool" +let bool_kn = MutInd.make2 datatypes_module @@ Label.make "bool" let glob_bool = IndRef (bool_kn,0) @@ -161,13 +158,13 @@ let glob_true = ConstructRef path_of_true let glob_false = ConstructRef path_of_false (** Equality *) -let eq_kn = make_ind logic_module "eq" +let eq_kn = MutInd.make2 logic_module @@ Label.make "eq" let glob_eq = IndRef (eq_kn,0) -let identity_kn = make_ind datatypes_module "identity" +let identity_kn = MutInd.make2 datatypes_module @@ Label.make "identity" let glob_identity = IndRef (identity_kn,0) -let jmeq_kn = make_ind jmeq_module "JMeq" +let jmeq_kn = MutInd.make2 jmeq_module @@ Label.make "JMeq" let glob_jmeq = IndRef (jmeq_kn,0) type coq_sigma_data = { diff --git a/library/coqlib.mli b/library/coqlib.mli index 8844684957..6a3d0953cd 100644 --- a/library/coqlib.mli +++ b/library/coqlib.mli @@ -61,12 +61,13 @@ val init_modules : string list list (** Modules *) val prelude_module : DirPath.t -val logic_module : DirPath.t +val logic_module : ModPath.t val logic_module_name : string list val logic_type_module : DirPath.t -val jmeq_module : DirPath.t +val jmeq_module : ModPath.t +val jmeq_library_path : DirPath.t val jmeq_module_name : string list val datatypes_module_name : string list diff --git a/library/declaremods.ml b/library/declaremods.ml index 0b3b461e6c..e01a99f731 100644 --- a/library/declaremods.ml +++ b/library/declaremods.ml @@ -164,8 +164,7 @@ module ModObjs : *) let mp_of_kn kn = - let mp,sec,l = KerName.repr kn in - assert (DirPath.is_empty sec); + let mp,l = KerName.repr kn in MPdot (mp,l) let dir_of_sp sp = diff --git a/library/global.ml b/library/global.ml index e872d081d6..0e236e6d34 100644 --- a/library/global.ml +++ b/library/global.ml @@ -91,8 +91,8 @@ let set_engagement c = globalize0 (Safe_typing.set_engagement c) let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c) let typing_flags () = Environ.typing_flags (env ()) let export_private_constants ~in_section cd = globalize (Safe_typing.export_private_constants ~in_section cd) -let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d) -let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie) +let add_constant ~in_section id d = globalize (Safe_typing.add_constant ~in_section (i2l id) d) +let add_mind id mie = globalize (Safe_typing.add_mind (i2l id) mie) let add_modtype id me inl = globalize (Safe_typing.add_modtype (i2l id) me inl) let add_module id me inl = globalize (Safe_typing.add_module (i2l id) me inl) let add_include me ismod inl = globalize (Safe_typing.add_include me ismod inl) diff --git a/library/global.mli b/library/global.mli index 5205968c7b..fd6c9a60d4 100644 --- a/library/global.mli +++ b/library/global.mli @@ -42,9 +42,9 @@ val export_private_constants : in_section:bool -> unit Entries.definition_entry * Safe_typing.exported_private_constant list val add_constant : - DirPath.t -> Id.t -> Safe_typing.global_declaration -> Constant.t + in_section:bool -> Id.t -> Safe_typing.global_declaration -> Constant.t val add_mind : - DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> MutInd.t + Id.t -> Entries.mutual_inductive_entry -> MutInd.t (** Extra universe constraints *) val add_constraints : Univ.Constraint.t -> unit diff --git a/library/globnames.ml b/library/globnames.ml index 6bbdd36489..9aca7788d2 100644 --- a/library/globnames.ml +++ b/library/globnames.ml @@ -8,11 +8,9 @@ (* * (see LICENSE file for the text of the license) *) (************************************************************************) -open CErrors open Names open Constr open Mod_subst -open Libnames (*s Global reference is a kernel side type for all references together *) type global_reference = GlobRef.t = @@ -137,53 +135,5 @@ type global_reference_or_constr = | IsGlobal of global_reference | IsConstr of constr -(** {6 Temporary function to brutally form kernel names from section paths } *) - -let encode_mind dir id = MutInd.make2 (MPfile dir) (Label.of_id id) - -let encode_con dir id = Constant.make2 (MPfile dir) (Label.of_id id) - -let check_empty_section dp = - if not (DirPath.is_empty dp) then - anomaly (Pp.str "Section part should be empty!") - -let decode_mind kn = - let rec dir_of_mp = function - | MPfile dir -> DirPath.repr dir - | MPbound mbid -> - let _,_,dp = MBId.repr mbid in - let id = MBId.to_id mbid in - id::(DirPath.repr dp) - | MPdot(mp,l) -> (Label.to_id l)::(dir_of_mp mp) - in - let mp,sec_dir,l = MutInd.repr3 kn in - check_empty_section sec_dir; - (DirPath.make (dir_of_mp mp)),Label.to_id l - -let decode_con kn = - let mp,sec_dir,l = Constant.repr3 kn in - check_empty_section sec_dir; - match mp with - | MPfile dir -> (dir,Label.to_id l) - | _ -> anomaly (Pp.str "MPfile expected!") - -(** Popping one level of section in global names. - These functions are meant to be used during discharge: - user and canonical kernel names must be equal. *) - -let pop_con con = - let (mp,dir,l) = Constant.repr3 con in - Constant.make3 mp (pop_dirpath dir) l - -let pop_kn kn = - let (mp,dir,l) = MutInd.repr3 kn in - MutInd.make3 mp (pop_dirpath dir) l - -let pop_global_reference = function - | ConstRef con -> ConstRef (pop_con con) - | IndRef (kn,i) -> IndRef (pop_kn kn,i) - | ConstructRef ((kn,i),j) -> ConstructRef ((pop_kn kn,i),j) - | VarRef id -> anomaly (Pp.str "VarRef not poppable.") - (* Deprecated *) let eq_gr = GlobRef.equal diff --git a/library/globnames.mli b/library/globnames.mli index 45ee069b06..a96a42ced2 100644 --- a/library/globnames.mli +++ b/library/globnames.mli @@ -82,15 +82,3 @@ end type global_reference_or_constr = | IsGlobal of GlobRef.t | IsConstr of constr - -(** {6 Temporary function to brutally form kernel names from section paths } *) - -val encode_mind : DirPath.t -> Id.t -> MutInd.t -val decode_mind : MutInd.t -> DirPath.t * Id.t -val encode_con : DirPath.t -> Id.t -> Constant.t -val decode_con : Constant.t -> DirPath.t * Id.t - -(** {6 Popping one level of section in global names } *) -val pop_con : Constant.t -> Constant.t -val pop_kn : MutInd.t-> MutInd.t -val pop_global_reference : GlobRef.t -> GlobRef.t diff --git a/library/keys.ml b/library/keys.ml index a74d13c600..53447a679a 100644 --- a/library/keys.ml +++ b/library/keys.ml @@ -92,8 +92,7 @@ let subst_keys (subst,(k,k')) = (subst_key subst k, subst_key subst k') let discharge_key = function - | KGlob g when Lib.is_in_section g -> - if isVarRef g then None else Some (KGlob (pop_global_reference g)) + | KGlob (VarRef _ as g) when Lib.is_in_section g -> None | x -> Some x let discharge_keys (_,(k,k')) = diff --git a/library/lib.ml b/library/lib.ml index 07026a9c2a..27c5056a7f 100644 --- a/library/lib.ml +++ b/library/lib.ml @@ -135,8 +135,8 @@ let make_path_except_section id = Libnames.make_path (cwd_except_section ()) id let make_kn id = - let mp, dir = current_mp (), current_sections () in - Names.KerName.make mp dir (Names.Label.of_id id) + let mp = current_mp () in + Names.KerName.make mp (Names.Label.of_id id) let make_oname id = Libnames.make_oname !lib_state.path_prefix id @@ -632,44 +632,12 @@ let library_part = function |VarRef id -> library_dp () |ref -> dp_of_mp (mp_of_global ref) -(************************) -(* Discharging names *) - -let con_defined_in_sec kn = - let _,dir,_ = Names.Constant.repr3 kn in - not (Names.DirPath.is_empty dir) && - Names.DirPath.equal (pop_dirpath dir) (current_sections ()) - -let defined_in_sec kn = - let _,dir,_ = Names.MutInd.repr3 kn in - not (Names.DirPath.is_empty dir) && - Names.DirPath.equal (pop_dirpath dir) (current_sections ()) - -let discharge_global = function - | ConstRef kn when con_defined_in_sec kn -> - ConstRef (Globnames.pop_con kn) - | IndRef (kn,i) when defined_in_sec kn -> - IndRef (Globnames.pop_kn kn,i) - | ConstructRef ((kn,i),j) when defined_in_sec kn -> - ConstructRef ((Globnames.pop_kn kn,i),j) - | r -> r - -let discharge_kn kn = - if defined_in_sec kn then Globnames.pop_kn kn else kn - -let discharge_con cst = - if con_defined_in_sec cst then Globnames.pop_con cst else cst - let discharge_proj_repr = Projection.Repr.map_npars (fun mind npars -> - if not (defined_in_sec mind) then mind, npars - else - let modlist = replacement_context () in - let _, newpars = Mindmap.find mind (snd modlist) in - Globnames.pop_kn mind, npars + Array.length newpars) - -let discharge_inductive (kn,i) = - (discharge_kn kn,i) + if not (is_in_section (IndRef (mind,0))) then mind, npars + else let modlist = replacement_context () in + let _, newpars = Mindmap.find mind (snd modlist) in + mind, npars + Array.length newpars) let discharge_abstract_universe_context { abstr_subst = subst; abstr_uctx = abs_ctx } auctx = let open Univ in diff --git a/library/lib.mli b/library/lib.mli index a7d21060e9..686e6a0e2d 100644 --- a/library/lib.mli +++ b/library/lib.mli @@ -187,10 +187,8 @@ val is_polymorphic_univ : Univ.Level.t -> bool (** {6 Discharge: decrease the section level if in the current section } *) -val discharge_kn : MutInd.t -> MutInd.t -val discharge_con : Constant.t -> Constant.t +(* XXX Why can't we use the kernel functions ? *) + val discharge_proj_repr : Projection.Repr.t -> Projection.Repr.t -val discharge_global : GlobRef.t -> GlobRef.t -val discharge_inductive : inductive -> inductive val discharge_abstract_universe_context : abstr_info -> Univ.AUContext.t -> Univ.universe_level_subst * Univ.AUContext.t diff --git a/library/libnames.ml b/library/libnames.ml index 23085048a1..bd2ca550b9 100644 --- a/library/libnames.ml +++ b/library/libnames.ml @@ -171,8 +171,8 @@ type object_prefix = { } (* let make_oname (dirpath,(mp,dir)) id = *) -let make_oname { obj_dir; obj_mp; obj_sec } id = - make_path obj_dir id, KerName.make obj_mp obj_sec (Label.of_id id) +let make_oname { obj_dir; obj_mp } id = + make_path obj_dir id, KerName.make obj_mp (Label.of_id id) (* to this type are mapped DirPath.t's in the nametab *) type global_dir_reference = diff --git a/library/nametab.ml b/library/nametab.ml index 840cf8e380..06ace373c3 100644 --- a/library/nametab.ml +++ b/library/nametab.ml @@ -30,6 +30,9 @@ let error_global_not_found qid = *) type visibility = Until of int | Exactly of int +let map_visibility f = function + | Until i -> Until (f i) + | Exactly i -> Exactly (f i) (* Data structure for nametabs *******************************************) diff --git a/library/nametab.mli b/library/nametab.mli index 57e9141db9..1c3322bfb1 100644 --- a/library/nametab.mli +++ b/library/nametab.mli @@ -75,6 +75,8 @@ val error_global_not_found : qualid -> 'a type visibility = Until of int | Exactly of int +val map_visibility : (int -> int) -> visibility -> visibility + val push : visibility -> full_path -> GlobRef.t -> unit val push_modtype : visibility -> full_path -> ModPath.t -> unit val push_dir : visibility -> DirPath.t -> global_dir_reference -> unit diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4 index d65b35c462..9c421f5b76 100644 --- a/parsing/cLexer.ml4 +++ b/parsing/cLexer.ml4 @@ -398,7 +398,6 @@ let set_lexer_state (o,s,b,c,f) = current_file := f let get_lexer_state () = (!comment_begin, Buffer.contents current_comment, !between_commands, !comments, !current_file) -let release_lexer_state = get_lexer_state let drop_lexer_state () = set_lexer_state (init_lexer_state Loc.ToplevelInput) diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli index a14f08d91f..e4aa8debc1 100644 --- a/parsing/cLexer.mli +++ b/parsing/cLexer.mli @@ -54,7 +54,5 @@ type lexer_state val init_lexer_state : Loc.source -> lexer_state val set_lexer_state : lexer_state -> unit val get_lexer_state : unit -> lexer_state -val release_lexer_state : unit -> lexer_state -[@@ocaml.deprecated "Use get_lexer_state"] val drop_lexer_state : unit -> unit val get_comment_state : lexer_state -> ((int * int) * string) list diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index 7cb5af787b..e25f7aa54f 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -249,20 +249,20 @@ GRAMMAR EXTEND Gram record_field_declaration: [ [ id = global; bl = binders; ":="; c = lconstr -> - { (id, if bl = [] then c else mkCLambdaN ~loc bl c) } ] ] + { (id, mkLambdaCN ~loc bl c) } ] ] ; binder_constr: [ [ "forall"; bl = open_binders; ","; c = operconstr LEVEL "200" -> - { mkCProdN ~loc bl c } + { mkProdCN ~loc bl c } | "fun"; bl = open_binders; "=>"; c = operconstr LEVEL "200" -> - { mkCLambdaN ~loc bl c } + { mkLambdaCN ~loc bl c } | "let"; id=name; bl = binders; ty = type_cstr; ":="; c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" -> { let ty,c1 = match ty, c1 with | (_,None), { CAst.v = CCast(c, CastConv t) } -> (Loc.tag ?loc:(constr_loc t) @@ Some t), c (* Tolerance, see G_vernac.def_body *) | _, _ -> ty, c1 in - CAst.make ~loc @@ CLetIn(id,mkCLambdaN ?loc:(constr_loc c1) bl c1, - Option.map (mkCProdN ?loc:(fst ty) bl) (snd ty), c2) } + CAst.make ~loc @@ CLetIn(id,mkLambdaCN ?loc:(constr_loc c1) bl c1, + Option.map (mkProdCN ?loc:(fst ty) bl) (snd ty), c2) } | "let"; fx = single_fix; "in"; c = operconstr LEVEL "200" -> { let fixp = mk_single_fix fx in let { CAst.loc = li; v = id } = match fixp.CAst.v with diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index c21f8f0d9a..c05229d576 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -23,12 +23,6 @@ module Gram : sig include Grammar.S with type te = Tok.t - type 'a entry = 'a Entry.e - [@@ocaml.deprecated "Use [Pcoq.Entry.t]"] - - val entry_create : string -> 'a Entry.e - [@@ocaml.deprecated "Use [Pcoq.Entry.create]"] - val gram_extend : 'a Entry.e -> 'a Extend.extend_statement -> unit end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml index d413cd1e6d..bdeb6fca60 100644 --- a/plugins/extraction/common.ml +++ b/plugins/extraction/common.ml @@ -588,7 +588,7 @@ let pp_global k r = let ls = ref_renaming (k,r) in assert (List.length ls > 1); let s = List.hd ls in - let mp,_,l = repr_of_r r in + let mp,l = repr_of_r r in if ModPath.equal mp (top_visible_mp ()) then (* simpliest situation: definition of r (or use in the same context) *) (* we update the visible environment *) diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml index 5d3115d8d7..b0f6301192 100644 --- a/plugins/extraction/extract_env.ml +++ b/plugins/extraction/extract_env.ml @@ -30,7 +30,7 @@ open Common let toplevel_env () = let get_reference = function | (_,kn), Lib.Leaf o -> - let mp,_,l = KerName.repr kn in + let mp,l = KerName.repr kn in begin match Libobject.object_tag o with | "CONSTANT" -> let constant = Global.lookup_constant (Constant.make1 kn) in @@ -124,7 +124,7 @@ module Visit : VISIT = struct end let add_field_label mp = function - | (lab, (SFBconst _|SFBmind _)) -> Visit.add_kn (KerName.make2 mp lab) + | (lab, (SFBconst _|SFBmind _)) -> Visit.add_kn (KerName.make mp lab) | (lab, (SFBmodule _|SFBmodtype _)) -> Visit.add_mp_all (MPdot (mp,lab)) let rec add_labels mp = function @@ -208,10 +208,10 @@ let env_for_mtb_with_def env mp me reso idl = Modops.add_structure mp before reso env let make_cst resolver mp l = - Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp l) + Mod_subst.constant_of_delta_kn resolver (KerName.make mp l) let make_mind resolver mp l = - Mod_subst.mind_of_delta_kn resolver (KerName.make2 mp l) + Mod_subst.mind_of_delta_kn resolver (KerName.make mp l) (* From a [structure_body] (i.e. a list of [structure_field_body]) to specifications. *) diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml index 6ee1770a4e..7b4fd280bd 100644 --- a/plugins/extraction/table.ml +++ b/plugins/extraction/table.ml @@ -36,16 +36,16 @@ let occur_kn_in_ref kn = function | ConstRef _ | VarRef _ -> false let repr_of_r = function - | ConstRef kn -> Constant.repr3 kn + | ConstRef kn -> Constant.repr2 kn | IndRef (kn,_) - | ConstructRef ((kn,_),_) -> MutInd.repr3 kn + | ConstructRef ((kn,_),_) -> MutInd.repr2 kn | VarRef v -> KerName.repr (Lib.make_kn v) let modpath_of_r r = - let mp,_,_ = repr_of_r r in mp + let mp,_ = repr_of_r r in mp let label_of_r r = - let _,_,l = repr_of_r r in l + let _,l = repr_of_r r in l let rec base_mp = function | MPdot (mp,l) -> base_mp mp @@ -95,7 +95,7 @@ let rec parse_labels2 ll mp1 = function let labels_of_ref r = let mp_top = Lib.current_mp () in - let mp,_,l = repr_of_r r in + let mp,l = repr_of_r r in parse_labels2 [l] mp_top mp @@ -189,7 +189,7 @@ let init_recursors () = recursors := KNset.empty let add_recursors env ind = let kn = MutInd.canonical ind in let mk_kn id = - KerName.make (KerName.modpath kn) DirPath.empty (Label.of_id id) + KerName.make (KerName.modpath kn) (Label.of_id id) in let mib = Environ.lookup_mind ind env in Array.iter @@ -287,7 +287,7 @@ let safe_pr_long_global r = try Printer.pr_global r with Not_found -> match r with | ConstRef kn -> - let mp,_,l = Constant.repr3 kn in + let mp,l = Constant.repr2 kn in str ((ModPath.to_string mp)^"."^(Label.to_string l)) | _ -> assert false @@ -653,8 +653,7 @@ let inline_extraction : bool * GlobRef.t list -> obj = cache_function = (fun (_,(b,l)) -> add_inline_entries b l); load_function = (fun _ (_,(b,l)) -> add_inline_entries b l); classify_function = (fun o -> Substitute o); - discharge_function = - (fun (_,(b,l)) -> Some (b, List.map pop_global_reference l)); + discharge_function = (fun (_,x) -> Some x); subst_function = (fun (s,(b,l)) -> (b,(List.map (fun x -> fst (subst_global s x)) l))) } diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli index a8baeaf1b6..acc1bfee8a 100644 --- a/plugins/extraction/table.mli +++ b/plugins/extraction/table.mli @@ -46,7 +46,7 @@ val info_file : string -> unit (*s utilities about [module_path] and [kernel_names] and [GlobRef.t] *) val occur_kn_in_ref : MutInd.t -> GlobRef.t -> bool -val repr_of_r : GlobRef.t -> ModPath.t * DirPath.t * Label.t +val repr_of_r : GlobRef.t -> ModPath.t * Label.t val modpath_of_r : GlobRef.t -> ModPath.t val label_of_r : GlobRef.t -> Label.t val base_mp : ModPath.t -> ModPath.t diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml index b2a528a1fd..9ca91d62da 100644 --- a/plugins/funind/functional_principles_types.ml +++ b/plugins/funind/functional_principles_types.ml @@ -1,3 +1,13 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + open Printer open CErrors open Term @@ -322,7 +332,8 @@ let generate_functional_principle (evd: Evd.evar_map ref) try let f = funs.(i) in - let type_sort = Evarutil.evd_comb1 Evd.fresh_sort_in_family evd InType in + let sigma, type_sort = Evd.fresh_sort_in_family !evd InType in + evd := sigma; let new_sorts = match sorts with | None -> Array.make (Array.length funs) (type_sort) @@ -394,7 +405,7 @@ let generate_functional_principle (evd: Evd.evar_map ref) exception Not_Rec -let get_funs_constant mp dp = +let get_funs_constant mp = let get_funs_constant const e : (Names.Constant.t*int) array = match Constr.kind ((strip_lam e)) with | Fix((_,(na,_,_))) -> @@ -402,7 +413,7 @@ let get_funs_constant mp dp = (fun i na -> match na with | Name id -> - let const = Constant.make3 mp dp (Label.of_id id) in + let const = Constant.make2 mp (Label.of_id id) in const,i | Anonymous -> anomaly (Pp.str "Anonymous fix.") @@ -474,13 +485,13 @@ let make_scheme evd (fas : (pconstant*Sorts.family) list) : Safe_typing.private_ let env = Global.env () in let funs = List.map fst fas in let first_fun = List.hd funs in - let funs_mp,funs_dp,_ = KerName.repr (Constant.canonical (fst first_fun)) in + let funs_mp = KerName.modpath (Constant.canonical (fst first_fun)) in let first_fun_kn = try fst (find_Function_infos (fst first_fun)).graph_ind with Not_found -> raise No_graph_found in - let this_block_funs_indexes = get_funs_constant funs_mp funs_dp (fst first_fun) in + let this_block_funs_indexes = get_funs_constant funs_mp (fst first_fun) in let this_block_funs = Array.map (fun (c,_) -> (c,snd first_fun)) this_block_funs_indexes in let prop_sort = InProp in let funs_indexes = @@ -507,8 +518,9 @@ let make_scheme evd (fas : (pconstant*Sorts.family) list) : Safe_typing.private_ let i = ref (-1) in let sorts = List.rev_map (fun (_,x) -> - Evarutil.evd_comb1 Evd.fresh_sort_in_family evd x - ) + let sigma, fs = Evd.fresh_sort_in_family !evd x in + evd := sigma; fs + ) fas in (* We create the first priciple by tactic *) @@ -669,9 +681,9 @@ let build_case_scheme fa = user_err ~hdr:"FunInd.build_case_scheme" (str "Cannot find " ++ Libnames.pr_qualid f) in let first_fun,u = destConst funs in - let funs_mp,funs_dp,_ = Constant.repr3 first_fun in + let funs_mp = Constant.modpath first_fun in let first_fun_kn = try fst (find_Function_infos first_fun).graph_ind with Not_found -> raise No_graph_found in - let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in + let this_block_funs_indexes = get_funs_constant funs_mp first_fun in let this_block_funs = Array.map (fun (c,_) -> (c,u)) this_block_funs_indexes in let prop_sort = InProp in let funs_indexes = diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml index 9eda19a86b..9a6169d42a 100644 --- a/plugins/funind/indfun.ml +++ b/plugins/funind/indfun.ml @@ -898,11 +898,11 @@ let make_graph (f_ref : GlobRef.t) = let id = Label.to_id (Constant.label c) in [((CAst.make id,None),(None,Constrexpr.CStructRec),nal_tas,t,Some b),[]] in - let mp,dp,_ = Constant.repr3 c in + let mp = Constant.modpath c in do_generate_principle [c,Univ.Instance.empty] error_error false false expr_list; (* We register the infos *) List.iter - (fun ((({CAst.v=id},_),_,_,_,_),_) -> add_Function false (Constant.make3 mp dp (Label.of_id id))) + (fun ((({CAst.v=id},_),_,_,_,_),_) -> add_Function false (Constant.make2 mp (Label.of_id id))) expr_list) let do_generate_principle = do_generate_principle [] warning_error true diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml index 4eee2c7a45..6ed382ca1c 100644 --- a/plugins/funind/indfun_common.ml +++ b/plugins/funind/indfun_common.ml @@ -297,36 +297,7 @@ let subst_Function (subst,finfos) = let classify_Function infos = Libobject.Substitute infos -let discharge_Function (_,finfos) = - let function_constant' = Lib.discharge_con finfos.function_constant - and graph_ind' = Lib.discharge_inductive finfos.graph_ind - and equation_lemma' = Option.Smart.map Lib.discharge_con finfos.equation_lemma - and correctness_lemma' = Option.Smart.map Lib.discharge_con finfos.correctness_lemma - and completeness_lemma' = Option.Smart.map Lib.discharge_con finfos.completeness_lemma - and rect_lemma' = Option.Smart.map Lib.discharge_con finfos.rect_lemma - and rec_lemma' = Option.Smart.map Lib.discharge_con finfos.rec_lemma - and prop_lemma' = Option.Smart.map Lib.discharge_con finfos.prop_lemma - in - if function_constant' == finfos.function_constant && - graph_ind' == finfos.graph_ind && - equation_lemma' == finfos.equation_lemma && - correctness_lemma' == finfos.correctness_lemma && - completeness_lemma' == finfos.completeness_lemma && - rect_lemma' == finfos.rect_lemma && - rec_lemma' == finfos.rec_lemma && - prop_lemma' == finfos.prop_lemma - then Some finfos - else - Some { function_constant = function_constant' ; - graph_ind = graph_ind' ; - equation_lemma = equation_lemma' ; - correctness_lemma = correctness_lemma' ; - completeness_lemma = completeness_lemma'; - rect_lemma = rect_lemma'; - rec_lemma = rec_lemma'; - prop_lemma = prop_lemma' ; - is_general = finfos.is_general - } +let discharge_Function (_,finfos) = Some finfos let pr_ocst c = let sigma, env = Pfedit.get_current_context () in diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml index ad11f853ca..56fe430077 100644 --- a/plugins/funind/invfun.ml +++ b/plugins/funind/invfun.ml @@ -450,7 +450,7 @@ let generalize_dependent_of x hyp g = let tauto = let dp = List.map Id.of_string ["Tauto" ; "Init"; "Coq"] in let mp = ModPath.MPfile (DirPath.make dp) in - let kn = KerName.make2 mp (Label.make "tauto") in + let kn = KerName.make mp (Label.make "tauto") in Proofview.tclBIND (Proofview.tclUNIT ()) begin fun () -> let body = Tacenv.interp_ltac kn in Tacinterp.eval_tactic body diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index 7298342e1e..633d98a585 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -713,7 +713,7 @@ let mkDestructEq : observe_tclTHENLIST (str "mkDestructEq") [Proofview.V82.of_tactic (generalize new_hyps); (fun g2 -> - let changefun patvars sigma = + let changefun patvars env sigma = pattern_occs [Locus.AllOccurrencesBut [1], expr] (pf_env g2) sigma (pf_concl g2) in Proofview.V82.of_tactic (change_in_concl None changefun) g2); diff --git a/plugins/ltac/tacexpr.ml b/plugins/ltac/tacexpr.ml index 11d13d3a2f..8731cbf60d 100644 --- a/plugins/ltac/tacexpr.ml +++ b/plugins/ltac/tacexpr.ml @@ -35,41 +35,6 @@ type advanced_flag = bool (* true = advanced false = basic *) type letin_flag = bool (* true = use local def false = use Leibniz *) type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *) -type goal_selector = Goal_select.t = - | SelectAlreadyFocused - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectNth of int - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectList of (int * int) list - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectId of Id.t - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectAll - [@ocaml.deprecated "Use constructors in [Goal_select]"] -[@@ocaml.deprecated "Use [Goal_select.t]"] - -type 'a core_destruction_arg = 'a Tactics.core_destruction_arg = - | ElimOnConstr of 'a - [@ocaml.deprecated "Use constructors in [Tactics]"] - | ElimOnIdent of lident - [@ocaml.deprecated "Use constructors in [Tactics]"] - | ElimOnAnonHyp of int - [@ocaml.deprecated "Use constructors in [Tactics]"] -[@@ocaml.deprecated "Use Tactics.core_destruction_arg"] - -type 'a destruction_arg = - clear_flag * 'a Tactics.core_destruction_arg -[@@ocaml.deprecated "Use Tactics.destruction_arg"] - -type inversion_kind = Inv.inversion_kind = - | SimpleInversion - [@ocaml.deprecated "Use constructors in [Inv]"] - | FullInversion - [@ocaml.deprecated "Use constructors in [Inv]"] - | FullInversionClear - [@ocaml.deprecated "Use constructors in [Inv]"] -[@@ocaml.deprecated "Use Tactics.inversion_kind"] - type ('c,'d,'id) inversion_strength = | NonDepInversion of Inv.inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli index 6b131edaac..9958d6dcda 100644 --- a/plugins/ltac/tacexpr.mli +++ b/plugins/ltac/tacexpr.mli @@ -35,41 +35,6 @@ type advanced_flag = bool (* true = advanced false = basic *) type letin_flag = bool (* true = use local def false = use Leibniz *) type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *) -type goal_selector = Goal_select.t = - | SelectAlreadyFocused - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectNth of int - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectList of (int * int) list - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectId of Id.t - [@ocaml.deprecated "Use constructors in [Goal_select]"] - | SelectAll - [@ocaml.deprecated "Use constructors in [Goal_select]"] -[@@ocaml.deprecated "Use Vernacexpr.goal_selector"] - -type 'a core_destruction_arg = 'a Tactics.core_destruction_arg = - | ElimOnConstr of 'a - [@ocaml.deprecated "Use constructors in [Tactics]"] - | ElimOnIdent of lident - [@ocaml.deprecated "Use constructors in [Tactics]"] - | ElimOnAnonHyp of int - [@ocaml.deprecated "Use constructors in [Tactics]"] -[@@ocaml.deprecated "Use Tactics.core_destruction_arg"] - -type 'a destruction_arg = - clear_flag * 'a Tactics.core_destruction_arg -[@@ocaml.deprecated "Use Tactics.destruction_arg"] - -type inversion_kind = Inv.inversion_kind = - | SimpleInversion - [@ocaml.deprecated "Use constructors in [Inv]"] - | FullInversion - [@ocaml.deprecated "Use constructors in [Inv]"] - | FullInversionClear - [@ocaml.deprecated "Use constructors in [Inv]"] -[@@ocaml.deprecated "Use Tactics.inversion_kind"] - type ('c,'d,'id) inversion_strength = | NonDepInversion of Inv.inversion_kind * 'id list * 'd or_and_intro_pattern_expr CAst.t or_var option diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml index 9f34df4608..f90e889678 100644 --- a/plugins/ltac/tacinterp.ml +++ b/plugins/ltac/tacinterp.ml @@ -283,6 +283,12 @@ let debugging_exception_step ist signal_anomaly e pp = debugging_step ist (fun () -> pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ explain_exc e) +let ensure_freshness env = + (* We anonymize declarations which we know will not be used *) + (* This assumes that the original context had no rels *) + process_rel_context + (fun d e -> EConstr.push_rel (Context.Rel.Declaration.set_name Anonymous d) e) env + (* Raise Not_found if not in interpretation sign *) let try_interp_ltac_var coerce ist env {loc;v=id} = let v = Id.Map.find id ist.lfun in @@ -1740,15 +1746,15 @@ and interp_atomic ist tac : unit Proofview.tactic = | AllOccurrences | NoOccurrences -> true | _ -> false in - let c_interp patvars sigma = + let c_interp patvars env sigma = let lfun' = Id.Map.fold (fun id c lfun -> Id.Map.add id (Value.of_constr c) lfun) patvars ist.lfun in let ist = { ist with lfun = lfun' } in if is_onhyps && is_onconcl - then interp_type ist (pf_env gl) sigma c - else interp_constr ist (pf_env gl) sigma c + then interp_type ist env sigma c + else interp_constr ist env sigma c in Tactics.change None c_interp (interp_clause ist (pf_env gl) (project gl) cl) end @@ -1761,11 +1767,12 @@ and interp_atomic ist tac : unit Proofview.tactic = let sigma = project gl in let op = interp_typed_pattern ist env sigma op in let to_catch = function Not_found -> true | e -> CErrors.is_anomaly e in - let c_interp patvars sigma = + let c_interp patvars env sigma = let lfun' = Id.Map.fold (fun id c lfun -> Id.Map.add id (Value.of_constr c) lfun) patvars ist.lfun in + let env = ensure_freshness env in let ist = { ist with lfun = lfun' } in try interp_constr ist env sigma c diff --git a/plugins/omega/g_omega.mlg b/plugins/omega/g_omega.mlg index c3d063cff8..85081b24a3 100644 --- a/plugins/omega/g_omega.mlg +++ b/plugins/omega/g_omega.mlg @@ -27,7 +27,7 @@ open Stdarg let eval_tactic name = let dp = DirPath.make (List.map Id.of_string ["PreOmega"; "omega"; "Coq"]) in - let kn = KerName.make2 (ModPath.MPfile dp) (Label.make name) in + let kn = KerName.make (ModPath.MPfile dp) (Label.make name) in let tac = Tacenv.interp_ltac kn in Tacinterp.eval_tactic tac diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml index b05e1e85b7..0734654abf 100644 --- a/plugins/setoid_ring/newring.ml +++ b/plugins/setoid_ring/newring.ml @@ -266,7 +266,7 @@ let my_reference c = let znew_ring_path = DirPath.make (List.map Id.of_string ["InitialRing";plugin_dir;"Coq"]) let zltac s = - lazy(KerName.make (ModPath.MPfile znew_ring_path) DirPath.empty (Label.make s)) + lazy(KerName.make (ModPath.MPfile znew_ring_path) (Label.make s)) let mk_cst l s = lazy (Coqlib.coq_reference "newring" l s);; let pol_cst s = mk_cst [plugin_dir;"Ring_polynom"] s ;; @@ -760,7 +760,7 @@ let new_field_path = DirPath.make (List.map Id.of_string ["Field_tac";plugin_dir;"Coq"]) let field_ltac s = - lazy(KerName.make (ModPath.MPfile new_field_path) DirPath.empty (Label.make s)) + lazy(KerName.make (ModPath.MPfile new_field_path) (Label.make s)) let _ = add_map "field" diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml index f23433f2f4..2af917b939 100644 --- a/plugins/ssr/ssrequality.ml +++ b/plugins/ssr/ssrequality.ml @@ -337,9 +337,9 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl = let elim, gl = pf_fresh_global (Indrec.lookup_eliminator ind sort) gl in if dir = R2L then elim, gl else (* taken from Coq's rewrite *) let elim, _ = destConst elim in - let mp,dp,l = Constant.repr3 (Constant.make1 (Constant.canonical elim)) in + let mp,l = Constant.repr2 (Constant.make1 (Constant.canonical elim)) in let l' = Label.of_id (Nameops.add_suffix (Label.to_id l) "_r") in - let c1' = Global.constant_of_delta_kn (Constant.canonical (Constant.make3 mp dp l')) in + let c1' = Global.constant_of_delta_kn (Constant.canonical (Constant.make2 mp l')) in mkConst c1', gl in let elim = EConstr.of_constr elim in let proof = EConstr.mkApp (elim, [| rdx_ty; new_rdx; pred; p; rdx; c |]) in diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml index 53153198f9..8ee6fbf036 100644 --- a/plugins/syntax/ascii_syntax.ml +++ b/plugins/syntax/ascii_syntax.ml @@ -24,7 +24,6 @@ open Coqlib exception Non_closed_ascii let make_dir l = DirPath.make (List.rev_map Id.of_string l) -let make_kn dir id = Globnames.encode_mind (make_dir dir) (Id.of_string id) 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 @@ -32,10 +31,12 @@ let is_gr c gr = match DAst.get c with | _ -> false let ascii_module = ["Coq";"Strings";"Ascii"] +let ascii_modpath = MPfile (make_dir ascii_module) let ascii_path = make_path ascii_module "ascii" -let ascii_kn = make_kn ascii_module "ascii" +let ascii_label = Label.make "ascii" +let ascii_kn = MutInd.make2 ascii_modpath ascii_label let path_of_Ascii = ((ascii_kn,0),1) let static_glob_Ascii = ConstructRef path_of_Ascii diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml index 49497aef54..776d2a2229 100644 --- a/plugins/syntax/r_syntax.ml +++ b/plugins/syntax/r_syntax.ml @@ -33,12 +33,10 @@ 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_path = make_path binnums "positive" -(* TODO: temporary hack *) -let make_kn dir id = Globnames.encode_mind dir id - -let positive_kn = make_kn (make_dir binnums) (Id.of_string "positive") +let positive_kn = MutInd.make2 positive_modpath (Label.make "positive") let glob_positive = IndRef (positive_kn,0) let path_of_xI = ((positive_kn,0),1) let path_of_xO = ((positive_kn,0),2) @@ -74,7 +72,7 @@ let rec bignat_of_pos c = match DAst.get c with (**********************************************************************) let z_path = make_path binnums "Z" -let z_kn = make_kn (make_dir binnums) (Id.of_string "Z") +let z_kn = MutInd.make2 positive_modpath (Label.make "Z") let glob_z = IndRef (z_kn,0) let path_of_ZERO = ((z_kn,0),1) let path_of_POS = ((z_kn,0),2) @@ -106,12 +104,10 @@ let bigint_of_z c = match DAst.get c with (**********************************************************************) let rdefinitions = ["Coq";"Reals";"Rdefinitions"] +let r_modpath = MPfile (make_dir rdefinitions) let r_path = make_path rdefinitions "R" -(* TODO: temporary hack *) -let make_path dir id = Globnames.encode_con dir (Id.of_string id) - -let glob_IZR = ConstRef (make_path (make_dir rdefinitions) "IZR") +let glob_IZR = ConstRef (Constant.make2 r_modpath @@ Label.make "IZR") let r_of_int ?loc z = DAst.make @@ GApp (DAst.make @@ GRef(glob_IZR,None), [z_of_int ?loc z]) diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml index 7478c1e978..703b40dd3e 100644 --- a/plugins/syntax/string_syntax.ml +++ b/plugins/syntax/string_syntax.ml @@ -24,9 +24,10 @@ exception Non_closed_string let string_module = ["Coq";"Strings";"String"] +let string_modpath = MPfile (make_dir string_module) let string_path = make_path string_module "string" -let string_kn = make_kn string_module "string" +let string_kn = MutInd.make2 string_modpath @@ Label.make "string" let static_glob_EmptyString = ConstructRef ((string_kn,0),1) let static_glob_String = ConstructRef ((string_kn,0),2) diff --git a/pretyping/arguments_renaming.ml b/pretyping/arguments_renaming.ml index b8958ca944..3da1ab7439 100644 --- a/pretyping/arguments_renaming.ml +++ b/pretyping/arguments_renaming.ml @@ -46,10 +46,9 @@ let discharge_rename_args = function | _, (ReqGlobal (c, names), _ as req) -> (try let vars = Lib.variable_section_segment_of_reference c in - let c' = pop_global_reference c in let var_names = List.map (fst %> NamedDecl.get_id %> Name.mk_name) vars in let names' = var_names @ names in - Some (ReqGlobal (c', names), (c', names')) + Some (ReqGlobal (c, names), (c, names')) with Not_found -> Some req) | _ -> None diff --git a/pretyping/cases.ml b/pretyping/cases.ml index 2c821c96ba..9fa8442f8a 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -1713,7 +1713,8 @@ let abstract_tycon ?loc env sigma subst tycon extenv t = let vl = List.map pi1 good in let ty = let ty = get_type_of !!env sigma t in - Evarutil.evd_comb1 (refresh_universes (Some false) !!env) evdref ty + let sigma, res = refresh_universes (Some false) !!env !evdref ty in + evdref := sigma; res in let dummy_subst = List.init k (fun _ -> mkProp) in let ty = substl dummy_subst (aux x ty) in diff --git a/pretyping/classops.ml b/pretyping/classops.ml index b264e31474..b026397abf 100644 --- a/pretyping/classops.ml +++ b/pretyping/classops.ml @@ -451,12 +451,6 @@ let subst_coercion (subst, c) = else { c with coercion_type = coe; coercion_source = cls; coercion_target = clt; coercion_is_proj = clp; } -let discharge_cl = function - | CL_CONST kn -> CL_CONST (Lib.discharge_con kn) - | CL_IND ind -> CL_IND (Lib.discharge_inductive ind) - | CL_PROJ p -> CL_PROJ (Lib.discharge_proj_repr p) - | cl -> cl - let discharge_coercion (_, c) = if c.coercion_local then None else @@ -467,9 +461,6 @@ let discharge_coercion (_, c) = with Not_found -> 0 in let nc = { c with - coercion_type = Lib.discharge_global c.coercion_type; - coercion_source = discharge_cl c.coercion_source; - coercion_target = discharge_cl c.coercion_target; coercion_params = n + c.coercion_params; coercion_is_proj = Option.map Lib.discharge_proj_repr c.coercion_is_proj; } in diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index e978adf761..bae13dbba1 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1386,8 +1386,6 @@ let solve_unif_constraints_with_heuristics env check_problems_are_solved env heuristic_solved_evd; solve_unconstrained_impossible_cases env heuristic_solved_evd -let consider_remaining_unif_problems = solve_unif_constraints_with_heuristics - (* Main entry points *) exception UnableToUnify of evar_map * unification_error @@ -1414,13 +1412,3 @@ let conv env ?(ts=default_transparent_state env) evd t1 t2 = let cumul env ?(ts=default_transparent_state env) evd t1 t2 = make_opt(evar_conv_x ts env evd CUMUL t1 t2) - -let e_conv env ?(ts=default_transparent_state env) evdref t1 t2 = - match evar_conv_x ts env !evdref CONV t1 t2 with - | Success evd' -> evdref := evd'; true - | _ -> false - -let e_cumul env ?(ts=default_transparent_state env) evdref t1 t2 = - match evar_conv_x ts env !evdref CUMUL t1 t2 with - | Success evd' -> evdref := evd'; true - | _ -> false diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli index cdf5dd0e50..20a4f34ec7 100644 --- a/pretyping/evarconv.mli +++ b/pretyping/evarconv.mli @@ -27,12 +27,6 @@ val the_conv_x_leq : env -> ?ts:transparent_state -> constr -> constr -> evar_ma (** The same function resolving evars by side-effect and catching the exception *) -val e_conv : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr -> bool -[@@ocaml.deprecated "Use [Evarconv.conv]"] - -val e_cumul : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr -> bool -[@@ocaml.deprecated "Use [Evarconv.cumul]"] - val conv : env -> ?ts:transparent_state -> evar_map -> constr -> constr -> evar_map option val cumul : env -> ?ts:transparent_state -> evar_map -> constr -> constr -> evar_map option @@ -43,9 +37,6 @@ val cumul : env -> ?ts:transparent_state -> evar_map -> constr -> constr -> evar val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map -val consider_remaining_unif_problems : env -> ?ts:transparent_state -> evar_map -> evar_map -[@@ocaml.deprecated "Alias for [solve_unif_constraints_with_heuristics]"] - (** Check all pending unification problems are solved and raise an error otherwise *) diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index 2dd3721980..44bfe4b6cc 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -46,7 +46,8 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false) (* direction: true for fresh universes lower than the existing ones *) let refresh_sort status ~direction s = let s = ESorts.kind !evdref s in - let s' = evd_comb0 (new_sort_variable status) evdref in + let sigma, s' = new_sort_variable status !evdref in + evdref := sigma; let evd = if direction then set_leq_sort env !evdref s' s else set_leq_sort env !evdref s s' @@ -1690,8 +1691,6 @@ let reconsider_unif_constraints conv_algo evd = (Success evd) pbs -let reconsider_conv_pbs = reconsider_unif_constraints - (* Tries to solve problem t1 = t2. * Precondition: t1 is an uninstantiated evar * Returns an optional list of evars that were instantiated, or None diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index 3f05c58c41..4665ed29a2 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -62,9 +62,6 @@ val solve_simple_eqn : conv_fun -> ?choose:bool -> env -> evar_map -> val reconsider_unif_constraints : conv_fun -> evar_map -> unification_result -val reconsider_conv_pbs : conv_fun -> evar_map -> unification_result -[@@ocaml.deprecated "Alias for [reconsider_unif_constraints]"] - val is_unification_pattern_evar : env -> evar_map -> existential -> constr list -> constr -> alias list option diff --git a/pretyping/heads.ml b/pretyping/heads.ml index 7d9debce34..a3e4eb8971 100644 --- a/pretyping/heads.ml +++ b/pretyping/heads.ml @@ -14,7 +14,6 @@ open Constr open Vars open Mod_subst open Environ -open Globnames open Libobject open Lib open Context.Named.Declaration @@ -171,7 +170,7 @@ let subst_head (subst,(ref,k)) = let discharge_head (_,(ref,k)) = match ref with - | EvalConstRef cst -> Some (EvalConstRef (pop_con cst), k) + | EvalConstRef cst -> Some (ref, k) | EvalVarRef id -> None let rebuild_head (ref,k) = diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml index 418fdf2a26..e49ba75b3f 100644 --- a/pretyping/indrec.ml +++ b/pretyping/indrec.ml @@ -455,8 +455,8 @@ let mis_make_indrec env sigma ?(force_mutual=false) listdepkind mib u = | ((indi,u),_,_,dep,kinds)::rest -> let indf = make_ind_family ((indi,u), Context.Rel.to_extended_list mkRel i lnamesparrec) in let s = - Evarutil.evd_comb1 (Evd.fresh_sort_in_family ~rigid:Evd.univ_flexible_alg) - evdref kinds + let sigma, res = Evd.fresh_sort_in_family ~rigid:Evd.univ_flexible_alg !evdref kinds in + evdref := sigma; res in let typP = make_arity env !evdref dep indf s in let typP = EConstr.Unsafe.to_constr typP in @@ -601,13 +601,13 @@ let make_elimination_ident id s = add_suffix id (elimination_suffix s) let lookup_eliminator ind_sp s = let kn,i = ind_sp in - let mp,dp,l = KerName.repr (MutInd.canonical kn) in + let mp,l = KerName.repr (MutInd.canonical kn) in let ind_id = (Global.lookup_mind kn).mind_packets.(i).mind_typename in let id = add_suffix ind_id (elimination_suffix s) in (* Try first to get an eliminator defined in the same section as the *) (* inductive type *) try - let cst =Global.constant_of_delta_kn (KerName.make mp dp (Label.of_id id)) in + let cst =Global.constant_of_delta_kn (KerName.make mp (Label.of_id id)) in let _ = Global.lookup_constant cst in ConstRef cst with Not_found -> diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 0fa573b9a6..ea222397a8 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -269,10 +269,6 @@ let allowed_sorts env (kn,i as ind) = let (mib,mip) = Inductive.lookup_mind_specif env ind in mip.mind_kelim -let projection_nparams_env _ p = Projection.npars p - -let projection_nparams p = Projection.npars p - let has_dependent_elim mib = match mib.mind_record with | PrimRecord _ -> mib.mind_finite == BiFinite diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli index ea34707bfc..b2e205115f 100644 --- a/pretyping/inductiveops.mli +++ b/pretyping/inductiveops.mli @@ -129,15 +129,9 @@ val allowed_sorts : env -> inductive -> Sorts.family list val has_dependent_elim : mutual_inductive_body -> bool (** Primitive projections *) -val projection_nparams : Projection.t -> int -[@@ocaml.deprecated "Use [Projection.npars]"] -val projection_nparams_env : env -> Projection.t -> int -[@@ocaml.deprecated "Use [Projection.npars]"] - val type_of_projection_knowing_arg : env -> evar_map -> Projection.t -> EConstr.t -> EConstr.types -> types - (** Extract information from an inductive family *) type constructor_summary = { @@ -152,8 +146,6 @@ val get_constructor : pinductive * mutual_inductive_body * one_inductive_body * constr list -> int -> constructor_summary val get_constructors : env -> inductive_family -> constructor_summary array -val get_projections : env -> inductive -> Projection.Repr.t array option -[@@ocaml.deprecated "Use [Environ.get_projections]"] (** [get_arity] returns the arity of the inductive family instantiated with the parameters; if recursively non-uniform parameters are not diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index c25416405e..3719f9302a 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -79,12 +79,7 @@ let subst_structure (subst,((kn,i),id,kl,projs as obj)) = if projs' == projs && kn' == kn && id' == id then obj else ((kn',i),id',kl,projs') -let discharge_constructor (ind, n) = - (Lib.discharge_inductive ind, n) - -let discharge_structure (_,(ind,id,kl,projs)) = - Some (Lib.discharge_inductive ind, discharge_constructor id, kl, - List.map (Option.map Lib.discharge_con) projs) +let discharge_structure (_,x) = Some x let inStruc : struc_tuple -> obj = declare_object {(default_object "STRUCTURE") with @@ -319,8 +314,7 @@ let subst_canonical_structure (subst,(cst,ind as obj)) = let ind' = subst_ind subst ind in if cst' == cst && ind' == ind then obj else (cst',ind') -let discharge_canonical_structure (_,(cst,ind)) = - Some (Lib.discharge_con cst,Lib.discharge_inductive ind) +let discharge_canonical_structure (_,x) = Some x let inCanonStruc : Constant.t * inductive -> obj = declare_object {(default_object "CANONICAL-STRUCTURE") with diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index e8c3b3e2b3..5dbe95a471 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -132,8 +132,7 @@ module ReductionBehaviour = struct { b with b_nargs = nargs'; b_recargs = recargs' } else b in - let c = Lib.discharge_con c in - Some (ReqGlobal (ConstRef c, req), (ConstRef c, b)) + Some (ReqGlobal (gr, req), (ConstRef c, b)) | _ -> None let rebuild = function @@ -713,8 +712,8 @@ let magicaly_constant_of_fixbody env sigma reference bd = function | Name.Name id -> let open UnivProblem in try - let (cst_mod,cst_sect,_) = Constant.repr3 reference in - let cst = Constant.make3 cst_mod cst_sect (Label.of_id id) in + let (cst_mod,_) = Constant.repr2 reference in + let cst = Constant.make2 cst_mod (Label.of_id id) in let (cst, u), ctx = UnivGen.fresh_constant_instance env cst in match constant_opt_value_in env (cst,u) with | None -> bd diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 67c5643459..7e5815acd1 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -222,26 +222,26 @@ let discharge_class (_,cl) = | Some (_, ((tc,_), _)) -> Some tc.cl_impl) ctx' in - List.Smart.map (Option.Smart.map Lib.discharge_global) grs - @ newgrs + grs @ newgrs in grs', discharge_rel_context subst 1 ctx @ ctx' in - let cl_impl' = Lib.discharge_global cl.cl_impl in - if cl_impl' == cl.cl_impl then cl else + try let info = abs_context cl in let ctx = info.Lib.abstr_ctx in let ctx, subst = rel_of_variable_context ctx in let usubst, cl_univs' = Lib.discharge_abstract_universe_context info cl.cl_univs in let context = discharge_context ctx (subst, usubst) cl.cl_context in let props = discharge_rel_context (subst, usubst) (succ (List.length (fst cl.cl_context))) cl.cl_props in - let discharge_proj (x, y, z) = x, y, Option.Smart.map Lib.discharge_con z in - { cl_univs = cl_univs'; - cl_impl = cl_impl'; - cl_context = context; - cl_props = props; - cl_projs = List.Smart.map discharge_proj cl.cl_projs; - cl_strict = cl.cl_strict; - cl_unique = cl.cl_unique - } + let discharge_proj x = x in + { cl_univs = cl_univs'; + cl_impl = cl.cl_impl; + cl_context = context; + cl_props = props; + cl_projs = List.Smart.map discharge_proj cl.cl_projs; + cl_strict = cl.cl_strict; + cl_unique = cl.cl_unique + } + with Not_found -> (* not defined in the current section *) + cl let rebuild_class cl = try @@ -365,8 +365,8 @@ let discharge_instance (_, (action, inst)) = Some (action, { inst with is_global = Some (pred n); - is_class = Lib.discharge_global inst.is_class; - is_impl = Lib.discharge_global inst.is_impl }) + is_class = inst.is_class; + is_impl = inst.is_impl }) let is_local i = (i.is_global == None) diff --git a/pretyping/typing.ml b/pretyping/typing.ml index 4ba715f0d5..dc3f042431 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -398,9 +398,6 @@ let check env sigma c t = error_actual_type_core env sigma j t | Some sigma -> sigma -let e_check env evdref c t = - evdref := check env !evdref c t - (* Type of a constr *) let unsafe_type_of env sigma c = @@ -416,9 +413,6 @@ let sort_of env sigma c = let sigma, a = type_judgment env sigma j in sigma, a.utj_type -let e_sort_of env evdref c = - Evarutil.evd_comb1 (sort_of env) evdref c - (* Try to solve the existential variables by typing *) let type_of ?(refresh=false) env sigma c = @@ -429,16 +423,10 @@ let type_of ?(refresh=false) env sigma c = Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma j.uj_type else sigma, j.uj_type -let e_type_of ?refresh env evdref c = - Evarutil.evd_comb1 (type_of ?refresh env) evdref c - let solve_evars env sigma c = let env = enrich_env env sigma in let sigma, j = execute env sigma c in (* side-effect on evdref *) sigma, nf_evar sigma j.uj_val -let e_solve_evars env evdref c = - Evarutil.evd_comb1 (solve_evars env) evdref c - let _ = Evarconv.set_solve_evars (fun env sigma c -> solve_evars env sigma c) diff --git a/pretyping/typing.mli b/pretyping/typing.mli index 3cf43ace01..b8830ff4a2 100644 --- a/pretyping/typing.mli +++ b/pretyping/typing.mli @@ -24,27 +24,17 @@ val unsafe_type_of : env -> evar_map -> constr -> types universes *) val type_of : ?refresh:bool -> env -> evar_map -> constr -> evar_map * types -(** Variant of [type_of] using references instead of state-passing. *) -val e_type_of : ?refresh:bool -> env -> evar_map ref -> constr -> types -[@@ocaml.deprecated "Use [Typing.type_of]"] - (** Typecheck a type and return its sort *) val sort_of : env -> evar_map -> types -> evar_map * Sorts.t -val e_sort_of : env -> evar_map ref -> types -> Sorts.t -[@@ocaml.deprecated "Use [Typing.sort_of]"] (** Typecheck a term has a given type (assuming the type is OK) *) val check : env -> evar_map -> constr -> types -> evar_map -val e_check : env -> evar_map ref -> constr -> types -> unit -[@@ocaml.deprecated "Use [Typing.check]"] (** Returns the instantiated type of a metavariable *) val meta_type : evar_map -> metavariable -> types (** Solve existential variables using typing *) val solve_evars : env -> evar_map -> constr -> evar_map * constr -val e_solve_evars : env -> evar_map ref -> constr -> constr -[@@ocaml.deprecated "Use [Typing.solve_evars]"] (** Raise an error message if incorrect elimination for this inductive *) (** (first constr is term to match, second is return predicate) *) diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index 90d2b7abaf..e7f995c84e 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -194,7 +194,6 @@ let tag_var = tag Tag.variable sl ++ id let pr_id = Id.print - let pr_name = Name.print let pr_qualid = pr_qualid let pr_patvar = pr_id diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli index bca419c9ac..e7f71849a5 100644 --- a/printing/ppconstr.mli +++ b/printing/ppconstr.mli @@ -34,8 +34,6 @@ val pr_sep_com : constr_expr -> Pp.t val pr_id : Id.t -> Pp.t -val pr_name : Name.t -> Pp.t -[@@ocaml.deprecated "alias of Names.Name.print"] val pr_qualid : qualid -> Pp.t val pr_patvar : Pattern.patvar -> Pp.t diff --git a/printing/prettyp.ml b/printing/prettyp.ml index 66f748454d..e6f82c60ee 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -617,10 +617,10 @@ let gallina_print_leaf_entry env sigma with_values ((sp,kn as oname),lobj) = | (_,"INDUCTIVE") -> Some (gallina_print_inductive (MutInd.make1 kn) None) | (_,"MODULE") -> - let (mp,_,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in Some (print_module with_values (MPdot (mp,l))) | (_,"MODULE TYPE") -> - let (mp,_,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in Some (print_modtype (MPdot (mp,l))) | (_,("AUTOHINT"|"GRAMMAR"|"SYNTAXCONSTANT"|"PPSYNTAX"|"TOKEN"|"CLASS"| "COERCION"|"REQUIRE"|"END-SECTION"|"STRUCTURE")) -> None @@ -734,12 +734,12 @@ let print_full_pure_context env sigma = str "." ++ fnl () ++ fnl () | "MODULE" -> (* TODO: make it reparsable *) - let (mp,_,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in print_module true (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl () | "MODULE TYPE" -> (* TODO: make it reparsable *) (* TODO: make it reparsable *) - let (mp,_,l) = KerName.repr kn in + let (mp,l) = KerName.repr kn in print_modtype (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl () | _ -> mt () in prec rest ++ pp diff --git a/printing/printer.ml b/printing/printer.ml index cfa3e8b6e9..990bdaad7d 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -17,7 +17,6 @@ open Environ open Globnames open Nametab open Evd -open Proof_type open Refiner open Constrextern open Ppconstr @@ -98,20 +97,6 @@ let pr_econstr_env env sigma c = pr_econstr_core false env sigma c let pr_open_lconstr_env env sigma (_,c) = pr_leconstr_env env sigma c let pr_open_constr_env env sigma (_,c) = pr_econstr_env env sigma c -(* NB do not remove the eta-redexes! Global.env() has side-effects... *) -let pr_lconstr t = - let (sigma, env) = Pfedit.get_current_context () in - pr_lconstr_env env sigma t -let pr_constr t = - let (sigma, env) = Pfedit.get_current_context () in - pr_constr_env env sigma t - -let pr_leconstr c = pr_lconstr (EConstr.Unsafe.to_constr c) -let pr_econstr c = pr_constr (EConstr.Unsafe.to_constr c) - -let pr_open_lconstr (_,c) = pr_leconstr c -let pr_open_constr (_,c) = pr_econstr c - let pr_constr_under_binders_env_gen pr env sigma (ids,c) = (* Warning: clashes can occur with variables of same name in env but *) (* we also need to preserve the actual names of the patterns *) @@ -122,13 +107,6 @@ let pr_constr_under_binders_env_gen pr env sigma (ids,c) = let pr_constr_under_binders_env = pr_constr_under_binders_env_gen pr_econstr_env let pr_lconstr_under_binders_env = pr_constr_under_binders_env_gen pr_leconstr_env -let pr_constr_under_binders c = - let (sigma, env) = Pfedit.get_current_context () in - pr_constr_under_binders_env env sigma c -let pr_lconstr_under_binders c = - let (sigma, env) = Pfedit.get_current_context () in - pr_lconstr_under_binders_env env sigma c - let pr_etype_core goal_concl_style env sigma t = pr_constr_expr (extern_type goal_concl_style env sigma t) let pr_letype_core = Proof_diffs.pr_letype_core @@ -136,13 +114,6 @@ let pr_letype_core = Proof_diffs.pr_letype_core let pr_ltype_env env sigma c = pr_letype_core false env sigma (EConstr.of_constr c) let pr_type_env env sigma c = pr_etype_core false env sigma (EConstr.of_constr c) -let pr_ltype t = - let (sigma, env) = Pfedit.get_current_context () in - pr_ltype_env env sigma t -let pr_type t = - let (sigma, env) = Pfedit.get_current_context () in - pr_type_env env sigma t - let pr_etype_env env sigma c = pr_etype_core false env sigma c let pr_letype_env env sigma c = pr_letype_core false env sigma c let pr_goal_concl_style_env env sigma c = pr_letype_core true env sigma c @@ -150,29 +121,15 @@ let pr_goal_concl_style_env env sigma c = pr_letype_core true env sigma c let pr_ljudge_env env sigma j = (pr_leconstr_env env sigma j.uj_val, pr_leconstr_env env sigma j.uj_type) -let pr_ljudge j = - let (sigma, env) = Pfedit.get_current_context () in - pr_ljudge_env env sigma j - let pr_lglob_constr_env env c = pr_lconstr_expr (extern_glob_constr (Termops.vars_of_env env) c) let pr_glob_constr_env env c = pr_constr_expr (extern_glob_constr (Termops.vars_of_env env) c) -let pr_lglob_constr c = - let (sigma, env) = Pfedit.get_current_context () in - pr_lglob_constr_env env c -let pr_glob_constr c = - let (sigma, env) = Pfedit.get_current_context () in - pr_glob_constr_env env c - let pr_closed_glob_n_env env sigma n c = pr_constr_expr_n n (extern_closed_glob false env sigma c) let pr_closed_glob_env env sigma c = pr_constr_expr (extern_closed_glob false env sigma c) -let pr_closed_glob c = - let (sigma, env) = Pfedit.get_current_context () in - pr_closed_glob_env env sigma c let pr_lconstr_pattern_env env sigma c = pr_lconstr_pattern_expr (extern_constr_pattern (Termops.names_of_rel_context env) sigma c) @@ -182,13 +139,6 @@ let pr_constr_pattern_env env sigma c = let pr_cases_pattern t = pr_cases_pattern_expr (extern_cases_pattern Names.Id.Set.empty t) -let pr_lconstr_pattern t = - let (sigma, env) = Pfedit.get_current_context () in - pr_lconstr_pattern_env env sigma t -let pr_constr_pattern t = - let (sigma, env) = Pfedit.get_current_context () in - pr_constr_pattern_env env sigma t - let pr_sort sigma s = pr_glob_sort (extern_sort sigma s) let _ = Termops.Internal.set_print_constr @@ -247,13 +197,6 @@ let safe_gen f env sigma c = let safe_pr_lconstr_env = safe_gen pr_lconstr_env let safe_pr_constr_env = safe_gen pr_constr_env -let safe_pr_lconstr t = - let (sigma, env) = Pfedit.get_current_context () in - safe_pr_lconstr_env env sigma t - -let safe_pr_constr t = - let (sigma, env) = Pfedit.get_current_context () in - safe_pr_constr_env env sigma t let pr_universe_ctx_set sigma c = if !Detyping.print_universes && not (Univ.ContextSet.is_empty c) then @@ -889,19 +832,6 @@ let pr_goal_by_id ~proof id = pr_selected_subgoal (pr_id id) sigma g) with Not_found -> user_err Pp.(str "No such goal.") -(* Elementary tactics *) - -let pr_prim_rule = function - | Refine c -> - (** FIXME *) - str(if Termops.occur_meta Evd.empty (EConstr.of_constr c) then "refine " else "exact ") ++ - Constrextern.with_meta_as_hole pr_constr c - -(* Backwards compatibility *) - -let prterm = pr_lconstr - - (* Printer function for sets of Assumptions.assumptions. It is used primarily by the Print Assumptions command. *) @@ -959,7 +889,7 @@ let pr_assumptionset env sigma s = try pr_constant env kn with Not_found -> (* FIXME? *) - let mp,_,lab = Constant.repr3 kn in + let mp,lab = Constant.repr2 kn in str (ModPath.to_string mp) ++ str "." ++ Label.print lab in let safe_pr_inductive env kn = diff --git a/printing/printer.mli b/printing/printer.mli index 96db7091a6..f9d1a62895 100644 --- a/printing/printer.mli +++ b/printing/printer.mli @@ -27,13 +27,9 @@ val enable_goal_names_printing : bool ref (** Terms *) val pr_lconstr_env : env -> evar_map -> constr -> Pp.t -val pr_lconstr : constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_lconstr_goal_style_env : env -> evar_map -> constr -> Pp.t val pr_constr_env : env -> evar_map -> constr -> Pp.t -val pr_constr : constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_constr_goal_style_env : env -> evar_map -> constr -> Pp.t val pr_constr_n_env : env -> evar_map -> Notation_gram.tolerability -> constr -> Pp.t @@ -43,19 +39,11 @@ val pr_constr_n_env : env -> evar_map -> Notation_gram.tolerability -> co in case of remaining issues (such as reference not in env). *) val safe_pr_lconstr_env : env -> evar_map -> constr -> Pp.t -val safe_pr_lconstr : constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val safe_pr_constr_env : env -> evar_map -> constr -> Pp.t -val safe_pr_constr : constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_econstr_env : env -> evar_map -> EConstr.t -> Pp.t -val pr_econstr : EConstr.t -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_leconstr_env : env -> evar_map -> EConstr.t -> Pp.t -val pr_leconstr : EConstr.t -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_econstr_n_env : env -> evar_map -> Notation_gram.tolerability -> EConstr.t -> Pp.t @@ -63,54 +51,30 @@ val pr_etype_env : env -> evar_map -> EConstr.types -> Pp.t val pr_letype_env : env -> evar_map -> EConstr.types -> Pp.t val pr_open_constr_env : env -> evar_map -> open_constr -> Pp.t -val pr_open_constr : open_constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_open_lconstr_env : env -> evar_map -> open_constr -> Pp.t -val pr_open_lconstr : open_constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_constr_under_binders_env : env -> evar_map -> constr_under_binders -> Pp.t -val pr_constr_under_binders : constr_under_binders -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_lconstr_under_binders_env : env -> evar_map -> constr_under_binders -> Pp.t -val pr_lconstr_under_binders : constr_under_binders -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_goal_concl_style_env : env -> evar_map -> EConstr.types -> Pp.t val pr_ltype_env : env -> evar_map -> types -> Pp.t -val pr_ltype : types -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_type_env : env -> evar_map -> types -> Pp.t -val pr_type : types -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_closed_glob_n_env : env -> evar_map -> Notation_gram.tolerability -> closed_glob_constr -> Pp.t val pr_closed_glob_env : env -> evar_map -> closed_glob_constr -> Pp.t -val pr_closed_glob : closed_glob_constr -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_ljudge_env : env -> evar_map -> EConstr.unsafe_judgment -> Pp.t * Pp.t -val pr_ljudge : EConstr.unsafe_judgment -> Pp.t * Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_lglob_constr_env : env -> 'a glob_constr_g -> Pp.t -val pr_lglob_constr : 'a glob_constr_g -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_glob_constr_env : env -> 'a glob_constr_g -> Pp.t -val pr_glob_constr : 'a glob_constr_g -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_lconstr_pattern_env : env -> evar_map -> constr_pattern -> Pp.t -val pr_lconstr_pattern : constr_pattern -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_constr_pattern_env : env -> evar_map -> constr_pattern -> Pp.t -val pr_constr_pattern : constr_pattern -> Pp.t -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] val pr_cases_pattern : cases_pattern -> Pp.t @@ -222,16 +186,8 @@ val pr_evars : evar_map -> evar_info Evar.Map.t -> Pp.t val pr_ne_evar_set : Pp.t -> Pp.t -> evar_map -> Evar.Set.t -> Pp.t -val pr_prim_rule : prim_rule -> Pp.t -[@@ocaml.deprecated "[pr_prim_rule] is scheduled to be removed along with the legacy proof engine"] - val print_and_diff : Proof.t option -> Proof.t option -> unit -(** Backwards compatibility *) - -val prterm : constr -> Pp.t (** = pr_lconstr *) -[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"] - (** Declarations for the "Print Assumption" command *) type axiom = | Constant of Constant.t (* An axiom or a constant. *) diff --git a/proofs/proof.ml b/proofs/proof.ml index 8bbd82bb0a..70a08e4966 100644 --- a/proofs/proof.ml +++ b/proofs/proof.ml @@ -122,8 +122,6 @@ type t = { initial_euctx : UState.t } -type proof = t - (*** General proof functions ***) let proof p = @@ -435,9 +433,6 @@ let pr_proof p = (*** Compatibility layer with <=v8.2 ***) module V82 = struct - let subgoals p = - let it, sigma = Proofview.proofview p.proofview in - Evd.{ it; sigma } let background_subgoals p = let it, sigma = Proofview.proofview (unroll_focus p.proofview p.focus_stack) in diff --git a/proofs/proof.mli b/proofs/proof.mli index 511dcc2e00..8cf543557b 100644 --- a/proofs/proof.mli +++ b/proofs/proof.mli @@ -33,8 +33,6 @@ (* Type of a proof. *) type t -type proof = t -[@@ocaml.deprecated "please use [Proof.t]"] (* Returns a stylised view of a proof for use by, for instance, ide-s. *) @@ -192,8 +190,6 @@ val pr_proof : t -> Pp.t (*** Compatibility layer with <=v8.2 ***) module V82 : sig - val subgoals : t -> Goal.goal list Evd.sigma - [@@ocaml.deprecated "Use the first and fifth argument of [Proof.proof]"] (* All the subgoals of the proof, including those which are not focused. *) val background_subgoals : t -> Goal.goal list Evd.sigma diff --git a/proofs/proof_bullet.ml b/proofs/proof_bullet.ml index cc3e79f858..ed8df29d7b 100644 --- a/proofs/proof_bullet.ml +++ b/proofs/proof_bullet.ml @@ -197,6 +197,3 @@ let put p b = let suggest p = (!current_behavior).suggest p - -let pr_goal_selector = Goal_select.pr_goal_selector -let get_default_goal_selector = Goal_select.get_default_goal_selector diff --git a/proofs/proof_bullet.mli b/proofs/proof_bullet.mli index a09a7ec1d2..0fcc647a6f 100644 --- a/proofs/proof_bullet.mli +++ b/proofs/proof_bullet.mli @@ -44,9 +44,3 @@ val register_behavior : behavior -> unit *) val put : Proof.t -> t -> Proof.t val suggest : Proof.t -> Pp.t - -(** Deprecated *) -val pr_goal_selector : Goal_select.t -> Pp.t -[@@ocaml.deprecated "Please use [Goal_select.pr_goal_selector]"] -val get_default_goal_selector : unit -> Goal_select.t -[@@ocaml.deprecated "Please use [Goal_select.get_default_goal_selector]"] diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml index 7e250faa86..de151fb6e5 100644 --- a/proofs/proof_global.ml +++ b/proofs/proof_global.ml @@ -101,7 +101,6 @@ type pstate = { } type t = pstate list -type state = t let make_terminator f = f let apply_terminator f = f diff --git a/proofs/proof_global.mli b/proofs/proof_global.mli index 854ceaa41a..2b04bfab57 100644 --- a/proofs/proof_global.mli +++ b/proofs/proof_global.mli @@ -13,8 +13,6 @@ environment. *) type t -type state = t -[@@ocaml.deprecated "please use [Proof_global.t]"] val there_are_pending_proofs : unit -> bool val check_no_pending_proof : unit -> unit diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml index 44685d2bbd..56ce744bc1 100644 --- a/proofs/redexpr.ml +++ b/proofs/redexpr.ml @@ -15,7 +15,6 @@ open Names open Constr open EConstr open Declarations -open Globnames open Genredexpr open Pattern open Reductionops @@ -79,7 +78,7 @@ let set_strategy_one ref l = | OpaqueDef _ -> user_err ~hdr:"set_transparent_const" (str "Cannot make" ++ spc () ++ - Nametab.pr_global_env Id.Set.empty (ConstRef sp) ++ + Nametab.pr_global_env Id.Set.empty (GlobRef.ConstRef sp) ++ spc () ++ str "transparent because it was declared opaque."); | _ -> Csymtable.set_transparent_const sp) | _ -> () @@ -114,10 +113,8 @@ let classify_strategy (local,_ as obj) = let disch_ref ref = match ref with - EvalConstRef c -> - let c' = Lib.discharge_con c in - if c==c' then Some ref else Some (EvalConstRef c') - | EvalVarRef id -> if Lib.is_in_section (VarRef id) then None else Some ref + EvalConstRef c -> Some ref + | EvalVarRef id -> if Lib.is_in_section (GlobRef.VarRef id) then None else Some ref let discharge_strategy (_,(local,obj)) = if local then None else diff --git a/proofs/refiner.mli b/proofs/refiner.mli index 0f83e16ec8..30af6d8e1a 100644 --- a/proofs/refiner.mli +++ b/proofs/refiner.mli @@ -22,14 +22,6 @@ val project : 'a sigma -> evar_map val pf_env : goal sigma -> Environ.env val pf_hyps : goal sigma -> named_context -val unpackage : 'a sigma -> evar_map ref * 'a -[@@ocaml.deprecated "Do not use [evar_map ref]"] -val repackage : evar_map ref -> 'a -> 'a sigma -[@@ocaml.deprecated "Do not use [evar_map ref]"] -val apply_sig_tac : - evar_map ref -> (goal sigma -> goal list sigma) -> goal -> goal list -[@@ocaml.deprecated "Do not use [evar_map ref]"] - val refiner : rule -> tactic (** {6 Tacticals. } *) diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml index 9e42a71ea8..5d1faf1465 100644 --- a/proofs/tacmach.ml +++ b/proofs/tacmach.ml @@ -30,14 +30,7 @@ let re_sig it gc = { it = it; sigma = gc; } (* Operations for handling terms under a local typing context *) (**************************************************************) -type 'a sigma = 'a Evd.sigma;; -type tactic = Proof_type.tactic;; - -[@@@ocaml.warning "-3"] -let unpackage = Refiner.unpackage -let repackage = Refiner.repackage -let apply_sig_tac = Refiner.apply_sig_tac -[@@@ocaml.warning "+3"] +type tactic = Proof_type.tactic let sig_it = Refiner.sig_it let project = Refiner.project diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli index b4cb2be2b8..3432ad4afa 100644 --- a/proofs/tacmach.mli +++ b/proofs/tacmach.mli @@ -18,9 +18,6 @@ open Locus (** Operations for handling terms under a local typing context. *) -type 'a sigma = 'a Evd.sigma -[@@ocaml.deprecated "alias of Evd.sigma"] - open Evd type tactic = Proof_type.tactic;; @@ -29,14 +26,6 @@ val project : goal sigma -> evar_map val re_sig : 'a -> evar_map -> 'a sigma -val unpackage : 'a sigma -> evar_map ref * 'a -[@@ocaml.deprecated "Do not use [evar_map ref]"] -val repackage : evar_map ref -> 'a -> 'a sigma -[@@ocaml.deprecated "Do not use [evar_map ref]"] -val apply_sig_tac : - evar_map ref -> (goal sigma -> (goal list) sigma) -> goal -> (goal list) -[@@ocaml.deprecated "Do not use [evar_map ref]"] - val pf_concl : goal sigma -> types val pf_env : goal sigma -> env val pf_hyps : goal sigma -> named_context diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml index 768d94d305..94e04d1842 100644 --- a/stm/asyncTaskQueue.ml +++ b/stm/asyncTaskQueue.ml @@ -325,7 +325,7 @@ module Make(T : Task) () = struct let response = slave_respond request in report_status "Idle"; marshal_response (Option.get !slave_oc) response; - CEphemeron.clear () + CEphemeron.clean () with | MarshalError s -> stm_pr_err Pp.(prlist str ["Fatal marshal error: "; s]); flush_all (); exit 2 diff --git a/tactics/equality.ml b/tactics/equality.ml index d0f4b2c680..510f119229 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -356,9 +356,9 @@ let find_elim hdcncl lft2rgt dep cls ot = | Some true, None | Some false, Some _ -> let c1 = destConstRef pr1 in - let mp,dp,l = Constant.repr3 (Constant.make1 (Constant.canonical c1)) in + let mp,l = Constant.repr2 (Constant.make1 (Constant.canonical c1)) in let l' = Label.of_id (add_suffix (Label.to_id l) "_r") in - let c1' = Global.constant_of_delta_kn (KerName.make mp dp l') in + let c1' = Global.constant_of_delta_kn (KerName.make mp l') in begin try let _ = Global.lookup_constant c1' in diff --git a/tactics/hints.ml b/tactics/hints.ml index c0ba363360..af6d1c472f 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -209,14 +209,14 @@ let fresh_key = let cur = incr id; !id in let lbl = Id.of_string ("_" ^ string_of_int cur) in let kn = Lib.make_kn lbl in - let (mp, dir, _) = KerName.repr kn in + let (mp, _) = KerName.repr kn in (** We embed the full path of the kernel name in the label so that the identifier should be unique. This ensures that including two modules together won't confuse the corresponding labels. *) - let lbl = Id.of_string_soft (Printf.sprintf "%s#%s#%i" - (ModPath.to_string mp) (DirPath.to_string dir) cur) + let lbl = Id.of_string_soft (Printf.sprintf "%s#%i" + (ModPath.to_string mp) cur) in - KerName.make mp dir (Label.of_id lbl) + KerName.make mp (Label.of_id lbl) let pri_order_int (id1, {pri=pri1}) (id2, {pri=pri2}) = let d = pri1 - pri2 in @@ -1552,11 +1552,6 @@ let pr_hint_db_env env sigma db = hov 2 (str"Cut: " ++ pp_hints_path (Hint_db.cut db)) ++ fnl () ++ content -(* Deprecated in the mli *) -let pr_hint_db db = - let sigma, env = Pfedit.get_current_context () in - pr_hint_db_env env sigma db - let pr_hint_db_by_name env sigma dbname = try let db = searchtable_map dbname in pr_hint_db_env env sigma db @@ -1601,7 +1596,7 @@ let warn_non_imported_hint = let warn env sigma h = let hint = pr_hint env sigma h in - let (mp, _, _) = KerName.repr h.uid in + let mp = KerName.modpath h.uid in warn_non_imported_hint (hint,mp) let wrap_hint_warning t = diff --git a/tactics/hints.mli b/tactics/hints.mli index d63efea27d..6db8feccd0 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -298,9 +298,4 @@ val pr_applicable_hint : unit -> Pp.t val pr_hint_ref : env -> evar_map -> GlobRef.t -> Pp.t val pr_hint_db_by_name : env -> evar_map -> hint_db_name -> Pp.t val pr_hint_db_env : env -> evar_map -> Hint_db.t -> Pp.t -val pr_hint_db : Hint_db.t -> Pp.t -[@@ocaml.deprecated "please used pr_hint_db_env"] val pr_hint : env -> evar_map -> hint -> Pp.t - -type nonrec hint_info = hint_info -[@@ocaml.deprecated "Use [Typeclasses.hint_info]"] diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml index 7da059ae35..a1bb0a7401 100644 --- a/tactics/hipattern.ml +++ b/tactics/hipattern.ml @@ -438,7 +438,7 @@ let match_eq sigma eqn (ref, hetero) = | _ -> raise PatternMatchingFailure let no_check () = true -let check_jmeq_loaded () = Library.library_is_loaded Coqlib.jmeq_module +let check_jmeq_loaded () = Library.library_is_loaded @@ Coqlib.jmeq_library_path let equalities = [(coq_eq_ref, false), no_check, build_coq_eq_data; diff --git a/tactics/ind_tables.ml b/tactics/ind_tables.ml index e4013152e6..b81967c781 100644 --- a/tactics/ind_tables.ml +++ b/tactics/ind_tables.ml @@ -56,8 +56,7 @@ let subst_scheme (subst,(kind,l)) = (kind,Array.Smart.map (subst_one_scheme subst) l) let discharge_scheme (_,(kind,l)) = - Some (kind,Array.map (fun (ind,const) -> - (Lib.discharge_inductive ind,Lib.discharge_con const)) l) + Some (kind, l) let inScheme : string * (inductive * Constant.t) array -> obj = declare_object {(default_object "SCHEME") with diff --git a/tactics/inv.ml b/tactics/inv.ml index f718b13a63..5ac4284b43 100644 --- a/tactics/inv.ml +++ b/tactics/inv.ml @@ -70,6 +70,11 @@ type inversion_kind = | FullInversion | FullInversionClear +let evd_comb1 f evdref x = + let (evd',y) = f !evdref x in + evdref := evd'; + y + let compute_eqn env sigma n i ai = (mkRel (n-i),get_type_of env sigma (mkRel (n-i))) @@ -94,7 +99,7 @@ let make_inv_predicate env evd indf realargs id status concl = | Some concl -> concl (*assumed it's some [x1..xn,H:I(x1..xn)]C*) | None -> let sort = get_sort_family_of env !evd concl in - let sort = Evarutil.evd_comb1 Evd.fresh_sort_in_family evd sort in + let sort = evd_comb1 Evd.fresh_sort_in_family evd sort in let p = make_arity env !evd true indf sort in let evd',(p,ptyp) = Unification.abstract_list_all env !evd p concl (realargs@[mkVar id]) @@ -124,19 +129,19 @@ let make_inv_predicate env evd indf realargs id status concl = evd := sigma; res in let eq_term = eqdata.Coqlib.eq in - let eq = Evarutil.evd_comb1 (Evd.fresh_global env) evd eq_term in + let eq = evd_comb1 (Evd.fresh_global env) evd eq_term in let eqn = applist (eq,[eqnty;lhs;rhs]) in let eqns = (Anonymous, lift n eqn) :: eqns in let refl_term = eqdata.Coqlib.refl in - let refl_term = Evarutil.evd_comb1 (Evd.fresh_global env) evd refl_term in + let refl_term = evd_comb1 (Evd.fresh_global env) evd refl_term in let refl = mkApp (refl_term, [|eqnty; rhs|]) in - let _ = Evarutil.evd_comb1 (Typing.type_of env) evd refl in + let _ = evd_comb1 (Typing.type_of env) evd refl in let args = refl :: args in build_concl eqns args (succ n) restlist in let (newconcl, args) = build_concl [] [] 0 realargs in let predicate = it_mkLambda_or_LetIn newconcl (name_context env !evd hyps) in - let _ = Evarutil.evd_comb1 (Typing.type_of env) evd predicate in + let _ = evd_comb1 (Typing.type_of env) evd predicate in (* OK - this predicate should now be usable by res_elimination_then to do elimination on the conclusion. *) predicate, args diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml index 596feeec8b..f2cf915fe3 100644 --- a/tactics/tacticals.ml +++ b/tactics/tacticals.ml @@ -60,10 +60,6 @@ let tclIFTHENSELSE = Refiner.tclIFTHENSELSE let tclIFTHENSVELSE = Refiner.tclIFTHENSVELSE let tclIFTHENTRYELSEMUST = Refiner.tclIFTHENTRYELSEMUST -(* Synonyms *) - -let tclTHENSEQ = tclTHENLIST - (************************************************************************) (* Tacticals applying on hypotheses *) (************************************************************************) diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli index 1e66c2b0b1..cc15469d0e 100644 --- a/tactics/tacticals.mli +++ b/tactics/tacticals.mli @@ -23,8 +23,6 @@ val tclIDTAC_MESSAGE : Pp.t -> tactic val tclORELSE0 : tactic -> tactic -> tactic val tclORELSE : tactic -> tactic -> tactic val tclTHEN : tactic -> tactic -> tactic -val tclTHENSEQ : tactic list -> tactic -[@@ocaml.deprecated "alias of Tacticals.tclTHENLIST"] val tclTHENLIST : tactic list -> tactic val tclTHEN_i : tactic -> (int -> tactic) -> tactic val tclTHENFIRST : tactic -> tactic -> tactic diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 6999b17d8e..f3f81ff616 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -791,9 +791,9 @@ let e_change_in_hyp redfun (id,where) = (convert_hyp c) end -type change_arg = Ltac_pretype.patvar_map -> evar_map -> evar_map * EConstr.constr +type change_arg = Ltac_pretype.patvar_map -> env -> evar_map -> evar_map * EConstr.constr -let make_change_arg c pats sigma = (sigma, replace_vars (Id.Map.bindings pats) c) +let make_change_arg c pats env sigma = (sigma, replace_vars (Id.Map.bindings pats) c) let check_types env sigma mayneedglobalcheck deep newc origc = let t1 = Retyping.get_type_of env sigma newc in @@ -818,7 +818,7 @@ let check_types env sigma mayneedglobalcheck deep newc origc = (* Now we introduce different instances of the previous tacticals *) let change_and_check cv_pb mayneedglobalcheck deep t env sigma c = - let (sigma, t') = t sigma in + let (sigma, t') = t env sigma in let sigma = check_types env sigma mayneedglobalcheck deep t' c in match infer_conv ~pb:cv_pb env sigma t' c with | None -> user_err ~hdr:"convert-check-hyp" (str "Not convertible."); diff --git a/tactics/tactics.mli b/tactics/tactics.mli index c088e404b0..24c12ffd82 100644 --- a/tactics/tactics.mli +++ b/tactics/tactics.mli @@ -145,7 +145,7 @@ val exact_proof : Constrexpr.constr_expr -> unit Proofview.tactic type tactic_reduction = Reductionops.reduction_function type e_tactic_reduction = Reductionops.e_reduction_function -type change_arg = patvar_map -> evar_map -> evar_map * constr +type change_arg = patvar_map -> env -> evar_map -> evar_map * constr val make_change_arg : constr -> change_arg val reduct_in_hyp : ?check:bool -> tactic_reduction -> hyp_location -> unit Proofview.tactic diff --git a/test-suite/Makefile b/test-suite/Makefile index bde0bfc91f..e35393b5e8 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -60,7 +60,6 @@ SINGLE_QUOTE=" # wrap the arguments in parens, but only if they exist get_coq_prog_args_in_parens = $(subst $(SINGLE_QUOTE),,$(if $(call get_coq_prog_args,$(1)), ($(call get_coq_prog_args,$(1))))) # get the command to use with this set of arguments; if there's -compile, use coqc, else use coqtop -has_compile_flag = $(filter "-compile",$(call get_coq_prog_args,$(1))) has_profile_ltac_or_compile_flag = $(filter "-profile-ltac-cutoff" "-profile-ltac" "-compile",$(call get_coq_prog_args,$(1))) get_command_based_on_flags = $(if $(call has_profile_ltac_or_compile_flag,$(1)),$(coqtopcompile),$(coqtopload)) @@ -308,7 +307,7 @@ ssr: $(wildcard ssr/*.v:%.v=%.v.log) $(addsuffix .log,$(wildcard ssr/*.v success/*.v micromega/*.v modules/*.v)): %.v.log: %.v $(PREREQUISITELOG) @echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")" $(HIDE){ \ - opts="$(if $(findstring modules/,$<),-R modules Mods -impredicative-set)"; \ + opts="$(if $(findstring modules/,$<),-R modules Mods)"; \ echo $(call log_intro,$<); \ $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") $$opts 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ diff --git a/test-suite/bugs/5996.v b/test-suite/bugs/bug_5996.v index c9e3292b48..c9e3292b48 100644 --- a/test-suite/bugs/5996.v +++ b/test-suite/bugs/bug_5996.v diff --git a/test-suite/bugs/closed/1243.v b/test-suite/bugs/closed/1243.v deleted file mode 100644 index 7d6781db27..0000000000 --- a/test-suite/bugs/closed/1243.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import ZArith. -Require Import Arith. -Open Scope Z_scope. - -Theorem r_ex : (forall x y:nat, x + y = x + y)%nat. -Admitted. - -Theorem r_ex' : forall x y:nat, (x + y = x + y)%nat. -Admitted. - - - diff --git a/test-suite/bugs/closed/1302.v b/test-suite/bugs/closed/1302.v deleted file mode 100644 index e94dfcfb05..0000000000 --- a/test-suite/bugs/closed/1302.v +++ /dev/null @@ -1,22 +0,0 @@ -Module Type T. - -Parameter A : Type. - -Inductive L : Type := -| L0 : L (* without this constructor, it works right *) -| L1 : A -> L. - -End T. - -Axiom Tp : Type. - -Module TT : T. - -Definition A : Type := Tp. - -Inductive L : Type := -| L0 : L -| L1 : A -> L. - -End TT. - diff --git a/test-suite/bugs/closed/1341.v b/test-suite/bugs/closed/1341.v deleted file mode 100644 index 79a0a14d7c..0000000000 --- a/test-suite/bugs/closed/1341.v +++ /dev/null @@ -1,17 +0,0 @@ -Require Import Setoid. - -Section Setoid_Bug. - -Variable X:Type -> Type. -Variable Xeq : forall A, (X A) -> (X A) -> Prop. -Hypothesis Xst : forall A, Equivalence (Xeq A). - -Variable map : forall A B, (A -> B) -> X A -> X B. - -Arguments map [A B]. - -Goal forall A B (a b:X (B -> A)) (c:X A) (f:A -> B -> A), Xeq _ a b -> Xeq _ b (map f c) -> Xeq _ a (map f c). -intros A B a b c f Hab Hbc. -rewrite Hab. -assumption. -Qed. diff --git a/test-suite/bugs/closed/1411.v b/test-suite/bugs/closed/1411.v deleted file mode 100644 index a1a7b288a5..0000000000 --- a/test-suite/bugs/closed/1411.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import List. -Require Import Program. - -Inductive Tree : Set := -| Br : Tree -> Tree -> Tree -| No : nat -> Tree -. - -(* given a tree, we want to know which lists can - be used to navigate exactly to a node *) -Inductive Exact : Tree -> list bool -> Prop := -| exDone n : Exact (No n) nil -| exLeft l r p: Exact l p -> Exact (Br l r) (true::p) -| exRight l r p: Exact r p -> Exact (Br l r) (false::p) -. - -Definition unreachable A : False -> A. -intros. -destruct H. -Defined. - -Program Fixpoint fetch t p (x:Exact t p) {struct t} := - match t, p with - | No p' , nil => p' - | No p' , _::_ => unreachable nat _ - | Br l r, nil => unreachable nat _ - | Br l r, true::t => fetch l t _ - | Br l r, false::t => fetch r t _ - end. - -Next Obligation. inversion x. Qed. -Next Obligation. inversion x. Qed. -Next Obligation. inversion x; trivial. Qed. -Next Obligation. inversion x; trivial. Qed. - diff --git a/test-suite/bugs/closed/1414.v b/test-suite/bugs/closed/1414.v deleted file mode 100644 index ee9e2504a6..0000000000 --- a/test-suite/bugs/closed/1414.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import ZArith Coq.Program.Wf Coq.Program.Utils. - -Parameter data:Set. - -Inductive t : Set := - | Leaf : t - | Node : t -> data -> t -> Z -> t. - -Parameter avl : t -> Prop. -Parameter bst : t -> Prop. -Parameter In : data -> t -> Prop. -Parameter cardinal : t -> nat. -Definition card2 (s:t*t) := let (s1,s2) := s in cardinal s1 + cardinal s2. - -Parameter split : data -> t -> t*(bool*t). -Parameter join : t -> data -> t -> t. -Parameter add : data -> t -> t. - -Program Fixpoint union - (s u:t) - (hb1: bst s)(ha1: avl s)(hb2: bst u)(hb2: avl u) - { measure (cardinal s + cardinal u) } : - {s' : t | bst s' /\ avl s' /\ forall x, In x s' <-> In x s \/ In x u} := - match s, u with - | Leaf,t2 => t2 - | t1,Leaf => t1 - | Node l1 v1 r1 h1, Node l2 v2 r2 h2 => - if (Z_ge_lt_dec h1 h2) then - if (Z.eq_dec h2 1) - then add v2 s - else - let (l2', r2') := split v1 u in - join (union l1 l2' _ _ _ _) v1 (union r1 (snd r2') _ _ _ _) - else - if (Z.eq_dec h1 1) - then add v1 s - else - let (l1', r1') := split v2 u in - join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _) - end. diff --git a/test-suite/bugs/closed/1416.v b/test-suite/bugs/closed/1416.v deleted file mode 100644 index ee09200573..0000000000 --- a/test-suite/bugs/closed/1416.v +++ /dev/null @@ -1,30 +0,0 @@ -(* In 8.1 autorewrite used to raised an anomaly here *) -(* After resolution of the bug, autorewrite succeeded *) -(* From forthcoming 8.4, autorewrite is forbidden to instantiate *) -(* evars, so the new test just checks it is not an anomaly *) - -Set Implicit Arguments. - -Record Place (Env A: Type) : Type := { - read: Env -> A ; - write: Env -> A -> Env ; - write_read: forall (e:Env), (write e (read e))=e -}. - -Hint Rewrite -> write_read: placeeq. - -Record sumPl (Env A B: Type) (vL:(Place Env A)) (vR:(Place Env B)) : Type := - { - mkEnv: A -> B -> Env ; - mkEnv2writeL: forall (e:Env) (x:A), (mkEnv x (read vR e))=(write vL e x) - }. - -(* when the following line is commented, the bug does not appear *) -Hint Rewrite -> mkEnv2writeL: placeeq. - -Lemma autorewrite_raise_anomaly: forall (Env A:Type) (e: Env) (p:Place Env A), - (exists e1:Env, e=(write p e1 (read p e))). -Proof. - intros Env A e p; eapply ex_intro. - autorewrite with placeeq. (* Here is the bug *) - diff --git a/test-suite/bugs/closed/1483.v b/test-suite/bugs/closed/1483.v deleted file mode 100644 index a3d7f16830..0000000000 --- a/test-suite/bugs/closed/1483.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import BinPos. - -Definition P := (fun x : positive => x = xH). - -Goal forall (p q : positive), P q -> q = p -> P p. -intros; congruence. -Qed. - - - diff --git a/test-suite/bugs/closed/1501.v b/test-suite/bugs/closed/1501.v deleted file mode 100644 index e771e192dc..0000000000 --- a/test-suite/bugs/closed/1501.v +++ /dev/null @@ -1,67 +0,0 @@ -Set Implicit Arguments. - - -Require Export Relation_Definitions. -Require Export Setoid. -Require Import Morphisms. - - -Section Essais. - -(* Parametrized Setoid *) -Parameter K : Type -> Type. -Parameter equiv : forall A : Type, K A -> K A -> Prop. -Parameter equiv_refl : forall (A : Type) (x : K A), equiv x x. -Parameter equiv_sym : forall (A : Type) (x y : K A), equiv x y -> equiv y x. -Parameter equiv_trans : forall (A : Type) (x y z : K A), equiv x y -> equiv y z --> equiv x z. - -(* basic operations *) -Parameter val : forall A : Type, A -> K A. -Parameter bind : forall A B : Type, K A -> (A -> K B) -> K B. - -Parameter - bind_compat : - forall (A B : Type) (m1 m2 : K A) (f1 f2 : A -> K B), - equiv m1 m2 -> - (forall x : A, equiv (f1 x) (f2 x)) -> equiv (bind m1 f1) (bind m2 f2). - -(* monad axioms *) -Parameter - bind_val_l : - forall (A B : Type) (a : A) (f : A -> K B), equiv (bind (val a) f) (f a). -Parameter - bind_val_r : - forall (A : Type) (m : K A), equiv (bind m (fun a => val a)) m. -Parameter - bind_assoc : - forall (A B C : Type) (m : K A) (f : A -> K B) (g : B -> K C), - equiv (bind (bind m f) g) (bind m (fun a => bind (f a) g)). - - -Hint Resolve equiv_refl equiv_sym equiv_trans: monad. - -Add Parametric Relation A : (K A) (@equiv A) - reflexivity proved by (@equiv_refl A) - symmetry proved by (@equiv_sym A) - transitivity proved by (@equiv_trans A) - as equiv_rel. - -Add Parametric Morphism A B : (@bind A B) - with signature (@equiv A) ==> (pointwise_relation A (@equiv B)) ==> (@equiv B) - as bind_mor. -Proof. - unfold pointwise_relation; intros; apply bind_compat; auto. -Qed. - -Lemma test: - forall (A B: Type) (m1 m2 m3: K A) (f: A -> A -> K B), - (equiv m1 m2) -> (equiv m2 m3) -> - equiv (bind m1 (fun a => bind m2 (fun a' => f a a'))) - (bind m2 (fun a => bind m3 (fun a' => f a a'))). -Proof. - intros A B m1 m2 m3 f H1 H2. - setoid_rewrite H1. (* this works *) - setoid_rewrite H2. - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/1507.v b/test-suite/bugs/closed/1507.v deleted file mode 100644 index f2ab910034..0000000000 --- a/test-suite/bugs/closed/1507.v +++ /dev/null @@ -1,120 +0,0 @@ -(* - Implementing reals a la Stolzenberg - - Danko Ilik, March 2007 - - XField.v -- (unfinished) axiomatisation of the theories of real and - rational intervals. -*) - -Definition associative (A:Type)(op:A->A->A) := - forall x y z:A, op (op x y) z = op x (op y z). - -Definition commutative (A:Type)(op:A->A->A) := - forall x y:A, op x y = op y x. - -Definition trichotomous (A:Type)(R:A->A->Prop) := - forall x y:A, R x y \/ x=y \/ R y x. - -Definition relation (A:Type) := A -> A -> Prop. -Definition reflexive (A:Type)(R:relation A) := forall x:A, R x x. -Definition transitive (A:Type)(R:relation A) := - forall x y z:A, R x y -> R y z -> R x z. -Definition symmetric (A:Type)(R:relation A) := forall x y:A, R x y -> R y x. - -Record interval (X:Set)(le:X->X->Prop) : Set := - interval_make { - interval_left : X; - interval_right : X; - interval_nonempty : le interval_left interval_right - }. - -Record I (grnd:Set)(le:grnd->grnd->Prop) : Type := Imake { - Icar := interval grnd le; - Iplus : Icar -> Icar -> Icar; - Imult : Icar -> Icar -> Icar; - Izero : Icar; - Ione : Icar; - Iopp : Icar -> Icar; - Iinv : Icar -> Icar; - Ic : Icar -> Icar -> Prop; (* consistency *) - (* monoids *) - Iplus_assoc : associative Icar Iplus; - Imult_assoc : associative Icar Imult; - (* abelian groups *) - Iplus_comm : commutative Icar Iplus; - Imult_comm : commutative Icar Imult; - Iplus_0_l : forall x:Icar, Ic (Iplus Izero x) x; - Iplus_0_r : forall x:Icar, Ic (Iplus x Izero) x; - Imult_0_l : forall x:Icar, Ic (Imult Ione x) x; - Imult_0_r : forall x:Icar, Ic (Imult x Ione) x; - Iplus_opp_r : forall x:Icar, Ic (Iplus x (Iopp x)) (Izero); - Imult_inv_r : forall x:Icar, ~(Ic x Izero) -> Ic (Imult x (Iinv x)) Ione; - (* distributive laws *) - Imult_plus_distr_l : forall x x' y y' z z' z'', - Ic x x' -> Ic y y' -> Ic z z' -> Ic z z'' -> - Ic (Imult (Iplus x y) z) (Iplus (Imult x' z') (Imult y' z'')); - (* order and lattice structure *) - Ilt : Icar -> Icar -> Prop; - Ilc := fun (x y:Icar) => Ilt x y \/ Ic x y; - Isup : Icar -> Icar -> Icar; - Iinf : Icar -> Icar -> Icar; - Ilt_trans : transitive _ lt; - Ilt_trich : forall x y:Icar, Ilt x y \/ Ic x y \/ Ilt y x; - Isup_lub : forall x y z:Icar, Ilc x z -> Ilc y z -> Ilc (Isup x y) z; - Iinf_glb : forall x y z:Icar, Ilc x y -> Ilc x z -> Ilc x (Iinf y z); - (* order preserves operations? *) - (* properties of Ic *) - Ic_refl : reflexive _ Ic; - Ic_sym : symmetric _ Ic -}. - -Definition interval_set (X:Set)(le:X->X->Prop) := - (interval X le) -> Prop. (* can be Set as well *) -Check interval_set. -Check Ic. -Definition consistent (X:Set)(le:X->X->Prop)(TI:I X le)(p:interval_set X le) := - forall I J:interval X le, p I -> p J -> (Ic X le TI) I J. -Check consistent. -(* define 'fine' *) - -Record N (grnd:Set)(le:grnd->grnd->Prop)(grndI:I grnd le) : Type := Nmake { - Ncar := interval_set grnd le; - Nplus : Ncar -> Ncar -> Ncar; - Nmult : Ncar -> Ncar -> Ncar; - Nzero : Ncar; - None : Ncar; - Nopp : Ncar -> Ncar; - Ninv : Ncar -> Ncar; - Nc : Ncar -> Ncar -> Prop; (* Ncistency *) - (* monoids *) - Nplus_assoc : associative Ncar Nplus; - Nmult_assoc : associative Ncar Nmult; - (* abelian groups *) - Nplus_comm : commutative Ncar Nplus; - Nmult_comm : commutative Ncar Nmult; - Nplus_0_l : forall x:Ncar, Nc (Nplus Nzero x) x; - Nplus_0_r : forall x:Ncar, Nc (Nplus x Nzero) x; - Nmult_0_l : forall x:Ncar, Nc (Nmult None x) x; - Nmult_0_r : forall x:Ncar, Nc (Nmult x None) x; - Nplus_opp_r : forall x:Ncar, Nc (Nplus x (Nopp x)) (Nzero); - Nmult_inv_r : forall x:Ncar, ~(Nc x Nzero) -> Nc (Nmult x (Ninv x)) None; - (* distributive laws *) - Nmult_plus_distr_l : forall x x' y y' z z' z'', - Nc x x' -> Nc y y' -> Nc z z' -> Nc z z'' -> - Nc (Nmult (Nplus x y) z) (Nplus (Nmult x' z') (Nmult y' z'')); - (* order and lattice structure *) - Nlt : Ncar -> Ncar -> Prop; - Nlc := fun (x y:Ncar) => Nlt x y \/ Nc x y; - Nsup : Ncar -> Ncar -> Ncar; - Ninf : Ncar -> Ncar -> Ncar; - Nlt_trans : transitive _ lt; - Nlt_trich : forall x y:Ncar, Nlt x y \/ Nc x y \/ Nlt y x; - Nsup_lub : forall x y z:Ncar, Nlc x z -> Nlc y z -> Nlc (Nsup x y) z; - Ninf_glb : forall x y z:Ncar, Nlc x y -> Nlc x z -> Nlc x (Ninf y z); - (* order preserves operations? *) - (* properties of Nc *) - Nc_refl : reflexive _ Nc; - Nc_sym : symmetric _ Nc -}. - diff --git a/test-suite/bugs/closed/1542.v b/test-suite/bugs/closed/1542.v deleted file mode 100644 index 52cfbbc496..0000000000 --- a/test-suite/bugs/closed/1542.v +++ /dev/null @@ -1,40 +0,0 @@ -Module Type TITI. -Parameter B:Set. -Parameter x:B. -Inductive A:Set:= -a1:B->A. -Definition f2: A ->B -:= fun (a:A) => -match a with - (a1 b)=>b -end. -Definition f: A -> B:=fun (a:A) => x. -End TITI. - - -Module Type TIT. -Declare Module t:TITI. -End TIT. - -Module Seq(titi:TIT). -Module t:=titi.t. -Inductive toto:t.A->t.B->Set:= -t1:forall (a:t.A), (toto a (t.f a)) -| t2:forall (a:t.A), (toto a (t.f2 a)). -End Seq. - -Module koko(tit:TIT). -Module seq:=Seq tit. -Module t':=tit.t. - -Definition def:forall (a:t'.A), (seq.toto a (t'.f a)). -intro ; constructor 1. -Defined. - -Definition def2: forall (a:t'.A), (seq.toto a (t'.f2 a)). -intro; constructor 2. -(* Toplevel input, characters 0-13 - constructor 2. - ^^^^^^^^^^^^^ -Error: Impossible to unify (seq.toto ?3 (seq.t.f2 ?3)) with - (seq.toto a (t'.f2 a)).*) diff --git a/test-suite/bugs/closed/1545.v b/test-suite/bugs/closed/1545.v deleted file mode 100644 index 9ef796faf7..0000000000 --- a/test-suite/bugs/closed/1545.v +++ /dev/null @@ -1,20 +0,0 @@ -Module Type TIT. - -Inductive X:Set:= - b:X. -End TIT. - - -Module Type TOTO. -Declare Module t:TIT. -Inductive titi:Set:= - a:t.X->titi. -End TOTO. - - -Module toto (ta:TOTO). -Module ti:=ta.t. - -Definition ex1:forall (c d:ti.X), (ta.a d)=(ta.a c) -> d=c. -intros. -injection H. diff --git a/test-suite/bugs/closed/1568.v b/test-suite/bugs/closed/1568.v deleted file mode 100644 index 3609e9c83b..0000000000 --- a/test-suite/bugs/closed/1568.v +++ /dev/null @@ -1,13 +0,0 @@ -CoInductive A: Set := - mk_A: B -> A -with B: Set := - mk_B: A -> B. - -CoFixpoint a:A := mk_A b -with b:B := mk_B a. - -Goal b = match a with mk_A a1 => a1 end. - simpl. reflexivity. -Qed. - - diff --git a/test-suite/bugs/closed/1576.v b/test-suite/bugs/closed/1576.v deleted file mode 100644 index 3621f7a1ff..0000000000 --- a/test-suite/bugs/closed/1576.v +++ /dev/null @@ -1,38 +0,0 @@ -Module Type TA. -Parameter t : Set. -End TA. - -Module Type TB. -Declare Module A: TA. -End TB. - -Module Type TC. -Declare Module B : TB. -End TC. - -Module Type TD. - -Declare Module B: TB . -Declare Module C: TC - with Module B := B . -End TD. - -Module Type TE. -Declare Module D : TD. -End TE. - -Module Type TF. -Declare Module E: TE. -End TF. - -Module G (D: TD). -Module B' := D.C.B. -End G. - -Module H (F: TF). -Module I := G(F.E.D). -End H. - -Declare Module F: TF. -Module K := H(F). - diff --git a/test-suite/bugs/closed/1582.v b/test-suite/bugs/closed/1582.v deleted file mode 100644 index be5d3dd211..0000000000 --- a/test-suite/bugs/closed/1582.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Import Peano_dec. - -Definition fact_F : - forall (n:nat), - (forall m, m<n -> nat) -> - nat. -refine - (fun n fact_rec => - if eq_nat_dec n 0 then - 1 - else - let fn := fact_rec (n-1) _ in - n * fn). -Admitted. - diff --git a/test-suite/bugs/closed/1618.v b/test-suite/bugs/closed/1618.v deleted file mode 100644 index a9b067ceb2..0000000000 --- a/test-suite/bugs/closed/1618.v +++ /dev/null @@ -1,23 +0,0 @@ -Inductive A: Set := -| A1: nat -> A. - -Definition A_size (a: A) : nat := - match a with - | A1 n => 0 - end. - -Require Import Recdef. - -Function n3 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {struct a} : P a := - match a return (P a) with - | A1 n => f n - end. - - -Function n1 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {measure A_size a} : -P -a := - match a return (P a) with - | A1 n => f n - end. - diff --git a/test-suite/bugs/closed/1680.v b/test-suite/bugs/closed/1680.v deleted file mode 100644 index 524c7bab42..0000000000 --- a/test-suite/bugs/closed/1680.v +++ /dev/null @@ -1,9 +0,0 @@ -Ltac int1 := let h := fresh in intro h. - -Goal nat -> nat -> True. - let h' := fresh in (let h := fresh in intro h); intro h'. - Restart. let h' := fresh in int1; intro h'. - trivial. -Qed. - - diff --git a/test-suite/bugs/closed/1683.v b/test-suite/bugs/closed/1683.v deleted file mode 100644 index 3e99694b3c..0000000000 --- a/test-suite/bugs/closed/1683.v +++ /dev/null @@ -1,42 +0,0 @@ -Require Import Setoid. - -Section SetoidBug. - -Variable ms : Type. -Variable ms_type : ms -> Type. -Variable ms_eq : forall (A:ms), relation (ms_type A). - -Variable CR : ms. - -Record Ring : Type := -{Ring_type : Type}. - -Variable foo : forall (A:Ring), nat -> Ring_type A. -Variable IR : Ring. -Variable IRasCR : Ring_type IR -> ms_type CR. - -Definition CRasCRing : Ring := Build_Ring (ms_type CR). - -Hypothesis ms_refl : forall A x, ms_eq A x x. -Hypothesis ms_sym : forall A x y, ms_eq A x y -> ms_eq A y x. -Hypothesis ms_trans : forall A x y z, ms_eq A x y -> ms_eq A y z -> ms_eq A x z. - -Add Parametric Relation A : (ms_type A) (ms_eq A) - reflexivity proved by (ms_refl A) - symmetry proved by (ms_sym A) - transitivity proved by (ms_trans A) - as ms_Setoid. - -Hypothesis foobar : forall n, ms_eq CR (IRasCR (foo IR n)) (foo CRasCRing n). - -Goal forall (b:ms_type CR), - ms_eq CR (IRasCR (foo IR O)) b -> - ms_eq CR (IRasCR (foo IR O)) b. -intros b H. -rewrite foobar. -rewrite foobar in H. -assumption. -Qed. - - - diff --git a/test-suite/bugs/closed/1740.v b/test-suite/bugs/closed/1740.v deleted file mode 100644 index ec4a7a6bcb..0000000000 --- a/test-suite/bugs/closed/1740.v +++ /dev/null @@ -1,23 +0,0 @@ -(* Check that expansion of alias in pattern-matching compilation is no - longer dependent of whether the pattern-matching problem occurs in a - typed context or at toplevel (solved from revision 10883) *) - -Definition f := - fun n m : nat => - match n, m with - | O, _ => O - | n, O => n - | _, _ => O - end. - -Goal f = - fun n m : nat => - match n, m with - | O, _ => O - | n, O => n - | _, _ => O - end. - unfold f. - reflexivity. -Qed. - diff --git a/test-suite/bugs/closed/1773.v b/test-suite/bugs/closed/1773.v deleted file mode 100644 index 211af89b70..0000000000 --- a/test-suite/bugs/closed/1773.v +++ /dev/null @@ -1,9 +0,0 @@ -(* An occur-check test was done too early *) - -Goal forall B C : nat -> nat -> Prop, forall k, - (exists A, (forall k', C A k' -> B A k') -> B A k). -Proof. - intros B C k. - econstructor. - intros X. - apply X. (* used to fail here *) diff --git a/test-suite/bugs/closed/1784.v b/test-suite/bugs/closed/1784.v deleted file mode 100644 index 25d1b192eb..0000000000 --- a/test-suite/bugs/closed/1784.v +++ /dev/null @@ -1,100 +0,0 @@ -Require Import List. -Require Import ZArith. -Require String. Open Scope string_scope. -Ltac Case s := let c := fresh "case" in set (c := s). - -Set Implicit Arguments. -Unset Strict Implicit. - -Inductive sv : Set := -| I : Z -> sv -| S : list sv -> sv. - -Section sv_induction. - -Variables - (VP: sv -> Prop) - (LP: list sv -> Prop) - - (VPint: forall n, VP (I n)) - (VPset: forall vs, LP vs -> VP (S vs)) - (lpcons: forall v vs, VP v -> LP vs -> LP (v::vs)) - (lpnil: LP nil). - -Fixpoint setl_value_indp (x:sv) {struct x}: VP x := - match x as x return VP x with - | I n => VPint n - | S vs => - VPset - ((fix values_indp (vs:list sv) {struct vs}: (LP vs) := - match vs as vs return LP vs with - | nil => lpnil - | v::vs => lpcons (setl_value_indp v) (values_indp vs) - end) vs) - end. -End sv_induction. - -Inductive slt : sv -> sv -> Prop := -| IC : forall z, slt (I z) (I z) -| IS : forall vs vs', slist_in vs vs' -> slt (S vs) (S vs') - -with sin : sv -> list sv -> Prop := -| Ihd : forall s s' sv', slt s s' -> sin s (s'::sv') -| Itl : forall s s' sv', sin s sv' -> sin s (s'::sv') - -with slist_in : list sv -> list sv -> Prop := -| Inil : forall sv', - slist_in nil sv' -| Icons : forall s sv sv', - sin s sv' -> - slist_in sv sv' -> - slist_in (s::sv) sv'. - -Hint Constructors sin slt slist_in. - -Require Import Program. - -Program Fixpoint lt_dec (x y:sv) { struct x } : {slt x y}+{~slt x y} := - match x with - | I x => - match y with - | I y => if (Z.eq_dec x y) then in_left else in_right - | S ys => in_right - end - | S xs => - match y with - | I y => in_right - | S ys => - let fix list_in (xs ys:list sv) {struct xs} : - {slist_in xs ys} + {~slist_in xs ys} := - match xs with - | nil => in_left - | x::xs => - let fix elem_in (ys:list sv) : {sin x ys}+{~sin x ys} := - match ys with - | nil => in_right - | y::ys => if lt_dec x y then in_left else if elem_in - ys then in_left else in_right - end - in - if elem_in ys then - if list_in xs ys then in_left else in_right - else in_right - end - in if list_in xs ys then in_left else in_right - end - end. - -Next Obligation. intro H0. apply H; inversion H0; subst; trivial. Defined. -Next Obligation. intro H; inversion H. Defined. -Next Obligation. intro H; inversion H. Defined. -Next Obligation. intro H; inversion H; subst. Defined. -Next Obligation. - intro H1; contradict H. inversion H1; subst. assumption. - contradict H0; assumption. Defined. -Next Obligation. intro H1; contradict H0. inversion H1; subst. assumption. Defined. -Next Obligation. - intro H1; contradict H. inversion H1; subst. assumption. Defined. -Next Obligation. - intro H0; contradict H. inversion H0; subst; auto. Defined. - diff --git a/test-suite/bugs/closed/1787.v b/test-suite/bugs/closed/1787.v deleted file mode 100644 index 8e1024e6ec..0000000000 --- a/test-suite/bugs/closed/1787.v +++ /dev/null @@ -1,11 +0,0 @@ -Parameter P : nat -> nat -> Prop. -Parameter Q : nat -> nat -> Prop. -Axiom A : forall x x' x'', P x x' -> Q x'' x' -> P x x''. - -Goal (P 1 3) -> (Q 1 3) -> (P 1 1). -intros H H'. -refine ((fun H1 : P 1 _ => let H2 := (_:Q 1 _) in A _ _ _ H1 H2) _). -clear. -Admitted. - - diff --git a/test-suite/bugs/closed/1850.v b/test-suite/bugs/closed/1850.v deleted file mode 100644 index 26b48093b7..0000000000 --- a/test-suite/bugs/closed/1850.v +++ /dev/null @@ -1,4 +0,0 @@ -Parameter P : Type -> Type -> Type. -Notation "e |= t --> v" := (P e t v) (at level 100, t at level 54). -Fail Check (nat |= nat --> nat). - diff --git a/test-suite/bugs/closed/1865.v b/test-suite/bugs/closed/1865.v deleted file mode 100644 index 17c1998948..0000000000 --- a/test-suite/bugs/closed/1865.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Check that tactics (here dependent inversion) do not generate - conversion problems T <= U with sup's of universes in U *) - -(* Submitted by David Nowak *) - -Inductive list (A:Set) : nat -> Set := -| nil : list A O -| cons : forall n, A -> list A n -> list A (S n). - -Definition f (n:nat) : Type := - match n with - | O => bool - | _ => unit - end. - -Goal forall A n, list A n -> f n. -intros A n. -dependent inversion n. diff --git a/test-suite/bugs/closed/1891.v b/test-suite/bugs/closed/1891.v deleted file mode 100644 index 5024a5bc97..0000000000 --- a/test-suite/bugs/closed/1891.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Check evar-evar unification *) - Inductive T (A: Set): Set := mkT: unit -> T A. - - Definition f (A: Set) (l: T A): unit := tt. - - Arguments f [A]. - - Lemma L (x: T unit): (unit -> T unit) -> unit. - Proof. - refine (match x return _ with mkT _ n => fun g => f (g _) end). - trivial. - Qed. - diff --git a/test-suite/bugs/closed/1918.v b/test-suite/bugs/closed/1918.v deleted file mode 100644 index 9d92fe12b8..0000000000 --- a/test-suite/bugs/closed/1918.v +++ /dev/null @@ -1,376 +0,0 @@ -(** Occur-check for Meta (up to delta) *) - -(** LNMItPredShort.v Version 2.0 July 2008 *) -(** does not need impredicative Set, runs under V8.2, tested with SVN 11296 *) - -(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse*) - - -Set Implicit Arguments. - -(** the universe of all monotypes *) -Definition k0 := Set. - -(** the type of all type transformations *) -Definition k1 := k0 -> k0. - -(** the type of all rank-2 type transformations *) -Definition k2 := k1 -> k1. - -(** polymorphic identity *) -Definition id : forall (A:Set), A -> A := fun A x => x. - -(** composition *) -Definition comp (A B C:Set)(g:B->C)(f:A->B) : A->C := fun x => g (f x). - -Infix "o" := comp (at level 90). - -Definition sub_k1 (X Y:k1) : Type := - forall A:Set, X A -> Y A. - -Infix "c_k1" := sub_k1 (at level 60). - -(** monotonicity *) -Definition mon (X:k1) : Type := forall (A B:Set), (A -> B) -> X A -> X B. - -(** extensionality *) -Definition ext (X:k1)(h: mon X): Prop := - forall (A B:Set)(f g:A -> B), - (forall a, f a = g a) -> forall r, h _ _ f r = h _ _ g r. - -(** first functor law *) -Definition fct1 (X:k1)(m: mon X) : Prop := - forall (A:Set)(x:X A), m _ _ (id(A:=A)) x = x. - -(** second functor law *) -Definition fct2 (X:k1)(m: mon X) : Prop := - forall (A B C:Set)(f:A -> B)(g:B -> C)(x:X A), - m _ _ (g o f) x = m _ _ g (m _ _ f x). - -(** pack up the good properties of the approximation into - the notion of an extensional functor *) -Record EFct (X:k1) : Type := mkEFct - { m : mon X; - e : ext m; - f1 : fct1 m; - f2 : fct2 m }. - -(** preservation of extensional functors *) -Definition pEFct (F:k2) : Type := - forall (X:k1), EFct X -> EFct (F X). - - -(** we show some closure properties of pEFct, depending on such properties - for EFct *) - -Definition moncomp (X Y:k1)(mX:mon X)(mY:mon Y): mon (fun A => X(Y A)). -Proof. - red. - intros A B f x. - exact (mX (Y A)(Y B) (mY A B f) x). -Defined. - -(** closure under composition *) -Lemma compEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X(Y A)). -Proof. - intros ef1 ef2. - apply (mkEFct(m:=moncomp (m ef1) (m ef2))); red; intros; unfold moncomp. -(* prove ext *) - apply (e ef1). - intro. - apply (e ef2); trivial. -(* prove fct1 *) - rewrite (e ef1 (m ef2 (id (A:=A))) (id(A:=Y A))). - apply (f1 ef1). - intro. - apply (f1 ef2). -(* prove fct2 *) - rewrite (e ef1 (m ef2 (g o f))((m ef2 g)o(m ef2 f))). - apply (f2 ef1). - intro. - unfold comp at 2. - apply (f2 ef2). -Defined. - -Corollary comppEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X (G X A)). -Proof. - red. - intros. - apply compEFct; auto. -Defined. - -(** closure under sums *) -Lemma sumEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A + Y A)%type. -Proof. - intros ef1 ef2. - set (m12:=fun (A B:Set)(f:A->B) x => match x with - | inl y => inl _ (m ef1 f y) - | inr y => inr _ (m ef2 f y) - end). - apply (mkEFct(m:=m12)); red; intros. -(* prove ext *) - destruct r. - simpl. - apply (f_equal (fun x=>inl (A:=X B) (Y B) x)). - apply (e ef1); trivial. - simpl. - apply (f_equal (fun x=>inr (X B) (B:=Y B) x)). - apply (e ef2); trivial. -(* prove fct1 *) - destruct x. - simpl. - apply (f_equal (fun x=>inl (A:=X A) (Y A) x)). - apply (f1 ef1). - simpl. - apply (f_equal (fun x=>inr (X A) (B:=Y A) x)). - apply (f1 ef2). -(* prove fct2 *) - destruct x. - simpl. - rewrite (f2 ef1); reflexivity. - simpl. - rewrite (f2 ef2); reflexivity. -Defined. - -Corollary sumpEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X A + G X A)%type. -Proof. - red. - intros. - apply sumEFct; auto. -Defined. - -(** closure under products *) -Lemma prodEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A * Y A)%type. -Proof. - intros ef1 ef2. - set (m12:=fun (A B:Set)(f:A->B) x => match x with - (x1,x2) => (m ef1 f x1, m ef2 f x2) end). - apply (mkEFct(m:=m12)); red; intros. -(* prove ext *) - destruct r as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (e ef1); trivial. - apply (e ef2); trivial. -(* prove fct1 *) - destruct x as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (f1 ef1). - apply (f1 ef2). -(* prove fct2 *) - destruct x as [x1 x2]. - simpl. - apply injective_projections; simpl. - apply (f2 ef1). - apply (f2 ef2). -Defined. - -Corollary prodpEFct (F G:k2): pEFct F -> pEFct G -> - pEFct (fun X A => F X A * G X A)%type. -Proof. - red. - intros. - apply prodEFct; auto. -Defined. - -(** the identity in k2 preserves extensional functors *) -Lemma idpEFct: pEFct (fun X => X). -Proof. - red. - intros. - assumption. -Defined. - -(** a variant for the eta-expanded identity *) -Lemma idpEFct_eta: pEFct (fun X A => X A). -Proof. - red. - intros X ef. - destruct ef as [m0 e0 f01 f02]. - change (mon X) with (mon (fun A => X A)) in m0. - apply (mkEFct (m:=m0) e0 f01 f02). -Defined. - -(** the identity in k1 "is" an extensional functor *) -Lemma idEFct: EFct (fun A => A). -Proof. - set (mId:=fun A B (f:A->B)(x:A) => f x). - apply (mkEFct(m:=mId)). - red. - intros. - unfold mId. - apply H. - red. - reflexivity. - red. - reflexivity. -Defined. - -(** constants in k2 *) -Lemma constpEFct (X:k1): EFct X -> pEFct (fun _ => X). -Proof. - red. - intros. - assumption. -Defined. - -(** constants in k1 *) -Lemma constEFct (C:Set): EFct (fun _ => C). -Proof. - set (mC:=fun A B (f:A->B)(x:C) => x). - apply (mkEFct(m:=mC)); red; intros; unfold mC; reflexivity. -Defined. - - -(** the option type *) -Lemma optionEFct: EFct (fun (A:Set) => option A). - apply (mkEFct (X:=fun (A:Set) => option A)(m:=option_map)); red; intros. - destruct r. - simpl. - rewrite H. - reflexivity. - reflexivity. - destruct x; reflexivity. - destruct x; reflexivity. -Defined. - - -(** natural transformations from (X,mX) to (Y,mY) *) -Definition NAT(X Y:k1)(j:X c_k1 Y)(mX:mon X)(mY:mon Y) : Prop := - forall (A B:Set)(f:A->B)(t:X A), j B (mX A B f t) = mY _ _ f (j A t). - - -Module Type LNMIt_Type. - -Parameter F:k2. -Parameter FpEFct: pEFct F. -Parameter mu20: k1. -Definition mu2: k1:= fun A => mu20 A. -Parameter mapmu2: mon mu2. -Definition MItType: Type := - forall G : k1, (forall X : k1, X c_k1 G -> F X c_k1 G) -> mu2 c_k1 G. -Parameter MIt0 : MItType. -Definition MIt : MItType:= fun G s A t => MIt0 s t. -Definition InType : Type := - forall (X:k1)(ef:EFct X)(j: X c_k1 mu2), - NAT j (m ef) mapmu2 -> F X c_k1 mu2. -Parameter In : InType. -Axiom mapmu2Red : forall (A:Set)(X:k1)(ef:EFct X)(j: X c_k1 mu2) - (n: NAT j (m ef) mapmu2)(t: F X A)(B:Set)(f:A->B), - mapmu2 f (In ef n t) = In ef n (m (FpEFct ef) f t). -Axiom MItRed : forall (G : k1) - (s : forall X : k1, X c_k1 G -> F X c_k1 G)(X : k1)(ef:EFct X)(j: X c_k1 mu2) - (n: NAT j (m ef) mapmu2)(A:Set)(t:F X A), - MIt s (In ef n t) = s X (fun A => (MIt s (A:=A)) o (j A)) A t. -Definition mu2IndType : Prop := - forall (P : (forall A : Set, mu2 A -> Prop)), - (forall (X : k1)(ef:EFct X)(j : X c_k1 mu2)(n: NAT j (m ef) mapmu2), - (forall (A : Set) (x : X A), P A (j A x)) -> - forall (A:Set)(t : F X A), P A (In ef n t)) -> - forall (A : Set) (r : mu2 A), P A r. -Axiom mu2Ind : mu2IndType. - -End LNMIt_Type. - -(** BushDepPredShort.v Version 0.2 July 2008 *) -(** does not need impredicative Set, produces stack overflow under V8.2, tested -with SVN 11296 *) - -(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse *) - -Set Implicit Arguments. - -Require Import List. - -Definition listk1 (A:Set) : Set := list A. -Open Scope type_scope. - -Definition BushF(X:k1)(A:Set) := unit + A * X (X A). - -Definition bushpEFct : pEFct BushF. -Proof. - unfold BushF. - apply sumpEFct. - apply constpEFct. - apply constEFct. - apply prodpEFct. - apply constpEFct. - apply idEFct. - apply comppEFct. - apply idpEFct. - apply idpEFct_eta. -Defined. - -Module Type BUSH := LNMIt_Type with Definition F:=BushF - with Definition FpEFct := -bushpEFct. - -Module Bush (BushBase:BUSH). - -Definition Bush : k1 := BushBase.mu2. - -Definition bush : mon Bush := BushBase.mapmu2. - -End Bush. - - -Definition Id : k1 := fun X => X. - -Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= - match k with 0 => Id - | S k' => fun A => X (Pow X k' A) - end. - -Fixpoint POW (k:nat)(X:k1)(m:mon X){struct k} : mon (Pow X k) := - match k return mon (Pow X k) - with 0 => fun _ _ f => f - | S k' => fun _ _ f => m _ _ (POW k' m f) - end. - -Module Type BushkToList_Type. - -Declare Module Import BP: BUSH. -Definition F:=BushF. -Definition FpEFct:= bushpEFct. -Definition mu20 := mu20. -Definition mu2 := mu2. -Definition mapmu2 := mapmu2. -Definition MItType:= MItType. -Definition MIt0 := MIt0. -Definition MIt := MIt. -Definition InType := InType. -Definition In := In. -Definition mapmu2Red:=mapmu2Red. -Definition MItRed:=MItRed. -Definition mu2IndType:=mu2IndType. -Definition mu2Ind:=mu2Ind. - -Definition Bush:= mu2. -Module BushM := Bush BP. - -Parameter BushkToList: forall(k:nat)(A:k0)(t:Pow Bush k A), list A. -Axiom BushkToList0: forall(A:k0)(t:Pow Bush 0 A), BushkToList 0 A t = t::nil. - -End BushkToList_Type. - -Module BushDep (BushkToListM:BushkToList_Type). - -Module Bush := Bush BushkToListM. - -Import Bush. -Import BushkToListM. - - -Lemma BushkToList0NAT: NAT(Y:=listk1) (BushkToList 0) (POW 0 bush) map. -Proof. - red. - intros. - simpl. - rewrite BushkToList0. -(* stack overflow for coqc and coqtop *) - - -Abort. diff --git a/test-suite/bugs/closed/1944.v b/test-suite/bugs/closed/1944.v deleted file mode 100644 index ee2918c6e9..0000000000 --- a/test-suite/bugs/closed/1944.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Test some uses of ? in introduction patterns *) - -Inductive J : nat -> Prop := - | K : forall p, J p -> (True /\ True) -> J (S p). - -Lemma bug : forall n, J n -> J (S n). -Proof. - intros ? H. - induction H as [? ? [? ?]]. diff --git a/test-suite/bugs/closed/1963.v b/test-suite/bugs/closed/1963.v deleted file mode 100644 index 11e2ee44d6..0000000000 --- a/test-suite/bugs/closed/1963.v +++ /dev/null @@ -1,19 +0,0 @@ -(* Check that "dependent inversion" behaves correctly w.r.t to universes *) - -Require Import Eqdep. - -Set Implicit Arguments. - -Inductive illist(A:Type) : nat -> Type := - illistn : illist A 0 -| illistc : forall n:nat, A -> illist A n -> illist A (S n). - -Inductive isig (A:Type)(P:A -> Type) : Type := - iexists : forall x : A, P x -> isig P. - -Lemma inv : forall (A:Type)(n n':nat)(ts':illist A n'), n' = S n -> - isig (fun t => isig (fun ts => - eq_dep nat (fun n => illist A n) n' ts' (S n) (illistc t ts))). -Proof. -intros. -dependent inversion ts'. diff --git a/test-suite/bugs/closed/2016.v b/test-suite/bugs/closed/2016.v deleted file mode 100644 index 536e6fabd9..0000000000 --- a/test-suite/bugs/closed/2016.v +++ /dev/null @@ -1,64 +0,0 @@ -(* Coq 8.2beta4 *) -Require Import Classical_Prop. - -Unset Structural Injection. - -Record coreSemantics : Type := CoreSemantics { - core: Type; - corestep: core -> core -> Prop; - corestep_fun: forall q q1 q2, corestep q q1 -> corestep q q2 -> q1 = q2 -}. - -Definition state : Type := {sem: coreSemantics & sem.(core)}. - -Inductive step: state -> state -> Prop := - | step_core: forall sem st st' - (Hcs: sem.(corestep) st st'), - step (existT _ sem st) (existT _ sem st'). - -Lemma step_fun: forall st1 st2 st2', step st1 st2 -> step st1 st2' -> st2 = st2'. -Proof. -intros. -inversion H; clear H; subst. inversion H0; clear H0; subst; auto. -generalize (inj_pairT2 _ _ _ _ _ H2); clear H2; intro; subst. -rewrite (corestep_fun _ _ _ _ Hcs Hcs0); auto. -Qed. - -Record oe_core := oe_Core { - in_core: Type; - in_corestep: in_core -> in_core -> Prop; - in_corestep_fun: forall q q1 q2, in_corestep q q1 -> in_corestep q q2 -> q1 = q2; - in_q: in_core -}. - -Definition oe2coreSem (oec : oe_core) : coreSemantics := - CoreSemantics oec.(in_core) oec.(in_corestep) oec.(in_corestep_fun). - -Definition oe_corestep (q q': oe_core) := - step (existT _ (oe2coreSem q) q.(in_q)) (existT _ (oe2coreSem q') q'.(in_q)). - -Lemma inj_pairT1: forall (U: Type) (P: U -> Type) (p1 p2: U) x y, - existT P p1 x = existT P p2 y -> p1=p2. -Proof. intros; injection H; auto. -Qed. - -Definition f := CoreSemantics oe_core. - -Lemma oe_corestep_fun: forall q q1 q2, - oe_corestep q q1 -> oe_corestep q q2 -> q1 = q2. -Proof. -unfold oe_corestep; intros. -assert (HH:= step_fun _ _ _ H H0); clear H H0. -destruct q1; destruct q2; unfold oe2coreSem; simpl in *. -generalize (inj_pairT1 _ _ _ _ _ _ HH); clear HH; intros. -injection H. -revert in_q1 in_corestep1 in_corestep_fun1 - H. -pattern in_core1. -apply eq_ind_r with (x := in_core0). -admit. -apply sym_eq. -(** good to here **) -Show Universes. -Print Universes. -Fail apply H0. diff --git a/test-suite/bugs/closed/2083.v b/test-suite/bugs/closed/2083.v deleted file mode 100644 index 5f17f7af35..0000000000 --- a/test-suite/bugs/closed/2083.v +++ /dev/null @@ -1,27 +0,0 @@ -Require Import Program Arith. - -Program Fixpoint check_n (n : nat) (P : { i | i < n } -> bool) (p : nat) - (H : forall (i : { i | i < n }), i < p -> P i = true) - {measure (n - p)} : - Exc (forall (p : { i | i < n}), P p = true) := - match le_lt_dec n p with - | left _ => value _ - | right cmp => - if dec (P p) then - check_n n P (S p) _ - else - error - end. - -Require Import Omega. - -Solve Obligations with program_simpl ; auto with *; try omega. - -Next Obligation. - apply H. simpl. omega. -Defined. - -Next Obligation. - case (le_lt_dec p i) ; intros. assert(i = p) by omega. subst. - revert H0. clear_subset_proofs. auto. - apply H. simpl. assumption. Defined. diff --git a/test-suite/bugs/closed/2117.v b/test-suite/bugs/closed/2117.v deleted file mode 100644 index 6377a8b74a..0000000000 --- a/test-suite/bugs/closed/2117.v +++ /dev/null @@ -1,56 +0,0 @@ -(* Check pattern-unification on evars in apply unification *) - -Axiom app : forall tau tau':Type, (tau -> tau') -> tau -> tau'. - -Axiom copy : forall tau:Type, tau -> tau -> Prop. -Axiom copyr : forall tau:Type, tau -> tau -> Prop. -Axiom copyf : forall tau:Type, tau -> tau -> Prop. -Axiom eq : forall tau:Type, tau -> tau -> Prop. -Axiom subst : forall tau tau':Type, (tau -> tau') -> tau -> tau' -> Prop. - -Axiom copy_atom : forall tau:Type, forall t t':tau, eq tau t t' -> copy tau t t'. -Axiom copy_fun: forall tau tau':Type, forall t t':(tau->tau'), -(forall x:tau, copyr tau x x->copy tau' (t x) (t' x)) -->copy (tau->tau') t t'. - -Axiom copyr_atom : forall tau:Type, forall t t':tau, copyr tau t t' -> eq tau t t'. -Axiom copyr_fun: forall tau tau':Type, forall t t':(tau->tau'), -copyr (tau->tau') t t' -->(forall x y:tau, copy tau x y->copyr tau' (t x) (t' y)). - -Axiom copyf_atom : forall tau:Type, forall t t':tau, copyf tau t t' -> eq tau t t'. -Axiom copyf_fun: forall tau tau':Type, forall t t':(tau->tau'), -copyr (tau->tau') t t' -->(forall x y:tau, forall z1 z2:tau', -(copy tau x y)-> -(subst tau tau' t x z1)-> -(subst tau tau' t' y z2)-> -copyf tau' z1 z2). - -Axiom eqappg: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau',forall t':tau', -( ((subst tau tau' t q t') /\ (eq tau' t' r)) -->eq tau' (app tau tau' t q) r). - -Axiom eqappd: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', -forall t':tau', ((subst tau tau' t q t') /\ (eq tau' r t')) -->eq tau' r (app tau tau' t q). - -Axiom substcopy: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', -(forall x:tau, (copyf tau x q) -> (copy tau' (t x) r)) -->subst tau tau' t q r. - -Ltac EtaLong := (apply copy_fun;intros;EtaLong)|| apply copy_atom.
-Ltac Subst := apply substcopy;intros;EtaLong. -Ltac Rigid_aux := fun A => apply A|| Rigid_aux (copyr_fun _ _ _ _ A). -Ltac Rigid := fun A => apply copyr_atom; Rigid_aux A. - -Theorem church0: forall i:Type, exists X:(i->i)->i->i, -copy ((i->i)->i->i) (fun f:i->i => fun x:i=>f (X f x)) (fun f:i->i=>fun x:i=>app i i (X f) (f x)). -intros. -esplit. -EtaLong. -eapply eqappd;split. -Subst. -apply copyf_atom. -Show Existentials. -apply H1. diff --git a/test-suite/bugs/closed/2123.v b/test-suite/bugs/closed/2123.v deleted file mode 100644 index 422a2c126e..0000000000 --- a/test-suite/bugs/closed/2123.v +++ /dev/null @@ -1,11 +0,0 @@ -(* About the detection of non-dependent metas by the refine tactic *) - -(* The following is a simplification of bug #2123 *) - -Parameter fset : nat -> Set. -Parameter widen : forall (n : nat) (s : fset n), { x : fset (S n) | s=s }. -Goal forall i, fset (S i). -intro. -refine (proj1_sig (widen i _)). - - diff --git a/test-suite/bugs/closed/2135.v b/test-suite/bugs/closed/2135.v deleted file mode 100644 index 61882176aa..0000000000 --- a/test-suite/bugs/closed/2135.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Check that metas are whd-normalized before trying 2nd-order unification *) -Lemma test : - forall (D:Type) (T : forall C, option C) (Q:forall D, option D -> Prop), - (forall (A : Type) (P : forall B:Type, option B -> Prop), P A (T A)) - -> Q D (T D). -Proof. - intros D T Q H. - pattern (T D). apply H. -Qed. diff --git a/test-suite/bugs/closed/2139.v b/test-suite/bugs/closed/2139.v deleted file mode 100644 index a7f3550888..0000000000 --- a/test-suite/bugs/closed/2139.v +++ /dev/null @@ -1,24 +0,0 @@ -(* Call of apply on <-> failed because of evars in elimination predicate *) -Generalizable Variables patch. - -Class Patch (patch : Type) := { - commute : patch -> patch -> Prop -}. - -Parameter flip : forall `{patchInstance : Patch patch} - {a b : patch}, - commute a b <-> commute b a. - -Lemma Foo : forall `{patchInstance : Patch patch} - {a b : patch}, - (commute a b) - -> True. -Proof. -intros. -apply flip in H. - -(* failed in well-formed arity check because elimination predicate of - iff in (@flip _ _ _ _) had normalized evars while the ones in the - type of (@flip _ _ _ _) itself had non-normalized evars *) - -(* By the way, is the check necessary ? *) diff --git a/test-suite/bugs/closed/2145.v b/test-suite/bugs/closed/2145.v deleted file mode 100644 index 4dc0de7433..0000000000 --- a/test-suite/bugs/closed/2145.v +++ /dev/null @@ -1,20 +0,0 @@ -(* Test robustness of Groebner tactic in presence of disequalities *) - -Require Export Reals. -Require Export Nsatz. - -Open Scope R_scope. - -Lemma essai : - forall yb xb m1 m2 xa ya, - xa <> xb -> - yb - 2 * m2 * xb = ya - m2 * xa -> - yb - m1 * xb = ya - m1 * xa -> - yb - ya = (2 * xb - xa) * m2 -> - yb - ya = (xb - xa) * m1. -Proof. -intros. -(* clear H. groebner used not to work when H was not cleared *) -nsatz. -Qed. - diff --git a/test-suite/bugs/closed/2149.v b/test-suite/bugs/closed/2149.v deleted file mode 100644 index 38c5f36ab2..0000000000 --- a/test-suite/bugs/closed/2149.v +++ /dev/null @@ -1,7 +0,0 @@ -Lemma Foo : forall x y : nat, y = x -> y = x. -Proof. -intros x y. -rename x into y, y into x. -trivial. -Qed. - diff --git a/test-suite/bugs/closed/2164.v b/test-suite/bugs/closed/2164.v deleted file mode 100644 index 6adb3577be..0000000000 --- a/test-suite/bugs/closed/2164.v +++ /dev/null @@ -1,334 +0,0 @@ -(* Check that "inversion as" manages names as expected *) -Inductive type: Set - := | int: type - | pointer: type -> type. -Print type. - -Parameter value_set - : type -> Set. - -Parameter string : Set. - -Parameter Z : Set. - -Inductive lvalue (t: type): Set - := | var: string -> lvalue t (* name of the variable *) - | lvalue_loc: Z -> lvalue t (* address of the variable *) - | deref_l: lvalue (pointer t) -> lvalue t (* deref an lvalue ptr *) - | deref_r: rvalue (pointer t) -> lvalue t (* deref an rvalue ptr *) -with rvalue (t: type): Set - := | value_of: lvalue t -> rvalue t (* variable as value *) - | mk_rvalue: value_set t -> rvalue t. (* literal value *) -Print lvalue. - -Inductive statement: Set - := | void_stat: statement - | var_loc: (* to be destucted at end of scope *) - forall (t: type) (n: string) (loc: Z), statement - | var_ref: (* not to be destructed *) - forall (t: type) (n: string) (loc: Z), statement - | var_def: (* var def as typed in code *) - forall (t:type) (n: string) (val: rvalue t), statement - | assign: - forall (t: type) (var: lvalue t) (val: rvalue t), statement - | group: - forall (l: list statement), statement - | fun_def: - forall (s: string) (l: list statement), statement - | param_decl: - forall (t: type) (n: string), statement - | delete: - forall a: Z, statement. - -Inductive expr: Set -:= | statement_to_expr: statement -> expr - | lvalue_to_expr: forall t: type, lvalue t -> expr - | rvalue_to_expr: forall t: type, rvalue t -> expr. - -Inductive executable_prim_expr: expr -> Set -:= -(* statements *) - | var_def_primitive: - forall (t: type) (n: string) (loc: Z), - executable_prim_expr - (statement_to_expr - (var_def t n - (value_of t (lvalue_loc t loc)))) - | assign_primitive: - forall (t: type) (loc1 loc2: Z), - executable_prim_expr - (statement_to_expr - (assign t (lvalue_loc t loc1) - (value_of t (lvalue_loc t loc2)))) -(* rvalue *) - | mk_rvalue_primitive: - forall (t: type) (v: value_set t), - executable_prim_expr - (rvalue_to_expr t (mk_rvalue t v)) -(* lvalue *) - (* var *) - | var_primitive: - forall (t: type) (n: string), - executable_prim_expr (lvalue_to_expr t (var t n)) - (* deref_l *) - | deref_l_primitive: - forall (t: type) (loc: Z), - executable_prim_expr - (lvalue_to_expr t - (deref_l t (lvalue_loc (pointer t) loc))) - (* deref_r *) - | deref_r_primitive: - forall (t: type) (loc: Z), - executable_prim_expr - (lvalue_to_expr t - (deref_r t - (value_of (pointer t) - (lvalue_loc (pointer t) loc)))). - -Inductive executable_sub_expr: expr -> Set -:= | executable_sub_expr_prim: - forall e: expr, - executable_prim_expr e -> - executable_sub_expr e -(* statements *) - | var_def_sub_rvalue: - forall (t: type) (n: string) (rv: rvalue t), - executable_sub_expr (rvalue_to_expr t rv) -> - executable_sub_expr (statement_to_expr (var_def t n rv)) - | assign_sub_lvalue: - forall (t: type) (lv: lvalue t) (rv: rvalue t), - executable_sub_expr (lvalue_to_expr t lv) -> - executable_sub_expr (statement_to_expr (assign t lv rv)) - | assign_sub_rvalue: - forall (t: type) (lv: lvalue t) (rv: rvalue t), - executable_sub_expr (rvalue_to_expr t rv) -> - executable_sub_expr (statement_to_expr (assign t lv rv)) -(* rvalue *) - | value_of_sub_lvalue: - forall (t: type) (lv: lvalue t), - executable_sub_expr (lvalue_to_expr t lv) -> - executable_sub_expr (rvalue_to_expr t (value_of t lv)) -(* lvalue *) - | deref_l_sub_lvalue: - forall (t: type) (lv: lvalue (pointer t)), - executable_sub_expr (lvalue_to_expr (pointer t) lv) -> - executable_sub_expr (lvalue_to_expr t (deref_l t lv)) - | deref_r_sub_rvalue: - forall (t: type) (rv: rvalue (pointer t)), - executable_sub_expr (rvalue_to_expr (pointer t) rv) -> - executable_sub_expr (lvalue_to_expr t (deref_r t rv)). - -Inductive expr_kind: Set -:= | statement_kind: expr_kind - | lvalue_kind: type -> expr_kind - | rvalue_kind: type -> expr_kind. - -Definition expr_to_kind: expr -> expr_kind. -intro e. -destruct e. -exact statement_kind. -exact (lvalue_kind t). -exact (rvalue_kind t). -Defined. - -Inductive def_sub_expr_subs: - forall e: expr, - forall ee: executable_sub_expr e, - forall ee': expr, - forall e': expr, - Prop -:= | def_sub_expr_subs_prim: - forall e: expr, - forall p: executable_prim_expr e, - forall ee': expr, - expr_to_kind e = expr_to_kind ee' -> - def_sub_expr_subs e (executable_sub_expr_prim e p) ee' ee' - | def_sub_expr_subs_var_def_sub_rvalue: - forall (t: type) (n: string), - forall rv rv': rvalue t, - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr t rv), - def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' - (rvalue_to_expr t rv') -> - def_sub_expr_subs - (statement_to_expr (var_def t n rv)) - (var_def_sub_rvalue t n rv se_rv) - ee' - (statement_to_expr (var_def t n rv')) - | def_sub_expr_subs_assign_sub_lvalue: - forall t: type, - forall lv lv': lvalue t, - forall rv: rvalue t, - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' - (lvalue_to_expr t lv') -> - def_sub_expr_subs - (statement_to_expr (assign t lv rv)) - (assign_sub_lvalue t lv rv se_lv) - ee' - (statement_to_expr (assign t lv' rv)) - | def_sub_expr_subs_assign_sub_rvalue: - forall t: type, - forall lv: lvalue t, - forall rv rv': rvalue t, - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr t rv), - def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' - (rvalue_to_expr t rv') -> - def_sub_expr_subs - (statement_to_expr (assign t lv rv)) - (assign_sub_rvalue t lv rv se_rv) - ee' - (statement_to_expr (assign t lv rv')) - | def_sub_expr_subs_value_of_sub_lvalue: - forall t: type, - forall lv lv': lvalue t, - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' - (lvalue_to_expr t lv') -> - def_sub_expr_subs - (rvalue_to_expr t (value_of t lv)) - (value_of_sub_lvalue t lv se_lv) - ee' - (rvalue_to_expr t (value_of t lv')) - | def_sub_expr_subs_deref_l_sub_lvalue: - forall t: type, - forall lv lv': lvalue (pointer t), - forall ee': expr, - forall se_lv: executable_sub_expr (lvalue_to_expr (pointer t) lv), - def_sub_expr_subs (lvalue_to_expr (pointer t) lv) se_lv ee' - (lvalue_to_expr (pointer t) lv') -> - def_sub_expr_subs - (lvalue_to_expr t (deref_l t lv)) - (deref_l_sub_lvalue t lv se_lv) - ee' - (lvalue_to_expr t (deref_l t lv')) - | def_sub_expr_subs_deref_r_sub_rvalue: - forall t: type, - forall rv rv': rvalue (pointer t), - forall ee': expr, - forall se_rv: executable_sub_expr (rvalue_to_expr (pointer t) rv), - def_sub_expr_subs (rvalue_to_expr (pointer t) rv) se_rv ee' - (rvalue_to_expr (pointer t) rv') -> - def_sub_expr_subs - (lvalue_to_expr t (deref_r t rv)) - (deref_r_sub_rvalue t rv se_rv) - ee' - (lvalue_to_expr t (deref_r t rv')). - -Lemma type_dec: forall t t': type, {t = t'} + {t <> t'}. -Proof. -intros t. -induction t as [|t IH]. -destruct t'. -tauto. -right. -discriminate. -destruct t'. -right. -discriminate. -destruct (IH t') as [H|H]. -left. -f_equal. -tauto. -right. -injection. -tauto. -Qed. -Check type_dec. - -Definition sigT_get_proof: - forall T: Type, - forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, - forall P: T -> Type, - forall t: T, - P t -> - sigT P -> - P t. -intros T eq_dec_T P t H1 H2. -destruct H2 as [t' H2]. -destruct (eq_dec_T t t') as [H3|H3]. -rewrite H3. -exact H2. -exact H1. -Defined. - -Axiom sigT_get_proof_existT_same: - forall T: Type, - forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, - forall P: T -> Type, - forall t: T, - forall H1 H2: P t, - sigT_get_proof T eq_dec_T P t H1 (existT P t H2) = H2. - -Theorem existT_injective: - forall T, - (forall t1 t2: T, { t1 = t2 } + { t1 <> t2 }) -> - forall P: T -> Type, - forall t: T, - forall pt1 pt2: P t, - existT P t pt1 = existT P t pt2 -> - pt1 = pt2. -Proof. -intros T T_dec P t pt1 pt2 H1. -pose (H2 := f_equal (sigT_get_proof T T_dec P t pt1) H1). -repeat rewrite sigT_get_proof_existT_same in H2. -assumption. -Qed. - -Ltac decide_equality_sub dec x x' H := - destruct (dec x x') as [H|H]; - [subst x'; try tauto|try(right; injection; tauto; fail)]. - -Axiom value_set_dec: - forall t: type, - forall v v': value_set t, - {v = v'} + {v <> v'}. - -Theorem lvalue_dec: - forall (t: type) (l l': lvalue t), {l = l'} + {l <> l'} -with rvalue_dec: - forall (t: type) (r r': rvalue t), {r = r'} + {r <> r'}. -Admitted. - -Theorem sub_expr_subs_same_kind: - forall e: expr, - forall ee: executable_sub_expr e, - forall ee': expr, - forall e': expr, - def_sub_expr_subs e ee ee' e' -> - expr_to_kind e = expr_to_kind e'. -Proof. -intros e ee ee' e' H1. -case H1; try (intros; tauto; fail). -Qed. - -Theorem def_sub_expr_subs_assign_sub_lvalue_inversion: - forall t: type, - forall lv: lvalue t, - forall rv: rvalue t, - forall ee' e': expr, - forall ee_sub: executable_sub_expr (lvalue_to_expr t lv), - def_sub_expr_subs (statement_to_expr (assign t lv rv)) - (assign_sub_lvalue t lv rv ee_sub) ee' e' -> - { lv': lvalue t - | def_sub_expr_subs (lvalue_to_expr t lv) ee_sub ee' - (lvalue_to_expr t lv') - & e' = statement_to_expr (assign t lv' rv) }. -Proof. -intros t lv rv ee' [s'|t' lv''|t' rv''] ee_sub H1; - try discriminate (sub_expr_subs_same_kind _ _ _ _ H1). -destruct s' as [| | | |t' lv'' rv''| | | |]; - try(assert (H2: False); [inversion H1|elim H2]; fail). -destruct (type_dec t t') as [H2|H2]; - [|assert (H3: False); - [|elim H3; fail]]. -2: inversion H1 as [];tauto. -subst t'. -exists lv''. - inversion H1 as - [| |t' lv''' lv'''' rv''' ee'' ee_sub' H2 (H3_1,H3_2,H3_3) (H4_1,H4_2,H4_3,H4_4,H4_5) H5 (H6_1,H6_2)| | | |]. -(* Check that all names are the given ones: *) -clear t' lv''' lv'''' rv''' ee'' ee_sub' H2 H3_1 H3_2 H3_3 H4_1 H4_2 H4_3 H4_4 H4_5 H5 H6_1 H6_2. diff --git a/test-suite/bugs/closed/2193.v b/test-suite/bugs/closed/2193.v deleted file mode 100644 index fe2588676d..0000000000 --- a/test-suite/bugs/closed/2193.v +++ /dev/null @@ -1,31 +0,0 @@ -(* Computation of dependencies in the "match" return predicate was incomplete *) -(* Submitted by R. O'Connor, Nov 2009 *) - -Inductive Symbol : Set := - | VAR : Symbol. - -Inductive SExpression := - | atomic : Symbol -> SExpression. - -Inductive ProperExpr : SExpression -> SExpression -> Type := - | pe_3 : forall (x : Symbol) (alpha : SExpression), - ProperExpr alpha (atomic VAR) -> - ProperExpr (atomic x) alpha. - -Definition A (P : forall s : SExpression, Type) - (x alpha alpha1 : SExpression) - (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := - match t as pe in ProperExpr a b return option (a = atomic VAR) with - | pe_3 x0 alpha3 tye' => - (fun (x:Symbol) (alpha : SExpression) => @None (atomic x = atomic VAR)) - x0 alpha3 - end. - -Definition B (P : forall s : SExpression, Type) - (x alpha alpha1 : SExpression) - (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := - match t as pe in ProperExpr a b return option (a = atomic VAR) with - | pe_3 x0 alpha3 tye' => - (fun (x:Symbol) (alpha : SExpression) (t:ProperExpr alpha (atomic VAR)) => @None (atomic x = atomic VAR)) - x0 alpha3 tye' - end. diff --git a/test-suite/bugs/closed/2243.v b/test-suite/bugs/closed/2243.v deleted file mode 100644 index 6d45c9a09e..0000000000 --- a/test-suite/bugs/closed/2243.v +++ /dev/null @@ -1,9 +0,0 @@ -Inductive is_nul: nat -> Prop := X: is_nul 0. -Section O. -Variable u: nat. -Variable H: is_nul u. -Goal True. -Proof. -destruct H. -Undo. -revert H; intro H; destruct H. diff --git a/test-suite/bugs/closed/2244.v b/test-suite/bugs/closed/2244.v deleted file mode 100644 index d499e515fe..0000000000 --- a/test-suite/bugs/closed/2244.v +++ /dev/null @@ -1,19 +0,0 @@ -(* 1st-order unification did not work when in competition with pattern unif. *) - -Set Implicit Arguments. -Lemma test : forall - (A : Type) - (B : Type) - (f : A -> B) - (S : B -> Prop) - (EV : forall y (f':A->B), (forall x', S (f' x')) -> S (f y)) - (HS : forall x', S (f x')) - (x : A), - S (f x). -Proof. - intros. eapply EV. intros. - (* worked in v8.2 but not in v8.3beta, fixed in r12898 *) - apply HS. - - (* still not compatible with 8.2 because an evar can be solved in - two different ways and is left open *) diff --git a/test-suite/bugs/closed/2255.v b/test-suite/bugs/closed/2255.v deleted file mode 100644 index bf80ff6607..0000000000 --- a/test-suite/bugs/closed/2255.v +++ /dev/null @@ -1,21 +0,0 @@ -(* Check injection in presence of dependencies hidden in applicative terms *) - -Inductive TupleT : nat -> Type := - nilT : TupleT 0 -| consT {n} A : (A -> TupleT n) -> TupleT (S n). - -Inductive Tuple : forall n, TupleT n -> Type := - nil : Tuple _ nilT -| cons {n} A (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). - -Goal forall n A F x X n0 A0 x0 F0 H0 (H : existT (fun n0 : nat => {H0 : TupleT -n0 & Tuple n0 H0}) - (S n0) - (existT (fun H0 : TupleT (S n0) => Tuple (S n0) H0) - (consT A0 F0) (cons A0 x0 F0 H0)) = - existT (fun n0 : nat => {H0 : TupleT n0 & Tuple n0 H0}) - (S n) - (existT (fun H0 : TupleT (S n) => Tuple (S n) H0) - (consT A F) (cons A x F X))), False. -intros. -injection H. diff --git a/test-suite/bugs/closed/2262.v b/test-suite/bugs/closed/2262.v deleted file mode 100644 index b61f18b837..0000000000 --- a/test-suite/bugs/closed/2262.v +++ /dev/null @@ -1,11 +0,0 @@ - - -Generalizable Variables A. -Class Test A := { test : A }. - -Lemma mylemma : forall `{Test A}, test = test. -Admitted. (* works fine *) - -Definition mylemma' := forall `{Test A}, test = test. -About mylemma'. - diff --git a/test-suite/bugs/closed/2295.v b/test-suite/bugs/closed/2295.v deleted file mode 100644 index f5ca28dcaa..0000000000 --- a/test-suite/bugs/closed/2295.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Check if omission of "as" in return clause works w/ section variables too *) - -Section sec. - -Variable b: bool. - -Definition d' := - (match b return b = true \/ b = false with - | true => or_introl _ (refl_equal true) - | false => or_intror _ (refl_equal false) - end). diff --git a/test-suite/bugs/closed/2299.v b/test-suite/bugs/closed/2299.v deleted file mode 100644 index c0552ca7b3..0000000000 --- a/test-suite/bugs/closed/2299.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Check that destruct refreshes universes in what it generalizes *) - -Section test. - -Variable A: Type. - -Inductive T: unit -> Type := C: A -> unit -> T tt. - -Let unused := T tt. - -Goal T tt -> False. - intro X. - destruct X. diff --git a/test-suite/bugs/closed/2304.v b/test-suite/bugs/closed/2304.v deleted file mode 100644 index 1ac2702b0a..0000000000 --- a/test-suite/bugs/closed/2304.v +++ /dev/null @@ -1,4 +0,0 @@ -(* This used to fail with an anomaly NotASort at some time *) -Class A (O: Type): Type := a: O -> Type. -Fail Goal forall (x: a tt), @a x = @a x. - diff --git a/test-suite/bugs/closed/2307.v b/test-suite/bugs/closed/2307.v deleted file mode 100644 index 7c04949539..0000000000 --- a/test-suite/bugs/closed/2307.v +++ /dev/null @@ -1,3 +0,0 @@ -Inductive V: nat -> Type := VS n: V (S n). -Definition f (e: V 1): nat := match e with VS 0 => 3 end. - diff --git a/test-suite/bugs/closed/2320.v b/test-suite/bugs/closed/2320.v deleted file mode 100644 index facb9ecfc9..0000000000 --- a/test-suite/bugs/closed/2320.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Managing metavariables in the return clause of a match *) - -(* This was working in 8.1 but is failing in 8.2 and 8.3. It works in - trunk thanks to the new proof engine. It could probably made to work in - 8.2 and 8.3 if a return predicate of the form "dummy 0" instead of - (or in addition to) a sophisticated predicate of the form - "as x in dummy y return match y with 0 => ?P | _ => ID end" *) - -Inductive dummy : nat -> Prop := constr : dummy 0. - -Lemma failure : forall (x : dummy 0), x = constr. -Proof. -intros x. -refine (match x with constr => _ end). diff --git a/test-suite/bugs/closed/2342.v b/test-suite/bugs/closed/2342.v deleted file mode 100644 index 6613b28571..0000000000 --- a/test-suite/bugs/closed/2342.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Checking that the type inference algoithme does not commit to an - equality over sorts when only a subtyping constraint is around *) - -Parameter A : Set. -Parameter B : A -> Set. -Parameter F : Set -> Prop. -Check (F (forall x, B x)). - diff --git a/test-suite/bugs/closed/2347.v b/test-suite/bugs/closed/2347.v deleted file mode 100644 index e433f158e4..0000000000 --- a/test-suite/bugs/closed/2347.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import EquivDec List. -Generalizable All Variables. - -Program Definition list_eqdec `(eqa : EqDec A eq) : EqDec (list A) eq := - (fun (x y : list A) => _). -Admit Obligations of list_eqdec. - -Program Definition list_eqdec' `(eqa : EqDec A eq) : EqDec (list A) eq := - (fun _ : nat => (fun (x y : list A) => _)) 0. -Admit Obligations of list_eqdec'. diff --git a/test-suite/bugs/closed/2350.v b/test-suite/bugs/closed/2350.v deleted file mode 100644 index e91f22e267..0000000000 --- a/test-suite/bugs/closed/2350.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Check that the fix tactic, when called from refine, reduces enough - to see the products *) - -Definition foo := forall n:nat, n=n. -Definition bar : foo. -refine (fix aux (n:nat) := _). diff --git a/test-suite/bugs/closed/2360.v b/test-suite/bugs/closed/2360.v deleted file mode 100644 index 4ae97c97bb..0000000000 --- a/test-suite/bugs/closed/2360.v +++ /dev/null @@ -1,13 +0,0 @@ -(* This failed in V8.3 because descend_in_conjunctions built ill-typed terms *) -Definition interp (etyp : nat -> Type) (p: nat) := etyp p. - -Record Value (etyp : nat -> Type) := Mk { - typ : nat; - value : interp etyp typ -}. - -Definition some_value (etyp : nat -> Type) : (Value etyp). -Proof. - intros. - Fail apply Mk. (* Check that it does not raise an anomaly *) - diff --git a/test-suite/bugs/closed/2362.v b/test-suite/bugs/closed/2362.v deleted file mode 100644 index 10e86cd12d..0000000000 --- a/test-suite/bugs/closed/2362.v +++ /dev/null @@ -1,38 +0,0 @@ -Set Implicit Arguments. - -Class Pointed (M:Type -> Type) := -{ - creturn: forall {A: Type}, A -> M A -}. - -Unset Implicit Arguments. -Inductive FPair (A B:Type) (neutral: B) : Type:= - fpair : forall (a:A) (b:B), FPair A B neutral. -Arguments fpair {A B neutral}. - -Set Implicit Arguments. - -Notation "( x ,> y )" := (fpair x y) (at level 0). - -Instance Pointed_FPair B neutral: - Pointed (fun A => FPair A B neutral) := - { creturn := fun A (a:A) => (a,> neutral) }. -Definition blah_fail (x:bool) : FPair bool nat O := - creturn x. -Set Printing All. Print blah_fail. - -Definition blah_explicit (x:bool) : FPair bool nat O := - @creturn _ (Pointed_FPair _ ) _ x. - -Print blah_explicit. - - -Instance Pointed_FPair_mono: - Pointed (fun A => FPair A nat 0) := - { creturn := fun A (a:A) => (a,> 0) }. - - -Definition blah (x:bool) : FPair bool nat O := - creturn x. - - diff --git a/test-suite/bugs/closed/2375.v b/test-suite/bugs/closed/2375.v deleted file mode 100644 index c17c426cda..0000000000 --- a/test-suite/bugs/closed/2375.v +++ /dev/null @@ -1,18 +0,0 @@ -(* In the following code, the (superfluous) lemma [lem] is responsible -for the failure of congruence. *) - -Definition f : nat -> Prop := fun x => True. - -Lemma lem : forall x, (True -> True) = ( True -> f x). -Proof. - intros. reflexivity. -Qed. - -Goal forall (x:nat), x = x. -Proof. - intros. - assert (lem := lem). - (*clear ax.*) - congruence. -Qed. - diff --git a/test-suite/bugs/closed/2378.v b/test-suite/bugs/closed/2378.v deleted file mode 100644 index b9dd654057..0000000000 --- a/test-suite/bugs/closed/2378.v +++ /dev/null @@ -1,610 +0,0 @@ -Require Import TestSuite.admit. -(* test with Coq 8.3rc1 *) - -Require Import Program. - -Inductive Unit: Set := unit: Unit. - -Definition eq_dec T := forall x y:T, {x=y}+{x<>y}. - -Section TTS_TASM. - -Variable Time: Set. -Variable Zero: Time. -Variable tle: Time -> Time -> Prop. -Variable tlt: Time -> Time -> Prop. -Variable tadd: Time -> Time -> Time. -Variable tsub: Time -> Time -> Time. -Variable tmin: Time -> Time -> Time. -Notation "t1 @<= t2" := (tle t1 t2) (at level 70, no associativity). -Notation "t1 @< t2" := (tlt t1 t2) (at level 70, no associativity). -Notation "t1 @+ t2" := (tadd t1 t2) (at level 50, left associativity). -Notation "t1 @- t2" := (tsub t1 t2) (at level 50, left associativity). -Notation "t1 @<= t2 @<= t3" := ((tle t1 t2) /\ (tle t2 t3)) (at level 70, t2 at next level). -Notation "t1 @<= t2 @< t3" := ((tle t1 t2) /\ (tlt t2 t3)) (at level 70, t2 at next level). - -Variable tzerop: forall n, (n = Zero) + {Zero @< n}. -Variable tlt_eq_gt_dec: forall x y, {x @< y} + {x=y} + {y @< x}. -Variable tle_plus_l: forall n m, n @<= n @+ m. -Variable tle_lt_eq_dec: forall n m, n @<= m -> {n @< m} + {n = m}. - -Variable tzerop_zero: tzerop Zero = inleft (Zero @< Zero) (@eq_refl _ Zero). -Variable tplus_n_O: forall n, n @+ Zero = n. -Variable tlt_le_weak: forall n m, n @< m -> n @<= m. -Variable tlt_irrefl: forall n, ~ n @< n. -Variable tplus_nlt: forall n m, ~n @+ m @< n. -Variable tle_n: forall n, n @<= n. -Variable tplus_lt_compat_l: forall n m p, n @< m -> p @+ n @< p @+ m. -Variable tlt_trans: forall n m p, n @< m -> m @< p -> n @< p. -Variable tle_lt_trans: forall n m p, n @<= m -> m @< p -> n @< p. -Variable tlt_le_trans: forall n m p, n @< m -> m @<= p -> n @< p. -Variable tle_refl: forall n, n @<= n. -Variable tplus_le_0: forall n m, n @+ m @<= n -> m = Zero. -Variable Time_eq_dec: eq_dec Time. - -(*************************************************************) - -Section PropLogic. -Variable Predicate: Type. - -Inductive LP: Type := - LPPred: Predicate -> LP -| LPAnd: LP -> LP -> LP -| LPNot: LP -> LP. - -Variable State: Type. -Variable Sat: State -> Predicate -> Prop. - -Fixpoint lpSat st f: Prop := - match f with - LPPred p => Sat st p - | LPAnd f1 f2 => lpSat st f1 /\ lpSat st f2 - | LPNot f1 => ~lpSat st f1 - end. -End PropLogic. - -Arguments lpSat : default implicits. - -Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := - match f with - LPPred _ p => p2lp p - | LPAnd _ f1 f2 => LPAnd _ (LPTransfo Pred1 Pred2 p2lp f1) (LPTransfo Pred1 Pred2 p2lp f2) - | LPNot _ f1 => LPNot _ (LPTransfo Pred1 Pred2 p2lp f1) - end. -Arguments LPTransfo : default implicits. - -Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := - LPTransfo (fun p => LPPred _ (existT (fun i => Pred i) i p)) f. - -Section TTS. - -Variable State: Type. - -Record TTS: Type := mkTTS { - Init: State -> Prop; - Delay: State -> Time -> State -> Prop; - Next: State -> State -> Prop; - Predicate: Type; - Satisfy: State -> Predicate -> Prop -}. - -Definition TTSIndexedProduct Ind (tts: Ind -> TTS): TTS := mkTTS - (fun st => forall i, Init (tts i) st) - (fun st d st' => forall i, Delay (tts i) st d st') - (fun st st' => forall i, Next (tts i) st st') - { i: Ind & Predicate (tts i) } - (fun st p => Satisfy (tts (projT1 p)) st (projT2 p)). - -End TTS. - -Section SIMU_F. - -Variables StateA StateC: Type. - -Record mapping: Type := mkMapping { - mState: Type; - mInit: StateC -> mState; - mNext: mState -> StateC -> mState; - mDelay: mState -> StateC -> Time -> mState; - mabs: mState -> StateC -> StateA -}. - -Variable m: mapping. - -Record simu (Pred: Type) (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuPrf { - inv: (mState m) -> StateC -> Prop; - invInit: forall st, Init _ c st -> inv (mInit m st) st; - invDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> inv (mDelay m ex1 st1 d) st2; - invNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> inv (mNext m ex1 st1) st2; - simuInit: forall st, Init _ c st -> Init _ a (mabs m (mInit m st) st); - simuDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> - Delay _ a (mabs m ex1 st1) d (mabs m (mDelay m ex1 st1 d) st2); - simuNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> - Next _ a (mabs m ex1 st1) (mabs m (mNext m ex1 st1) st2); - simuPred: forall ext st, inv ext st -> - (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) -}. - -Theorem satProd: forall State Ind Pred (Sat: forall i, State -> Pred i -> Prop) (st:State) i (f: LP (Pred i)), - lpSat (Sat i) st f - <-> - lpSat - (fun (st : State) (p : {i : Ind & Pred i}) => Sat (projT1 p) st (projT2 p)) st - (addIndex Ind _ i f). -Proof. - induction f; simpl; intros; split; intros; intuition. -Qed. - -Definition trProd (State: Type) Ind (Pred: Ind -> Type) (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))): - {i:Ind & Pred i} -> LP (Predicate _ (TTSIndexedProduct _ Ind tts)) := - fun p => addIndex Ind _ (projT1 p) (tr (projT1 p) (projT2 p)). - -Arguments trProd : default implicits. -Require Import Setoid. - -Theorem satTrProd: - forall State Ind Pred (tts: Ind -> TTS State) - (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))) (st:State) (p: {i:Ind & (Pred i)}), - lpSat (Satisfy _ (tts (projT1 p))) st (tr (projT1 p) (projT2 p)) - <-> - lpSat (Satisfy _ (TTSIndexedProduct _ _ tts)) st (trProd _ tts tr p). -Proof. - unfold trProd, TTSIndexedProduct; simpl; intros. - rewrite (satProd State Ind (fun i => Predicate State (tts i)) - (fun i => Satisfy _ (tts i))); tauto. -Qed. - -Theorem simuProd: - forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) - (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) - (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> - simu _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) - (trProd Pred tta tra) (trProd Pred ttc trc). -Proof. - intros. - apply simuPrf with (fun ex st => forall i, inv _ _ (ttc i) (tra i) (trc i) (X i) ex st); simpl; intros; auto. - eapply invInit; eauto. - eapply invDelay; eauto. - eapply invNext; eauto. - eapply simuInit; eauto. - eapply simuDelay; eauto. - eapply simuNext; eauto. - split; simpl; intros. - generalize (proj1 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. - rewrite <- (satTrProd StateA Ind Pred tta tra); apply H1. - rewrite (satTrProd StateC Ind Pred ttc trc); apply H0. - - generalize (proj2 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. - rewrite <- (satTrProd StateC Ind Pred ttc trc); apply H1. - rewrite (satTrProd StateA Ind Pred tta tra); apply H0. -Qed. - -End SIMU_F. - -Section TRANSFO. - -Record simu_equiv StateA StateC m1 m2 Pred (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuEquivPrf { - simuLR: simu StateA StateC m1 Pred a c tra trc; - simuRL: simu StateC StateA m2 Pred c a trc tra -}. - -Theorem simu_equivProd: - forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) - (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) - (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> - simu_equiv StateA StateC m1 m2 _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) - (trProd _ _ Pred tta tra) (trProd _ _ Pred ttc trc). -Proof. - intros; split; intros. - apply simuProd; intro. - elim (X i); auto. - apply simuProd; intro. - elim (X i); auto. -Qed. - -Record RTLanguage: Type := mkRTLanguage { - Syntax: Type; - DynamicState: Syntax -> Type; - Semantic: forall (mdl:Syntax), TTS (DynamicState mdl); - MdlPredicate: Syntax -> Type; - MdlPredicateDefinition: forall mdl, MdlPredicate mdl -> LP (Predicate _ (Semantic mdl)) -}. - -Record Transformation (l1 l2: RTLanguage): Type := mkTransformation { - Tmodel: Syntax l1 -> Syntax l2; - Tl1l2: forall mdl, mapping (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)); - Tl2l1: forall mdl, mapping (DynamicState l2 (Tmodel mdl)) (DynamicState l1 mdl); - Tpred: forall mdl, MdlPredicate l1 mdl -> LP (MdlPredicate l2 (Tmodel mdl)); - Tsim: forall mdl, simu_equiv (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)) (Tl1l2 mdl) (Tl2l1 mdl) - (MdlPredicate l1 mdl) (Semantic l1 mdl) (Semantic l2 (Tmodel mdl)) - (MdlPredicateDefinition l1 mdl) - (fun p => LPTransfo (MdlPredicateDefinition l2 (Tmodel mdl)) (Tpred mdl p)) -}. - -Section Product. - -Record PSyntax (L: RTLanguage): Type := mkPSyntax { - pIndex: Type; - pIsEmpty: pIndex + {pIndex -> False}; - pState: Type; - pComponents: pIndex -> Syntax L; - pIsShared: forall i, DynamicState L (pComponents i) = pState -}. - -Definition pPredicate (L: RTLanguage) (sys: PSyntax L) := { i : pIndex L sys & MdlPredicate L (pComponents L sys i)}. - -(* product with shared state *) - -Definition PLanguage (L: RTLanguage): RTLanguage := - mkRTLanguage - (PSyntax L) - (pState L) - (fun mdl => TTSIndexedProduct (pState L mdl) (pIndex L mdl) - (fun i => match pIsShared L mdl i in (_ = y) return TTS y with - eq_refl => Semantic L (pComponents L mdl i) - end)) - (pPredicate L) - (fun mdl => trProd _ _ _ _ - (fun i pi => match pIsShared L mdl i as e in (_ = y) return - (LP (Predicate y - match e in (_ = y0) return (TTS y0) with - | eq_refl => Semantic L (pComponents L mdl i) - end)) - with - | eq_refl => MdlPredicateDefinition L (pComponents L mdl i) pi - end)). - -Inductive Empty: Type :=. - -Record isSharedTransfo l1 l2 tr: Prop := isSharedTransfoPrf { -sameState: forall mdl i j, - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j)); -sameMState: forall mdl i j, - mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl i)) = - mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl j)); -sameM12: forall mdl i j, - Tl1l2 _ _ tr (pComponents l1 mdl i) = - match sym_eq (sameState mdl i j) in _=y return mapping _ y with - eq_refl => match sym_eq (pIsShared l1 mdl i) in _=x return mapping x _ with - eq_refl => match pIsShared l1 mdl j in _=x return mapping x _ with - eq_refl => Tl1l2 _ _ tr (pComponents l1 mdl j) - end - end - end; -sameM21: forall mdl i j, - Tl2l1 l1 l2 tr (pComponents l1 mdl i) = - match - sym_eq (sameState mdl i j) in (_ = y) - return (mapping y (DynamicState l1 (pComponents l1 mdl i))) - with eq_refl => - match - sym_eq (pIsShared l1 mdl i) in (_ = y) - return - (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) - with - | eq_refl => - match - pIsShared l1 mdl j in (_ = y) - return - (mapping - (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) - with - | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl j) - end - end -end -}. - -Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := - mkPSyntax l2 (pIndex l1 mdl) - (pIsEmpty l1 mdl) - (match pIsEmpty l1 mdl return Type with - inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - |inright h => pState l1 mdl - end) - (fun i => Tmodel l1 l2 tr (pComponents l1 mdl i)) - (fun i => match pIsEmpty l1 mdl as y return - (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = - match y with - | inleft i0 => - DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i0)) - | inright _ => pState l1 mdl - end) - with - inleft j => sameState l1 l2 tr h mdl i j - | inright h => match h i with end - end). - -Definition compSemantic l mdl i := - match pIsShared l mdl i in (_=y) return TTS y with - eq_refl => Semantic l (pComponents l mdl i) - end. - -Definition compSemanticEq l mdl i s (e: DynamicState l (pComponents l mdl i) = s) := - match e in (_=y) return TTS y with - eq_refl => Semantic l (pComponents l mdl i) - end. - -Definition Pmap12 l1 l2 tr (h: isSharedTransfo l1 l2 tr) (mdl : PSyntax l1) := -match - pIsEmpty l1 mdl as s - return - (mapping (pState l1 mdl) - match s with - | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - | inright _ => pState l1 mdl - end) -with -| inleft p => - match - pIsShared l1 mdl p in (_ = y) - return - (mapping y (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p)))) - with - | eq_refl => Tl1l2 l1 l2 tr (pComponents l1 mdl p) - end -| inright _ => - mkMapping (pState l1 mdl) (pState l1 mdl) Unit - (fun _ : pState l1 mdl => unit) - (fun (_ : Unit) (_ : pState l1 mdl) => unit) - (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) - (fun (_ : Unit) (X : pState l1 mdl) => X) -end. - -Definition Pmap21 l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl := -match - pIsEmpty l1 mdl as s - return - (mapping - match s with - | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - | inright _ => pState l1 mdl - end (pState l1 mdl)) -with -| inleft p => - match - pIsShared l1 mdl p in (_ = y) - return - (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) y) - with - | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl p) - end -| inright _ => - mkMapping (pState l1 mdl) (pState l1 mdl) Unit - (fun _ : pState l1 mdl => unit) - (fun (_ : Unit) (_ : pState l1 mdl) => unit) - (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) - (fun (_ : Unit) (X : pState l1 mdl) => X) -end. - -Definition PTpred l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl (pp : pPredicate l1 mdl): - LP (MdlPredicate (PLanguage l2) (PTransfoSyntax l1 l2 tr h mdl)) := -match pIsEmpty l1 mdl with -| inleft _ => - let (x, p) := pp in - addIndex (pIndex l1 mdl) (fun i => MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) x - (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl x)) - (LPPred (MdlPredicate l1 (pComponents l1 mdl x)) p)) -| inright f => match f (projT1 pp) with end -end. - -Lemma simu_eqA: - forall A1 A2 C m P sa sc tta ttc (h: A2=A1), - simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) - P (match h in (_=y) return TTS y with eq_refl => sa end) - sc (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => tta p end) - ttc -> - simu A2 C m P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqC: - forall A C1 C2 m P sa sc tta ttc (h: C2=C1), - simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) - P sa (match h in (_=y) return TTS y with eq_refl => sc end) - tta (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => ttc p end) - -> - simu A C2 m P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqA1: - forall A1 A2 C m P sa sc tta ttc (h: A1=A2), - simu A1 C m - P - (match (sym_eq h) in (_=y) return TTS y with eq_refl => sa end) sc - (fun p => match (sym_eq h) as e in (_=y) return LP (Predicate y (match e in (_=z) return TTS z with eq_refl => sa end)) with eq_refl => tta p end) ttc - -> - simu A2 C (match h in (_=y) return mapping _ C with eq_refl => m end) P sa sc tta ttc. -admit. -Qed. - -Lemma simu_eqA2: - forall A1 A2 C m P sa sc tta ttc (h: A1=A2), - simu A1 C (match (sym_eq h) in (_=y) return mapping _ C with eq_refl => m end) - P - sa sc tta ttc - -> - simu A2 C m P - (match h in (_=y) return TTS y with eq_refl => sa end) sc - (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sa end) with eq_refl => tta p end) - ttc. -admit. -Qed. - -Lemma simu_eqC2: - forall A C1 C2 m P sa sc tta ttc (h: C1=C2), - simu A C1 (match (sym_eq h) in (_=y) return mapping A _ with eq_refl => m end) - P - sa sc tta ttc - -> - simu A C2 m P - sa (match h in (_=y) return TTS y with eq_refl => sc end) - tta (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sc end) with eq_refl => ttc p end). -admit. -Qed. - -Lemma simu_eqM: - forall A C m1 m2 P sa sc tta ttc (h: m1=m2), - simu A C m1 P sa sc tta ttc - -> - simu A C m2 P sa sc tta ttc. -admit. -Qed. - -Lemma LPTransfo_trans: - forall Pred1 Pred2 Pred3 (tr1: Pred1 -> LP Pred2) (tr2: Pred2 -> LP Pred3) f, - LPTransfo tr2 (LPTransfo tr1 f) = LPTransfo (fun x => LPTransfo tr2 (tr1 x)) f. -Proof. - admit. -Qed. - -Lemma LPTransfo_addIndex: - forall Ind Pred tr1 x (tr2: forall i, Pred i -> LP (tr1 i)) (p: LP (Pred x)), - addIndex Ind tr1 x (LPTransfo (tr2 x) p) = - LPTransfo - (fun p0 : {i : Ind & Pred i} => - addIndex Ind tr1 (projT1 p0) (tr2 (projT1 p0) (projT2 p0))) - (addIndex Ind Pred x p). -Proof. - unfold addIndex; intros. - rewrite LPTransfo_trans. - rewrite LPTransfo_trans. - simpl. - auto. -Qed. - -Record tr_compat I0 I1 tr := compatPrf { - and_compat: forall p1 p2, tr (LPAnd I0 p1 p2) = LPAnd I1 (tr p1) (tr p2); - not_compat: forall p, tr (LPNot I0 p) = LPNot I1 (tr p) -}. - -Lemma LPTransfo_addIndex_tr: - forall Ind Pred tr0 tr1 x (tr2: forall i, Pred i -> LP (tr0 i)) (tr3: forall i, LP (tr0 i) -> LP (tr1 i)) (p: LP (Pred x)), - (forall x, tr_compat (tr0 x) (tr1 x) (tr3 x)) -> - addIndex Ind tr1 x (tr3 x (LPTransfo (tr2 x) p)) = - LPTransfo - (fun p0 : {i : Ind & Pred i} => - addIndex Ind tr1 (projT1 p0) (tr3 (projT1 p0) (tr2 (projT1 p0) (projT2 p0)))) - (addIndex Ind Pred x p). -Proof. - unfold addIndex; simpl; intros. - rewrite LPTransfo_trans; simpl. - rewrite <- LPTransfo_trans. - f_equal. - induction p; simpl; intros; auto. - rewrite (and_compat _ _ _ (H x)). - rewrite <- IHp1, <- IHp2; auto. - rewrite <- IHp. - rewrite (not_compat _ _ _ (H x)); auto. -Qed. - -Require Export Coq.Logic.FunctionalExtensionality. -Print PLanguage. - -Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): -Transformation (PLanguage l1) (PLanguage l2) := - mkTransformation (PLanguage l1) (PLanguage l2) - (PTransfoSyntax l1 l2 tr h) - (Pmap12 l1 l2 tr h) - (Pmap21 l1 l2 tr h) - (PTpred l1 l2 tr h) - (fun mdl => simu_equivProd - (pState l1 mdl) - (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) - (Pmap12 l1 l2 tr h mdl) - (Pmap21 l1 l2 tr h mdl) - (pIndex l1 mdl) - (fun i => MdlPredicate l1 (pComponents l1 mdl i)) - (compSemantic l1 mdl) - (compSemantic l2 (PTransfoSyntax l1 l2 tr h mdl)) - _ - _ - _ - ). - -Next Obligation. - unfold compSemantic, PTransfoSyntax; simpl. - case (pIsEmpty l1 mdl); simpl; intros. - unfold pPredicate; simpl. - unfold pPredicate in X; simpl in X. - case (sameState l1 l2 tr h mdl i p). - apply (LPTransfo (MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). - apply (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl i))). - apply (LPPred _ X). - - apply False_rect; apply (f i). -Defined. - -Next Obligation. - split; intros. - unfold Pmap12; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - case (pIsEmpty l1 mdl); intros. - apply simu_eqA2. - apply simu_eqC2. - apply simu_eqM with (Tl1l2 l1 l2 tr (pComponents l1 mdl i)). - apply sameM12. - apply (simuLR _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. - - apply False_rect; apply (f i). - - unfold Pmap21; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - case (pIsEmpty l1 mdl); intros. - apply simu_eqC2. - apply simu_eqA2. - apply simu_eqM with (Tl2l1 l1 l2 tr (pComponents l1 mdl i)). - apply sameM21. - apply (simuRL _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. - - apply False_rect; apply (f i). -Qed. - -Next Obligation. - unfold trProd; simpl. - unfold PTransfo_obligation_1; simpl. - unfold compSemantic; simpl. - unfold eq_ind, eq_rect, f_equal; simpl. - apply functional_extensionality; intro. - case x; clear x; intros. - unfold PTpred; simpl. - case (pIsEmpty l1 mdl); simpl; intros. - set (tr0 i := - Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) - (Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). - set (tr1 i := - Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) - match sameState l1 l2 tr h mdl i p in (_ = y) return (TTS y) with - | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) - end). - set (tr2 x := MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). - set (Pred x := MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). - set (tr3 x f := match - sameState l1 l2 tr h mdl x p as e in (_ = y) - return - (LP - (Predicate y - match e in (_ = y0) return (TTS y0) with - | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl x)) - end)) - with - | eq_refl => f - end). - apply (LPTransfo_addIndex_tr _ Pred tr0 tr1 x tr2 tr3 - (Tpred l1 l2 tr (pComponents l1 mdl x) m)). - unfold tr0, tr1, tr3; intros; split; simpl; intros; auto. - case (sameState l1 l2 tr h mdl x0 p); auto. - case (sameState l1 l2 tr h mdl x0 p); auto. - - apply False_rect; apply (f x). -Qed. - -End Product. diff --git a/test-suite/bugs/closed/2388.v b/test-suite/bugs/closed/2388.v deleted file mode 100644 index c792671193..0000000000 --- a/test-suite/bugs/closed/2388.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Error message was not printed in the correct environment *) - -Fail Parameters (A:Prop) (a:A A). - -(* This is a variant (reported as part of bug #2347) *) - -Require Import EquivDec. -Fail Program Instance bool_eq_eqdec : EqDec bool eq := - {equiv_dec x y := (fix aux (x y : bool) {struct x}:= aux _ y) x y}. - diff --git a/test-suite/bugs/closed/2404.v b/test-suite/bugs/closed/2404.v deleted file mode 100644 index f6ec676014..0000000000 --- a/test-suite/bugs/closed/2404.v +++ /dev/null @@ -1,46 +0,0 @@ -(* Check that dependencies in the indices of the type of the terms to - match are taken into account and correctly generalized *) - -Require Import Relations.Relation_Definitions. -Require Import Basics. - -Record Base := mkBase - {(* Primitives *) - World : Set - (* Names are real, links are theoretical *) - ; Name : World -> Set - - ; wweak : World -> World -> Prop - - ; exportw : forall a b : World, (wweak a b) -> (Name b) -> option (Name a) -}. - -Section Derived. - Variable base : Base. - Definition bWorld := World base. - Definition bName := Name base. - Definition bexportw := exportw base. - Definition bwweak := wweak base. - - Arguments bexportw [a b]. - -Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type := - starReflS : forall a, RstarSetProof T a a -| starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k. - -Arguments starTransS [I T i j k]. - -Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))). - -Definition bwweakFlip (b a : bWorld) : Prop := (bwweak a b). -Definition Rweak : forall a b : bWorld, Type := RstarInv bwweak. - -Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) := - match aRWb,y with - | starReflS _ a, y' => Some y' - | starTransS jWk jRWi, y' => - match (bexportw jWk y) with - | Some x => exportRweak jRWi x - | None => None - end - end. diff --git a/test-suite/bugs/closed/2473.v b/test-suite/bugs/closed/2473.v deleted file mode 100644 index 0e7c0c25fa..0000000000 --- a/test-suite/bugs/closed/2473.v +++ /dev/null @@ -1,40 +0,0 @@ -Require Import TestSuite.admit. - -Require Import Relations Program Setoid Morphisms. - -Section S1. - Variable R: nat -> relation bool. - Instance HR1: forall n, Transitive (R n). Admitted. - Instance HR2: forall n, Symmetric (R n). Admitted. - Hypothesis H: forall n a, R n (andb a a) a. - Goal forall n a b, R n b a. - intros. - (* rewrite <- H. *) (* Anomaly: Evar ?.. was not declared. Please report. *) - (* idem with setoid_rewrite *) -(* assert (HR2' := HR2 n). *) - rewrite <- H. (* ok *) - admit. - Qed. -End S1. - -Section S2. - Variable R: nat -> relation bool. - Instance HR: forall n, Equivalence (R n). Admitted. - Hypothesis H: forall n a, R n (andb a a) a. - Goal forall n a b, R n a b. - intros. rewrite <- H. admit. - Qed. -End S2. - -(* the parametrised relation is required to get the problem *) -Section S3. - Variable R: relation bool. - Instance HR1': Transitive R. Admitted. - Instance HR2': Symmetric R. Admitted. - Hypothesis H: forall a, R (andb a a) a. - Goal forall a b, R b a. - intros. - rewrite <- H. (* ok *) - admit. - Qed. -End S3. diff --git a/test-suite/bugs/closed/2584.v b/test-suite/bugs/closed/2584.v deleted file mode 100644 index b5a723b47f..0000000000 --- a/test-suite/bugs/closed/2584.v +++ /dev/null @@ -1,89 +0,0 @@ -Require Import List. - -Set Implicit Arguments. - -Definition err : Type := unit. - -Inductive res (A: Type) : Type := -| OK: A -> res A -| Error: err -> res A. - -Arguments Error [A]. - -Set Printing Universes. - -Section FOO. - -Inductive ftyp : Type := - | Funit : ftyp - | Ffun : list ftyp -> ftyp - | Fref : area -> ftyp -with area : Type := - | Stored : ftyp -> area -. - -Print ftyp. -(* yields: -Inductive ftyp : Type (* Top.27429 *) := - Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp - with area : Type (* Set *) := Stored : ftyp -> area -*) - -Fixpoint tc_wf_type (ftype: ftyp) {struct ftype}: res unit := - match ftype with - | Funit => OK tt - | Ffun args => - ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := - match ftypes with - | nil => OK tt - | t::ts => - match tc_wf_type t with - | OK tt => tc_wf_types ts - | Error m => Error m - end - end) args) - | Fref a => tc_wf_area a - end -with tc_wf_area (ar:area): res unit := - match ar with - | Stored c => tc_wf_type c - end. - -End FOO. - -Print ftyp. -(* yields: -Inductive ftyp : Type (* Top.27465 *) := - Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp - with area : Set := Stored : ftyp -> area -*) - -Fixpoint tc_wf_type' (ftype: ftyp) {struct ftype}: res unit := - match ftype with - | Funit => OK tt - | Ffun args => - ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := - match ftypes with - | nil => OK tt - | t::ts => - match tc_wf_type' t with - | OK tt => tc_wf_types ts - | Error m => Error m - end - end) args) - | Fref a => tc_wf_area' a - end -with tc_wf_area' (ar:area): res unit := - match ar with - | Stored c => tc_wf_type' c - end. - -(* yields: -Error: -Incorrect elimination of "ar" in the inductive type "area": -the return type has sort "Type (* max(Set, Top.27424) *)" while it -should be "Prop" or "Set". -Elimination of an inductive object of sort Set -is not allowed on a predicate in sort Type -because strong elimination on non-small inductive types leads to paradoxes. -*) diff --git a/test-suite/bugs/closed/2590.v b/test-suite/bugs/closed/2590.v deleted file mode 100644 index 4300de16e0..0000000000 --- a/test-suite/bugs/closed/2590.v +++ /dev/null @@ -1,20 +0,0 @@ -Require Import TestSuite.admit. -Require Import Relation_Definitions RelationClasses Setoid SetoidClass. - -Section Bug. - - Context {A : Type} (R : relation A). - Hypothesis pre : PreOrder R. - Context `{SA : Setoid A}. - - Goal True. - set (SA' := SA). - assert ( forall SA0 : Setoid A, - @PartialOrder A (@equiv A SA0) (@setoid_equiv A SA0) R pre ). - rename SA into SA0. - intro SA. - admit. - admit. -Qed. -End Bug. - diff --git a/test-suite/bugs/closed/2602.v b/test-suite/bugs/closed/2602.v deleted file mode 100644 index 29c8ac16b2..0000000000 --- a/test-suite/bugs/closed/2602.v +++ /dev/null @@ -1,8 +0,0 @@ -Goal exists m, S m > 0. -eexists. -match goal with - | |- context [ S ?a ] => - match goal with - | |- S a > 0 => idtac - end -end. diff --git a/test-suite/bugs/closed/2613.v b/test-suite/bugs/closed/2613.v deleted file mode 100644 index 15f3bf52c3..0000000000 --- a/test-suite/bugs/closed/2613.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import TestSuite.admit. -(* Check that eq_sym is still pointing to Logic.eq_sym after use of Function *) - -Require Import ZArith. -Require Recdef. - -Axiom nat_eq_dec: forall x y : nat, {x=y}+{x<>y}. - -Locate eq_sym. (* Constant Coq.Init.Logic.eq_sym *) - -Function loop (n: nat) {measure (fun x => x) n} : bool := - if nat_eq_dec n 0 then false else loop (pred n). -Proof. - admit. -Defined. - -Check eq_sym eq_refl : 0=0. - diff --git a/test-suite/bugs/closed/2615.v b/test-suite/bugs/closed/2615.v deleted file mode 100644 index 26c0f334d0..0000000000 --- a/test-suite/bugs/closed/2615.v +++ /dev/null @@ -1,17 +0,0 @@ -Require Import TestSuite.admit. -(* This failed with an anomaly in pre-8.4 because of let-in not - properly taken into account in the test for unification pattern *) - -Inductive foo : forall A, A -> Prop := -| foo_intro : forall A x, foo A x. -Lemma bar A B f : foo (A -> B) f -> forall x : A, foo B (f x). -Fail induction 1. - -(* Whether these examples should succeed with a non-dependent return predicate - or fail because there is well-typed return predicate dependent in f - is questionable. As of 25 oct 2011, they succeed *) -refine (fun p => match p with _ => _ end). -Undo. -refine (fun p => match p with foo_intro _ _ => _ end). -admit. -Qed. diff --git a/test-suite/bugs/closed/2616.v b/test-suite/bugs/closed/2616.v deleted file mode 100644 index 8758e32dd8..0000000000 --- a/test-suite/bugs/closed/2616.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Testing ill-typed rewrite which used to succeed in 8.3 *) -Goal - forall (N : nat -> Prop) (g : nat -> sig N) (IN : forall a : sig N, a = g 0), - N 0 -> False. -Proof. -intros. -Fail rewrite IN in H. diff --git a/test-suite/bugs/closed/2680.v b/test-suite/bugs/closed/2680.v deleted file mode 100644 index 0f573a2898..0000000000 --- a/test-suite/bugs/closed/2680.v +++ /dev/null @@ -1,17 +0,0 @@ -(* Tauto bug initially due to wrong test for binary connective *) - -Parameter A B : Type. - -Axiom P : A -> B -> Prop. - -Inductive IP (a : A) (b: B) : Prop := -| IP_def : P a b -> IP a b. - - -Goal forall (a : A) (b : B), IP a b -> ~ IP a b -> False. -Proof. - intros. - tauto. -Qed. - - diff --git a/test-suite/bugs/closed/2713.v b/test-suite/bugs/closed/2713.v deleted file mode 100644 index b5fc74bfa7..0000000000 --- a/test-suite/bugs/closed/2713.v +++ /dev/null @@ -1,17 +0,0 @@ -Set Implicit Arguments. - -Definition pred_le A (P Q : A->Prop) := - forall x, P x -> Q x. - -Lemma pred_le_refl : forall A (P:A->Prop), - pred_le P P. -Proof. unfold pred_le. auto. Qed. - -Hint Resolve pred_le_refl. - -Lemma test : - forall (P1 P2:nat->Prop), - (forall Q, pred_le (fun a => P1 a /\ P2 a) Q -> True) -> - True. -Proof. intros. eapply H. eauto. (* used to work *) - apply pred_le_refl. Qed. diff --git a/test-suite/bugs/closed/2729.v b/test-suite/bugs/closed/2729.v deleted file mode 100644 index c9d65c12c7..0000000000 --- a/test-suite/bugs/closed/2729.v +++ /dev/null @@ -1,115 +0,0 @@ -(* This bug report actually revealed two bugs in the reconstruction of - a term with "match" in the vm *) - -(* A simplified form of the first problem *) - -(* Reconstruction of terms normalized with vm when a constructor has *) -(* let-ins arguments *) - -Record A : Type := C { a := 0 : nat; b : a=a }. -Goal forall d:A, match d with C a b => b end = match d with C a b => b end. -intro. -vm_compute. -(* Now check that it is well-typed *) -match goal with |- ?c = _ => first [let x := type of c in idtac | fail 2] end. -Abort. - -(* A simplified form of the second problem *) - -Parameter P : nat -> Type. - -Inductive box A := Box : A -> box A. - -Axiom com : {m : nat & box (P m) }. - -Lemma L : - (let (w, s) as com' return (com' = com -> Prop) := com in - let (s0) as s0 - return (existT (fun m : nat => box (P m)) w s0 = com -> Prop) := s in - fun _ : existT (fun m : nat => box (P m)) w (Box (P w) s0) = com => - True) eq_refl. -Proof. -vm_compute. -(* Now check that it is well-typed (the "P w" used to be turned into "P s") *) -match goal with |- ?c => first [let x := type of c in idtac | fail 2] end. -Abort. - -(* Then the original report *) - -Require Import Equality. - -Parameter NameSet : Set. -Parameter SignedName : Set. -Parameter SignedName_compare : forall (x y : SignedName), comparison. -Parameter pu_type : NameSet -> NameSet -> Type. -Parameter pu_nameOf : forall {from to : NameSet}, pu_type from to -> SignedName. -Parameter commute : forall {from mid1 mid2 to : NameSet}, - pu_type from mid1 -> pu_type mid1 to - -> pu_type from mid2 -> pu_type mid2 to -> Prop. - -Program Definition castPatchFrom {from from' to : NameSet} - (HeqFrom : from = from') - (p : pu_type from to) - : pu_type from' to - := p. - -Class PatchUniverse : Type := mkPatchUniverse { - - commutable : forall {from mid1 to : NameSet}, - pu_type from mid1 -> pu_type mid1 to -> Prop - := fun {from mid1 to : NameSet} - (p : pu_type from mid1) (q : pu_type mid1 to) => - exists mid2 : NameSet, - exists q' : pu_type from mid2, - exists p' : pu_type mid2 to, - commute p q q' p'; - - commutable_dec : forall {from mid to : NameSet} - (p : pu_type from mid) - (q : pu_type mid to), - {mid2 : NameSet & - { q' : pu_type from mid2 & - { p' : pu_type mid2 to & - commute p q q' p' }}} - + {~(commutable p q)} -}. - -Inductive SequenceBase (pu : PatchUniverse) - : NameSet -> NameSet -> Type - := Nil : forall {cxt : NameSet}, - SequenceBase pu cxt cxt - | Cons : forall {from mid to : NameSet} - (p : pu_type from mid) - (qs : SequenceBase pu mid to), - SequenceBase pu from to. -Arguments Nil [pu cxt]. -Arguments Cons [pu from mid to]. - -Program Fixpoint insertBase {pu : PatchUniverse} - {from mid to : NameSet} - (p : pu_type from mid) - (qs : SequenceBase pu mid to) - : SequenceBase pu from to - := match qs with - | Nil => Cons p Nil - | Cons q qs' => - match SignedName_compare (pu_nameOf p) (pu_nameOf q) with - | Lt => Cons p qs - | _ => match commutable_dec p (castPatchFrom _ q) with - | inleft (existT _ _ (existT _ q' (existT _ p' _))) => Cons q' -(insertBase p' qs') - | inright _ => Cons p qs - end - end - end. - -Lemma insertBaseConsLt {pu : PatchUniverse} - {o op opq opqr : NameSet} - (p : pu_type o op) - (q : pu_type op opq) - (rs : SequenceBase pu opq opqr) - (p_Lt_q : SignedName_compare (pu_nameOf p) (pu_nameOf q) -= Lt) - : insertBase p (Cons q rs) = Cons p (Cons q rs). -Proof. -vm_compute. diff --git a/test-suite/bugs/closed/2775.v b/test-suite/bugs/closed/2775.v deleted file mode 100644 index f1f384bdf7..0000000000 --- a/test-suite/bugs/closed/2775.v +++ /dev/null @@ -1,6 +0,0 @@ -Inductive typ : forall (T:Type), list T -> Type -> Prop := - | Get : forall (T:Type) (l:list T), typ T l T. - - -Derive Inversion inv with -(forall (X: Type) (y: list nat), typ nat y X) Sort Prop. diff --git a/test-suite/bugs/closed/2817.v b/test-suite/bugs/closed/2817.v deleted file mode 100644 index 08dff99287..0000000000 --- a/test-suite/bugs/closed/2817.v +++ /dev/null @@ -1,9 +0,0 @@ -(** Occur-check for Meta (up to application of already known instances) *) - -Goal forall (f: nat -> nat -> Prop) (x:bool) - (H: forall (u: nat), f u u -> True) - (H0: forall x0, f (if x then x0 else x0) x0), -False. - -intros. -Fail apply H in H0. (* should fail without exhausting the stack *) diff --git a/test-suite/bugs/closed/2828.v b/test-suite/bugs/closed/2828.v deleted file mode 100644 index 0b8abace22..0000000000 --- a/test-suite/bugs/closed/2828.v +++ /dev/null @@ -1,4 +0,0 @@ -Parameter A B : Type. -Coercion POL (p : prod A B) := fst p. -Goal forall x : prod A B, A. - intro x. Fail exact x. diff --git a/test-suite/bugs/closed/2830.v b/test-suite/bugs/closed/2830.v deleted file mode 100644 index 07a5cf91a5..0000000000 --- a/test-suite/bugs/closed/2830.v +++ /dev/null @@ -1,227 +0,0 @@ -(* Bug report #2830 (evar defined twice) covers different bugs *) - -(* 1- This was submitted by qb.h.agws *) - -Module A. - -Set Implicit Arguments. - -Inductive Bit := O | I. - -Inductive BitString: nat -> Set := -| bit: Bit -> BitString 0 -| bitStr: forall n: nat, Bit -> BitString n -> BitString (S n). - -Definition BitOr (a b: Bit) := - match a, b with - | O, O => O - | _, _ => I - end. - -(* Should fail with an error; used to failed in 8.4 and trunk with - anomaly Evd.define: cannot define an evar twice *) - -Fail Fixpoint StringOr (n m: nat) (a: BitString n) (b: BitString m) := - match a with - | bit a' => - match b with - | bit b' => bit (BitOr a' b') - | bitStr b' bT => bitStr b' (StringOr (bit a') bT) - end - | bitStr a' aT => - match b with - | bit b' => bitStr a' (StringOr aT (bit b')) - | bitStr b' bT => bitStr (BitOr a' b') (StringOr aT bT) - end - end. - -End A. - -(* 2- This was submitted by Andrew Appel *) - -Module B. - -Require Import Program Relations. - -Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A) := -{ af_unage : forall x x' y', level x' = level y' -> age1 x = Some x' -> exists y, age1 y = Some y' -; af_level1 : forall x, age1 x = None <-> level x = 0 -; af_level2 : forall x y, age1 x = Some y -> level x = S (level y) -}. - -Arguments af_unage {A level age1}. -Arguments af_level1 {A level age1}. -Arguments af_level2 {A level age1}. - -Class ageable (A:Type) := mkAgeable -{ level : A -> nat -; age1 : A -> option A -; age_facts : ageable_facts A level age1 -}. -Definition age {A} `{ageable A} (x y:A) := age1 x = Some y. -Definition necR {A} `{ageable A} : relation A := clos_refl_trans A age. -Delimit Scope pred with pred. -Local Open Scope pred. - -Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) := - forall a a':A, R a a' -> p a -> p a'. - -Definition pred (A:Type) {AG:ageable A} := - { p:A -> Prop | hereditary age p }. - -Bind Scope pred with pred. - -Definition app_pred {A} `{ageable A} (p:pred A) : A -> Prop := proj1_sig p. -Definition pred_hereditary `{ageable} (p:pred A) := proj2_sig p. -Coercion app_pred : pred >-> Funclass. -Global Opaque pred. - -Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a. -Arguments derives : default implicits. - -Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A := - fun a:A => P a /\ Q a. -Next Obligation. - intros; intro; intuition; apply pred_hereditary with a; auto. -Qed. - -Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A := - fun a:A => forall a':A, necR a a' -> P a' -> Q a'. -Next Obligation. - intros; intro; intuition. - apply H1; auto. - apply rt_trans with a'; auto. - apply rt_step; auto. -Qed. - -Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A - := fun a => forall b, f b a. -Next Obligation. - intros; intro; intuition. - apply pred_hereditary with a; auto. - apply H1. -Qed. - -Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred. -Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity). -Notation "'All' x ':' T ',' P " := (allp (fun x:T => P%pred)) (at level 65, x at level 99) : pred. - -Lemma forall_pred_ext {A} `{agA : ageable A}: forall B P Q, - (All x : B, (P x <--> Q x)) |-- (All x : B, P x) <--> (All x: B, Q x). -Abort. - -End B. - -(* 3. *) - -(* This was submitted by Anthony Cowley *) - -Require Import Coq.Classes.Morphisms. -Require Import Setoid. - -Module C. - -Reserved Notation "a ~> b" (at level 70, right associativity). -Reserved Notation "a ≈ b" (at level 54). -Reserved Notation "a ∘ b" (at level 50, left associativity). -Generalizable All Variables. - -Class Category (Object:Type) (Hom:Object -> Object -> Type) := { - hom := Hom where "a ~> b" := (hom a b) : category_scope - ; ob := Object - ; id : forall a, hom a a - ; comp : forall c b a, hom b c -> hom a b -> hom a c - where "g ∘ f" := (comp _ _ _ g f) : category_scope - ; eqv : forall a b, hom a b -> hom a b -> Prop - where "f ≈ g" := (eqv _ _ f g) : category_scope - ; eqv_equivalence : forall a b, Equivalence (eqv a b) - ; comp_respects : forall a b c, - Proper (eqv b c ==> eqv a b ==> eqv a c) (comp c b a) - ; left_identity : forall `(f:a ~> b), id b ∘ f ≈ f - ; right_identity : forall `(f:a ~> b), f ∘ id a ≈ f - ; associativity : forall `(f:a~>b) `(g:b~>c) `(h:c~>d), - h ∘ (g ∘ f) ≈ (h ∘ g) ∘ f -}. -Notation "a ~> b" := (@hom _ _ _ a b) : category_scope. -Notation "g ∘ f" := (@comp _ _ _ _ _ _ g f) : category_scope. -Notation "a ≈ b" := (@eqv _ _ _ _ _ a b) : category_scope. -Notation "a ~{ C }~> b" := (@hom _ _ C a b) (at level 100) : category_scope. -Coercion ob : Category >-> Sortclass. - -Open Scope category_scope. - -Add Parametric Relation `(C:Category Ob Hom) (a b : Ob) : (hom a b) (eqv a b) - reflexivity proved by (@Equivalence_Reflexive _ _ (eqv_equivalence a b)) - symmetry proved by (@Equivalence_Symmetric _ _ (eqv_equivalence a b)) - transitivity proved by (@Equivalence_Transitive _ _ (eqv_equivalence a b)) - as parametric_relation_eqv. - -Add Parametric Morphism `(C:Category Ob Hom) (c b a : Ob) : (comp c b a) - with signature (eqv _ _ ==> eqv _ _ ==> eqv _ _) as parametric_morphism_comp. - intros x y Heq x' y'. apply comp_respects. exact Heq. - Defined. - -Class Functor `(C:Category) `(D:Category) (im : C -> D) := { - functor_im := im - ; fmap : forall {a b}, `(a ~> b) -> im a ~> im b - ; fmap_respects : forall a b (f f' : a ~> b), f ≈ f' -> fmap f ≈ fmap f' - ; fmap_preserves_id : forall a, fmap (id a) ≈ id (im a) - ; fmap_preserves_comp : forall `(f:a~>b) `(g:b~>c), - fmap g ∘ fmap f ≈ fmap (g ∘ f) -}. -Coercion functor_im : Functor >-> Funclass. -Arguments fmap [Object Hom C Object0 Hom0 D im] _ [a b]. - -Add Parametric Morphism `(C:Category) `(D:Category) - (Im:C->D) (F:Functor C D Im) (a b:C) : (@fmap _ _ C _ _ D Im F a b) - with signature (@eqv C _ C a b ==> @eqv D _ D (Im a) (Im b)) - as parametric_morphism_fmap. -intros. apply fmap_respects. assumption. Qed. - -(* HERE IS THE PROBLEMATIC INSTANCE. If we change this to a regular Definition, - then the problem goes away. *) -Instance functor_comp `{C:Category} `{D:Category} `{E:Category} - {Gim} (G:Functor D E Gim) {Fim} (F:Functor C D Fim) - : Functor C E (Basics.compose Gim Fim). -intros. apply Build_Functor with (fmap := fun a b f => fmap G (fmap F f)). -abstract (intros; rewrite H; reflexivity). -abstract (intros; repeat (rewrite fmap_preserves_id); reflexivity). -abstract (intros; repeat (rewrite fmap_preserves_comp); reflexivity). -Defined. - -Definition skel {A:Type} : relation A := @eq A. -Instance skel_equiv A : Equivalence (@skel A). -Admitted. - -Import FunctionalExtensionality. -Instance set_cat : Category Type (fun A B => A -> B) := { - id := fun A => fun x => x - ; comp c b a f g := fun x => f (g x) - ; eqv := fun A B => @skel (A -> B) -}. -intros. compute. symmetry. apply eta_expansion. -intros. compute. symmetry. apply eta_expansion. -intros. compute. reflexivity. Defined. - -(* The [list] type constructor is a Functor. *) - -Import List. - -Definition setList (A:set_cat) := list A. -Instance list_functor : Functor set_cat set_cat setList. -apply Build_Functor with (fmap := @map). -intros. rewrite H. reflexivity. -intros; simpl; apply functional_extensionality. - induction x; [auto|simpl]. rewrite IHx. reflexivity. -intros; simpl; apply functional_extensionality. - induction x; [auto|simpl]. rewrite IHx. reflexivity. -Defined. - -Local Notation "[ a , .. , b ]" := (a :: .. (b :: nil) ..) : list_scope. -Definition setFmap {Fim} {F:Functor set_cat set_cat Fim} `(f:A~>B) (xs:Fim A) := fmap F f xs. - -(* We want to infer the [Functor] instance based on the value's - structure, but the [functor_comp] instance throws things awry. *) -Eval cbv in setFmap (fun x => x * 3) [67,8]. - -End C. diff --git a/test-suite/bugs/closed/2834.v b/test-suite/bugs/closed/2834.v deleted file mode 100644 index 6015c53b8a..0000000000 --- a/test-suite/bugs/closed/2834.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Testing typing of subst *) - -Lemma eqType2Set (a b : Set) (H : @eq Type a b) : @eq Set a b. -Fail subst. diff --git a/test-suite/bugs/closed/2836.v b/test-suite/bugs/closed/2836.v deleted file mode 100644 index a948b75e27..0000000000 --- a/test-suite/bugs/closed/2836.v +++ /dev/null @@ -1,39 +0,0 @@ -(* Check that possible instantiation made during evar materialization - are taken into account and do not raise Not_found *) - -Set Implicit Arguments. - -Record SpecializedCategory (obj : Type) (Morphism : obj -> obj -> Type) := { - Object :> _ := obj; - - Identity' : forall o, Morphism o o; - Compose' : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' -}. - -Section SpecializedCategoryInterface. - Variable obj : Type. - Variable mor : obj -> obj -> Type. - Variable C : @SpecializedCategory obj mor. - - Definition Morphism (s d : C) := mor s d. - Definition Identity (o : C) : Morphism o o := C.(Identity') o. - Definition Compose (s d d' : C) (m : Morphism d d') (m0 : Morphism s d) : -Morphism s d' := C.(Compose') s d d' m m0. -End SpecializedCategoryInterface. - -Section ProductCategory. - Variable objC : Type. - Variable morC : objC -> objC -> Type. - Variable objD : Type. - Variable morD : objD -> objD -> Type. - Variable C : SpecializedCategory morC. - Variable D : SpecializedCategory morD. - -(* Should fail nicely *) -Definition ProductCategory : @SpecializedCategory (objC * objD)%type (fun s d -=> (morC (fst s) (fst d) * morD (snd s) (snd d))%type). -Fail refine {| - Identity' := (fun o => (Identity (fst o), Identity (snd o))); - Compose' := (fun s d d' m2 m1 => (Compose (fst m2) (fst m1), Compose (snd -m2) (snd m1))) - |}. diff --git a/test-suite/bugs/closed/2837.v b/test-suite/bugs/closed/2837.v deleted file mode 100644 index 52a56c2cff..0000000000 --- a/test-suite/bugs/closed/2837.v +++ /dev/null @@ -1,15 +0,0 @@ -Require Import JMeq. - -Axiom test : forall n m : nat, JMeq n m. - -Goal forall n m : nat, JMeq n m. - -(* I) with no intros nor variable hints, this should produce a regular error - instead of Uncaught exception Failure("nth"). *) -Fail rewrite test. - -(* II) with intros but indication of variables, still an error *) -Fail (intros; rewrite test). - -(* III) a working variant: *) -intros; rewrite (test n m). diff --git a/test-suite/bugs/closed/2839.v b/test-suite/bugs/closed/2839.v deleted file mode 100644 index e727e26061..0000000000 --- a/test-suite/bugs/closed/2839.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Check a case where ltac typing error should result in error, not anomaly *) - -Goal forall (H : forall x : nat, x = x), False. -intro. -Fail - let H := - match goal with - | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H' - end - in pose H. diff --git a/test-suite/bugs/closed/2854.v b/test-suite/bugs/closed/2854.v deleted file mode 100644 index 14aee17ff0..0000000000 --- a/test-suite/bugs/closed/2854.v +++ /dev/null @@ -1,7 +0,0 @@ -Section foo. - Let foo := Type. - Definition bar : foo -> foo := @id _. - Goal False. - subst foo. - Fail pose bar as f. - (* simpl in f. *) diff --git a/test-suite/bugs/closed/2876.v b/test-suite/bugs/closed/2876.v deleted file mode 100644 index a66ee6b3fa..0000000000 --- a/test-suite/bugs/closed/2876.v +++ /dev/null @@ -1,11 +0,0 @@ -Lemma test_bug : forall (R:nat->nat->Prop) n m m' (P: Prop), - P -> - (P -> R n m) -> - (P -> R n m') -> - (forall u, R n u -> u = u -> True) -> - True. -Proof. - intros * HP H1 H2 H3. eapply H3. - eauto. (* H1 is used, but H2 should be used since it is the last hypothesis *) - auto. -Qed. diff --git a/test-suite/bugs/closed/2883.v b/test-suite/bugs/closed/2883.v deleted file mode 100644 index f027b5eb29..0000000000 --- a/test-suite/bugs/closed/2883.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import TestSuite.admit. -Require Import List. -Require Import Coq.Program.Equality. - -Inductive star {genv state : Type} - (step : genv -> state -> state -> Prop) - (ge : genv) : state -> state -> Prop := - | star_refl : forall s : state, star step ge s s - | star_step : - forall (s1 : state) (s2 : state) - (s3 : state), - step ge s1 s2 -> - star step ge s2 s3 -> - star step ge s1 s3. - -Parameter genv expr env mem : Type. -Definition genv' := genv. -Inductive state : Type := - | State : expr -> env -> mem -> state. -Parameter step : genv' -> state -> state -> Prop. - -Section Test. - -Variable ge : genv'. - -Lemma compat_eval_steps: - forall a b e a' b', - star step ge (State a e b) (State a' e b') -> - True. -Proof. - intros. dependent induction H. - trivial. - eapply IHstar; eauto. - replace s2 with (State a' e b') by admit. eauto. -Qed. (* Oups *) diff --git a/test-suite/bugs/closed/2900.v b/test-suite/bugs/closed/2900.v deleted file mode 100644 index 8f4264e910..0000000000 --- a/test-suite/bugs/closed/2900.v +++ /dev/null @@ -1,28 +0,0 @@ -(* Was raising stack overflow in 8.4 and assertion failed in future 8.5 *) -Set Implicit Arguments. - -Require Import List. -Require Import Coq.Program.Equality. - -(** Reflexive-transitive closure ( R* ) *) - -Inductive rtclosure (A : Type) (R : A-> A->Prop) : A->A->Prop := - | rtclosure_refl : forall x, - rtclosure R x x - | rtclosure_step : forall y x z, - R x y -> rtclosure R y z -> rtclosure R x z. - (* bug goes away if rtclosure_step is commented out *) - -(** The closure of the trivial binary relation [eq] *) - -Definition tr (A:Type) := rtclosure (@eq A). - -(** The bug *) - -Lemma bug : forall A B (l t:list A) (r s:list B), - length l = length r -> - tr (combine l r) (combine t s) -> tr l t. -Proof. - intros * E Hp. - (* bug goes away if [revert E] is called explicitly *) - dependent induction Hp. diff --git a/test-suite/bugs/closed/2946.v b/test-suite/bugs/closed/2946.v deleted file mode 100644 index d8138e145c..0000000000 --- a/test-suite/bugs/closed/2946.v +++ /dev/null @@ -1,8 +0,0 @@ -Lemma toto (E : nat -> nat -> Prop) (x y : nat) - (Ex_ : forall z, E x z) (E_y : forall z, E z y) : True. - -(* OK *) -assert (pairE1 := let Exy := _ in (Ex_ y, E_y _) : Exy * Exy). - -(* FAIL *) -assert (pairE2 := let Exy := _ in (Ex_ _, E_y x) : Exy * Exy). diff --git a/test-suite/bugs/closed/2955.v b/test-suite/bugs/closed/2955.v deleted file mode 100644 index 11fd7bada7..0000000000 --- a/test-suite/bugs/closed/2955.v +++ /dev/null @@ -1,52 +0,0 @@ -Require Import Coq.Arith.Arith. - -Module A. - - Fixpoint foo (n:nat) := - match n with - | 0 => 0 - | S n => bar n - end - - with bar (n:nat) := - match n with - | 0 => 0 - | S n => foo n - end. - - Lemma using_foo: - forall (n:nat), foo n = 0 /\ bar n = 0. - Proof. - induction n ; split ; auto ; - destruct IHn ; auto. - Qed. - -End A. - - -Module B. - - Module A := A. - Import A. - -End B. - -Module E. - - Module B := B. - Import B.A. - - (* Bug 1 *) - Lemma test_1: - forall (n:nat), foo n = 0. - Proof. - intros ; destruct n. - reflexivity. - specialize (A.using_foo (S n)) ; intros. - simpl in H. - simpl. - destruct H. - assumption. - Qed. - -End E. diff --git a/test-suite/bugs/closed/2966.v b/test-suite/bugs/closed/2966.v deleted file mode 100644 index debada8539..0000000000 --- a/test-suite/bugs/closed/2966.v +++ /dev/null @@ -1,79 +0,0 @@ -(** Non-termination and state monad with extraction *) -Require Import List. - -Set Implicit Arguments. -Set Asymmetric Patterns. - -Module MemSig. - Definition t: Type := list Type. - - Definition Nth (sig: t) (n: nat) := - nth n sig unit. -End MemSig. - -(** A memory of type [Mem.t s] is the union of cells whose type is specified - by [s]. *) -Module Mem. - Inductive t: MemSig.t -> Type := - | Nil: t nil - | Cons: forall (T: Type), option T -> forall (sig: MemSig.t), t sig -> - t (T :: sig). -End Mem. - -Module Ref. - Inductive t (sig: MemSig.t) (T: Type): Type := - | Input: t sig T. - - Definition Read (sig: MemSig.t) (T: Type) (ref: t sig T) (s: Mem.t sig) - : option T := - match ref with - | Input => None - end. -End Ref. - -Module Monad. - Definition t (sig: MemSig.t) (A: Type) := - Mem.t sig -> option A * Mem.t sig. - - Definition Return (sig: MemSig.t) (A: Type) (x: A): t sig A := - fun s => - (Some x, s). - - Definition Bind (sig: MemSig.t) (A B: Type) (x: t sig A) (f: A -> t sig B) - : t sig B := - fun s => - match x s with - | (Some x', s') => f x' s' - | (None, s') => (None, s') - end. - - Definition Select (T: Type) (f g: unit -> T): T := - f tt. - - (** Read in a reference. *) - Definition Read (sig: MemSig.t) (T: Type) (ref: Ref.t sig T) - : t sig T := - fun s => - match Ref.Read ref s with - | None => (None, s) - | Some x => (Some x, s) - end. -End Monad. - -Import Monad. - -Definition pop (sig: MemSig.t) (T: Type) (trace: Ref.t sig (list T)) - : Monad.t sig T := - Bind (Read trace) (fun _ s => (None, s)). - -Definition sig: MemSig.t := (list nat: Type) :: nil. - -Definition trace: Ref.t sig (list nat). -Admitted. - -Definition Gre (sig: MemSig.t) (trace: _) - (f: bool -> bool): Monad.t sig nat := - Select (fun _ => pop trace) (fun _ => Return 0). - -Definition Arg := - Gre trace (fun _ => false). diff --git a/test-suite/bugs/closed/2981.v b/test-suite/bugs/closed/2981.v deleted file mode 100644 index 1facd9b7e9..0000000000 --- a/test-suite/bugs/closed/2981.v +++ /dev/null @@ -1,15 +0,0 @@ -Check let TTT := Type in (fun (a b : @sigT TTT (fun A : TTT => A)) - (f : @projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) => - @eq_refl - (@projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) - (fun x : @projT1 TTT (fun A : TTT => A) a => f x)) : - forall (a b : @sigT TTT (fun A : TTT => A)) - (f : @projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b), - @eq - (@projT1 TTT (fun A : TTT => A) a -> - @projT1 TTT (fun A : TTT => A) b) - (fun x : @projT1 TTT (fun A : TTT => A) a => f x) f. - diff --git a/test-suite/bugs/closed/2995.v b/test-suite/bugs/closed/2995.v deleted file mode 100644 index b6c5b6df44..0000000000 --- a/test-suite/bugs/closed/2995.v +++ /dev/null @@ -1,9 +0,0 @@ -Module Type Interface. - Parameter error: nat. -End Interface. - -Module Implementation <: Interface. - Definition t := bool. - Definition error: t := false. -Fail End Implementation. -(* A UserError here is expected, not an uncaught Not_found *) diff --git a/test-suite/bugs/closed/2996.v b/test-suite/bugs/closed/2996.v deleted file mode 100644 index d5409289c5..0000000000 --- a/test-suite/bugs/closed/2996.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import TestSuite.admit. -(* Test on definitions referring to section variables that are not any - longer in the current context *) - -Section x. - - Hypothesis h : forall(n : nat), n < S n. - - Definition f(n m : nat)(less : n < m) : nat := n + m. - - Lemma a : forall(n : nat), f n (S n) (h n) = 1 + 2 * n. - Proof. - (* XXX *) admit. - Qed. - - Lemma b : forall(n : nat), n < 3 + n. - Proof. - clear. - intros n. - Fail assert (H := a n). - Abort. - - Let T := True. - Definition p := I : T. - - Lemma paradox : False. - Proof. - clear. - set (T := False). - Fail pose proof p as H. - Abort. diff --git a/test-suite/bugs/closed/3003.v b/test-suite/bugs/closed/3003.v deleted file mode 100644 index 2f8bcdae7a..0000000000 --- a/test-suite/bugs/closed/3003.v +++ /dev/null @@ -1,12 +0,0 @@ -(* This used to raise an anomaly in 8.4 and trunk up to 17 April 2013 *) - -Set Implicit Arguments. - -Inductive path (V : Type) (E : V -> V -> Type) (s : V) : V -> Type := - | NoEdges : path E s s - | AddEdge : forall d d' : V, path E s d -> E d d' -> path E s d'. -Inductive G_Vertex := G_v0 | G_v1. -Inductive G_Edge : G_Vertex -> G_Vertex -> Set := G_e : G_Edge G_v0 G_v1. -Goal forall x1 : G_Edge G_v1 G_v1, @AddEdge _ G_Edge G_v1 _ _ (NoEdges _ _) x1 = NoEdges _ _. -intro x1. -try destruct x1. (* now raises a typing error *) diff --git a/test-suite/bugs/closed/3016.v b/test-suite/bugs/closed/3016.v deleted file mode 100644 index bd4f1dd805..0000000000 --- a/test-suite/bugs/closed/3016.v +++ /dev/null @@ -1,4 +0,0 @@ -Section foo. - Variable C : Type. - Goal True. - change (eq (A := ?C) ?x ?y) with (eq). diff --git a/test-suite/bugs/closed/3036.v b/test-suite/bugs/closed/3036.v deleted file mode 100644 index 3b57310d6e..0000000000 --- a/test-suite/bugs/closed/3036.v +++ /dev/null @@ -1,169 +0,0 @@ -(* Checking use of retyping in w_unify0 in the presence of unification -problems of the form \x:Meta.Meta = \x:ind.match x with ... end *) - -Require Import List. -Require Import QArith. -Require Import Qcanon. - -Set Implicit Arguments. - -Inductive dynamic : Type := - | Dyn : forall T, T -> dynamic. - -Definition perm := Qc. - -Locate Qle_bool. - -Definition compatibleb (p1 p2 : perm) : bool := -let p1pos := Qle_bool 0 p1 in - let p2pos := Qle_bool 0 p2 in - negb ( - (p1pos && p2pos) - || ((p1pos || p2pos) && (negb (Qle_bool 0 ((p1 + p2)%Qc)))))%Qc. - -Definition compatible (p1 p2 : perm) := compatibleb p1 p2 = true. - -Definition perm_plus (p1 p2 : perm) : option perm := - if compatibleb p1 p2 then Some (p1 + p2) else None. - -Infix "+p" := perm_plus (at level 60, no associativity). - -Axiom axiom_ptr : Set. - -Definition ptr := axiom_ptr. - -Axiom axiom_ptr_eq_dec : forall (a b : ptr), {a = b} + {a <> b}. - -Definition ptr_eq_dec := axiom_ptr_eq_dec. - -Definition hval := (dynamic * perm)%type. - -Definition heap := ptr -> option hval. - -Bind Scope heap_scope with heap. -Delimit Scope heap_scope with heap. -Local Open Scope heap_scope. - -Definition read (h : heap) (p : ptr) : option hval := h p. - -Notation "a # b" := (read a b) (at level 55, no associativity) : heap_scope. - -Definition val (v:hval) := fst v. -Definition frac (v:hval) := snd v. - -Definition hval_plus (v1 v2 : hval) : option hval := - match (frac v1) +p (frac v2) with - | None => None - | Some v1v2 => Some (val v1, v1v2) - end. - -Definition hvalo_plus (v1 v2 : option hval) := - match v1 with - | None => v2 - | Some v1' => - match v2 with - | None => v1 - | Some v2' => (hval_plus v1' v2') - end - end. - -Notation "v1 +o v2" := (hvalo_plus v1 v2) (at level 60, no associativity) : heap_scope. - -Definition join (h1 h2 : heap) : heap := - (fun p => (h1 p) +o (h2 p)). - -Infix "*" := join (at level 40, left associativity) : heap_scope. - -Definition hprop := heap -> Prop. - -Bind Scope hprop_scope with hprop. -Delimit Scope hprop_scope with hprop. - -Definition hprop_cell (p : ptr) T (v : T) (pi:Qc): hprop := fun h => - h#p = Some (Dyn v, pi) /\ forall p', p' <> p -> h#p' = None. - -Notation "p ---> v" := (hprop_cell p v (0%Qc)) (at level 38, no associativity) : hprop_scope. - -Definition empty : heap := fun _ => None. - -Definition hprop_empty : hprop := eq empty. -Notation "'emp'" := hprop_empty : hprop_scope. - -Definition hprop_inj (P : Prop) : hprop := fun h => h = empty /\ P. -Notation "[ P ]" := (hprop_inj P) (at level 0, P at level 200) : hprop_scope. - -Definition hprop_imp (p1 p2 : hprop) : Prop := forall h, p1 h -> p2 h. -Infix "==>" := hprop_imp (right associativity, at level 55). - -Definition hprop_ex T (p : T -> hprop) : hprop := fun h => exists v, p v h. -Notation "'Exists' v :@ T , p" := (hprop_ex (fun v : T => p%hprop)) - (at level 90, T at next level) : hprop_scope. - -Local Open Scope hprop_scope. -Definition disjoint (h1 h2 : heap) : Prop := - forall p, - match h1#p with - | None => True - | Some v1 => match h2#p with - | None => True - | Some v2 => val v1 = val v2 - /\ compatible (frac v1) (frac v2) - end - end. - -Infix "<#>" := disjoint (at level 40, no associativity) : heap_scope. - -Definition split (h h1 h2 : heap) : Prop := h1 <#> h2 /\ h = h1 * h2. - -Notation "h ~> h1 * h2" := (split h h1 h2) (at level 40, h1 at next level, no associativity). - -Definition hprop_sep (p1 p2 : hprop) : hprop := fun h => - exists h1, exists h2, h ~> h1 * h2 - /\ p1 h1 - /\ p2 h2. -Infix "*" := hprop_sep (at level 40, left associativity) : hprop_scope. - -Section Stack. - Variable T : Set. - - Record node : Set := Node { - data : T; - next : option ptr - }. - - Fixpoint listRep (ls : list T) (hd : option ptr) {struct ls} : hprop := - match ls with - | nil => [hd = None] - | h :: t => - match hd with - | None => [False] - | Some hd' => Exists p :@ option ptr, hd' ---> Node h p * listRep t p - end - end%hprop. - - Definition stack := ptr. - - Definition rep q ls := (Exists po :@ option ptr, q ---> po * listRep ls po)%hprop. - - Definition isExistential T (x : T) := True. - - Theorem himp_ex_conc_trivial : forall T p p1 p2, - p ==> p1 * p2 - -> T - -> p ==> hprop_ex (fun _ : T => p1) * p2. - Admitted. - - Goal forall (s : ptr) (x : T) (nd : ptr) (v : unit) (x0 : list T) (v0 : option ptr) - (H0 : isExistential v0), - nd ---> {| data := x; next := v0 |} * (s ---> Some nd * listRep x0 v0) ==> - (Exists po :@ option ptr, - s ---> po * - match po with - | Some hd' => - Exists p :@ option ptr, - hd' ---> {| data := x; next := p |} * listRep x0 p - | None => [False] - end) * emp. - Proof. - intros. - try apply himp_ex_conc_trivial. diff --git a/test-suite/bugs/closed/3037.v b/test-suite/bugs/closed/3037.v deleted file mode 100644 index baa7eff549..0000000000 --- a/test-suite/bugs/closed/3037.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Anomaly before 4a8950ec7a0d9f2b216e67e69b446c064590a8e9 *) - -Require Import Recdef. - -Function f_R (a: nat) {wf (fun x y: nat => False) a}:Prop:= - match a:nat with - | 0 => True - | (S y') => f_R y' - end. -(* Anomaly: File "plugins/funind/recdef.ml", line 916, characters 13-19: Assertion failed. -Please report. *) diff --git a/test-suite/bugs/closed/3045.v b/test-suite/bugs/closed/3045.v deleted file mode 100644 index 5f80013df2..0000000000 --- a/test-suite/bugs/closed/3045.v +++ /dev/null @@ -1,34 +0,0 @@ - -Set Asymmetric Patterns. -Generalizable All Variables. -Set Implicit Arguments. -Set Universe Polymorphism. - -Record SpecializedCategory (obj : Type) := - { - Object :> _ := obj; - Morphism : obj -> obj -> Type; - - Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' - }. - -Arguments Compose {obj} [C s d d'] _ _ : rename. - -Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -> Type := -| ReifiedComposedMorphism : forall objC C s d d', ReifiedMorphism C d d' -> ReifiedMorphism C s d -> @ReifiedMorphism objC C s d'. - -Fixpoint ReifiedMorphismDenote objC C s d (m : @ReifiedMorphism objC C s d) : Morphism C s d := - match m in @ReifiedMorphism objC C s d return Morphism C s d with - | ReifiedComposedMorphism _ _ _ _ _ m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1) - (@ReifiedMorphismDenote _ _ _ _ m2) - end. - -Fixpoint ReifiedMorphismSimplifyWithProof objC C s d (m : @ReifiedMorphism objC C s d) -: { m' : ReifiedMorphism C s d | ReifiedMorphismDenote m = ReifiedMorphismDenote m' }. -refine match m with - | ReifiedComposedMorphism _ _ s0 d0 d0' m1 m2 => _ - end; clear m. -(* This fails with an error rather than an anomaly, but morally - it should work, if destruct were able to do the good generalization - in advance, before doing the "intros []". *) -Fail destruct (@ReifiedMorphismSimplifyWithProof T s1 d0 d0' m1) as [ [] ? ]. diff --git a/test-suite/bugs/closed/3068.v b/test-suite/bugs/closed/3068.v deleted file mode 100644 index 9811733dc6..0000000000 --- a/test-suite/bugs/closed/3068.v +++ /dev/null @@ -1,64 +0,0 @@ -Require Import TestSuite.admit. -Section Counted_list. - - Variable A : Type. - - Inductive counted_list : nat -> Type := - | counted_nil : counted_list 0 - | counted_cons : forall(n : nat), - A -> counted_list n -> counted_list (S n). - - - Fixpoint counted_def_nth{n : nat}(l : counted_list n) - (i : nat)(def : A) : A := - match i with - | 0 => match l with - | counted_nil => def - | counted_cons _ a _ => a - end - | S i => match l with - | counted_nil => def - | counted_cons _ _ tl => counted_def_nth tl i def - end - end. - - - Lemma counted_list_equal_nth_char : - forall(n : nat)(l1 l2 : counted_list n)(def : A), - (forall(i : nat), counted_def_nth l1 i def = counted_def_nth l2 i def) -> - l1 = l2. - Proof. - admit. - Qed. - -End Counted_list. - -Arguments counted_def_nth [A n]. - -Section Finite_nat_set. - - Variable set_size : nat. - - Definition fnat_subset : Type := counted_list bool set_size. - - Definition fnat_member(fs : fnat_subset)(n : nat) : Prop := - is_true (counted_def_nth fs n false). - - - Lemma fnat_subset_member_eq : forall(fs1 fs2 : fnat_subset), - fs1 = fs2 <-> - forall(n : nat), fnat_member fs1 n <-> fnat_member fs2 n. - - Proof. - intros fs1 fs2. - split. - intros H n. - subst fs1. - apply iff_refl. - intros H. - eapply (counted_list_equal_nth_char _ _ _ _ ?[def]). - intros i. - destruct (counted_def_nth fs1 i _ ) eqn:H0. - (* This was not part of the initial bug report; this is to check that - the existential variable kept its name *) - change (true = counted_def_nth fs2 i ?def). diff --git a/test-suite/bugs/closed/3070.v b/test-suite/bugs/closed/3070.v deleted file mode 100644 index 7a8feca587..0000000000 --- a/test-suite/bugs/closed/3070.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Testing subst wrt chains of dependencies *) - -Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop) - (Ha : a1 = a2) (c : a1) (d : b1 c) : True. -Proof. - subst. diff --git a/test-suite/bugs/closed/3100.v b/test-suite/bugs/closed/3100.v deleted file mode 100644 index 6f35a74dc1..0000000000 --- a/test-suite/bugs/closed/3100.v +++ /dev/null @@ -1,9 +0,0 @@ -Fixpoint F (n : nat) (A : Type) : Type := - match n with - | 0 => True - | S n => forall (x : A), F n (x = x) - end. - -Goal forall A n, (forall (x : A) (e : x = x), F n (e = e)). -intros A n. -Fail change (forall x, F n (x = x)) with (F (S n)). diff --git a/test-suite/bugs/closed/3199.v b/test-suite/bugs/closed/3199.v deleted file mode 100644 index 08bf62493d..0000000000 --- a/test-suite/bugs/closed/3199.v +++ /dev/null @@ -1,18 +0,0 @@ -Axiom P : nat -> Prop. -Axiom admit : forall n : nat, P n -> P n -> n = S n. -Axiom foo : forall n, P n. - -Create HintDb bar. -Hint Extern 3 => symmetry : bar. -Hint Resolve admit : bar. -Hint Immediate foo : bar. - -Lemma qux : forall n : nat, n = S n. -Proof. -intros n. -eauto with bar. -Defined. - -Goal True. -pose (e := eq_refl (qux 0)); unfold qux in e. -match type of e with context [eq_sym] => fail 1 | _ => idtac end. diff --git a/test-suite/bugs/closed/3209.v b/test-suite/bugs/closed/3209.v deleted file mode 100644 index 855058b011..0000000000 --- a/test-suite/bugs/closed/3209.v +++ /dev/null @@ -1,75 +0,0 @@ -(* Avoiding some occur-check *) - -(* 1. Original example *) - -Inductive eqT {A} (x : A) : A -> Type := - reflT : eqT x x. -Definition Bi_inv (A B : Type) (f : (A -> B)) := - sigT (fun (g : B -> A) => - sigT (fun (h : B -> A) => - sigT (fun (α : forall b : B, eqT (f (g b)) b) => - forall a : A, eqT (h (f a)) a))). -Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f). - -Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B). -Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B := - sigT_rect (fun _ => TEquiv A B) - (fun (f : TEquiv A B -> eqT A B) H => - sigT_rect _ (* (fun _ => TEquiv A B) *) - (fun g _ => g e) - H) - (UA A B). - -(* 2. Alternative example by Guillaume *) - -Inductive foo (A : Prop) : Prop := Foo : foo A. -Axiom bar : forall (A : Prop) (P : foo A -> Prop), (A -> P (Foo A)) -> Prop. - -(* This used to fail with a Not_found, we fail more graciously but a - heuristic could be implemented, e.g. in some smart occur-check - function, to find a solution of then form ?P := fun _ => ?P' *) - -Fail Check (fun e : ?[T] => bar ?[A] ?[P] (fun g : ?[A'] => g e)). - -(* This works and tells which solution we could have inferred *) - -Check (fun e : ?[T] => bar ?[A] (fun _ => ?[P]) (fun g : ?[A'] => g e)). - -(* For the record, here is the trace in the failing example: - -In (fun e : ?T => bar ?[A] ?[P] (fun g : ?A' => g e)), we have the existential variables - -e:?T |- ?A : Prop -e:?T |- ?P : foo ?A -> Prop -e:?T |- ?A' : Type - -with constraints - -?A' == ?A -?A' == ?T -> ?P (Foo ?A) - -To type (g e), unification first defines - -?A := forall x:?B, ?P'{e:=e,x:=x} -with ?T <= ?B -and ?P'@{e:=e,x:=e} <= ?P@{e:=e} (Foo (forall x:?B, ?P'{e:=e,x:=x})) - -Then, since ?P'@{e:=e,x:=e} may use "e" in two different ways, it is -not a pattern and we define a new - -e:?T x:?B|- ?P'' : foo (?B' -> ?P''') -> Prop - -for some ?B' and ?P''', together with - -?P'@{e,x} := ?P''{e:=e,x:=e} (Foo (?B -> ?P') -?P@{e} := ?P''{e:=e,x:=e} - -Moreover, ?B' and ?P''' have to satisfy - -?B'@{e:=e,x:=e} == ?B@{e:=e} -?P'''@{e:=e,x:=e} == ?P'@{e:=e,x:=x} - -and this leads to define ?P' which was the initial existential -variable to define. -*) - diff --git a/test-suite/bugs/closed/3210.v b/test-suite/bugs/closed/3210.v deleted file mode 100644 index bb673f38c2..0000000000 --- a/test-suite/bugs/closed/3210.v +++ /dev/null @@ -1,22 +0,0 @@ -(* Test support of let-in in arity of inductive types *) - -Inductive Foo : let X := Set in X := -| I : Foo. - -Definition foo (x : Foo) : bool := - match x with - I => true - end. - -Definition foo' (x : Foo) : x = x. -case x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -elim x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -induction x. -match goal with |- I = I => idtac end. (* check form of the goal *) -Undo 2. -destruct x. -match goal with |- I = I => idtac end. (* check form of the goal *) diff --git a/test-suite/bugs/closed/3228.v b/test-suite/bugs/closed/3228.v deleted file mode 100644 index 5d1a0ff88b..0000000000 --- a/test-suite/bugs/closed/3228.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Check that variables in the context do not take precedence over - ltac variables *) - -Ltac bar x := exact x. -Goal False -> False. - intro x. - Fail bar doesnotexist. diff --git a/test-suite/bugs/closed/3242.v b/test-suite/bugs/closed/3242.v deleted file mode 100644 index 805baee153..0000000000 --- a/test-suite/bugs/closed/3242.v +++ /dev/null @@ -1,2 +0,0 @@ -Inductive Foo (x := Type) := C : Foo -> Foo. - diff --git a/test-suite/bugs/closed/3251.v b/test-suite/bugs/closed/3251.v deleted file mode 100644 index d4ce050c57..0000000000 --- a/test-suite/bugs/closed/3251.v +++ /dev/null @@ -1,14 +0,0 @@ -Goal True. -idtac. -Ltac foo := idtac. -(* print out happens twice: -foo is defined -foo is defined - -... that's fishy. But E. Tassi tells me that it's expected since "Ltac" generates a side -effect that escapes the proof. In the STM model this means the command is executed twice, -once in the proof branch, and another time in the main branch *) -Undo. -Ltac foo := idtac. -(* Before 5b39c3535f7b3383d89d7b844537244a4e7c0eca, this would print out: *) -(* Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) diff --git a/test-suite/bugs/closed/3257.v b/test-suite/bugs/closed/3257.v deleted file mode 100644 index d8aa6a0479..0000000000 --- a/test-suite/bugs/closed/3257.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid Morphisms Basics. -Lemma foo A B (P : B -> Prop) : - pointwise_relation _ impl (fun z => A -> P z) P. -Proof. - Fail reflexivity. diff --git a/test-suite/bugs/closed/3258.v b/test-suite/bugs/closed/3258.v deleted file mode 100644 index b263c6baf4..0000000000 --- a/test-suite/bugs/closed/3258.v +++ /dev/null @@ -1,36 +0,0 @@ -Require Import TestSuite.admit. -Require Import Coq.Classes.Morphisms Coq.Classes.RelationClasses Coq.Program.Program Coq.Setoids.Setoid. - -Global Set Implicit Arguments. - -Hint Extern 0 => apply reflexivity : typeclass_instances. - -Inductive Comp : Type -> Type := -| Pick : forall A, (A -> Prop) -> Comp A. - -Axiom computes_to : forall A, Comp A -> A -> Prop. - -Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. - -Global Instance refine_PreOrder A : PreOrder (@refine A). -Admitted. -Add Parametric Morphism A -: (@Pick A) - with signature - (pointwise_relation _ (flip impl)) - ==> (@refine A) - as refine_flip_impl_Pick. - admit. -Defined. -Definition remove_forall_eq' A x B (P : A -> B -> Prop) : pointwise_relation _ impl (P x) (fun z => forall y : A, y = x -> P y z). - admit. -Defined. -Goal forall A B (x : A) (P : _ -> _ -> Prop), - refine (Pick (fun n : B => forall y, y = x -> P y n)) - (Pick (fun n : B => P x n)). -Proof. - intros. - setoid_rewrite (@remove_forall_eq' _ _ _ _). - Undo. - (* This failed with NotConvertible at some time *) - setoid_rewrite (@remove_forall_eq' _ _ _). diff --git a/test-suite/bugs/closed/3260.v b/test-suite/bugs/closed/3260.v deleted file mode 100644 index 9f0231d91b..0000000000 --- a/test-suite/bugs/closed/3260.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Setoid. -Goal forall m n, n = m -> n+n = m+m. -intros. -replace n with m at 2. -lazymatch goal with -|- n + m = m + m => idtac -end. diff --git a/test-suite/bugs/closed/3262.v b/test-suite/bugs/closed/3262.v deleted file mode 100644 index 70bfde2990..0000000000 --- a/test-suite/bugs/closed/3262.v +++ /dev/null @@ -1,78 +0,0 @@ -(* Not having a [return] clause causes the [refine] at the bottom to stack overflow before f65fa9de8a4c9c12d933188a755b51508bd51921 *) - -Require Import Coq.Lists.List. -Require Import Relations RelationClasses. - -Set Implicit Arguments. -Set Strict Implicit. -Set Asymmetric Patterns. - -Section hlist. - Context {iT : Type}. - Variable F : iT -> Type. - - Inductive hlist : list iT -> Type := - | Hnil : hlist nil - | Hcons : forall l ls, F l -> hlist ls -> hlist (l :: ls). - - Definition hlist_hd {a b} (hl : hlist (a :: b)) : F a := - match hl in hlist x return match x with - | nil => unit - | l :: _ => F l - end with - | Hnil => tt - | Hcons _ _ x _ => x - end. - - Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b := - match hl in hlist x return match x with - | nil => unit - | _ :: ls => hlist ls - end with - | Hnil => tt - | Hcons _ _ _ x => x - end. - - Lemma hlist_eta : forall ls (h : hlist ls), - h = match ls as ls return hlist ls -> hlist ls with - | nil => fun _ => Hnil - | a :: b => fun h => Hcons (hlist_hd h) (hlist_tl h) - end h. - Proof. - intros. destruct h; auto. - Qed. - - Variable eqv : forall x, relation (F x). - - Inductive equiv_hlist : forall ls, hlist ls -> hlist ls -> Prop := - | hlist_eqv_nil : equiv_hlist Hnil Hnil - | hlist_eqv_cons : forall l ls x y h1 h2, eqv x y -> equiv_hlist h1 h2 -> - @equiv_hlist (l :: ls) (Hcons x h1) (Hcons y h2). - - Global Instance Reflexive_equiv_hlist (R : forall t, Reflexive (@eqv t)) ls - : Reflexive (@equiv_hlist ls). - Proof. - red. induction x; constructor; auto. reflexivity. - Qed. - - Global Instance Transitive_equiv_hlist (R : forall t, Transitive (@eqv t)) ls - : Transitive (@equiv_hlist ls). - Proof. - red. induction 1. - { intro; assumption. } - { rewrite (hlist_eta z). - Timeout 2 Fail refine - (fun H => - match H in @equiv_hlist ls X Y - return - (* Uncommenting the following gives an immediate error in 8.4pl3; commented out results in a stack overflow *) - match ls (*as ls return hlist ls -> hlist ls -> Type*) with - | nil => fun _ _ : hlist nil => True - | l :: ls => fun (X Y : hlist (l :: ls)) => - equiv_hlist (Hcons x h1) Y - end X Y - with - | hlist_eqv_nil => I - | hlist_eqv_cons l ls x y h1 h2 pf pf' => - _ - end). diff --git a/test-suite/bugs/closed/3284.v b/test-suite/bugs/closed/3284.v deleted file mode 100644 index 34cd09c6f4..0000000000 --- a/test-suite/bugs/closed/3284.v +++ /dev/null @@ -1,23 +0,0 @@ -(* Several bugs: -- wrong env in pose_all_metas_as_evars leading to out of scope instance of evar -- check that metas posed as evars in pose_all_metas_as_evars were - resolved was not done -*) - -Axiom functional_extensionality_dep : - forall {A : Type} {B : A -> Type} (f g : forall x : A, B x), - (forall x : A, f x = g x) -> f = g. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g x H. - Fail apply @functional_extensionality_dep in H. - Fail apply functional_extensionality_dep in H. - eapply functional_extensionality_dep in H. -Abort. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g x H. - specialize (H x). - apply functional_extensionality_dep in H. diff --git a/test-suite/bugs/closed/3286.v b/test-suite/bugs/closed/3286.v deleted file mode 100644 index 701480fc83..0000000000 --- a/test-suite/bugs/closed/3286.v +++ /dev/null @@ -1,41 +0,0 @@ -Require Import FunctionalExtensionality. - -Ltac make_apply_under_binders_in lem H := - let tac := make_apply_under_binders_in in - match type of H with - | forall x : ?T, @?P x - => let ret := constr:(fun x' : T => - let Hx := H x' in - ltac:(let ret' := tac lem Hx in - exact ret')) in - match eval cbv zeta in ret with - | fun x => Some (@?P x) => let P' := (eval cbv zeta in P) in - constr:(Some P') - end - | _ => let ret := constr:(ltac:(match goal with - | _ => (let H' := fresh in - pose H as H'; - apply lem in H'; - exact (Some H')) - | _ => exact (@None nat) - end - )) in - let ret' := (eval cbv beta zeta in ret) in - constr:(ret') - | _ => constr:(@None nat) - end. - -Ltac apply_under_binders_in lem H := - let H' := make_apply_under_binders_in lem H in - let H'0 := match H' with Some ?H'0 => constr:(H'0) end in - let H'' := fresh in - pose proof H'0 as H''; - clear H; - rename H'' into H. - -Goal forall A B C (f g : forall (x : A) (y : B x), C x y), (forall x y, f x y = g x y) -> True. -Proof. - intros A B C f g H. - let lem := constr:(@functional_extensionality_dep) in - apply_under_binders_in lem H. -(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3291.v b/test-suite/bugs/closed/3291.v deleted file mode 100644 index 4ea748c0fb..0000000000 --- a/test-suite/bugs/closed/3291.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import Setoid. - -Definition segv : forall x, (x = 0%nat) -> (forall (y : nat), (y < x)%nat -> nat) = forall (y : nat), (y < 0)%nat -> nat. -intros x eq. -assert (H : forall y, (y < x)%nat = (y < 0)%nat). -rewrite -> eq. auto. -Set Typeclasses Debug. -Fail setoid_rewrite <- H. (* The command has indeed failed with message: -=> Stack overflow. *) diff --git a/test-suite/bugs/closed/3297.v b/test-suite/bugs/closed/3297.v deleted file mode 100644 index 1cacb97ff3..0000000000 --- a/test-suite/bugs/closed/3297.v +++ /dev/null @@ -1,12 +0,0 @@ -Goal forall (n : nat) (H := eq_refl : n = n) (H' : n = 0), H = eq_refl. - intros. - subst. (* Toplevel input, characters 15-20: -Error: Abstracting over the term "n" leads to a term -"λ n : nat, H = eq_refl" which is ill-typed. *) - Undo. - revert H. - subst. (* success *) - Undo. - intro. - clearbody H. - subst. (* success *) diff --git a/test-suite/bugs/closed/3306.v b/test-suite/bugs/closed/3306.v deleted file mode 100644 index 599e8391ac..0000000000 --- a/test-suite/bugs/closed/3306.v +++ /dev/null @@ -1,12 +0,0 @@ - -Inductive Foo(A : Type) : Prop := - foo: A -> Foo A. - -Arguments foo [A] _. - -Scheme Foo_elim := Induction for Foo Sort Prop. - -Goal forall (fn : Foo nat), { x: nat | foo x = fn }. -intro fn. -Fail induction fn as [n] using Foo_elim. (* should fail in a non-Prop context *) -Admitted. diff --git a/test-suite/bugs/closed/3310.v b/test-suite/bugs/closed/3310.v deleted file mode 100644 index d6c31c6b41..0000000000 --- a/test-suite/bugs/closed/3310.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. - -CoInductive stream A := cons { hd : A; tl : stream A }. - -CoFixpoint id {A} (s : stream A) := cons (hd s) (id (tl s)). - -Lemma id_spec : forall A (s : stream A), id s = s. -Proof. -intros A s. -Fail change (id s) with (cons (hd (id s)) (tl (id s))). diff --git a/test-suite/bugs/closed/3317.v b/test-suite/bugs/closed/3317.v deleted file mode 100644 index 8d152894ef..0000000000 --- a/test-suite/bugs/closed/3317.v +++ /dev/null @@ -1,94 +0,0 @@ -Set Implicit Arguments. -Module A. - Set Universe Polymorphism. - Set Primitive Projections. - Set Asymmetric Patterns. - Inductive paths {A} (x : A) : A -> Type := idpath : paths x x - where "x = y" := (@paths _ x y) : type_scope. - Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. - Arguments existT {A} _ _ _. - Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - Notation "x .1" := (projT1 x) (at level 3). - Notation "x .2" := (projT2 x) (at level 3). - Notation "( x ; y )" := (existT _ x y). - Set Printing All. - Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) - : u = v - := match pq with - | existT p q => - match u, v return (forall p0 : (u.1 = v.1), (transport P p0 u.2 = v.2) -> (u=v)) with - | (x;y), (x';y') => fun p1 (q1 : transport P p1 (existT P x y).2 = (existT P x' y').2) => - match p1 in (_ = x'') return (forall y'', (transport _ p1 y = y'') -> (x;y)=(x'';y'')) with - | idpath => fun y' (q2 : transport _ (@idpath _ _) y = y') => - match q2 in (_ = y'') return (x;y) = (x;y'') with - | idpath => @idpath _ _ - end - end y' q1 - end p q - end. - (* Toplevel input, characters 341-357: -Error: -In environment -A : Type -P : forall _ : A, Type -u : @sigT A P -v : @sigT A P -pq : -@sigT (@paths A (projT1 u) (projT1 v)) - (fun p : @paths A (projT1 u) (projT1 v) => - @paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) - (projT2 v)) -p : @paths A (projT1 u) (projT1 v) -q : -@paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) - (projT2 v) -x : A -y : P x -x' : A -y' : P x' -p1 : @paths A (projT1 (@existT A P x y)) (projT1 (@existT A P x' y')) -The term "projT2 (@existT A P x y)" has type "P (projT1 (@existT A P x y))" -while it is expected to have type "P (projT1 (@existT A P x y))". - *) -End A. - -Module B. - Set Universe Polymorphism. - Set Primitive Projections. - Set Asymmetric Patterns. - Inductive paths {A} (x : A) : A -> Type := idpath : paths x x - where "x = y" := (@paths _ x y) : type_scope. - Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. - Arguments existT {A} _ _ _. - Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - Notation "x .1" := (projT1 x) (at level 3). - Notation "x .2" := (projT2 x) (at level 3). - Notation "( x ; y )" := (existT _ x y). - Set Printing All. - - Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) - : u = v. - Proof. - destruct u as [x y]. - destruct v. (* Toplevel input, characters 0-11: -Error: Illegal application: -The term "transport" of type - "forall (A : Type) (P : forall _ : A, Type) (x y : A) - (_ : @paths A x y) (_ : P x), P y" -cannot be applied to the terms - "A" : "Type" - "P" : "forall _ : A, Type" - "projT1 (@existT A P x y)" : "A" - "projT1 v" : "A" - "p" : "@paths A (projT1 (@existT A P x y)) (projT1 v)" - "projT2 (@existT A P x y)" : "P (projT1 (@existT A P x y))" -The 5th term has type "@paths A (projT1 (@existT A P x y)) (projT1 v)" -which should be coercible to - "@paths A (projT1 (@existT A P x y)) (projT1 v)". - *) - Abort. -End B. diff --git a/test-suite/bugs/closed/3319.v b/test-suite/bugs/closed/3319.v deleted file mode 100644 index fbf5d86dcb..0000000000 --- a/test-suite/bugs/closed/3319.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5353 lines to 4545 lines, then from 4513 lines to 4504 lines, then from 4515 lines to 4508 lines, then from 4519 lines to 132 lines, then from 111 lines to 66 lines, then from 68 lines to 35 lines *) -Set Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a - where "x = y" := (@paths _ x y) : type_scope. - -Record PreCategory := { obj :> Type; morphism : obj -> obj -> Type }. -Record NotionOfStructure (X : PreCategory) := - { structure :> X -> Type; - is_structure_homomorphism - : forall x y (f : morphism X x y) (a : structure x) (b : structure y), Type }. - -Section precategory. - Variable X : PreCategory. - Variable P : NotionOfStructure X. - Local Notation object := { x : X & P x }. - Record morphism' (xa yb : object) := {}. - - Lemma issig_morphism xa yb - : { f : morphism X (projT1 xa) (projT1 yb) - & is_structure_homomorphism _ _ _ f (projT2 xa) (projT2 yb) } - = morphism' xa yb. - Proof. - admit. - Defined. diff --git a/test-suite/bugs/closed/3320.v b/test-suite/bugs/closed/3320.v deleted file mode 100644 index a5c243d8e3..0000000000 --- a/test-suite/bugs/closed/3320.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal forall x : nat, True. - fix goal 1. - assumption. -Fail Qed. -Undo. diff --git a/test-suite/bugs/closed/3321.v b/test-suite/bugs/closed/3321.v deleted file mode 100644 index b6f10e533e..0000000000 --- a/test-suite/bugs/closed/3321.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 103 lines to 83 lines, then from 86 lines to 36 lines, then from 37 lines to 17 lines *) - -Axiom admit : forall {T}, T. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. -Definition equiv_path (A B : Type) (p : A = B) : Equiv A B := admit. -Class Univalence := { isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) }. -Definition path_universe `{Univalence} {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B) := admit. -Context `{ua:Univalence}. -Variable A:Type. -Goal forall (I : Type) (f : I -> A), - {p : I = {a : A & @hfiber I A f a} & True }. -intros. -clear. -try exists (path_universe admit). (* Toplevel input, characters 15-44: -Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3322.v b/test-suite/bugs/closed/3322.v deleted file mode 100644 index ab3025a6aa..0000000000 --- a/test-suite/bugs/closed/3322.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 11971 lines to 11753 lines, then from 7702 lines to 564 lines, then from 571 lines to 61 lines *) -Set Asymmetric Patterns. -Axiom admit : forall {T}, T. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : {p : (projT1 u) = (projT1 v) & transport _ p (projT2 u) = (projT2 v)}) -: u = v. -Proof. - destruct pq as [p q], u as [x y], v as [x' y']; simpl in *. - destruct p, q; simpl; reflexivity. -Defined. -Arguments path_sigma_uncurried : simpl never. -Section opposite. - Let opposite_functor_involutive_helper - := @path_sigma_uncurried admit admit (existT _ admit admit) admit (existT _ admit admit). - - Goal True. - Opaque path_sigma_uncurried. - simpl in *. - Transparent path_sigma_uncurried. - (* This command should fail with "Error: Failed to progress.", as it does in 8.4; the simpl never directive should prevent simpl from progressing *) - Fail progress simpl in *. diff --git a/test-suite/bugs/closed/3323.v b/test-suite/bugs/closed/3323.v deleted file mode 100644 index 4622634eaa..0000000000 --- a/test-suite/bugs/closed/3323.v +++ /dev/null @@ -1,78 +0,0 @@ -Require Import TestSuite.admit. -(* -*- coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 297 lines to 117 lines, then from 95 lines to 79 lines, then from 82 lines to 68 lines *) - -Set Universe Polymorphism. -Generalizable All Variables. -Inductive sigT {A:Type} (P:A -> Type) : Type := existT : forall x:A, P x -> sigT P. -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Definition projT1 {A} {P : A -> Type} (x : sigT P) : A := let (a, _) := x in a. -Definition projT2 {A} {P : A -> Type} (x : sigT P) : P (projT1 x) := let (a, h) return P (projT1 x) := x in h. -Axiom admit : forall {T}, T. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. -Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Existing Instance equiv_isequiv. -Global Instance isequiv_inverse `{IsEquiv A B f} : IsEquiv (@equiv_inv _ _ f _) | 10000 := admit. -Definition equiv_path_sigma `(P : A -> Type) (u v : sigT P) -: Equiv {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v} (u = v) := admit. -Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. -Definition path_universe {A B : Type} (f : A -> B) : (A = B) := admit. -Section AssumeFunext. - Let equiv_fibration_replacement_eissect {B C f} - : forall x : {y : B & {x : C & f x = y}}, - existT _ (f (projT1 (projT2 x))) (existT _ (projT1 (projT2 x)) idpath) = x. - admit. - Defined. - Definition equiv_fibration_replacement {B C} (f:C ->B): - Equiv C {y:B & {x:C & f x = y}}. - Proof. - refine (BuildEquiv - _ _ _ - (BuildIsEquiv - C {y:B & {x:C & f x = y}} - (fun c => existT _ (f c) (existT _ c idpath)) - (fun c => projT1 (projT2 c)) - equiv_fibration_replacement_eissect)). - Defined. - Definition equiv_total_paths (A : Type) (P : A-> Type) (x y : sigT P) : - Equiv (x = y) { p : projT1 x = projT1 y & transport P p (projT2 x) = (projT2 y) } - := BuildEquiv _ _ (@equiv_inv _ _ _ (equiv_path_sigma P x y)) _. - Variable A:Type. - Definition Fam A:=sigT (fun I:Type => I->A). - Definition p2f: (A->Type)-> Fam A := fun Q:(A->Type) => existT _ (sigT Q) (@projT1 _ _). - Definition f2p: Fam A -> (A->Type) := fun F => let (I, f) := F in (fun a => (hfiber f a)). - Definition exp {U V:Type}(w:Equiv U V):Equiv (U->A) (V->A). - exists (fun f:(U->A)=> (fun x => (f (@equiv_inv _ _ w _ x)))). - admit. - Defined. - Goal { h : Fam A -> A -> Type & Sect h p2f }. - exists f2p. - intros [I f]. - set (e:=@equiv_total_paths _ _ (@existT Type (fun I0 : Type => I0 -> A) I f) - (existT _ {a : A & hfiber f a} (@projT1 _ _))). - simpl in e. - cut ( {p : I = {a : A & @hfiber I A f a} & - @transport _ (fun I0 : Type => I0 -> A) _ _ p f = @projT1 _ _}). - { intro X. - apply (inverse (@equiv_inv _ _ _ e X)). } - set (w:=@equiv_fibration_replacement A I f). - exists (path_universe w). - assert (forall x, (exp w) f x = projT1 x); [ | admit ]. - intros [a [i p]]. - exact p. - Qed. -(* Toplevel input, characters 15-19: -Error: In pattern-matching on term "x" the branch for constructor -"existT(*Top.256 Top.258*)" has type - "forall (I : Type) (f : I -> A), - existT (fun I0 : Type => I0 -> A) {a : A & hfiber f a} projT1 = - existT (fun I0 : Type => I0 -> A) I f" which should be - "forall (x : Type) (H : x -> A), - p2f (f2p (existT (fun I : Type => I -> A) x H)) = - existT (fun I : Type => I -> A) x H". - *) diff --git a/test-suite/bugs/closed/3326.v b/test-suite/bugs/closed/3326.v deleted file mode 100644 index 4d7e9f77cb..0000000000 --- a/test-suite/bugs/closed/3326.v +++ /dev/null @@ -1,19 +0,0 @@ -Class ORDER A := Order { - LEQ : A -> A -> bool; - leqRefl: forall x, true = LEQ x x -}. - -Section XXX. - -Variable A:Type. -Variable (O:ORDER A). -Definition aLeqRefl := @leqRefl _ O. - -Lemma OK : forall x, true = LEQ x x. -Proof. - intros. - unfold LEQ. - destruct O. - clear. - Fail apply aLeqRefl. -Abort. diff --git a/test-suite/bugs/closed/3330.v b/test-suite/bugs/closed/3330.v deleted file mode 100644 index 672fb3f131..0000000000 --- a/test-suite/bugs/closed/3330.v +++ /dev/null @@ -1,1115 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 12106 lines to 1070 lines *) -Set Universe Polymorphism. -Definition setleq (A : Type@{i}) (B : Type@{j}) := A : Type@{j}. - -Inductive foo : Type@{l} := bar : foo . -Section MakeEq. - Variables (a : foo@{i}) (b : foo@{j}). - - Let t := ltac:(let ty := type of b in exact ty). - Definition make_eq (x:=b) := a : t. -End MakeEq. - -Definition same (x : foo@{i}) (y : foo@{i}) := x. - -Section foo. - - Variables x : foo@{i}. - Variables y : foo@{j}. - - Let AleqB := let foo := make_eq x y in (Type * Type)%type. - - Definition baz := same x y. -End foo. - -Definition baz' := Eval unfold baz in baz@{i j k l}. - -Module Export HoTT_DOT_Overture. -Module Export HoTT. -Module Export Overture. - -Definition relation (A : Type) := A -> A -> Type. -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := - fun x => g (f x). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. - -Open Scope function_scope. - -Set Printing Universes. Set Printing All. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. - -Notation "x = y" := (x = y :>_) : type_scope. - -Delimit Scope path_scope with path. - -Local Open Scope path_scope. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p q) (at level 20) : path_scope. - -Notation "p ^" := (inverse p) (at level 3) : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type - := forall x:A, f x = g x. - -Hint Unfold pointwise_paths : typeclass_instances. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) - : f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Delimit Scope equiv_scope with equiv. - -Local Open Scope equiv_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint nat_to_trunc_index (n : nat) : trunc_index - := match n with - | 0 => trunc_S (trunc_S minus_two) - | S n' => trunc_S (nat_to_trunc_index n') - end. - -Coercion nat_to_trunc_index : nat >-> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation IsHSet := (IsTrunc 0). - -Class Funext := - { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. - -Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : - f == g -> f = g - := - (@apD10 A P f g)^-1. - -End Overture. - -End HoTT. - -End HoTT_DOT_Overture. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. - -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Set Printing Universes. -Set Printing All. -Record PreCategory := - Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - - identity_identity : forall x, identity x o identity x = identity x; - - trunc_morphism : forall s d, IsHSet (morphism s d) - }. - -Bind Scope category_scope with PreCategory. - -Arguments identity [!C%category] x%object : rename. -Arguments compose [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. - -Definition Build_PreCategory - object morphism compose identity - associativity left_identity right_identity - := @Build_PreCategory' - object - morphism - compose - identity - associativity - (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) - left_identity - right_identity - (fun _ => left_identity _ _ _). - -Existing Instance trunc_morphism. - -Hint Resolve @left_identity @right_identity @associativity : category morphism. - -Module Export CategoryCoreNotations. - - Infix "o" := compose : morphism_scope. -End CategoryCoreNotations. -End Core. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Core. - -Module Export HoTT_DOT_types_DOT_Forall. - -Module Export HoTT. -Module Export types. -Module Export Forall. -Generalizable Variables A B f g e n. - -Section AssumeFunext. - -Global Instance trunc_forall `{P : A -> Type} `{forall a, IsTrunc n (P a)} - : IsTrunc n (forall a, P a) | 100. - -admit. -Defined. -End AssumeFunext. - -End Forall. - -End types. - -End HoTT. - -End HoTT_DOT_types_DOT_Forall. - -Module Export HoTT_DOT_types_DOT_Prod. - -Module Export HoTT. -Module Export types. -Module Export Prod. -Local Open Scope path_scope. - -Definition path_prod_uncurried {A B : Type} (z z' : A * B) - (pq : (fst z = fst z') * (snd z = snd z')) - : (z = z') - := match pq with (p,q) => - match z, z' return - (fst z = fst z') -> (snd z = snd z') -> (z = z') with - | (a,b), (a',b') => fun p q => - match p, q with - idpath, idpath => 1 - end - end p q - end. - -Definition path_prod {A B : Type} (z z' : A * B) : - (fst z = fst z') -> (snd z = snd z') -> (z = z') - := fun p q => path_prod_uncurried z z' (p,q). - -Definition path_prod' {A B : Type} {x x' : A} {y y' : B} - : (x = x') -> (y = y') -> ((x,y) = (x',y')) - := fun p q => path_prod (x,y) (x',y') p q. - -End Prod. - -End types. - -End HoTT. - -End HoTT_DOT_types_DOT_Prod. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Delimit Scope functor_scope with functor. - -Local Open Scope morphism_scope. - -Section Functor. - - Variable C : PreCategory. - Variable D : PreCategory. - - Record Functor := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. - -End Functor. -Bind Scope functor_scope with Functor. - -Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Module Export FunctorCoreNotations. - - Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -End FunctorCoreNotations. -End Core. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Morphisms. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Morphisms. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - -Class Isomorphic {C : PreCategory} s d := - { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic - }. - -Module Export CategoryMorphismsNotations. - - Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. - -End CategoryMorphismsNotations. -End Morphisms. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Morphisms. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Dual. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section opposite. - - Definition opposite (C : PreCategory) : PreCategory - := @Build_PreCategory' - C - (fun s d => morphism C d s) - (identity (C := C)) - (fun _ _ _ m1 m2 => m2 o m1) - (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _) - (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _) - (fun _ _ => @right_identity _ _ _) - (fun _ _ => @left_identity _ _ _) - (@identity_identity C) - _. -End opposite. - -Module Export CategoryDualNotations. - - Notation "C ^op" := (opposite C) (at level 3) : category_scope. -End CategoryDualNotations. -End Dual. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Composition. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section composition. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable E : PreCategory. - Variable G : Functor D E. - Variable F : Functor C D. - - Local Notation c_object_of c := (G (F c)) (only parsing). - - Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). - - Let compose_composition_of' s d d' - (m1 : morphism C s d) (m2 : morphism C d d') - : c_morphism_of (m2 o m1) = c_morphism_of m2 o c_morphism_of m1. -admit. -Defined. - Definition compose_composition_of s d d' m1 m2 - := Eval cbv beta iota zeta delta - [compose_composition_of'] in - @compose_composition_of' s d d' m1 m2. - Let compose_identity_of' x - : c_morphism_of (identity x) = identity (c_object_of x). - -admit. -Defined. - Definition compose_identity_of x - := Eval cbv beta iota zeta delta - [compose_identity_of'] in - @compose_identity_of' x. - Definition compose : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)) - compose_composition_of - compose_identity_of. - -End composition. -Module Export FunctorCompositionCoreNotations. - - Infix "o" := compose : functor_scope. -End FunctorCompositionCoreNotations. -End Core. - -End Composition. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Dual. -Set Universe Polymorphism. - -Set Implicit Arguments. - -Section opposite. - - Variable C : PreCategory. - Variable D : PreCategory. - Definition opposite (F : Functor C D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). - -End opposite. -Module Export FunctorDualNotations. - - Notation "F ^op" := (opposite F) : functor_scope. -End FunctorDualNotations. -End Dual. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Functor_DOT_Identity. - -Module Export HoTT. -Module Export categories. -Module Export Functor. -Module Export Identity. -Set Universe Polymorphism. - -Section identity. - - Definition identity C : Functor C C - := Build_Functor C C - (fun x => x) - (fun _ _ x => x) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). -End identity. -Module Export FunctorIdentityNotations. - - Notation "1" := (identity _) : functor_scope. -End FunctorIdentityNotations. -End Identity. - -End Functor. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Functor_DOT_Identity. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. - -Module Export HoTT. -Module Export categories. -Module Export NaturalTransformation. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section NaturalTransformation. - - Variable C : PreCategory. - Variable D : PreCategory. - Variables F G : Functor C D. - - Record NaturalTransformation := - Build_NaturalTransformation' { - components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), - components_of d o F _1 m = G _1 m o components_of s; - - commutes_sym : forall s d (m : C.(morphism) s d), - G _1 m o components_of s = components_of d o F _1 m - }. - -End NaturalTransformation. -End Core. - -End NaturalTransformation. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. - -Module Export HoTT. -Module Export categories. -Module Export NaturalTransformation. -Module Export Dual. -Set Universe Polymorphism. - -Section opposite. - - Variable C : PreCategory. - Variable D : PreCategory. - - Definition opposite - (F G : Functor C D) - (T : NaturalTransformation F G) - : NaturalTransformation G^op F^op - := Build_NaturalTransformation' (G^op) (F^op) - (components_of T) - (fun s d => commutes_sym T d s) - (fun s d => commutes T d s). - -End opposite. - -End Dual. - -End NaturalTransformation. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. - -Module Export HoTT_DOT_categories_DOT_Category_DOT_Strict. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Strict. - -Export Category.Core. -Set Universe Polymorphism. - -End Strict. - -End Category. - -End categories. - -End HoTT. - -End HoTT_DOT_categories_DOT_Category_DOT_Strict. - -Module Export HoTT. -Module Export categories. -Module Export Category. -Module Export Prod. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section prod. - - Variable C : PreCategory. - Variable D : PreCategory. - Definition prod : PreCategory. - - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) - _ - _ - _ - _); admit. - Defined. -End prod. -Module Export CategoryProdNotations. - - Infix "*" := prod : category_scope. -End CategoryProdNotations. -End Prod. - -End Category. - -End categories. - -End HoTT. - -Module Functor. -Module Export Prod. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Section proj. - - Context {C : PreCategory}. - Context {D : PreCategory}. - Definition fst : Functor (C * D) C - := Build_Functor (C * D) C - (@fst _ _) - (fun _ _ => @fst _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - - Definition snd : Functor (C * D) D - := Build_Functor (C * D) D - (@snd _ _) - (fun _ _ => @snd _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - -End proj. - -Section prod. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable D' : PreCategory. - Definition prod (F : Functor C D) (F' : Functor C D') - : Functor C (D * D') - := Build_Functor - C (D * D') - (fun c => (F c, F' c)) - (fun s d m => (F _1 m, F' _1 m)) - (fun _ _ _ _ _ => path_prod' (composition_of F _ _ _ _ _) - (composition_of F' _ _ _ _ _)) - (fun _ => path_prod' (identity_of F _) (identity_of F' _)). - -End prod. -Local Infix "*" := prod : functor_scope. - -Section pair. - - Variable C : PreCategory. - Variable D : PreCategory. - Variable C' : PreCategory. - Variable D' : PreCategory. - Variable F : Functor C D. - Variable F' : Functor C' D'. - Definition pair : Functor (C * C') (D * D') - := (F o fst) * (F' o snd). - -End pair. - -Module Export FunctorProdNotations. - - Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : functor_scope. -End FunctorProdNotations. -End Prod. - -End Functor. - -Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. - -Module Export HoTT. -Module categories. -Module Export NaturalTransformation. -Module Export Composition. -Module Export Core. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope path_scope. - -Local Open Scope morphism_scope. - -Section composition. - - Section compose. - Variable C : PreCategory. - Variable D : PreCategory. - Variables F F' F'' : Functor C D. - Variable T' : NaturalTransformation F' F''. - - Variable T : NaturalTransformation F F'. - Local Notation CO c := (T' c o T c). - - Definition compose_commutes s d (m : morphism C s d) - : CO d o morphism_of F m = morphism_of F'' m o CO s - := (associativity _ _ _ _ _ _ _ _) - @ ap (fun x => _ o x) (commutes T _ _ m) - @ (associativity_sym _ _ _ _ _ _ _ _) - @ ap (fun x => x o _) (commutes T' _ _ m) - @ (associativity _ _ _ _ _ _ _ _). - - Definition compose_commutes_sym s d (m : morphism C s d) - : morphism_of F'' m o CO s = CO d o morphism_of F m - := (associativity_sym _ _ _ _ _ _ _ _) - @ ap (fun x => x o _) (commutes_sym T' _ _ m) - @ (associativity _ _ _ _ _ _ _ _) - @ ap (fun x => _ o x) (commutes_sym T _ _ m) - @ (associativity_sym _ _ _ _ _ _ _ _). - - Definition compose - : NaturalTransformation F F'' - := Build_NaturalTransformation' F F'' - (fun c => CO c) - compose_commutes - compose_commutes_sym. - - End compose. - End composition. -Module Export NaturalTransformationCompositionCoreNotations. - - Infix "o" := compose : natural_transformation_scope. -End NaturalTransformationCompositionCoreNotations. -End Core. - -End Composition. - -End NaturalTransformation. - -End categories. - -Set Universe Polymorphism. - -Section path_natural_transformation. - - Context `{Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - Variables F G : Functor C D. - - Global Instance trunc_natural_transformation - : IsHSet (NaturalTransformation F G). - -admit. -Defined. - Section path. - - Variables T U : NaturalTransformation F G. - - Lemma path'_natural_transformation - : components_of T = components_of U - -> T = U. - -admit. -Defined. - Lemma path_natural_transformation - : components_of T == components_of U - -> T = U. - - Proof. - intros. - apply path'_natural_transformation. - apply path_forall; assumption. - Qed. - End path. -End path_natural_transformation. - -Ltac path_natural_transformation := - repeat match goal with - | _ => intro - | _ => apply path_natural_transformation; simpl - end. - -Module Export Identity. -Set Universe Polymorphism. - -Set Implicit Arguments. -Local Open Scope morphism_scope. - -Local Open Scope path_scope. -Section identity. - - Variable C : PreCategory. - Variable D : PreCategory. - - Section generalized. - - Variables F G : Functor C D. - Hypothesis HO : object_of F = object_of G. - Hypothesis HM : transport (fun GO => forall s d, - morphism C s d - -> morphism D (GO s) (GO d)) - HO - (morphism_of F) - = morphism_of G. - Local Notation CO c := (transport (fun GO => morphism D (F c) (GO c)) - HO - (identity (F c))). - - Definition generalized_identity_commutes s d (m : morphism C s d) - : CO d o morphism_of F m = morphism_of G m o CO s. - - Proof. - case HM. -case HO. - exact (left_identity _ _ _ _ @ (right_identity _ _ _ _)^). - Defined. - Definition generalized_identity_commutes_sym s d (m : morphism C s d) - : morphism_of G m o CO s = CO d o morphism_of F m. - -admit. -Defined. - Definition generalized_identity - : NaturalTransformation F G - := Build_NaturalTransformation' - F G - (fun c => CO c) - generalized_identity_commutes - generalized_identity_commutes_sym. - - End generalized. - Definition identity (F : Functor C D) - : NaturalTransformation F F - := Eval simpl in @generalized_identity F F 1 1. - -End identity. -Module Export NaturalTransformationIdentityNotations. - - Notation "1" := (identity _) : natural_transformation_scope. -End NaturalTransformationIdentityNotations. -End Identity. - -Module Export Laws. -Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. -Set Universe Polymorphism. - -Local Open Scope natural_transformation_scope. -Section natural_transformation_identity. - - Context `{fs : Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - - Lemma left_identity (F F' : Functor C D) - (T : NaturalTransformation F F') - : 1 o T = T. - - Proof. - path_natural_transformation; auto with morphism. - Qed. - - Lemma right_identity (F F' : Functor C D) - (T : NaturalTransformation F F') - : T o 1 = T. - - Proof. - path_natural_transformation; auto with morphism. - Qed. -End natural_transformation_identity. -Section associativity. - - Section nt. - - Context `{fs : Funext}. - Definition associativity - C D F G H I - (V : @NaturalTransformation C D F G) - (U : @NaturalTransformation C D G H) - (T : @NaturalTransformation C D H I) - : (T o U) o V = T o (U o V). - - Proof. - path_natural_transformation. - apply associativity. - Qed. - End nt. -End associativity. -End Laws. - -Module Export FunctorCategory. -Module Export Core. -Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. -Set Universe Polymorphism. - -Section functor_category. - - Context `{Funext}. - Variable C : PreCategory. - - Variable D : PreCategory. - - Definition functor_category : PreCategory - := @Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - (@identity C D) - (@compose C D) - (@associativity _ C D) - (@left_identity _ C D) - (@right_identity _ C D) - _. - -End functor_category. -Module Export FunctorCategoryCoreNotations. - - Notation "C -> D" := (functor_category C D) : category_scope. -End FunctorCategoryCoreNotations. -End Core. - -End FunctorCategory. - -Module Export Morphisms. -Set Universe Polymorphism. - -Set Implicit Arguments. - -Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := - @Isomorphic (C -> D) F G. - -Module Export FunctorCategoryMorphismsNotations. - - Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. -End FunctorCategoryMorphismsNotations. -End Morphisms. - -Module Export HSet. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. - -Global Existing Instance iss. -End HSet. - -Module Export Core. -Set Universe Polymorphism. - -Notation cat_of obj := - (@Build_PreCategory obj - (fun x y => x -> y) - (fun _ x => x) - (fun _ _ _ f g => f o g)%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - _). - -Definition set_cat `{Funext} : PreCategory := cat_of hSet. -Set Universe Polymorphism. - -Local Open Scope morphism_scope. - -Section hom_functor. - - Context `{Funext}. - Variable C : PreCategory. - Local Notation obj_of c'c := - (BuildhSet - (morphism - C - (fst (c'c : object (C^op * C))) - (snd (c'c : object (C^op * C)))) - _). - - Let hom_functor_morphism_of s's d'd (hf : morphism (C^op * C) s's d'd) - : morphism set_cat (obj_of s's) (obj_of d'd) - := fun g => snd hf o g o fst hf. - - Definition hom_functor : Functor (C^op * C) set_cat. - - refine (Build_Functor (C^op * C) set_cat - (fun c'c => obj_of c'c) - hom_functor_morphism_of - _ - _); - subst hom_functor_morphism_of; - simpl; admit. - Defined. -End hom_functor. -Set Universe Polymorphism. - -Import Category.Dual Functor.Dual. -Import Category.Prod Functor.Prod. -Import Functor.Composition.Core. -Import Functor.Identity. -Set Universe Polymorphism. - -Local Open Scope functor_scope. -Local Open Scope natural_transformation_scope. -Section Adjunction. - - Context `{Funext}. - Variable C : PreCategory. - Variable D : PreCategory. - Variable F : Functor C D. - Variable G : Functor D C. - - Let Adjunction_Type := - Eval simpl in (hom_functor D) o (F^op, 1) <~=~> (hom_functor C) o (1, G). - - Record AdjunctionHom := - { - mate_of : - @NaturalIsomorphism H - (Prod.prod (Category.Dual.opposite C) D) - (@set_cat H) - (@compose (Prod.prod (Category.Dual.opposite C) D) - (Prod.prod (Category.Dual.opposite D) D) - (@set_cat H) (@hom_functor H D) - (@pair (Category.Dual.opposite C) - (Category.Dual.opposite D) D D - (@opposite C D F) (identity D))) - (@compose (Prod.prod (Category.Dual.opposite C) D) - (Prod.prod (Category.Dual.opposite C) C) - (@set_cat H) (@hom_functor H C) - (@pair (Category.Dual.opposite C) - (Category.Dual.opposite C) D C - (identity (Category.Dual.opposite C)) G)) - }. -End Adjunction. -(* Error: Illegal application: -The term "NaturalIsomorphism" of type - "forall (H : Funext) (C D : PreCategory), - (C -> D)%category -> (C -> D)%category -> Type" -cannot be applied to the terms - "H" : "Funext" - "(C ^op * D)%category" : "PreCategory" - "set_cat" : "PreCategory" - "hom_functor D o (F ^op, 1)" : "Functor (C ^op * D) set_cat" - "hom_functor C o (1, G)" : "Functor (C ^op * D) set_cat" -The 5th term has type "Functor (C ^op * D) set_cat" -which should be coercible to "object (C ^op * D -> set_cat)". -*) -End Core. - -End HoTT. - -End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. diff --git a/test-suite/bugs/closed/3331.v b/test-suite/bugs/closed/3331.v deleted file mode 100644 index b7dbb290e1..0000000000 --- a/test-suite/bugs/closed/3331.v +++ /dev/null @@ -1,31 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 6303 lines to 66 lines, then from 63 lines to 36 lines *) -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y :> A" := (@paths A x y) : type_scope. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (x = y :>_) : type_scope. -Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. -Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. -Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : IsTrunc n (x = y) := H x y. -Notation Contr := (IsTrunc minus_two). -Section groupoid_category. - Variable X : Type. - Context `{H : IsTrunc (trunc_S (trunc_S (trunc_S minus_two))) X}. - Goal X -> True. - intro d. - pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))) as H'. (* success *) - clear H'. - compute in H. - change (forall (x y : X) (p q : x = y) (r s : p = q), Contr (r = s)) in H. - assert (H' := H). - set (foo:=_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). (* success *) - clear H' foo. - Set Typeclasses Debug. - pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). -Abort. diff --git a/test-suite/bugs/closed/3337.v b/test-suite/bugs/closed/3337.v deleted file mode 100644 index cd7891f112..0000000000 --- a/test-suite/bugs/closed/3337.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Setoid. -Goal forall x y : Set, x = y -> x = y. -intros x y H. -rewrite_strat subterms H. diff --git a/test-suite/bugs/closed/3338.v b/test-suite/bugs/closed/3338.v deleted file mode 100644 index 076cd5e6ea..0000000000 --- a/test-suite/bugs/closed/3338.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Setoid. -Goal forall x y : Set, x = y -> y = y. -intros x y H. -rewrite_strat try topdown terms H. diff --git a/test-suite/bugs/closed/3368.v b/test-suite/bugs/closed/3368.v deleted file mode 100644 index 1eff1dba8a..0000000000 --- a/test-suite/bugs/closed/3368.v +++ /dev/null @@ -1,16 +0,0 @@ -(* File reduced by coq-bug-finder from 7411 lines to 2271 lines., then from 889 lines to 119 lines, then from 76 lines to 19 lines *) -Set Universe Polymorphism. -Set Implicit Arguments. -Set Primitive Projections. -Record PreCategory := { object :> Type; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). -Definition opposite' C D (F : Functor C D) - := Build_Functor (opposite C) (opposite D) - (object_of F) - (fun s d => @morphism_of C D F d s). -(* Toplevel input, characters 15-191: -Anomaly: File "pretyping/reductionops.ml", line 149, characters 4-10: Assertion failed. -Please report. *) diff --git a/test-suite/bugs/closed/3372.v b/test-suite/bugs/closed/3372.v deleted file mode 100644 index 91e3df76dd..0000000000 --- a/test-suite/bugs/closed/3372.v +++ /dev/null @@ -1,7 +0,0 @@ -Set Universe Polymorphism. -Definition hProp : Type := sigT (fun _ : Type => True). -Goal Type. -Fail exact hProp@{Set}. (* test that it fails, but is not an anomaly *) -try (exact hProp@{Set}; fail 1). (* Toplevel input, characters 15-32: -Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). -Please report. *) diff --git a/test-suite/bugs/closed/3383.v b/test-suite/bugs/closed/3383.v deleted file mode 100644 index 25257644a6..0000000000 --- a/test-suite/bugs/closed/3383.v +++ /dev/null @@ -1,6 +0,0 @@ -Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end. -intro. -lazymatch goal with -| [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ] - => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b) -end. diff --git a/test-suite/bugs/closed/3386.v b/test-suite/bugs/closed/3386.v deleted file mode 100644 index b8bb8bce09..0000000000 --- a/test-suite/bugs/closed/3386.v +++ /dev/null @@ -1,17 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. -Set Printing Universes. -Record Cat := { Obj :> Type }. -Definition set_cat := {| Obj := Type |}. -Goal Type@{i} = Type@{j}. -Proof. - (* 1 subgoals -, subgoal 1 (ID 3) - - ============================ - Type@{Top.368} = Type@{Top.370} -(dependent evars:) *) - Fail change Type@{i} with (Obj set_cat@{i}). (* check that it fails *) - try change Type@{i} with (Obj set_cat@{i}). (* check that it's not an anomaly *) -(* Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). -Please report. *) diff --git a/test-suite/bugs/closed/3390.v b/test-suite/bugs/closed/3390.v deleted file mode 100644 index eb3c4f4b9c..0000000000 --- a/test-suite/bugs/closed/3390.v +++ /dev/null @@ -1,9 +0,0 @@ -Tactic Notation "basicapply" open_constr(R) "using" tactic3(tac) "sideconditions" tactic0(tacfin) := idtac. -Tactic Notation "basicapply" open_constr(R) := basicapply R using (fun Hlem => idtac) sideconditions (autounfold with spred; idtac). -(* segfault in coqtop *) - - -Tactic Notation "basicapply" tactic0(tacfin) := idtac. - -Goal True. -basicapply subst. diff --git a/test-suite/bugs/closed/3393.v b/test-suite/bugs/closed/3393.v deleted file mode 100644 index ae8e41e29e..0000000000 --- a/test-suite/bugs/closed/3393.v +++ /dev/null @@ -1,153 +0,0 @@ -Require Import TestSuite.admit. -(* -*- coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 8760 lines to 7519 lines, then from 7050 lines to 909 lines, then from 846 lines to 578 lines, then from 497 lines to 392 lines, then from 365 lines to 322 lines, then from 252 lines to 205 lines, then from 215 lines to 204 lines, then from 210 lines to 182 lines, then from 175 lines to 157 lines *) -Set Universe Polymorphism. -Axiom admit : forall {T}, T. -Set Implicit Arguments. -Generalizable All Variables. -Reserved Notation "g 'o' f" (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "a = b" := (@paths _ a b) : type_scope. -Arguments idpath {A a} , [A] a. -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. -Delimit Scope equiv_scope with equiv. -Local Open Scope equiv_scope. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. -Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. -Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : (forall x, f x = g x) -> f = g := (@apD10 A P f g)^-1. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' where "f 'o' g" := (compose f g); - associativity : forall x1 x2 x3 x4 (m1 : morphism x1 x2) (m2 : morphism x2 x3) (m3 : morphism x3 x4), (m3 o m2) o m1 = m3 o (m2 o m1) - }. -Bind Scope category_scope with PreCategory. -Bind Scope morphism_scope with morphism. -Infix "o" := (@compose _ _ _ _) : morphism_scope. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Bind Scope functor_scope with Functor. -Notation "F '_1' m" := (@morphism_of _ _ F _ _ m) (at level 10, no associativity) : morphism_scope. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. -Class Isomorphic {C : PreCategory} s d := - { morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. -Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. - -Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) : IsIsomorphism (m0 o m1). -Admitted. -Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. -Definition composef C D E (G : Functor D E) (F : Functor C D) : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => @morphism_of _ _ G _ _ (@morphism_of _ _ F _ _ m)). -Infix "o" := composef : functor_scope. -Delimit Scope natural_transformation_scope with natural_transformation. - -Local Open Scope morphism_scope. -Record NaturalTransformation C D (F G : Functor C D) := - { components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), components_of d o F _1 m = G _1 m o components_of s }. - -Definition composet C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') -: NaturalTransformation F F'' - := Build_NaturalTransformation F F'' (fun c => T' c o T c) admit. -Infix "o" := composet : natural_transformation_scope. -Section path_natural_transformation. - Context `{Funext}. - Variable C : PreCategory. - Variable D : PreCategory. - Variables F G : Functor C D. - Section path. - Variables T U : NaturalTransformation F G. - Lemma path'_natural_transformation - : components_of T = components_of U - -> T = U. - admit. - Defined. - Lemma path_natural_transformation - : (forall x, components_of T x = components_of U x) - -> T = U. - Proof. - intros. - apply path'_natural_transformation. - apply path_forall; assumption. - Qed. - End path. -End path_natural_transformation. -Ltac path_natural_transformation := - repeat match goal with - | _ => intro - | _ => apply path_natural_transformation; simpl - end. - -Local Open Scope natural_transformation_scope. -Definition associativityt `{fs : Funext} - C D F G H I - (V : @NaturalTransformation C D F G) - (U : @NaturalTransformation C D G H) - (T : @NaturalTransformation C D H I) -: (T o U) o V = T o (U o V). -Proof. - path_natural_transformation. - apply associativity. -Qed. -Definition functor_category `{Funext} (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composet C D) (@associativityt _ C D). -Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := @Isomorphic (C -> D) F G. -Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. -Global Instance isisomorphism_compose' `{Funext} - `(T' : @NaturalTransformation C D F' F'') - `(T : @NaturalTransformation C D F F') - `{@IsIsomorphism (C -> D) F' F'' T'} - `{@IsIsomorphism (C -> D) F F' T} -: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation - := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. -Section lemmas. - Context `{Funext}. - Variable C : PreCategory. - Variable F : C -> PreCategory. - Context - {w y z} - {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} - {f2 : Functor (F y) (F z)} - {f5 : Functor (F w) (F z)} - {n2 : f <~=~> (f2 o f0)%functor}. - Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' XX - : @IsIsomorphism - (F w -> F z) f5 f - (n2 ^-1 o XX)%natural_transformation. - Proof. - eapply isisomorphism_compose'. - eapply isisomorphism_inverse. (* Toplevel input, characters 22-43: -Error: -In environment -H : Funext -C : PreCategory -F : C -> PreCategory -w : C -y : C -z : C -f : Functor (F w) (F z) -f0 : Functor (F w) (F y) -f2 : Functor (F y) (F z) -f5 : Functor (F w) (F z) -n2 : f <~=~> (f2 o f0)%functor -XX : NaturalTransformation f5 (f2 o f0) -Unable to unify - "{| - object := Functor (F w) (F z); - morphism := NaturalTransformation (D:=F z); - compose := composet (D:=F z); - associativity := associativityt (D:=F z) |}" with - "{| - object := Functor (F w) (F z); - morphism := NaturalTransformation (D:=F z); - compose := composet (D:=F z); - associativity := associativityt (D:=F z) |}". *) diff --git a/test-suite/bugs/closed/3408.v b/test-suite/bugs/closed/3408.v deleted file mode 100644 index b12b8c1afb..0000000000 --- a/test-suite/bugs/closed/3408.v +++ /dev/null @@ -1,163 +0,0 @@ -Require Import BinPos. - -Inductive expr : Type := - Var : nat -> expr -| App : expr -> expr -> expr -| Abs : unit -> expr -> expr. - -Inductive expr_acc -: expr -> expr -> Prop := - acc_App_l : forall f a : expr, - expr_acc f (App f a) -| acc_App_r : forall f a : expr, - expr_acc a (App f a) -| acc_Abs : forall (t : unit) (e : expr), - expr_acc e (Abs t e). - -Theorem wf_expr_acc : well_founded expr_acc. -Proof. - red. - refine (fix rec a : Acc expr_acc a := - match a as a return Acc expr_acc a with - | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => - match _H in expr_acc z Z - return match Z return Prop with - | Var _ => Acc _ y - | _ => True - end - with - | acc_App_l _ _ => I - | _ => I - end) - | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => - match pf in expr_acc z Z - return match Z return Prop with - | App a b => f = a -> x = b -> Acc expr_acc z - | _ => True - end - with - | acc_App_l f' x' => fun pf _ => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec f - end - | acc_App_r f' x' => fun _ pf => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec x - end - | _ => I - end eq_refl eq_refl) - | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => - match pf in expr_acc z Z - return match Z return Prop with - | Abs a b => e = b -> Acc expr_acc z - | _ => True - end - with - | acc_Abs f x => fun pf => match pf in _ = z return - Acc expr_acc z - with - | eq_refl => rec e - end - | _ => I - end eq_refl) - end). -Defined. - -Theorem wf_expr_acc_delay : well_founded expr_acc. -Proof. - red. - refine (fix rec a : Acc expr_acc a := - match a as a return Acc expr_acc a with - | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => - match _H in expr_acc z Z - return match Z return Prop with - | Var _ => Acc _ y - | _ => True - end - with - | acc_App_l _ _ => I - | _ => I - end) - | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => - match pf in expr_acc z Z - return match Z return Prop with - | App a b => (unit -> Acc expr_acc a) -> (unit -> Acc expr_acc b) -> Acc expr_acc z - | _ => True - end - with - | acc_App_l f' x' => fun pf _ => pf tt - | acc_App_r f' x' => fun _ pf => pf tt - | _ => I - end (fun _ => rec f) (fun _ => rec x)) - | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => - match pf in expr_acc z Z - return match Z return Prop with - | Abs a b => (unit -> Acc expr_acc b) -> Acc expr_acc z - | _ => True - end - with - | acc_Abs f x => fun pf => pf tt - | _ => I - end (fun _ => rec e)) - end); - try solve [ inversion _H ]. -Defined. - -Fixpoint build_large (n : nat) : expr := - match n with - | 0 => Var 0 - | S n => - let e := build_large n in - App e e - end. - -Section guard. - Context {A : Type} {R : A -> A -> Prop}. - - Fixpoint guard (n : nat) (wfR : well_founded R) : well_founded R := - match n with - | 0 => wfR - | S n0 => - fun x : A => - Acc_intro x - (fun (y : A) (_ : R y x) => guard n0 (guard n0 wfR) y) - end. -End guard. - - -Definition sizeF_delay : expr -> positive. -refine - (@Fix expr (expr_acc) - (wf_expr_acc_delay) - (fun _ => positive) - (fun e => - match e as e return (forall l, expr_acc l e -> positive) -> positive with - | Var _ => fun _ => 1 - | App l r => fun rec => @rec l _ + @rec r _ - | Abs _ e => fun rec => 1 + @rec e _ - end%positive)). -eapply acc_App_l. -eapply acc_App_r. -eapply acc_Abs. -Defined. - -Definition sizeF_guard : expr -> positive. -refine - (@Fix expr (expr_acc) - (guard 5 wf_expr_acc) - (fun _ => positive) - (fun e => - match e as e return (forall l, expr_acc l e -> positive) -> positive with - | Var _ => fun _ => 1 - | App l r => fun rec => @rec l _ + @rec r _ - | Abs _ e => fun rec => 1 + @rec e _ - end%positive)). -eapply acc_App_l. -eapply acc_App_r. -eapply acc_Abs. -Defined. - -Time Eval native_compute in sizeF_delay (build_large 2). -Time Eval native_compute in sizeF_guard (build_large 2). diff --git a/test-suite/bugs/closed/3427.v b/test-suite/bugs/closed/3427.v deleted file mode 100644 index 9a57ca7703..0000000000 --- a/test-suite/bugs/closed/3427.v +++ /dev/null @@ -1,196 +0,0 @@ -Require Import TestSuite.admit. -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 0 lines to 7171 lines, then from 7184 lines to 558 lines, then from 556 lines to 209 lines *) -Generalizable All Variables. -Set Universe Polymorphism. -Notation Type0 := Set. -Notation idmap := (fun x => x). -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Delimit Scope path_scope with path. -Local Open Scope path_scope. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3) : path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) - }. -Record Equiv A B := BuildEquiv { - equiv_fun :> A -> B ; - equiv_isequiv :> IsEquiv equiv_fun - }. - -Delimit Scope equiv_scope with equiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) - }. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint nat_to_trunc_index (n : nat) : trunc_index - := match n with - | 0 => trunc_S (trunc_S minus_two) - | S n' => trunc_S (nat_to_trunc_index n') - end. - -Coercion nat_to_trunc_index : nat >-> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Notation minus_one:=(trunc_S minus_two). - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation Contr := (IsTrunc minus_two). -Notation IsHProp := (IsTrunc minus_one). -Notation IsHSet := (IsTrunc 0). - -Class Funext := - { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. - -Definition concat_pV {A : Type} {x y : A} (p : x = y) : - p @ p^ = 1 - := - match p with idpath => 1 end. - -Definition concat_Vp {A : Type} {x y : A} (p : x = y) : - p^ @ p = 1 - := - match p with idpath => 1 end. - -Definition transport_pp {A : Type} (P : A -> Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) : - p @ q # u = q # p # u := - match q with idpath => - match p with idpath => 1 end - end. - -Definition transport2 {A : Type} (P : A -> Type) {x y : A} {p q : x = y} - (r : p = q) (z : P x) -: p # z = q # z - := ap (fun p' => p' # z) r. - -Inductive Unit : Type0 := - tt : Unit. - -Instance contr_unit : Contr Unit | 0 := let x := {| - center := tt; - contr := fun t : Unit => match t with tt => 1 end - |} in x. - -Instance trunc_succ `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. -admit. -Defined. - -Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. -Definition Unit_hp:hProp:=(hp Unit _). - -Global Instance isequiv_ap_hproptype `{Funext} X Y : IsEquiv (@ap _ _ hproptype X Y). -admit. -Defined. - -Definition path_hprop `{Funext} X Y := (@ap _ _ hproptype X Y)^-1%equiv. - -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Local Open Scope equiv_scope. - -Instance isequiv_path {A B : Type} (p : A = B) -: IsEquiv (transport (fun X:Type => X) p) | 0 - := BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) - (fun b => ((transport_pp idmap p^ p b)^ @ transport2 idmap (concat_Vp p) b)) - (fun a => ((transport_pp idmap p p^ a)^ @ transport2 idmap (concat_pV p) a)) - (fun a => match p in _ = C return - (transport_pp idmap p^ p (transport idmap p a))^ @ - transport2 idmap (concat_Vp p) (transport idmap p a) = - ap (transport idmap p) ((transport_pp idmap p p^ a) ^ @ - transport2 idmap (concat_pV p) a) with idpath => 1 end). - -Definition equiv_path (A B : Type) (p : A = B) : A <~> B - := BuildEquiv _ _ (transport (fun X:Type => X) p) _. - -Class Univalence := { - isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) - }. - -Section Univalence. - Context `{Univalence}. - - Definition path_universe_uncurried {A B : Type} (f : A <~> B) : A = B - := (equiv_path A B)^-1 f. -End Univalence. - -Local Inductive minus1Trunc (A :Type) : Type := - min1 : A -> minus1Trunc A. - -Instance minus1Trunc_is_prop {A : Type} : IsHProp (minus1Trunc A) | 0. -admit. -Defined. - -Definition hexists {X} (P:X->Type):Type:= minus1Trunc (sigT P). - -Section AssumingUA. - - Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, - forall g h: Y -> Z, g o f = h o f -> g = h. - Context {X Y : hSet} (f : X -> Y) (Hisepi : isepi f). - - Goal forall (X Y : hSet) (f : forall _ : setT X, setT Y), - let fib := - fun y : setT Y => - hp (@hexists (setT X) (fun x : setT X => @paths (setT Y) (f x) y)) - (@minus1Trunc_is_prop - (@sigT (setT X) (fun x : setT X => @paths (setT Y) (f x) y))) in - forall (x : setT X) (_ : Univalence) (_ : Funext), - @paths hProp (fib (f x)) Unit_hp. - intros. - - apply path_hprop. - simpl. - Set Printing Universes. - Set Printing All. - refine (path_universe_uncurried _). - Undo. - apply path_universe_uncurried. (* Toplevel input, characters 21-44: -Error: Refiner was given an argument - "@path_universe_uncurried (* Top.425 Top.426 Top.427 Top.428 Top.429 *) X1 - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit - ?63" of type - "@paths (* Top.428 *) Type (* Top.425 *) - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit" -instead of - "@paths (* Top.413 *) Type (* Set *) - (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) - (fun x0 : setT (* Top.405 *) X0 => - @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit". - *) diff --git a/test-suite/bugs/closed/3428.v b/test-suite/bugs/closed/3428.v deleted file mode 100644 index 16ace90af3..0000000000 --- a/test-suite/bugs/closed/3428.v +++ /dev/null @@ -1,35 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 2809 lines to 39 lines *) -Set Primitive Projections. -Set Implicit Arguments. -Module Export foo. - Record prod (A B : Type) := pair { fst : A ; snd : B }. -End foo. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Axiom path_prod : forall {A B : Type} (z z' : prod A B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Notation fst := (@fst _ _). -Notation snd := (@snd _ _). -Definition ap_fst_path_prod {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') -: ap fst (path_prod z z' p q) = p. -Abort. - -Notation fstp x := (x.(foo.fst)). -Notation fstap x := (foo.fst x). - -Definition ap_fst_path_prod' {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') -: ap (fun x => fstap x) (path_prod z z' p q) = p. - -Abort. - -(* Toplevel input, characters 137-138: -Error: -In environment -A : Type -B : Type -z : prod A B -z' : prod A B -p : @paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z') -q : @paths ?54 (foo.snd ?42 ?45 z) (foo.snd ?57 ?60 z') -The term "p" has type "@paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')" -while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *) diff --git a/test-suite/bugs/closed/3441.v b/test-suite/bugs/closed/3441.v deleted file mode 100644 index ddfb339443..0000000000 --- a/test-suite/bugs/closed/3441.v +++ /dev/null @@ -1,23 +0,0 @@ -Axiom f : nat -> nat -> nat. -Fixpoint do_n (n : nat) (k : nat) := - match n with - | 0 => k - | S n' => do_n n' (f k k) - end. - -Notation big := (_ = _). -Axiom k : nat. -Goal True. -Timeout 1 let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *) -Timeout 1 let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *) - -Timeout 1 Time let H := fresh "H" in - let x := constr:(let n := 17 in do_n n = do_n n) in - let y := (eval lazy in x) in - assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) diff --git a/test-suite/bugs/closed/3446.v b/test-suite/bugs/closed/3446.v deleted file mode 100644 index 8a0c98c333..0000000000 --- a/test-suite/bugs/closed/3446.v +++ /dev/null @@ -1,51 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7372 lines to 539 lines, then from 531 lines to 107 lines, then from 76 lines to 46 lines *) -Module First. -Set Asymmetric Patterns. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Notation "A -> B" := (forall (_ : A), B). -Set Universe Polymorphism. - - -Notation "x → y" := (x -> y) - (at level 99, y at level 200, right associativity): type_scope. -Record sigT A (P : A -> Type) := - { projT1 : A ; projT2 : P projT1 }. -Arguments projT1 {A P} s. -Arguments projT2 {A P} s. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Reserved Notation "x = y" (at level 70, no associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y). -Notation " x = y " := (paths x y) : type_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Reserved Notation "{ x : A & P }" (at level 0, x at level 99). -Notation "{ x : A & P }" := (sigT A (fun x => P)) : type_scope. - - -Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT A P) (pq : {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v}), u = v. -Axiom isequiv_pr1_contr : forall {A} {P : A -> Type}, (A -> {x : A & P x}). - -Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT _ P) := - @compose _ _ _ (path_sigma_uncurried P u v) (@isequiv_pr1_contr _ _). -End First. - -Set Asymmetric Patterns. -Set Universe Polymorphism. -Arguments projT1 {_ _} _. -Notation "( x ; y )" := (existT _ x y). -Notation pr1 := projT1. -Notation "x .1" := (projT1 x) (at level 3). -Notation "x .2" := (projT2 x) (at level 3). -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). -Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT P) (pq : {p : u.1 = v.1 & p # u.2 = v.2}), u = v. -Instance isequiv_pr1_contr {A} {P : A -> Type} : IsEquiv (@pr1 A P) | 100. -Admitted. - -Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT P) : u.1 = v.1 -> u = v := - path_sigma_uncurried P u v o pr1^-1. diff --git a/test-suite/bugs/closed/3454.v b/test-suite/bugs/closed/3454.v deleted file mode 100644 index ca4d23803e..0000000000 --- a/test-suite/bugs/closed/3454.v +++ /dev/null @@ -1,63 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. - -Record prod {A} {B}:= pair { fst : A ; snd : B }. -Notation " A * B " := (@prod A B) : type_scope. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation pr1 := (@projT1 _ _). -Arguments prod : clear implicits. - -Check (@projT1 _ (fun x : nat => x = x)). -Check (fun s : @sigT nat (fun x : nat => x = x) => s.(projT1)). - -Record rimpl {b : bool} {n : nat} := { foo : forall {x : nat}, x = n }. - -Check (fun r : @rimpl true 0 => r.(foo) (x:=0)). -Check (fun r : @rimpl true 0 => @foo true 0 r 0). -Check (fun r : @rimpl true 0 => foo r (x:=0)). -Check (fun r : @rimpl true 0 => @foo _ _ r 0). -Check (fun r : @rimpl true 0 => r.(@foo _ _)). -Check (fun r : @rimpl true 0 => r.(foo)). - -Notation "{ x : T & P }" := (@sigT T P). -Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope. -(* Notation "{ x : T * U & P }" := (@sigT (T * U) P). *) - -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Class IsEquiv {A B : Type} (f : A -> B) := {}. - -Local Instance isequiv_tgt_compose A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B - (@compose {xy : B * B & fst xy = snd xy} _ B (@snd B B) pr1)). -(* Toplevel input, characters 220-223: *) -(* Error: Cannot infer this placeholder. *) - -Local Instance isequiv_tgt_compose' A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) pr1)). -(* Toplevel input, characters 221-232: *) -(* Error: *) -(* In environment *) -(* A : Type *) -(* B : Type *) -(* The term "pr1" has type "sigT ?30 -> ?29" while it is expected to have type *) -(* "{xy : B * B & fst xy = snd xy} -> ?27 * B". *) - -Local Instance isequiv_tgt_compose'' A B -: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) - (A -> B) - (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) - (fun s => s.(projT1)))). -(* Toplevel input, characters 15-241: -Error: -Cannot infer an internal placeholder of type "Type" in environment: - -A : Type -B : Type -x : ?32 -. *) diff --git a/test-suite/bugs/closed/3461.v b/test-suite/bugs/closed/3461.v deleted file mode 100644 index 1b625e6a15..0000000000 --- a/test-suite/bugs/closed/3461.v +++ /dev/null @@ -1,5 +0,0 @@ -Lemma foo (b : bool) : - exists x : nat, x = x. -Proof. -eexists. -Fail eexact (eq_refl b). diff --git a/test-suite/bugs/closed/3469.v b/test-suite/bugs/closed/3469.v deleted file mode 100644 index b09edc65b0..0000000000 --- a/test-suite/bugs/closed/3469.v +++ /dev/null @@ -1,29 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 538 lines to 31 lines *) -Open Scope type_scope. -Global Set Primitive Projections. -Set Implicit Arguments. -Record sig (A : Type) (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. -Notation sigT := sig (only parsing). -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). -Variables X : Type. -Variable R : X -> X -> Type. -Lemma dependent_choice : - (forall x:X, {y : _ & R x y}) -> - forall x0, {f : nat -> X & (f O = x0) * (forall n, R (f n) (f (S n)))}. -Proof. - intros H x0. - set (f:=fix f n := match n with O => x0 | S n' => projT1 (H (f n')) end). - exists f. - split. - reflexivity. - induction n; simpl in *. - clear. - apply (proj2_sig (H x0)). - Undo. - apply @proj2_sig. - - -(* Toplevel input, characters 21-31: -Error: Found no subterm matching "proj1_sig ?206" in the current *) diff --git a/test-suite/bugs/closed/3477.v b/test-suite/bugs/closed/3477.v deleted file mode 100644 index 3ed63604ea..0000000000 --- a/test-suite/bugs/closed/3477.v +++ /dev/null @@ -1,9 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall A B : Set, True. -Proof. - intros A B. - evar (a : prod A B); evar (f : (prod A B -> Set)). - let a' := (eval unfold a in a) in - set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))). diff --git a/test-suite/bugs/closed/3480.v b/test-suite/bugs/closed/3480.v deleted file mode 100644 index 35e0c51a93..0000000000 --- a/test-suite/bugs/closed/3480.v +++ /dev/null @@ -1,48 +0,0 @@ -Require Import TestSuite.admit. -Set Primitive Projections. -Axiom admit : forall {T}, T. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Set Implicit Arguments. -Delimit Scope category_scope with category. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Local Open Scope category_scope. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Class Isomorphic {C : PreCategory} s d := { morphism_isomorphic :> @morphism C s d ; isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. -Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. -Definition idtoiso (C : PreCategory) (x y : C) (H : x = y) : Isomorphic x y := admit. -Record NotionOfStructure (X : PreCategory) := { structure :> X -> Type }. -Record Smorphism (X : PreCategory) (P : NotionOfStructure X) (xa yb : { x : X & P x }) := { f : morphism X xa.1 yb.1 }. -Definition precategory_of_structures X (P : NotionOfStructure X) : PreCategory. -Proof. - refine (@Build_PreCategory _ (@Smorphism _ P)). -Defined. -Section sip. - Variable X : PreCategory. - Variable P : NotionOfStructure X. - - Let StrX := @precategory_of_structures X P. - - Definition sip_isotoid (xa yb : StrX) (f : xa <~=~> yb) : xa = yb. - admit. - Defined. - - Lemma structure_identity_principle_helper (xa yb : StrX) - (x : xa <~=~> yb) : Smorphism P xa yb. - Proof. - refine ((idtoiso (precategory_of_structures P) (sip_isotoid x) : @morphism _ _ _) : morphism _ _ _). -(* Toplevel input, characters 24-95: -Error: -In environment -X : PreCategory -P : NotionOfStructure X -StrX := precategory_of_structures P : PreCategory -xa : object StrX -yb : object StrX -x : xa <~=~> yb -The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb" -has type "@morphism (precategory_of_structures P) xa yb" -while it is expected to have type "morphism ?40 ?41 ?42". *) diff --git a/test-suite/bugs/closed/3481.v b/test-suite/bugs/closed/3481.v deleted file mode 100644 index 38f03b166b..0000000000 --- a/test-suite/bugs/closed/3481.v +++ /dev/null @@ -1,70 +0,0 @@ - -Set Implicit Arguments. - -Require Import Logic. -Module NonPrim. -Local Set Nonrecursive Elimination Schemes. -Record prodwithlet (A B : Type) : Type := - pair' { fst : A; fst' := fst; snd : B }. - -Definition letreclet (p : prodwithlet nat nat) := - let (x, x', y) := p in x + y. - -Definition pletreclet (p : prodwithlet nat nat) := - let 'pair' x x' y := p in x + y + x'. - -Definition pletreclet2 (p : prodwithlet nat nat) := - let 'pair' x y := p in x + y. - -Check (pair 0 0). -End NonPrim. - -Global Set Universe Polymorphism. -Global Set Asymmetric Patterns. -Local Set Nonrecursive Elimination Schemes. -Local Set Primitive Projections. - -Record prod (A B : Type) : Type := - pair { fst : A; snd : B }. - -Print prod_rect. - -(* What I really want: *) -Definition prod_rect' A B (P : prod A B -> Type) (u : forall (fst : A) (snd : B), P (pair fst snd)) - (p : prod A B) : P p - := u (fst p) (snd p). - -Definition conv : @prod_rect = @prod_rect'. -Proof. reflexivity. Defined. - -Definition imposs := - (fun A B P f (p : prod A B) => match p as p0 return P p0 with - | {| fst := x ; snd := x0 |} => f x x0 - end). - -Definition letrec (p : prod nat nat) := - let (x, y) := p in x + y. -Eval compute in letrec (pair 1 5). - -Goal forall p : prod nat nat, letrec p = fst p + snd p. -Proof. - reflexivity. - Undo. - intros p. - case p. simpl. unfold letrec. simpl. reflexivity. -Defined. - -Eval compute in conv. (* = eq_refl - : prod_rect = prod_rect' *) - -Check eq_refl : @prod_rect = @prod_rect'. (* Toplevel input, characters 6-13: -Error: -The term "eq_refl" has type "prod_rect = prod_rect" -while it is expected to have type "prod_rect = prod_rect'" -(cannot unify "prod_rect" and "prod_rect'"). *) - -Record sigma (A : Type) (B : A -> Type) : Type := - dpair { pi1 : A ; pi2 : B pi1 }. - - - diff --git a/test-suite/bugs/closed/3483.v b/test-suite/bugs/closed/3483.v deleted file mode 100644 index 2cc6618620..0000000000 --- a/test-suite/bugs/closed/3483.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Check proper failing when using notation of non-constructors in - pattern-bmatching *) - -Fail Definition nonsense ( x : False ) := match x with y + 2 => 0 end. - diff --git a/test-suite/bugs/closed/3484.v b/test-suite/bugs/closed/3484.v deleted file mode 100644 index a0e157303f..0000000000 --- a/test-suite/bugs/closed/3484.v +++ /dev/null @@ -1,31 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 14259 lines to 305 lines, then from 237 lines to 120 lines, then from 100 lines to 30 lines *) -Set Primitive Projections. -Set Implicit Arguments. -Record sigT (A : Type) (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation "{ x : A & P }" := (@sigT A (fun x : A => P)) : type_scope. -Notation pr1 := (@projT1 _ _). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Goal forall (T : Type) (H : { g : T & g = g }) (x : T), projT1 H = projT1 (existT (fun g : T => g = g) x idpath). -Proof. - intros. - let y := match goal with |- projT1 ?x = projT1 ?y => constr:(y) end in - apply (@ap _ _ pr1 _ y). - Undo. - Unset Printing Notations. - apply (ap pr1). - Undo. - refine (ap pr1 _). -admit. -Defined. - -(* Toplevel input, characters 22-28: -Error: -In environment -T : Type -H : sigT T (fun g : T => paths g g) -x : T -Unable to unify "paths (@projT1 ?24 ?23 ?25) (@projT1 ?24 ?23 ?26)" with - "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *) diff --git a/test-suite/bugs/closed/3490.v b/test-suite/bugs/closed/3490.v deleted file mode 100644 index e7a5caa1de..0000000000 --- a/test-suite/bugs/closed/3490.v +++ /dev/null @@ -1,27 +0,0 @@ -Inductive T : Type := -| Var : nat -> T -| Arr : T -> T -> T. - -Inductive Tele : list T -> Type := -| Tnil : @Tele nil -| Tcons : forall ls, forall (t : @Tele ls) (l : T), @Tele (l :: ls). - -Fail Fixpoint TeleD (ls : list T) (t : Tele ls) {struct t} - : { x : Type & x -> nat -> Type } := - match t return { x : Type & x -> nat -> Type } with - | Tnil => @existT Type (fun x => x -> nat -> Type) unit (fun (_ : unit) (_ : nat) => unit) - | Tcons ls t' l => - let (result, get) := TeleD ls t' in - @existT Type (fun x => x -> nat -> Type) - { v : result & (fix TD (t : T) {struct t} := - match t with - | Var n => - get v n - | Arr a b => TD a -> TD b - end) l } - (fun x n => - match n return Type with - | 0 => projT2 x - | S n => get (projT1 x) n - end) - end. diff --git a/test-suite/bugs/closed/3495.v b/test-suite/bugs/closed/3495.v deleted file mode 100644 index 102a2aba0d..0000000000 --- a/test-suite/bugs/closed/3495.v +++ /dev/null @@ -1,18 +0,0 @@ -Require Import RelationClasses. - -Axiom R : Prop -> Prop -> Prop. -Declare Instance : Reflexive R. - -Class bar := { x : False }. -Record foo := { a : Prop ; b : bar }. - -Definition default_foo (a0 : Prop) `{b : bar} : foo := {| a := a0 ; b := b |}. - -Goal exists k, R k True. -Proof. -eexists. -evar (b : bar). -let e := match goal with |- R ?e _ => constr:(e) end in -unify e (a (default_foo True)). -subst b. -reflexivity. diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v deleted file mode 100644 index a1d0b9107b..0000000000 --- a/test-suite/bugs/closed/3513.v +++ /dev/null @@ -1,74 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *) -Require Coq.Setoids.Setoid. -Import Coq.Setoids.Setoid. -Generalizable All Variables. -Axiom admit : forall {T}, T. -Class Equiv (A : Type) := equiv : relation A. -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Class ILogicOps Frm := { lentails: relation Frm; - ltrue: Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm }. -Infix "|--" := lentails (at level 79, no associativity). -Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. -Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. -Infix "-|-" := lequiv (at level 85, no associativity). -Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. -Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. - Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. -End ILogic_Fun. -Arguments ILFunFrm _ {e} _ {ILOps}. -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; - ltrue := True; - land P Q := P /\ Q; - lor P Q := P \/ Q |}. -Axiom Action : Set. -Definition Actions := list Action. -Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. -Definition OPred := ILFunFrm Actions Prop. -Local Existing Instance ILFun_Ops. -Local Existing Instance ILFun_ILogic. -Definition catOP (P Q: OPred) : OPred := admit. -Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. -apply admit. -Defined. -Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. -Class IsPointed (T : Type) := point : T. -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. -Existing Instance OPred_inhabited. -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. -Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) - (tr : T -> T) (O2 : PointedOPred) (x : T) - (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), - exists e1 e2, - catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. - intros; do 2 esplit. - rewrite <- catOPA. - lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) - (@Morphisms.respectful OPred (OPred -> OPred) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> - @lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP - catOP_entails_m_Proper a a' H b b' H') in - pose P; - refine (P _ _) - end; unfold Basics.flip. - Focus 2. - (* As in 8.5, allow a shelved subgoal to remain *) - apply reflexivity. - diff --git a/test-suite/bugs/closed/3520.v b/test-suite/bugs/closed/3520.v deleted file mode 100644 index ea122e521f..0000000000 --- a/test-suite/bugs/closed/3520.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Primitive Projections. - -Record foo (A : Type) := - { bar : Type ; baz := Set; bad : baz = bar }. - -Set Nonrecursive Elimination Schemes. - -Record notprim : Prop := - { irrel : True; relevant : nat }. - - - diff --git a/test-suite/bugs/closed/3531.v b/test-suite/bugs/closed/3531.v deleted file mode 100644 index 3502b4f549..0000000000 --- a/test-suite/bugs/closed/3531.v +++ /dev/null @@ -1,54 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 270 lines to -198 lines, then from 178 lines to 82 lines, then from 88 lines to 59 lines *) -(* coqc version trunk (August 2014) compiled on Aug 19 2014 14:40:15 with OCaml -4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(56ece74efc25af1b0e09265f3c7fcf74323abcaf) *) -Require Import Coq.Lists.List. -Set Implicit Arguments. -Definition mem := nat -> option nat. -Definition pred := mem -> Prop. -Delimit Scope pred_scope with pred. -Definition exis A (p : A -> pred) : pred := fun m => exists x, p x m. -Notation "'exists' x .. y , p" := (exis (fun x => .. (exis (fun y => p)) ..)) : -pred_scope. -Definition emp : pred := fun m => forall a, m a = None. -Definition lift_empty (P : Prop) : pred := fun m => P /\ forall a, m a = None. -Notation "[[ P ]]" := (lift_empty P) : pred_scope. -Definition pimpl (p q : pred) := forall m, p m -> q m. -Notation "p ==> q" := (pimpl p%pred q%pred) (right associativity, at level 90). -Definition piff (p q : pred) : Prop := (p ==> q) /\ (q ==> p). -Notation "p <==> q" := (piff p%pred q%pred) (at level 90). -Parameter sep_star : pred -> pred -> pred. -Infix "*" := sep_star : pred_scope. -Definition memis (m : mem) : pred := eq m. -Definition mptsto (m : mem) (a : nat) (v : nat) := m a = Some v. -Notation "m @ a |-> v" := (mptsto m a v) (a at level 34, at level 35). -Lemma piff_trans: forall a b c, (a <==> b) -> (b <==> c) -> (a <==> c). -Admitted. -Lemma piff_refl: forall a, (a <==> a). -Admitted. -Definition stars (ps : list pred) := fold_left sep_star ps emp. -Lemma flatten_exists: forall T PT p ps P, - (forall (a:T), (p a <==> exists (x:PT), stars (ps a x) * [[P a x]])) - -> (exists (a:T), p a) <==> - (exists (x:(T*PT)), stars (ps (fst x) (snd x)) * [[P (fst x) (snd x)]]). -Admitted. -Goal forall b, (exists e1 e2 e3, - (exists (m : mem) (v : nat) (F : pred), b) - <==> (exists x : e1, stars (e2 x) * [[e3 x]])). - intros. - Set Printing Universes. - Show Universes. - do 3 eapply ex_intro. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. - assert (H : False) by (clear; admit); destruct H. - Grab Existential Variables. - admit. - admit. - admit. - Show Universes. -Time Qed. diff --git a/test-suite/bugs/closed/3539.v b/test-suite/bugs/closed/3539.v deleted file mode 100644 index b0c4b23702..0000000000 --- a/test-suite/bugs/closed/3539.v +++ /dev/null @@ -1,66 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 11678 lines to 11330 lines, then from 10721 lines to 9544 lines, then from 9549 lines to 794 lines, then from 810 lines to 785 lines, then from 628 lines to 246 lines, then from 220 lines to 89 lines, then from 80 lines to 47 lines *) -(* coqc version trunk (August 2014) compiled on Aug 22 2014 4:17:28 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (a67cc6941434124465f20b14a1256f2ede31a60e) *) - -Set Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. -Local Set Primitive Projections. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Axiom path_prod : forall {A B : Type} (z z' : A * B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Axiom transport_path_prod : forall A B (P : A * B -> Type) (x y : A * B) (HA : fst x = fst y) (HB : snd x = snd y) Px, - transport P (path_prod _ _ HA HB) Px - = transport (fun x => P (x, snd y)) HA (transport (fun y => P (fst x, y)) HB Px). -Goal forall (T0 : Type) (snd1 snd0 f : T0) (p : @paths T0 f snd0) - (f0 : T0) (p1 : @paths T0 f0 snd1) (T1 : Type) - (fst1 fst0 : T1) (p0 : @paths T1 fst0 fst0) (p2 : @paths T1 fst1 fst1) - (T : Type) (x2 : T) (T2 : Type) (T3 : forall (_ : T2) (_ : T2), Type) - (x' : forall (_ : T1) (_ : T), T2) (m : T3 (x' fst1 x2) (x' fst0 x2)), - @paths (T3 (x' fst1 x2) (x' fst0 x2)) - (@transport (prod T1 T0) - (fun x : prod T1 T0 => - T3 (x' fst1 x2) (x' (fst x) x2)) - (@pair T1 T0 fst0 f) (@pair T1 T0 fst0 snd0) - (@path_prod T1 T0 (@pair T1 T0 fst0 f) - (@pair T1 T0 fst0 snd0) p0 p) - (@transport (prod T1 T0) - (fun x : prod T1 T0 => - T3 (x' (fst x) x2) (x' fst0 x2)) - (@pair T1 T0 fst1 f0) (@pair T1 T0 fst1 snd1) - (@path_prod T1 T0 (@pair T1 T0 fst1 f0) - (@pair T1 T0 fst1 snd1) p2 p1) m)) m. - intros. - match goal with - | [ |- context[transport ?P (path_prod ?x ?y ?HA ?HB) ?Px] ] - => rewrite (transport_path_prod P x y HA HB Px) - end || fail "bad". - Undo. - Set Printing All. - rewrite transport_path_prod. (* Toplevel input, characters 15-43: -Error: -In environment -T0 : Type -snd1 : T0 -snd0 : T0 -f : T0 -p : @paths T0 f snd0 -f0 : T0 -p1 : @paths T0 f0 snd1 -T1 : Type -fst1 : T1 -fst0 : T1 -p0 : @paths T1 fst0 fst0 -p2 : @paths T1 fst1 fst1 -T : Type -x2 : T -T2 : Type -T3 : forall (_ : T2) (_ : T2), Type -x' : forall (_ : T1) (_ : T), T2 -m : T3 (x' fst1 x2) (x' fst0 x2) -Unable to unify "?25 (@pair ?23 ?24 (fst ?27) (snd ?27))" with -"?25 ?27". - *) diff --git a/test-suite/bugs/closed/3542.v b/test-suite/bugs/closed/3542.v deleted file mode 100644 index b6837a0c33..0000000000 --- a/test-suite/bugs/closed/3542.v +++ /dev/null @@ -1,6 +0,0 @@ -Section foo. - Context {A:Type} {B : A -> Type}. - Context (f : forall x, B x). - Goal True. - pose (r := fun k => existT (fun g => forall x, f x = g x) - (fun x => projT1 (k x)) (fun x => projT2 (k x))). diff --git a/test-suite/bugs/closed/3546.v b/test-suite/bugs/closed/3546.v deleted file mode 100644 index 55d718bd03..0000000000 --- a/test-suite/bugs/closed/3546.v +++ /dev/null @@ -1,17 +0,0 @@ -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {_ _} _ _. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Definition ap11 {A B} {f g:A->B} (h:f=g) {x y:A} (p:x=y) : f x = g y. -Admitted. -Goal forall x y z w : Set, (x, y) = (z, w). -Proof. - intros. - apply ap11. (* Toplevel input, characters 21-25: -Error: In environment -x : Set -y : Set -z : Set -w : Set -Unable to unify "?31 ?191 = ?32 ?192" with "(x, y) = (z, w)". - *) diff --git a/test-suite/bugs/closed/3554.v b/test-suite/bugs/closed/3554.v deleted file mode 100644 index 13a79cc840..0000000000 --- a/test-suite/bugs/closed/3554.v +++ /dev/null @@ -1 +0,0 @@ -Example foo (f : forall {_ : Type}, Type) : Type. diff --git a/test-suite/bugs/closed/3559.v b/test-suite/bugs/closed/3559.v deleted file mode 100644 index 5210b27032..0000000000 --- a/test-suite/bugs/closed/3559.v +++ /dev/null @@ -1,88 +0,0 @@ -Unset Strict Universe Declaration. -(* File reduced by coq-bug-finder from original input, then from 8657 lines to -4731 lines, then from 4174 lines to 192 lines, then from 161 lines to 55 lines, -then from 51 lines to 37 lines, then from 43 lines to 30 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml -4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Require Import Coq.Init.Notations. -Set Universe Polymorphism. -Generalizable All Variables. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {_ _} _ _. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x <-> y" (at level 95, no associativity). -Reserved Notation "x = y" (at level 70, no associativity). -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Open Scope type_scope. - -Definition iff A B := prod (A -> B) (B -> A). -Infix "<->" := iff : type_scope. -Inductive paths {A : Type@{i}} (a : A) : A -> Type@{i} := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center -= y) }. -Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type@{i}) : Type@{i} := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. -Notation minus_one:=(trunc_S minus_two). -Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : -IsTrunc_internal n A. -Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : -IsTrunc n (x = y) := H x y. - -Axiom cheat : forall {A}, A. - -Lemma paths_lift (A : Type@{i}) (x y : A) (p : x = y) : paths@{j} x y. -Proof. - destruct p. apply idpath. -Defined. - -Lemma paths_change (A : Type@{i}) (x y : A) : paths@{j} x y = paths@{i} x y. -Proof. (* require Univalence *) - apply cheat. -Defined. - -Lemma IsTrunc_lift (n : trunc_index) : - forall (A : Type@{i}), IsTrunc_internal@{i} n A -> IsTrunc_internal@{j} n A. -Proof. - induction n; simpl; intros. - destruct X. exists center0. intros. apply (paths_lift _ _ _ (contr0 y)). - - rewrite paths_change. - apply IHn, X. -Defined. - -Notation IsHProp := (IsTrunc minus_one). -(* Record hProp := hp { hproptype :> Type ; isp : IsTrunc minus_one hproptype}. *) -(* Make the truncation proof polymorphic, i.e., available at any level greater or equal - to the carrier type level j *) -Record hProp := hp { hproptype :> Type@{j} ; isp : IsTrunc minus_one hproptype}. -Axiom path_iff_hprop_uncurried : forall `{IsHProp A, IsHProp B}, (A <-> B) -> A -= B. -Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. -Axiom is0trunc_V : IsTrunc (trunc_S (trunc_S minus_two)) V. -Existing Instance is0trunc_V. -Axiom bisimulation : V@{U' U} -> V@{U' U} -> hProp@{U'}. -Axiom bisimulation_refl : forall (v : V), bisimulation v v. -Axiom bisimulation_eq : forall (u v : V), bisimulation u v -> u = v. -Notation "u ~~ v" := (bisimulation u v) (at level 30). -Lemma bisimulation_equals_id : forall u v : V@{i j}, (u = v) = (u ~~ v). -Proof. - intros u v. - refine (@path_iff_hprop_uncurried _ _ _ _ _). -(* path_iff_hprop_uncurried : *) -(* forall A : Type@{Top.74}, *) -(* IsHProp A -> forall B : Type@{Top.74}, IsHProp B -> A <-> B -> A = B *) -(* (* Top.74 *) -(* Top.78 |= Top.74 < Top.78 *) -(* *) *) - - Show Universes. - exact (isp _). - split; intros. destruct X. apply bisimulation_refl. - apply bisimulation_eq, X. -Defined. diff --git a/test-suite/bugs/closed/3561.v b/test-suite/bugs/closed/3561.v deleted file mode 100644 index ef4422eeac..0000000000 --- a/test-suite/bugs/closed/3561.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6343 lines to 2362 lines, then from 2115 lines to 303 lines, then from 321 lines to 90 lines, then from 95 lines to 41 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). -Lemma ap_transport {A} {P Q : A -> Type} {x y : A} (p : x = y) (f : forall x, P x -> Q x) (z : P x) : - f y (p # z) = (p # (f x z)). -Proof. admit. -Defined. -Lemma foo A B (f : A * B -> A) : f = f. -Admitted. -Goal forall (H0 H2 : Type) x p, - @transport (prod H0 H2) - (fun GO : prod H0 H2 => x (fst GO)) = p. - intros. - match goal with - | [ |- context[x (?f _)] ] => set(foo':=f) - end. diff --git a/test-suite/bugs/closed/3562.v b/test-suite/bugs/closed/3562.v deleted file mode 100644 index 1a1410a3b1..0000000000 --- a/test-suite/bugs/closed/3562.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Should not be an anomaly as it was at some time in - September/October 2014 but some "Disjunctive/conjunctive - introduction pattern expected" error *) - -Theorem t: True. -Fail destruct 0 as x. diff --git a/test-suite/bugs/closed/3563.v b/test-suite/bugs/closed/3563.v deleted file mode 100644 index 961563ed4a..0000000000 --- a/test-suite/bugs/closed/3563.v +++ /dev/null @@ -1,38 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 11716 lines to 11295 lines, then from 10518 lines to 21 lines, then \ -from 37 lines to 21 lines *) -(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) -Set Primitive Projections. -Record prod A B := pair { fst : A ; snd : B }. -Arguments pair {A B} _ _. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0) - (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = - H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2))), - transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7. - intros. - match goal with - | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ] - => set(foo:=h); idtac - end. - match goal with - | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ] - => idtac - end. -Abort. -Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0) - (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = - H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2) H2)), - transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7. - intros. - match goal with - | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ] - => set(foo:=X) - end. -(* Anomaly: Uncaught exception Not_found(_). Please report. *) - -(* Anomaly: Uncaught exception Not_found(_). Please report. *) diff --git a/test-suite/bugs/closed/3566.v b/test-suite/bugs/closed/3566.v deleted file mode 100644 index e2d7976981..0000000000 --- a/test-suite/bugs/closed/3566.v +++ /dev/null @@ -1,23 +0,0 @@ -Unset Strict Universe Declaration. -Notation idmap := (fun x => x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Delimit Scope path_scope with path. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. -Class IsEquiv {A B : Type} (f : A -> B) := {}. -Axiom path_universe : forall {A B : Type} (f : A -> B) {feq : IsEquiv f}, (A = B). - -Definition Lift : Type@{i} -> Type@{j} - := Eval hnf in let lt := Type@{i} : Type@{j} in fun T => T. - -Definition lift {T} : T -> Lift T := fun x => x. - -Goal forall x y : Type, x = y. - intros. - pose proof ((fun H0 : idmap _ => (@path_universe _ _ (@lift x) (H0 x) @ - (@path_universe _ _ (@lift x) (H0 x))^)))%path as H''. diff --git a/test-suite/bugs/closed/3567.v b/test-suite/bugs/closed/3567.v deleted file mode 100644 index 00c9c05469..0000000000 --- a/test-suite/bugs/closed/3567.v +++ /dev/null @@ -1,68 +0,0 @@ - -(* File reduced by coq-bug-finder from original input, then from 2901 lines to 69 lines, then from 80 lines to 63 lines *) -(* coqc version trunk (September 2014) compiled on Sep 2 2014 2:7:1 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3c5daf4e23ee20f0788c0deab688af452e83ccf0) *) - -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Add Printing Let prod. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Unset Implicit Arguments. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := - { equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. -Definition path_prod_uncurried {A B : Type} (z z' : A * B) (pq : (fst z = fst z') * (snd z = snd z')) -: (z = z') - := match fst pq in (_ = z'1), snd pq in (_ = z'2) return z = (z'1, z'2) with - | idpath, idpath => idpath - end. -Definition path_prod {A B : Type} (z z' : A * B) : - (fst z = fst z') -> (snd z = snd z') -> (z = z') - := fun p q => path_prod_uncurried z z' (p,q). -Definition path_prod' {A B : Type} {x x' : A} {y y' : B} -: (x = x') -> (y = y') -> ((x,y) = (x',y')) - := fun p q => path_prod (x,y) (x',y') p q. -Axiom ap_fst_path_prod : forall {A B : Type} {z z' : A * B} - (p : fst z = fst z') (q : snd z = snd z'), - ap fst (path_prod _ _ p q) = p. -Axiom ap_snd_path_prod : forall {A B : Type} {z z' : A * B} - (p : fst z = fst z') (q : snd z = snd z'), - ap snd (path_prod _ _ p q) = q. -Axiom eta_path_prod : forall {A B : Type} {z z' : A * B} (p : z = z'), - path_prod _ _(ap fst p) (ap snd p) = p. -Definition isequiv_path_prod {A B : Type} {z z' : A * B} : IsEquiv (path_prod_uncurried z z'). -Proof. - refine (Build_IsEquiv - _ _ _ - (fun r => (ap fst r, ap snd r)) - eta_path_prod - (fun pq => match pq with - | (p,q) => path_prod' - (ap_fst_path_prod p q) (ap_snd_path_prod p q) - end) _). - destruct z as [x y], z' as [x' y']. simpl. -(* Toplevel input, characters 15-50: -Error: Abstracting over the term "z" leads to a term -fun z0 : A * B => -forall x : (fst z0 = fst z') * (snd z0 = snd z'), -eta_path_prod (path_prod_uncurried z0 z' x) = -ap (path_prod_uncurried z0 z') - (let (p, q) as pq - return - ((ap (fst) (path_prod_uncurried z0 z' pq), - ap (snd) (path_prod_uncurried z0 z' pq)) = pq) := x in - path_prod' (ap_fst_path_prod p q) (ap_snd_path_prod p q)) -which is ill-typed. -Reason is: Pattern-matching expression on an object of inductive type prod -has invalid information. - *) diff --git a/test-suite/bugs/closed/3590.v b/test-suite/bugs/closed/3590.v deleted file mode 100644 index 9fded85a8d..0000000000 --- a/test-suite/bugs/closed/3590.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Definition idS := Set. -Goal forall x y : prod Set Set, forall H : fst x = fst y, fst x = fst y. - intros. - change (@fst _ _ ?z) with (@fst Set idS z) at 2. - apply H. -Qed. - -(* Toplevel input, characters 20-58: -Error: Failed to get enough information from the left-hand side to type the -right-hand side. *) diff --git a/test-suite/bugs/closed/3593.v b/test-suite/bugs/closed/3593.v deleted file mode 100644 index 378db68570..0000000000 --- a/test-suite/bugs/closed/3593.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Universe Polymorphism. -Set Printing All. -Set Implicit Arguments. -Record prod A B := pair { fst : A ; snd : B }. -Goal forall x : prod Set Set, let f := @fst _ in f _ x = @fst _ _ x. -simpl; intros. - constr_eq (@fst Set Set x) (fst (A := Set) (B := Set) x). - Fail progress change (@fst Set Set x) with (fst (A := Set) (B := Set) x). - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3594.v b/test-suite/bugs/closed/3594.v deleted file mode 100644 index 1f86f4bd70..0000000000 --- a/test-suite/bugs/closed/3594.v +++ /dev/null @@ -1,51 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 8752 lines to 735 lines, then from 735 lines to 310 lines, then from 228 lines to 105 lines, then from 98 lines to 41 lines *) -(* coqc version trunk (September 2014) compiled on Sep 6 2014 6:15:6 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3ea6d6888105edd5139ae0a4d8f8ecdb586aff6c) *) -Notation idmap := (fun x => x). -Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. -Local Set Primitive Projections. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Bind Scope category_scope with PreCategory. -Set Implicit Arguments. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := {}. -Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). -Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. -Definition oppositeF C D (F : Functor C D) : Functor C^op D^op := Build_Functor (C^op) (D^op). -Local Notation "F ^op" := (oppositeF F) (at level 3, format "F ^op") : functor_scope. -Axiom oppositeF_involutive : forall C D (F : Functor C D), ((F^op)^op)%functor = F. -Local Open Scope functor_scope. -Goal forall C D : PreCategory, - (fun c : Functor C^op D^op => (c^op)^op) = idmap. - intros. - exact (path_forall (fun F : Functor C^op D^op => (F^op)^op) _ (@oppositeF_involutive _ _)). - Undo. - Unset Printing Notations. - Set Debug Unification. -(* Check (eq_refl : Build_PreCategory (opposite D).(object) *) -(* (fun s d : (opposite D).(object) => *) -(* (opposite D).(morphism) d s) = *) -(* @Build_PreCategory D (fun s d => morphism D d s)). *) -(* opposite D). *) - exact (path_forall (fun F => (F^op)^op) _ (@oppositeF_involutive _ _)). -Qed. - (* Toplevel input, characters 22-101: -Error: -In environment -C : PreCategory -D : PreCategory -The term - "path_forall - (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) - (fun F : Functor (opposite C) (opposite D) => F) - (oppositeF_involutive (D:=opposite D))" has type - "eq (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) - (fun F : Functor (opposite C) (opposite D) => F)" -while it is expected to have type - "eq (fun c : Functor (opposite C) (opposite D) => oppositeF (oppositeF c)) - (fun x : Functor (opposite C) (opposite D) => x)" -(cannot unify "{| - object := opposite D; - morphism := fun s d : opposite D => morphism (opposite D) d s |}" -and "opposite D"). - *) diff --git a/test-suite/bugs/closed/3596.v b/test-suite/bugs/closed/3596.v deleted file mode 100644 index 1ee9a5d8c1..0000000000 --- a/test-suite/bugs/closed/3596.v +++ /dev/null @@ -1,19 +0,0 @@ -Require Import TestSuite.admit. -Set Implicit Arguments. -Record foo := { fx : nat }. -Set Primitive Projections. -Record bar := { bx : nat }. -Definition Foo (f : foo) : f = f. - destruct f as [fx]; destruct fx; admit. -Defined. -Definition Bar (b : bar) : b = b. - destruct b as [fx]; destruct fx; admit. -Defined. -Goal forall f b, Bar b = Bar b -> Foo f = Foo f. - intros f b. - destruct f, b. - simpl. - Fail progress unfold Bar. (* success *) - Fail progress unfold Foo. (* failed to progress *) - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/3612.v b/test-suite/bugs/closed/3612.v deleted file mode 100644 index 33e5d532ad..0000000000 --- a/test-suite/bugs/closed/3612.v +++ /dev/null @@ -1,54 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter" "-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 3595 lines to 3518 lines, then from 3133 lines to 2950 lines, then from 2911 lines to 415 lines, then from 431 lines to 407 \ -lines, then from 421 lines to 428 lines, then from 444 lines to 429 lines, then from 434 lines to 66 lines, then from 163 lines to 48 lines *) -(* coqc version trunk (September 2014) compiled on Sep 11 2014 14:48:8 with OCaml 4.01.0 - coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (580b25e05c7cc9e7a31430b3d9edb14ae12b7598) *) -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x = y :> T" (at level 70, y at next level, no associativity). -Reserved Notation "x = y" (at level 70, no associativity). -Delimit Scope type_scope with type. -Bind Scope type_scope with Sortclass. -Open Scope type_scope. -Global Set Universe Polymorphism. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Generalizable All Variables. -Local Set Primitive Projections. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Arguments projT1 {A P} _ / . -Arguments projT2 {A P} _ / . -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y . -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Local Open Scope path_scope. -Axiom pr1_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), u.1 = v.1. -Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. -Axiom pr2_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), p..1 # u.2 = v.2. -Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. -Axiom path_path_sigma : forall {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (r : p..1 = q..1) - (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2), -p = q. - -Declare ML Module "ltac_plugin". - -Set Default Proof Mode "Classic". - -Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x)) - (xx : @paths (@sigT A (fun x0 : A => B x0)) x x), - @paths (@paths (@sigT A (fun x0 : A => B x0)) x x) xx - (@idpath (@sigT A (fun x0 : A => B x0)) x). - intros A B x xx. - Set Printing All. - change (fun x => B x) with B in xx. - pose (path_path_sigma B x x xx) as x''. - clear x''. - Check (path_path_sigma B x x xx). diff --git a/test-suite/bugs/closed/3616.v b/test-suite/bugs/closed/3616.v deleted file mode 100644 index 688700260c..0000000000 --- a/test-suite/bugs/closed/3616.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Was failing from April 2014 to September 2014 because of injection *) -Goal forall P e es t, (e :: es = existT P tt t :: es)%list -> True. -inversion 1. diff --git a/test-suite/bugs/closed/3618.v b/test-suite/bugs/closed/3618.v deleted file mode 100644 index 674b4cc2f4..0000000000 --- a/test-suite/bugs/closed/3618.v +++ /dev/null @@ -1,103 +0,0 @@ -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition concat {A} {x y z : A} : x = y -> y = z -> x = z. Admitted. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. Admitted. -Notation "p @ q" := (concat p q) (at level 20). -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. Admitted. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. Admitted. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : forall x, f (equiv_inv x) = x; - eissect : forall x, equiv_inv (f x) = x -}. - -Class Contr_internal (A : Type). - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | minus_two => Contr_internal A - | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. -Definition istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) -: IsTrunc n (x = y). -Admitted. - -Hint Extern 4 (IsTrunc _ (_ = _)) => eapply @istrunc_paths : typeclass_instances. - -Class Funext. - -Instance isequiv_compose A B C f g `{IsEquiv A B f} `{IsEquiv B C g} - : IsEquiv (compose g f) | 1000. -Admitted. - -Section IsEquivHomotopic. - Context (A B : Type) `(f : A -> B) `(g : A -> B) `{IsEquiv A B f} (h : forall x:A, f x = g x). - Let sect := (fun b:B => inverse (h (@equiv_inv _ _ f _ b)) @ @eisretr _ _ f _ b). - Let retr := (fun a:A => inverse (ap (@equiv_inv _ _ f _) (h a)) @ @eissect _ _ f _ a). - Global Instance isequiv_homotopic : IsEquiv g | 10000 - := ( BuildIsEquiv _ _ g (@equiv_inv _ _ f _) sect retr). -End IsEquivHomotopic. - -Instance trunc_succ A n `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. Admitted. - -Global Instance trunc_forall A n `{P : A -> Type} `{forall a, IsTrunc n (P a)} - : IsTrunc n (forall a, P a) | 100. -Admitted. - -Instance trunc_prod A B n `{IsTrunc n A} `{IsTrunc n B} : IsTrunc n (A * B) | 100. -Admitted. - -Global Instance trunc_arrow n {A B : Type} `{IsTrunc n B} : IsTrunc n (A -> B) | 100. -Admitted. - -Instance isequiv_pr1_contr {A} {P : A -> Type} `{forall a, IsTrunc minus_two (P a)} -: IsEquiv (@projT1 A P) | 100. -Admitted. - -Instance trunc_sigma n A `{P : A -> Type} `{IsTrunc n A} `{forall a, IsTrunc n (P a)} -: IsTrunc n (sigT P) | 100. -Admitted. - -Global Instance trunc_trunc `{Funext} A m n : IsTrunc (trunc_S n) (IsTrunc m A) | 0. -Admitted. - -Definition BiInv {A B} (f : A -> B) : Type -:= ( {g : B -> A & forall x, g (f x) = x} * {h : B -> A & forall x, f (h x) = x}). - -Global Instance isprop_biinv {A B} (f : A -> B) : IsTrunc (trunc_S minus_two) (BiInv f) | 0. -Admitted. - -Instance isequiv_path {A B : Type} (p : A = B) -: IsEquiv (transport (fun X:Type => X) p) | 0. -Admitted. - -Class ReflectiveSubuniverse_internal := - { inO_internal : Type -> Type ; - O : Type -> Type ; - O_unit : forall T, T -> O T }. - -Class ReflectiveSubuniverse := - ReflectiveSubuniverse_wrap : Funext -> ReflectiveSubuniverse_internal. -Global Existing Instance ReflectiveSubuniverse_wrap. - -Class inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) := - isequiv_inO : inO_internal T. - -Global Instance hprop_inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) : IsTrunc (trunc_S minus_two) (inO T) . -Admitted. - -(* To avoid looping class resolution *) -Hint Mode IsEquiv - - + : typeclass_instances. - -Fail Definition equiv_O_rectnd {fs : Funext} {subU : ReflectiveSubuniverse} - (P Q : Type) {Q_inO : inO_internal Q} -: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _. diff --git a/test-suite/bugs/closed/3633.v b/test-suite/bugs/closed/3633.v deleted file mode 100644 index 52bb307271..0000000000 --- a/test-suite/bugs/closed/3633.v +++ /dev/null @@ -1,10 +0,0 @@ -Set Typeclasses Strict Resolution. -Class Contr (A : Type) := { center : A }. -Definition foo {A} `{Contr A} : A. -Proof. - apply center. - Undo. - (* Ensure the constraints are solved independently, otherwise a frozen ?A - makes a search for Contr ?A fail when finishing to apply (fun x => x) *) - apply (fun x => x), center. -Qed. diff --git a/test-suite/bugs/closed/3638.v b/test-suite/bugs/closed/3638.v deleted file mode 100644 index 5441fbedce..0000000000 --- a/test-suite/bugs/closed/3638.v +++ /dev/null @@ -1,25 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from 104 lines to 28 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Primitive Projections. -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. -Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. -Global Existing Instance rsubu_usubu. -Context {subU : ReflectiveSubuniverse}. -Goal forall (A B : Type) (x : O A * O B) (x0 : B), - { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) - (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = - g x0 }. - eexists. - Show Existentials. Set Printing Existential Instances. - match goal with - | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in set (e' := e) - end. - - -(* Toplevel input, characters 15-114: -Anomaly: Bad recursive type. Please report. *) diff --git a/test-suite/bugs/closed/3640.v b/test-suite/bugs/closed/3640.v deleted file mode 100644 index 5dff98ba23..0000000000 --- a/test-suite/bugs/closed/3640.v +++ /dev/null @@ -1,31 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 14990 lines to 70 lines, then from 44 lines to 29 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} P := existT { pr1 : A ; pr2 : P pr1 }. -Notation "{ x : A & P }" := (sigT (A := A) (fun x : A => P)) : type_scope. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'"). -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'"). -Record Equiv A B := { equiv_fun :> A -> B }. -Notation "A <~> B" := (Equiv A B) (at level 85). -Inductive Bool : Type := true | false. -Definition negb (b : Bool) := if b then false else true. -Axiom eval_bool_isequiv : forall (f : Bool -> Bool), f false = negb (f true). -Lemma bool_map_equiv_not_idmap (f : { f : Bool <~> Bool & ~(forall x, f x = x) }) -: forall b, ~(f.1 b = b). -Proof. - intro b. - intro H''. - apply f.2. - intro b'. - pose proof (eval_bool_isequiv f.1) as H. - destruct b', b. - Fail match type of H with - | _ = negb (f.1 true) => fail 1 "no f.1 true" - end. (* Error: No matching clauses for match. *) - destruct (f.1 true). - simpl in *. - Fail match type of H with - | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true" - end. (* Error: Tactic failure: still has f.1 true. *) diff --git a/test-suite/bugs/closed/3641.v b/test-suite/bugs/closed/3641.v deleted file mode 100644 index 730ab3f431..0000000000 --- a/test-suite/bugs/closed/3641.v +++ /dev/null @@ -1,21 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from\ - 104 lines to 28 lines *) -(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) -Set Implicit Arguments. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. -Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. -Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. -Global Existing Instance rsubu_usubu. -Context {subU : ReflectiveSubuniverse}. -Goal forall (A B : Type) (x : O A * O B) (x0 : B), - { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) - (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = - g x0 }. - eexists. - match goal with - | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e) - end. - Fail change ?g with e'. (* Stack overflow *) diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v deleted file mode 100644 index e91c004c77..0000000000 --- a/test-suite/bugs/closed/3647.v +++ /dev/null @@ -1,654 +0,0 @@ -Require Import TestSuite.admit. -Require Coq.Setoids.Setoid. - -Axiom BITS : nat -> Set. -Definition n7 := 7. -Definition n15 := 15. -Definition n31 := 31. -Notation n8 := (S n7). -Notation n16 := (S n15). -Notation n32 := (S n31). -Inductive OpSize := OpSize1 | OpSize2 | OpSize4 . -Definition VWORD s := BITS (match s with OpSize1 => n8 | OpSize2 => n16 | OpSize4 => n32 end). -Definition BYTE := VWORD OpSize1. -Definition WORD := VWORD OpSize2. -Definition DWORD := VWORD OpSize4. -Ltac subst_body := - repeat match goal with - | [ H := _ |- _ ] => subst H - end. -Import Coq.Setoids.Setoid. -Class Equiv (A : Type) := equiv : relation A. -Infix "===" := equiv (at level 70, no associativity). -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Definition setoid_resp {T T'} (f : T -> T') `{e : type T} `{e' : type T'} := forall x y, x === y -> f x === f y. -Record morphism T T' `{e : type T} `{e' : type T'} := - mkMorph { - morph :> T -> T'; - morph_resp : setoid_resp morph}. -Arguments mkMorph [T T' e0 e e1 e']. -Infix "-s>" := morphism (at level 45, right associativity). -Section Morphisms. - Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. - Global Instance morph_equiv : Equiv (S -s> T). - admit. - Defined. - - Global Instance morph_type : type (S -s> T). - admit. - Defined. - - Program Definition mcomp (f: T -s> U) (g: S -s> T) : (S -s> U) := - mkMorph (fun x => f (g x)) _. - Next Obligation. - admit. - Defined. - -End Morphisms. - -Infix "<<" := mcomp (at level 35). - -Section MorphConsts. - Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. - - Definition lift2s (f : S -> T -> U) p q : (S -s> T -s> U) := - mkMorph (fun x => mkMorph (f x) (p x)) q. - -End MorphConsts. -Instance Equiv_PropP : Equiv Prop. -admit. -Defined. - -Section SetoidProducts. - Context {A B : Type} `{eA : type A} `{eB : type B}. - Global Instance Equiv_prod : Equiv (A * B). - admit. - Defined. - - Global Instance type_prod : type (A * B). - admit. - Defined. - - Program Definition mfst : (A * B) -s> A := - mkMorph (fun p => fst p) _. - Next Obligation. - admit. - Defined. - - Program Definition msnd : (A * B) -s> B := - mkMorph (fun p => snd p) _. - Next Obligation. - admit. - Defined. - - Context {C} `{eC : type C}. - - Program Definition mprod (f: C -s> A) (g: C -s> B) : C -s> (A * B) := - mkMorph (fun c => (f c, g c)) _. - Next Obligation. - admit. - Defined. - -End SetoidProducts. - -Section IndexedProducts. - - Record ttyp := {carr :> Type; eqc : Equiv carr; eqok : type carr}. - Global Instance ttyp_proj_eq {A : ttyp} : Equiv A. - admit. - Defined. - Global Instance ttyp_proj_prop {A : ttyp} : type A. - admit. - Defined. - Context {I : Type} {P : I -> ttyp}. - - Global Program Instance Equiv_prodI : Equiv (forall i, P i) := - fun p p' : forall i, P i => (forall i : I, @equiv _ (eqc _) (p i) (p' i)). - - Global Instance type_prodI : type (forall i, P i). - admit. - Defined. - - Program Definition mprojI (i : I) : (forall i, P i) -s> P i := - mkMorph (fun X => X i) _. - Next Obligation. - admit. - Defined. - - Context {C : Type} `{eC : type C}. - - Program Definition mprodI (f : forall i, C -s> P i) : C -s> (forall i, P i) := - mkMorph (fun c i => f i c) _. - Next Obligation. - admit. - Defined. - -End IndexedProducts. - -Section Exponentials. - - Context {A B C D} `{eA : type A} `{eB : type B} `{eC : type C} `{eD : type D}. - - Program Definition comps : (B -s> C) -s> (A -s> B) -s> A -s> C := - lift2s (fun f g => f << g) _ _. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - - Program Definition muncurry (f : A -s> B -s> C) : A * B -s> C := - mkMorph (fun p => f (fst p) (snd p)) _. - Next Obligation. - admit. - Defined. - - Program Definition mcurry (f : A * B -s> C) : A -s> B -s> C := - lift2s (fun a b => f (a, b)) _ _. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - - Program Definition meval : (B -s> A) * B -s> A := - mkMorph (fun p => fst p (snd p)) _. - Next Obligation. - admit. - Defined. - - Program Definition mid : A -s> A := mkMorph (fun x => x) _. - Next Obligation. - admit. - Defined. - - Program Definition mconst (b : B) : A -s> B := mkMorph (fun _ => b) _. - Next Obligation. - admit. - Defined. - -End Exponentials. - -Inductive empty : Set := . -Instance empty_Equiv : Equiv empty. -admit. -Defined. -Instance empty_type : type empty. -admit. -Defined. - -Section Initials. - Context {A} `{eA : type A}. - - Program Definition mzero_init : empty -s> A := mkMorph (fun x => match x with end) _. - Next Obligation. - admit. - Defined. - -End Initials. - -Section Subsetoid. - - Context {A} `{eA : type A} {P : A -> Prop}. - Global Instance subset_Equiv : Equiv {a : A | P a}. - admit. - Defined. - Global Instance subset_type : type {a : A | P a}. - admit. - Defined. - - Program Definition mforget : {a : A | P a} -s> A := - mkMorph (fun x => x) _. - Next Obligation. - admit. - Defined. - - Context {B} `{eB : type B}. - Program Definition minherit (f : B -s> A) (HB : forall b, P (f b)) : B -s> {a : A | P a} := - mkMorph (fun b => exist P (f b) (HB b)) _. - Next Obligation. - admit. - Defined. - -End Subsetoid. - -Section Option. - - Context {A} `{eA : type A}. - Global Instance option_Equiv : Equiv (option A). - admit. - Defined. - - Global Instance option_type : type (option A). - admit. - Defined. - -End Option. - -Section OptDefs. - Context {A B} `{eA : type A} `{eB : type B}. - - Program Definition msome : A -s> option A := mkMorph (fun a => Some a) _. - Next Obligation. - admit. - Defined. - - Program Definition moptionbind (f : A -s> option B) : option A -s> option B := - mkMorph (fun oa => match oa with None => None | Some a => f a end) _. - Next Obligation. - admit. - Defined. - -End OptDefs. - -Generalizable Variables Frm. - -Class ILogicOps Frm := { - lentails: relation Frm; - ltrue: Frm; - lfalse: Frm; - limpl: Frm -> Frm -> Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm; - lforall: forall {T}, (T -> Frm) -> Frm; - lexists: forall {T}, (T -> Frm) -> Frm - }. - -Infix "|--" := lentails (at level 79, no associativity). -Infix "//\\" := land (at level 75, right associativity). -Infix "\\//" := lor (at level 76, right associativity). -Infix "-->>" := limpl (at level 77, right associativity). -Notation "'Forall' x .. y , p" := - (lforall (fun x => .. (lforall (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). -Notation "'Exists' x .. y , p" := - (lexists (fun x => .. (lexists (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). - -Class ILogic Frm {ILOps: ILogicOps Frm} := { - lentailsPre:> PreOrder lentails; - ltrueR: forall C, C |-- ltrue; - lfalseL: forall C, lfalse |-- C; - lforallL: forall T x (P: T -> Frm) C, P x |-- C -> lforall P |-- C; - lforallR: forall T (P: T -> Frm) C, (forall x, C |-- P x) -> C |-- lforall P; - lexistsL: forall T (P: T -> Frm) C, (forall x, P x |-- C) -> lexists P |-- C; - lexistsR: forall T x (P: T -> Frm) C, C |-- P x -> C |-- lexists P; - landL1: forall P Q C, P |-- C -> P //\\ Q |-- C; - landL2: forall P Q C, Q |-- C -> P //\\ Q |-- C; - lorR1: forall P Q C, C |-- P -> C |-- P \\// Q; - lorR2: forall P Q C, C |-- Q -> C |-- P \\// Q; - landR: forall P Q C, C |-- P -> C |-- Q -> C |-- P //\\ Q; - lorL: forall P Q C, P |-- C -> Q |-- C -> P \\// Q |-- C; - landAdj: forall P Q C, C |-- (P -->> Q) -> C //\\ P |-- Q; - limplAdj: forall P Q C, C //\\ P |-- Q -> C |-- (P -->> Q) - }. -Hint Extern 0 (?x |-- ?x) => reflexivity. - -Section ILogicExtra. - Context `{IL: ILogic Frm}. - Definition lpropand (p: Prop) Q := Exists _: p, Q. - Definition lpropimpl (p: Prop) Q := Forall _: p, Q. - -End ILogicExtra. - -Infix "/\\" := lpropand (at level 75, right associativity). -Infix "->>" := lpropimpl (at level 77, right associativity). - -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - - Record ILFunFrm := mkILFunFrm { - ILFunFrm_pred :> T -> Frm; - ILFunFrm_closed: forall t t': T, t === t' -> - ILFunFrm_pred t |-- ILFunFrm_pred t' - }. - - Notation "'mk'" := @mkILFunFrm. - - Program Definition ILFun_Ops : ILogicOps ILFunFrm := {| - lentails P Q := forall t:T, P t |-- Q t; - ltrue := mk (fun t => ltrue) _; - lfalse := mk (fun t => lfalse) _; - limpl P Q := mk (fun t => P t -->> Q t) _; - land P Q := mk (fun t => P t //\\ Q t) _; - lor P Q := mk (fun t => P t \\// Q t) _; - lforall A P := mk (fun t => Forall a, P a t) _; - lexists A P := mk (fun t => Exists a, P a t) _ - |}. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - -End ILogic_Fun. - -Arguments ILFunFrm _ {e} _ {ILOps}. -Arguments mkILFunFrm [T] _ [Frm ILOps]. - -Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) : - @ILFunFrm T _ R ILOps := - @mkILFunFrm T eq R ILOps P _. -Next Obligation. - admit. -Defined. - -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| - lentails P Q := (P : Prop) -> Q; - ltrue := True; - lfalse := False; - limpl P Q := P -> Q; - land P Q := P /\ Q; - lor P Q := P \/ Q; - lforall T F := forall x:T, F x; - lexists T F := exists x:T, F x - |}. - -Instance ILogic_Prop : ILogic Prop. -admit. -Defined. - -Section FunEq. - Context A `{eT: type A}. - - Global Instance FunEquiv {T} : Equiv (T -> A) := { - equiv P Q := forall a, P a === Q a - }. -End FunEq. - -Section SepAlgSect. - Class SepAlgOps T `{eT : type T}:= { - sa_unit : T; - - sa_mul : T -> T -> T -> Prop - }. - - Class SepAlg T `{SAOps: SepAlgOps T} : Type := { - sa_mul_eqL a b c d : sa_mul a b c -> c === d -> sa_mul a b d; - sa_mul_eqR a b c d : sa_mul a b c -> sa_mul a b d -> c === d; - sa_mon a b c : a === b -> sa_mul a c === sa_mul b c; - sa_mulC a b : sa_mul a b === sa_mul b a; - sa_mulA a b c : forall bc abc, sa_mul a bc abc -> sa_mul b c bc -> - exists ac, sa_mul b ac abc /\ sa_mul a c ac; - sa_unitI a : sa_mul a sa_unit a - }. - -End SepAlgSect. - -Section BILogic. - - Class BILOperators (A : Type) := { - empSP : A; - sepSP : A -> A -> A; - wandSP : A -> A -> A - }. - -End BILogic. - -Notation "a '**' b" := (sepSP a b) - (at level 75, right associativity). - -Section BISepAlg. - Context {A} `{sa : SepAlg A}. - Context {B} `{IL: ILogic B}. - - Program Instance SABIOps: BILOperators (ILFunFrm A B) := { - empSP := mkILFunFrm e (fun x => sa_unit === x /\\ ltrue) _; - sepSP P Q := mkILFunFrm e (fun x => Exists x1, Exists x2, sa_mul x1 x2 x /\\ - P x1 //\\ Q x2) _; - wandSP P Q := mkILFunFrm e (fun x => Forall x1, Forall x2, sa_mul x x1 x2 ->> - P x1 -->> Q x2) _ - }. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - Next Obligation. - admit. - Defined. - -End BISepAlg. - -Set Implicit Arguments. - -Definition Chan := WORD. -Definition Data := BYTE. - -Inductive Action := -| Out (c:Chan) (d:Data) -| In (c:Chan) (d:Data). - -Definition Actions := list Action. - -Instance ActionsEquiv : Equiv Actions := { - equiv a1 a2 := a1 = a2 - }. - -Definition OPred := ILFunFrm Actions Prop. -Definition mkOPred (P : Actions -> Prop) : OPred. - admit. -Defined. - -Definition eq_opred s := mkOPred (fun s' => s === s'). -Definition empOP : OPred. - exact (eq_opred nil). -Defined. -Definition catOP (P Q: OPred) : OPred. - admit. -Defined. - -Class IsPointed (T : Type) := point : T. - -Generalizable All Variables. - -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). - -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. - -Existing Instance OPred_inhabited. - -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_eq_opred x : IsPointed_OPred (eq_opred x). -admit. -Defined. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q). -admit. -Defined. - -Definition Flag := BITS 5. -Definition OF: Flag. - admit. -Defined. - -Inductive FlagVal := mkFlag (b: bool) | FlagUnspecified. -Coercion mkFlag : bool >-> FlagVal. -Inductive NonSPReg := EAX | EBX | ECX | EDX | ESI | EDI | EBP. - -Inductive Reg := nonSPReg (r: NonSPReg) | ESP. - -Inductive AnyReg := regToAnyReg (r: Reg) | EIP. - -Inductive BYTEReg := AL|BL|CL|DL|AH|BH|CH|DH. - -Inductive WORDReg := mkWordReg (r:Reg). -Definition PState : Type. -admit. -Defined. - -Instance PStateEquiv : Equiv PState. -admit. -Defined. - -Instance PStateType : type PState. -admit. -Defined. - -Instance PStateSepAlgOps: SepAlgOps PState. -admit. -Defined. -Definition SPred : Type. -exact (ILFunFrm PState Prop). -Defined. - -Local Existing Instance ILFun_Ops. -Local Existing Instance SABIOps. -Axiom BYTEregIs : BYTEReg -> BYTE -> SPred. - -Inductive RegOrFlag := -| RegOrFlagDWORD :> AnyReg -> RegOrFlag -| RegOrFlagWORD :> WORDReg -> RegOrFlag -| RegOrFlagBYTE :> BYTEReg -> RegOrFlag -| RegOrFlagF :> Flag -> RegOrFlag. - -Definition RegOrFlag_target rf := - match rf with - | RegOrFlagDWORD _ => DWORD - | RegOrFlagWORD _ => WORD - | RegOrFlagBYTE _ => BYTE - | RegOrFlagF _ => FlagVal - end. - -Inductive Condition := -| CC_O | CC_B | CC_Z | CC_BE | CC_S | CC_P | CC_L | CC_LE. - -Section ILSpecSect. - - Axiom spec : Type. - Global Instance ILOps: ILogicOps spec | 2. - admit. - Defined. - -End ILSpecSect. - -Axiom parameterized_basic : forall {T_OPred} {proj : T_OPred -> OPred} {T} (P : SPred) (c : T) (O : OPred) (Q : SPred), spec. -Global Notation loopy_basic := (@parameterized_basic PointedOPred OPred_pred _). - -Axiom program : Type. - -Axiom ConditionIs : forall (cc : Condition) (cv : RegOrFlag_target OF), SPred. - -Axiom foldl : forall {T R}, (R -> T -> R) -> R -> list T -> R. -Axiom nth : forall {T}, T -> list T -> nat -> T. -Axiom while : forall (ptest: program) - (cond: Condition) (value: bool) - (pbody: program), program. - -Lemma while_rule_ind {quantT} - {ptest} {cond : Condition} {value : bool} {pbody} - {S} - {transition_body : quantT -> quantT} - {P : quantT -> SPred} {Otest : quantT -> OPred} {Obody : quantT -> OPred} {O : quantT -> PointedOPred} - {O_after_test : quantT -> PointedOPred} - {I_state : quantT -> bool -> SPred} - {I_logic : quantT -> bool -> bool} - {Q : quantT -> SPred} - (Htest : S |-- (Forall (x : quantT), - (loopy_basic (P x) - ptest - (Otest x) - (Exists b, I_logic x b = true /\\ I_state x b ** ConditionIs cond b)))) - (Hbody : S |-- (Forall (x : quantT), - (loopy_basic (I_logic x value = true /\\ I_state x value ** ConditionIs cond value) - pbody - (Obody x) - (P (transition_body x))))) - (H_after_test : forall x, catOP (Otest x) (O_after_test x) |-- O x) - (H_body_after_test : forall x, I_logic x value = true -> catOP (Obody x) (O (transition_body x)) |-- O_after_test x) - (H_empty : forall x, I_logic x (negb value) = true -> empOP |-- O_after_test x) - (Q_correct : forall x, I_logic x (negb value) = true /\\ I_state x (negb value) ** ConditionIs cond (negb value) |-- Q x) - (Q_safe : forall x, I_logic x value = true -> Q (transition_body x) |-- Q x) -: S |-- (Forall (x : quantT), - loopy_basic (P x) - (while ptest cond value pbody) - (O x) - (Q x)). -admit. -Defined. -Axiom behead : forall {T}, list T -> list T. -Axiom all : forall {T}, (T -> bool) -> list T -> bool. -Axiom all_behead : forall {T} (xs : list T) P, all P xs = true -> all P (behead xs) = true. -Instance IsPointed_foldlOP A B C f g (init : A * B) `{IsPointed_OPred (g init)} - `{forall a acc, IsPointed_OPred (g acc) -> IsPointed_OPred (g (f acc a))} - (ls : list C) -: IsPointed_OPred (g (foldl f init ls)). -admit. -Defined. -Goal forall (ptest : program) (cond : Condition) (value : bool) - (pbody : program) (T ioT : Type) (P : T -> SPred) - (I : T -> bool -> SPred) (accumulate : T -> ioT -> T) - (Otest Obody : T -> ioT -> PointedOPred) - (coq_test__is_finished : ioT -> bool) (S : spec) - (al : BYTE), - (forall (initial : T) (xs : list ioT) (x : ioT), - all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> - coq_test__is_finished x = true -> - S - |-- loopy_basic (P initial ** BYTEregIs AL al) ptest - (Otest initial (nth x xs 0)) - (I initial - (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end) ** - ConditionIs cond - (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end))) -> - (forall (initial : T) (xs : list ioT) (x : ioT), - all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> - xs <> nil -> - coq_test__is_finished x = true -> - S - |-- loopy_basic (I initial value ** ConditionIs cond value) pbody - (Obody initial (nth x xs 0)) - (P (accumulate initial (nth x xs 0)) ** BYTEregIs AL al)) -> - forall x : ioT, - coq_test__is_finished x = true -> - S - |-- Forall ixsp : {init_xs : T * list ioT & - all (fun t : ioT => negb (coq_test__is_finished t)) - (snd init_xs) = true}, - loopy_basic (P (fst (projT1 ixsp)) ** BYTEregIs AL al) - (while ptest cond value pbody) - (catOP - (snd - (foldl - (fun (xy : T * OPred) (v : ioT) => - (accumulate (fst xy) v, - catOP (catOP (Otest (fst xy) v) (Obody (fst xy) v)) - (snd xy))) (fst (projT1 ixsp), empOP) - (snd (projT1 ixsp)))) - (Otest (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) - x)) - (I (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) - (negb value) ** ConditionIs cond (negb value)). - intros. - eapply @while_rule_ind - with (I_logic := fun ixsp b => match (match (coq_test__is_finished (nth x (snd (projT1 ixsp)) 0)) with true => negb value | false => value end), b with true, true => true | false, false => true | _, _ => false end) - (Otest := fun ixsp => Otest (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) - (Obody := fun ixsp => Obody (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) - (I_state := fun ixsp => I (fst (projT1 ixsp))) - (transition_body := fun ixsp => let initial := fst (projT1 ixsp) in - let xs := snd (projT1 ixsp) in - existT _ (accumulate initial (nth x xs 0), behead xs) _) - (O_after_test := fun ixsp => let initial := fst (projT1 ixsp) in - let xs := snd (projT1 ixsp) in - match xs with | nil => default_PointedOPred empOP | _ => Obody initial (nth x xs 0) end); - simpl projT1; simpl projT2; simpl fst; simpl snd; clear; let H := fresh in assert (H : False) by (clear; admit); destruct H. - - Grab Existential Variables. - subst_body; simpl. - Fail refine (all_behead (projT2 _)). - Unset Solve Unification Constraints. refine (all_behead (projT2 _)). diff --git a/test-suite/bugs/closed/3648.v b/test-suite/bugs/closed/3648.v deleted file mode 100644 index 58aa161403..0000000000 --- a/test-suite/bugs/closed/3648.v +++ /dev/null @@ -1,83 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 8808 lines to 424 lines, then from 432 lines to 196 lines, then from\ - 145 lines to 82 lines *) -(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) - -Reserved Infix "o" (at level 40, left associativity). -Global Set Primitive Projections. - -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. - -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g) - }. -Arguments identity {!C%category} / x%object : rename. - -Infix "o" := (@compose _ _ _ _) : morphism_scope. - -Local Open Scope morphism_scope. -Definition prodC (C D : PreCategory) : PreCategory. - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1))). -Defined. - -Local Infix "*" := prodC : category_scope. - -Delimit Scope functor_scope with functor. - -Record Functor (C D : PreCategory) := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. -Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. -Axiom cheat : forall {A}, A. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) cheat cheat). -Defined. - -Local Notation "C -> D" := (functor_category C D) : category_scope. -Variable C1 : PreCategory. -Variable C2 : PreCategory. -Variable D : PreCategory. - -Definition functor_object_of -: (C1 -> (C2 -> D))%category -> (C1 * C2 -> D)%category. -Proof. - intro F; hnf in F |- *. - refine (Build_Functor - (prodC C1 C2) D - (fun c1c2 => F (fst c1c2) (snd c1c2)) - (fun s d m => F (fst d) _1 (snd m) o (@morphism_of _ _ F _ _ (fst m)) (snd s)) - _). - intros. - rewrite identity_of. - cbn. - rewrite (identity_of _ _ F (fst x)). - Undo. -(* Toplevel input, characters 20-55: -Error: -Found no subterm matching "F _1 (identity (fst x))" in the current goal. *) - rewrite identity_of. (* Toplevel input, characters 15-34: -Error: -Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *) diff --git a/test-suite/bugs/closed/3649.v b/test-suite/bugs/closed/3649.v deleted file mode 100644 index a664a1ef1d..0000000000 --- a/test-suite/bugs/closed/3649.v +++ /dev/null @@ -1,60 +0,0 @@ -(* -*- coq-prog-args: ("-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *) -(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) -Declare ML Module "ltac_plugin". -Set Default Proof Mode "Classic". -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x = y" (at level 70, no associativity). -Delimit Scope type_scope with type. -Bind Scope type_scope with Sortclass. -Open Scope type_scope. -Axiom admit : forall {T}, T. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Reserved Infix "o" (at level 40, left associativity). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Global Set Primitive Projections. -Delimit Scope morphism_scope with morphism. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g) }. -Infix "o" := (@compose _ _ _ _) : morphism_scope. -Set Implicit Arguments. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d) }. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { morphism_inverse : morphism C d s }. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Definition composeT C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') -: NaturalTransformation F F''. - exact admit. -Defined. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - admit - (@composeT C D)). -Defined. -Goal forall (C D : PreCategory) (G G' : Functor C D) - (T : @NaturalTransformation C D G G') - (H : @IsIsomorphism (@functor_category C D) G G' T) - (x : C), - @paths (morphism D (G x) (G x)) - (@compose D (G x) (G' x) (G x) - ((@morphism_inverse (@functor_category C D) G G' T H) x) - (T x)) (@identity D (G x)). - intros. - (** This [change] succeeded, but did not progress, in 07e4438bd758c2ced8caf09a6961ccd77d84e42b, because [T0 x o T1 x] was not found in the goal *) - let T0 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T0) end in - let T1 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T1) end in - progress change (T0 x o T1 x) with ((fun y => y) (T0 x o T1 x)). diff --git a/test-suite/bugs/closed/3652.v b/test-suite/bugs/closed/3652.v deleted file mode 100644 index 86e061376d..0000000000 --- a/test-suite/bugs/closed/3652.v +++ /dev/null @@ -1,101 +0,0 @@ -Require Setoid. -Require ZArith. -Import ZArith. - -Inductive Erasable(A : Set) : Prop := - erasable: A -> Erasable A. - -Arguments erasable [A] _. - -Hint Constructors Erasable. - -Scheme Erasable_elim := Induction for Erasable Sort Prop. - -Notation "## T" := (Erasable T) (at level 1, format "## T") : Erasable_scope. -Notation "# x" := (erasable x) (at level 1, format "# x") : Erasable_scope. -Open Scope Erasable_scope. - -Axiom Erasable_inj : forall {A : Set}{a b : A}, #a=#b -> a=b. - -Lemma Erasable_rw : forall (A: Set)(a b : A), (#a=#b) <-> (a=b). -Proof. - intros A a b. - split. - - apply Erasable_inj. - - congruence. -Qed. - -Open Scope Z_scope. -Opaque Z.mul. - -Infix "^" := Zpower_nat : Z_scope. - -Notation "f ; v <- x" := (let (v) := x in f) - (at level 199, left associativity) : Erasable_scope. -Notation "f ; < v" := (f ; v <- v) - (at level 199, left associativity) : Erasable_scope. -Notation "f |# v <- x" := (#f ; v <- x) - (at level 199, left associativity) : Erasable_scope. -Notation "f |# < v" := (#f ; < v) - (at level 199, left associativity) : Erasable_scope. - -Ltac name_evars id := - repeat match goal with |- context[?V] => - is_evar V; let H := fresh id in set (H:=V) in * end. - -Lemma Twoto0 : 2^0 = 1. -Proof. compute. reflexivity. Qed. - -Ltac ring_simplify' := rewrite ?Twoto0; ring_simplify. - -Definition mp2a1s(x : Z)(n : nat) := x * 2^n + (2^n-1). - -Hint Unfold mp2a1s. - -Definition zotval(n1s : nat)(is2 : bool)(next_value : Z) : Z := - 2 * mp2a1s next_value n1s + if is2 then 2 else 0. - -Inductive zot'(eis2 : ##bool)(value : ##Z) : Set := -| Zot'(is2 : bool) - (iseq : eis2=#is2) - {next_is2 : ##bool} - (ok : is2=true -> next_is2=#false) - {next_value : ##Z} - (n1s : nat) - (veq : value = (zotval n1s is2 next_value |#<next_value)) - (next : zot' next_is2 next_value) - : zot' eis2 value. - -Definition de2{eis2 value}(z : zot' eis2 value) : zot' #false value. -Proof. - case z. - intros is2 iseq next_is2 ok next_value n1s veq next. - subst. - destruct is2. - 2:trivial. - clear z. - specialize (ok eq_refl). subst. - destruct n1s. - - refine (Zot' _ _ _ _ _ _ _ _). - all:shelve_unifiable. - reflexivity. - discriminate. - name_evars e. - case_eq next_value. intros next_valueU next_valueEU. - case_eq e. intros eU eEU. - f_equal. - unfold zotval. - unfold mp2a1s. - ring_simplify'. - replace 2 with (2*1) at 2 7 by omega. - rewrite <-?Z.mul_assoc. - rewrite <-?Z.mul_add_distr_l. - rewrite <-Z.mul_sub_distr_l. - rewrite Z.mul_cancel_l by omega. - replace 1 with (2-1) at 1 by omega. - rewrite Z.add_sub_assoc. - rewrite Z.sub_cancel_r. - Unshelve. - all:case_eq next. -Abort. - diff --git a/test-suite/bugs/closed/3656.v b/test-suite/bugs/closed/3656.v deleted file mode 100644 index cbd773d079..0000000000 --- a/test-suite/bugs/closed/3656.v +++ /dev/null @@ -1,53 +0,0 @@ -Module A. - Set Primitive Projections. - Record hSet : Type := BuildhSet { setT : Type; iss : True }. - Ltac head_hnf_under_binders x := - match eval hnf in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal forall s : hSet, True. -intros. -let x := head_hnf_under_binders setT in pose x. - -set (foo := eq_refl (@setT )). generalize foo. simpl. cbn. -Abort. -End A. - -Module A'. -Set Universe Polymorphism. - Set Primitive Projections. -Record hSet (A : Type) : Type := BuildhSet { setT : Type; iss : True }. -Ltac head_hnf_under_binders x := - match eval compute in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal forall s : @hSet nat, True. -intros. -let x := head_hnf_under_binders setT in pose x. - -set (foo := eq_refl (@setT nat)). generalize foo. simpl. cbn. -Abort. -End A'. - -Set Primitive Projections. -Record hSet : Type := BuildhSet { setT : Type; iss : True }. -Ltac head_hnf_under_binders x := - match eval hnf in x with - | ?f _ => head_hnf_under_binders f - | (fun y => ?f y) => head_hnf_under_binders f - | ?y => y - end. -Goal setT = setT. - progress unfold setT. (* should not succeed *) - match goal with - | |- (fun h => setT h) = (fun h => setT h) => fail 1 "should not eta-expand" - | _ => idtac - end. (* should not fail *) -Abort. - -Goal forall h, setT h = setT h. -Proof. intro. progress unfold setT. diff --git a/test-suite/bugs/closed/3657.v b/test-suite/bugs/closed/3657.v deleted file mode 100644 index 778fdab190..0000000000 --- a/test-suite/bugs/closed/3657.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Check typing of replaced objects in change - even though the failure - was already a proper error message (but with a helpless content) *) - -Class foo {A} {a : A} := { bar := a; baz : bar = bar }. -Arguments bar {_} _ {_}. -Instance: forall A a, @foo A a. -intros; constructor. -abstract reflexivity. -Defined. -Goal @bar _ Set _ = (@bar _ (fun _ : Set => Set) _) nat. -Proof. - Fail change (bar (fun _ : Set => Set)) with (bar Set). diff --git a/test-suite/bugs/closed/3660.v b/test-suite/bugs/closed/3660.v deleted file mode 100644 index 39eb89c402..0000000000 --- a/test-suite/bugs/closed/3660.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Import TestSuite.admit. -Generalizable All Variables. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. -Axiom IsHSet : Type -> Type. -Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (compose g f) | 1000. -admit. -Defined. -Set Primitive Projections. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Global Instance isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). -admit. -Defined. -Local Open Scope equiv_scope. -Axiom equiv_path : forall (A B : Type) (p : A = B), A <~> B. - -Goal forall (C D : hSet), IsEquiv (fun x : C = D => (equiv_path C D (ap setT x))). - intros. - change (IsEquiv (equiv_path C D o @ap _ _ setT C D)). - apply @isequiv_compose; [ | admit ]. - Set Typeclasses Debug. - typeclasses eauto. diff --git a/test-suite/bugs/closed/3661.v b/test-suite/bugs/closed/3661.v deleted file mode 100644 index 1f13ffcf34..0000000000 --- a/test-suite/bugs/closed/3661.v +++ /dev/null @@ -1,88 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 11218 lines to 438 lines, then from 434 lines to 202 lines, then from 140 lines to 94 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Bind Scope category_scope with PreCategory. -Local Open Scope morphism_scope. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. -Set Primitive Projections. -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Unset Primitive Projections. -Class Isomorphic {C : PreCategory} s d := - { morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Arguments morphism_inverse {C s d} m {_} / . -Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Generalizable All Variables. -Definition isisomorphism_components_of `{@IsIsomorphism (C -> D) F G T} x : IsIsomorphism (T x). -Proof. - constructor. - exact (T^-1 x). -Defined. -Hint Immediate isisomorphism_components_of : typeclass_instances. -Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3) - (x35 : @Isomorphic (@functor_category x9 x3) f0 x12) - (x37 : object x9) - (H3 : morphism x3 (@object_of x9 x3 f0 x37) - (@object_of x9 x3 f0 x37)) - (x34 : @Isomorphic (@functor_category x9 x3) x12 f0) - (m : morphism x3 (x12 x37) (f0 x37) -> - morphism x3 (f0 x37) (x12 x37) -> - morphism x3 (f0 x37) (f0 x37)), - @paths - (morphism x3 (@object_of x9 x3 f0 x37) (@object_of x9 x3 f0 x37)) - H3 - (m - (@components_of x9 x3 x12 f0 - (@morphism_inverse (@functor_category x9 x3) f0 x12 - (@morphism_isomorphic (@functor_category x9 x3) f0 x12 x35) - (@isisomorphism_isomorphic (@functor_category x9 x3) f0 x12 - x35)) x37) - (@components_of x9 x3 f0 x12 - (@morphism_inverse (@functor_category x9 x3) x12 f0 - (@morphism_isomorphic (@functor_category x9 x3) x12 f0 x34) - (@isisomorphism_isomorphic (@functor_category x9 x3) x12 f0 - x34)) x37)). - Unset Printing All. - intros. - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T1 := constr:(T^-1 x) in - let T2 := constr:((T x)^-1) in - change T1 with T2 || fail 1 "too early" - end. - - Undo. - - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T1 := constr:(T^-1 x) in - change T1 with ((T x)^-1) || fail 1 "too early 2" - end. - - Undo. - - match goal with - | [ |- context[components_of ?T^-1 ?x] ] - => progress let T2 := constr:((T x)^-1) in - change (T^-1 x) with T2 - end. (* not convertible *) - -(* - - (@components_of x9 x3 x12 f0 - (@morphism_inverse _ _ _ - (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37) - -*) diff --git a/test-suite/bugs/closed/3662.v b/test-suite/bugs/closed/3662.v deleted file mode 100644 index b8754bce98..0000000000 --- a/test-suite/bugs/closed/3662.v +++ /dev/null @@ -1,47 +0,0 @@ -Set Primitive Projections. -Set Implicit Arguments. -Set Nonrecursive Elimination Schemes. -Record prod A B := pair { fst : A ; snd : B }. -Definition f : Set -> Type := fun x => x. - -Goal (fst (pair (fun x => x + 1) nat) 0) = 0. -compute. -Undo. -cbv. -Undo. -Opaque fst. -cbn. -Transparent fst. -cbn. -Undo. -simpl. -Undo. -Abort. - -Goal f (fst (pair nat nat)) = nat. -compute. - match goal with - | [ |- fst ?x = nat ] => fail 1 "compute failed" - | [ |- nat = nat ] => idtac - end. - reflexivity. -Defined. - -Goal fst (pair nat nat) = nat. - unfold fst. - match goal with - | [ |- fst ?x = nat ] => fail 1 "compute failed" - | [ |- nat = nat ] => idtac - end. - reflexivity. -Defined. - -Lemma eta A B : forall x : prod A B, x = pair (fst x) (snd x). reflexivity. Qed. - -Goal forall x : prod nat nat, fst x = 0. - intros. unfold fst. - Fail match goal with - | [ |- fst ?x = 0 ] => idtac - end. -Abort. - diff --git a/test-suite/bugs/closed/3667.v b/test-suite/bugs/closed/3667.v deleted file mode 100644 index d2fc4d9bf9..0000000000 --- a/test-suite/bugs/closed/3667.v +++ /dev/null @@ -1,25 +0,0 @@ - -Set Primitive Projections. -Axiom ap10 : forall {A B} {f g:A->B} (h:f=g) x, f x = g x. -Axiom IsHSet : Type -> Type. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d) }. -Set Implicit Arguments. -Record NaturalTransformation C D (F G : Functor C D) := - { components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), components_of s = components_of s }. -Definition set_cat : PreCategory. - exact ((@Build_PreCategory hSet - (fun x y => x -> y))). -Defined. -Goal forall (A : PreCategory) (F : Functor A set_cat) - (a : A) (x : F a) (nt :NaturalTransformation F F), x = x. - intros. - pose (fun c d m => ap10 (commutes nt c d m)). - - diff --git a/test-suite/bugs/closed/3668.v b/test-suite/bugs/closed/3668.v deleted file mode 100644 index 1add3dba1e..0000000000 --- a/test-suite/bugs/closed/3668.v +++ /dev/null @@ -1,54 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 6329 lines to 110 lines, then from 115 lines to 88 lines, then from 93 lines to 72 lines *) -(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) - -Notation "( x ; y )" := (existT _ x y). -Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Notation "A <~> B" := (Equiv A B) (at level 85). -Axiom IsHProp : Type -> Type. -Inductive Bool := true | false. -Definition negb (b : Bool) := if b then false else true. -Hypothesis LEM : forall A : Type, IsHProp A -> A + (A -> False). -Axiom cheat : forall {A},A. -Module NonPrim. - Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Definition Book_6_9 : forall X, X -> X. - Proof. - intro X. - pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. - destruct contrXEquiv as [[f H]|H]; [ exact f.1 | exact (fun x => x) ]. - Defined. - Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. - Proof. - unfold Book_6_9. - destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. - match goal with - | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac - | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" - end. - all:admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. - Definition Book_6_9 : forall X, X -> X. - Proof. - intro X. - pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. - destruct contrXEquiv as [[f H]|H]; [ exact (f.1) | exact (fun x => x) ]. - Defined. - Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. - Proof. - unfold Book_6_9. - destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. - match goal with - | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac - | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" - end. (* Tactic failure: bad *) - all:admit. - Defined. -End Prim. diff --git a/test-suite/bugs/closed/3670.v b/test-suite/bugs/closed/3670.v deleted file mode 100644 index c0f03261a9..0000000000 --- a/test-suite/bugs/closed/3670.v +++ /dev/null @@ -1,23 +0,0 @@ -Set Universe Polymorphism. -Module Type FOO. - Parameter f : Type -> Type. - Parameter h : forall T, f T. -End FOO. - -Module Type BAR. - Include FOO. -End BAR. - -Module Type BAZ. - Include FOO. -End BAZ. - -Module BAR_FROM_BAZ (baz : BAZ) <: BAR. - - Definition f : Type -> Type. - Proof. exact baz.f. Defined. - - Definition h : forall T, f T. - Admitted. - -Fail End BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/3672.v b/test-suite/bugs/closed/3672.v deleted file mode 100644 index b355e7e9db..0000000000 --- a/test-suite/bugs/closed/3672.v +++ /dev/null @@ -1,27 +0,0 @@ -Set Primitive Projections. (* No failures without this option. *) - -Record AT := -{ atype :> Type -; coerce : atype -> Type -}. -Coercion coerce : atype >-> Sortclass. - -Record Ar C (A:AT) := { ar : forall (X Y : C), A }. - -Definition t := forall C A a X, coerce _ (ar C A a X X). -Definition t' := forall C A a X, ar C A a X X. - -(* The command has indeed failed with message: -=> Error: The term "ar C A a X X" has type "atype A" which is not a (co-)inductive type. -*) - -Record Ar2 C (A:AT) := -{ ar2 : forall (X Y : C), A -; id2 : forall X, coerce _ (ar2 X X) }. - -Record Ar3 C (A:AT) := -{ ar3 : forall (X Y : C), A -; id3 : forall X, ar3 X X }. -(* The command has indeed failed with message: -=> Anomaly: Bad recursive type. Please report. -*) diff --git a/test-suite/bugs/closed/3675.v b/test-suite/bugs/closed/3675.v deleted file mode 100644 index 93227ab852..0000000000 --- a/test-suite/bugs/closed/3675.v +++ /dev/null @@ -1,20 +0,0 @@ -Set Primitive Projections. -Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. -Arguments idpath {A a} , [A] a. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. -Local Open Scope path_scope. -Local Open Scope equiv_scope. -Generalizable Variables A B C f g. -Lemma isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} -: IsEquiv (compose g f). -Proof. - refine (Build_IsEquiv A C - (compose g f) - (compose f^-1 g^-1) _). - exact (fun c => ap g (@eisretr _ _ f _ (g^-1 c)) @ (@eisretr _ _ g _ c)). diff --git a/test-suite/bugs/closed/3685.v b/test-suite/bugs/closed/3685.v deleted file mode 100644 index 7a0c3e6f1d..0000000000 --- a/test-suite/bugs/closed/3685.v +++ /dev/null @@ -1,75 +0,0 @@ -Require Import TestSuite.admit. -Set Universe Polymorphism. -Class Funext := { }. -Delimit Scope category_scope with category. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Set Implicit Arguments. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); - identity_of : forall s m, morphism_of s s m = morphism_of s s m }. -Definition sub_pre_cat `{Funext} (P : PreCategory -> Type) : PreCategory. -Proof. - exact (@Build_PreCategory PreCategory Functor). -Defined. -Definition opposite (C : PreCategory) : PreCategory. -Proof. - exact (@Build_PreCategory C (fun s d => morphism C d s)). -Defined. -Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. -Definition prod (C D : PreCategory) : PreCategory. -Proof. - refine (@Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). -Defined. -Local Infix "*" := prod : category_scope. -Record NaturalTransformation C D (F G : Functor C D) := {}. -Definition functor_category (C D : PreCategory) : PreCategory. -Proof. - exact (@Build_PreCategory (Functor C D) (@NaturalTransformation C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Module Export PointwiseCore. - Local Open Scope category_scope. - Definition pointwise - (C C' : PreCategory) - (F : Functor C' C) - (D D' : PreCategory) - (G : Functor D D') - : Functor (C -> D) (C' -> D'). - Proof. - unshelve (refine (Build_Functor - (C -> D) (C' -> D') - _ - _ - _)); - abstract admit. - Defined. -End PointwiseCore. -Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. -Local Open Scope category_scope. -Module Success. - Definition functor_uncurried `{Funext} (P : PreCategory -> Type) - (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) - : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) - := Eval cbv zeta in - let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => @Pidentity_of _ _ _ _). -End Success. -Module Bad. - Include PointwiseCore. - Definition functor_uncurried `{Funext} (P : PreCategory -> Type) - (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) - : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) - := Eval cbv zeta in - let object_of := (fun CD => (((fst CD) -> (snd CD)))) - in Build_Functor - ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) - object_of - (fun CD C'D' FG => pointwise (fst FG) (snd FG)) - (fun _ _ => @Pidentity_of _ _ _ _). diff --git a/test-suite/bugs/closed/3698.v b/test-suite/bugs/closed/3698.v deleted file mode 100644 index 3882eee97c..0000000000 --- a/test-suite/bugs/closed/3698.v +++ /dev/null @@ -1,26 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 5479 lines to 4682 lines, then from 4214 lines to 86 lines, then from 60 lines to 25 lines *) -(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) -Set Primitive Projections. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. -Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. -Global Existing Instance equiv_isequiv. -Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. -Axiom IsHSet : Type -> Type. -Local Open Scope equiv_scope. -Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. -Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). -Axiom issig_hSet: (sigT IsHSet) <~> hSet. -Definition isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). -Proof. - assert (H'' : forall g : X = Y -> (issig_hSet^-1 X).1 = (issig_hSet^-1 Y).1, - g = g -> IsEquiv g) by admit. - Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)). - Fail apply H''. (* stack overflow *) diff --git a/test-suite/bugs/closed/3709.v b/test-suite/bugs/closed/3709.v deleted file mode 100644 index 815f5b9507..0000000000 --- a/test-suite/bugs/closed/3709.v +++ /dev/null @@ -1,24 +0,0 @@ -Require Import TestSuite.admit. -Module NonPrim. - Unset Primitive Projections. - Record hProp := hp { hproptype :> Type }. - Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, - (forall y, h y = y) -> - h (fun b : Type => {| hproptype := f b |}) = k. - Proof. - intros h k f H. - etransitivity. - apply H. - admit. - Defined. -End NonPrim. -Module Prim. - Set Primitive Projections. - Record hProp := hp { hproptype :> Type }. - Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, - (forall y, h y = y) -> - h (fun b : Type => {| hproptype := f b |}) = k. - Proof. - intros h k f H. - etransitivity. - apply H. diff --git a/test-suite/bugs/closed/3710.v b/test-suite/bugs/closed/3710.v deleted file mode 100644 index b9e2798d88..0000000000 --- a/test-suite/bugs/closed/3710.v +++ /dev/null @@ -1,48 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13477 lines to 1457 lines, then from 1553 lines to 1586 lines, then \ -from 1574 lines to 823 lines, then from 837 lines to 802 lines, then from 793 lines to 657 lines, then from 661 lines to 233 lines, t\ -hen from 142 lines to 65 lines *) -(* coqc version trunk (October 2014) compiled on Oct 8 2014 13:38:17 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (335cf2860bfd9e714d14228d75a52fd2c88db386) *) -Set Universe Polymorphism. -Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. -Definition relation (A : Type) := A -> A -> Type. -Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. -Notation "( x ; y )" := (existT _ x y). -Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). -Reserved Infix "o" (at level 40, left associativity). -Delimit Scope category_scope with category. -Record PreCategory := - { object :> Type; - morphism : object -> object -> Type; - compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' }. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Local Open Scope category_scope. -Class Isomorphic {C : PreCategory} (s d : C) := {}. -Axiom composeF : forall C D E (G : Functor D E) (F : Functor C D), Functor C E. -Infix "o" := composeF : functor_scope. -Local Open Scope functor_scope. -Definition sub_pre_cat {P : PreCategory -> Type} : PreCategory. - exact (@Build_PreCategory - { C : PreCategory & P C } - (fun C D => Functor C.1 D.1) - (fun _ _ _ F G => F o G)). -Defined. -Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. -Axiom composeT : forall C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F'), - NaturalTransformation F F''. -Definition functor_category (C D : PreCategory) : PreCategory. - exact (@Build_PreCategory (Functor C D) - (@NaturalTransformation C D) - (@composeT C D)). -Defined. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism (C D : PreCategory) F G : Type := @Isomorphic (C -> D) F G. -Context `{P : PreCategory -> Type}. -Local Notation cat := (@sub_pre_cat P). -Goal forall (s d d' : cat) (m1 : morphism cat d d') (m2 : morphism cat s d), - NaturalIsomorphism (m1 o m2) (m1 o m2)%functor. -Fail exact (fun _ _ _ _ _ => reflexivity _). diff --git a/test-suite/bugs/closed/3732.v b/test-suite/bugs/closed/3732.v deleted file mode 100644 index 13d62b8ff6..0000000000 --- a/test-suite/bugs/closed/3732.v +++ /dev/null @@ -1,105 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 2073 lines to 358 lines, then from 359 lines to 218 lines, then from 107 lines to 92 lines *) -(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 - coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) -Require Coq.Lists.List. - -Import Coq.Lists.List. - -Set Implicit Arguments. -Global Set Asymmetric Patterns. - -Section machine. - Variables pc state : Type. - - Inductive propX (i := pc) (j := state) : list Type -> Type := - | Inj : forall G, Prop -> propX G - | ExistsX : forall G A, propX (A :: G) -> propX G. - - Arguments Inj [G]. - - Definition PropX := propX nil. - Fixpoint last (G : list Type) : Type. - exact (match G with - | nil => unit - | T :: nil => T - | _ :: G' => last G' - end). - Defined. - Fixpoint eatLast (G : list Type) : list Type. - exact (match G with - | nil => nil - | _ :: nil => nil - | x :: G' => x :: eatLast G' - end). - Defined. - - Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) := - match p with - | Inj _ P => fun _ => Inj P - | ExistsX G A p1 => fun p' => - match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with - | nil => fun p1 _ => ExistsX p1 - | _ :: _ => fun _ rc => ExistsX rc - end p1 (subst p1 (match G return (last G -> PropX) -> last (A :: G) -> PropX with - | nil => fun _ _ => Inj True - | _ => fun p' => p' - end p')) - end. - - Definition spec := state -> PropX. - Definition codeSpec := pc -> option spec. - - Inductive valid (specs : codeSpec) (G : list PropX) : PropX -> Prop := Env : forall P, In P G -> valid specs G P. - Definition interp specs := valid specs nil. -End machine. -Notation "'ExX' : A , P" := (ExistsX (A := A) P) (at level 89) : PropX_scope. -Bind Scope PropX_scope with PropX propX. -Variables pc state : Type. - -Inductive subs : list Type -> Type := -| SNil : subs nil -| SCons : forall T Ts, (last (T :: Ts) -> PropX pc state) -> subs (eatLast (T :: Ts)) -> subs (T :: Ts). - -Fixpoint SPush G T (s : subs G) (f : T -> PropX pc state) : subs (T :: G) := - match s in subs G return subs (T :: G) with - | SNil => SCons _ nil f SNil - | SCons T' Ts f' s' => SCons T (T' :: Ts) f' (SPush s' f) - end. - -Fixpoint Substs G (s : subs G) : propX pc state G -> PropX pc state := - match s in subs G return propX pc state G -> PropX pc state with - | SNil => fun p => p - | SCons _ _ f s' => fun p => Substs s' (subst p f) - end. -Variable specs : codeSpec pc state. - -Lemma simplify_fwd_ExistsX : forall G A s (p : propX pc state (A :: G)), - interp specs (Substs s (ExX : A, p)) - -> exists a, interp specs (Substs (SPush s a) p). -admit. -Defined. - -Goal forall (G : list Type) (A : Type) (p : propX pc state (@cons Type A G)) - (s : subs G) - (_ : @interp pc state specs (@Substs G s (@ExistsX pc state G A p))) - (P : forall _ : subs (@cons Type A G), Prop) - (_ : forall (s0 : subs (@cons Type A G)) - (_ : @interp pc state specs (@Substs (@cons Type A G) s0 p)), - P s0), - @ex (forall _ : A, PropX pc state) - (fun a : forall _ : A, PropX pc state => P (@SPush G A s a)). - intros ? ? ? ? H ? H'. - apply simplify_fwd_ExistsX in H. - firstorder. -Qed. - (* Toplevel input, characters 15-19: -Error: Illegal application: -The term "cons" of type "forall A : Type, A -> list A -> list A" -cannot be applied to the terms - "Type" : "Type" - "T" : "Type" - "G0" : "list Type" -The 2nd term has type "Type@{Top.53}" which should be coercible to - "Type@{Top.12}". - *) diff --git a/test-suite/bugs/closed/3735.v b/test-suite/bugs/closed/3735.v deleted file mode 100644 index aced9615ee..0000000000 --- a/test-suite/bugs/closed/3735.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Coq.Program.Tactics. -Class Foo := { bar : Type }. -Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *) -Fail Program Lemma foo : Foo -> bar. diff --git a/test-suite/bugs/closed/3755.v b/test-suite/bugs/closed/3755.v deleted file mode 100644 index 77427ace58..0000000000 --- a/test-suite/bugs/closed/3755.v +++ /dev/null @@ -1,16 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 6729 lines to -411 lines, then from 148 lines to 115 lines, then from 99 lines to 70 lines, -then from 85 lines to 63 lines, then from 76 lines to 55 lines, then from 61 -lines to 17 lines *) -(* coqc version trunk (January 2015) compiled on Jan 17 2015 21:58:5 with OCaml -4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk -(9e6b28c04ad98369a012faf3bd4d630cf123a473) *) -Set Printing Universes. -Section param. - Variable typeD : Set -> Set. - Variable STex : forall (T : Type) (p : T -> Set), Set. - Definition existsEach_cons' v (P : @sigT _ typeD -> Set) := - @STex _ (fun x => P (@existT _ _ v x)). - - Check @existT _ _ STex STex. diff --git a/test-suite/bugs/closed/3777.v b/test-suite/bugs/closed/3777.v deleted file mode 100644 index e203528fcc..0000000000 --- a/test-suite/bugs/closed/3777.v +++ /dev/null @@ -1,17 +0,0 @@ -Unset Strict Universe Declaration. -Module WithoutPoly. - Unset Universe Polymorphism. - Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. - Set Printing Universes. - Definition bla := ((@foo : Set -> _ -> _) : _ -> Type -> _). - (* ((fun A : Set => foo A):Set -> Type@{Top.55} -> Type@{Top.55}) -:Set -> Type@{Top.55} -> Type@{Top.55} - : Set -> Type@{Top.55} -> Type@{Top.55} -(* |= Set <= Top.55 - *) *) -End WithoutPoly. -Module WithPoly. - Set Universe Polymorphism. - Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. - Set Printing Universes. - Fail Check ((@foo : Set -> _ -> _) : _ -> Type -> _). diff --git a/test-suite/bugs/closed/3815.v b/test-suite/bugs/closed/3815.v deleted file mode 100644 index 5fb4839847..0000000000 --- a/test-suite/bugs/closed/3815.v +++ /dev/null @@ -1,9 +0,0 @@ -Require Import Setoid Coq.Program.Basics. -Global Open Scope program_scope. -Axiom foo : forall A (f : A -> A), f ∘ f = f. -Require Import Coq.Program.Combinators. -Hint Rewrite foo. -Theorem t {A B C D} (f : A -> A) (g : B -> C) (h : C -> D) -: f ∘ f = f. -Proof. - rewrite_strat topdown (hints core). diff --git a/test-suite/bugs/closed/3821.v b/test-suite/bugs/closed/3821.v deleted file mode 100644 index 30261ed266..0000000000 --- a/test-suite/bugs/closed/3821.v +++ /dev/null @@ -1,3 +0,0 @@ -Unset Strict Universe Declaration. -Inductive quotient {A : Type@{i}} {B : Type@{j}} : Type@{max(i, j)} := . - diff --git a/test-suite/bugs/closed/3825.v b/test-suite/bugs/closed/3825.v deleted file mode 100644 index 666c64631f..0000000000 --- a/test-suite/bugs/closed/3825.v +++ /dev/null @@ -1,24 +0,0 @@ -Set Universe Polymorphism. -Set Printing Universes. - -Axiom foo@{i j} : Type@{i} -> Type@{j}. - -Notation bar := foo. - -Monomorphic Universes i j. - -Check bar@{i j}. -Fail Check bar@{i}. - -Notation qux := (nat -> nat). - -Fail Check qux@{i}. - -Axiom TruncType@{i} : nat -> Type@{i}. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (0)-Type. - -Check hProp. -Check hProp@{i}. - diff --git a/test-suite/bugs/closed/3828.v b/test-suite/bugs/closed/3828.v deleted file mode 100644 index ae11c6c96c..0000000000 --- a/test-suite/bugs/closed/3828.v +++ /dev/null @@ -1,2 +0,0 @@ -Goal 0 = 0. -Fail pose ?Goal. diff --git a/test-suite/bugs/closed/3849.v b/test-suite/bugs/closed/3849.v deleted file mode 100644 index a8dc3af9cf..0000000000 --- a/test-suite/bugs/closed/3849.v +++ /dev/null @@ -1,8 +0,0 @@ -Tactic Notation "foo" hyp_list(hs) := clear hs. - -Tactic Notation "bar" hyp_list(hs) := foo hs. - -Goal True. -do 5 pose proof 0 as ?n0. -foo n1 n2. -bar n3 n4. diff --git a/test-suite/bugs/closed/3854.v b/test-suite/bugs/closed/3854.v deleted file mode 100644 index 7e915f202b..0000000000 --- a/test-suite/bugs/closed/3854.v +++ /dev/null @@ -1,22 +0,0 @@ -Require Import TestSuite.admit. -Definition relation (A : Type) := A -> A -> Type. -Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. -Axiom IsHProp : Type -> Type. -Existing Class IsHProp. -Inductive Empty : Set := . -Notation "~ x" := (x -> Empty) : type_scope. -Record hProp := BuildhProp { type :> Type ; trunc : IsHProp type }. -Arguments BuildhProp _ {_}. -Canonical Structure default_hProp := fun T P => (@BuildhProp T P). -Generalizable Variables A B f g e n. -Axiom trunc_forall : forall `{P : A -> Type}, IsHProp (forall a, P a). -Existing Instance trunc_forall. -Inductive V : Type := | set {A : Type} (f : A -> V) : V. -Axiom mem : V -> V -> hProp. -Axiom mem_induction -: forall (C : V -> hProp), (forall v, (forall x, mem x v -> C x) -> C v) -> forall v, C v. -Definition irreflexive_mem : forall x, (fun x y => ~ mem x y) x x. -Proof. - pose (fun x => BuildhProp (~ mem x x)). - refine (mem_induction (fun x => BuildhProp (~ mem x x)) _); simpl in *. - admit. diff --git a/test-suite/bugs/closed/3881.v b/test-suite/bugs/closed/3881.v deleted file mode 100644 index 7c60ddf347..0000000000 --- a/test-suite/bugs/closed/3881.v +++ /dev/null @@ -1,35 +0,0 @@ -(* -*- coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2236 lines to 1877 lines, then from 1652 lines to 160 lines, then from 102 lines to 34 lines *) -(* coqc version trunk (December 2014) compiled on Dec 23 2014 22:6:43 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *) -Generalizable All Variables. -Require Import Coq.Init.Notations. -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Axiom admit : forall {T}, T. -Notation "g 'o' f" := (fun x => g (f x)) (at level 40, left associativity). -Notation "g 'o' f" := ltac:(let g' := g in let f' := f in exact (fun x => g' (f' x))) (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *) -Inductive eq {A} (x:A) : A -> Prop := eq_refl : x = x where "x = y" := (@eq _ x y) : type_scope. -Arguments eq_refl {_ _}. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with eq_refl => eq_refl end. -Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. -Arguments eisretr {A B} f {_} _. -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). -Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (g o f) | 1000 := admit. -Definition isequiv_homotopic {A B} (f : A -> B) (g : A -> B) `{IsEquiv A B f} (h : forall x, f x = g x) : IsEquiv g := admit. -Global Instance isequiv_inverse {A B} (f : A -> B) {feq : IsEquiv f} : IsEquiv f^-1 | 10000 := admit. -Definition cancelR_isequiv {A B C} (f : A -> B) {g : B -> C} `{IsEquiv A B f} `{IsEquiv A C (g o f)} : IsEquiv g. -Proof. - pose (fun H => @isequiv_homotopic _ _ ((g o f) o f^-1) _ H - (fun b => ap g (eisretr f b))) as k. - revert k. - let x := match goal with |- let k := ?x in _ => constr:(x) end in - intro k; clear k; - pose (x _). - pose (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ - (fun b => ap g (eisretr f b))). - Undo. - apply (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ - (fun b => ap g (eisretr f b))). -Qed. - diff --git a/test-suite/bugs/closed/3895.v b/test-suite/bugs/closed/3895.v deleted file mode 100644 index 8659ca2cbd..0000000000 --- a/test-suite/bugs/closed/3895.v +++ /dev/null @@ -1,22 +0,0 @@ -Notation pr1 := (@projT1 _ _). -Notation compose := (fun g' f' x => g' (f' x)). -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : -function_scope. -Open Scope function_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p -with eq_refl => eq_refl end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, -f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. -Theorem Univalence_implies_FunextNondep (A B : Type) -: forall f g : A -> B, f == g -> f = g. -Proof. - intros f g p. - pose (d := fun x : A => existT (fun xy => fst xy = snd xy) (f x, f x) -(eq_refl (f x))). - pose (e := fun x : A => existT (fun xy => fst xy = snd xy) (f x, g x) (p x)). - change f with ((snd o pr1) o d). - change g with ((snd o pr1) o e). - apply (ap (fun g => snd o pr1 o g)). -(* Used to raise a not Found due to a "typo" in solve_evar_evar *) diff --git a/test-suite/bugs/closed/3896.v b/test-suite/bugs/closed/3896.v deleted file mode 100644 index b433922a21..0000000000 --- a/test-suite/bugs/closed/3896.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True. -pose proof 0 as n. -Fail apply pair in n. -(* Used to be an anomaly for a while *) diff --git a/test-suite/bugs/closed/3911.v b/test-suite/bugs/closed/3911.v deleted file mode 100644 index b289eafbf4..0000000000 --- a/test-suite/bugs/closed/3911.v +++ /dev/null @@ -1,26 +0,0 @@ -(* Tested against coq ee596bc *) - -Set Nonrecursive Elimination Schemes. -Set Primitive Projections. -Set Universe Polymorphism. - -Record setoid := { base : Type }. - -Definition catdata (Obj Arr : Type) : Type := nat. - (* [nat] can be replaced by any other type, it seems, - without changing the error *) - -Record cat : Type := - { - obj : setoid; - arr : Type; - dta : catdata (base obj) arr - }. - -Definition bcwa (C:cat) (B:setoid) :Type := nat. - (* As above, nothing special about [nat] here. *) - -Record temp {C}{B} (e:bcwa C B) := - { fld : base (obj C) }. - -Print temp_rect. diff --git a/test-suite/bugs/closed/3916.v b/test-suite/bugs/closed/3916.v deleted file mode 100644 index 55c3a35c3a..0000000000 --- a/test-suite/bugs/closed/3916.v +++ /dev/null @@ -1,3 +0,0 @@ -Require Import List. -Fail Hint Resolve -> in_map. - diff --git a/test-suite/bugs/closed/3920.v b/test-suite/bugs/closed/3920.v deleted file mode 100644 index a4adb23cc2..0000000000 --- a/test-suite/bugs/closed/3920.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Setoid. -Axiom P : nat -> Prop. -Axiom P_or : forall x y, P (x + y) <-> P x \/ P y. -Lemma foo (H : P 3) : False. -eapply or_introl in H. -erewrite <- P_or in H. -(* Error: No such hypothesis: H *) diff --git a/test-suite/bugs/closed/3922.v b/test-suite/bugs/closed/3922.v deleted file mode 100644 index d88e8c3325..0000000000 --- a/test-suite/bugs/closed/3922.v +++ /dev/null @@ -1,85 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -Set Universe Polymorphism. -Notation Type0 := Set. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. -Open Scope function_scope. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) -}. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Notation Contr := (IsTrunc -2). -Notation IsHProp := (IsTrunc -1). - -Monomorphic Axiom dummy_funext_type : Type0. -Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. - -Inductive Unit : Set := - tt : Unit. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type -}. - -Arguments BuildTruncType _ _ {_}. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hProp := (-1)-Type. - -Notation BuildhProp := (BuildTruncType -1). - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - -Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) -: IsTrunc@{j} n (Trunc@{i} n A). -Admitted. - -Definition Trunc_ind {n A} - (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} - : (forall a, P (tr a)) -> (forall aa, P aa) -:= (fun f aa => match aa with tr a => fun _ => f a end Pt). -Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). -Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) - (P : Type) `{Pc : X -> Contr P} - (g : X -> P) (h : P -> Y) (p : h o g == f) -: Unit. -Proof. - assert (merely X -> IsHProp P) by admit. - refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); - [ assumption.. | ]. - pose (g'' := Trunc_ind (fun _ => P) g : merely X -> P). diff --git a/test-suite/bugs/closed/3929.v b/test-suite/bugs/closed/3929.v deleted file mode 100644 index 955581ef26..0000000000 --- a/test-suite/bugs/closed/3929.v +++ /dev/null @@ -1,67 +0,0 @@ -Universes i j. -Set Printing Universes. -Set Printing All. -Polymorphic Definition lt@{x y} : Type@{y} := Type@{x}. -Goal True. -evar (T:Type@{i}). -set (Z := nat : Type@{j}). simpl in Z. -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -(** This enforces i <= j *) -Fail pose (lt@{i j}). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -exact I. -Defined. - -Goal True. -evar (T:nat). -pose (Z:=0). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal True. -evar (T:Set). -pose (Z:=nat). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal forall (A:Type)(a:A), True. -intros A a. -evar (T:A). -pose (Z:=a). -let Tv:=eval cbv delta [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. - -Goal True. -evar (T:Type). -pose (Z:=nat). -let Tv:=eval cbv [T] in T in -pose (x:=Tv). -revert x. -refine (_ : let x:=Z in True). -let Zv:=eval cbv [Z] in Z in -let Tv:=eval cbv [T] in T in -constr_eq Zv Tv. -Abort. diff --git a/test-suite/bugs/closed/3938.v b/test-suite/bugs/closed/3938.v deleted file mode 100644 index 859e9f0177..0000000000 --- a/test-suite/bugs/closed/3938.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import TestSuite.admit. -Require Import Coq.Arith.PeanoNat. -Hint Extern 1 => admit : typeclass_instances. -Require Import Setoid. -Goal forall a b (f : nat -> Set) (R : nat -> nat -> Prop), - Equivalence R -> R a b -> f a = f b. - intros a b f H. - intros. Fail rewrite H1. diff --git a/test-suite/bugs/closed/3943.v b/test-suite/bugs/closed/3943.v deleted file mode 100644 index ac9c50369b..0000000000 --- a/test-suite/bugs/closed/3943.v +++ /dev/null @@ -1,50 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 9492 lines to 119 lines *) -(* coqc version 8.5beta1 (January 2015) compiled on Jan 18 2015 7:27:36 with OCaml 3.12.1 - coqtop version 8.5beta1 (January 2015) *) - -Set Typeclasses Dependency Order. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Set Implicit Arguments. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. - -Record PreCategory := Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' }. -Arguments identity {!C%category} / x%object : rename. -Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. - -Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { - morphism_inverse : morphism C d s; - left_inverse : compose morphism_inverse m = identity _; - right_inverse : compose m morphism_inverse = identity _ }. -Arguments morphism_inverse {C s d} m {_}. -Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. - -Class Isomorphic {C : PreCategory} s d := { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. -Coercion morphism_isomorphic : Isomorphic >-> morphism. - -Variable C : PreCategory. -Variables s d : C. - -Definition path_isomorphic (i j : Isomorphic s d) -: @morphism_isomorphic _ _ _ i = @morphism_isomorphic _ _ _ j -> i = j. -Admitted. - -Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q -: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q. diff --git a/test-suite/bugs/closed/3944.v b/test-suite/bugs/closed/3944.v deleted file mode 100644 index 58e60f4f2e..0000000000 --- a/test-suite/bugs/closed/3944.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid. -Definition C (T : Type) := T. -Goal forall T (i : C T) (v : T), True. -Proof. -Fail setoid_rewrite plus_n_Sm. diff --git a/test-suite/bugs/closed/3953.v b/test-suite/bugs/closed/3953.v deleted file mode 100644 index 167cecea8e..0000000000 --- a/test-suite/bugs/closed/3953.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Checking subst on instances of evars (was bugged in 8.5 beta 1) *) -Goal forall (a b : unit), a = b -> exists c, b = c. - intros. - eexists. - subst. diff --git a/test-suite/bugs/closed/3956.v b/test-suite/bugs/closed/3956.v deleted file mode 100644 index 4957cc740d..0000000000 --- a/test-suite/bugs/closed/3956.v +++ /dev/null @@ -1,143 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-indices-matter"); mode: visual-line -*- *) -Set Universe Polymorphism. -Set Primitive Projections. -Close Scope nat_scope. - -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Arguments pair {A B} _ _. -Arguments fst {A B} _ / . -Arguments snd {A B} _ / . -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. - -Unset Strict Universe Declaration. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. -Definition Type2 := Eval hnf in let gt := (Type1 : Type@{i}) in Type@{i}. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (@paths _ x y) : type_scope. -Definition concat {A} {x y z : A} (p : x = y) (q : y = z) : x = z - := match p, q with idpath, idpath => idpath end. - -Definition path_prod {A B : Type} (z z' : A * B) -: (fst z = fst z') -> (snd z = snd z') -> (z = z'). -Proof. - destruct z, z'; simpl; intros [] []; reflexivity. -Defined. - -Module Type TypeM. - Parameter m : Type2. -End TypeM. - -Module ProdM (XM : TypeM) (YM : TypeM) <: TypeM. - Definition m := XM.m * YM.m. -End ProdM. - -Module Type FunctionM (XM YM : TypeM). - Parameter m : XM.m -> YM.m. -End FunctionM. - -Module IdmapM (XM : TypeM) <: FunctionM XM XM. - Definition m := (fun x => x) : XM.m -> XM.m. -End IdmapM. - -Module Type HomotopyM (XM YM : TypeM) (fM gM : FunctionM XM YM). - Parameter m : forall x, fM.m x = gM.m x. -End HomotopyM. - -Module ComposeM (XM YM ZM : TypeM) - (gM : FunctionM YM ZM) (fM : FunctionM XM YM) - <: FunctionM XM ZM. - Definition m := (fun x => gM.m (fM.m x)). -End ComposeM. - -Module Type CorecM (YM ZM : TypeM) (fM : FunctionM YM ZM) - (XM : TypeM) (gM : FunctionM XM ZM). - Parameter m : XM.m -> YM.m. - Parameter m_beta : forall x, fM.m (m x) = gM.m x. -End CorecM. - -Module Type CoindpathsM (YM ZM : TypeM) (fM : FunctionM YM ZM) - (XM : TypeM) (hM kM : FunctionM XM YM). - Module fhM := ComposeM XM YM ZM fM hM. - Module fkM := ComposeM XM YM ZM fM kM. - Declare Module mM (pM : HomotopyM XM ZM fhM fkM) - : HomotopyM XM YM hM kM. -End CoindpathsM. - -Module Type Comodality (XM : TypeM). - Parameter m : Type2. - Module mM <: TypeM. - Definition m := m. - End mM. - Parameter from : m -> XM.m. - Module fromM <: FunctionM mM XM. - Definition m := from. - End fromM. - Declare Module corecM : CorecM mM XM fromM. - Declare Module coindpathsM : CoindpathsM mM XM fromM. -End Comodality. - -Module Comodality_Theory (F : Comodality). - - Module F_functor_M (XM YM : TypeM) (fM : FunctionM XM YM) - (FXM : Comodality XM) (FYM : Comodality YM). - Module f_o_from_M <: FunctionM FXM.mM YM. - Definition m := fun x => fM.m (FXM.from x). - End f_o_from_M. - Module mM := FYM.corecM FXM.mM f_o_from_M. - Definition m := mM.m. - End F_functor_M. - - Module F_prod_cmp_M (XM YM : TypeM) - (FXM : Comodality XM) (FYM : Comodality YM). - Module PM := ProdM XM YM. - Module PFM := ProdM FXM FYM. - Module fstM <: FunctionM PM XM. - Definition m := @fst XM.m YM.m. - End fstM. - Module sndM <: FunctionM PM YM. - Definition m := @snd XM.m YM.m. - End sndM. - Module FPM := F PM. - Module FfstM := F_functor_M PM XM fstM FPM FXM. - Module FsndM := F_functor_M PM YM sndM FPM FYM. - Definition m : FPM.m -> PFM.m - := fun z => (FfstM.m z , FsndM.m z). - End F_prod_cmp_M. - - Module isequiv_F_prod_cmp_M - (XM YM : TypeM) - (FXM : Comodality XM) (FYM : Comodality YM). - (** The comparison map *) - Module cmpM := F_prod_cmp_M XM YM FXM FYM. - Module FPM := cmpM.FPM. - (** We construct an inverse to it using corecursion. *) - Module prod_from_M <: FunctionM cmpM.PFM cmpM.PM. - Definition m : cmpM.PFM.m -> cmpM.PM.m - := fun z => ( FXM.from (fst z) , FYM.from (snd z) ). - End prod_from_M. - Module cmpinvM <: FunctionM cmpM.PFM FPM - := FPM.corecM cmpM.PFM prod_from_M. - (** We prove the first homotopy *) - Module cmpinv_o_cmp_M <: FunctionM FPM FPM - := ComposeM FPM cmpM.PFM FPM cmpinvM cmpM. - Module idmap_FPM <: FunctionM FPM FPM - := IdmapM FPM. - Module cip_FPM := FPM.coindpathsM FPM cmpinv_o_cmp_M idmap_FPM. - Module cip_FPHM <: HomotopyM FPM cmpM.PM cip_FPM.fhM cip_FPM.fkM. - Definition m : forall x, cip_FPM.fhM.m@{i j} x = cip_FPM.fkM.m@{i j} x. - Proof. - intros x. - refine (concat (cmpinvM.m_beta@{i j} (cmpM.m@{i j} x)) _). - apply path_prod@{i i i}; simpl. - - exact (cmpM.FfstM.mM.m_beta@{i j} x). - - exact (cmpM.FsndM.mM.m_beta@{i j} x). - Defined. - End cip_FPHM. - End isequiv_F_prod_cmp_M. - -End Comodality_Theory. diff --git a/test-suite/bugs/closed/3974.v b/test-suite/bugs/closed/3974.v deleted file mode 100644 index 3d9e06b612..0000000000 --- a/test-suite/bugs/closed/3974.v +++ /dev/null @@ -1,7 +0,0 @@ -Module Type S. -End S. - -Module Type M (X : S). - Fail Module P (X : S). - (* Used to say: Anomaly: X already exists. Please report. *) - (* Should rather say now: Error: X already exists. *) diff --git a/test-suite/bugs/closed/3975.v b/test-suite/bugs/closed/3975.v deleted file mode 100644 index c7616b3ab6..0000000000 --- a/test-suite/bugs/closed/3975.v +++ /dev/null @@ -1,8 +0,0 @@ -Module Type S. End S. - -Module M (X:S). End M. - -Module Type P (X : S). - Print M. - (* Used to say: Anomaly: X already exists. Please report. *) - (* Should rather : print something :-) *) diff --git a/test-suite/bugs/closed/3978.v b/test-suite/bugs/closed/3978.v deleted file mode 100644 index 26e021e719..0000000000 --- a/test-suite/bugs/closed/3978.v +++ /dev/null @@ -1,27 +0,0 @@ -Require Import Structures.OrderedType. -Require Import Structures.OrderedTypeEx. - -Module Type M. Parameter X : Type. - -Declare Module Export XOrd : OrderedType - with Definition t := X - with Definition eq := @Logic.eq X. -End M. - -Module M' : M. - Definition X := nat. - - Module XOrd := Nat_as_OT. -End M'. - -Module Type MyOt. - Parameter t : Type. - Parameter eq : t -> t -> Prop. -End MyOt. - -Module Type M2. Parameter X : Type. - -Declare Module Export XOrd : MyOt - with Definition t := X - with Definition eq := @Logic.eq X. -End M2. diff --git a/test-suite/bugs/closed/3993.v b/test-suite/bugs/closed/3993.v deleted file mode 100644 index 086d8dd0f3..0000000000 --- a/test-suite/bugs/closed/3993.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Test smooth failure on not fully applied term to destruct with eqn: given *) -Goal True. -Fail induction S eqn:H. diff --git a/test-suite/bugs/closed/4001.v b/test-suite/bugs/closed/4001.v deleted file mode 100644 index 25d78f4b0e..0000000000 --- a/test-suite/bugs/closed/4001.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Computing the type constraints to be satisfied when building the - return clause of a match with a match *) - -Set Implicit Arguments. -Set Asymmetric Patterns. - -Variable A : Type. -Variable typ : A -> Type. - -Inductive t : list A -> Type := -| snil : t nil -| scons : forall (x : A) (e : typ x) (lx : list A) (le : t lx), t (x::lx). - -Definition car (x:A) (lx : list A) (s: t (x::lx)) : typ x := - match s in t l' with - | snil => False - | scons _ e _ _ => e - end. diff --git a/test-suite/bugs/closed/4016.v b/test-suite/bugs/closed/4016.v deleted file mode 100644 index 41cb1a8884..0000000000 --- a/test-suite/bugs/closed/4016.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Parameter eq : relation nat. -Declare Instance Equivalence_eq : Equivalence eq. - -Lemma foo : forall z, eq z 0 -> forall x, eq x 0 -> eq z x. -Proof. -intros z Hz x Hx. -rewrite <- Hx in Hz. -destruct z. -Abort. - diff --git a/test-suite/bugs/closed/4017.v b/test-suite/bugs/closed/4017.v deleted file mode 100644 index aa810f4f0e..0000000000 --- a/test-suite/bugs/closed/4017.v +++ /dev/null @@ -1,8 +0,0 @@ -Set Implicit Arguments. - -(* Use of implicit arguments was lost in multiple variable declarations *) -Variables - (A1 : Type) - (A2 : forall (x1 : A1), Type) - (A3 : forall (x1 : A1) (x2 : A2 x1), Type) - (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). diff --git a/test-suite/bugs/closed/4018.v b/test-suite/bugs/closed/4018.v deleted file mode 100644 index 8895e09e02..0000000000 --- a/test-suite/bugs/closed/4018.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Catching PatternMatchingFailure was lost at some point *) -Goal nat -> True. -Fail intros [=]. diff --git a/test-suite/bugs/closed/4031.v b/test-suite/bugs/closed/4031.v deleted file mode 100644 index 6c23baffa0..0000000000 --- a/test-suite/bugs/closed/4031.v +++ /dev/null @@ -1,14 +0,0 @@ -Definition something (P:Type) (e:P) := e. - -Inductive myunit : Set := mytt. - (* Proof below works when definition is in Type, - however builtin types such as unit are in Set. *) - -Lemma demo_hide_generic : - let x := mytt in x = x. -Proof. - intros. - change mytt with (@something _ mytt) in x. - subst x. (* Proof works if this line is removed *) - reflexivity. -Qed. diff --git a/test-suite/bugs/closed/4034.v b/test-suite/bugs/closed/4034.v deleted file mode 100644 index 3f7be4d1c7..0000000000 --- a/test-suite/bugs/closed/4034.v +++ /dev/null @@ -1,25 +0,0 @@ -(* This checks compatibility of interpretation scope used for exact - between 8.4 and 8.5. See discussion at - https://coq.inria.fr/bugs/show_bug.cgi?id=4034. It is not clear - what we would like exactly, but certainly, if exact is interpreted - in a special scope, it should be interpreted consistently so also - in ltac code. *) - -Record Foo := {}. -Bind Scope foo_scope with Foo. -Notation "!" := Build_Foo : foo_scope. -Notation "!" := 1 : core_scope. -Open Scope foo_scope. -Open Scope core_scope. - -Goal Foo. - Fail exact !. -(* ... but maybe will we want it to succeed eventually if we ever - would be able to make it working the same in - -Ltac myexact e := exact e. - -Goal Foo. - myexact !. -Defined. -*) diff --git a/test-suite/bugs/closed/4035.v b/test-suite/bugs/closed/4035.v deleted file mode 100644 index ec246d097b..0000000000 --- a/test-suite/bugs/closed/4035.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Supporting tactic notations within Ltac in the presence of an - "ident" entry which does not expect a fresh ident *) -(* Of course, this is a matter of convention of what "ident" is - supposed to denote, but in practice, it seems more convenient to - have less constraints on ident at interpretation time, as - otherwise more ad hoc entries would be necessary (as e.g. a special - "quantified_hypothesis" entry for dependent destruction). *) -Require Import Program. -Goal nat -> Type. - intro x. - lazymatch goal with - | [ x : nat |- _ ] => dependent destruction x - end. diff --git a/test-suite/bugs/closed/4046.v b/test-suite/bugs/closed/4046.v deleted file mode 100644 index 8f8779b7b2..0000000000 --- a/test-suite/bugs/closed/4046.v +++ /dev/null @@ -1,6 +0,0 @@ -Module Import Foo. - Class Foo := { foo : Type }. -End Foo. - -Instance f : Foo := { foo := nat }. (* works fine *) -Instance f' : Foo.Foo := { Foo.foo := nat }. diff --git a/test-suite/bugs/closed/4057.v b/test-suite/bugs/closed/4057.v deleted file mode 100644 index 4f0e696c9a..0000000000 --- a/test-suite/bugs/closed/4057.v +++ /dev/null @@ -1,210 +0,0 @@ -Require Coq.Strings.String. - -Set Implicit Arguments. - -Axiom falso : False. -Ltac admit := destruct falso. - -Reserved Notation "[ x ]". - -Record string_like (CharType : Type) := - { - String :> Type; - Singleton : CharType -> String where "[ x ]" := (Singleton x); - Empty : String; - Concat : String -> String -> String where "x ++ y" := (Concat x y); - bool_eq : String -> String -> bool; - bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; - Length : String -> nat - }. - -Delimit Scope string_like_scope with string_like. -Bind Scope string_like_scope with String. -Arguments Length {_%type_scope _} _%string_like. -Infix "++" := (@Concat _ _) : string_like_scope. - -Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) - := Length s1 < Length s2 \/ s1 = s2. -Infix "≤s" := str_le (at level 70, right associativity). - -Module Export ContextFreeGrammar. - Import Coq.Strings.String. - Import Coq.Lists.List. - - Section cfg. - Variable CharType : Type. - - Section definitions. - - Inductive item := - | NonTerminal (name : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions - }. - End definitions. - - Section parse. - Variable String : string_like CharType. - Variable G : grammar. - - Inductive parse_of : String -> productions -> Type := - | ParseHead : forall str pat pats, parse_of_production str pat - -> parse_of str (pat::pats) - | ParseTail : forall str pat pats, parse_of str pats - -> parse_of str (pat::pats) - with parse_of_production : String -> production -> Type := - | ParseProductionCons : forall str pat strs pats, - parse_of_item str pat - -> parse_of_production strs pats - -> parse_of_production (str ++ strs) (pat::pats) - with parse_of_item : String -> item -> Type := - | ParseNonTerminal : forall name str, parse_of str (Lookup G name) - -> parse_of_item str (NonTerminal -name). - End parse. - End cfg. - -End ContextFreeGrammar. -Module Export ContextFreeGrammarProperties. - - Section cfg. - Context CharType (String : string_like CharType) (G : grammar) - (P : String.string -> Type). - - Fixpoint Forall_parse_of {str pats} (p : parse_of String G str pats) - := match p with - | @ParseHead _ _ _ str pat pats p' - => Forall_parse_of_production p' - | @ParseTail _ _ _ _ _ _ p' - => Forall_parse_of p' - end - with Forall_parse_of_production {str pat} (p : parse_of_production String G -str pat) - := let Forall_parse_of_item {str it} (p : parse_of_item String G str -it) - := match p return Type with - | @ParseNonTerminal _ _ _ name str p' - => (P name * Forall_parse_of p')%type - end in - match p return Type with - | @ParseProductionCons _ _ _ str pat strs pats p' p'' - => (Forall_parse_of_item p' * Forall_parse_of_production -p'')%type - end. - - Definition Forall_parse_of_item {str it} (p : parse_of_item String G str it) - := match p return Type with - | @ParseNonTerminal _ _ _ name str p' - => (P name * Forall_parse_of p')%type - end. - End cfg. - -End ContextFreeGrammarProperties. - -Module Export DependentlyTyped. - Import Coq.Strings.String. - - Section recursive_descent_parser. - - Class parser_computational_predataT := - { nonterminal_names_listT : Type; - initial_nonterminal_names_data : nonterminal_names_listT; - is_valid_nonterminal_name : nonterminal_names_listT -> string -> bool; - remove_nonterminal_name : nonterminal_names_listT -> string -> -nonterminal_names_listT }. - - End recursive_descent_parser. - -End DependentlyTyped. -Import Coq.Strings.String. -Import Coq.Lists.List. - -Section cfg. - Context CharType (String : string_like CharType) (G : grammar). - Context (names_listT : Type) - (initial_names_data : names_listT) - (is_valid_name : names_listT -> string -> bool) - (remove_name : names_listT -> string -> names_listT). - - Inductive minimal_parse_of - : forall (str0 : String) (valid : names_listT) - (str : String), - productions -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : names_listT) - (str : String), - production -> Type := - | MinParseProductionNil : forall str0 valid, - @minimal_parse_of_production str0 valid (Empty _) -nil - | MinParseProductionCons : forall str0 valid str strs pat pats, - str ++ strs ≤s str0 - -> @minimal_parse_of_item str0 valid str pat - -> @minimal_parse_of_production str0 valid strs -pats - -> @minimal_parse_of_production str0 valid (str -++ strs) (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : names_listT) - (str : String), - item -> Type := - | MinParseNonTerminal - : forall str0 valid str name, - @minimal_parse_of_name str0 valid str name - -> @minimal_parse_of_item str0 valid str (NonTerminal name) - with minimal_parse_of_name - : forall (str0 : String) (valid : names_listT) - (str : String), - string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid name str, - @minimal_parse_of str initial_names_data str (Lookup G name) - -> @minimal_parse_of_name str0 valid str name - | MinParseNonTerminalStrEq - : forall str valid name, - @minimal_parse_of str (remove_name valid name) str (Lookup G name) - -> @minimal_parse_of_name str valid str name. - Definition parse_of_item_name__of__minimal_parse_of_name - : forall {str0 valid str name} (p : @minimal_parse_of_name str0 valid str -name), - parse_of_item String G str (NonTerminal name). - Proof. - admit. - Defined. - -End cfg. - -Section recursive_descent_parser. - Context (CharType : Type) - (String : string_like CharType) - (G : grammar). - Context {premethods : parser_computational_predataT}. - Let P : string -> Prop. - Proof. - admit. - Defined. - - Let mp_parse_nonterminal_name str0 valid str nonterminal_name - := { p' : minimal_parse_of_name String G initial_nonterminal_names_data -remove_nonterminal_name str0 valid str nonterminal_name & Forall_parse_of_item -P (parse_of_item_name__of__minimal_parse_of_name p') }. - - Goal False. - Proof. - clear -mp_parse_nonterminal_name. - subst P. - simpl in *. - admit. - Qed. diff --git a/test-suite/bugs/closed/4069.v b/test-suite/bugs/closed/4069.v deleted file mode 100644 index 668f6bb428..0000000000 --- a/test-suite/bugs/closed/4069.v +++ /dev/null @@ -1,106 +0,0 @@ - -Lemma test1 : -forall (v : nat) (f g : nat -> nat), -f v = g v. -intros. f_equal. -(* -Goal in v8.5: f v = g v -Goal in v8.4: v = v -> f v = g v -Expected: f = g -*) -Admitted. - -Lemma test2 : -forall (v u : nat) (f g : nat -> nat), -f v = g u. -intros. f_equal. -(* -In both v8.4 And v8.5 -Goal 1: v = u -> f v = g u -Goal 2: v = u - -Expected Goal 1: f = g -Expected Goal 2: v = u -*) -Admitted. - -Lemma test3 : -forall (v : nat) (u : list nat) (f : nat -> nat) (g : list nat -> nat), -f v = g u. -intros. f_equal. -(* -In both v8.4 And v8.5, the goal is unchanged. -*) -Admitted. - -Require Import List. -Lemma foo n (l k : list nat) : k ++ skipn n l = skipn n l. -Proof. f_equal. -(* - 8.4: leaves the goal unchanged, i.e. k ++ skipn n l = skipn n l - 8.5: 2 goals, skipn n l = l -> k ++ skipn n l = skipn n l - and skipn n l = l -*) -Abort. - -Require Import List. -Fixpoint replicate {A} (n : nat) (x : A) : list A := - match n with 0 => nil | S n => x :: replicate n x end. -Lemma bar {A} n m (x : A) : - skipn n (replicate m x) = replicate (m - n) x -> - skipn n (replicate m x) = replicate (m - n) x. -Proof. intros. f_equal. -(* 8.5: one goal, n = m - n *) -Abort. - -Variable F : nat -> Set. -Variable X : forall n, F (n + 1). - -Definition sequator{X Y: Set}{eq:X=Y}(x:X) : Y := eq_rec _ _ x _ eq. -Definition tequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. -Polymorphic Definition pequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. - -Goal {n:nat & F (S n)}. -eexists. -unshelve eapply (sequator (X _)). -f_equal. (*behaves*) -Undo 2. -unshelve eapply (pequator (X _)). -f_equal. (*behaves*) -Undo 2. -unshelve eapply (tequator (X _)). -f_equal. (*behaves now *) -Focus 2. exact 0. -simpl. -reflexivity. -Defined. - -(* Part 2: modulo casts introduced by refine due to reductions in goals *) - -Goal {n:nat & F (S n)}. -eexists. -(*misbehaves, although same goal as above*) -Set Printing All. -unshelve refine (sequator (X _)); revgoals. -2:exact 0. reflexivity. -Undo 3. -unshelve refine (pequator (X _)); revgoals. -f_equal. -Undo 2. -unshelve refine (tequator (X _)); revgoals. -f_equal. -Admitted. - -Goal @eq Set nat nat. -congruence. -Qed. - -Goal @eq Type nat nat. -congruence. -Qed. - -Variable T : Type. - -Goal @eq Type T T. -congruence. -Qed. diff --git a/test-suite/bugs/closed/4089.v b/test-suite/bugs/closed/4089.v deleted file mode 100644 index fc1c504f14..0000000000 --- a/test-suite/bugs/closed/4089.v +++ /dev/null @@ -1,375 +0,0 @@ -Unset Strict Universe Declaration. -Require Import TestSuite.admit. -(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) -(* File reduced by coq-bug-finder from original input, then from 6522 lines to 318 lines, then from 1139 lines to 361 lines *) -(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) -Open Scope type_scope. - -Global Set Universe Polymorphism. -Module Export Datatypes. - -Set Implicit Arguments. - -Record prod (A B : Type) := pair { fst : A ; snd : B }. - -Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. - -End Datatypes. -Module Export Specif. - -Set Implicit Arguments. - -Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. - -Notation sigT := sig (only parsing). -Notation existT := exist (only parsing). - -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -End Specif. - -Ltac rapply p := - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _ _) || - refine (p _ _ _ _ _ _) || - refine (p _ _ _ _ _) || - refine (p _ _ _ _) || - refine (p _ _ _) || - refine (p _ _) || - refine (p _) || - refine p. - -Local Unset Elimination Schemes. - -Definition relation (A : Type) := A -> A -> Type. - -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Class Transitive {A} (R : relation A) := - transitivity : forall x y z, R x y -> R y z -> R x z. - -Tactic Notation "etransitivity" open_constr(y) := - let R := match goal with |- ?R ?x ?z => constr:(R) end in - let x := match goal with |- ?R ?x ?z => constr:(x) end in - let z := match goal with |- ?R ?x ?z => constr:(z) end in - let pre_proof_term_head := constr:(@transitivity _ R _) in - let proof_term_head := (eval cbn in pre_proof_term_head) in - refine (proof_term_head x y z _ _); [ change (R x y) | change (R y z) ]. - -Ltac transitivity x := etransitivity x. - -Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation "( x ; y )" := (existT _ x y) : fibration_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Scheme paths_ind := Induction for paths Sort Type. - -Definition paths_rect := paths_ind. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Local Open Scope path_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Arguments concat {A x y z} p q : simpl nomatch. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) - : f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B}%type_scope f%function_scope {_} _. -Arguments eissect {A B}%type_scope f%function_scope {_} _. -Arguments eisadj {A B}%type_scope f%function_scope {_} _. - -Record Equiv A B := BuildEquiv { - equiv_fun : A -> B ; - equiv_isequiv : IsEquiv equiv_fun -}. - -Coercion equiv_fun : Equiv >-> Funclass. - -Global Existing Instance equiv_isequiv. - -Bind Scope equiv_scope with Equiv. - -Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. - -Inductive Unit : Set := - tt : Unit. - -Ltac done := - trivial; intros; solve - [ repeat first - [ solve [trivial] - | solve [symmetry; trivial] - | reflexivity - - | contradiction - | split ] - | match goal with - H : ~ _ |- _ => solve [destruct H; trivial] - end ]. -Tactic Notation "by" tactic(tac) := - tac; done. - -Definition concat_p1 {A : Type} {x y : A} (p : x = y) : - p @ 1 = p - := - match p with idpath => 1 end. - -Definition concat_1p {A : Type} {x y : A} (p : x = y) : - 1 @ p = p - := - match p with idpath => 1 end. - -Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : - ap f (p @ q) = (ap f p) @ (ap f q) - := - match q with - idpath => - match p with idpath => 1 end - end. - -Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : - ap (g o f) p = ap g (ap f p) - := - match p with idpath => 1 end. - -Definition concat_A1p {A : Type} {f : A -> A} (p : forall x, f x = x) {x y : A} (q : x = y) : - (ap f q) @ (p y) = (p x) @ q - := - match q with - | idpath => concat_1p _ @ ((concat_p1 _) ^) - end. - -Definition concat2 {A} {x y z : A} {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') - : p @ q = p' @ q' -:= match h, h' with idpath, idpath => 1 end. - -Notation "p @@ q" := (concat2 p q)%path (at level 20) : path_scope. - -Definition whiskerL {A : Type} {x y z : A} (p : x = y) - {q r : y = z} (h : q = r) : p @ q = p @ r -:= 1 @@ h. - -Definition ap02 {A B : Type} (f:A->B) {x y:A} {p q:x=y} (r:p=q) : ap f p = ap f q - := match r with idpath => 1 end. -Module Export Equivalences. - -Generalizable Variables A B C f g. - -Global Instance isequiv_idmap (A : Type) : IsEquiv idmap | 0 := - BuildIsEquiv A A idmap idmap (fun _ => 1) (fun _ => 1) (fun _ => 1). - -Definition equiv_idmap (A : Type) : A <~> A := BuildEquiv A A idmap _. - -Arguments equiv_idmap {A} , A. - -Notation "1" := equiv_idmap : equiv_scope. - -Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} - : IsEquiv (compose g f) | 1000 - := BuildIsEquiv A C (compose g f) - (compose f^-1 g^-1) - (fun c => ap g (eisretr f (g^-1 c)) @ eisretr g c) - (fun a => ap (f^-1) (eissect g (f a)) @ eissect f a) - (fun a => - (whiskerL _ (eisadj g (f a))) @ - (ap_pp g _ _)^ @ - ap02 g - ( (concat_A1p (eisretr f) (eissect g (f a)))^ @ - (ap_compose f^-1 f _ @@ eisadj f a) @ - (ap_pp f _ _)^ - ) @ - (ap_compose f g _)^ - ). - -Definition equiv_compose {A B C : Type} (g : B -> C) (f : A -> B) - `{IsEquiv B C g} `{IsEquiv A B f} - : A <~> C - := BuildEquiv A C (compose g f) _. - -Global Instance transitive_equiv : Transitive Equiv | 0 := - fun _ _ _ f g => equiv_compose g f. - -Theorem equiv_inverse {A B : Type} : (A <~> B) -> (B <~> A). -admit. -Defined. - -Global Instance symmetric_equiv : Symmetric Equiv | 0 := @equiv_inverse. - -End Equivalences. - -Definition path_prod_uncurried {A B : Type} (z z' : A * B) - (pq : (fst z = fst z') * (snd z = snd z')) - : (z = z'). -admit. -Defined. - -Global Instance isequiv_path_prod {A B : Type} {z z' : A * B} -: IsEquiv (path_prod_uncurried z z') | 0. -admit. -Defined. - -Definition equiv_path_prod {A B : Type} (z z' : A * B) - : (fst z = fst z') * (snd z = snd z') <~> (z = z') - := BuildEquiv _ _ (path_prod_uncurried z z') _. - -Generalizable Variables X A B C f g n. - -Definition functor_sigma `{P : A -> Type} `{Q : B -> Type} - (f : A -> B) (g : forall a, P a -> Q (f a)) -: sigT P -> sigT Q - := fun u => (f u.1 ; g u.1 u.2). - -Global Instance isequiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} - `{IsEquiv A B f} `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} -: IsEquiv (functor_sigma f g) | 1000. -admit. -Defined. - -Definition equiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} - (f : A -> B) `{IsEquiv A B f} - (g : forall a, P a -> Q (f a)) - `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} -: sigT P <~> sigT Q - := BuildEquiv _ _ (functor_sigma f g) _. - -Definition equiv_functor_sigma' `{P : A -> Type} `{Q : B -> Type} - (f : A <~> B) - (g : forall a, P a <~> Q (f a)) -: sigT P <~> sigT Q - := equiv_functor_sigma f g. - -Definition equiv_functor_sigma_id `{P : A -> Type} `{Q : A -> Type} - (g : forall a, P a <~> Q a) -: sigT P <~> sigT Q - := equiv_functor_sigma' 1 g. - -Definition Bip : Type := { C : Type & C * C }. - -Definition BipMor (X Y : Bip) : Type := - match X, Y with (C;(c0,c1)), (D;(d0,d1)) => - { f : C -> D & (f c0 = d0) * (f c1 = d1) } - end. - -Definition bipmor2map {X Y : Bip} : BipMor X Y -> X.1 -> Y.1 := - match X, Y with (C;(c0,c1)), (D;(d0,d1)) => fun i => - match i with (f;_) => f end - end. - -Definition bipidmor {X : Bip} : BipMor X X := - match X with (C;(c0,c1)) => (idmap; (1, 1)) end. - -Definition bipcompmor {X Y Z : Bip} : BipMor X Y -> BipMor Y Z -> BipMor X Z := - match X, Y, Z with (C;(c0,c1)), (D;(d0,d1)), (E;(e0,e1)) => fun i j => - match i, j with (f;(f0,f1)), (g;(g0,g1)) => - (g o f; (ap g f0 @ g0, ap g f1 @ g1)) - end - end. - -Definition isbipequiv {X Y : Bip} (i : BipMor X Y) : Type := - { l : BipMor Y X & bipcompmor i l = bipidmor } * - { r : BipMor Y X & bipcompmor r i = bipidmor }. - -Lemma bipequivEQequiv : forall {X Y : Bip} (i : BipMor X Y), - isbipequiv i <~> IsEquiv (bipmor2map i). -Proof. -assert (equivcompmor : forall {X Y : Bip} (i : BipMor X Y) j, -(bipcompmor i j = bipidmor) <~> Unit). - intros; set (U := X); set (V := Y); destruct X as [C [c0 c1]], Y as [D [d0 d1]]. - transitivity { n : (bipcompmor i j).1 = (@bipidmor U).1 & - (bipcompmor i j).2 = transport (fun h => (h c0 = c0) * (h c1 = c1)) n^ (@bipidmor U).2}. - admit. - destruct i as [f [f0 f1]]; destruct j as [g [g0 g1]]. - - transitivity { n : g o f = idmap & (ap g f0 @ g0 = apD10 n c0 @ 1) * - (ap g f1 @ g1 = apD10 n c1 @ 1)}. - apply equiv_functor_sigma_id; intro n. - assert (Ggen : forall (h0 h1 : C -> C) (p : h0 = h1) u0 u1 v0 v1, - ((u0, u1) = transport (fun h => (h c0 = c0) * (h c1 = c1)) p^ (v0, v1)) <~> - (u0 = apD10 p c0 @ v0) * (u1 = apD10 p c1 @ v1)). - induction p; intros; simpl; rewrite !concat_1p; apply symmetry. - by apply (equiv_path_prod (u0,u1) (v0,v1)). - rapply Ggen. - pose (@paths C). - Check (@paths C). - Undo. - Check (@paths C). (* Toplevel input, characters 0-17: -Error: Illegal application: -The term "@paths" of type "forall A : Type, A -> A -> Type" -cannot be applied to the term - "C" : "Type" -This term has type "Type@{Top.892}" which should be coercible to - "Type@{Top.882}". -*) diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v deleted file mode 100644 index bc9380f90d..0000000000 --- a/test-suite/bugs/closed/4095.v +++ /dev/null @@ -1,87 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) -(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) -Require Import Coq.Setoids.Setoid. -Generalizable All Variables. -Axiom admit : forall {T}, T. -Ltac admit := apply admit. -Class Equiv (A : Type) := equiv : relation A. -Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. -Class ILogicOps Frm := { lentails: relation Frm; - ltrue: Frm; - land: Frm -> Frm -> Frm; - lor: Frm -> Frm -> Frm }. -Infix "|--" := lentails (at level 79, no associativity). -Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. -Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. -Infix "-|-" := lequiv (at level 85, no associativity). -Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. -Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. -Section ILogic_Fun. - Context (T: Type) `{TType: type T}. - Context `{IL: ILogic Frm}. - Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. - Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. -End ILogic_Fun. -Arguments ILFunFrm _ {e} _ {ILOps}. -Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; - ltrue := True; - land P Q := P /\ Q; - lor P Q := P \/ Q |}. -Axiom Action : Set. -Definition Actions := list Action. -Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. -Definition OPred := ILFunFrm Actions Prop. -Local Existing Instance ILFun_Ops. -Local Existing Instance ILFun_ILogic. -Definition catOP (P Q: OPred) : OPred := admit. -Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. -admit. -Defined. -Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. -Class IsPointed (T : Type) := point : T. -Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). -Record PointedOPred := mkPointedOPred { - OPred_pred :> OPred; - OPred_inhabited: IsPointed_OPred OPred_pred - }. -Existing Instance OPred_inhabited. -Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred - := {| OPred_pred := O ; OPred_inhabited := _ |}. -Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. -Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) - (tr : T -> T) (O2 : PointedOPred) (x : T) - (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), - exists e1 e2, - catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. - intros; do 2 esplit. - rewrite <- catOPA. - lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) - (@Morphisms.respectful OPred (OPred -> OPred) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) - (@lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> - @lentails OPred - (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP - catOP_entails_m_Proper a a' H b b' H') in - pose P; - refine (P _ _) - end. - Undo. - Fail lazymatch goal with - | |- ?R (?f ?a ?b) (?f ?a' ?b') => - let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in - set(p:=P) - end. (* Toplevel input, characters 15-182: -Error: Cannot infer an instance of type -"PointedOPred" for the variable p in environment: -T : Type -O0 : T -> OPred -O1 : T -> PointedOPred -tr : T -> T -O2 : PointedOPred -x0 : T -H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) diff --git a/test-suite/bugs/closed/4101.v b/test-suite/bugs/closed/4101.v deleted file mode 100644 index 75a26a0670..0000000000 --- a/test-suite/bugs/closed/4101.v +++ /dev/null @@ -1,19 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 10940 lines to 152 lines, then from 509 lines to 163 lines, then from 178 lines to 66 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 2 2015 18:53:10 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (e77f178e60918f14eacd1ec0364a491d4cfd0f3f) *) - -Global Set Primitive Projections. -Set Implicit Arguments. -Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. -Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), - (forall x, f x = g x) -> f = g. -Lemma sigT_obj_eq -: forall (T : Type) (T0 : T -> Type) - (s s0 : forall s : sigT T0, - sigT (fun _ : T0 (projT1 s) => unit) -> - sigT (fun _ : T0 (projT1 s) => unit)), - s0 = s. -Proof. - intros. - Set Debug Tactic Unification. - apply path_forall. diff --git a/test-suite/bugs/closed/4103.v b/test-suite/bugs/closed/4103.v deleted file mode 100644 index 92cc0279ac..0000000000 --- a/test-suite/bugs/closed/4103.v +++ /dev/null @@ -1,12 +0,0 @@ -Set Primitive Projections. - -CoInductive stream A := { hd : A; tl : stream A }. - -CoFixpoint ticks (n : nat) : stream unit := {| hd := tt; tl := ticks n |}. - -Lemma expand : exists n : nat, (ticks n) = (ticks n).(tl _). -Proof. - eexists. - (* Set Debug Tactic Unification. *) - (* Set Debug RAKAM. *) - reflexivity. diff --git a/test-suite/bugs/closed/4116.v b/test-suite/bugs/closed/4116.v deleted file mode 100644 index 5932c9c56e..0000000000 --- a/test-suite/bugs/closed/4116.v +++ /dev/null @@ -1,383 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13191 lines to 1315 lines, then from 1601 lines to 595 lines, then from 585 lines to 379 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 3 2015 3:50:31 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ac62cda8a4f488b94033b108c37556877232137a) *) - -Axiom admit : False. -Ltac admit := exfalso; exact admit. - -Global Set Primitive Projections. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -Definition relation (A : Type) := A -> A -> Type. - -Class Reflexive {A} (R : relation A) := - reflexivity : forall x : A, R x x. - -Class Symmetric {A} (R : relation A) := - symmetry : forall x y, R x y -> R y x. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope path_scope. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Global Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "1" := idpath : path_scope. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. - -Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) -: f == g - := fun x => match h with idpath => 1 end. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) - }. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. - -Class Contr_internal (A : Type) := BuildContr { - center : A ; - contr : (forall y : A, center = y) - }. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. - -Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. -Local Open Scope trunc_scope. -Notation "-2" := minus_two (at level 0) : trunc_scope. -Notation "-1" := (-2.+1) (at level 0) : trunc_scope. -Notation "0" := (-1.+1) : trunc_scope. - -Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := - match n with - | -2 => Contr_internal A - | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) - end. - -Class IsTrunc (n : trunc_index) (A : Type) : Type := - Trunc_is_trunc : IsTrunc_internal n A. - -Tactic Notation "transparent" "assert" "(" ident(name) ":" constr(type) ")" := - unshelve refine (let __transparent_assert_hypothesis := (_ : type) in _); - [ - | ( - let H := match goal with H := _ |- _ => constr:(H) end in - rename H into name) ]. - -Definition transport_idmap_ap A (P : A -> Type) x y (p : x = y) (u : P x) -: transport P p u = transport idmap (ap P p) u - := match p with idpath => idpath end. - -Section Adjointify. - - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). - admit. - Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. - -End Adjointify. - -Record TruncType (n : trunc_index) := BuildTruncType { - trunctype_type : Type ; - istrunc_trunctype_type : IsTrunc n trunctype_type - }. -Arguments trunctype_type {_} _. - -Coercion trunctype_type : TruncType >-> Sortclass. - -Notation "n -Type" := (TruncType n) (at level 1) : type_scope. -Notation hSet := 0-Type. - -Module Export Category. - Module Export Core. - Set Implicit Arguments. - - Delimit Scope morphism_scope with morphism. - Delimit Scope category_scope with category. - Delimit Scope object_scope with object. - - Record PreCategory := - Build_PreCategory' { - object :> Type; - morphism : object -> object -> Type; - - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - - identity_identity : forall x, identity x o identity x = identity x - }. - Arguments identity {!C%category} / x%object : rename. - Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. - - Definition Build_PreCategory - object morphism compose identity - associativity left_identity right_identity - := @Build_PreCategory' - object - morphism - compose - identity - associativity - (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) - left_identity - right_identity - (fun _ => left_identity _ _ _). - - Module Export CategoryCoreNotations. - Infix "o" := compose : morphism_scope. - Notation "1" := (identity _) : morphism_scope. - End CategoryCoreNotations. - - End Core. - -End Category. -Module Export Core. - Set Implicit Arguments. - - Delimit Scope functor_scope with functor. - - Local Open Scope morphism_scope. - - Section Functor. - Variables C D : PreCategory. - - Record Functor := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. - End Functor. - Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. - -End Core. -Module Export Morphisms. - Set Implicit Arguments. - - Local Open Scope category_scope. - Local Open Scope morphism_scope. - - Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - - Class Isomorphic {C : PreCategory} s d := - { - morphism_isomorphic :> morphism C s d; - isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic - }. - - Coercion morphism_isomorphic : Isomorphic >-> morphism. - - Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. - - Section iso_equiv_relation. - Variable C : PreCategory. - - Global Instance isisomorphism_identity (x : C) : IsIsomorphism (identity x) - := {| morphism_inverse := identity x; - left_inverse := left_identity C x x (identity x); - right_inverse := right_identity C x x (identity x) |}. - - Global Instance isomorphic_refl : Reflexive (@Isomorphic C) - := fun x : C => {| morphism_isomorphic := identity x |}. - - Definition idtoiso (x y : C) (H : x = y) : Isomorphic x y - := match H in (_ = y0) return (x <~=~> y0) with - | 1%path => reflexivity x - end. - End iso_equiv_relation. - -End Morphisms. - -Notation IsCategory C := (forall s d : object C, IsEquiv (@idtoiso C s d)). - -Notation isotoid C s d := (@equiv_inv _ _ (@idtoiso C s d) _). - -Notation cat_of obj := - (@Build_PreCategory obj - (fun x y => x -> y) - (fun _ x => x) - (fun _ _ _ f g => f o g)%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - ). -Definition set_cat : PreCategory := cat_of hSet. -Set Implicit Arguments. - -Local Open Scope morphism_scope. - -Section Grothendieck. - Variable C : PreCategory. - Variable F : Functor C set_cat. - - Record Pair := - { - c : C; - x : F c - }. - - Local Notation Gmorphism s d := - { f : morphism C s.(c) d.(c) - | morphism_of F f s.(x) = d.(x) }. - - Definition identity_H s - := apD10 (identity_of F s.(c)) s.(x). - - Definition Gidentity s : Gmorphism s s. - Proof. - exists 1. - apply identity_H. - Defined. - - Definition Gcategory : PreCategory. - Proof. - unshelve refine (@Build_PreCategory - Pair - (fun s d => Gmorphism s d) - Gidentity - _ - _ - _ - _); admit. - Defined. -End Grothendieck. - -Lemma isotoid_1 {C} `{IsCategory C} {x : C} {H : IsIsomorphism (identity x)} -: isotoid C x x {| morphism_isomorphic := (identity x) ; isisomorphism_isomorphic := H |} - = idpath. - admit. -Defined. -Generalizable All Variables. - -Section Grothendieck2. - Context `{IsCategory C}. - Variable F : Functor C set_cat. - - Instance iscategory_grothendieck_toset : IsCategory (Gcategory F). - Proof. - intros s d. - unshelve refine (isequiv_adjointify _ _ _ _). - { - intro m. - transparent assert (H' : (s.(c) = d.(c))). - { - apply (idtoiso C (x := s.(c)) (y := d.(c)))^-1%function. - exists (m : morphism _ _ _).1. - admit. - - } - { - transitivity {| x := transport (fun x => F x) H' s.(x) |}. - admit. - - { - change d with {| c := d.(c) ; x := d.(x) |}; simpl. - apply ap. - subst H'. - simpl. - refine (transport_idmap_ap _ (fun x => F x : Type) _ _ _ _ @ _ @ (m : morphism _ _ _).2). - change (fun x => F x : Type) with (trunctype_type o object_of F)%function. - admit. - } - } - } - { - admit. - } - - { - intro x. - hnf in s, d. - destruct x. - simpl. - erewrite @isotoid_1. diff --git a/test-suite/bugs/closed/4151.v b/test-suite/bugs/closed/4151.v deleted file mode 100644 index fc0b58cfe1..0000000000 --- a/test-suite/bugs/closed/4151.v +++ /dev/null @@ -1,403 +0,0 @@ -Lemma foo (H : forall A, A) : forall A, A. - Show Universes. - eexact H. -Qed. - -(* File reduced by coq-bug-finder from original input, then from 6390 lines to 397 lines *) -(* coqc version 8.5beta1 (March 2015) compiled on Mar 17 2015 12:34:25 with OCaml 4.01.0 - coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (1b3759e78f227eb85a128c58b8ce8c11509dd8c3) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Import Coq.Lists.SetoidList. -Require Export Coq.Program.Program. - -Global Set Implicit Arguments. -Global Set Asymmetric Patterns. - -Fixpoint combine_sig_helper {T} {P : T -> Prop} (ls : list T) : (forall x, In x ls -> P x) -> list (sig P). - admit. -Defined. - -Lemma Forall_forall1_transparent_helper_1 {A P} {x : A} {xs : list A} {l : list A} - (H : Forall P l) (H' : x::xs = l) -: P x. - admit. -Defined. -Lemma Forall_forall1_transparent_helper_2 {A P} {x : A} {xs : list A} {l : list A} - (H : Forall P l) (H' : x::xs = l) -: Forall P xs. - admit. -Defined. - -Fixpoint Forall_forall1_transparent {A} (P : A -> Prop) (l : list A) {struct l} -: Forall P l -> forall x, In x l -> P x - := match l as l return Forall P l -> forall x, In x l -> P x with - | nil => fun _ _ f => match f : False with end - | x::xs => fun H x' H' => - match H' with - | or_introl H'' => eq_rect x - P - (Forall_forall1_transparent_helper_1 H eq_refl) - _ - H'' - | or_intror H'' => @Forall_forall1_transparent A P xs (Forall_forall1_transparent_helper_2 H eq_refl) _ H'' - end - end. - -Definition combine_sig {T P ls} (H : List.Forall P ls) : list (@sig T P) - := combine_sig_helper ls (@Forall_forall1_transparent T P ls H). -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -Record string_like (CharType : Type) := - { - String :> Type; - Singleton : CharType -> String where "[ x ]" := (Singleton x); - Empty : String; - Concat : String -> String -> String where "x ++ y" := (Concat x y); - bool_eq : String -> String -> bool; - bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; - Length : String -> nat; - Associativity : forall x y z, (x ++ y) ++ z = x ++ (y ++ z); - LeftId : forall x, Empty ++ x = x; - RightId : forall x, x ++ Empty = x; - Singleton_Length : forall x, Length (Singleton x) = 1; - Length_correct : forall s1 s2, Length s1 + Length s2 = Length (s1 ++ s2); - Length_Empty : Length Empty = 0; - Empty_Length : forall s1, Length s1 = 0 -> s1 = Empty; - Not_Singleton_Empty : forall x, Singleton x <> Empty; - SplitAt : nat -> String -> String * String; - SplitAt_correct : forall n s, fst (SplitAt n s) ++ snd (SplitAt n s) = s; - SplitAt_concat_correct : forall s1 s2, SplitAt (Length s1) (s1 ++ s2) = (s1, s2); - SplitAtLength_correct : forall n s, Length (fst (SplitAt n s)) = min (Length s) n - }. - -Delimit Scope string_like_scope with string_like. -Bind Scope string_like_scope with String. -Arguments Length {_%type_scope _} _%string_like. -Notation "[[ x ]]" := (@Singleton _ _ x) : string_like_scope. -Infix "++" := (@Concat _ _) : string_like_scope. -Infix "=s" := (@bool_eq _ _) (at level 70, right associativity) : string_like_scope. - -Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) - := Length s1 < Length s2 \/ s1 = s2. -Infix "≤s" := str_le (at level 70, right associativity). - -Record StringWithSplitState {CharType} (String : string_like CharType) (split_stateT : String -> Type) := - { string_val :> String; - state_val : split_stateT string_val }. - -Module Export ContextFreeGrammar. - Require Import Coq.Strings.String. - - Section cfg. - Variable CharType : Type. - - Section definitions. - - Inductive item := - | Terminal (_ : CharType) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - End cfg. - -End ContextFreeGrammar. -Module Export BaseTypes. - Import Coq.Strings.String. - - Local Open Scope string_like_scope. - - Inductive any_grammar CharType := - | include_item (_ : item CharType) - | include_production (_ : production CharType) - | include_productions (_ : productions CharType) - | include_nonterminal (_ : string). - Global Coercion include_item : item >-> any_grammar. - Global Coercion include_production : production >-> any_grammar. - - Section recursive_descent_parser. - Context {CharType : Type} - {String : string_like CharType} - {G : grammar CharType}. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - initial_nonterminals_data : nonterminals_listT; - is_valid_nonterminal : nonterminals_listT -> string -> bool; - remove_nonterminal : nonterminals_listT -> string -> nonterminals_listT; - nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal = true - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - ntl_wf : well_founded nonterminals_listT_R }. - - Class parser_computational_types_dataT := - { predata :> parser_computational_predataT; - split_stateT : String -> nonterminals_listT -> any_grammar CharType -> String -> Type }. - - Class parser_computational_dataT' `{parser_computational_types_dataT} := - { split_string_for_production - : forall (str0 : String) (valid : nonterminals_listT) (it : item CharType) (its : production CharType) (str : StringWithSplitState String (split_stateT str0 valid (it::its : production CharType))), - list (StringWithSplitState String (split_stateT str0 valid it) - * StringWithSplitState String (split_stateT str0 valid its)); - split_string_for_production_correct - : forall str0 valid it its str, - let P f := List.Forall f (@split_string_for_production str0 valid it its str) in - P (fun s1s2 => (fst s1s2 ++ snd s1s2 =s str) = true) }. - End recursive_descent_parser. - -End BaseTypes. -Import Coq.Strings.String. - -Section cfg. - Context CharType (String : string_like CharType) (G : grammar CharType). - Context (names_listT : Type) - (initial_names_data : names_listT) - (is_valid_name : names_listT -> string -> bool) - (remove_name : names_listT -> string -> names_listT) - (names_listT_R : names_listT -> names_listT -> Prop) - (remove_name_dec : forall ls name, - is_valid_name ls name = true - -> names_listT_R (remove_name ls name) ls) - (remove_name_1 - : forall ls ps ps', - is_valid_name (remove_name ls ps) ps' = true - -> is_valid_name ls ps' = true) - (remove_name_2 - : forall ls ps ps', - is_valid_name (remove_name ls ps) ps' = false - <-> is_valid_name ls ps' = false \/ ps = ps') - (ntl_wf : well_founded names_listT_R). - - Inductive minimal_parse_of - : forall (str0 : String) (valid : names_listT) - (str : String), - productions CharType -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : names_listT) - (str : String), - production CharType -> Type := - | MinParseProductionNil : forall str0 valid, - @minimal_parse_of_production str0 valid (Empty _) nil - | MinParseProductionCons : forall str0 valid str strs pat pats, - str ++ strs ≤s str0 - -> @minimal_parse_of_item str0 valid str pat - -> @minimal_parse_of_production str0 valid strs pats - -> @minimal_parse_of_production str0 valid (str ++ strs) (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : names_listT) - (str : String), - item CharType -> Type := - | MinParseTerminal : forall str0 valid x, - @minimal_parse_of_item str0 valid [[ x ]]%string_like (Terminal x) - | MinParseNonTerminal - : forall str0 valid str name, - @minimal_parse_of_name str0 valid str name - -> @minimal_parse_of_item str0 valid str (NonTerminal CharType name) - with minimal_parse_of_name - : forall (str0 : String) (valid : names_listT) - (str : String), - string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid name str, - Length str < Length str0 - -> is_valid_name initial_names_data name = true - -> @minimal_parse_of str initial_names_data str (Lookup G name) - -> @minimal_parse_of_name str0 valid str name - | MinParseNonTerminalStrEq - : forall str valid name, - is_valid_name initial_names_data name = true - -> is_valid_name valid name = true - -> @minimal_parse_of str (remove_name valid name) str (Lookup G name) - -> @minimal_parse_of_name str valid str name. -End cfg. - -Local Coercion is_true : bool >-> Sortclass. - -Local Open Scope string_like_scope. - -Section general. - Context {CharType} {String : string_like CharType} {G : grammar CharType}. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_stateT : String -> Type; - data' :> _ := {| BaseTypes.predata := predata ; BaseTypes.split_stateT := fun _ _ _ => split_stateT |}; - split_string_for_production - : forall it its, - StringWithSplitState String split_stateT - -> list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT); - split_string_for_production_correct - : forall it its (str : StringWithSplitState String split_stateT), - let P f := List.Forall f (split_string_for_production it its str) in - P (fun s1s2 => - (fst s1s2 ++ snd s1s2 =s str) = true); - premethods :> parser_computational_dataT' - := @Build_parser_computational_dataT' - _ String data' - (fun _ _ => split_string_for_production) - (fun _ _ => split_string_for_production_correct) }. - - Definition split_list_completeT `{data : boolean_parser_dataT} - {str0 valid} - (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) - (split_list : list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT)) - (it : item CharType) (its : production CharType) - := ({ s1s2 : String * String - & (fst s1s2 ++ snd s1s2 =s str) - * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) - * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type) - -> ({ s1s2 : StringWithSplitState String split_stateT * StringWithSplitState String split_stateT - & (In s1s2 split_list) - * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) - * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type). -End general. - -Section recursive_descent_parser. - Context {CharType} - {String : string_like CharType} - {G : grammar CharType}. - Context `{data : @boolean_parser_dataT _ String}. - - Section bool. - Section parts. - Definition parse_item - (str_matches_nonterminal : string -> bool) - (str : StringWithSplitState String split_stateT) - (it : item CharType) - : bool - := match it with - | Terminal ch => [[ ch ]] =s str - | NonTerminal nt => str_matches_nonterminal nt - end. - - Section production. - Context {str0} - (parse_nonterminal - : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Fixpoint parse_production - (str : StringWithSplitState String split_stateT) - (pf : str ≤s str0) - (prod : production CharType) - : bool. - Proof. - refine - match prod with - | nil => - - str =s Empty _ - | it::its - => let parse_production' := fun str pf => parse_production str pf its in - fold_right - orb - false - (let mapF f := map f (combine_sig (split_string_for_production_correct it its str)) in - mapF (fun s1s2p => - (parse_item - (parse_nonterminal (fst (proj1_sig s1s2p)) _) - (fst (proj1_sig s1s2p)) - it) - && parse_production' (snd (proj1_sig s1s2p)) _)%bool) - end; - revert pf; clear; intros; admit. - Defined. - End production. - - End parts. - End bool. -End recursive_descent_parser. - -Section sound. - Context CharType (String : string_like CharType) (G : grammar CharType). - Context `{data : @boolean_parser_dataT CharType String}. - - Section production. - Context (str0 : String) - (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Definition parse_nonterminal_completeT P - := forall valid (str : StringWithSplitState String split_stateT) pf nonterminal (H_sub : P str0 valid nonterminal), - minimal_parse_of_name _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal - -> @parse_nonterminal str pf nonterminal = true. - - Lemma parse_production_complete - valid Pv - (parse_nonterminal_complete : parse_nonterminal_completeT Pv) - (Hinit : forall str (pf : str ≤s str0) nonterminal, - minimal_parse_of_name String G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal - -> Pv str0 valid nonterminal) - (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) - (prod : production CharType) - (split_string_for_production_complete' - : forall str0 valid str pf, - Forall_tails - (fun prod' => - match prod' return Type with - | nil => True - | it::its => split_list_completeT (G := G) (valid := valid) (str0 := str0) str pf (split_string_for_production it its str) it its - end) - prod) - : minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str prod - -> parse_production parse_nonterminal str pf prod = true. - admit. - Defined. - End production. - Context (str0 : String) - (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), - str ≤s str0 - -> string - -> bool). - - Goal forall (a : production CharType), - (forall (str1 : String) (valid : nonterminals_listT) - (str : StringWithSplitState String split_stateT) - (pf : str ≤s str1), - Forall_tails - (fun prod' : list (item CharType) => - match prod' with - | [] => True - | it :: its => - split_list_completeT (G := G) (valid := valid) str pf - (split_string_for_production it its str) it its - end) a) -> - forall (str : String) (pf : str ≤s str0) (st : split_stateT str), - parse_production parse_nonterminal - {| string_val := str; state_val := st |} pf a = true. - Proof. - intros a X **. - eapply parse_production_complete. - Focus 3. - exact X. - Undo. - assumption. - Undo. - eassumption. (* no applicable tactic *) diff --git a/test-suite/bugs/closed/4165.v b/test-suite/bugs/closed/4165.v deleted file mode 100644 index 8e0a62d35c..0000000000 --- a/test-suite/bugs/closed/4165.v +++ /dev/null @@ -1,7 +0,0 @@ -Lemma foo : True. -Proof. -pose (fun x : nat => (let H:=true in x)) as s. -match eval cbv delta [s] in s with -| context C[true] => - let C':=context C[false] in pose C' as s' -end. diff --git a/test-suite/bugs/closed/4187.v b/test-suite/bugs/closed/4187.v deleted file mode 100644 index b13ca36a37..0000000000 --- a/test-suite/bugs/closed/4187.v +++ /dev/null @@ -1,709 +0,0 @@ -(* Lifted from https://coq.inria.fr/bugs/show_bug.cgi?id=4187 *) -(* File reduced by coq-bug-finder from original input, then from 715 lines to 696 lines *) -(* coqc version 8.4pl5 (December 2014) compiled on Dec 28 2014 03:23:16 with OCaml 4.01.0 - coqtop version 8.4pl5 (December 2014) *) -Set Asymmetric Patterns. -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Import Coq.Lists.List. -Require Import Coq.Setoids.Setoid. -Require Import Coq.Numbers.Natural.Peano.NPeano. -Global Set Implicit Arguments. -Global Generalizable All Variables. -Coercion is_true : bool >-> Sortclass. -Coercion bool_of_sumbool {A B} (x : {A} + {B}) : bool := if x then true else false. -Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type - := match ls return Type with - | nil => True - | x::xs => (P x * ForallT P xs)%type - end. -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -Module Export ADTSynthesis_DOT_Common_DOT_Wf. -Module Export ADTSynthesis. -Module Export Common. -Module Export Wf. - -Section wf. - Section wf_prod. - Context A B (RA : relation A) (RB : relation B). -Definition prod_relation : relation (A * B). -exact (fun ab a'b' => - RA (fst ab) (fst a'b') \/ (fst a'b' = fst ab /\ RB (snd ab) (snd a'b'))). -Defined. - - Fixpoint well_founded_prod_relation_helper - a b - (wf_A : Acc RA a) (wf_B : well_founded RB) {struct wf_A} - : Acc prod_relation (a, b) - := match wf_A with - | Acc_intro fa => (fix wf_B_rec b' (wf_B' : Acc RB b') : Acc prod_relation (a, b') - := Acc_intro - _ - (fun ab => - match ab as ab return prod_relation ab (a, b') -> Acc prod_relation ab with - | (a'', b'') => - fun pf => - match pf with - | or_introl pf' - => @well_founded_prod_relation_helper - _ _ - (fa _ pf') - wf_B - | or_intror (conj pfa pfb) - => match wf_B' with - | Acc_intro fb - => eq_rect - _ - (fun a'' => Acc prod_relation (a'', b'')) - (wf_B_rec _ (fb _ pfb)) - _ - pfa - end - end - end) - ) b (wf_B b) - end. - - Definition well_founded_prod_relation : well_founded RA -> well_founded RB -> well_founded prod_relation. - Proof. - intros wf_A wf_B [a b]; hnf in *. - apply well_founded_prod_relation_helper; auto. - Defined. - End wf_prod. - - Section wf_projT1. - Context A (B : A -> Type) (R : relation A). -Definition projT1_relation : relation (sigT B). -exact (fun ab a'b' => - R (projT1 ab) (projT1 a'b')). -Defined. - - Definition well_founded_projT1_relation : well_founded R -> well_founded projT1_relation. - Proof. - intros wf [a b]; hnf in *. - induction (wf a) as [a H IH]. - constructor. - intros y r. - specialize (IH _ r (projT2 y)). - destruct y. - exact IH. - Defined. - End wf_projT1. -End wf. - -Section Fix3. - Context A (B : A -> Type) (C : forall a, B a -> Type) (D : forall a b, C a b -> Type) - (R : A -> A -> Prop) (Rwf : well_founded R) - (P : forall a b c, D a b c -> Type) - (F : forall x : A, (forall y : A, R y x -> forall b c d, P y b c d) -> forall b c d, P x b c d). -Definition Fix3 a b c d : @P a b c d. -exact (@Fix { a : A & { b : B a & { c : C b & D c } } } - (fun x y => R (projT1 x) (projT1 y)) - (well_founded_projT1_relation Rwf) - (fun abcd => P (projT2 (projT2 (projT2 abcd)))) - (fun x f => @F (projT1 x) (fun y r b c d => f (existT _ y (existT _ b (existT _ c d))) r) _ _ _) - (existT _ a (existT _ b (existT _ c d)))). -Defined. -End Fix3. - -End Wf. - -End Common. - -End ADTSynthesis. - -End ADTSynthesis_DOT_Common_DOT_Wf. - -Module Export ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. -Module Export ADTSynthesis. -Module Export Parsers. -Module Export StringLike. -Module Export Core. -Import Coq.Setoids.Setoid. -Import Coq.Classes.Morphisms. - - - -Module Export StringLike. - Class StringLike {Char : Type} := - { - String :> Type; - is_char : String -> Char -> bool; - length : String -> nat; - take : nat -> String -> String; - drop : nat -> String -> String; - bool_eq : String -> String -> bool; - beq : relation String := fun x y => bool_eq x y - }. - - Arguments StringLike : clear implicits. - Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. - Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. - Local Open Scope string_like_scope. - - Definition str_le `{StringLike Char} (s1 s2 : String) - := length s1 < length s2 \/ s1 =s s2. - Infix "≤s" := str_le (at level 70, right associativity). - - Class StringLikeProperties (Char : Type) `{StringLike Char} := - { - singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; - length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; - bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; - is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; - length_Proper :> Proper (beq ==> eq) length; - take_Proper :> Proper (eq ==> beq ==> beq) take; - drop_Proper :> Proper (eq ==> beq ==> beq) drop; - bool_eq_Equivalence :> Equivalence beq; - bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; - take_short_length : forall str n, n <= length str -> length (take n str) = n; - take_long : forall str n, length str <= n -> take n str =s str; - take_take : forall str n m, take n (take m str) =s take (min n m) str; - drop_length : forall str n, length (drop n str) = length str - n; - drop_0 : forall str, drop 0 str =s str; - drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; - drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); - take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str) - }. - - Arguments StringLikeProperties Char {_}. -End StringLike. - -End Core. - -End StringLike. - -End Parsers. - -End ADTSynthesis. - -End ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. - -Module Export ADTSynthesis. -Module Export Parsers. -Module Export ContextFreeGrammar. -Require Import Coq.Strings.String. -Require Import Coq.Lists.List. -Export ADTSynthesis.Parsers.StringLike.Core. -Import ADTSynthesis.Common. - -Local Open Scope string_like_scope. - -Section cfg. - Context {Char : Type}. - - Section definitions. - - Inductive item := - | Terminal (_ : Char) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - Section parse. - Context {HSL : StringLike Char}. - Variable G : grammar. - - Inductive parse_of (str : String) : productions -> Type := - | ParseHead : forall pat pats, parse_of_production str pat - -> parse_of str (pat::pats) - | ParseTail : forall pat pats, parse_of str pats - -> parse_of str (pat::pats) - with parse_of_production (str : String) : production -> Type := - | ParseProductionNil : length str = 0 -> parse_of_production str nil - | ParseProductionCons : forall n pat pats, - parse_of_item (take n str) pat - -> parse_of_production (drop n str) pats - -> parse_of_production str (pat::pats) - with parse_of_item (str : String) : item -> Type := - | ParseTerminal : forall ch, str ~= [ ch ] -> parse_of_item str (Terminal ch) - | ParseNonTerminal : forall nt, parse_of str (Lookup G nt) - -> parse_of_item str (NonTerminal nt). - End parse. -End cfg. - -Arguments item _ : clear implicits. -Arguments production _ : clear implicits. -Arguments productions _ : clear implicits. -Arguments grammar _ : clear implicits. - -End ContextFreeGrammar. - -Module Export BaseTypes. - -Section recursive_descent_parser. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - initial_nonterminals_data : nonterminals_listT; - is_valid_nonterminal : nonterminals_listT -> String.string -> bool; - remove_nonterminal : nonterminals_listT -> String.string -> nonterminals_listT; - nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - ntl_wf : well_founded nonterminals_listT_R }. - - Class parser_removal_dataT' `{predata : parser_computational_predataT} := - { remove_nonterminal_1 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' - -> is_valid_nonterminal ls ps'; - remove_nonterminal_2 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' = false - <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. -End recursive_descent_parser. - -End BaseTypes. -Import Coq.Lists.List. -Import ADTSynthesis.Parsers.ContextFreeGrammar. - -Local Open Scope string_like_scope. - -Section cfg. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - Context {predata : @parser_computational_predataT} - {rdata' : @parser_removal_dataT' predata}. - - Inductive minimal_parse_of - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - productions Char -> Type := - | MinParseHead : forall str0 valid str pat pats, - @minimal_parse_of_production str0 valid str pat - -> @minimal_parse_of str0 valid str (pat::pats) - | MinParseTail : forall str0 valid str pat pats, - @minimal_parse_of str0 valid str pats - -> @minimal_parse_of str0 valid str (pat::pats) - with minimal_parse_of_production - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - production Char -> Type := - | MinParseProductionNil : forall str0 valid str, - length str = 0 - -> @minimal_parse_of_production str0 valid str nil - | MinParseProductionCons : forall str0 valid str n pat pats, - str ≤s str0 - -> @minimal_parse_of_item str0 valid (take n str) pat - -> @minimal_parse_of_production str0 valid (drop n str) pats - -> @minimal_parse_of_production str0 valid str (pat::pats) - with minimal_parse_of_item - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - item Char -> Type := - | MinParseTerminal : forall str0 valid str ch, - str ~= [ ch ] - -> @minimal_parse_of_item str0 valid str (Terminal ch) - | MinParseNonTerminal - : forall str0 valid str (nt : String.string), - @minimal_parse_of_nonterminal str0 valid str nt - -> @minimal_parse_of_item str0 valid str (NonTerminal nt) - with minimal_parse_of_nonterminal - : forall (str0 : String) (valid : nonterminals_listT) - (str : String), - String.string -> Type := - | MinParseNonTerminalStrLt - : forall str0 valid (nt : String.string) str, - length str < length str0 - -> is_valid_nonterminal initial_nonterminals_data nt - -> @minimal_parse_of str initial_nonterminals_data str (Lookup G nt) - -> @minimal_parse_of_nonterminal str0 valid str nt - | MinParseNonTerminalStrEq - : forall str0 str valid nonterminal, - str =s str0 - -> is_valid_nonterminal initial_nonterminals_data nonterminal - -> is_valid_nonterminal valid nonterminal - -> @minimal_parse_of str0 (remove_nonterminal valid nonterminal) str (Lookup G nonterminal) - -> @minimal_parse_of_nonterminal str0 valid str nonterminal. -End cfg. -Import ADTSynthesis.Common. - -Section general. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_string_for_production - : item Char -> production Char -> String -> list nat }. - - Global Coercion predata : boolean_parser_dataT >-> parser_computational_predataT. - - Definition split_list_completeT `{data : @parser_computational_predataT} - {str0 valid} - (it : item Char) (its : production Char) - (str : String) - (pf : str ≤s str0) - (split_list : list nat) - - := ({ n : nat - & (minimal_parse_of_item (G := G) (predata := data) str0 valid (take n str) it) - * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type) - -> ({ n : nat - & (In n split_list) - * (minimal_parse_of_item (G := G) str0 valid (take n str) it) - * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type). - - Class boolean_parser_completeness_dataT' `{data : boolean_parser_dataT} := - { split_string_for_production_complete - : forall str0 valid str (pf : str ≤s str0) nt, - is_valid_nonterminal initial_nonterminals_data nt - -> ForallT - (Forall_tails - (fun prod - => match prod return Type with - | nil => True - | it::its - => @split_list_completeT data str0 valid it its str pf (split_string_for_production it its str) - end)) - (Lookup G nt) }. -End general. - -Module Export BooleanRecognizer. -Import Coq.Numbers.Natural.Peano.NPeano. -Import Coq.Arith.Compare_dec. -Import Coq.Arith.Wf_nat. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}. - Context {data : @boolean_parser_dataT Char _}. - - Section bool. - Section parts. -Definition parse_item - (str_matches_nonterminal : String.string -> bool) - (str : String) - (it : item Char) - : bool. -Admitted. - - Section production. - Context {str0} - (parse_nonterminal - : forall (str : String), - str ≤s str0 - -> String.string - -> bool). - - Fixpoint parse_production - (str : String) - (pf : str ≤s str0) - (prod : production Char) - : bool. - Proof. - refine - match prod with - | nil => - - Nat.eq_dec (length str) 0 - | it::its - => let parse_production' := fun str pf => parse_production str pf its in - fold_right - orb - false - (map (fun n => - (parse_item - (parse_nonterminal (str := take n str) _) - (take n str) - it) - && parse_production' (drop n str) _)%bool - (split_string_for_production it its str)) - end; - revert pf; clear -HSLP; intros; admit. - Defined. - End production. - - Section productions. - Context {str0} - (parse_nonterminal - : forall (str : String) - (pf : str ≤s str0), - String.string -> bool). -Definition parse_productions - (str : String) - (pf : str ≤s str0) - (prods : productions Char) - : bool. -exact (fold_right orb - false - (map (parse_production parse_nonterminal pf) - prods)). -Defined. - End productions. - - Section nonterminals. - Section step. - Context {str0 valid} - (parse_nonterminal - : forall (p : String * nonterminals_listT), - prod_relation (ltof _ length) nonterminals_listT_R p (str0, valid) - -> forall str : String, - str ≤s fst p -> String.string -> bool). - - Definition parse_nonterminal_step - (str : String) - (pf : str ≤s str0) - (nt : String.string) - : bool. - Proof. - refine - (if lt_dec (length str) (length str0) - then - parse_productions - (@parse_nonterminal - (str : String, initial_nonterminals_data) - (or_introl _)) - (or_intror (reflexivity _)) - (Lookup G nt) - else - if Sumbool.sumbool_of_bool (is_valid_nonterminal valid nt) - then - parse_productions - (@parse_nonterminal - (str0 : String, remove_nonterminal valid nt) - (or_intror (conj eq_refl (remove_nonterminal_dec _ nt _)))) - (str := str) - _ - (Lookup G nt) - else - false); - assumption. - Defined. - End step. - - Section wf. -Definition parse_nonterminal_or_abort - : forall (p : String * nonterminals_listT) - (str : String), - str ≤s fst p - -> String.string - -> bool. -exact (Fix3 - _ _ _ - (well_founded_prod_relation - (well_founded_ltof _ length) - ntl_wf) - _ - (fun sl => @parse_nonterminal_step (fst sl) (snd sl))). -Defined. -Definition parse_nonterminal - (str : String) - (nt : String.string) - : bool. -exact (@parse_nonterminal_or_abort - (str : String, initial_nonterminals_data) str - (or_intror (reflexivity _)) nt). -Defined. - End wf. - End nonterminals. - End parts. - End bool. -End recursive_descent_parser. - -Section cfg. - Context {Char} {HSL : StringLike Char} {HSLP : @StringLikeProperties Char HSL} (G : grammar Char). - - Section definitions. - Context (P : String -> String.string -> Type). - - Definition Forall_parse_of_item' - (Forall_parse_of : forall {str pats} (p : parse_of G str pats), Type) - {str it} (p : parse_of_item G str it) - := match p return Type with - | ParseTerminal ch pf => unit - | ParseNonTerminal nt p' - => (P str nt * Forall_parse_of p')%type - end. - - Fixpoint Forall_parse_of {str pats} (p : parse_of G str pats) - := match p with - | ParseHead pat pats p' - => Forall_parse_of_production p' - | ParseTail _ _ p' - => Forall_parse_of p' - end - with Forall_parse_of_production {str pat} (p : parse_of_production G str pat) - := match p return Type with - | ParseProductionNil pf => unit - | ParseProductionCons pat strs pats p' p'' - => (Forall_parse_of_item' (@Forall_parse_of) p' * Forall_parse_of_production p'')%type - end. - - Definition Forall_parse_of_item {str it} (p : parse_of_item G str it) - := @Forall_parse_of_item' (@Forall_parse_of) str it p. - End definitions. - - End cfg. - -Section recursive_descent_parser_list. - Context {Char} {HSL : StringLike Char} {HLSP : StringLikeProperties Char} {G : grammar Char}. -Definition rdp_list_nonterminals_listT : Type. -exact (list String.string). -Defined. -Definition rdp_list_is_valid_nonterminal : rdp_list_nonterminals_listT -> String.string -> bool. -admit. -Defined. -Definition rdp_list_remove_nonterminal : rdp_list_nonterminals_listT -> String.string -> rdp_list_nonterminals_listT. -admit. -Defined. -Definition rdp_list_nonterminals_listT_R : rdp_list_nonterminals_listT -> rdp_list_nonterminals_listT -> Prop. -exact (ltof _ (@List.length _)). -Defined. - Lemma rdp_list_remove_nonterminal_dec : forall ls prods, - @rdp_list_is_valid_nonterminal ls prods = true - -> @rdp_list_nonterminals_listT_R (@rdp_list_remove_nonterminal ls prods) ls. -admit. -Defined. - Lemma rdp_list_ntl_wf : well_founded rdp_list_nonterminals_listT_R. - Proof. - unfold rdp_list_nonterminals_listT_R. - intro. - apply well_founded_ltof. - Defined. - - Global Instance rdp_list_predata : parser_computational_predataT - := { nonterminals_listT := rdp_list_nonterminals_listT; - initial_nonterminals_data := Valid_nonterminals G; - is_valid_nonterminal := rdp_list_is_valid_nonterminal; - remove_nonterminal := rdp_list_remove_nonterminal; - nonterminals_listT_R := rdp_list_nonterminals_listT_R; - remove_nonterminal_dec := rdp_list_remove_nonterminal_dec; - ntl_wf := rdp_list_ntl_wf }. -End recursive_descent_parser_list. - -Section sound. - Section general. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). - Context {data : @boolean_parser_dataT Char _} - {cdata : @boolean_parser_completeness_dataT' Char _ G data} - {rdata : @parser_removal_dataT' predata}. - - Section parts. - - Section nonterminals. - Section wf. - - Lemma parse_nonterminal_sound - (str : String) (nonterminal : String.string) - : parse_nonterminal (G := G) str nonterminal - = true - -> parse_of_item G str (NonTerminal nonterminal). -admit. -Defined. - End wf. - End nonterminals. - End parts. - End general. -End sound. - -Import Coq.Strings.String. -Import ADTSynthesis.Parsers.ContextFreeGrammar. - -Fixpoint list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T - := match ls with - | nil => fun _ => default - | (str, t)::ls' => fun s => if string_dec str s - then t - else list_to_productions default ls' s - end. - -Fixpoint list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T - := {| Start_symbol := hd ""%string (map (@fst _ _) ls); - Lookup := list_to_productions default ls; - Valid_nonterminals := map (@fst _ _) ls |}. - -Section interface. - Context {Char} (G : grammar Char). -Definition production_is_reachable (p : production Char) : Prop. -admit. -Defined. -Definition split_list_is_complete `{HSL : StringLike Char} (str : String) (it : item Char) (its : production Char) - (splits : list nat) - : Prop. -exact (forall n, - n <= length str - -> parse_of_item G (take n str) it - -> parse_of_production G (drop n str) its - -> production_is_reachable (it::its) - -> List.In n splits). -Defined. - - Record Splitter := - { - string_type :> StringLike Char; - splits_for : String -> item Char -> production Char -> list nat; - - string_type_properties :> StringLikeProperties Char; - splits_for_complete : forall str it its, - split_list_is_complete str it its (splits_for str it its) - - }. - Global Existing Instance string_type_properties. - - Record Parser (HSL : StringLike Char) := - { - has_parse : @String Char HSL -> bool; - - has_parse_sound : forall str, - has_parse str = true - -> parse_of_item G str (NonTerminal (Start_symbol G)); - - has_parse_complete : forall str (p : parse_of_item G str (NonTerminal (Start_symbol G))), - Forall_parse_of_item - (fun _ nt => List.In nt (Valid_nonterminals G)) - p - -> has_parse str = true - }. -End interface. - -Module Export ParserImplementation. - -Section implementation. - Context {Char} {G : grammar Char}. - Context (splitter : Splitter G). - - Local Instance parser_data : @boolean_parser_dataT Char _ := - { predata := rdp_list_predata (G := G); - split_string_for_production it its str - := splits_for splitter str it its }. - - Program Definition parser : Parser G splitter - := {| has_parse str := parse_nonterminal (G := G) (data := parser_data) str (Start_symbol G); - has_parse_sound str Hparse := parse_nonterminal_sound G _ _ Hparse; - has_parse_complete str p Hp := _ |}. - Next Obligation. -admit. -Defined. -End implementation. - -End ParserImplementation. - -Section implementation. - Context {Char} {ls : list (String.string * productions Char)}. - Local Notation G := (list_to_grammar (nil::nil) ls) (only parsing). - Context (splitter : Splitter G). - - Local Instance parser_data : @boolean_parser_dataT Char _ := parser_data splitter. - - Goal forall str : @String Char splitter, - let G' := - @BooleanRecognizer.parse_nonterminal Char splitter splitter G parser_data str G = true in - G'. - intros str G'. - Timeout 1 assert (pf' : G' -> Prop) by abstract admit. diff --git a/test-suite/bugs/closed/4190.v b/test-suite/bugs/closed/4190.v deleted file mode 100644 index 2843488ba0..0000000000 --- a/test-suite/bugs/closed/4190.v +++ /dev/null @@ -1,15 +0,0 @@ -Module Type A . - Tactic Notation "bar" := idtac "ITSME". -End A. - -Module Type B. - Tactic Notation "foo" := fail "NOTME". -End B. - -Module Type C := A <+ B. - -Module Type F (Import M : C). - -Lemma foo : True. -Proof. -bar. diff --git a/test-suite/bugs/closed/4191.v b/test-suite/bugs/closed/4191.v deleted file mode 100644 index 290bb384d9..0000000000 --- a/test-suite/bugs/closed/4191.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Test maximal implicit arguments in the presence of let-ins *) -Definition foo (x := 1) {y : nat} (H : y = y) : True := I. -Definition bar {y : nat} (x := 1) (H : y = y) : True := I. -Check bar (eq_refl 1). -Check foo (eq_refl 1). diff --git a/test-suite/bugs/closed/4198.v b/test-suite/bugs/closed/4198.v deleted file mode 100644 index 28800ac05a..0000000000 --- a/test-suite/bugs/closed/4198.v +++ /dev/null @@ -1,39 +0,0 @@ -(* Check that the subterms of the predicate of a match are taken into account *) - -Require Import List. -Open Scope list_scope. -Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'), - let k := - (match H in (_ = y) return x = hd x y with - | eq_refl => eq_refl - end : x = x') - in k = k. - simpl. - intros. - match goal with - | [ |- context G[@hd] ] => idtac - end. -Abort. - -(* This second example comes from CFGV where inspecting subterms of a - match is expecting to inspect first the term to match (even though - it would certainly be better to provide a "match x with _ end" - construct for generically matching a "match") *) - -Ltac find_head_of_head_match T := - match T with context [?E] => - match T with - | E => fail 1 - | _ => constr:(E) - end - end. - -Ltac mydestruct := - match goal with - | |- ?T1 = _ => let E := find_head_of_head_match T1 in destruct E - end. - -Goal forall x, match x with 0 => 0 | _ => 0 end = 0. -intros. -mydestruct. -Abort. diff --git a/test-suite/bugs/closed/4205.v b/test-suite/bugs/closed/4205.v deleted file mode 100644 index c40dfcc1f3..0000000000 --- a/test-suite/bugs/closed/4205.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Testing a regression from 8.5beta1 to 8.5beta2 in evar-evar tactic unification problems *) - - -Inductive test : nat -> nat -> nat -> nat -> Prop := - | test1 : forall m n, test m n m n. - -Goal test 1 2 3 4. -erewrite f_equal2 with (f := fun k l => test _ _ k l). diff --git a/test-suite/bugs/closed/4216.v b/test-suite/bugs/closed/4216.v deleted file mode 100644 index ae7f746778..0000000000 --- a/test-suite/bugs/closed/4216.v +++ /dev/null @@ -1,20 +0,0 @@ -Generalizable Variables T A. - -Inductive path `(a: A): A -> Type := idpath: path a a. - -Class TMonad (T: Type -> Type) := { - bind: forall {A B: Type}, (T A) -> (A -> T B) -> T B; - ret: forall {A: Type}, A -> T A; - ret_unit_left: forall {A B: Type} (k: A -> T B) (a: A), - path (bind (ret a) k) (k a) - }. - -Let T_fzip `{TMonad T} := fun (A B: Type) (f: T (A -> B)) (t: T A) - => bind t (fun a => bind f (fun g => ret (g a) )). -Let T_pure `{TMonad T} := @ret _ _. - -Let T_pure_id `{TMonad T} {A: Type} (t: A -> A) (x: T A): - path (T_fzip A A (T_pure (A -> A) t) x) x. - unfold T_fzip, T_pure. - Fail rewrite (ret_unit_left (fun g a => ret (g a)) (fun x => x)). - diff --git a/test-suite/bugs/closed/4217.v b/test-suite/bugs/closed/4217.v deleted file mode 100644 index 19973f30a7..0000000000 --- a/test-suite/bugs/closed/4217.v +++ /dev/null @@ -1,6 +0,0 @@ -(* Checking correct index of implicit by pos in fixpoints *) - -Fixpoint ith_default - {default_A : nat} - {As : list nat} - {struct As} : Set. diff --git a/test-suite/bugs/closed/4221.v b/test-suite/bugs/closed/4221.v deleted file mode 100644 index bc120fb1ff..0000000000 --- a/test-suite/bugs/closed/4221.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Some test checking that interpreting binder names using ltac - context does not accidentally break the bindings *) - -Goal (forall x : nat, x = 1 -> False) -> 1 = 1 -> False. - intros H0 x. - lazymatch goal with - | [ x : forall k : nat, _ |- _ ] - => specialize (fun H0 => x 1 H0) - end. diff --git a/test-suite/bugs/closed/4234.v b/test-suite/bugs/closed/4234.v deleted file mode 100644 index 348dd49d93..0000000000 --- a/test-suite/bugs/closed/4234.v +++ /dev/null @@ -1,7 +0,0 @@ -Definition UU := Type. - -Definition dirprodpair {X Y : UU} := existT (fun x : X => Y). - -Definition funtoprodtoprod {X Y Z : UU} : { a : X -> Y & X -> Z }. -Proof. - refine (dirprodpair _ (fun x => _)). diff --git a/test-suite/bugs/closed/4240.v b/test-suite/bugs/closed/4240.v deleted file mode 100644 index 083c59fe68..0000000000 --- a/test-suite/bugs/closed/4240.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Check that closure of filter did not restrict the former evar filter *) - -Lemma foo (new : nat) : False. -evar (H1: nat). -set (H3 := 0). -assert (H3' := id H3). -evar (H5: nat). -clear H3. -assert (H5 = new). -unfold H5. -unfold H1. -exact (eq_refl new). diff --git a/test-suite/bugs/closed/4251.v b/test-suite/bugs/closed/4251.v deleted file mode 100644 index f112e7b4d5..0000000000 --- a/test-suite/bugs/closed/4251.v +++ /dev/null @@ -1,17 +0,0 @@ - -Inductive array : Type -> Type := -| carray : forall A, array A. - -Inductive Mtac : Type -> Prop := -| bind : forall {A B}, Mtac A -> (A -> Mtac B) -> Mtac B -| array_make : forall {A}, A -> Mtac (array A). - -Definition Ref := array. - -Definition ref : forall {A}, A -> Mtac (Ref A) := - fun A x=> array_make x. -Check array Type. -Check fun A : Type => Ref A. - -Definition abs_val (a : Type) := - bind (ref a) (fun r : array Type => array_make tt). diff --git a/test-suite/bugs/closed/4256.v b/test-suite/bugs/closed/4256.v deleted file mode 100644 index 3cdc4ada02..0000000000 --- a/test-suite/bugs/closed/4256.v +++ /dev/null @@ -1,43 +0,0 @@ -(* Testing 8.5 regression with type classes not solving evars - redefined while trying to solve them with the type class mechanism *) - -Global Set Universe Polymorphism. -Monomorphic Universe i. -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Inductive trunc_index : Type := -| minus_two : trunc_index -| trunc_S : trunc_index -> trunc_index. -Notation "-1" := (trunc_S minus_two) (at level 0). - -Class IsPointed (A : Type) := point : A. -Arguments point A {_}. - -Record pType := - { pointed_type : Type ; - ispointed_type : IsPointed pointed_type }. -Coercion pointed_type : pType >-> Sortclass. -Existing Instance ispointed_type. - -Private Inductive Trunc (n : trunc_index) (A :Type) : Type := - tr : A -> Trunc n A. -Arguments tr {n A} a. - - - -Record ooGroup := - { classifying_space : pType@{i} }. - -Definition group_loops (X : pType) -: ooGroup. -Proof. - (** This works: *) - pose (x0 := point X). - pose (H := existT (fun x:X => Trunc -1 (x = point X)) x0 (tr idpath)). - clear H x0. - (** But this doesn't: *) - pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)). diff --git a/test-suite/bugs/closed/4273.v b/test-suite/bugs/closed/4273.v deleted file mode 100644 index 401e86649b..0000000000 --- a/test-suite/bugs/closed/4273.v +++ /dev/null @@ -1,9 +0,0 @@ - - -Set Primitive Projections. -Record total2 (P : nat -> Prop) := tpair { pr1 : nat; pr2 : P pr1 }. -Theorem onefiber' (q : total2 (fun y => y = 0)) : True. -Proof. assert (foo:=pr2 _ q). simpl in foo. - destruct foo. (* Error: q is used in conclusion. *) exact I. Qed. - -Print onefiber'. diff --git a/test-suite/bugs/closed/4276.v b/test-suite/bugs/closed/4276.v deleted file mode 100644 index ea9cbb210f..0000000000 --- a/test-suite/bugs/closed/4276.v +++ /dev/null @@ -1,11 +0,0 @@ -Set Primitive Projections. - -Record box (T U : Type) (x := T) := wrap { unwrap : T }. -Definition mybox : box True False := wrap _ _ I. -Definition unwrap' := @unwrap. - -Definition bad' : True := mybox.(unwrap _ _). - -Fail Definition bad : False := unwrap _ _ mybox. - -(* Closed under the global context *) diff --git a/test-suite/bugs/closed/4283.v b/test-suite/bugs/closed/4283.v deleted file mode 100644 index e06998b711..0000000000 --- a/test-suite/bugs/closed/4283.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import Hurkens. - -Polymorphic Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. - -Definition unwrap' := fun (X : Type) (b : box X) => let (unwrap) := b in unwrap. - -Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _ Type)) eq_refl. - diff --git a/test-suite/bugs/closed/4284.v b/test-suite/bugs/closed/4284.v deleted file mode 100644 index 0fff3026ff..0000000000 --- a/test-suite/bugs/closed/4284.v +++ /dev/null @@ -1,6 +0,0 @@ -Set Primitive Projections. -Record total2 { T: Type } ( P: T -> Type ) := tpair { pr1 : T; pr2 : P pr1 }. -Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True. -Proof. -set (Q1 := total2 (fun f => pr1 P f = x)). -set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)). diff --git a/test-suite/bugs/closed/4287.v b/test-suite/bugs/closed/4287.v deleted file mode 100644 index 757b71b2dd..0000000000 --- a/test-suite/bugs/closed/4287.v +++ /dev/null @@ -1,123 +0,0 @@ -Unset Strict Universe Declaration. - -Universe b. - -Universe c. - -Definition U : Type@{b} := Type@{c}. - -Module Type MT. - -Definition T := Prop. -End MT. - -Module M : MT. - Definition T := Type@{b}. - -Print Universes. -Fail End M. - -Set Universe Polymorphism. - -(* This is a modified version of Hurkens with all universes floating *) -Section Hurkens. - -Variable down : Type -> Type. -Variable up : Type -> Type. - -Hypothesis back : forall A, up (down A) -> A. - -Hypothesis forth : forall A, A -> up (down A). - -Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), - P (back A (forth A a)) -> P a. - -Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), - P a -> P (back A (forth A a)). - -(** Proof *) -Definition V : Type := forall A:Type, ((up A -> Type) -> up A -> Type) -> up A -> Type. -Definition U : Type := V -> Type. - -Definition sb (z:V) : V := fun A r a => r (z A r) a. -Definition le (i:U -> Type) (x:U) : Type := x (fun A r a => i (fun v => sb v A r a)). -Definition le' (i:up (down U) -> Type) (x:up (down U)) : Type := le (fun a:U => i (forth _ a)) (back _ x). -Definition induct (i:U -> Type) : Type := forall x:U, up (le i x) -> up (i x). -Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). -Definition I (x:U) : Type := - (forall i:U -> Type, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. - -Lemma Omega : forall i:U -> Type, induct i -> up (i WF). -Proof. -intros i y. -apply y. -unfold le, WF, induct. -apply forth. -intros x H0. -apply y. -unfold sb, le', le. -compute. -apply backforth_r. -exact H0. -Qed. - -Lemma lemma1 : induct (fun u => down (I u)). -Proof. -unfold induct. -intros x p. -apply forth. -intro q. -generalize (q (fun u => down (I u)) p). -intro r. -apply back in r. -apply r. -intros i j. -unfold le, sb, le', le in j |-. -apply backforth in j. -specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). -apply q. -exact j. -Qed. - -Lemma lemma2 : (forall i:U -> Type, induct i -> up (i WF)) -> False. -Proof. -intro x. -generalize (x (fun u => down (I u)) lemma1). -intro r; apply back in r. -apply r. -intros i H0. -apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). -unfold le, WF in H0. -apply back in H0. -exact H0. -Qed. - -Theorem paradox : False. -Proof. -exact (lemma2 Omega). -Qed. - -End Hurkens. - -Polymorphic Record box (T : Type) := wrap {unwrap : T}. - -(* Here we instantiate to Set *) - -Fail Definition down (x : Type) : Prop := box x. -Definition up (x : Prop) : Type := x. - -Fail Definition back A : up (down A) -> A := unwrap A. - -Fail Definition forth A : A -> up (down A) := wrap A. - -Definition id {A : Type} (a : A) := a. -Definition setlt (A : Type@{i}) := - let foo := Type@{i} : Type@{j} in True. - -Definition setle (B : Type@{i}) := - let foo (A : Type@{j}) := A in foo B. - -Fail Check @setlt@{j Prop}. -Fail Definition foo := @setle@{j Prop}. -Check setlt@{Set i}. -Check setlt@{Set j}. diff --git a/test-suite/bugs/closed/4299.v b/test-suite/bugs/closed/4299.v deleted file mode 100644 index a1daa193ae..0000000000 --- a/test-suite/bugs/closed/4299.v +++ /dev/null @@ -1,12 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. - -Module Type Foo. - Definition U := Type : Type. - Parameter eq : Type = U. -End Foo. - -Module M : Foo with Definition U := Type : Type. - Definition U := let X := Type in Type. - Definition eq : Type = U := eq_refl. -Fail End M. diff --git a/test-suite/bugs/closed/4301.v b/test-suite/bugs/closed/4301.v deleted file mode 100644 index b4e17c2231..0000000000 --- a/test-suite/bugs/closed/4301.v +++ /dev/null @@ -1,13 +0,0 @@ -Unset Strict Universe Declaration. -Set Universe Polymorphism. - -Module Type Foo. - Parameter U : Type. -End Foo. - -Module Lower (X : Foo with Definition U := True : Type). -End Lower. - -Module M : Foo. - Definition U := nat : Type@{i}. -End M. diff --git a/test-suite/bugs/closed/4325.v b/test-suite/bugs/closed/4325.v deleted file mode 100644 index af69ca04b6..0000000000 --- a/test-suite/bugs/closed/4325.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal (forall a b : nat, Set = (a = b)) -> Set. -Proof. - clear. - intro H. - erewrite (fun H' => H _ H'). diff --git a/test-suite/bugs/closed/4347.v b/test-suite/bugs/closed/4347.v deleted file mode 100644 index 29686a26c1..0000000000 --- a/test-suite/bugs/closed/4347.v +++ /dev/null @@ -1,17 +0,0 @@ -Fixpoint demo_recursion(n:nat) := match n with - |0 => Type - |S k => (demo_recursion k) -> Type - end. - -Record Demonstration := mkDemo -{ - demo_law : forall n:nat, demo_recursion n; - demo_stuff : forall n:nat, forall q:(fix demo_recursion (n : nat) : Type := - match n with - | 0 => Type - | S k => demo_recursion k -> Type - end) n, (demo_law (S n)) q -}. - -Theorem DemoError : Demonstration. -Fail apply mkDemo. (*Anomaly: Uncaught exception Not_found. Please report.*) diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v deleted file mode 100644 index 468bade1cc..0000000000 --- a/test-suite/bugs/closed/4375.v +++ /dev/null @@ -1,107 +0,0 @@ - - -Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - - -Module A. -Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => foo t n - end. -End A. - -Module B. -Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => foo t n - end. -End B. - -Module C. -Fail Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{j} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End C. - -Module D. -Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{i j} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End D. - -Module E. -Fail Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := - match n with - | 0 => t - | S n => bar t n - end - -with bar@{j i} (t : Type@{j}) (n : nat) : Type@{j} := - match n with - | 0 => t - | S n => foo t n - end. -End E. - -(* -Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - -Print g. - -Polymorphic Fixpoint a@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t -with b@{i} (t : Type@{i}) (n : nat) : Type@{i} := - t. - -Print a. -Print b. -*) - -Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} := -| A : foo T -> foo T. - -Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (cg t). - -Print cg. - -Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (cb t) -with cb@{i} (t : Type@{i}) : foo@{i} t := - @A@{i} t (ca t). - -Print ca. -Print cb. - diff --git a/test-suite/bugs/closed/4378.v b/test-suite/bugs/closed/4378.v deleted file mode 100644 index 9d59165562..0000000000 --- a/test-suite/bugs/closed/4378.v +++ /dev/null @@ -1,9 +0,0 @@ -Tactic Notation "epose" open_constr(a) := - let a' := fresh in - pose a as a'. -Tactic Notation "epose2" open_constr(a) tactic3(tac) := - let a' := fresh in - pose a as a'. -Goal True. - epose _. Undo. - epose2 _ idtac. diff --git a/test-suite/bugs/closed/4397.v b/test-suite/bugs/closed/4397.v deleted file mode 100644 index 3566353d84..0000000000 --- a/test-suite/bugs/closed/4397.v +++ /dev/null @@ -1,3 +0,0 @@ -Require Import Equality. -Theorem foo (u : unit) (H : u = u) : True. -dependent destruction H. diff --git a/test-suite/bugs/closed/4404.v b/test-suite/bugs/closed/4404.v deleted file mode 100644 index 27b43a61d4..0000000000 --- a/test-suite/bugs/closed/4404.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive Foo : Type -> Type := foo A : Foo A. -Goal True. - remember Foo. - diff --git a/test-suite/bugs/closed/4412.v b/test-suite/bugs/closed/4412.v deleted file mode 100644 index 4b2aae0c7b..0000000000 --- a/test-suite/bugs/closed/4412.v +++ /dev/null @@ -1,4 +0,0 @@ -Require Import Coq.Bool.Bool Coq.Setoids.Setoid. -Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True. - intros. - Fail rewrite Bool.andb_true_iff in H. diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v deleted file mode 100644 index 62b90b4286..0000000000 --- a/test-suite/bugs/closed/4416.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal exists x, x. -Unset Solve Unification Constraints. -unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. -(* Error: Incorrect number of goals (expected 2 tactics). *) diff --git a/test-suite/bugs/closed/4420.v b/test-suite/bugs/closed/4420.v deleted file mode 100644 index 0e16cb2399..0000000000 --- a/test-suite/bugs/closed/4420.v +++ /dev/null @@ -1,19 +0,0 @@ -Module foo. - Context (Char : Type). - Axiom foo : Type -> Type. - Goal foo Char = foo Char. - change foo with (fun x => foo x). - cbv beta. - reflexivity. - Defined. -End foo. - -Inductive foo (A : Type) : Prop := I. (*Top.1*) -Lemma bar : foo Type. (*Top.3*) -Proof. - Set Printing Universes. -change foo with (fun x : Type => foo x). (*Top.4*) -cbv beta. -apply I. (* I Type@{Top.3} : (fun x : Type@{Top.4} => foo x) Type@{Top.3} *) -Defined. - diff --git a/test-suite/bugs/closed/4453.v b/test-suite/bugs/closed/4453.v deleted file mode 100644 index 009dd5e3ca..0000000000 --- a/test-suite/bugs/closed/4453.v +++ /dev/null @@ -1,8 +0,0 @@ - -Section Foo. -Variable A : Type. -Lemma foo : A -> True. now intros _. Qed. -Goal Type -> True. -rename A into B. -intros A. -Fail apply foo. diff --git a/test-suite/bugs/closed/4456.v b/test-suite/bugs/closed/4456.v deleted file mode 100644 index 56a7b4f6e9..0000000000 --- a/test-suite/bugs/closed/4456.v +++ /dev/null @@ -1,647 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *) -(* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0 - coqtop version 8.5beta3 (November 2015) *) -(* Variable P : forall n m : nat, n = m -> Prop. *) -(* Axiom Prefl : forall n : nat, P n n eq_refl. *) -Axiom proof_admitted : False. - -Tactic Notation "admit" := case proof_admitted. - -Require Coq.Program.Program. -Require Coq.Strings.String. -Require Coq.omega.Omega. -Module Export Fiat_DOT_Common. -Module Export Fiat. -Module Common. -Import Coq.Lists.List. -Export Coq.Program.Program. - -Global Set Implicit Arguments. - -Global Coercion is_true : bool >-> Sortclass. -Coercion bool_of_sum {A B} (b : sum A B) : bool := if b then true else false. - -Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type - := match ls return Type with - | nil => True - | x::xs => (P x * ForallT P xs)%type - end. -Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type - := match ls with - | nil => P nil - | x::xs => (P (x::xs) * Forall_tails P xs)%type - end. - -End Common. - -End Fiat. - -End Fiat_DOT_Common. -Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. -Module Export Fiat. -Module Export Parsers. -Module Export StringLike. -Module Export Core. -Import Coq.Relations.Relation_Definitions. -Import Coq.Classes.Morphisms. - -Local Coercion is_true : bool >-> Sortclass. - -Module Export StringLike. - Class StringLike {Char : Type} := - { - String :> Type; - is_char : String -> Char -> bool; - length : String -> nat; - take : nat -> String -> String; - drop : nat -> String -> String; - get : nat -> String -> option Char; - unsafe_get : nat -> String -> Char; - bool_eq : String -> String -> bool; - beq : relation String := fun x y => bool_eq x y - }. - - Arguments StringLike : clear implicits. - Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. - Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. - Local Open Scope string_like_scope. - - Class StringLikeProperties (Char : Type) `{StringLike Char} := - { - singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; - singleton_exists : forall s, length s = 1 -> exists ch, s ~= [ ch ]; - get_0 : forall s ch, take 1 s ~= [ ch ] <-> get 0 s = Some ch; - get_S : forall n s, get (S n) s = get n (drop 1 s); - unsafe_get_correct : forall n s ch, get n s = Some ch -> unsafe_get n s = ch; - length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; - bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; - is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; - length_Proper :> Proper (beq ==> eq) length; - take_Proper :> Proper (eq ==> beq ==> beq) take; - drop_Proper :> Proper (eq ==> beq ==> beq) drop; - bool_eq_Equivalence :> Equivalence beq; - bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; - take_short_length : forall str n, n <= length str -> length (take n str) = n; - take_long : forall str n, length str <= n -> take n str =s str; - take_take : forall str n m, take n (take m str) =s take (min n m) str; - drop_length : forall str n, length (drop n str) = length str - n; - drop_0 : forall str, drop 0 str =s str; - drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; - drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); - take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str); - bool_eq_from_get : forall str str', (forall n, get n str = get n str') -> str =s str' - }. -Global Arguments StringLikeProperties _ {_}. -End StringLike. - -End Core. - -End StringLike. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. - -Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Core. -Import Coq.Strings.String. -Import Coq.Lists.List. -Export Fiat.Parsers.StringLike.Core. - -Section cfg. - Context {Char : Type}. - - Section definitions. - - Inductive item := - | Terminal (_ : Char) - | NonTerminal (_ : string). - - Definition production := list item. - Definition productions := list production. - - Record grammar := - { - Start_symbol :> string; - Lookup :> string -> productions; - Start_productions :> productions := Lookup Start_symbol; - Valid_nonterminals : list string; - Valid_productions : list productions := map Lookup Valid_nonterminals - }. - End definitions. - - End cfg. - -Arguments item _ : clear implicits. -Arguments production _ : clear implicits. -Arguments productions _ : clear implicits. -Arguments grammar _ : clear implicits. - -End Core. - -End ContextFreeGrammar. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. - -Module Export Fiat_DOT_Parsers_DOT_BaseTypes. -Module Export Fiat. -Module Export Parsers. -Module Export BaseTypes. -Import Coq.Arith.Wf_nat. - -Local Coercion is_true : bool >-> Sortclass. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Class parser_computational_predataT := - { nonterminals_listT : Type; - nonterminal_carrierT : Type; - of_nonterminal : String.string -> nonterminal_carrierT; - to_nonterminal : nonterminal_carrierT -> String.string; - initial_nonterminals_data : nonterminals_listT; - nonterminals_length : nonterminals_listT -> nat; - is_valid_nonterminal : nonterminals_listT -> nonterminal_carrierT -> bool; - remove_nonterminal : nonterminals_listT -> nonterminal_carrierT -> nonterminals_listT }. - - Class parser_removal_dataT' `{predata : parser_computational_predataT} := - { nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop - := ltof _ nonterminals_length; - nonterminals_length_zero : forall ls, - nonterminals_length ls = 0 - -> forall nt, is_valid_nonterminal ls nt = false; - remove_nonterminal_dec : forall ls nonterminal, - is_valid_nonterminal ls nonterminal - -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; - remove_nonterminal_noninc : forall ls nonterminal, - ~nonterminals_listT_R ls (remove_nonterminal ls nonterminal); - initial_nonterminals_correct : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) <-> List.In nonterminal (Valid_nonterminals G); - initial_nonterminals_correct' : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data nonterminal <-> List.In (to_nonterminal nonterminal) (Valid_nonterminals G); - to_of_nonterminal : forall nonterminal, - List.In nonterminal (Valid_nonterminals G) - -> to_nonterminal (of_nonterminal nonterminal) = nonterminal; - of_to_nonterminal : forall nonterminal, - is_valid_nonterminal initial_nonterminals_data nonterminal - -> of_nonterminal (to_nonterminal nonterminal) = nonterminal; - ntl_wf : well_founded nonterminals_listT_R - := well_founded_ltof _ _; - remove_nonterminal_1 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' - -> is_valid_nonterminal ls ps'; - remove_nonterminal_2 - : forall ls ps ps', - is_valid_nonterminal (remove_nonterminal ls ps) ps' = false - <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. - - Class split_dataT := - { split_string_for_production - : item Char -> production Char -> String -> list nat }. - - Class boolean_parser_dataT := - { predata :> parser_computational_predataT; - split_data :> split_dataT }. -End recursive_descent_parser. - -End BaseTypes. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_BaseTypes. - -Module Export Fiat_DOT_Common_DOT_List_DOT_Operations. -Module Export Fiat. -Module Export Common. -Module Export List. -Module Export Operations. - -Import Coq.Lists.List. - -Module Export List. - Section InT. - Context {A : Type} (a : A). - - Fixpoint InT (ls : list A) : Set - := match ls return Set with - | nil => False - | b :: m => (b = a) + InT m - end%type. - End InT. - - End List. - -End Operations. - -End List. - -End Common. - -End Fiat. - -End Fiat_DOT_Common_DOT_List_DOT_Operations. - -Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. -Module Export Fiat. -Module Export Parsers. -Module Export StringLike. -Module Export Properties. - -Section String. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char}. - - Lemma take_length {str n} - : length (take n str) = min n (length str). -admit. -Defined. - - End String. - -End Properties. - -End StringLike. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. - -Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Properties. - -Local Open Scope list_scope. -Definition production_is_reachableT {Char} (G : grammar Char) (p : production Char) - := { nt : _ - & { prefix : _ - & List.In nt (Valid_nonterminals G) - * List.InT - (prefix ++ p) - (Lookup G nt) } }%type. - -End Properties. - -End ContextFreeGrammar. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. - -Module Export Fiat_DOT_Parsers_DOT_MinimalParse. -Module Export Fiat. -Module Export Parsers. -Module Export MinimalParse. -Import Coq.Lists.List. -Import Fiat.Parsers.ContextFreeGrammar.Core. - -Local Coercion is_true : bool >-> Sortclass. -Local Open Scope string_like_scope. - -Section cfg. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - Context {predata : @parser_computational_predataT} - {rdata' : @parser_removal_dataT' _ G predata}. - - Inductive minimal_parse_of - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - productions Char -> Type := - | MinParseHead : forall len0 valid str pat pats, - @minimal_parse_of_production len0 valid str pat - -> @minimal_parse_of len0 valid str (pat::pats) - | MinParseTail : forall len0 valid str pat pats, - @minimal_parse_of len0 valid str pats - -> @minimal_parse_of len0 valid str (pat::pats) - with minimal_parse_of_production - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - production Char -> Type := - | MinParseProductionNil : forall len0 valid str, - length str = 0 - -> @minimal_parse_of_production len0 valid str nil - | MinParseProductionCons : forall len0 valid str n pat pats, - length str <= len0 - -> @minimal_parse_of_item len0 valid (take n str) pat - -> @minimal_parse_of_production len0 valid (drop n str) pats - -> @minimal_parse_of_production len0 valid str (pat::pats) - with minimal_parse_of_item - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - item Char -> Type := - | MinParseTerminal : forall len0 valid str ch, - str ~= [ ch ] - -> @minimal_parse_of_item len0 valid str (Terminal ch) - | MinParseNonTerminal - : forall len0 valid str (nt : String.string), - @minimal_parse_of_nonterminal len0 valid str nt - -> @minimal_parse_of_item len0 valid str (NonTerminal nt) - with minimal_parse_of_nonterminal - : forall (len0 : nat) (valid : nonterminals_listT) - (str : String), - String.string -> Type := - | MinParseNonTerminalStrLt - : forall len0 valid (nt : String.string) str, - length str < len0 - -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) - -> @minimal_parse_of (length str) initial_nonterminals_data str (Lookup G nt) - -> @minimal_parse_of_nonterminal len0 valid str nt - | MinParseNonTerminalStrEq - : forall len0 str valid nonterminal, - length str = len0 - -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) - -> is_valid_nonterminal valid (of_nonterminal nonterminal) - -> @minimal_parse_of len0 (remove_nonterminal valid (of_nonterminal nonterminal)) str (Lookup G nonterminal) - -> @minimal_parse_of_nonterminal len0 valid str nonterminal. - -End cfg. - -End MinimalParse. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_MinimalParse. - -Module Export Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. -Module Export Fiat. -Module Export Parsers. -Module Export CorrectnessBaseTypes. -Import Coq.Lists.List. -Import Fiat.Parsers.ContextFreeGrammar.Core. -Import Fiat_DOT_Common.Fiat.Common. -Section general. - Context {Char} {HSL : StringLike Char} {G : grammar Char}. - - Definition split_list_completeT_for {data : @parser_computational_predataT} - {len0 valid} - (it : item Char) (its : production Char) - (str : String) - (pf : length str <= len0) - (split_list : list nat) - - := ({ n : nat - & (minimal_parse_of_item (G := G) (predata := data) len0 valid (take n str) it) - * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type) - -> ({ n : nat - & (In (min (length str) n) (map (min (length str)) split_list)) - * (minimal_parse_of_item (G := G) len0 valid (take n str) it) - * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type). - - Definition split_list_completeT {data : @parser_computational_predataT} - (splits : item Char -> production Char -> String -> list nat) - := forall len0 valid str (pf : length str <= len0) nt, - is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) - -> ForallT - (Forall_tails - (fun prod - => match prod return Type with - | nil => True - | it::its - => @split_list_completeT_for data len0 valid it its str pf (splits it its str) - end)) - (Lookup G nt). - - Class boolean_parser_completeness_dataT' {data : boolean_parser_dataT} := - { split_string_for_production_complete - : split_list_completeT split_string_for_production }. -End general. - -End CorrectnessBaseTypes. - -End Parsers. - -End Fiat. - -End Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. - -Module Export Fiat. -Module Export Parsers. -Module Export ContextFreeGrammar. -Module Export Valid. -Export Fiat.Parsers.StringLike.Core. - -Section cfg. - Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) - {predata : parser_computational_predataT}. - - Definition item_valid (it : item Char) - := match it with - | Terminal _ => True - | NonTerminal nt' => is_true (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt')) - end. - - Definition production_valid pat - := List.Forall item_valid pat. - - Definition productions_valid pats - := List.Forall production_valid pats. - - Definition grammar_valid - := forall nt, - List.In nt (Valid_nonterminals G) - -> productions_valid (Lookup G nt). -End cfg. - -End Valid. - -Section app. - Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) - {predata : parser_computational_predataT}. - - Lemma hd_production_valid - (it : item Char) - (its : production Char) - (H : production_valid (it :: its)) - : item_valid it. -admit. -Defined. - - Lemma production_valid_cons - (it : item Char) - (its : production Char) - (H : production_valid (it :: its)) - : production_valid its. -admit. -Defined. - - End app. - -Import Coq.Lists.List. -Import Coq.omega.Omega. -Import Fiat_DOT_Common.Fiat.Common. -Import Fiat.Parsers.ContextFreeGrammar.Valid. -Local Open Scope string_like_scope. - -Section recursive_descent_parser. - Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). - Context {data : @boolean_parser_dataT Char _} - {cdata : @boolean_parser_completeness_dataT' Char _ G data} - {rdata : @parser_removal_dataT' _ G _} - {gvalid : grammar_valid G}. - - Local Notation dec T := (T + (T -> False))%type (only parsing). - - Local Notation iffT x y := ((x -> y) * (y -> x))%type (only parsing). - - Lemma dec_prod {A B} (HA : dec A) (HB : dec B) : dec (A * B). -admit. -Defined. - - Lemma dec_In {A} {P : A -> Type} (HA : forall a, dec (P a)) ls - : dec { a : _ & (In a ls * P a) }. -admit. -Defined. - - Section item. - Context {len0 valid} - (str : String) - (str_matches_nonterminal' - : nonterminal_carrierT -> bool) - (str_matches_nonterminal - : forall nt : nonterminal_carrierT, - dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). - - Section valid. - Context (Hmatches - : forall nt, - is_valid_nonterminal initial_nonterminals_data nt - -> str_matches_nonterminal nt = str_matches_nonterminal' nt :> bool) - (it : item Char) - (Hvalid : item_valid it). - - Definition parse_item' - : dec (minimal_parse_of_item (G := G) len0 valid str it). - Proof. - clear Hvalid. - refine (match it return dec (minimal_parse_of_item len0 valid str it) with - | Terminal ch => if Sumbool.sumbool_of_bool (str ~= [ ch ]) - then inl (MinParseTerminal _ _ _ _ _) - else inr (fun _ => !) - | NonTerminal nt => if str_matches_nonterminal (of_nonterminal nt) - then inl (MinParseNonTerminal _) - else inr (fun _ => !) - end); - clear str_matches_nonterminal Hmatches; - admit. - Defined. - End valid. - - End item. - Context {len0 valid} - (parse_nonterminal - : forall (str : String) (len : nat) (Hlen : length str = len) (pf : len <= len0) (nt : nonterminal_carrierT), - dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). - - Lemma dec_in_helper {ls it its str} - : iffT {n0 : nat & - (In (min (length str) n0) (map (min (length str)) ls) * - minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} - {n0 : nat & - (In n0 ls * - (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its))%type}. -admit. -Defined. - - Lemma parse_production'_helper {str it its} (pf : length str <= len0) - : dec {n0 : nat & - (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * - minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} - -> dec (minimal_parse_of_production (G := G) len0 valid str (it :: its)). -admit. -Defined. - Local Ltac t_parse_production_for := repeat - match goal with - | [ H : (beq_nat _ _) = true |- _ ] => apply EqNat.beq_nat_true in H - | _ => progress subst - | _ => solve [ constructor; assumption ] - | [ H : minimal_parse_of_production _ _ _ nil |- _ ] => (inversion H; clear H) - | [ H : minimal_parse_of_production _ _ _ (_::_) |- _ ] => (inversion H; clear H) - | [ H : ?x = 0, H' : context[?x] |- _ ] => rewrite H in H' - | _ => progress simpl in * - | _ => discriminate - | [ H : forall x, (_ * _)%type -> _ |- _ ] => specialize (fun x y z => H x (y, z)) - | _ => solve [ eauto with nocore ] - | _ => solve [ apply Min.min_case_strong; omega ] - | _ => omega - | [ H : production_valid (_::_) |- _ ] - => let H' := fresh in - pose proof H as H'; - apply production_valid_cons in H; - apply hd_production_valid in H' - end. - - Definition parse_production'_for - (splits : item Char -> production Char -> String -> list nat) - (Hsplits : forall str it its (Hreachable : production_is_reachableT G (it::its)) pf', split_list_completeT_for (len0 := len0) (G := G) (valid := valid) it its str pf' (splits it its str)) - (str : String) - (len : nat) - (Hlen : length str = len) - (pf : len <= len0) - (prod : production Char) - (Hreachable : production_is_reachableT G prod) - : dec (minimal_parse_of_production (G := G) len0 valid str prod). - Proof. - revert prod Hreachable str len Hlen pf. - refine - ((fun pf_helper => - list_rect - (fun prod => - forall (Hreachable : production_is_reachableT G prod) - (str : String) - (len : nat) - (Hlen : length str = len) - (pf : len <= len0), - dec (minimal_parse_of_production (G := G) len0 valid str prod)) - ( - fun Hreachable str len Hlen pf - => match Utils.dec (beq_nat len 0) with - | left H => inl _ - | right H => inr (fun p => _) - end) - (fun it its parse_production' Hreachable str len Hlen pf - => parse_production'_helper - _ - (let parse_item := (fun n pf => parse_item' (parse_nonterminal (take n str) (len := min n len) (eq_trans take_length (f_equal (min _) Hlen)) pf) it) in - let parse_item := (fun n => parse_item n (Min.min_case_strong n len (fun k => k <= len0) (fun Hlen => (Nat.le_trans _ _ _ Hlen pf)) (fun Hlen => pf))) in - let parse_production := (fun n => parse_production' (pf_helper it its Hreachable) (drop n str) (len - n) (eq_trans (drop_length _ _) (f_equal (fun x => x - _) Hlen)) (Nat.le_trans _ _ _ (Nat.le_sub_l _ _) pf)) in - match dec_In - (fun n => dec_prod (parse_item n) (parse_production n)) - (splits it its str) - with - | inl p => inl (existT _ (projT1 p) (snd (projT2 p))) - | inr p - => let pf' := (Nat.le_trans _ _ _ (Nat.eq_le_incl _ _ Hlen) pf) in - let H := (_ : split_list_completeT_for (G := G) (len0 := len0) (valid := valid) it its str pf' (splits it its str)) in - inr (fun p' => p (fst dec_in_helper (H p'))) - end) - )) _); - [ clear parse_nonterminal Hsplits splits rdata cdata - | clear parse_nonterminal Hsplits splits rdata cdata - | .. - | admit ]. - abstract t_parse_production_for. - abstract t_parse_production_for. - abstract t_parse_production_for. - abstract t_parse_production_for. - Defined. diff --git a/test-suite/bugs/closed/4462.v b/test-suite/bugs/closed/4462.v deleted file mode 100644 index c680518c6a..0000000000 --- a/test-suite/bugs/closed/4462.v +++ /dev/null @@ -1,7 +0,0 @@ -Variables P Q : Prop. -Axiom pqrw : P <-> Q. - -Require Setoid. - -Goal P -> Q. -unshelve (rewrite pqrw). diff --git a/test-suite/bugs/closed/4464.v b/test-suite/bugs/closed/4464.v deleted file mode 100644 index f8e9405d93..0000000000 --- a/test-suite/bugs/closed/4464.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True -> True. -Proof. - intro H'. - let H := H' in destruct H; try destruct H. diff --git a/test-suite/bugs/closed/4471.v b/test-suite/bugs/closed/4471.v deleted file mode 100644 index 36efc42d47..0000000000 --- a/test-suite/bugs/closed/4471.v +++ /dev/null @@ -1,6 +0,0 @@ -Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : forall (x : A) (x' : B), P (@pair A B x x')), - @eq (P (@pair A B a b)) (p (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))) - (p0 (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))). -Proof. - intros. - Fail generalize dependent (a, b). diff --git a/test-suite/bugs/closed/4479.v b/test-suite/bugs/closed/4479.v deleted file mode 100644 index 921579d1e1..0000000000 --- a/test-suite/bugs/closed/4479.v +++ /dev/null @@ -1,3 +0,0 @@ -Goal True. -Fail autorewrite with foo. -try autorewrite with foo. diff --git a/test-suite/bugs/closed/4480.v b/test-suite/bugs/closed/4480.v deleted file mode 100644 index 98c05ee1a8..0000000000 --- a/test-suite/bugs/closed/4480.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Definition proj (P Q : Prop) := P. - -Lemma foo (P : Prop) : proj P P = P. -Admitted. -Lemma trueI : True <-> True. -Admitted. -Goal True. - Fail setoid_rewrite foo. - Fail setoid_rewrite trueI. - diff --git a/test-suite/bugs/closed/4484.v b/test-suite/bugs/closed/4484.v deleted file mode 100644 index f988539d62..0000000000 --- a/test-suite/bugs/closed/4484.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Testing 8.5 regression with type classes not solving evars - redefined while trying to solve them with the type class mechanism *) - -Class A := {}. -Axiom foo : forall {ac : A}, bool. -Lemma bar (ac : A) : True. -Check (match foo as k return foo = k -> True with - | true => _ - | false => _ - end eq_refl). diff --git a/test-suite/bugs/closed/4511.v b/test-suite/bugs/closed/4511.v deleted file mode 100644 index 0cdb3aee4f..0000000000 --- a/test-suite/bugs/closed/4511.v +++ /dev/null @@ -1,3 +0,0 @@ -Goal True. -Fail evar I. - diff --git a/test-suite/bugs/closed/4519.v b/test-suite/bugs/closed/4519.v deleted file mode 100644 index 945183fae7..0000000000 --- a/test-suite/bugs/closed/4519.v +++ /dev/null @@ -1,21 +0,0 @@ -Set Universe Polymorphism. -Section foo. - Universe i. - Context (foo : Type@{i}) (bar : Type@{i}). - Definition qux@{i} (baz : Type@{i}) := foo -> bar. -End foo. -Set Printing Universes. -Print qux. (* qux@{Top.42 Top.43} = -fun foo bar _ : Type@{Top.42} => foo -> bar - : Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -(* Top.42 Top.43 |= *) -(* This is wrong; the first two types are equal, but the last one is not *) - -qux is universe polymorphic -Argument scopes are [type_scope type_scope type_scope] - *) -Check qux nat nat nat : Set. -Check qux nat nat Set : Set. (* Error: -The term "qux@{Top.50 Top.51} ?T ?T0 Set" has type "Type@{Top.50}" while it is -expected to have type "Set" -(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *) diff --git a/test-suite/bugs/closed/4527.v b/test-suite/bugs/closed/4527.v deleted file mode 100644 index f8cedfff6e..0000000000 --- a/test-suite/bugs/closed/4527.v +++ /dev/null @@ -1,270 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1199 lines to -430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, -then from 269 lines to 255 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml -4.01.0 - coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". -Inductive False := . -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Init.Datatypes. - -Import Coq.Init.Notations. - -Global Set Universe Polymorphism. - -Notation "A -> B" := (forall (_ : A), B) : type_scope. - -Inductive True : Type := - I : True. -Module Export Datatypes. - -Set Implicit Arguments. -Notation nat := Coq.Init.Datatypes.nat. -Notation O := Coq.Init.Datatypes.O. -Notation S := Coq.Init.Datatypes.S. -Notation two := (S (S O)). - -Record prod (A B : Type) := pair { fst : A ; snd : B }. - -Notation "x * y" := (prod x y) : type_scope. - -Open Scope nat_scope. - -End Datatypes. -Module Export Specif. - -Set Implicit Arguments. - -Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P -proj1_sig }. - -Notation sigT := sig (only parsing). - -Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - -Notation projT1 := proj1_sig (only parsing). -Notation projT2 := proj2_sig (only parsing). - -End Specif. -Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. - -Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in -Type@{i}. - -Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in - let ge := ((fun x => x) : Type1@{j} -> -Type@{i}) in Type@{i}. - -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. - -Notation pr1 := projT1. -Notation pr2 := projT2. - -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. - -Notation compose := (fun g f x => g (f x)). - -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left -associativity) : function_scope. - -Inductive paths {A : Type} (a : A) : A -> Type := - idpath : paths a a. - -Arguments idpath {A a} , [A] a. - -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. - -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. - -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. - -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. - -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. - -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. - -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. - -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. - -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr (f x) = ap f (eissect x) -}. - -Arguments eisretr {A B}%type_scope f%function_scope {_} _. -Arguments eissect {A B}%type_scope f%function_scope {_} _. - -Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : -function_scope. - -Inductive Unit : Type1 := - tt : Unit. - -Local Open Scope path_scope. - -Section EquivInverse. - - Context {A B : Type} (f : A -> B) {feq : IsEquiv f}. - - Theorem other_adj (b : B) : eissect f (f^-1 b) = ap f^-1 (eisretr f b). -admit. -Defined. - - Global Instance isequiv_inverse : IsEquiv f^-1 | 10000 - := BuildIsEquiv B A f^-1 f (eissect f) (eisretr f) other_adj. -End EquivInverse. - -Section Adjointify. - - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). -admit. -Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. - -End Adjointify. - - Definition ExtensionAlong {A B : Type} (f : A -> B) - (P : B -> Type) (d : forall x:A, P (f x)) - := { s : forall y:B, P y & forall x:A, s (f x) = d x }. - - Fixpoint ExtendableAlong@{i j k l} - (n : nat) {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := match n with - | O => Unit@{l} - | S n => (forall (g : forall a, C (f a)), - ExtensionAlong@{i j k l l} f C g) * - forall (h k : forall b, C b), - ExtendableAlong n f (fun b => h b = k b) - end. - - Definition ooExtendableAlong@{i j k l} - {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := forall n, ExtendableAlong@{i j k l} n f C. - -Module Type ReflectiveSubuniverses. - - Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter inO_equiv_inO@{u a i j k} : - forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) - (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), - - let gei := ((fun x => x) : Type@{i} -> Type@{k}) in - let gej := ((fun x => x) : Type@{j} -> Type@{k}) in - In@{u a j} O U. - - Parameter extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : -Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). - -End ReflectiveSubuniverses. - -Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). -Export Os. - -Existing Class In. - - Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. - -Arguments inO_equiv_inO {O} T {U} {_} f {_}. -Global Existing Instance O_inO. - -Section ORecursion. - Context {O : ReflectiveSubuniverse}. - - Definition O_indpaths {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o to O P == h o to O P) - : g == h - := (fst (snd (extendable_to_O O two) g h) p).1. - - Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) - : O_indpaths g h p (to O P x) = p x - := (fst (snd (extendable_to_O O two) g h) p).2 x. - -End ORecursion. - -Section Reflective_Subuniverse. - Universes Ou Oa. - Context (O : ReflectiveSubuniverse@{Ou Oa}). - - Definition inO_isequiv_to_O (T:Type) - : IsEquiv (to O T) -> In O T - := fun _ => inO_equiv_inO (O T) (to O T)^-1. - - Definition inO_to_O_retract (T:Type) (mu : O T -> T) - : Sect (to O T) mu -> In O T. - Proof. - unfold Sect; intros H. - apply inO_isequiv_to_O. - apply isequiv_adjointify with (g:=mu). - - - refine (O_indpaths (to O T o mu) idmap _). - intros x; exact (ap (to O T) (H x)). - - - exact H. - Defined. - - Definition inO_paths@{i} (S : Type@{i}) {S_inO : In@{Ou Oa i} O S} (x y : -S) : In@{Ou Oa i} O (x=y). - Proof. - simple refine (inO_to_O_retract@{i} _ _ _); intro u. - - - assert (p : (fun _ : O (x=y) => x) == (fun _=> y)). - { - refine (O_indpaths _ _ _); simpl. - intro v; exact v. -} - exact (p u). - - - hnf. - rewrite O_indpaths_beta; reflexivity. - Qed. - Check inO_paths@{Type}. diff --git a/test-suite/bugs/closed/4529.v b/test-suite/bugs/closed/4529.v deleted file mode 100644 index 8b3c24fec6..0000000000 --- a/test-suite/bugs/closed/4529.v +++ /dev/null @@ -1,45 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 1334 lines to 1518 lines, then from 849 lines to 59 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 22 2016 18:20:47 with OCaml 4.02.3 - coqtop version r-schnelltop:/home/r/src/coq/coq,(HEAD detached at V8.5) (5e23fb90b39dfa014ae5c4fb46eb713cca09dbff) *) -Require Coq.Setoids.Setoid. -Import Coq.Setoids.Setoid. - -Class Equiv A := equiv: relation A. -Infix "≡" := equiv (at level 70, no associativity). -Notation "(≡)" := equiv (only parsing). - -(* If I remove this line, everything compiles. *) -Set Primitive Projections. - -Class Dist A := dist : nat -> relation A. -Notation "x ={ n }= y" := (dist n x y) - (at level 70, n at next level, format "x ={ n }= y"). - -Record CofeMixin A `{Equiv A, Dist A} := { - mixin_equiv_dist x y : x ≡ y <-> forall n, x ={n}= y; - mixin_dist_equivalence n : Equivalence (dist n); -}. - -Structure cofeT := CofeT { - cofe_car :> Type; - cofe_equiv : Equiv cofe_car; - cofe_dist : Dist cofe_car; - cofe_mixin : CofeMixin cofe_car -}. -Existing Instances cofe_equiv cofe_dist. -Arguments cofe_car : simpl never. - -Section cofe_mixin. - Context {A : cofeT}. - Implicit Types x y : A. - Lemma equiv_dist x y : x ≡ y <-> forall n, x ={n}= y. -Admitted. -End cofe_mixin. - Context {A : cofeT}. - Global Instance cofe_equivalence : Equivalence ((≡) : relation A). - Proof. - split. - * - intros x. -apply equiv_dist. - diff --git a/test-suite/bugs/closed/4533.v b/test-suite/bugs/closed/4533.v deleted file mode 100644 index fd2380a070..0000000000 --- a/test-suite/bugs/closed/4533.v +++ /dev/null @@ -1,230 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1125 lines to -346 lines, then from 360 lines to 346 lines, then from 822 lines to 271 lines, -then from 285 lines to 271 lines *) -(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml -4.01.0 - coqtop version 8.5 (January 2016) *) -Declare ML Module "ltac_plugin". -Inductive False := . -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Init.Datatypes. -Import Coq.Init.Notations. -Global Set Universe Polymorphism. -Global Set Primitive Projections. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Module Export Datatypes. - Set Implicit Arguments. - Notation nat := Coq.Init.Datatypes.nat. - Notation O := Coq.Init.Datatypes.O. - Notation S := Coq.Init.Datatypes.S. - Notation one := (S O). - Notation two := (S one). - Record prod (A B : Type) := pair { fst : A ; snd : B }. - Notation "x * y" := (prod x y) : type_scope. - Delimit Scope nat_scope with nat. - Open Scope nat_scope. -End Datatypes. -Module Export Specif. - Set Implicit Arguments. - Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P -proj1_sig }. - Notation sigT := sig (only parsing). - Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. - Notation projT1 := proj1_sig (only parsing). - Notation projT2 := proj2_sig (only parsing). -End Specif. -Global Set Keyed Unification. -Global Unset Strict Universe Declaration. -Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. -Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in -Type@{i}. -Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in - let ge := ((fun x => x) : Type1@{j} -> -Type@{i}) in Type@{i}. -Notation idmap := (fun x => x). -Delimit Scope function_scope with function. -Delimit Scope path_scope with path. -Delimit Scope fibration_scope with fibration. -Open Scope fibration_scope. -Open Scope function_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. -Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. -Notation compose := (fun g f x => g (f x)). -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left -associativity) : function_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. -Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) - := forall x:A, f x = g x. -Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : -type_scope. -Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := - forall x : A, r (s x) = x. -Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { - equiv_inv : B -> A ; - eisretr : Sect equiv_inv f; - eissect : Sect f equiv_inv; - eisadj : forall x : A, eisretr -(f x) = ap f (eissect x) - }. -Arguments eissect {A B}%type_scope f%function_scope {_} _. -Inductive Unit : Type1 := tt : Unit. -Local Open Scope path_scope. -Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z -= t) : - p @ (q @ r) = (p @ q) @ r := - match r with idpath => - match q with idpath => - match p with idpath => 1 - end end end. -Section Adjointify. - Context {A B : Type} (f : A -> B) (g : B -> A). - Context (isretr : Sect g f) (issect : Sect f g). - Let issect' := fun x => - ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. - - Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). - admit. - Defined. - - Definition isequiv_adjointify : IsEquiv f - := BuildIsEquiv A B f g isretr issect' is_adjoint'. -End Adjointify. -Definition ExtensionAlong {A B : Type} (f : A -> B) - (P : B -> Type) (d : forall x:A, P (f x)) - := { s : forall y:B, P y & forall x:A, s (f x) = d x }. -Fixpoint ExtendableAlong@{i j k l} - (n : nat) {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := match n with - | O => Unit@{l} - | S n => (forall (g : forall a, C (f a)), - ExtensionAlong@{i j k l l} f C g) * - forall (h k : forall b, C b), - ExtendableAlong n f (fun b => h b = k b) - end. - -Definition ooExtendableAlong@{i j k l} - {A : Type@{i}} {B : Type@{j}} - (f : A -> B) (C : B -> Type@{k}) : Type@{l} - := forall n, ExtendableAlong@{i j k l} n f C. - -Module Type ReflectiveSubuniverses. - - Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. - - Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), - Type2le@{i a} -> Type2le@{i a}. - - Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - In@{u a i} O (O_reflector@{u a i} O T). - - Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : -Type@{i}), - T -> O_reflector@{u a i} O T. - - Parameter extendable_to_O@{u a i j k} - : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : -Type2le@{j a}} {Q_inO : In@{u a j} O Q}, - ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). - -End ReflectiveSubuniverses. - -Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). - Export Os. - Existing Class In. - Module Export Coercions. - Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. - End Coercions. - Global Existing Instance O_inO. - - Section ORecursion. - Context {O : ReflectiveSubuniverse}. - - Definition O_rec {P Q : Type} {Q_inO : In O Q} - (f : P -> Q) - : O P -> Q - := (fst (extendable_to_O O one) f).1. - - Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} - (f : P -> Q) (x : P) - : O_rec f (to O P x) = f x - := (fst (extendable_to_O O one) f).2 x. - - Definition O_indpaths {P Q : Type} {Q_inO : In O Q} - (g h : O P -> Q) (p : g o to O P == h o to O P) - : g == h - := (fst (snd (extendable_to_O O two) g h) p).1. - - End ORecursion. - - - Section Reflective_Subuniverse. - Context (O : ReflectiveSubuniverse@{Ou Oa}). - - Definition isequiv_to_O_inO@{u a i} (T : Type@{i}) `{In@{u a i} O T} : -IsEquiv@{i i} (to O T). - Proof. - - pose (g := O_rec@{u a i i i i i} idmap). - refine (isequiv_adjointify (to O T) g _ _). - - - refine (O_indpaths@{u a i i i i i} (to O T o g) idmap _). - intros x. - apply ap. - apply O_rec_beta. - - - intros x. - apply O_rec_beta. - Defined. - Global Existing Instance isequiv_to_O_inO. - - End Reflective_Subuniverse. - -End ReflectiveSubuniverses_Theory. - -Module Type Preserves_Fibers (Os : ReflectiveSubuniverses). - Module Export Os_Theory := ReflectiveSubuniverses_Theory Os. -End Preserves_Fibers. - -Opaque eissect. -Module Lex_Reflective_Subuniverses - (Os : ReflectiveSubuniverses) (Opf : Preserves_Fibers Os). - Import Opf. - Goal forall (O : ReflectiveSubuniverse) (A : Type) (B : A -> Type) (A_inO : -In O A), - - forall g, - forall (x : O {x : A & B x}) v v' v'' (p2 : v'' = v') (p0 : v' = v) (p1 : -v = _) r, - (p2 - @ (p0 - @ p1)) - @ eissect (to O A) (g x) = r. - intros. - cbv zeta. - rewrite concat_p_pp. - match goal with - | [ |- p2 @ p0 @ p1 @ eissect (to O A) (g x) = r ] => idtac "good" - | [ |- ?G ] => fail 1 "bad" G - end. - Fail rewrite concat_p_pp. diff --git a/test-suite/bugs/closed/4574.v b/test-suite/bugs/closed/4574.v deleted file mode 100644 index 39ba190369..0000000000 --- a/test-suite/bugs/closed/4574.v +++ /dev/null @@ -1,8 +0,0 @@ -Require Import Setoid. - -Definition block A (a : A) := a. - -Goal forall A (a : A), block Type nat. -Proof. -Fail reflexivity. - diff --git a/test-suite/bugs/closed/4580.v b/test-suite/bugs/closed/4580.v deleted file mode 100644 index 4ffd5f0f4b..0000000000 --- a/test-suite/bugs/closed/4580.v +++ /dev/null @@ -1,6 +0,0 @@ -Require Import Program. - -Class Foo (A : Type) := foo : A. - -Unset Refine Instance Mode. -Program Instance f1 : Foo nat := S _. diff --git a/test-suite/bugs/closed/4596.v b/test-suite/bugs/closed/4596.v deleted file mode 100644 index 592fdb6580..0000000000 --- a/test-suite/bugs/closed/4596.v +++ /dev/null @@ -1,14 +0,0 @@ -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. - -Definition T (x : bool) := x = true. - -Goal forall (S : Type) (b b0 : S -> nat -> bool) (str : S) (p : nat) - (s : forall n : nat, bool) - (s0 s1 : nat -> S -> S), - (forall (str0 : S) (n m : nat), - (if s m then T (b0 (s1 n str0) 0) else T (b (s1 n str0) 0)) -> T (b (s0 n str0) m) -> - T (b str0 m)) -> - T (b str p). -Proof. -intros ???????? H0. -rewrite H0. diff --git a/test-suite/bugs/closed/4603.v b/test-suite/bugs/closed/4603.v deleted file mode 100644 index 2c90044dc7..0000000000 --- a/test-suite/bugs/closed/4603.v +++ /dev/null @@ -1,10 +0,0 @@ -Axiom A : Type. - -Goal True. exact I. -Check (fun P => P A). -Abort. - -Goal True. -Definition foo (A : Type) : Prop:= True. - set (x:=foo). split. -Qed. diff --git a/test-suite/bugs/closed/4644.v b/test-suite/bugs/closed/4644.v deleted file mode 100644 index f09b27c2b1..0000000000 --- a/test-suite/bugs/closed/4644.v +++ /dev/null @@ -1,52 +0,0 @@ -(* Testing a regression of unification in 8.5 in problems of the form - "match ?y with ... end = ?x args" *) - -Lemma foo : exists b, forall a, match a with tt => tt end = b a. -Proof. -eexists. intro. -refine (_ : _ = match _ with tt => _ end). -refine eq_refl. -Qed. - -(**********************************************************************) - -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Export Coq.Classes.Morphisms. -Require Import Coq.Lists.List. - -Global Set Implicit Arguments. - -Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) - ls - : P ls - := match ls with - | nil => N - | x::xs => C x xs - end. - -Axiom list_caset_Proper' - : forall {A P}, - Proper (eq - ==> pointwise_relation _ (pointwise_relation _ eq) - ==> eq - ==> eq) - (@list_caset A (fun _ => P)). -Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool), - match a3 with - | nil => 0 - | (_ :: _)%list => 1 - end = y2 a4. - clear; eexists; intros. - reflexivity. Undo. - Local Ltac t := - lazymatch goal with - | [ |- match ?v with nil => ?N | cons x xs => @?C x xs end = _ :> ?P ] - => let T := type of v in - let A := match (eval hnf in T) with list ?A => A end in - refine (@list_caset_Proper' A P _ _ _ _ _ _ _ _ _ - : @list_caset A (fun _ => P) N C v = match _ with nil => _ | cons x xs => _ end) - end. - (etransitivity; [ t | reflexivity ]) || fail 0 "too early". - Undo. - t. diff --git a/test-suite/bugs/closed/4661.v b/test-suite/bugs/closed/4661.v deleted file mode 100644 index 03d2350a69..0000000000 --- a/test-suite/bugs/closed/4661.v +++ /dev/null @@ -1,10 +0,0 @@ -Module Type Test. - Parameter t : Type. -End Test. - -Module Type Func (T:Test). - Parameter x : Type. -End Func. - -Module Shortest_path (T : Test). -Print Func. diff --git a/test-suite/bugs/closed/4673.v b/test-suite/bugs/closed/4673.v deleted file mode 100644 index 10e48db6dd..0000000000 --- a/test-suite/bugs/closed/4673.v +++ /dev/null @@ -1,57 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *) -(* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3 - coqtop version 8.5 (February 2016) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := case proof_admitted. -Require Coq.Lists.List. -Import Coq.Lists.List. -Import Coq.Classes.Morphisms. - -Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) - ls - : P ls - := match ls with - | nil => N - | x::xs => C x xs - end. - -Global Instance list_caset_Proper' {A P} - : Proper (eq - ==> pointwise_relation _ (pointwise_relation _ eq) - ==> eq - ==> eq) - (@list_caset A (fun _ => P)). -admit. -Defined. - -Global Instance list_caset_Proper'' {A P} - : (Proper (eq ==> pointwise_relation _ (pointwise_relation _ eq) ==> forall_relation (fun _ => eq)) - (list_caset A (fun _ => P))). -Admitted. - -Goal forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l0 : forall _ : forall _ : Char, bool, list bool) - - (T : Type) (T0 : forall _ : T, Type) (t : T), - - let predata := t in - - forall (splitdata : T0 predata) (l5 : forall _ : T0 t, list nat) (T1 : Type) (b : forall (_ : T1) (_ : Char), bool) - - (T2 : Type) (a11 : T2) (xs : list T2) (T3 : Type) (i0 : T3) (P0 : Set) (b1 : forall (_ : nat) (_ : P0), bool) - - (l2 : forall (_ : forall _ : T1, list bool) (_ : forall _ : P0, list bool) (_ : T2), list bool) - - (l1 : forall (_ : forall _ : forall _ : Char, bool, list bool) (_ : forall _ : P0, list bool) (_ : T3), list bool) - - (_ : forall NT : forall _ : P0, list bool, @eq (list bool) (l1 l0 NT i0) (l2 (fun f : T1 => l0 (b f)) NT a11)), - - P - (@list_caset T2 (fun _ : list T2 => list bool) l - (fun (_ : T2) (_ : list T2) => l1 l0 (fun a9 : P0 => @map nat bool (fun x0 : nat => b1 x0 a9) (l5 splitdata)) i0 -) xs). - intros. - subst predata; - let H := match goal with H : forall _, _ = _ |- _ => H end in - setoid_rewrite H || fail 0 "too early". - Undo. - setoid_rewrite H. diff --git a/test-suite/bugs/closed/4695.v b/test-suite/bugs/closed/4695.v deleted file mode 100644 index a42271811d..0000000000 --- a/test-suite/bugs/closed/4695.v +++ /dev/null @@ -1,38 +0,0 @@ -(* -The Qed at the end of this file was slow in 8.5 and 8.5pl1 because the kernel -term comparison after evaluation was done on constants according to their user -names. The conversion still succeeded because delta applied, but was much -slower than with a canonical names comparison. -*) - -Module Mod0. - - Fixpoint rec_ t d : nat := - match d with - | O => O - | S d' => - match t with - | true => rec_ t d' - | false => rec_ t d' - end - end. - - Definition depth := 1000. - - Definition rec t := rec_ t depth. - -End Mod0. - - -Module Mod1. - Module M := Mod0. -End Mod1. - - -Axiom rec_prop : forall t d n, Mod1.M.rec_ t d = n. - -Lemma slow_qed : forall t n, - Mod0.rec t = n. -Proof. - intros; unfold Mod0.rec; apply rec_prop. -Timeout 2 Qed. diff --git a/test-suite/bugs/closed/4725.v b/test-suite/bugs/closed/4725.v deleted file mode 100644 index fd5e0fb60d..0000000000 --- a/test-suite/bugs/closed/4725.v +++ /dev/null @@ -1,38 +0,0 @@ -Require Import EquivDec Equivalence List Program. -Require Import Relation_Definitions. -Import ListNotations. -Generalizable All Variables. - -Fixpoint removeV `{eqDecV : @EqDec V eqV equivV}`(x : V) (l : list V) : list V -:= - match l with - | nil => nil - | y::tl => if (equiv_dec x y) then removeV x tl else y::(removeV x tl) - end. - -Lemma remove_le {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : -@EqDec V eqV equivV} (xs : list V) (x : V) : - length (removeV x xs) < length (x :: xs). - Proof. Admitted. - -(* Function version *) -Set Printing Universes. - -Require Import Recdef. - -Function nubV {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : -@EqDec V eqV equivV} (l : list V) { measure length l} := - match l with - | nil => nil - | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) - end. -Proof. intros. apply remove_le. Qed. - -(* Program version *) - -Program Fixpoint nubV `{eqDecV : @EqDec V eqV equivV} (l : list V) - { measure (@length V l) lt } := - match l with - | nil => nil - | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) _ - end. diff --git a/test-suite/bugs/closed/4726.v b/test-suite/bugs/closed/4726.v deleted file mode 100644 index 0037b6fdea..0000000000 --- a/test-suite/bugs/closed/4726.v +++ /dev/null @@ -1,19 +0,0 @@ -Set Universe Polymorphism. - -Definition le@{i j} : Type@{j} := - (fun A : Type@{j} => A) - (unit : Type@{i}). -Definition eq@{i j} : Type@{j} := let x := le@{i j} in le@{j i}. - -Record Inj@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := - { inj : A }. - -Monomorphic Universe u1. -Let ty1 : Type@{u1} := Set. -Check Inj@{Set u1}. -(* Would fail with univ inconsistency if the universe was minimized *) - -Record Inj'@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := - { inj' : A; foo : Type@{j} := eq@{i j} }. -Fail Check Inj'@{Set u1}. (* Do not drop constraint i = j *) -Check Inj'@{Set Set}. diff --git a/test-suite/bugs/closed/4762.v b/test-suite/bugs/closed/4762.v deleted file mode 100644 index 7a87b07a8e..0000000000 --- a/test-suite/bugs/closed/4762.v +++ /dev/null @@ -1,24 +0,0 @@ -Inductive myand (P Q : Prop) := myconj : P -> Q -> myand P Q. - -Lemma foo P Q R : R = myand P Q -> P -> Q -> R. -Proof. intros ->; constructor; auto. Qed. - -Hint Extern 0 (myand _ _) => eapply foo; [reflexivity| |] : test1. - -Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). -Proof. - intros. - eauto with test1. -Qed. - -Hint Extern 0 => - match goal with - | |- myand _ _ => eapply foo; [reflexivity| |] - end : test2. - -Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). -Proof. - intros. - eauto with test2. (* works *) -Qed. - diff --git a/test-suite/bugs/closed/4769.v b/test-suite/bugs/closed/4769.v deleted file mode 100644 index f0c91f7b49..0000000000 --- a/test-suite/bugs/closed/4769.v +++ /dev/null @@ -1,94 +0,0 @@ - -(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *) -(* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3 - coqtop version trunk (June 2016) *) - -Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). -Reserved Notation "x * y" (at level 40, left associativity). -Delimit Scope type_scope with type. -Open Scope type_scope. -Global Set Universe Polymorphism. -Notation "A -> B" := (forall (_ : A), B) : type_scope. -Set Implicit Arguments. -Global Set Nonrecursive Elimination Schemes. -Record prod (A B : Type) := pair { fst : A ; snd : B }. -Notation "x * y" := (prod x y) : type_scope. -Axiom admit : forall {T}, T. -Delimit Scope function_scope with function. -Notation compose := (fun g f x => g (f x)). -Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. -Record PreCategory := - Build_PreCategory { - object :> Type; - morphism : object -> object -> Type; - identity : forall x, morphism x x }. -Bind Scope category_scope with PreCategory. -Record Functor (C D : PreCategory) := { object_of :> C -> D }. -Bind Scope functor_scope with Functor. -Class Isomorphic {C : PreCategory} (s d : C) := {}. -Definition oppositeC (C : PreCategory) : PreCategory - := @Build_PreCategory C (fun s d => morphism C d s) admit. -Notation "C ^op" := (oppositeC C) (at level 3, format "C '^op'") : category_scope. -Definition oppositeF C D (F : Functor C D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) (object_of F). -Definition set_cat : PreCategory := @Build_PreCategory Type (fun x y => x -> y) admit. -Definition prodC (C D : PreCategory) : PreCategory - := @Build_PreCategory - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - admit. -Infix "*" := prodC : category_scope. -Section composition. - Variables B C D E : PreCategory. - Definition composeF (G : Functor D E) (F : Functor C D) : Functor C E := Build_Functor C E (fun c => G (F c)). -End composition. -Infix "o" := composeF : functor_scope. -Definition fstF {C D} : Functor (C * D) C := admit. -Definition sndF {C D} : Functor (C * D) D := admit. -Definition prodF C D D' (F : Functor C D) (F' : Functor C D') : Functor C (D * D') := admit. -Local Infix "*" := prodF : functor_scope. -Definition pairF C D C' D' (F : Functor C D) (F' : Functor C' D') : Functor (C * C') (D * D') - := (F o fstF) * (F' o sndF). -Section hom_functor. - Variable C : PreCategory. - Local Notation obj_of c'c := - ((morphism - C - (fst (c'c : object (C^op * C))) - (snd (c'c : object (C^op * C))))). - Definition hom_functor : Functor (C^op * C) set_cat - := Build_Functor (C^op * C) set_cat (fun c'c => obj_of c'c). -End hom_functor. -Definition identityF C : Functor C C := admit. -Definition functor_category (C D : PreCategory) : PreCategory - := @Build_PreCategory (Functor C D) admit admit. -Local Notation "C -> D" := (functor_category C D) : category_scope. -Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. - -Section Adjunction. - Variables C D : PreCategory. - Variable F : Functor C D. - Variable G : Functor D C. - - Record AdjunctionHom := - { - mate_of : @NaturalIsomorphism - (prodC (oppositeC C) D) - (@set_cat) - (@composeF - (prodC (oppositeC C) D) - (prodC (oppositeC D) D) - (@set_cat) (@hom_functor D) - (@pairF (oppositeC C) - (oppositeC D) D D - (@oppositeF C D F) (identityF D))) - (@composeF - (prodC (oppositeC C) D) - (prodC (oppositeC C) C) - (@set_cat) (@hom_functor C) - (@pairF (oppositeC C) - (oppositeC C) D C - (identityF (oppositeC C)) G)) - }. -End Adjunction. diff --git a/test-suite/bugs/closed/4780.v b/test-suite/bugs/closed/4780.v deleted file mode 100644 index 71a51c6312..0000000000 --- a/test-suite/bugs/closed/4780.v +++ /dev/null @@ -1,106 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Top" "-top" "bug_bad_induction_01") -*- *) -(* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *) -(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 - coqtop version 8.5pl1 (April 2016) *) -Axiom proof_admitted : False. -Tactic Notation "admit" := abstract case proof_admitted. -Global Set Universe Polymorphism. -Global Set Asymmetric Patterns. -Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..)) - (at level 200, x binder, right associativity, - format "'[' 'exists' '/ ' x .. y , '/ ' p ']'") - : type_scope. -Definition relation (A : Type) := A -> A -> Type. -Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. -Tactic Notation "etransitivity" open_constr(y) := - let R := match goal with |- ?R ?x ?z => constr:(R) end in - let x := match goal with |- ?R ?x ?z => constr:(x) end in - let z := match goal with |- ?R ?x ?z => constr:(z) end in - refine (@transitivity _ R _ x y z _ _). -Tactic Notation "etransitivity" := etransitivity _. -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation pr1 := projT1. -Notation pr2 := projT2. -Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. -Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Arguments paths_rect [A] a P f y p. -Notation "x = y :> A" := (@paths A x y) : type_scope. -Notation "x = y" := (x = y :>_) : type_scope. -Delimit Scope path_scope with path. -Local Open Scope path_scope. -Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := - match p, q with idpath, idpath => idpath end. -Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. -Definition inverse {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. -Notation "1" := idpath : path_scope. -Notation "p @ q" := (concat p q) (at level 20) : path_scope. -Notation "p ^" := (inverse p) (at level 3) : path_scope. -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := - match p with idpath => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with idpath => idpath end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): - p # (f x) = f y - := match p with idpath => idpath end. -Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) - (p : x = y) (z : P (f x)) - : transport (fun x => P (f x)) p z = transport P (ap f p) z. -admit. -Defined. -Local Open Scope path_scope. -Generalizable Variables X A B C f g n. -Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (pq : {p : u.1 = v.1 & p # u.2 = v.2}) - : u = v - := match pq with - | existT p q => - match u, v return (forall p0 : (u.1 = v.1), (p0 # u.2 = v.2) -> (u=v)) with - | (x;y), (x';y') => fun p1 q1 => - match p1 in (_ = x'') return (forall y'', (p1 # y = y'') -> (x;y)=(x'';y'')) with - | idpath => fun y' q2 => - match q2 in (_ = y'') return (x;y) = (x;y'') with - | idpath => 1 - end - end y' q1 - end p q - end. -Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) - (p : u.1 = v.1) (q : p # u.2 = v.2) - : u = v - := path_sigma_uncurried P u v (p;q). -Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) - : u.1 = v.1 - := - ap (@projT1 _ _) p. -Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. -Definition projT2_path `{P : A -> Type} {u v : sigT P} (p : u = v) - : p..1 # u.2 = v.2 - := (transport_compose P (@projT1 _ _) p u.2)^ - @ (@apD {x:A & P x} _ (@projT2 _ _) _ _ p). -Notation "p ..2" := (projT2_path p) (at level 3) : fibration_scope. -Definition eta_path_sigma_uncurried `{P : A -> Type} {u v : sigT P} - (p : u = v) - : path_sigma_uncurried _ _ _ (p..1; p..2) = p. -admit. -Defined. -Definition eta_path_sigma `{P : A -> Type} {u v : sigT P} (p : u = v) - : path_sigma _ _ _ (p..1) (p..2) = p - := eta_path_sigma_uncurried p. - -Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) - (p q : u = v) - (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) - : p = q. -Proof. - destruct rs, p, u. - etransitivity; [ | apply eta_path_sigma ]. - simpl in *. - induction p0. - admit. -Defined. - diff --git a/test-suite/bugs/closed/4782.v b/test-suite/bugs/closed/4782.v deleted file mode 100644 index 1e1a4cb9c2..0000000000 --- a/test-suite/bugs/closed/4782.v +++ /dev/null @@ -1,26 +0,0 @@ -(* About typing of with bindings *) - -Record r : Type := mk_r { type : Type; cond : type -> Prop }. - -Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p. - -Goal p. -Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil. -Abort. - -(* A simplification of an example from coquelicot, which was failing - at some time after a fix #4782 was committed. *) - -Record T := { dom : Type }. -Definition pairT A B := {| dom := (dom A * dom B)%type |}. -Class C (A:Type). -Parameter B:T. -Instance c (A:T) : C (dom A). -Instance cn : C (dom B). -Parameter F : forall A:T, C (dom A) -> forall x:dom A, x=x -> A = A. -Set Typeclasses Debug. -Goal forall (A:T) (x:dom A), pairT A A = pairT A A. -intros. -apply (F _ _) with (x,x). -Abort. - diff --git a/test-suite/bugs/closed/4787.v b/test-suite/bugs/closed/4787.v deleted file mode 100644 index b586cba50f..0000000000 --- a/test-suite/bugs/closed/4787.v +++ /dev/null @@ -1,9 +0,0 @@ -(* [Unset Bracketing Last Introduction Pattern] was not working *) - -Unset Bracketing Last Introduction Pattern. - -Goal forall T (x y : T * T), fst x = fst y /\ snd x = snd y -> x = y. -do 10 ((intros [] || intro); simpl); reflexivity. -Qed. - - diff --git a/test-suite/bugs/closed/4811.v b/test-suite/bugs/closed/4811.v deleted file mode 100644 index fe6e65a0f0..0000000000 --- a/test-suite/bugs/closed/4811.v +++ /dev/null @@ -1,1685 +0,0 @@ -(* Test about a slowness of f_equal in 8.5pl1 *) - -(* Submitted by Jason Gross *) - -(* -*- mode: coq; coq-prog-args: ("-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *) -(* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *) -(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 - coqtop version 8.5pl1 (April 2016) *) -Require Coq.ZArith.ZArith. - -Import Coq.ZArith.ZArith. - -Axiom F : Z -> Set. -Definition Let_In {A P} (x : A) (f : forall y : A, P y) - := let y := x in f y. -Local Open Scope Z_scope. -Definition modulus : Z := 2^255 - 19. -Axiom decode : list Z -> F modulus. -Goal forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z, - let Zmul := Z.mul in - let Zadd := Z.add in - let Zsub := Z.sub in - let Zpow_pos := Z.pow_pos in - @eq (F (Zsub (Zpow_pos (Zpos (xO xH)) (xI (xI (xI (xI (xI (xI (xI xH)))))))) (Zpos (xI (xI (xO (xO xH))))))) - (@decode - (@Let_In Z (fun _ : Z => list Z) - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (fun z : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (fun z0 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z0 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (fun z1 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z1 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) - (fun z2 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z2 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (fun z3 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z3 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (fun z4 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z4 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (fun z5 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z5 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (fun z6 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z6 (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) - (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (fun z7 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Z.shiftr z7 (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) - (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) - (Zmul x1 y8)) (Zmul x0 y9))) - (fun z8 : Z => - @Let_In Z (fun _ : Z => list Z) - (Zadd (Zmul (Zpos (xI (xI (xO (xO xH))))) (Z.shiftr z8 (Zpos (xI (xO (xO (xI xH))))))) - (Z.land z - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (fun z9 : Z => - @cons Z - (Z.land z9 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Zadd (Z.shiftr z9 (Zpos (xO (xI (xO (xI xH)))))) - (Z.land z0 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z1 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z2 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z3 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z4 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z5 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z6 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land z7 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land z8 - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@nil Z))))))))))))))))))))))) - (@decode - (@cons Z - (Z.land - (Zadd - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) - (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) - (Zmul x0 y8)) (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) (Zmul x5 y4)) - (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) - (Zpos (xI (xO (xO (xI xH))))))) - (Z.land - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Zadd - (Z.shiftr - (Zadd - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) - (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) - (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) - (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) - (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) - (Zmul x1 y8)) (Zmul x0 y9))) (Zpos (xI (xO (xO (xI xH))))))) - (Z.land - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Z.land - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) - (Zmul x6 y5)) (Zmul x5 y6)) (Zmul x4 y7)) - (Zmul x3 y8)) (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) - (Zmul x6 y5)) (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul (Zmul x9 y1) (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul (Zmul x7 y3) (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) (Zmul x6 y5)) - (Zmul x5 y6)) (Zmul x4 y7)) - (Zmul x3 y8)) (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul (Zmul x5 y5) (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul (Zmul x3 y7) (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y2) (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) (Zmul x3 y8)) - (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) - (Zmul x6 y7)) (Zmul x5 y8)) - (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) - (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) - (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) - (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) - (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul - (Zmul x3 y7) - (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y3) - (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul (Zmul x7 y5) (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul (Zmul x5 y7) (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) - (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) (Zmul x6 y7)) - (Zmul x5 y8)) (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) - (Zmul x8 y6)) (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) - (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) - (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) - (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) - (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) - (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) - (@cons Z - (Z.land - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd - (Z.shiftr - (Zadd (Zmul x0 y0) - (Zmul - (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y1) - (Zpos (xO xH))) - (Zmul x8 y2)) - (Zmul - (Zmul x7 y3) - (Zpos (xO xH)))) - (Zmul x6 y4)) - (Zmul - (Zmul x5 y5) - (Zpos (xO xH)))) - (Zmul x4 y6)) - (Zmul - (Zmul x3 y7) - (Zpos (xO xH)))) - (Zmul x2 y8)) - (Zmul - (Zmul x1 y9) - (Zpos (xO xH)))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul x9 y2) - (Zmul x8 y3)) - (Zmul x7 y4)) - (Zmul x6 y5)) - (Zmul x5 y6)) - (Zmul x4 y7)) - (Zmul x3 y8)) - (Zmul x2 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zmul x2 y0) - (Zmul (Zmul x1 y1) (Zpos (xO xH)))) - (Zmul x0 y2)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zmul - (Zmul x9 y3) - (Zpos (xO xH))) - (Zmul x8 y4)) - (Zmul - (Zmul x7 y5) - (Zpos (xO xH)))) - (Zmul x6 y6)) - (Zmul - (Zmul x5 y7) - (Zpos (xO xH)))) - (Zmul x4 y8)) - (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) - (Zmul x1 y2)) (Zmul x0 y3)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x9 y4) (Zmul x8 y5)) - (Zmul x7 y6)) - (Zmul x6 y7)) - (Zmul x5 y8)) - (Zmul x4 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x4 y0) - (Zmul (Zmul x3 y1) (Zpos (xO xH)))) - (Zmul x2 y2)) - (Zmul (Zmul x1 y3) (Zpos (xO xH)))) - (Zmul x0 y4)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd - (Zadd - (Zadd - (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) - (Zmul x8 y6)) - (Zmul (Zmul x7 y7) (Zpos (xO xH)))) - (Zmul x6 y8)) - (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) - (Zmul x2 y3)) (Zmul x1 y4)) - (Zmul x0 y5)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) - (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zmul x6 y0) - (Zmul (Zmul x5 y1) (Zpos (xO xH)))) - (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) - (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) - (Zmul x0 y6)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) - (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) - (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) - (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) - (Zmul x1 y6)) (Zmul x0 y7)) - (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) - (Zpos (xI (xO (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) - (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) - (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) - (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) - (Zmul x0 y8)) - (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) - (Zpos (xO (xI (xO (xI xH)))))) - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd - (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) - (Zmul x6 y3)) (Zmul x5 y4)) (Zmul x4 y5)) - (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) - (Zpos - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI - (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) - (@nil Z)))))))))))). - cbv beta zeta. - intros. - (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early". - Undo. - Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *) diff --git a/test-suite/bugs/closed/4813.v b/test-suite/bugs/closed/4813.v deleted file mode 100644 index 5f8ea74c1a..0000000000 --- a/test-suite/bugs/closed/4813.v +++ /dev/null @@ -1,9 +0,0 @@ -(* On the strength of "apply with" (see also #4782) *) - -Record ProverT := { Facts : Type }. -Record ProverT_correct (P : ProverT) := { Valid : Facts P -> Prop ; - Valid_weaken : Valid = Valid }. -Definition reflexivityValid (_ : unit) := True. -Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}. -Proof. - eapply Build_ProverT_correct with (Valid := reflexivityValid). diff --git a/test-suite/bugs/closed/4818.v b/test-suite/bugs/closed/4818.v deleted file mode 100644 index e411ce62f0..0000000000 --- a/test-suite/bugs/closed/4818.v +++ /dev/null @@ -1,24 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-R" "." "Prob" "-top" "Product") -*- *) -(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *) -(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3 - coqtop version 8.5pl1 (June 2016) *) -Set Universe Polymorphism. - -Inductive GCov (I : Type) : Type := | Foo : I -> GCov I. - -Section Product. - -Variables S IS : Type. -Variable locS : IS -> True. - -Goal GCov (IS * S) -> GCov IS. -intros X0. induction X0; intros. -destruct i. -specialize (locS i). -clear -locS. -destruct locS. Show Universes. -Admitted. - -(* -Anomaly: Universe Product.5189 undefined. Please report. -*) diff --git a/test-suite/bugs/closed/4852.v b/test-suite/bugs/closed/4852.v deleted file mode 100644 index 5068ed9b95..0000000000 --- a/test-suite/bugs/closed/4852.v +++ /dev/null @@ -1,54 +0,0 @@ -(** BZ 4852 : unsatisfactory Extraction Implicit for a fixpoint defined via wf *) - -Require Import Coq.Lists.List. -Import ListNotations. -Require Import Omega. - -Definition wfi_lt := well_founded_induction_type Wf_nat.lt_wf. - -Tactic Notation "wfinduction" constr(term) "on" ne_hyp_list(Hs) "as" ident(H) := - let R := fresh in - let E := fresh in - remember term as R eqn:E; - revert E; revert Hs; - induction R as [R H] using wfi_lt; - intros; subst R. - -Hint Rewrite @app_comm_cons @app_assoc @app_length : app_rws. - -Ltac solve_nat := autorewrite with app_rws in *; cbn in *; omega. - -Notation "| x |" := (length x) (at level 11, no associativity, format "'|' x '|'"). - -Definition split_acc (ls : list nat) : forall acc1 acc2, - (|acc1| = |acc2| \/ |acc1| = S (|acc2|)) -> - { lss : list nat * list nat | - let '(ls1, ls2) := lss in |ls1++ls2| = |ls++acc1++acc2| /\ (|ls1| = |ls2| \/ |ls1| = S (|ls2|))}. -Proof. - induction ls as [|a ls IHls]. all:intros acc1 acc2 H. - { exists (acc1, acc2). cbn. intuition reflexivity. } - destruct (IHls (a::acc2) acc1) as [[ls1 ls2] (H1 & H2)]. 1:solve_nat. - exists (ls1, ls2). cbn. intuition solve_nat. -Defined. - -Definition join(ls : list nat) : { rls : list nat | |rls| = |ls| }. -Proof. - wfinduction (|ls|) on ls as IH. - case (split_acc ls [] []). 1:solve_nat. - intros (ls1 & ls2) (H1 & H2). - destruct ls2 as [|a ls2]. - - exists ls1. solve_nat. - - unshelve eelim (IH _ _ ls1 eq_refl). 1:solve_nat. intros rls1 H3. - unshelve eelim (IH _ _ ls2 eq_refl). 1:solve_nat. intros rls2 H4. - exists (a :: rls1 ++ rls2). solve_nat. -Defined. - -Require Import ExtrOcamlNatInt. -Extract Inlined Constant length => "List.length". -Extract Inlined Constant app => "List.append". - -Extraction Inline wfi_lt. -Extraction Implicit wfi_lt [1 3]. -Recursive Extraction join. (* was: Error: An implicit occurs after extraction *) -Extraction TestCompile join. - diff --git a/test-suite/bugs/closed/4863.v b/test-suite/bugs/closed/4863.v deleted file mode 100644 index 1e47f2957b..0000000000 --- a/test-suite/bugs/closed/4863.v +++ /dev/null @@ -1,33 +0,0 @@ -Require Import Classes.DecidableClass. - -Inductive Foo : Set := -| foo1 | foo2. - -Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. -Proof. - intros P H. - refine (Build_Decidable _ (if H then true else false) _). - intuition congruence. -Qed. - -Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances. - -Goal forall (a b : Foo), {a=b}+{a<>b}. -intros. -abstract (abstract (decide equality)). (*abstract works here*) -Qed. - -Check ltac:(abstract (exact I)) : True. - -Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). -intros. -split. typeclasses eauto. -typeclasses eauto. Qed. - -Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). -intros. -split. -refine _. -refine _. -Defined. -(*fails*) diff --git a/test-suite/bugs/closed/4865.v b/test-suite/bugs/closed/4865.v deleted file mode 100644 index da4e53aab0..0000000000 --- a/test-suite/bugs/closed/4865.v +++ /dev/null @@ -1,52 +0,0 @@ -(* Check discharge of arguments scopes + other checks *) - -(* This is bug #4865 *) - -Notation "<T>" := true : bool_scope. -Section A. - Check negb <T>. - Global Arguments negb : clear scopes. - Fail Check negb <T>. -End A. - -(* Check that no scope is re-computed *) -Fail Check negb <T>. - -(* Another test about arguments scopes in sections *) - -Notation "0" := true. -Section B. - Variable x : nat. - Let T := nat -> nat. - Definition f y : T := fun z => x + y + z. - Fail Check f 1 0. (* 0 in nat, 0 in bool *) - Fail Check f 0 0. (* 0 in nat, 0 in bool *) - Check f 0 1. (* 0 and 1 in nat *) - Global Arguments f _%nat_scope _%nat_scope. - Check f 0 0. (* both 0 in nat *) -End B. - -(* Check that only the scope for the extra product on x is re-computed *) -Check f 0 0 0. (* All 0 in nat *) - -Section C. - Variable x : nat. - Let T := nat -> nat. - Definition g y : T := fun z => x + y + z. - Global Arguments g : clear scopes. - Check g 1. (* 1 in nat *) -End C. - -(* Check that only the scope for the extra product on x is re-computed *) -Check g 0. (* 0 in nat *) -Fail Check g 0 1 0. (* 2nd 0 in bool *) -Fail Check g 0 0 1. (* 2nd 0 in bool *) - -(* Another test on arguments scopes: checking scope for expanding arities *) -(* Not sure this is very useful, but why not *) - -Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end. -Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n end. -Notation "0" := true. -Arguments lam _%nat_scope _%nat_scope : extra scopes. -Check (lam 1 0). diff --git a/test-suite/bugs/closed/4893.v b/test-suite/bugs/closed/4893.v deleted file mode 100644 index 9a35bcf954..0000000000 --- a/test-suite/bugs/closed/4893.v +++ /dev/null @@ -1,4 +0,0 @@ -Goal True. -evar (P: Prop). -assert (H : P); [|subst P]; [exact I|]. -let T := type of H in not_evar T. diff --git a/test-suite/bugs/closed/4955.v b/test-suite/bugs/closed/4955.v deleted file mode 100644 index dce1f764c3..0000000000 --- a/test-suite/bugs/closed/4955.v +++ /dev/null @@ -1,98 +0,0 @@ -(* An example involving a first-order unification triggering a cyclic constraint *) - -Module A. -Notation "{ x : A | P }" := (sigT (fun x:A => P)). -Notation "( x ; y )" := (existT _ x y) : fibration_scope. -Open Scope fibration_scope. -Notation "p @ q" := (eq_trans p q) (at level 20). -Notation "p ^" := (eq_sym p) (at level 3). -Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) -: P y := - match p with eq_refl => u end. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only -parsing). -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with eq_refl => eq_refl end. -Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): p # (f -x) = f y - := match p with eq_refl => eq_refl end. -Axiom transport_compose - : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f -x)), - transport (fun x => P (f x)) p z = transport P (ap f p) z. -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Delimit Scope functor_scope with functor. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) -(object_of d) }. -Arguments object_of {C%category D%category} f%functor c%object : rename, simpl -nomatch. -Arguments morphism_of [C%category] [D%category] f%functor [s%object d%object] -m%morphism : rename, simpl nomatch. -Section path_functor. - Variable C : PreCategory. - Variable D : PreCategory. - - Local Notation path_functor'_T F G - := { HO : object_of F = object_of G - | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) -(GO d)) - HO - (morphism_of F) - = morphism_of G } - (only parsing). - Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> -path_functor'_T F G - := fun H' - => (ap object_of H'; - (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). - -End path_functor. -End A. - -(* A variant of it with more axioms *) - -Module B. -Notation "{ x : A | P }" := (sigT (fun x:A => P)). -Notation "( x ; y )" := (existT _ x y). -Notation "p @ q" := (eq_trans p q) (at level 20). -Notation "p ^" := (eq_sym p) (at level 3). -Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. -Notation "p # x" := (transport _ p x) (right associativity, at level 65, only -parsing). -Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y - := match p with eq_refl => eq_refl end. -Axiom apD : forall {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y), p # (f -x) = f y. -Axiom transport_compose - : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f -x)), - transport (fun x => P (f x)) p z = transport P (ap f p) z. -Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. -Record Functor (C D : PreCategory) := - { object_of :> C -> D; - morphism_of : forall s d, morphism C s d -> morphism D (object_of s) -(object_of d) }. -Arguments object_of {C D} f c : rename, simpl nomatch. -Arguments morphism_of [C] [D] f [s d] m : rename, simpl nomatch. -Section path_functor. - Variable C D : PreCategory. - Local Notation path_functor'_T F G - := { HO : object_of F = object_of G - | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) -(GO d)) - HO - (morphism_of F) - = morphism_of G }. - Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> -path_functor'_T F G - := fun H' - => (ap object_of H'; - (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). - -End path_functor. -End B. diff --git a/test-suite/bugs/closed/4969.v b/test-suite/bugs/closed/4969.v deleted file mode 100644 index 4dee41e221..0000000000 --- a/test-suite/bugs/closed/4969.v +++ /dev/null @@ -1,11 +0,0 @@ -Require Import Classes.Init. - -Class C A := c : A. -Instance nat_C : C nat := 0. -Instance bool_C : C bool := true. -Lemma silly {A} `{C A} : 0 = 0 -> c = c -> True. -Proof. auto. Qed. - -Goal True. - class_apply @silly; [reflexivity|]. - reflexivity. Fail Qed. diff --git a/test-suite/bugs/closed/5045.v b/test-suite/bugs/closed/5045.v deleted file mode 100644 index dc38738d8f..0000000000 --- a/test-suite/bugs/closed/5045.v +++ /dev/null @@ -1,3 +0,0 @@ -Axiom silly : 1 = 1 -> nat -> nat. -Goal forall pf : 1 = 1, silly pf 0 = 0 -> True. - Fail generalize (@eq nat). diff --git a/test-suite/bugs/closed/5077.v b/test-suite/bugs/closed/5077.v deleted file mode 100644 index 7e7f2c3737..0000000000 --- a/test-suite/bugs/closed/5077.v +++ /dev/null @@ -1,8 +0,0 @@ -(* Testing robustness of typing for a fixpoint with evars in its type *) - -Inductive foo (n : nat) : Type := . -Definition foo_denote {n} (x : foo n) : Type := match x with end. - -Definition baz : forall n (x : foo n), foo_denote x. -refine (fix go n (x : foo n) : foo_denote x := _). -Abort. diff --git a/test-suite/bugs/closed/5078.v b/test-suite/bugs/closed/5078.v deleted file mode 100644 index ca73cbcc18..0000000000 --- a/test-suite/bugs/closed/5078.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Test coercion from ident to evaluable reference *) -Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H]. -Goal True -> Type. - intro H''. - Fail unfold_hyp H''. diff --git a/test-suite/bugs/closed/5093.v b/test-suite/bugs/closed/5093.v deleted file mode 100644 index 3ded4dd304..0000000000 --- a/test-suite/bugs/closed/5093.v +++ /dev/null @@ -1,11 +0,0 @@ -Axiom P : nat -> Prop. -Axiom PS : forall n, P n -> P (S n). -Axiom P0 : P 0. - -Hint Resolve PS : foobar. -Hint Resolve P0 : foobar. - -Goal P 100. -Proof. -Fail typeclasses eauto 100 with foobar. -typeclasses eauto 101 with foobar. diff --git a/test-suite/bugs/closed/5095.v b/test-suite/bugs/closed/5095.v deleted file mode 100644 index b6f38e3e84..0000000000 --- a/test-suite/bugs/closed/5095.v +++ /dev/null @@ -1,5 +0,0 @@ -(* Checking let-in abstraction *) -Goal let x := Set in let y := x in True. - intros x y. - (* There used to have a too strict dependency test there *) - set (s := Set) in (value of x). diff --git a/test-suite/bugs/closed/5096.v b/test-suite/bugs/closed/5096.v deleted file mode 100644 index 20a537ab3c..0000000000 --- a/test-suite/bugs/closed/5096.v +++ /dev/null @@ -1,219 +0,0 @@ -Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List. - -Set Asymmetric Patterns. - -Notation eta x := (fst x, snd x). - -Inductive expr {var : Type} : Type := -| Const : expr -| LetIn : expr -> (var -> expr) -> expr. - -Definition Expr := forall var, @expr var. - -Fixpoint count_binders (e : @expr unit) : nat := -match e with -| LetIn _ eC => 1 + @count_binders (eC tt) -| _ => 0 -end. - -Definition CountBinders (e : Expr) : nat := count_binders (e _). - -Class Context (Name : Type) (var : Type) := - { ContextT : Type; - extendb : ContextT -> Name -> var -> ContextT; - empty : ContextT }. -Coercion ContextT : Context >-> Sortclass. -Arguments ContextT {_ _ _}, {_ _} _. -Arguments extendb {_ _ _} _ _ _. -Arguments empty {_ _ _}. - -Module Export Named. -Inductive expr Name : Type := -| Const : expr Name -| LetIn : Name -> expr Name -> expr Name -> expr Name. -End Named. - -Global Arguments Const {_}. -Global Arguments LetIn {_} _ _ _. - -Definition split_onames {Name : Type} (ls : list (option Name)) - : option (Name) * list (option Name) - := match ls with - | cons n ls' - => (n, ls') - | nil => (None, nil) - end. - -Section internal. - Context (InName OutName : Type) - {InContext : Context InName (OutName)} - {ReverseContext : Context OutName (InName)} - (InName_beq : InName -> InName -> bool). - - Fixpoint register_reassign (ctxi : InContext) (ctxr : ReverseContext) - (e : expr InName) (new_names : list (option OutName)) - : option (expr OutName) - := match e in Named.expr _ return option (expr _) with - | Const => Some Const - | LetIn n ex eC - => let '(n', new_names') := eta (split_onames new_names) in - match n', @register_reassign ctxi ctxr ex nil with - | Some n', Some x - => let ctxi := @extendb _ _ _ ctxi n n' in - let ctxr := @extendb _ _ _ ctxr n' n in - option_map (LetIn n' x) (@register_reassign ctxi ctxr eC new_names') - | None, Some x - => let ctxi := ctxi in - @register_reassign ctxi ctxr eC new_names' - | _, None => None - end - end. - -End internal. - -Global Instance pos_context (var : Type) : Context positive var - := { ContextT := PositiveMap.t var; - extendb ctx key v := PositiveMap.add key v ctx; - empty := PositiveMap.empty _ }. - -Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _. - -Section language5. - Context (Name : Type). - - Local Notation expr := (@Top.expr Name). - Local Notation nexpr := (@Named.expr Name). - - Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e} - : option (nexpr) - := match e in @Top.expr _ return option (nexpr) with - | Top.Const => Some Named.Const - | Top.LetIn ex eC - => match @ocompile ex nil, split_onames ls with - | Some x, (Some n, ls')%core - => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls') - | _, _ => None - end - end. - - Definition compile (e : expr) (ls : list Name) := @ocompile e (List.map (@Some _) ls). -End language5. - -Global Arguments compile {_} e ls. - -Fixpoint merge_liveness (ls1 ls2 : list unit) := - match ls1, ls2 with - | cons x xs, cons y ys => cons tt (@merge_liveness xs ys) - | nil, ls | ls, nil => ls - end. - -Section internal1. - Context (Name : Type) - (OutName : Type) - {Context : Context Name (list unit)}. - - Definition compute_livenessf_step - (compute_livenessf : forall (ctx : Context) (e : expr Name) (prefix : list unit), list unit) - (ctx : Context) - (e : expr Name) (prefix : list unit) - : list unit - := match e with - | Const => prefix - | LetIn n ex eC - => let lx := @compute_livenessf ctx ex prefix in - let lx := merge_liveness lx (prefix ++ repeat tt 1) in - let ctx := @extendb _ _ _ ctx n (lx) in - @compute_livenessf ctx eC (prefix ++ repeat tt 1) - end. - - Fixpoint compute_liveness ctx e prefix - := @compute_livenessf_step (@compute_liveness) ctx e prefix. - - Fixpoint insert_dead_names_gen def (ls : list unit) (lsn : list OutName) - : list (option OutName) - := match ls with - | nil => nil - | cons live xs - => match lsn with - | cons n lsn' => Some n :: @insert_dead_names_gen def xs lsn' - | nil => def :: @insert_dead_names_gen def xs nil - end - end. - Definition insert_dead_names def (e : expr Name) - := insert_dead_names_gen def (compute_liveness empty e nil). -End internal1. - -Global Arguments insert_dead_names {_ _ _} def e lsn. - -Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. - -Section language7. - Context {Context : Context unit (positive)}. - - Local Notation nexpr := (@Named.expr unit). - - Definition CompileAndEliminateDeadCode (e : Expr) (ls : list unit) - : option (nexpr) - := let e := compile (Name:=positive) (e _) (List.map Pos.of_nat (seq 1 (CountBinders e))) in - match e with - | Some e => Let_In (insert_dead_names None e ls) (* help vm_compute by factoring this out *) - (fun names => register_reassign empty empty e names) - | None => None - end. -End language7. - -Global Arguments CompileAndEliminateDeadCode {_} e ls. - -Definition ContextOn {Name1 Name2} f {var} (Ctx : Context Name1 var) : Context Name2 var - := {| ContextT := Ctx; - extendb ctx n v := extendb ctx (f n) v; - empty := empty |}. - -Definition Register := Datatypes.unit. - -Global Instance RegisterContext {var : Type} : Context Register var - := ContextOn (fun _ => 1%positive) (pos_context var). - -Definition syntax := Named.expr Register. - -Definition AssembleSyntax e ls (res := CompileAndEliminateDeadCode e ls) - := match res return match res with None => _ | _ => _ end with - | Some v => v - | None => I - end. - -Definition dummy_registers (n : nat) : list Register - := List.map (fun _ => tt) (seq 0 n). -Definition DefaultRegisters (e : Expr) : list Register - := dummy_registers (CountBinders e). - -Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e). - -Notation "'slet' x := A 'in' b" := (Top.LetIn A (fun x => b)) (at level 200, b at level 200). -Notation "#[ var ]#" := (@Top.Const var). - -Definition compiled_syntax : Expr := fun (var : Type) => -( - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - slet x1 := #[ var ]# in - @Top.Const var). - -Definition v := - Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)). - -Timeout 2 Eval vm_compute in v. diff --git a/test-suite/bugs/closed/5149.v b/test-suite/bugs/closed/5149.v deleted file mode 100644 index 684dba1961..0000000000 --- a/test-suite/bugs/closed/5149.v +++ /dev/null @@ -1,47 +0,0 @@ -Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x. -intros. -eexists. -rewrite <- H. -eassumption. -Qed. - -Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) - (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : -flat_type -> Type) - (v v' : interp_flat_type1 t'), - v = v' -> - forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0) - (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> -interp_flat_type0 t0) - (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t)) - (x' : interp_flat_type1 (Tbase t)) (T : Type) - (flatten_binding_list : forall t0 : flat_type, - interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T) - (P : T -> list T -> Prop) (prod : Type -> Type -> Type) - (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) -(interp_flat_type1 (Tbase x0)) -> T) - (pair : forall A B : Type, A -> B -> prod A B), - P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x')) - (flatten_binding_list t' (SmartVarVar t' v') v) -> - (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 -t'0) - (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)), - P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 -x'0)) - (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf -(Tbase t0) x0 = x'0) -> - interpf (Tbase t) x = x'. -Proof. - intros ?????????????????????? interpf_SmartVarVar. - solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail -"too early". - Undo. - (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *) - Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. - solve [eapply interpf_SmartVarVar; subst; eassumption]. - Undo. - Unset Solve Unification Constraints. - (* User control of when constraints are solved *) - solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. -Qed. - diff --git a/test-suite/bugs/closed/5153.v b/test-suite/bugs/closed/5153.v deleted file mode 100644 index be6407b5fa..0000000000 --- a/test-suite/bugs/closed/5153.v +++ /dev/null @@ -1,8 +0,0 @@ -(* An example where it does not hurt having more type-classes resolution *) -Class some_type := { Ty : Type }. -Instance: some_type := { Ty := nat }. -Arguments Ty : clear implicits. -Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 = 2. -Proof. -intros H H'. -specialize (H' (@H _ O)). (* was failing *) diff --git a/test-suite/bugs/closed/5180.v b/test-suite/bugs/closed/5180.v deleted file mode 100644 index 05603a048c..0000000000 --- a/test-suite/bugs/closed/5180.v +++ /dev/null @@ -1,64 +0,0 @@ -Universes a b c ω ω'. -Definition Typeω := Type@{ω}. -Definition Type2 : Typeω := Type@{c}. -Definition Type1 : Type2 := Type@{b}. -Definition Type0 : Type1 := Type@{a}. - -Set Universe Polymorphism. -Set Printing Universes. - -Definition Typei' (n : nat) - := match n return Type@{ω'} with - | 0 => Type0 - | 1 => Type1 - | 2 => Type2 - | _ => Typeω - end. -Definition TypeOfTypei' {n} (x : Typei' n) : Type@{ω'} - := match n return Typei' n -> Type@{ω'} with - | 0 | 1 | 2 | _ => fun x => x - end x. -Definition Typei (n : nat) : Typei' (S n) - := match n return Typei' (S n) with - | 0 => Type0 - | 1 => Type1 - | _ => Type2 - end. -Definition TypeOfTypei {n} (x : TypeOfTypei' (Typei n)) : Type@{ω'} - := match n return TypeOfTypei' (Typei n) -> Type@{ω'} with - | 0 | 1 | _ => fun x => x - end x. -Check Typei 0 : Typei 1. -Check Typei 1 : Typei 2. - -Definition lift' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) - := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => (x : Type) - end. -Definition lift'' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) - := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => x - end. (* The command has indeed failed with message: -In environment -n : nat -x : TypeOfTypei' (Typei 0) -The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type - "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). - *) -Check (fun x : TypeOfTypei' (Typei 0) => TypeOfTypei' (Typei 1)). - -Definition lift''' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)). - refine match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with - | 0 | 1 | 2 | _ => fun x => _ - end. - exact x. - Undo. - (* The command has indeed failed with message: -In environment -n : nat -x : TypeOfTypei' (Typei 0) -The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type - "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). - *) - all:compute in *. - all:exact x. diff --git a/test-suite/bugs/closed/5181.v b/test-suite/bugs/closed/5181.v deleted file mode 100644 index 0e6d471979..0000000000 --- a/test-suite/bugs/closed/5181.v +++ /dev/null @@ -1,3 +0,0 @@ -Definition foo (x y : nat) := x. -Fail Arguments foo {_} : assert. - diff --git a/test-suite/bugs/closed/5193.v b/test-suite/bugs/closed/5193.v deleted file mode 100644 index cc8739afe6..0000000000 --- a/test-suite/bugs/closed/5193.v +++ /dev/null @@ -1,14 +0,0 @@ -Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. - -Typeclasses eauto := debug. -Set Typeclasses Debug Verbosity 2. - -Inductive Finx(n : nat) : Set := -| Fx1(i : nat)(e : n = S i) -| FxS(i : nat)(f : Finx i)(e : n = S i). - -Context `{Finx_eqdec : forall n, Eqdec (Finx n)}. - -Goal {x : Type & Eqdec x}. - eexists. - try typeclasses eauto 1 with typeclass_instances. diff --git a/test-suite/bugs/closed/5198.v b/test-suite/bugs/closed/5198.v deleted file mode 100644 index 72722f5f6d..0000000000 --- a/test-suite/bugs/closed/5198.v +++ /dev/null @@ -1,39 +0,0 @@ -(* -*- mode: coq; coq-prog-args: ("-boot" "-nois") -*- *) -(* File reduced by coq-bug-finder from original input, then from 286 lines to -27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, -then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from -253 lines to 65 lines, then from 79 lines to 65 lines *) -(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with -OCaml 4.02.3 - coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 -(7e992fa784ee6fa48af8a2e461385c094985587d) *) -Axiom admit : forall {T}, T. -Set Printing Implicit. -Inductive nat := O | S (_ : nat). -Axiom f : forall (_ _ : nat), nat. -Class ZLikeOps (e : nat) - := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT -}. -Class BarrettParameters := - { b : nat ; k : nat ; ops : ZLikeOps (f b k) }. -Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters} - (_ : @LargeT _ (@ops params)), - @SmallT _ (@ops params). - -Global Instance ZZLikeOps e : ZLikeOps (f (S O) e) - := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }. -Definition SRep := nat. -Local Instance x86_25519_Barrett : BarrettParameters - := { b := S O ; k := O ; ops := ZZLikeOps O }. -Definition SRepAdd : forall (_ _ : SRep), SRep - := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in - v. -Definition SRepAdd' : forall (_ _ : SRep), SRep - := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)). -(* Error: -In environment -x : SRep -y : SRep -The term "x" has type "SRep" while it is expected to have type - "@LargeT ?e ?ZLikeOps". - *) diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v deleted file mode 100644 index 3428e1a450..0000000000 --- a/test-suite/bugs/closed/5203.v +++ /dev/null @@ -1,5 +0,0 @@ -Goal True. - Typeclasses eauto := debug. - Fail solve [ typeclasses eauto ]. - Fail typeclasses eauto. - diff --git a/test-suite/bugs/closed/5219.v b/test-suite/bugs/closed/5219.v deleted file mode 100644 index f7cec1a0cf..0000000000 --- a/test-suite/bugs/closed/5219.v +++ /dev/null @@ -1,10 +0,0 @@ -(* Test surgical use of beta-iota in the type of variables coming from - pattern-matching for refine *) - -Goal forall x : sigT (fun x => x = 1), True. - intro x; refine match x with - | existT _ x' e' => _ - end. - lazymatch goal with - | [ H : _ = _ |- _ ] => idtac - end. diff --git a/test-suite/bugs/closed/5277.v b/test-suite/bugs/closed/5277.v deleted file mode 100644 index 7abc38bfce..0000000000 --- a/test-suite/bugs/closed/5277.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Scheme Equality not robust wrt names *) - -Module A1. - Inductive A (T : Type) := C (a : T). - Scheme Equality for A. (* success *) -End A1. - -Module A2. - Inductive A (x : Type) := C (a : x). - Scheme Equality for A. -End A2. diff --git a/test-suite/bugs/closed/5315.v b/test-suite/bugs/closed/5315.v deleted file mode 100644 index d8824bff87..0000000000 --- a/test-suite/bugs/closed/5315.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Recdef. - -Function dumb_works (a:nat) {struct a} := - match (fun x => x) a with O => O | S n' => dumb_works n' end. - -Function dumb_nope (a:nat) {struct a} := - match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end. - -(* This check is just present to ensure Function worked well *) -Check R_dumb_nope_complete. diff --git a/test-suite/bugs/closed/5321.v b/test-suite/bugs/closed/5321.v deleted file mode 100644 index 03514e23b1..0000000000 --- a/test-suite/bugs/closed/5321.v +++ /dev/null @@ -1,18 +0,0 @@ -Definition proj1_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) - : proj1_sig u = proj1_sig v - := f_equal (@proj1_sig _ _) p. - -Definition proj2_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) - : eq_rect _ _ (proj2_sig u) _ (proj1_sig_path p) = proj2_sig v - := match p with eq_refl => eq_refl end. - -Goal forall sz : nat, - let sz' := sz in - forall pf : sz = sz', - let feq_refl := exist (fun x : nat => sz = x) sz' eq_refl in - let fpf := exist (fun x : nat => sz = x) sz' pf in feq_refl = fpf -> -proj2_sig feq_refl = proj2_sig fpf. -Proof. - intros. - etransitivity; [ | exact (proj2_sig_path H) ]. - Fail clearbody fpf. diff --git a/test-suite/bugs/closed/5322.v b/test-suite/bugs/closed/5322.v deleted file mode 100644 index 01aec8f29b..0000000000 --- a/test-suite/bugs/closed/5322.v +++ /dev/null @@ -1,14 +0,0 @@ -(* Regression in computing types of branches in "match" *) -Inductive flat_type := Unit | Prod (A B : flat_type). -Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type --> Type := -| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. -Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit. -Arguments Op {_ _ _ _} _ _. -Definition bound_op {var} - {src2 dst2} - (opc2 : op src2 dst2) - : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2. - refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with - | _ => _ - end. diff --git a/test-suite/bugs/closed/5323.v b/test-suite/bugs/closed/5323.v deleted file mode 100644 index 295b7cd9f5..0000000000 --- a/test-suite/bugs/closed/5323.v +++ /dev/null @@ -1,26 +0,0 @@ -(* Revealed a missing re-consideration of postponed problems *) - -Module A. -Inductive flat_type := Unit | Prod (A B : flat_type). -Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type --> Type := -| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. -Inductive op : flat_type -> flat_type -> Type := . -Arguments Op {_ _ _ _} _ _. -Definition bound_op {var} - {src2 dst2} - (opc2 : op src2 dst2) - : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2 - := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end. -End A. - -(* A shorter variant *) -Module B. -Inductive exprf (op : unit -> Type) : Type := -| A : exprf op -| Op tR (opc : op tR) (args : exprf op) : exprf op. -Inductive op : unit -> Type := . -Definition bound_op (dst2 : unit) (opc2 : op dst2) - : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op - := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end. -End B. diff --git a/test-suite/bugs/closed/5331.v b/test-suite/bugs/closed/5331.v deleted file mode 100644 index 28743736d3..0000000000 --- a/test-suite/bugs/closed/5331.v +++ /dev/null @@ -1,11 +0,0 @@ -(* Checking no anomaly on some unexpected intropattern *) - -Ltac ih H := induction H as H. -Ltac ih' H H' := induction H as H'. - -Goal True -> True. -Fail intro H; ih H. -intro H; ih' H ipattern:([]). -exact I. -Qed. - diff --git a/test-suite/bugs/closed/5359.v b/test-suite/bugs/closed/5359.v deleted file mode 100644 index 87e69565e3..0000000000 --- a/test-suite/bugs/closed/5359.v +++ /dev/null @@ -1,218 +0,0 @@ -Require Import Coq.nsatz.Nsatz. -Goal False. - - (* the first (succeeding) goal was reached by clearing one hypothesis in the second goal which overflows 6GB of stack space *) - let sugar := constr:( 0%Z ) in - let nparams := constr:( (-1)%Z ) in - let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in - let power := constr:( N.one ) in - let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). - - let sugar := constr:( 0%Z ) in - let nparams := constr:( (-1)%Z ) in - let reified_goal := constr:( - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) ) in - let power := constr:( N.one ) in - let reified_givens := constr:( - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) - :: Ring_polynom.PEadd - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7)) - (Ring_polynom.PEsub - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6)) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)))) - (Ring_polynom.PEX Z 8)) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) - (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEmul - (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEX Z 2)) - (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) - (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9)) - (Ring_polynom.PEc 1%Z) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) - (Ring_polynom.PEX Z 7))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) - (Ring_polynom.PEX Z 8)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) - (Ring_polynom.PEX Z 5))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) - (Ring_polynom.PEX Z 6)))) - :: Ring_polynom.PEsub - (Ring_polynom.PEadd - (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3))) - (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) - (Ring_polynom.PEmul - (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) - (Ring_polynom.PEX Z 2))) - (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) - (Ring_polynom.PEX Z 3)))) :: nil)%list ) in - Nsatz.nsatz_compute - (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). diff --git a/test-suite/bugs/closed/5372.v b/test-suite/bugs/closed/5372.v deleted file mode 100644 index e60244cd1d..0000000000 --- a/test-suite/bugs/closed/5372.v +++ /dev/null @@ -1,8 +0,0 @@ -(* coq bug 5372: https://coq.inria.fr/bugs/show_bug.cgi?id=5372 *) -Require Import FunInd. -Function odd (n:nat) := - match n with - | 0 => false - | S n => true - end -with even (n:nat) := false. diff --git a/test-suite/bugs/closed/5414.v b/test-suite/bugs/closed/5414.v deleted file mode 100644 index 2522a274fb..0000000000 --- a/test-suite/bugs/closed/5414.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Use of idents bound to ltac names in a "match" *) - -Definition foo : Type. -Proof. - let x := fresh "a" in - refine (forall k : nat * nat, let '(x, _) := k in (_ : Type)). - exact (a = a). -Defined. -Goal foo. -intros k. elim k. (* elim because elim keeps names *) -intros. -Check a. (* We check that the name is "a" *) diff --git a/test-suite/bugs/closed/5434.v b/test-suite/bugs/closed/5434.v deleted file mode 100644 index 5d2460face..0000000000 --- a/test-suite/bugs/closed/5434.v +++ /dev/null @@ -1,18 +0,0 @@ -(* About binders which remain unnamed after typing *) - -Global Set Asymmetric Patterns. - -Definition proj2_sig_map {A} {P Q : A -> Prop} (f : forall a, P a -> Q a) (x : -@sig A P) : @sig A Q - := let 'exist a p := x in exist Q a (f a p). -Axioms (feBW' : Type) (g : Prop -> Prop) (f' : feBW' -> Prop). -Definition foo := @proj2_sig_map feBW' (fun H => True = f' _) (fun H => - g True = g (f' H)) - (fun (a : feBW') (p : (fun H : feBW' => True = - f' H) a) => @f_equal Prop Prop g True (f' a) p). -Print foo. -Goal True. - lazymatch type of foo with - | sig (fun a : ?A => ?P) -> _ - => pose (fun a : A => a = a /\ P = P) - end. diff --git a/test-suite/bugs/closed/5435.v b/test-suite/bugs/closed/5435.v deleted file mode 100644 index 60ace5ce96..0000000000 --- a/test-suite/bugs/closed/5435.v +++ /dev/null @@ -1,2 +0,0 @@ -Definition foo (x : nat) := Eval native_compute in x. - diff --git a/test-suite/bugs/closed/5449.v b/test-suite/bugs/closed/5449.v deleted file mode 100644 index d7fc2aaa00..0000000000 --- a/test-suite/bugs/closed/5449.v +++ /dev/null @@ -1,6 +0,0 @@ -(* An example of decide equality which was failing due to a lhs dep into the rhs *) - -Require Import Coq.PArith.BinPos. -Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}. -intros. -decide equality. diff --git a/test-suite/bugs/closed/5476.v b/test-suite/bugs/closed/5476.v deleted file mode 100644 index b2d9d943bc..0000000000 --- a/test-suite/bugs/closed/5476.v +++ /dev/null @@ -1,28 +0,0 @@ -Require Setoid. - -Goal forall (P : Prop) (T : Type) (m m' : T) (T0 T1 : Type) (P2 : forall _ : -Prop, Prop) - (P0 : Set) (x0 : P0) (P1 : forall (_ : P0) (_ : T), Prop) - (P3 : forall (_ : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (_ : -T) (_ : Prop), Prop) - (o : forall _ : P0, option T1) - (_ : P3 - (fun (k : P0) (_ : T0) (_ : Prop) => - match o k return Prop with - | Some _ => True - | None => False - end) m' P) (_ : P2 (P1 x0 m)) - (_ : forall (f : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (m1 m2 -: T) - (k : P0) (e : T0) (_ : P2 (P1 k m1)), iff (P3 f m2 P) -(f k e (P3 f m1 P))), False. -Proof. - intros ???????????? H0 H H1. - rewrite H1 in H0; eauto with nocore. - { lazymatch goal with - | H : match ?X with _ => _ end |- _ - => first [ lazymatch goal with - | [ H' : context[X] |- _ ] => idtac H - end - | fail 1 "could not find" X ] - end. diff --git a/test-suite/bugs/closed/5486.v b/test-suite/bugs/closed/5486.v deleted file mode 100644 index 390133162f..0000000000 --- a/test-suite/bugs/closed/5486.v +++ /dev/null @@ -1,15 +0,0 @@ -Axiom proof_admitted : False. -Tactic Notation "admit" := abstract case proof_admitted. -Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k : - forall _ : T, Fm), - @eq Fm - (k - match p return T with - | pair p0 swap => fst p0 - end) f. - intros. - (* next statement failed in Bug 5486 *) - match goal with - | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ] - => pose (let (a, b) := d in e a b) as t0 - end. diff --git a/test-suite/bugs/closed/5487.v b/test-suite/bugs/closed/5487.v deleted file mode 100644 index 9b995f4503..0000000000 --- a/test-suite/bugs/closed/5487.v +++ /dev/null @@ -1,9 +0,0 @@ -(* Was a collision between an ltac pattern variable and an evar *) - -Goal forall n, exists m, n = m :> nat. -Proof. - eexists. - Fail match goal with - | [ |- ?x = ?y ] - => match x with y => idtac end - end. diff --git a/test-suite/bugs/closed/5501.v b/test-suite/bugs/closed/5501.v deleted file mode 100644 index 24739a3658..0000000000 --- a/test-suite/bugs/closed/5501.v +++ /dev/null @@ -1,21 +0,0 @@ -Set Universe Polymorphism. - -Record Pred@{A} := - { car :> Type@{A} - ; P : car -> Prop - }. - -Class All@{A} (A : Pred@{A}) : Type := - { proof : forall (a : A), P A a - }. - -Record Pred_All@{A} : Type := - { P' :> Pred@{A} - ; P'_All : All P' - }. - -Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A. - -Definition Pred_All_proof {A : Pred_All} (a : A) : P A a. -Proof. -solve[auto using proof]. diff --git a/test-suite/bugs/closed/5547.v b/test-suite/bugs/closed/5547.v deleted file mode 100644 index 79633f4893..0000000000 --- a/test-suite/bugs/closed/5547.v +++ /dev/null @@ -1,16 +0,0 @@ -(* Checking typability of intermediate return predicates in nested pattern-matching *) - -Inductive A : (Type->Type) -> Type := J : A (fun x => x). -Definition ret (x : nat * A (fun x => x)) - := match x return Type with - | (y,z) => match z in A f return f Type with - | J => bool - end - end. -Definition foo : forall x, ret x. -Proof. -Fail refine (fun x - => match x return ret x with - | (y,J) => true - end - ). diff --git a/test-suite/bugs/closed/5578.v b/test-suite/bugs/closed/5578.v deleted file mode 100644 index b9f0bc45c6..0000000000 --- a/test-suite/bugs/closed/5578.v +++ /dev/null @@ -1,57 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 1549 lines to 298 lines, then from 277 lines to 133 lines, then from 985 lines to 138 lines, then from 206 lines to 139 lines, then from 203 lines to 142 lines, then from 262 lines to 152 lines, then from 567 lines to 151 lines, then from 3746 lines to 151 lines, then from 577 lines to 151 lines, then from 187 lines to 151 lines, thenfrom 981 lines to 940 lines, then from 938 lines to 175 lines, then from 589 lines to 205 lines, then from 3797 lines to 205 lines, then from 628 lines to 206 lines, then from 238 lines to 205 lines, then from 1346 lines to 213 lines, then from 633 lines to 214 lines, then from 243 lines to 213 lines, then from 5656 lines to 245 lines, then from 661 lines to 272 lines, then from 3856 lines to 352 lines, then from 1266 lines to 407 lines, then from 421 lines to 406 lines, then from 424 lines to 91 lines, then from 105 lines to 91 lines, then from 85 lines to 55 lines, then from 69 lines to 55 lines *) -(* coqc version trunk (May 2017) compiled on May 30 2017 13:28:59 with OCaml -4.02.3 - coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-trunk,trunk (fd36c0451c26e44b1b7e93299d3367ad2d35fee3) *) - -Class Proper {A} (R : A -> A -> Prop) (m : A) := mkp : R m m. -Definition respectful {A B} (R : A -> A -> Prop) (R' : B -> B -> Prop) (f g : A -> B) := forall x y, R x y -> R' (f x) (g y). -Set Implicit Arguments. - -Class EqDec (A : Set) := { - eqb : A -> A -> bool ; - eqb_leibniz : forall x y, eqb x y = true <-> x = y -}. - -Infix "?=" := eqb (at level 70) : eq_scope. - -Inductive Comp : Set -> Type := -| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A. - -Open Scope eq_scope. - -Goal forall (Rat : Set) (PositiveMap_t : Set -> Set) - type (t : type) (interp_type_list_message interp_type_rand interp_type_message : nat -> Set), - (forall eta : nat, PositiveMap_t (interp_type_rand eta) -> interp_type_list_message eta -> interp_type_message eta) -> - ((nat -> Rat) -> Prop) -> - forall (interp_type_sbool : nat -> Set) (interp_type0 : type -> nat -> Set), - (forall eta : nat, - (interp_type_list_message eta -> interp_type_message eta) -> PositiveMap_t (interp_type_rand eta) -> interp_type0 t eta) - -> (forall (t0 : type) (eta : nat), EqDec (interp_type0 t0 eta)) - -> (bool -> Comp bool) -> False. - clear. - intros Rat PositiveMap_t type t interp_type_list_message interp_type_rand interp_type_message adv negligible interp_type_sbool - interp_type interp_term_fixed_t_x - EqDec_interp_type ret_bool. - assert (forall f adv' k - (lem : forall (eta : nat) (evil_rands rands : PositiveMap_t -(interp_type_rand eta)), - (interp_term_fixed_t_x eta (adv eta evil_rands) rands - ?= interp_term_fixed_t_x eta (adv eta evil_rands) rands) = true), - (forall (eta : nat), Proper (respectful eq eq) (f eta)) - -> negligible - (fun eta : nat => - f eta ( - (Bind (k eta) (fun rands => - ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). - Undo. - assert (forall f adv' k - (lem : forall (eta : nat) (rands : PositiveMap_t -(interp_type_rand eta)), - (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands) = true), - (forall (eta : nat), Proper (respectful eq eq) (f eta)) - -> negligible - (fun eta : nat => - f eta ( - (Bind (k eta) (fun rands => - ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). - (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *) diff --git a/test-suite/bugs/closed/5608.v b/test-suite/bugs/closed/5608.v deleted file mode 100644 index f02eae69c2..0000000000 --- a/test-suite/bugs/closed/5608.v +++ /dev/null @@ -1,33 +0,0 @@ -Reserved Notation "'slet' x .. y := A 'in' b" - (at level 200, x binder, y binder, b at level 200, format "'slet' x .. y := A 'in' '//' b"). -Reserved Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" - (at level 200, format "T x [1] = { A } ; '//' 'return' ( b0 , b1 , .. , b2 )"). - -Delimit Scope ctype_scope with ctype. -Local Open Scope ctype_scope. -Delimit Scope expr_scope with expr. -Inductive base_type := TZ | TWord (logsz : nat). -Inductive flat_type := Tbase (T : base_type) | Prod (A B : flat_type). -Context {var : base_type -> Type}. -Fixpoint interp_flat_type (interp_base_type : base_type -> Type) (t : -flat_type) := - match t with - | Tbase t => interp_base_type t - | Prod x y => prod (interp_flat_type interp_base_type x) (interp_flat_type -interp_base_type y) - end. -Inductive exprf : flat_type -> Type := -| Var {t} (v : var t) : exprf (Tbase t) -| LetIn {tx} (ex : exprf tx) {tC} (eC : interp_flat_type var tx -> exprf tC) : -exprf tC -| Pair {tx} (ex : exprf tx) {ty} (ey : exprf ty) : exprf (Prod tx ty). -Global Arguments Var {_} _. -Global Arguments LetIn {_} _ {_} _. -Global Arguments Pair {_} _ {_} _. -Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" := (LetIn (tx:=T) A -(fun x => Pair .. (Pair b0%expr b1%expr) .. b2%expr)) : expr_scope. -Definition foo := - (fun x3 => - (LetIn (Var x3) (fun x18 : var TZ - => (Pair (Var x18) (Var x18))))). -Print foo. diff --git a/test-suite/bugs/closed/5666.v b/test-suite/bugs/closed/5666.v deleted file mode 100644 index d55a6e57b4..0000000000 --- a/test-suite/bugs/closed/5666.v +++ /dev/null @@ -1,4 +0,0 @@ -Inductive foo := Foo : False -> foo. -Goal foo. -try (constructor ; fail 0). -Fail try (constructor ; fail 1). diff --git a/test-suite/bugs/closed/5671.v b/test-suite/bugs/closed/5671.v deleted file mode 100644 index c9a085045a..0000000000 --- a/test-suite/bugs/closed/5671.v +++ /dev/null @@ -1,7 +0,0 @@ -(* Fixing Meta-unclean specialize *) - -Require Import Setoid. -Axiom a : forall x, x=0 -> True. -Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. -specialize a with (1:=H). clear H x. intros _. -setoid_rewrite H0. diff --git a/test-suite/bugs/closed/5707.v b/test-suite/bugs/closed/5707.v deleted file mode 100644 index 785844c66d..0000000000 --- a/test-suite/bugs/closed/5707.v +++ /dev/null @@ -1,12 +0,0 @@ -(* Destruct and primitive projections *) - -(* Checking the (superficial) part of #5707: - "destruct" should be able to use non-dependent case analysis when - dependent case analysis is not available and unneeded *) - -Set Primitive Projections. - -Inductive foo := Foo { proj1 : nat; proj2 : nat }. - -Goal forall x : foo, True. -Proof. intros x. destruct x. diff --git a/test-suite/bugs/closed/5741.v b/test-suite/bugs/closed/5741.v deleted file mode 100644 index f6598f192d..0000000000 --- a/test-suite/bugs/closed/5741.v +++ /dev/null @@ -1,4 +0,0 @@ -(* Check no anomaly in info_trivial *) - -Goal True. -info_trivial. diff --git a/test-suite/bugs/closed/5749.v b/test-suite/bugs/closed/5749.v deleted file mode 100644 index 81bfe351c5..0000000000 --- a/test-suite/bugs/closed/5749.v +++ /dev/null @@ -1,18 +0,0 @@ -(* Checking computation of free vars of a term for generalization *) - -Definition Decision := fun P : Prop => {P} + {~ P}. -Class SetUnfold (P Q : Prop) : Prop := Build_SetUnfold { set_unfold : P <-> Q -}. - -Section Filter_Help. - - Context {A: Type}. - Context (fold_right : forall A B : Type, (B -> A -> A) -> A -> list B -> A). - Definition lType2 := (sigT (fun (P : A -> Prop) => forall a, Decision (P -a))). - Definition test (X: lType2) := let (x, _) := X in x. - - Global Instance foo `{fhl1 : list lType2} m Q: - SetUnfold (Q) - (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P -m)) (Q) (fhl1)). diff --git a/test-suite/bugs/closed/5750.v b/test-suite/bugs/closed/5750.v deleted file mode 100644 index 6d0e21f5d0..0000000000 --- a/test-suite/bugs/closed/5750.v +++ /dev/null @@ -1,3 +0,0 @@ -(* Check printability of the hole of the context *) -Goal 0 = 0. -match goal with |- context c [0] => idtac c end. diff --git a/test-suite/bugs/closed/5757.v b/test-suite/bugs/closed/5757.v deleted file mode 100644 index 0d0f2eed44..0000000000 --- a/test-suite/bugs/closed/5757.v +++ /dev/null @@ -1,76 +0,0 @@ -(* Check that resolved status of evars follows "restrict" *) - -Axiom H : forall (v : nat), Some 0 = Some v -> True. -Lemma L : True. -eapply H with _; -match goal with - | |- Some 0 = Some ?v => change (Some (0+0) = Some v) -end. -Abort. - -(* The original example *) - -Set Default Proof Using "Type". - -Module heap_lang. - -Inductive expr := - | InjR (e : expr). - -Inductive val := - | InjRV (v : val). - -Bind Scope val_scope with val. - -Fixpoint of_val (v : val) : expr := - match v with - | InjRV v => InjR (of_val v) - end. - -Fixpoint to_val (e : expr) : option val := None. - -End heap_lang. -Export heap_lang. - -Module W. -Inductive expr := - | Val (v : val) - (* Sums *) - | InjR (e : expr). - -Fixpoint to_expr (e : expr) : heap_lang.expr := - match e with - | Val v => of_val v - | InjR e => heap_lang.InjR (to_expr e) - end. - -End W. - - - -Section Tests. - - Context (iProp: Type). - Context (WPre: expr -> Prop). - - Context (tac_wp_alloc : - forall (e : expr) (v : val), - to_val e = Some v -> WPre e). - - Lemma push_atomic_spec (x: val) : - WPre (InjR (of_val x)). - Proof. -(* This works. *) -eapply tac_wp_alloc with _. -match goal with - | |- to_val ?e = Some ?v => - change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) -end. -Undo. Undo. -(* This is fixed *) -eapply tac_wp_alloc with _; -match goal with - | |- to_val ?e = Some ?v => - change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) -end. -Abort. diff --git a/test-suite/bugs/closed/5786.v b/test-suite/bugs/closed/5786.v deleted file mode 100644 index 20301ec4f5..0000000000 --- a/test-suite/bugs/closed/5786.v +++ /dev/null @@ -1,29 +0,0 @@ -(* Printing all kinds of Ltac generic arguments *) - -Tactic Notation "myidtac" string(v) := idtac v. -Goal True. -myidtac "foo". -Abort. - -Tactic Notation "myidtac2" ref(c) := idtac c. -Goal True. -myidtac2 True. -Abort. - -Tactic Notation "myidtac3" preident(s) := idtac s. -Goal True. -myidtac3 foo. -Abort. - -Tactic Notation "myidtac4" int_or_var(n) := idtac n. -Goal True. -myidtac4 3. -Abort. - -Tactic Notation "myidtac5" ident(id) := idtac id. -Goal True. -myidtac5 foo. -Abort. - - - diff --git a/test-suite/bugs/closed/5797.v b/test-suite/bugs/closed/5797.v deleted file mode 100644 index ee5ec1fa6a..0000000000 --- a/test-suite/bugs/closed/5797.v +++ /dev/null @@ -1,213 +0,0 @@ -Set Implicit Arguments. - -Open Scope type_scope. - -Inductive One : Set := inOne: One. - -Definition maybe: forall A B:Set,(A -> B) -> One + A -> One + B. -Proof. - intros A B f c. - case c. - left; assumption. - right; apply f; assumption. -Defined. - -Definition id (A:Set)(a:A):=a. - -Definition LamF (X: Set -> Set)(A:Set) :Set := - A + (X A)*(X A) + X(One + A). - -Definition LamF' (X: Set -> Set)(A:Set) :Set := - LamF X A. - -Require Import List. -Require Import Bool. - -Definition index := list bool. - -Inductive L (A:Set) : index -> Set := - initL: A -> L A nil - | pluslL: forall l:index, One -> L A (false::l) - | plusrL: forall l:index, L A l -> L A (false::l) - | varL: forall l:index, L A l -> L A (true::l) - | appL: forall l:index, L A (true::l) -> L A (true::l) -> L A (true::l) - | absL: forall l:index, L A (true::false::l) -> L A (true::l). - -Scheme L_rec_simp := Minimality for L Sort Set. - -Definition Lam' (A:Set) := L A (true::nil). - -Definition aczelapp: forall (l1 l2: index)(A:Set), L (L A l2) l1 -> L A - (l1++l2). -Proof. - intros l1 l2 A. - generalize l1. - clear l1. - (* Check (fun i:index => L A (i++l2)). *) - apply (L_rec_simp (A:=L A l2) (fun i:index => L A (i++l2))). - trivial. - intros l o. - simpl app. - apply pluslL; assumption. - intros l _ t. - simpl app. - apply plusrL; assumption. - intros l _ t. - simpl app. - apply varL; assumption. - intros l _ t1 _ t2. - simpl app in *|-*. - Check 0. - apply appL; [exact t1| exact t2]. - intros l _ t. - simpl app in *|-*. - Check 0. - apply absL; assumption. -Defined. - -Definition monL: forall (l:index)(A:Set)(B:Set), (A->B) -> L A l -> L B l. -Proof. - intros l A B f. - intro t. - elim t. - intro a. - exact (initL (f a)). - intros i u. - exact (pluslL _ _ u). - intros i _ r. - exact (plusrL r). - intros i _ r. - exact (varL r). - intros i _ r1 _ r2. - exact (appL r1 r2). - intros i _ r. - exact (absL r). -Defined. - -Definition lam': forall (A B:Set), (A -> B) -> Lam' A -> Lam' B. -Proof. - intros A B f t. - unfold Lam' in *|-*. - Check 0. - exact (monL f t). -Defined. - -Definition inLam': forall A:Set, LamF' Lam' A -> Lam' A. -Proof. - intros A [[a|[t1 t2]]|r]. - unfold Lam'. - exact (varL (initL a)). - exact (appL t1 t2). - unfold Lam' in * |- *. - Check 0. - apply absL. - change (L A ((true::nil) ++ (false::nil))). - apply aczelapp. - (* Check (fun x:One + A => (match (maybe (fun a:A => initL a) x) with - | inl u => pluslL _ _ u - | inr t' => plusrL t' end)). *) - exact (monL (fun x:One + A => - (match (maybe (fun a:A => initL a) x) with - | inl u => pluslL _ _ u - | inr t' => plusrL t' end)) r). -Defined. - -Section minimal. - -Definition sub1 (F G: Set -> Set):= forall A:Set, F A->G A. -Hypothesis G: Set -> Set. -Hypothesis step: sub1 (LamF' G) G. - -Fixpoint L'(A:Set)(i:index){struct i} : Set := - match i with - nil => A - | false::l => One + L' A l - | true::l => G (L' A l) - end. - -Definition LinL': forall (A:Set)(i:index), L A i -> L' A i. -Proof. - intros A i t. - elim t. - intro a. - unfold L'. - assumption. - intros l u. - left; assumption. - intros l _ r. - right; assumption. - intros l _ r. - apply (step (A:=L' A l)). - exact (inl _ (inl _ r)). - intros l _ r1 _ r2. - apply (step (A:=L' A l)). - (* unfold L' in * |- *. - Check 0. *) - exact (inl _ (inr _ (pair r1 r2))). - intros l _ r. - apply (step (A:=L' A l)). - exact (inr _ r). -Defined. - -Definition L'inG: forall A: Set, L' A (true::nil) -> G A. -Proof. - intros A t. - unfold L' in t. - assumption. -Defined. - -Definition Itbasic: sub1 Lam' G. -Proof. - intros A t. - apply L'inG. - unfold Lam' in t. - exact (LinL' t). -Defined. - -End minimal. - -Definition recid := Itbasic inLam'. - -Definition L'Lam'inL: forall (i:index)(A:Set), L' Lam' A i -> L A i. -Proof. - intros i A t. - induction i. - unfold L' in t. - apply initL. - assumption. - induction a. - simpl L' in t. - apply (aczelapp (l1:=true::nil) (l2:=i)). - exact (lam' IHi t). - simpl L' in t. - induction t. - exact (pluslL _ _ a). - exact (plusrL (IHi b)). -Defined. - - -Lemma recidgen: forall(A:Set)(i:index)(t:L A i), L'Lam'inL i A (LinL' inLam' t) - = t. -Proof. - intros A i t. - induction t. - trivial. - trivial. - simpl. - rewrite IHt. - trivial. - simpl L'Lam'inL. - rewrite IHt. - trivial. - simpl L'Lam'inL. - simpl L'Lam'inL in IHt1. - unfold lam' in IHt1. - simpl L'Lam'inL in IHt2. - unfold lam' in IHt2. - - (* going on. This fails for the original solution. *) - rewrite IHt1. - rewrite IHt2. - trivial. -Abort. (* one goal still left *) - diff --git a/test-suite/bugs/closed/5940.v b/test-suite/bugs/closed/5940.v deleted file mode 100644 index 32c78b4b9e..0000000000 --- a/test-suite/bugs/closed/5940.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Setoid. - -Parameter P : nat -> Prop. -Parameter Q : nat -> Prop. -Parameter PQ : forall n, P n <-> Q n. - -Lemma PQ2 : forall n, P n -> Q n. - intros. - rewrite PQ in H. - trivial. -Qed. - diff --git a/test-suite/bugs/closed/6534.v b/test-suite/bugs/closed/6534.v deleted file mode 100644 index f5013994c5..0000000000 --- a/test-suite/bugs/closed/6534.v +++ /dev/null @@ -1,7 +0,0 @@ -Goal forall x : nat, x = x. -Proof. -intros x. -refine ((fun x x => _ tt) tt tt). -let t := match goal with [ |- ?P ] => P end in -let _ := type of t in -idtac. diff --git a/test-suite/bugs/closed/6631.v b/test-suite/bugs/closed/6631.v deleted file mode 100644 index 100dc13fc8..0000000000 --- a/test-suite/bugs/closed/6631.v +++ /dev/null @@ -1,7 +0,0 @@ -Require Import Coq.derive.Derive. - -Derive f SuchThat (f = 1 + 1) As feq. -Proof. - transitivity 2; [refine (eq_refl 2)|]. - transitivity 2. - 2:abstract exact (eq_refl 2). diff --git a/test-suite/bugs/closed/7392.v b/test-suite/bugs/closed/7392.v deleted file mode 100644 index cf465c6588..0000000000 --- a/test-suite/bugs/closed/7392.v +++ /dev/null @@ -1,9 +0,0 @@ -Inductive R : nat -> Prop := ER : forall n, R n -> R (S n). - -Goal (forall (n : nat), R n -> False) -> True -> False. -Proof. -intros H0 H1. -eapply H0. -clear H1. -apply ER. -simpl. diff --git a/test-suite/bugs/closed/8553.v b/test-suite/bugs/closed/8553.v new file mode 100644 index 0000000000..4a1afabe89 --- /dev/null +++ b/test-suite/bugs/closed/8553.v @@ -0,0 +1,7 @@ +(* Using tactic "change" under binders *) + +Definition add2 n := n +2. +Goal (fun n => n) = (fun n => n+2). +change (?n + 2) with (add2 n). +match goal with |- _ = (fun n => add2 n) => idtac end. (* To test the presence of add2 *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_002.v b/test-suite/bugs/closed/HoTT_coq_002.v index dba4d5998f..fbafc97580 100644 --- a/test-suite/bugs/closed/HoTT_coq_002.v +++ b/test-suite/bugs/closed/HoTT_coq_002.v @@ -31,3 +31,4 @@ F : @SpecializedFunctor (* Top.516 *) objC C The term "F" has type "@SpecializedFunctor (* Top.516 *) objC C" while it is expected to have type "@SpecializedFunctor (* Top.519 Top.520 *) objC C". *) +End FunctorInterface. diff --git a/test-suite/bugs/closed/HoTT_coq_014.v b/test-suite/bugs/closed/HoTT_coq_014.v index 5c45036643..35f8701b2f 100644 --- a/test-suite/bugs/closed/HoTT_coq_014.v +++ b/test-suite/bugs/closed/HoTT_coq_014.v @@ -200,3 +200,4 @@ Polymorphic Definition UnderlyingGraphFunctor_MorphismOf (C D : SmallCategory) ( Morphism (FunctorCategory GraphIndexingCategory TypeCat) (UnderlyingGraph C) (UnderlyingGraph D). (* Anomaly: apply_coercion. Please report.*) Proof. Admitted. +End test. diff --git a/test-suite/bugs/closed/HoTT_coq_028.v b/test-suite/bugs/closed/HoTT_coq_028.v index b03241402f..99bde6d7c0 100644 --- a/test-suite/bugs/closed/HoTT_coq_028.v +++ b/test-suite/bugs/closed/HoTT_coq_028.v @@ -12,3 +12,4 @@ Error: Cannot instantiate metavariable P of type match eq_sym e in (_ = y) return (T (f y) (f x)) with | eq_refl => m (f x) end = m (f x)" of incompatible type "forall x : O, x = x -> Prop". *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_042.v b/test-suite/bugs/closed/HoTT_coq_042.v index 432cf7054f..e2eedd16e3 100644 --- a/test-suite/bugs/closed/HoTT_coq_042.v +++ b/test-suite/bugs/closed/HoTT_coq_042.v @@ -26,3 +26,4 @@ Let SetCatFoo' : Foo. (* Toplevel input, characters 15-20: Error: Universe inconsistency (cannot enforce Set <= Prop). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_044.v b/test-suite/bugs/closed/HoTT_coq_044.v index c824f53ba8..78b675eab9 100644 --- a/test-suite/bugs/closed/HoTT_coq_044.v +++ b/test-suite/bugs/closed/HoTT_coq_044.v @@ -33,3 +33,4 @@ r2 : Row (* Top.56 Top.57 *) Ts The term "Row (* Coq.Init.Logic.8 Top.59 *) Ts" has type "Type (* max(Top.58+1, Top.59) *)" while it is expected to have type "Type (* Coq.Init.Logic.8 *)" (Universe inconsistency). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_047.v b/test-suite/bugs/closed/HoTT_coq_047.v index bef3c33ca1..219689f9fc 100644 --- a/test-suite/bugs/closed/HoTT_coq_047.v +++ b/test-suite/bugs/closed/HoTT_coq_047.v @@ -46,3 +46,4 @@ Proof. destruct n0. destruct cr. (* Anomaly: Evar ?nnn was not declared. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_049.v b/test-suite/bugs/closed/HoTT_coq_049.v index 906ec329e0..31e7861de4 100644 --- a/test-suite/bugs/closed/HoTT_coq_049.v +++ b/test-suite/bugs/closed/HoTT_coq_049.v @@ -4,3 +4,4 @@ Goal forall y, @f_equal = y. intro. apply functional_extensionality_dep. (* Error: Ill-typed evar instance in HoTT/coq, Anomaly: Uncaught exception Reductionops.NotASort(_). Please report. before that. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_057.v b/test-suite/bugs/closed/HoTT_coq_057.v index e72ce0c5ec..1405232b8e 100644 --- a/test-suite/bugs/closed/HoTT_coq_057.v +++ b/test-suite/bugs/closed/HoTT_coq_057.v @@ -31,3 +31,4 @@ Proof. Set Printing Universes. try (apply IHsub in X). (* Toplevel input, characters 5-21: Error: Universe inconsistency (cannot enforce Top.47 = Set). *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_058.v b/test-suite/bugs/closed/HoTT_coq_058.v index 3d16e7ac0d..09e4365ebe 100644 --- a/test-suite/bugs/closed/HoTT_coq_058.v +++ b/test-suite/bugs/closed/HoTT_coq_058.v @@ -139,3 +139,4 @@ let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in rewrite transport_path_prod'_beta'. (* Anomaly: Uncaught exception Invalid_argument("to_constraints: non-trivial algebraic constraint between universes", _). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_059.v b/test-suite/bugs/closed/HoTT_coq_059.v index 2e6c735cf5..9800ba8e45 100644 --- a/test-suite/bugs/closed/HoTT_coq_059.v +++ b/test-suite/bugs/closed/HoTT_coq_059.v @@ -15,3 +15,4 @@ Section foo. (* Toplevel input, characters 0-60: Error: Universe inconsistency (cannot enforce Top.24 <= Top.23 because Top.23 < Top.22 <= Top.24). *) +End foo. diff --git a/test-suite/bugs/closed/HoTT_coq_079.v b/test-suite/bugs/closed/HoTT_coq_079.v index e70de9ca99..7e782139ea 100644 --- a/test-suite/bugs/closed/HoTT_coq_079.v +++ b/test-suite/bugs/closed/HoTT_coq_079.v @@ -14,3 +14,4 @@ Hint Resolve H : bar. Goal forall y : foo, @x y = @x y. intro y. progress auto with bar. (* failed to progress *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_083.v b/test-suite/bugs/closed/HoTT_coq_083.v index 494b25c7b1..02c4b22a4d 100644 --- a/test-suite/bugs/closed/HoTT_coq_083.v +++ b/test-suite/bugs/closed/HoTT_coq_083.v @@ -27,3 +27,4 @@ generalize dependent (@ob C). intros T t. (* Toplevel input, characters 9-10: Error: No product even after head-reduction. *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_099.v b/test-suite/bugs/closed/HoTT_coq_099.v index cd5b0c8ff6..a9119052cb 100644 --- a/test-suite/bugs/closed/HoTT_coq_099.v +++ b/test-suite/bugs/closed/HoTT_coq_099.v @@ -60,3 +60,4 @@ Top.168 <= Coq.Init.Datatypes.28 Top.169 <= Coq.Init.Datatypes.29 Top.169 <= Coq.Init.Datatypes.28 (maybe a bugged tactic). *) +End PreMonoidalCategory. diff --git a/test-suite/bugs/closed/HoTT_coq_100.v b/test-suite/bugs/closed/HoTT_coq_100.v index 663b6280e4..660283116d 100644 --- a/test-suite/bugs/closed/HoTT_coq_100.v +++ b/test-suite/bugs/closed/HoTT_coq_100.v @@ -150,3 +150,4 @@ cannot be applied to the terms Top.313 Top.314 Top.306 Top.316 Top.305 *)" The 4th term has type "Category (* Top.300 Set *) unit" which should be coercible to "Category (* Top.300 Top.307 *) unit". *) +End CommaCategoryProjectionFunctor. diff --git a/test-suite/bugs/closed/HoTT_coq_101.v b/test-suite/bugs/closed/HoTT_coq_101.v index 3ef56892be..777fd8600a 100644 --- a/test-suite/bugs/closed/HoTT_coq_101.v +++ b/test-suite/bugs/closed/HoTT_coq_101.v @@ -76,3 +76,4 @@ Section FullyFaithful. Check @FunctorProduct' C TypeCatC YC. (* Toplevel input, characters 0-37: Error: Universe inconsistency. Cannot enforce Top.187 = Top.186 because Top.186 <= Top.189 < Top.191 <= Top.187). *) +End FullyFaithful. diff --git a/test-suite/bugs/closed/HoTT_coq_112.v b/test-suite/bugs/closed/HoTT_coq_112.v index 5bee69fcde..c3ef2aa1a7 100644 --- a/test-suite/bugs/closed/HoTT_coq_112.v +++ b/test-suite/bugs/closed/HoTT_coq_112.v @@ -74,3 +74,4 @@ The 1st term has type "Univalence (* Top.934 Top.935 Top.936 Top.937 *)" which should be coercible to "Univalence (* Top.1003 Top.1003 Top.1001 Top.997 *)". *) +End Univalence. diff --git a/test-suite/bugs/closed/HoTT_coq_118.v b/test-suite/bugs/closed/HoTT_coq_118.v index e41689cba3..37b6ff66a1 100644 --- a/test-suite/bugs/closed/HoTT_coq_118.v +++ b/test-suite/bugs/closed/HoTT_coq_118.v @@ -34,3 +34,4 @@ p : tt = tt ?46 : "Contr_internal (idpath = p)" *) +Abort. diff --git a/test-suite/bugs/closed/HoTT_coq_120.v b/test-suite/bugs/closed/HoTT_coq_120.v index e46ea58bb3..a80d075f69 100644 --- a/test-suite/bugs/closed/HoTT_coq_120.v +++ b/test-suite/bugs/closed/HoTT_coq_120.v @@ -136,3 +136,5 @@ Section fully_faithful_helpers. Set Printing Universes. admit. (* Error: Universe inconsistency (cannot enforce Top.235 <= Set because Set < Top.235). *) + Abort. +End fully_faithful_helpers. diff --git a/test-suite/bugs/closed/HoTT_coq_123.v b/test-suite/bugs/closed/HoTT_coq_123.v index 7bed956f3e..f688f51222 100644 --- a/test-suite/bugs/closed/HoTT_coq_123.v +++ b/test-suite/bugs/closed/HoTT_coq_123.v @@ -174,3 +174,4 @@ Section FunctorSectionCategory. _); abstract (path_natural_transformation; admit). Defined. (* Stack overflow *) +End FunctorSectionCategory. diff --git a/test-suite/bugs/closed/1238.v b/test-suite/bugs/closed/bug_1238.v index 6b6e83779f..6b6e83779f 100644 --- a/test-suite/bugs/closed/1238.v +++ b/test-suite/bugs/closed/bug_1238.v diff --git a/test-suite/bugs/closed/bug_1243.v b/test-suite/bugs/closed/bug_1243.v new file mode 100644 index 0000000000..a80e1dd609 --- /dev/null +++ b/test-suite/bugs/closed/bug_1243.v @@ -0,0 +1,9 @@ +Require Import ZArith. +Require Import Arith. +Open Scope Z_scope. + +Theorem r_ex : (forall x y:nat, x + y = x + y)%nat. +Admitted. + +Theorem r_ex' : forall x y:nat, (x + y = x + y)%nat. +Admitted. diff --git a/test-suite/bugs/closed/bug_1302.v b/test-suite/bugs/closed/bug_1302.v new file mode 100644 index 0000000000..bea71f5022 --- /dev/null +++ b/test-suite/bugs/closed/bug_1302.v @@ -0,0 +1,21 @@ +Module Type T. + +Parameter A : Type. + +Inductive L : Type := +| L0 : L (* without this constructor, it works right *) +| L1 : A -> L. + +End T. + +Axiom Tp : Type. + +Module TT : T. + +Definition A : Type := Tp. + +Inductive L : Type := +| L0 : L +| L1 : A -> L. + +End TT. diff --git a/test-suite/bugs/closed/1322.v b/test-suite/bugs/closed/bug_1322.v index 6941ade44c..6941ade44c 100644 --- a/test-suite/bugs/closed/1322.v +++ b/test-suite/bugs/closed/bug_1322.v diff --git a/test-suite/bugs/closed/bug_1341.v b/test-suite/bugs/closed/bug_1341.v new file mode 100644 index 0000000000..9bdfffea3e --- /dev/null +++ b/test-suite/bugs/closed/bug_1341.v @@ -0,0 +1,19 @@ +Require Import Setoid. + +Section Setoid_Bug. + +Variable X:Type -> Type. +Variable Xeq : forall A, (X A) -> (X A) -> Prop. +Hypothesis Xst : forall A, Equivalence (Xeq A). + +Variable map : forall A B, (A -> B) -> X A -> X B. + +Arguments map [A B]. + +Goal forall A B (a b:X (B -> A)) (c:X A) (f:A -> B -> A), Xeq _ a b -> Xeq _ b (map f c) -> Xeq _ a (map f c). +intros A B a b c f Hab Hbc. +rewrite Hab. +assumption. +Qed. + +End Setoid_Bug. diff --git a/test-suite/bugs/closed/1362.v b/test-suite/bugs/closed/bug_1362.v index 6cafb9f0cd..6cafb9f0cd 100644 --- a/test-suite/bugs/closed/1362.v +++ b/test-suite/bugs/closed/bug_1362.v diff --git a/test-suite/bugs/closed/bug_1411.v b/test-suite/bugs/closed/bug_1411.v new file mode 100644 index 0000000000..504c967a20 --- /dev/null +++ b/test-suite/bugs/closed/bug_1411.v @@ -0,0 +1,34 @@ +Require Import List. +Require Import Program. + +Inductive Tree : Set := +| Br : Tree -> Tree -> Tree +| No : nat -> Tree +. + +(* given a tree, we want to know which lists can + be used to navigate exactly to a node *) +Inductive Exact : Tree -> list bool -> Prop := +| exDone n : Exact (No n) nil +| exLeft l r p: Exact l p -> Exact (Br l r) (true::p) +| exRight l r p: Exact r p -> Exact (Br l r) (false::p) +. + +Definition unreachable A : False -> A. +intros. +destruct H. +Defined. + +Program Fixpoint fetch t p (x:Exact t p) {struct t} := + match t, p with + | No p' , nil => p' + | No p' , _::_ => unreachable nat _ + | Br l r, nil => unreachable nat _ + | Br l r, true::t => fetch l t _ + | Br l r, false::t => fetch r t _ + end. + +Next Obligation. inversion x. Qed. +Next Obligation. inversion x. Qed. +Next Obligation. inversion x; trivial. Qed. +Next Obligation. inversion x; trivial. Qed. diff --git a/test-suite/bugs/closed/bug_1414.v b/test-suite/bugs/closed/bug_1414.v new file mode 100644 index 0000000000..ab490fa315 --- /dev/null +++ b/test-suite/bugs/closed/bug_1414.v @@ -0,0 +1,41 @@ +Require Import ZArith Coq.Program.Wf Coq.Program.Utils. + +Parameter data:Set. + +Inductive t : Set := + | Leaf : t + | Node : t -> data -> t -> Z -> t. + +Parameter avl : t -> Prop. +Parameter bst : t -> Prop. +Parameter In : data -> t -> Prop. +Parameter cardinal : t -> nat. +Definition card2 (s:t*t) := let (s1,s2) := s in cardinal s1 + cardinal s2. + +Parameter split : data -> t -> t*(bool*t). +Parameter join : t -> data -> t -> t. +Parameter add : data -> t -> t. + +Program Fixpoint union + (s u:t) + (hb1: bst s)(ha1: avl s)(hb2: bst u)(hb2: avl u) + { measure (cardinal s + cardinal u) } : + {s' : t | bst s' /\ avl s' /\ forall x, In x s' <-> In x s \/ In x u} := + match s, u with + | Leaf,t2 => t2 + | t1,Leaf => t1 + | Node l1 v1 r1 h1, Node l2 v2 r2 h2 => + if (Z_ge_lt_dec h1 h2) then + if (Z.eq_dec h2 1) + then add v2 s + else + let (l2', r2') := split v1 u in + join (union l1 l2' _ _ _ _) v1 (union r1 (snd r2') _ _ _ _) + else + if (Z.eq_dec h1 1) + then add v1 s + else + let (l1', r1') := split v2 u in + join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _) + end. +Reset union. diff --git a/test-suite/bugs/closed/bug_1416.v b/test-suite/bugs/closed/bug_1416.v new file mode 100644 index 0000000000..87ecce5c1d --- /dev/null +++ b/test-suite/bugs/closed/bug_1416.v @@ -0,0 +1,30 @@ +(* In 8.1 autorewrite used to raised an anomaly here *) +(* After resolution of the bug, autorewrite succeeded *) +(* From forthcoming 8.4, autorewrite is forbidden to instantiate *) +(* evars, so the new test just checks it is not an anomaly *) + +Set Implicit Arguments. + +Record Place (Env A: Type) : Type := { + read: Env -> A ; + write: Env -> A -> Env ; + write_read: forall (e:Env), (write e (read e))=e +}. + +Hint Rewrite -> write_read: placeeq. + +Record sumPl (Env A B: Type) (vL:(Place Env A)) (vR:(Place Env B)) : Type := + { + mkEnv: A -> B -> Env ; + mkEnv2writeL: forall (e:Env) (x:A), (mkEnv x (read vR e))=(write vL e x) + }. + +(* when the following line is commented, the bug does not appear *) +Hint Rewrite -> mkEnv2writeL: placeeq. + +Lemma autorewrite_raise_anomaly: forall (Env A:Type) (e: Env) (p:Place Env A), + (exists e1:Env, e=(write p e1 (read p e))). +Proof. + intros Env A e p; eapply ex_intro. + autorewrite with placeeq. (* Here is the bug *) +Abort. diff --git a/test-suite/bugs/closed/1419.v b/test-suite/bugs/closed/bug_1419.v index d021107d1d..d021107d1d 100644 --- a/test-suite/bugs/closed/1419.v +++ b/test-suite/bugs/closed/bug_1419.v diff --git a/test-suite/bugs/closed/1425.v b/test-suite/bugs/closed/bug_1425.v index 775d278e74..775d278e74 100644 --- a/test-suite/bugs/closed/1425.v +++ b/test-suite/bugs/closed/bug_1425.v diff --git a/test-suite/bugs/closed/1446.v b/test-suite/bugs/closed/bug_1446.v index 8cb2d653b6..8cb2d653b6 100644 --- a/test-suite/bugs/closed/1446.v +++ b/test-suite/bugs/closed/bug_1446.v diff --git a/test-suite/bugs/closed/1448.v b/test-suite/bugs/closed/bug_1448.v index fe3b4c8b41..fe3b4c8b41 100644 --- a/test-suite/bugs/closed/1448.v +++ b/test-suite/bugs/closed/bug_1448.v diff --git a/test-suite/bugs/closed/1477.v b/test-suite/bugs/closed/bug_1477.v index dfc8c32806..dfc8c32806 100644 --- a/test-suite/bugs/closed/1477.v +++ b/test-suite/bugs/closed/bug_1477.v diff --git a/test-suite/bugs/closed/bug_1483.v b/test-suite/bugs/closed/bug_1483.v new file mode 100644 index 0000000000..0d1419b94d --- /dev/null +++ b/test-suite/bugs/closed/bug_1483.v @@ -0,0 +1,7 @@ +Require Import BinPos. + +Definition P := (fun x : positive => x = xH). + +Goal forall (p q : positive), P q -> q = p -> P p. +intros; congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_1501.v b/test-suite/bugs/closed/bug_1501.v new file mode 100644 index 0000000000..64eea68c37 --- /dev/null +++ b/test-suite/bugs/closed/bug_1501.v @@ -0,0 +1,69 @@ +Set Implicit Arguments. + + +Require Export Relation_Definitions. +Require Export Setoid. +Require Import Morphisms. + + +Section Essais. + +(* Parametrized Setoid *) +Parameter K : Type -> Type. +Parameter equiv : forall A : Type, K A -> K A -> Prop. +Parameter equiv_refl : forall (A : Type) (x : K A), equiv x x. +Parameter equiv_sym : forall (A : Type) (x y : K A), equiv x y -> equiv y x. +Parameter equiv_trans : forall (A : Type) (x y z : K A), equiv x y -> equiv y z +-> equiv x z. + +(* basic operations *) +Parameter val : forall A : Type, A -> K A. +Parameter bind : forall A B : Type, K A -> (A -> K B) -> K B. + +Parameter + bind_compat : + forall (A B : Type) (m1 m2 : K A) (f1 f2 : A -> K B), + equiv m1 m2 -> + (forall x : A, equiv (f1 x) (f2 x)) -> equiv (bind m1 f1) (bind m2 f2). + +(* monad axioms *) +Parameter + bind_val_l : + forall (A B : Type) (a : A) (f : A -> K B), equiv (bind (val a) f) (f a). +Parameter + bind_val_r : + forall (A : Type) (m : K A), equiv (bind m (fun a => val a)) m. +Parameter + bind_assoc : + forall (A B C : Type) (m : K A) (f : A -> K B) (g : B -> K C), + equiv (bind (bind m f) g) (bind m (fun a => bind (f a) g)). + + +Hint Resolve equiv_refl equiv_sym equiv_trans: monad. + +Add Parametric Relation A : (K A) (@equiv A) + reflexivity proved by (@equiv_refl A) + symmetry proved by (@equiv_sym A) + transitivity proved by (@equiv_trans A) + as equiv_rel. + +Add Parametric Morphism A B : (@bind A B) + with signature (@equiv A) ==> (pointwise_relation A (@equiv B)) ==> (@equiv B) + as bind_mor. +Proof. + unfold pointwise_relation; intros; apply bind_compat; auto. +Qed. + +Lemma test: + forall (A B: Type) (m1 m2 m3: K A) (f: A -> A -> K B), + (equiv m1 m2) -> (equiv m2 m3) -> + equiv (bind m1 (fun a => bind m2 (fun a' => f a a'))) + (bind m2 (fun a => bind m3 (fun a' => f a a'))). +Proof. + intros A B m1 m2 m3 f H1 H2. + setoid_rewrite H1. (* this works *) + setoid_rewrite H2. + reflexivity. +Qed. + +End Essais. diff --git a/test-suite/bugs/closed/bug_1507.v b/test-suite/bugs/closed/bug_1507.v new file mode 100644 index 0000000000..96e421de64 --- /dev/null +++ b/test-suite/bugs/closed/bug_1507.v @@ -0,0 +1,119 @@ +(* + Implementing reals a la Stolzenberg + + Danko Ilik, March 2007 + + XField.v -- (unfinished) axiomatisation of the theories of real and + rational intervals. +*) + +Definition associative (A:Type)(op:A->A->A) := + forall x y z:A, op (op x y) z = op x (op y z). + +Definition commutative (A:Type)(op:A->A->A) := + forall x y:A, op x y = op y x. + +Definition trichotomous (A:Type)(R:A->A->Prop) := + forall x y:A, R x y \/ x=y \/ R y x. + +Definition relation (A:Type) := A -> A -> Prop. +Definition reflexive (A:Type)(R:relation A) := forall x:A, R x x. +Definition transitive (A:Type)(R:relation A) := + forall x y z:A, R x y -> R y z -> R x z. +Definition symmetric (A:Type)(R:relation A) := forall x y:A, R x y -> R y x. + +Record interval (X:Set)(le:X->X->Prop) : Set := + interval_make { + interval_left : X; + interval_right : X; + interval_nonempty : le interval_left interval_right + }. + +Record I (grnd:Set)(le:grnd->grnd->Prop) : Type := Imake { + Icar := interval grnd le; + Iplus : Icar -> Icar -> Icar; + Imult : Icar -> Icar -> Icar; + Izero : Icar; + Ione : Icar; + Iopp : Icar -> Icar; + Iinv : Icar -> Icar; + Ic : Icar -> Icar -> Prop; (* consistency *) + (* monoids *) + Iplus_assoc : associative Icar Iplus; + Imult_assoc : associative Icar Imult; + (* abelian groups *) + Iplus_comm : commutative Icar Iplus; + Imult_comm : commutative Icar Imult; + Iplus_0_l : forall x:Icar, Ic (Iplus Izero x) x; + Iplus_0_r : forall x:Icar, Ic (Iplus x Izero) x; + Imult_0_l : forall x:Icar, Ic (Imult Ione x) x; + Imult_0_r : forall x:Icar, Ic (Imult x Ione) x; + Iplus_opp_r : forall x:Icar, Ic (Iplus x (Iopp x)) (Izero); + Imult_inv_r : forall x:Icar, ~(Ic x Izero) -> Ic (Imult x (Iinv x)) Ione; + (* distributive laws *) + Imult_plus_distr_l : forall x x' y y' z z' z'', + Ic x x' -> Ic y y' -> Ic z z' -> Ic z z'' -> + Ic (Imult (Iplus x y) z) (Iplus (Imult x' z') (Imult y' z'')); + (* order and lattice structure *) + Ilt : Icar -> Icar -> Prop; + Ilc := fun (x y:Icar) => Ilt x y \/ Ic x y; + Isup : Icar -> Icar -> Icar; + Iinf : Icar -> Icar -> Icar; + Ilt_trans : transitive _ lt; + Ilt_trich : forall x y:Icar, Ilt x y \/ Ic x y \/ Ilt y x; + Isup_lub : forall x y z:Icar, Ilc x z -> Ilc y z -> Ilc (Isup x y) z; + Iinf_glb : forall x y z:Icar, Ilc x y -> Ilc x z -> Ilc x (Iinf y z); + (* order preserves operations? *) + (* properties of Ic *) + Ic_refl : reflexive _ Ic; + Ic_sym : symmetric _ Ic +}. + +Definition interval_set (X:Set)(le:X->X->Prop) := + (interval X le) -> Prop. (* can be Set as well *) +Check interval_set. +Check Ic. +Definition consistent (X:Set)(le:X->X->Prop)(TI:I X le)(p:interval_set X le) := + forall I J:interval X le, p I -> p J -> (Ic X le TI) I J. +Check consistent. +(* define 'fine' *) + +Record N (grnd:Set)(le:grnd->grnd->Prop)(grndI:I grnd le) : Type := Nmake { + Ncar := interval_set grnd le; + Nplus : Ncar -> Ncar -> Ncar; + Nmult : Ncar -> Ncar -> Ncar; + Nzero : Ncar; + None : Ncar; + Nopp : Ncar -> Ncar; + Ninv : Ncar -> Ncar; + Nc : Ncar -> Ncar -> Prop; (* Ncistency *) + (* monoids *) + Nplus_assoc : associative Ncar Nplus; + Nmult_assoc : associative Ncar Nmult; + (* abelian groups *) + Nplus_comm : commutative Ncar Nplus; + Nmult_comm : commutative Ncar Nmult; + Nplus_0_l : forall x:Ncar, Nc (Nplus Nzero x) x; + Nplus_0_r : forall x:Ncar, Nc (Nplus x Nzero) x; + Nmult_0_l : forall x:Ncar, Nc (Nmult None x) x; + Nmult_0_r : forall x:Ncar, Nc (Nmult x None) x; + Nplus_opp_r : forall x:Ncar, Nc (Nplus x (Nopp x)) (Nzero); + Nmult_inv_r : forall x:Ncar, ~(Nc x Nzero) -> Nc (Nmult x (Ninv x)) None; + (* distributive laws *) + Nmult_plus_distr_l : forall x x' y y' z z' z'', + Nc x x' -> Nc y y' -> Nc z z' -> Nc z z'' -> + Nc (Nmult (Nplus x y) z) (Nplus (Nmult x' z') (Nmult y' z'')); + (* order and lattice structure *) + Nlt : Ncar -> Ncar -> Prop; + Nlc := fun (x y:Ncar) => Nlt x y \/ Nc x y; + Nsup : Ncar -> Ncar -> Ncar; + Ninf : Ncar -> Ncar -> Ncar; + Nlt_trans : transitive _ lt; + Nlt_trich : forall x y:Ncar, Nlt x y \/ Nc x y \/ Nlt y x; + Nsup_lub : forall x y z:Ncar, Nlc x z -> Nlc y z -> Nlc (Nsup x y) z; + Ninf_glb : forall x y z:Ncar, Nlc x y -> Nlc x z -> Nlc x (Ninf y z); + (* order preserves operations? *) + (* properties of Nc *) + Nc_refl : reflexive _ Nc; + Nc_sym : symmetric _ Nc +}. diff --git a/test-suite/bugs/closed/1519.v b/test-suite/bugs/closed/bug_1519.v index de60de59e9..de60de59e9 100644 --- a/test-suite/bugs/closed/1519.v +++ b/test-suite/bugs/closed/bug_1519.v diff --git a/test-suite/bugs/closed/bug_1542.v b/test-suite/bugs/closed/bug_1542.v new file mode 100644 index 0000000000..1def7f4dba --- /dev/null +++ b/test-suite/bugs/closed/bug_1542.v @@ -0,0 +1,42 @@ +Module Type TITI. +Parameter B:Set. +Parameter x:B. +Inductive A:Set:= +a1:B->A. +Definition f2: A ->B +:= fun (a:A) => +match a with + (a1 b)=>b +end. +Definition f: A -> B:=fun (a:A) => x. +End TITI. + + +Module Type TIT. +Declare Module t:TITI. +End TIT. + +Module Seq(titi:TIT). +Module t:=titi.t. +Inductive toto:t.A->t.B->Set:= +t1:forall (a:t.A), (toto a (t.f a)) +| t2:forall (a:t.A), (toto a (t.f2 a)). +End Seq. + +Module koko(tit:TIT). +Module seq:=Seq tit. +Module t':=tit.t. + +Definition def:forall (a:t'.A), (seq.toto a (t'.f a)). +intro ; constructor 1. +Defined. + +Definition def2: forall (a:t'.A), (seq.toto a (t'.f2 a)). +intro; constructor 2. +(* Toplevel input, characters 0-13 + constructor 2. + ^^^^^^^^^^^^^ +Error: Impossible to unify (seq.toto ?3 (seq.t.f2 ?3)) with + (seq.toto a (t'.f2 a)).*) +Abort. +End koko. diff --git a/test-suite/bugs/closed/1543.v b/test-suite/bugs/closed/bug_1543.v index def6ed98dd..def6ed98dd 100644 --- a/test-suite/bugs/closed/1543.v +++ b/test-suite/bugs/closed/bug_1543.v diff --git a/test-suite/bugs/closed/bug_1545.v b/test-suite/bugs/closed/bug_1545.v new file mode 100644 index 0000000000..91ce4a76af --- /dev/null +++ b/test-suite/bugs/closed/bug_1545.v @@ -0,0 +1,22 @@ +Module Type TIT. + +Inductive X:Set:= + b:X. +End TIT. + + +Module Type TOTO. +Declare Module t:TIT. +Inductive titi:Set:= + a:t.X->titi. +End TOTO. + + +Module toto (ta:TOTO). +Module ti:=ta.t. + +Definition ex1:forall (c d:ti.X), (ta.a d)=(ta.a c) -> d=c. +intros. +injection H. +Abort. +End toto. diff --git a/test-suite/bugs/closed/1547.v b/test-suite/bugs/closed/bug_1547.v index 166fa7a9f2..166fa7a9f2 100644 --- a/test-suite/bugs/closed/1547.v +++ b/test-suite/bugs/closed/bug_1547.v diff --git a/test-suite/bugs/closed/1551.v b/test-suite/bugs/closed/bug_1551.v index 48f0b55129..48f0b55129 100644 --- a/test-suite/bugs/closed/1551.v +++ b/test-suite/bugs/closed/bug_1551.v diff --git a/test-suite/bugs/closed/bug_1568.v b/test-suite/bugs/closed/bug_1568.v new file mode 100644 index 0000000000..25fdcd297f --- /dev/null +++ b/test-suite/bugs/closed/bug_1568.v @@ -0,0 +1,11 @@ +CoInductive A: Set := + mk_A: B -> A +with B: Set := + mk_B: A -> B. + +CoFixpoint a:A := mk_A b +with b:B := mk_B a. + +Goal b = match a with mk_A a1 => a1 end. + simpl. reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_1576.v b/test-suite/bugs/closed/bug_1576.v new file mode 100644 index 0000000000..0889568d82 --- /dev/null +++ b/test-suite/bugs/closed/bug_1576.v @@ -0,0 +1,37 @@ +Module Type TA. +Parameter t : Set. +End TA. + +Module Type TB. +Declare Module A: TA. +End TB. + +Module Type TC. +Declare Module B : TB. +End TC. + +Module Type TD. + +Declare Module B: TB . +Declare Module C: TC + with Module B := B . +End TD. + +Module Type TE. +Declare Module D : TD. +End TE. + +Module Type TF. +Declare Module E: TE. +End TF. + +Module G (D: TD). +Module B' := D.C.B. +End G. + +Module H (F: TF). +Module I := G(F.E.D). +End H. + +Declare Module F: TF. +Module K := H(F). diff --git a/test-suite/bugs/closed/bug_1582.v b/test-suite/bugs/closed/bug_1582.v new file mode 100644 index 0000000000..88af924934 --- /dev/null +++ b/test-suite/bugs/closed/bug_1582.v @@ -0,0 +1,14 @@ +Require Import Peano_dec. + +Definition fact_F : + forall (n:nat), + (forall m, m<n -> nat) -> + nat. +refine + (fun n fact_rec => + if eq_nat_dec n 0 then + 1 + else + let fn := fact_rec (n-1) _ in + n * fn). +Admitted. diff --git a/test-suite/bugs/closed/1584.v b/test-suite/bugs/closed/bug_1584.v index 926af7dd1c..926af7dd1c 100644 --- a/test-suite/bugs/closed/1584.v +++ b/test-suite/bugs/closed/bug_1584.v diff --git a/test-suite/bugs/closed/1604.v b/test-suite/bugs/closed/bug_1604.v index 22c3df824b..22c3df824b 100644 --- a/test-suite/bugs/closed/1604.v +++ b/test-suite/bugs/closed/bug_1604.v diff --git a/test-suite/bugs/closed/1614.v b/test-suite/bugs/closed/bug_1614.v index 6bc165d406..6bc165d406 100644 --- a/test-suite/bugs/closed/1614.v +++ b/test-suite/bugs/closed/bug_1614.v diff --git a/test-suite/bugs/closed/bug_1618.v b/test-suite/bugs/closed/bug_1618.v new file mode 100644 index 0000000000..a7be12e26f --- /dev/null +++ b/test-suite/bugs/closed/bug_1618.v @@ -0,0 +1,22 @@ +Inductive A: Set := +| A1: nat -> A. + +Definition A_size (a: A) : nat := + match a with + | A1 n => 0 + end. + +Require Import Recdef. + +Function n3 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {struct a} : P a := + match a return (P a) with + | A1 n => f n + end. + + +Function n1 (P: A -> Prop) (f: forall n, P (A1 n)) (a: A) {measure A_size a} : +P +a := + match a return (P a) with + | A1 n => f n + end. diff --git a/test-suite/bugs/closed/1634.v b/test-suite/bugs/closed/bug_1634.v index 0150c25038..0150c25038 100644 --- a/test-suite/bugs/closed/1634.v +++ b/test-suite/bugs/closed/bug_1634.v diff --git a/test-suite/bugs/closed/1643.v b/test-suite/bugs/closed/bug_1643.v index 879a65b183..879a65b183 100644 --- a/test-suite/bugs/closed/1643.v +++ b/test-suite/bugs/closed/bug_1643.v diff --git a/test-suite/bugs/closed/bug_1680.v b/test-suite/bugs/closed/bug_1680.v new file mode 100644 index 0000000000..fa563f32d7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1680.v @@ -0,0 +1,7 @@ +Ltac int1 := let h := fresh in intro h. + +Goal nat -> nat -> True. + let h' := fresh in (let h := fresh in intro h); intro h'. + Restart. let h' := fresh in int1; intro h'. + trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_1683.v b/test-suite/bugs/closed/bug_1683.v new file mode 100644 index 0000000000..8ab030a297 --- /dev/null +++ b/test-suite/bugs/closed/bug_1683.v @@ -0,0 +1,41 @@ +Require Import Setoid. + +Section SetoidBug. + +Variable ms : Type. +Variable ms_type : ms -> Type. +Variable ms_eq : forall (A:ms), relation (ms_type A). + +Variable CR : ms. + +Record Ring : Type := +{Ring_type : Type}. + +Variable foo : forall (A:Ring), nat -> Ring_type A. +Variable IR : Ring. +Variable IRasCR : Ring_type IR -> ms_type CR. + +Definition CRasCRing : Ring := Build_Ring (ms_type CR). + +Hypothesis ms_refl : forall A x, ms_eq A x x. +Hypothesis ms_sym : forall A x y, ms_eq A x y -> ms_eq A y x. +Hypothesis ms_trans : forall A x y z, ms_eq A x y -> ms_eq A y z -> ms_eq A x z. + +Add Parametric Relation A : (ms_type A) (ms_eq A) + reflexivity proved by (ms_refl A) + symmetry proved by (ms_sym A) + transitivity proved by (ms_trans A) + as ms_Setoid. + +Hypothesis foobar : forall n, ms_eq CR (IRasCR (foo IR n)) (foo CRasCRing n). + +Goal forall (b:ms_type CR), + ms_eq CR (IRasCR (foo IR O)) b -> + ms_eq CR (IRasCR (foo IR O)) b. +intros b H. +rewrite foobar. +rewrite foobar in H. +assumption. +Qed. + +End SetoidBug. diff --git a/test-suite/bugs/closed/1696.v b/test-suite/bugs/closed/bug_1696.v index 0826428a34..0826428a34 100644 --- a/test-suite/bugs/closed/1696.v +++ b/test-suite/bugs/closed/bug_1696.v diff --git a/test-suite/bugs/closed/1703.v b/test-suite/bugs/closed/bug_1703.v index 114e3185b8..114e3185b8 100644 --- a/test-suite/bugs/closed/1703.v +++ b/test-suite/bugs/closed/bug_1703.v diff --git a/test-suite/bugs/closed/1704.v b/test-suite/bugs/closed/bug_1704.v index 7d8ba5b8da..7d8ba5b8da 100644 --- a/test-suite/bugs/closed/1704.v +++ b/test-suite/bugs/closed/bug_1704.v diff --git a/test-suite/bugs/closed/1711.v b/test-suite/bugs/closed/bug_1711.v index e16612e380..e16612e380 100644 --- a/test-suite/bugs/closed/1711.v +++ b/test-suite/bugs/closed/bug_1711.v diff --git a/test-suite/bugs/closed/1718.v b/test-suite/bugs/closed/bug_1718.v index 715fa94199..715fa94199 100644 --- a/test-suite/bugs/closed/1718.v +++ b/test-suite/bugs/closed/bug_1718.v diff --git a/test-suite/bugs/closed/1738.v b/test-suite/bugs/closed/bug_1738.v index ef52c876c1..ef52c876c1 100644 --- a/test-suite/bugs/closed/1738.v +++ b/test-suite/bugs/closed/bug_1738.v diff --git a/test-suite/bugs/closed/bug_1740.v b/test-suite/bugs/closed/bug_1740.v new file mode 100644 index 0000000000..3b882dc4ca --- /dev/null +++ b/test-suite/bugs/closed/bug_1740.v @@ -0,0 +1,22 @@ +(* Check that expansion of alias in pattern-matching compilation is no + longer dependent of whether the pattern-matching problem occurs in a + typed context or at toplevel (solved from revision 10883) *) + +Definition f := + fun n m : nat => + match n, m with + | O, _ => O + | n, O => n + | _, _ => O + end. + +Goal f = + fun n m : nat => + match n, m with + | O, _ => O + | n, O => n + | _, _ => O + end. + unfold f. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/1754.v b/test-suite/bugs/closed/bug_1754.v index 06b8dce851..06b8dce851 100644 --- a/test-suite/bugs/closed/1754.v +++ b/test-suite/bugs/closed/bug_1754.v diff --git a/test-suite/bugs/closed/bug_1773.v b/test-suite/bugs/closed/bug_1773.v new file mode 100644 index 0000000000..c930f24df7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1773.v @@ -0,0 +1,10 @@ +(* An occur-check test was done too early *) + +Goal forall B C : nat -> nat -> Prop, forall k, + (exists A, (forall k', C A k' -> B A k') -> B A k). +Proof. + intros B C k. + econstructor. + intros X. + apply X. (* used to fail here *) +Abort. diff --git a/test-suite/bugs/closed/1774.v b/test-suite/bugs/closed/bug_1774.v index 4c24b481bd..4c24b481bd 100644 --- a/test-suite/bugs/closed/1774.v +++ b/test-suite/bugs/closed/bug_1774.v diff --git a/test-suite/bugs/closed/1775.v b/test-suite/bugs/closed/bug_1775.v index 932949a371..932949a371 100644 --- a/test-suite/bugs/closed/1775.v +++ b/test-suite/bugs/closed/bug_1775.v diff --git a/test-suite/bugs/closed/1776.v b/test-suite/bugs/closed/bug_1776.v index 58491f9de1..58491f9de1 100644 --- a/test-suite/bugs/closed/1776.v +++ b/test-suite/bugs/closed/bug_1776.v diff --git a/test-suite/bugs/closed/1779.v b/test-suite/bugs/closed/bug_1779.v index 95bb66b962..95bb66b962 100644 --- a/test-suite/bugs/closed/1779.v +++ b/test-suite/bugs/closed/bug_1779.v diff --git a/test-suite/bugs/closed/1780.v b/test-suite/bugs/closed/bug_1780.v index ade4462a79..ade4462a79 100644 --- a/test-suite/bugs/closed/1780.v +++ b/test-suite/bugs/closed/bug_1780.v diff --git a/test-suite/bugs/closed/bug_1784.v b/test-suite/bugs/closed/bug_1784.v new file mode 100644 index 0000000000..93d7f6ab75 --- /dev/null +++ b/test-suite/bugs/closed/bug_1784.v @@ -0,0 +1,99 @@ +Require Import List. +Require Import ZArith. +Require String. Open Scope string_scope. +Ltac Case s := let c := fresh "case" in set (c := s). + +Set Implicit Arguments. +Unset Strict Implicit. + +Inductive sv : Set := +| I : Z -> sv +| S : list sv -> sv. + +Section sv_induction. + +Variables + (VP: sv -> Prop) + (LP: list sv -> Prop) + + (VPint: forall n, VP (I n)) + (VPset: forall vs, LP vs -> VP (S vs)) + (lpcons: forall v vs, VP v -> LP vs -> LP (v::vs)) + (lpnil: LP nil). + +Fixpoint setl_value_indp (x:sv) {struct x}: VP x := + match x as x return VP x with + | I n => VPint n + | S vs => + VPset + ((fix values_indp (vs:list sv) {struct vs}: (LP vs) := + match vs as vs return LP vs with + | nil => lpnil + | v::vs => lpcons (setl_value_indp v) (values_indp vs) + end) vs) + end. +End sv_induction. + +Inductive slt : sv -> sv -> Prop := +| IC : forall z, slt (I z) (I z) +| IS : forall vs vs', slist_in vs vs' -> slt (S vs) (S vs') + +with sin : sv -> list sv -> Prop := +| Ihd : forall s s' sv', slt s s' -> sin s (s'::sv') +| Itl : forall s s' sv', sin s sv' -> sin s (s'::sv') + +with slist_in : list sv -> list sv -> Prop := +| Inil : forall sv', + slist_in nil sv' +| Icons : forall s sv sv', + sin s sv' -> + slist_in sv sv' -> + slist_in (s::sv) sv'. + +Hint Constructors sin slt slist_in. + +Require Import Program. + +Program Fixpoint lt_dec (x y:sv) { struct x } : {slt x y}+{~slt x y} := + match x with + | I x => + match y with + | I y => if (Z.eq_dec x y) then in_left else in_right + | S ys => in_right + end + | S xs => + match y with + | I y => in_right + | S ys => + let fix list_in (xs ys:list sv) {struct xs} : + {slist_in xs ys} + {~slist_in xs ys} := + match xs with + | nil => in_left + | x::xs => + let fix elem_in (ys:list sv) : {sin x ys}+{~sin x ys} := + match ys with + | nil => in_right + | y::ys => if lt_dec x y then in_left else if elem_in + ys then in_left else in_right + end + in + if elem_in ys then + if list_in xs ys then in_left else in_right + else in_right + end + in if list_in xs ys then in_left else in_right + end + end. + +Next Obligation. intro H0. apply H; inversion H0; subst; trivial. Defined. +Next Obligation. intro H; inversion H. Defined. +Next Obligation. intro H; inversion H. Defined. +Next Obligation. intro H; inversion H; subst. Defined. +Next Obligation. + intro H1; contradict H. inversion H1; subst. assumption. + contradict H0; assumption. Defined. +Next Obligation. intro H1; contradict H0. inversion H1; subst. assumption. Defined. +Next Obligation. + intro H1; contradict H. inversion H1; subst. assumption. Defined. +Next Obligation. + intro H0; contradict H. inversion H0; subst; auto. Defined. diff --git a/test-suite/bugs/closed/bug_1787.v b/test-suite/bugs/closed/bug_1787.v new file mode 100644 index 0000000000..e3cf9f4b40 --- /dev/null +++ b/test-suite/bugs/closed/bug_1787.v @@ -0,0 +1,9 @@ +Parameter P : nat -> nat -> Prop. +Parameter Q : nat -> nat -> Prop. +Axiom A : forall x x' x'', P x x' -> Q x'' x' -> P x x''. + +Goal (P 1 3) -> (Q 1 3) -> (P 1 1). +intros H H'. +refine ((fun H1 : P 1 _ => let H2 := (_:Q 1 _) in A _ _ _ H1 H2) _). +clear. +Admitted. diff --git a/test-suite/bugs/closed/1791.v b/test-suite/bugs/closed/bug_1791.v index be0e8ae8ba..be0e8ae8ba 100644 --- a/test-suite/bugs/closed/1791.v +++ b/test-suite/bugs/closed/bug_1791.v diff --git a/test-suite/bugs/closed/1834.v b/test-suite/bugs/closed/bug_1834.v index 884ac01cd2..884ac01cd2 100644 --- a/test-suite/bugs/closed/1834.v +++ b/test-suite/bugs/closed/bug_1834.v diff --git a/test-suite/bugs/closed/1844.v b/test-suite/bugs/closed/bug_1844.v index c41e45900a..c41e45900a 100644 --- a/test-suite/bugs/closed/1844.v +++ b/test-suite/bugs/closed/bug_1844.v diff --git a/test-suite/bugs/closed/bug_1850.v b/test-suite/bugs/closed/bug_1850.v new file mode 100644 index 0000000000..b6d2edf8a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_1850.v @@ -0,0 +1,3 @@ +Parameter P : Type -> Type -> Type. +Notation "e |= t --> v" := (P e t v) (at level 100, t at level 54). +Fail Check (nat |= nat --> nat). diff --git a/test-suite/bugs/closed/1859.v b/test-suite/bugs/closed/bug_1859.v index 43acfe4ba2..43acfe4ba2 100644 --- a/test-suite/bugs/closed/1859.v +++ b/test-suite/bugs/closed/bug_1859.v diff --git a/test-suite/bugs/closed/bug_1865.v b/test-suite/bugs/closed/bug_1865.v new file mode 100644 index 0000000000..8bbe07881c --- /dev/null +++ b/test-suite/bugs/closed/bug_1865.v @@ -0,0 +1,19 @@ +(* Check that tactics (here dependent inversion) do not generate + conversion problems T <= U with sup's of universes in U *) + +(* Submitted by David Nowak *) + +Inductive list (A:Set) : nat -> Set := +| nil : list A O +| cons : forall n, A -> list A n -> list A (S n). + +Definition f (n:nat) : Type := + match n with + | O => bool + | _ => unit + end. + +Goal forall A n, list A n -> f n. +intros A n. +dependent inversion n. +Abort. diff --git a/test-suite/bugs/closed/bug_1891.v b/test-suite/bugs/closed/bug_1891.v new file mode 100644 index 0000000000..0e4f35efca --- /dev/null +++ b/test-suite/bugs/closed/bug_1891.v @@ -0,0 +1,12 @@ +(* Check evar-evar unification *) + Inductive T (A: Set): Set := mkT: unit -> T A. + + Definition f (A: Set) (l: T A): unit := tt. + + Arguments f [A]. + + Lemma L (x: T unit): (unit -> T unit) -> unit. + Proof. + refine (match x return _ with mkT _ n => fun g => f (g _) end). + trivial. + Qed. diff --git a/test-suite/bugs/closed/1898.v b/test-suite/bugs/closed/bug_1898.v index 70461286ce..70461286ce 100644 --- a/test-suite/bugs/closed/1898.v +++ b/test-suite/bugs/closed/bug_1898.v diff --git a/test-suite/bugs/closed/1900.v b/test-suite/bugs/closed/bug_1900.v index 6eea5db083..6eea5db083 100644 --- a/test-suite/bugs/closed/1900.v +++ b/test-suite/bugs/closed/bug_1900.v diff --git a/test-suite/bugs/closed/1901.v b/test-suite/bugs/closed/bug_1901.v index 98e017f9d6..98e017f9d6 100644 --- a/test-suite/bugs/closed/1901.v +++ b/test-suite/bugs/closed/bug_1901.v diff --git a/test-suite/bugs/closed/1905.v b/test-suite/bugs/closed/bug_1905.v index 3b8a3d2f68..3b8a3d2f68 100644 --- a/test-suite/bugs/closed/1905.v +++ b/test-suite/bugs/closed/bug_1905.v diff --git a/test-suite/bugs/closed/1907.v b/test-suite/bugs/closed/bug_1907.v index 55fc823190..55fc823190 100644 --- a/test-suite/bugs/closed/1907.v +++ b/test-suite/bugs/closed/bug_1907.v diff --git a/test-suite/bugs/closed/1912.v b/test-suite/bugs/closed/bug_1912.v index 987a541778..987a541778 100644 --- a/test-suite/bugs/closed/1912.v +++ b/test-suite/bugs/closed/bug_1912.v diff --git a/test-suite/bugs/closed/1915.v b/test-suite/bugs/closed/bug_1915.v index 2b0aed8c7d..2b0aed8c7d 100644 --- a/test-suite/bugs/closed/1915.v +++ b/test-suite/bugs/closed/bug_1915.v diff --git a/test-suite/bugs/closed/bug_1918.v b/test-suite/bugs/closed/bug_1918.v new file mode 100644 index 0000000000..5d1f9edb3e --- /dev/null +++ b/test-suite/bugs/closed/bug_1918.v @@ -0,0 +1,377 @@ +(** Occur-check for Meta (up to delta) *) + +(** LNMItPredShort.v Version 2.0 July 2008 *) +(** does not need impredicative Set, runs under V8.2, tested with SVN 11296 *) + +(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse*) + + +Set Implicit Arguments. + +(** the universe of all monotypes *) +Definition k0 := Set. + +(** the type of all type transformations *) +Definition k1 := k0 -> k0. + +(** the type of all rank-2 type transformations *) +Definition k2 := k1 -> k1. + +(** polymorphic identity *) +Definition id : forall (A:Set), A -> A := fun A x => x. + +(** composition *) +Definition comp (A B C:Set)(g:B->C)(f:A->B) : A->C := fun x => g (f x). + +Infix "o" := comp (at level 90). + +Definition sub_k1 (X Y:k1) : Type := + forall A:Set, X A -> Y A. + +Infix "c_k1" := sub_k1 (at level 60). + +(** monotonicity *) +Definition mon (X:k1) : Type := forall (A B:Set), (A -> B) -> X A -> X B. + +(** extensionality *) +Definition ext (X:k1)(h: mon X): Prop := + forall (A B:Set)(f g:A -> B), + (forall a, f a = g a) -> forall r, h _ _ f r = h _ _ g r. + +(** first functor law *) +Definition fct1 (X:k1)(m: mon X) : Prop := + forall (A:Set)(x:X A), m _ _ (id(A:=A)) x = x. + +(** second functor law *) +Definition fct2 (X:k1)(m: mon X) : Prop := + forall (A B C:Set)(f:A -> B)(g:B -> C)(x:X A), + m _ _ (g o f) x = m _ _ g (m _ _ f x). + +(** pack up the good properties of the approximation into + the notion of an extensional functor *) +Record EFct (X:k1) : Type := mkEFct + { m : mon X; + e : ext m; + f1 : fct1 m; + f2 : fct2 m }. + +(** preservation of extensional functors *) +Definition pEFct (F:k2) : Type := + forall (X:k1), EFct X -> EFct (F X). + + +(** we show some closure properties of pEFct, depending on such properties + for EFct *) + +Definition moncomp (X Y:k1)(mX:mon X)(mY:mon Y): mon (fun A => X(Y A)). +Proof. + red. + intros A B f x. + exact (mX (Y A)(Y B) (mY A B f) x). +Defined. + +(** closure under composition *) +Lemma compEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X(Y A)). +Proof. + intros ef1 ef2. + apply (mkEFct(m:=moncomp (m ef1) (m ef2))); red; intros; unfold moncomp. +(* prove ext *) + apply (e ef1). + intro. + apply (e ef2); trivial. +(* prove fct1 *) + rewrite (e ef1 (m ef2 (id (A:=A))) (id(A:=Y A))). + apply (f1 ef1). + intro. + apply (f1 ef2). +(* prove fct2 *) + rewrite (e ef1 (m ef2 (g o f))((m ef2 g)o(m ef2 f))). + apply (f2 ef1). + intro. + unfold comp at 2. + apply (f2 ef2). +Defined. + +Corollary comppEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X (G X A)). +Proof. + red. + intros. + apply compEFct; auto. +Defined. + +(** closure under sums *) +Lemma sumEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A + Y A)%type. +Proof. + intros ef1 ef2. + set (m12:=fun (A B:Set)(f:A->B) x => match x with + | inl y => inl _ (m ef1 f y) + | inr y => inr _ (m ef2 f y) + end). + apply (mkEFct(m:=m12)); red; intros. +(* prove ext *) + destruct r. + simpl. + apply (f_equal (fun x=>inl (A:=X B) (Y B) x)). + apply (e ef1); trivial. + simpl. + apply (f_equal (fun x=>inr (X B) (B:=Y B) x)). + apply (e ef2); trivial. +(* prove fct1 *) + destruct x. + simpl. + apply (f_equal (fun x=>inl (A:=X A) (Y A) x)). + apply (f1 ef1). + simpl. + apply (f_equal (fun x=>inr (X A) (B:=Y A) x)). + apply (f1 ef2). +(* prove fct2 *) + destruct x. + simpl. + rewrite (f2 ef1); reflexivity. + simpl. + rewrite (f2 ef2); reflexivity. +Defined. + +Corollary sumpEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X A + G X A)%type. +Proof. + red. + intros. + apply sumEFct; auto. +Defined. + +(** closure under products *) +Lemma prodEFct (X Y:k1): EFct X -> EFct Y -> EFct (fun A => X A * Y A)%type. +Proof. + intros ef1 ef2. + set (m12:=fun (A B:Set)(f:A->B) x => match x with + (x1,x2) => (m ef1 f x1, m ef2 f x2) end). + apply (mkEFct(m:=m12)); red; intros. +(* prove ext *) + destruct r as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (e ef1); trivial. + apply (e ef2); trivial. +(* prove fct1 *) + destruct x as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (f1 ef1). + apply (f1 ef2). +(* prove fct2 *) + destruct x as [x1 x2]. + simpl. + apply injective_projections; simpl. + apply (f2 ef1). + apply (f2 ef2). +Defined. + +Corollary prodpEFct (F G:k2): pEFct F -> pEFct G -> + pEFct (fun X A => F X A * G X A)%type. +Proof. + red. + intros. + apply prodEFct; auto. +Defined. + +(** the identity in k2 preserves extensional functors *) +Lemma idpEFct: pEFct (fun X => X). +Proof. + red. + intros. + assumption. +Defined. + +(** a variant for the eta-expanded identity *) +Lemma idpEFct_eta: pEFct (fun X A => X A). +Proof. + red. + intros X ef. + destruct ef as [m0 e0 f01 f02]. + change (mon X) with (mon (fun A => X A)) in m0. + apply (mkEFct (m:=m0) e0 f01 f02). +Defined. + +(** the identity in k1 "is" an extensional functor *) +Lemma idEFct: EFct (fun A => A). +Proof. + set (mId:=fun A B (f:A->B)(x:A) => f x). + apply (mkEFct(m:=mId)). + red. + intros. + unfold mId. + apply H. + red. + reflexivity. + red. + reflexivity. +Defined. + +(** constants in k2 *) +Lemma constpEFct (X:k1): EFct X -> pEFct (fun _ => X). +Proof. + red. + intros. + assumption. +Defined. + +(** constants in k1 *) +Lemma constEFct (C:Set): EFct (fun _ => C). +Proof. + set (mC:=fun A B (f:A->B)(x:C) => x). + apply (mkEFct(m:=mC)); red; intros; unfold mC; reflexivity. +Defined. + + +(** the option type *) +Lemma optionEFct: EFct (fun (A:Set) => option A). + apply (mkEFct (X:=fun (A:Set) => option A)(m:=option_map)); red; intros. + destruct r. + simpl. + rewrite H. + reflexivity. + reflexivity. + destruct x; reflexivity. + destruct x; reflexivity. +Defined. + + +(** natural transformations from (X,mX) to (Y,mY) *) +Definition NAT(X Y:k1)(j:X c_k1 Y)(mX:mon X)(mY:mon Y) : Prop := + forall (A B:Set)(f:A->B)(t:X A), j B (mX A B f t) = mY _ _ f (j A t). + + +Module Type LNMIt_Type. + +Parameter F:k2. +Parameter FpEFct: pEFct F. +Parameter mu20: k1. +Definition mu2: k1:= fun A => mu20 A. +Parameter mapmu2: mon mu2. +Definition MItType: Type := + forall G : k1, (forall X : k1, X c_k1 G -> F X c_k1 G) -> mu2 c_k1 G. +Parameter MIt0 : MItType. +Definition MIt : MItType:= fun G s A t => MIt0 s t. +Definition InType : Type := + forall (X:k1)(ef:EFct X)(j: X c_k1 mu2), + NAT j (m ef) mapmu2 -> F X c_k1 mu2. +Parameter In : InType. +Axiom mapmu2Red : forall (A:Set)(X:k1)(ef:EFct X)(j: X c_k1 mu2) + (n: NAT j (m ef) mapmu2)(t: F X A)(B:Set)(f:A->B), + mapmu2 f (In ef n t) = In ef n (m (FpEFct ef) f t). +Axiom MItRed : forall (G : k1) + (s : forall X : k1, X c_k1 G -> F X c_k1 G)(X : k1)(ef:EFct X)(j: X c_k1 mu2) + (n: NAT j (m ef) mapmu2)(A:Set)(t:F X A), + MIt s (In ef n t) = s X (fun A => (MIt s (A:=A)) o (j A)) A t. +Definition mu2IndType : Prop := + forall (P : (forall A : Set, mu2 A -> Prop)), + (forall (X : k1)(ef:EFct X)(j : X c_k1 mu2)(n: NAT j (m ef) mapmu2), + (forall (A : Set) (x : X A), P A (j A x)) -> + forall (A:Set)(t : F X A), P A (In ef n t)) -> + forall (A : Set) (r : mu2 A), P A r. +Axiom mu2Ind : mu2IndType. + +End LNMIt_Type. + +(** BushDepPredShort.v Version 0.2 July 2008 *) +(** does not need impredicative Set, produces stack overflow under V8.2, tested +with SVN 11296 *) + +(** Copyright Ralph Matthes, I.R.I.T., C.N.R.S. & University of Toulouse *) + +Set Implicit Arguments. + +Require Import List. + +Definition listk1 (A:Set) : Set := list A. +Open Scope type_scope. + +Definition BushF(X:k1)(A:Set) := unit + A * X (X A). + +Definition bushpEFct : pEFct BushF. +Proof. + unfold BushF. + apply sumpEFct. + apply constpEFct. + apply constEFct. + apply prodpEFct. + apply constpEFct. + apply idEFct. + apply comppEFct. + apply idpEFct. + apply idpEFct_eta. +Defined. + +Module Type BUSH := LNMIt_Type with Definition F:=BushF + with Definition FpEFct := +bushpEFct. + +Module Bush (BushBase:BUSH). + +Definition Bush : k1 := BushBase.mu2. + +Definition bush : mon Bush := BushBase.mapmu2. + +End Bush. + + +Definition Id : k1 := fun X => X. + +Fixpoint Pow (X:k1)(k:nat){struct k}:k1:= + match k with 0 => Id + | S k' => fun A => X (Pow X k' A) + end. + +Fixpoint POW (k:nat)(X:k1)(m:mon X){struct k} : mon (Pow X k) := + match k return mon (Pow X k) + with 0 => fun _ _ f => f + | S k' => fun _ _ f => m _ _ (POW k' m f) + end. + +Module Type BushkToList_Type. + +Declare Module Import BP: BUSH. +Definition F:=BushF. +Definition FpEFct:= bushpEFct. +Definition mu20 := mu20. +Definition mu2 := mu2. +Definition mapmu2 := mapmu2. +Definition MItType:= MItType. +Definition MIt0 := MIt0. +Definition MIt := MIt. +Definition InType := InType. +Definition In := In. +Definition mapmu2Red:=mapmu2Red. +Definition MItRed:=MItRed. +Definition mu2IndType:=mu2IndType. +Definition mu2Ind:=mu2Ind. + +Definition Bush:= mu2. +Module BushM := Bush BP. + +Parameter BushkToList: forall(k:nat)(A:k0)(t:Pow Bush k A), list A. +Axiom BushkToList0: forall(A:k0)(t:Pow Bush 0 A), BushkToList 0 A t = t::nil. + +End BushkToList_Type. + +Module BushDep (BushkToListM:BushkToList_Type). + +Module Bush := Bush BushkToListM. + +Import Bush. +Import BushkToListM. + + +Lemma BushkToList0NAT: NAT(Y:=listk1) (BushkToList 0) (POW 0 bush) map. +Proof. + red. + intros. + simpl. + rewrite BushkToList0. +(* stack overflow for coqc and coqtop *) + + +Abort. +End BushDep. diff --git a/test-suite/bugs/closed/1925.v b/test-suite/bugs/closed/bug_1925.v index 4caee1c36d..4caee1c36d 100644 --- a/test-suite/bugs/closed/1925.v +++ b/test-suite/bugs/closed/bug_1925.v diff --git a/test-suite/bugs/closed/1931.v b/test-suite/bugs/closed/bug_1931.v index 930ace1d55..930ace1d55 100644 --- a/test-suite/bugs/closed/1931.v +++ b/test-suite/bugs/closed/bug_1931.v diff --git a/test-suite/bugs/closed/1935.v b/test-suite/bugs/closed/bug_1935.v index d583761985..d583761985 100644 --- a/test-suite/bugs/closed/1935.v +++ b/test-suite/bugs/closed/bug_1935.v diff --git a/test-suite/bugs/closed/1939.v b/test-suite/bugs/closed/bug_1939.v index 7b430ace5e..7b430ace5e 100644 --- a/test-suite/bugs/closed/1939.v +++ b/test-suite/bugs/closed/bug_1939.v diff --git a/test-suite/bugs/closed/bug_1944.v b/test-suite/bugs/closed/bug_1944.v new file mode 100644 index 0000000000..f996eeecc6 --- /dev/null +++ b/test-suite/bugs/closed/bug_1944.v @@ -0,0 +1,10 @@ +(* Test some uses of ? in introduction patterns *) + +Inductive J : nat -> Prop := + | K : forall p, J p -> (True /\ True) -> J (S p). + +Lemma bug : forall n, J n -> J (S n). +Proof. + intros ? H. + induction H as [? ? [? ?]]. +Abort. diff --git a/test-suite/bugs/closed/1951.v b/test-suite/bugs/closed/bug_1951.v index e950554c4b..e950554c4b 100644 --- a/test-suite/bugs/closed/1951.v +++ b/test-suite/bugs/closed/bug_1951.v diff --git a/test-suite/bugs/closed/1962.v b/test-suite/bugs/closed/bug_1962.v index 37b0dde06d..37b0dde06d 100644 --- a/test-suite/bugs/closed/1962.v +++ b/test-suite/bugs/closed/bug_1962.v diff --git a/test-suite/bugs/closed/bug_1963.v b/test-suite/bugs/closed/bug_1963.v new file mode 100644 index 0000000000..354056ae2a --- /dev/null +++ b/test-suite/bugs/closed/bug_1963.v @@ -0,0 +1,20 @@ +(* Check that "dependent inversion" behaves correctly w.r.t to universes *) + +Require Import Eqdep. + +Set Implicit Arguments. + +Inductive illist(A:Type) : nat -> Type := + illistn : illist A 0 +| illistc : forall n:nat, A -> illist A n -> illist A (S n). + +Inductive isig (A:Type)(P:A -> Type) : Type := + iexists : forall x : A, P x -> isig P. + +Lemma inv : forall (A:Type)(n n':nat)(ts':illist A n'), n' = S n -> + isig (fun t => isig (fun ts => + eq_dep nat (fun n => illist A n) n' ts' (S n) (illistc t ts))). +Proof. +intros. +dependent inversion ts'. +Abort. diff --git a/test-suite/bugs/closed/1977.v b/test-suite/bugs/closed/bug_1977.v index 28715040ce..28715040ce 100644 --- a/test-suite/bugs/closed/1977.v +++ b/test-suite/bugs/closed/bug_1977.v diff --git a/test-suite/bugs/closed/1981.v b/test-suite/bugs/closed/bug_1981.v index a3d9429307..a3d9429307 100644 --- a/test-suite/bugs/closed/1981.v +++ b/test-suite/bugs/closed/bug_1981.v diff --git a/test-suite/bugs/closed/2001.v b/test-suite/bugs/closed/bug_2001.v index 652c65706a..652c65706a 100644 --- a/test-suite/bugs/closed/2001.v +++ b/test-suite/bugs/closed/bug_2001.v diff --git a/test-suite/bugs/closed/2006.v b/test-suite/bugs/closed/bug_2006.v index d353d0e2d6..d353d0e2d6 100644 --- a/test-suite/bugs/closed/2006.v +++ b/test-suite/bugs/closed/bug_2006.v diff --git a/test-suite/bugs/closed/bug_2016.v b/test-suite/bugs/closed/bug_2016.v new file mode 100644 index 0000000000..a82fd87986 --- /dev/null +++ b/test-suite/bugs/closed/bug_2016.v @@ -0,0 +1,65 @@ +(* Coq 8.2beta4 *) +Require Import Classical_Prop. + +Unset Structural Injection. + +Record coreSemantics : Type := CoreSemantics { + core: Type; + corestep: core -> core -> Prop; + corestep_fun: forall q q1 q2, corestep q q1 -> corestep q q2 -> q1 = q2 +}. + +Definition state : Type := {sem: coreSemantics & sem.(core)}. + +Inductive step: state -> state -> Prop := + | step_core: forall sem st st' + (Hcs: sem.(corestep) st st'), + step (existT _ sem st) (existT _ sem st'). + +Lemma step_fun: forall st1 st2 st2', step st1 st2 -> step st1 st2' -> st2 = st2'. +Proof. +intros. +inversion H; clear H; subst. inversion H0; clear H0; subst; auto. +generalize (inj_pairT2 _ _ _ _ _ H2); clear H2; intro; subst. +rewrite (corestep_fun _ _ _ _ Hcs Hcs0); auto. +Qed. + +Record oe_core := oe_Core { + in_core: Type; + in_corestep: in_core -> in_core -> Prop; + in_corestep_fun: forall q q1 q2, in_corestep q q1 -> in_corestep q q2 -> q1 = q2; + in_q: in_core +}. + +Definition oe2coreSem (oec : oe_core) : coreSemantics := + CoreSemantics oec.(in_core) oec.(in_corestep) oec.(in_corestep_fun). + +Definition oe_corestep (q q': oe_core) := + step (existT _ (oe2coreSem q) q.(in_q)) (existT _ (oe2coreSem q') q'.(in_q)). + +Lemma inj_pairT1: forall (U: Type) (P: U -> Type) (p1 p2: U) x y, + existT P p1 x = existT P p2 y -> p1=p2. +Proof. intros; injection H; auto. +Qed. + +Definition f := CoreSemantics oe_core. + +Lemma oe_corestep_fun: forall q q1 q2, + oe_corestep q q1 -> oe_corestep q q2 -> q1 = q2. +Proof. +unfold oe_corestep; intros. +assert (HH:= step_fun _ _ _ H H0); clear H H0. +destruct q1; destruct q2; unfold oe2coreSem; simpl in *. +generalize (inj_pairT1 _ _ _ _ _ _ HH); clear HH; intros. +injection H. +revert in_q1 in_corestep1 in_corestep_fun1 + H. +pattern in_core1. +apply eq_ind_r with (x := in_core0). +admit. +apply sym_eq. +(** good to here **) +Show Universes. +Print Universes. +Fail apply H0. +Abort. diff --git a/test-suite/bugs/closed/2017.v b/test-suite/bugs/closed/bug_2017.v index df6661483a..df6661483a 100644 --- a/test-suite/bugs/closed/2017.v +++ b/test-suite/bugs/closed/bug_2017.v diff --git a/test-suite/bugs/closed/2021.v b/test-suite/bugs/closed/bug_2021.v index 5df92998e1..5df92998e1 100644 --- a/test-suite/bugs/closed/2021.v +++ b/test-suite/bugs/closed/bug_2021.v diff --git a/test-suite/bugs/closed/2027.v b/test-suite/bugs/closed/bug_2027.v index ebc2bc070c..ebc2bc070c 100644 --- a/test-suite/bugs/closed/2027.v +++ b/test-suite/bugs/closed/bug_2027.v diff --git a/test-suite/bugs/closed/bug_2083.v b/test-suite/bugs/closed/bug_2083.v new file mode 100644 index 0000000000..f33e96cea6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2083.v @@ -0,0 +1,27 @@ +Require Import Program Arith. + +Program Fixpoint check_n (n : nat) (P : { i | i < n } -> bool) (p : nat) + (H : forall (i : { i | i < n }), i < p -> P i = true) + {measure (n - p)} : + Exc (forall (p : { i | i < n}), P p = true) := + match le_lt_dec n p with + | left _ => value _ + | right cmp => + if dec (P p) then + check_n n P (S p) _ + else + error + end. + +Require Import Omega. + +Solve Obligations with program_simpl ; auto with *; try omega. + +Next Obligation. + apply H. simpl. omega. +Defined. + +Next Obligation. + case (le_lt_dec p i) ; intros. assert(i = p) by omega. subst. + revert H0. clear_subset_proofs. auto. + apply H. simpl. assumption. Defined. diff --git a/test-suite/bugs/closed/2089.v b/test-suite/bugs/closed/bug_2089.v index aebccc9424..aebccc9424 100644 --- a/test-suite/bugs/closed/2089.v +++ b/test-suite/bugs/closed/bug_2089.v diff --git a/test-suite/bugs/closed/2095.v b/test-suite/bugs/closed/bug_2095.v index 28ea99dfef..28ea99dfef 100644 --- a/test-suite/bugs/closed/2095.v +++ b/test-suite/bugs/closed/bug_2095.v diff --git a/test-suite/bugs/closed/2105.v b/test-suite/bugs/closed/bug_2105.v index 46a416fd4b..46a416fd4b 100644 --- a/test-suite/bugs/closed/2105.v +++ b/test-suite/bugs/closed/bug_2105.v diff --git a/test-suite/bugs/closed/2108.v b/test-suite/bugs/closed/bug_2108.v index cad8baa981..cad8baa981 100644 --- a/test-suite/bugs/closed/2108.v +++ b/test-suite/bugs/closed/bug_2108.v diff --git a/test-suite/bugs/closed/bug_2117.v b/test-suite/bugs/closed/bug_2117.v new file mode 100644 index 0000000000..b68554a52a --- /dev/null +++ b/test-suite/bugs/closed/bug_2117.v @@ -0,0 +1,57 @@ +(* Check pattern-unification on evars in apply unification *) + +Axiom app : forall tau tau':Type, (tau -> tau') -> tau -> tau'. + +Axiom copy : forall tau:Type, tau -> tau -> Prop. +Axiom copyr : forall tau:Type, tau -> tau -> Prop. +Axiom copyf : forall tau:Type, tau -> tau -> Prop. +Axiom eq : forall tau:Type, tau -> tau -> Prop. +Axiom subst : forall tau tau':Type, (tau -> tau') -> tau -> tau' -> Prop. + +Axiom copy_atom : forall tau:Type, forall t t':tau, eq tau t t' -> copy tau t t'. +Axiom copy_fun: forall tau tau':Type, forall t t':(tau->tau'), +(forall x:tau, copyr tau x x->copy tau' (t x) (t' x)) +->copy (tau->tau') t t'. + +Axiom copyr_atom : forall tau:Type, forall t t':tau, copyr tau t t' -> eq tau t t'. +Axiom copyr_fun: forall tau tau':Type, forall t t':(tau->tau'), +copyr (tau->tau') t t' +->(forall x y:tau, copy tau x y->copyr tau' (t x) (t' y)). + +Axiom copyf_atom : forall tau:Type, forall t t':tau, copyf tau t t' -> eq tau t t'. +Axiom copyf_fun: forall tau tau':Type, forall t t':(tau->tau'), +copyr (tau->tau') t t' +->(forall x y:tau, forall z1 z2:tau', +(copy tau x y)-> +(subst tau tau' t x z1)-> +(subst tau tau' t' y z2)-> +copyf tau' z1 z2). + +Axiom eqappg: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau',forall t':tau', +( ((subst tau tau' t q t') /\ (eq tau' t' r)) +->eq tau' (app tau tau' t q) r). + +Axiom eqappd: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', +forall t':tau', ((subst tau tau' t q t') /\ (eq tau' r t')) +->eq tau' r (app tau tau' t q). + +Axiom substcopy: forall tau tau':Type, forall t:tau->tau', forall q:tau, forall r:tau', +(forall x:tau, (copyf tau x q) -> (copy tau' (t x) r)) +->subst tau tau' t q r. + +Ltac EtaLong := (apply copy_fun;intros;EtaLong)|| apply copy_atom. +Ltac Subst := apply substcopy;intros;EtaLong. +Ltac Rigid_aux := fun A => apply A|| Rigid_aux (copyr_fun _ _ _ _ A). +Ltac Rigid := fun A => apply copyr_atom; Rigid_aux A. + +Theorem church0: forall i:Type, exists X:(i->i)->i->i, +copy ((i->i)->i->i) (fun f:i->i => fun x:i=>f (X f x)) (fun f:i->i=>fun x:i=>app i i (X f) (f x)). +intros. +esplit. +EtaLong. +eapply eqappd;split. +Subst. +apply copyf_atom. +Show Existentials. +apply H1. +Abort. diff --git a/test-suite/bugs/closed/bug_2123.v b/test-suite/bugs/closed/bug_2123.v new file mode 100644 index 0000000000..0ff8bda6dc --- /dev/null +++ b/test-suite/bugs/closed/bug_2123.v @@ -0,0 +1,10 @@ +(* About the detection of non-dependent metas by the refine tactic *) + +(* The following is a simplification of bug #2123 *) + +Parameter fset : nat -> Set. +Parameter widen : forall (n : nat) (s : fset n), { x : fset (S n) | s=s }. +Goal forall i, fset (S i). +intro. +refine (proj1_sig (widen i _)). +Abort. diff --git a/test-suite/bugs/closed/2127.v b/test-suite/bugs/closed/bug_2127.v index 142ada268b..142ada268b 100644 --- a/test-suite/bugs/closed/2127.v +++ b/test-suite/bugs/closed/bug_2127.v diff --git a/test-suite/bugs/closed/bug_2135.v b/test-suite/bugs/closed/bug_2135.v new file mode 100644 index 0000000000..1638214e96 --- /dev/null +++ b/test-suite/bugs/closed/bug_2135.v @@ -0,0 +1,9 @@ +(* Check that metas are whd-normalized before trying 2nd-order unification *) +Lemma test : + forall (D:Type) (T : forall C, option C) (Q:forall D, option D -> Prop), + (forall (A : Type) (P : forall B:Type, option B -> Prop), P A (T A)) + -> Q D (T D). +Proof. + intros D T Q H. + pattern (T D). apply H. +Qed. diff --git a/test-suite/bugs/closed/2136.v b/test-suite/bugs/closed/bug_2136.v index 2fcfbe40dc..2fcfbe40dc 100644 --- a/test-suite/bugs/closed/2136.v +++ b/test-suite/bugs/closed/bug_2136.v diff --git a/test-suite/bugs/closed/2137.v b/test-suite/bugs/closed/bug_2137.v index b1f54b1766..b1f54b1766 100644 --- a/test-suite/bugs/closed/2137.v +++ b/test-suite/bugs/closed/bug_2137.v diff --git a/test-suite/bugs/closed/bug_2139.v b/test-suite/bugs/closed/bug_2139.v new file mode 100644 index 0000000000..07b94d540a --- /dev/null +++ b/test-suite/bugs/closed/bug_2139.v @@ -0,0 +1,25 @@ +(* Call of apply on <-> failed because of evars in elimination predicate *) +Generalizable Variables patch. + +Class Patch (patch : Type) := { + commute : patch -> patch -> Prop +}. + +Parameter flip : forall `{patchInstance : Patch patch} + {a b : patch}, + commute a b <-> commute b a. + +Lemma Foo : forall `{patchInstance : Patch patch} + {a b : patch}, + (commute a b) + -> True. +Proof. +intros. +apply flip in H. + +(* failed in well-formed arity check because elimination predicate of + iff in (@flip _ _ _ _) had normalized evars while the ones in the + type of (@flip _ _ _ _) itself had non-normalized evars *) + +(* By the way, is the check necessary ? *) +Abort. diff --git a/test-suite/bugs/closed/2141.v b/test-suite/bugs/closed/bug_2141.v index 22e33c8e81..22e33c8e81 100644 --- a/test-suite/bugs/closed/2141.v +++ b/test-suite/bugs/closed/bug_2141.v diff --git a/test-suite/bugs/closed/bug_2145.v b/test-suite/bugs/closed/bug_2145.v new file mode 100644 index 0000000000..949fc20364 --- /dev/null +++ b/test-suite/bugs/closed/bug_2145.v @@ -0,0 +1,19 @@ +(* Test robustness of Groebner tactic in presence of disequalities *) + +Require Export Reals. +Require Export Nsatz. + +Open Scope R_scope. + +Lemma essai : + forall yb xb m1 m2 xa ya, + xa <> xb -> + yb - 2 * m2 * xb = ya - m2 * xa -> + yb - m1 * xb = ya - m1 * xa -> + yb - ya = (2 * xb - xa) * m2 -> + yb - ya = (xb - xa) * m1. +Proof. +intros. +(* clear H. groebner used not to work when H was not cleared *) +nsatz. +Qed. diff --git a/test-suite/bugs/closed/bug_2149.v b/test-suite/bugs/closed/bug_2149.v new file mode 100644 index 0000000000..8bc5a2cefc --- /dev/null +++ b/test-suite/bugs/closed/bug_2149.v @@ -0,0 +1,6 @@ +Lemma Foo : forall x y : nat, y = x -> y = x. +Proof. +intros x y. +rename x into y, y into x. +trivial. +Qed. diff --git a/test-suite/bugs/closed/bug_2164.v b/test-suite/bugs/closed/bug_2164.v new file mode 100644 index 0000000000..9119a02419 --- /dev/null +++ b/test-suite/bugs/closed/bug_2164.v @@ -0,0 +1,335 @@ +(* Check that "inversion as" manages names as expected *) +Inductive type: Set + := | int: type + | pointer: type -> type. +Print type. + +Parameter value_set + : type -> Set. + +Parameter string : Set. + +Parameter Z : Set. + +Inductive lvalue (t: type): Set + := | var: string -> lvalue t (* name of the variable *) + | lvalue_loc: Z -> lvalue t (* address of the variable *) + | deref_l: lvalue (pointer t) -> lvalue t (* deref an lvalue ptr *) + | deref_r: rvalue (pointer t) -> lvalue t (* deref an rvalue ptr *) +with rvalue (t: type): Set + := | value_of: lvalue t -> rvalue t (* variable as value *) + | mk_rvalue: value_set t -> rvalue t. (* literal value *) +Print lvalue. + +Inductive statement: Set + := | void_stat: statement + | var_loc: (* to be destucted at end of scope *) + forall (t: type) (n: string) (loc: Z), statement + | var_ref: (* not to be destructed *) + forall (t: type) (n: string) (loc: Z), statement + | var_def: (* var def as typed in code *) + forall (t:type) (n: string) (val: rvalue t), statement + | assign: + forall (t: type) (var: lvalue t) (val: rvalue t), statement + | group: + forall (l: list statement), statement + | fun_def: + forall (s: string) (l: list statement), statement + | param_decl: + forall (t: type) (n: string), statement + | delete: + forall a: Z, statement. + +Inductive expr: Set +:= | statement_to_expr: statement -> expr + | lvalue_to_expr: forall t: type, lvalue t -> expr + | rvalue_to_expr: forall t: type, rvalue t -> expr. + +Inductive executable_prim_expr: expr -> Set +:= +(* statements *) + | var_def_primitive: + forall (t: type) (n: string) (loc: Z), + executable_prim_expr + (statement_to_expr + (var_def t n + (value_of t (lvalue_loc t loc)))) + | assign_primitive: + forall (t: type) (loc1 loc2: Z), + executable_prim_expr + (statement_to_expr + (assign t (lvalue_loc t loc1) + (value_of t (lvalue_loc t loc2)))) +(* rvalue *) + | mk_rvalue_primitive: + forall (t: type) (v: value_set t), + executable_prim_expr + (rvalue_to_expr t (mk_rvalue t v)) +(* lvalue *) + (* var *) + | var_primitive: + forall (t: type) (n: string), + executable_prim_expr (lvalue_to_expr t (var t n)) + (* deref_l *) + | deref_l_primitive: + forall (t: type) (loc: Z), + executable_prim_expr + (lvalue_to_expr t + (deref_l t (lvalue_loc (pointer t) loc))) + (* deref_r *) + | deref_r_primitive: + forall (t: type) (loc: Z), + executable_prim_expr + (lvalue_to_expr t + (deref_r t + (value_of (pointer t) + (lvalue_loc (pointer t) loc)))). + +Inductive executable_sub_expr: expr -> Set +:= | executable_sub_expr_prim: + forall e: expr, + executable_prim_expr e -> + executable_sub_expr e +(* statements *) + | var_def_sub_rvalue: + forall (t: type) (n: string) (rv: rvalue t), + executable_sub_expr (rvalue_to_expr t rv) -> + executable_sub_expr (statement_to_expr (var_def t n rv)) + | assign_sub_lvalue: + forall (t: type) (lv: lvalue t) (rv: rvalue t), + executable_sub_expr (lvalue_to_expr t lv) -> + executable_sub_expr (statement_to_expr (assign t lv rv)) + | assign_sub_rvalue: + forall (t: type) (lv: lvalue t) (rv: rvalue t), + executable_sub_expr (rvalue_to_expr t rv) -> + executable_sub_expr (statement_to_expr (assign t lv rv)) +(* rvalue *) + | value_of_sub_lvalue: + forall (t: type) (lv: lvalue t), + executable_sub_expr (lvalue_to_expr t lv) -> + executable_sub_expr (rvalue_to_expr t (value_of t lv)) +(* lvalue *) + | deref_l_sub_lvalue: + forall (t: type) (lv: lvalue (pointer t)), + executable_sub_expr (lvalue_to_expr (pointer t) lv) -> + executable_sub_expr (lvalue_to_expr t (deref_l t lv)) + | deref_r_sub_rvalue: + forall (t: type) (rv: rvalue (pointer t)), + executable_sub_expr (rvalue_to_expr (pointer t) rv) -> + executable_sub_expr (lvalue_to_expr t (deref_r t rv)). + +Inductive expr_kind: Set +:= | statement_kind: expr_kind + | lvalue_kind: type -> expr_kind + | rvalue_kind: type -> expr_kind. + +Definition expr_to_kind: expr -> expr_kind. +intro e. +destruct e. +exact statement_kind. +exact (lvalue_kind t). +exact (rvalue_kind t). +Defined. + +Inductive def_sub_expr_subs: + forall e: expr, + forall ee: executable_sub_expr e, + forall ee': expr, + forall e': expr, + Prop +:= | def_sub_expr_subs_prim: + forall e: expr, + forall p: executable_prim_expr e, + forall ee': expr, + expr_to_kind e = expr_to_kind ee' -> + def_sub_expr_subs e (executable_sub_expr_prim e p) ee' ee' + | def_sub_expr_subs_var_def_sub_rvalue: + forall (t: type) (n: string), + forall rv rv': rvalue t, + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr t rv), + def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' + (rvalue_to_expr t rv') -> + def_sub_expr_subs + (statement_to_expr (var_def t n rv)) + (var_def_sub_rvalue t n rv se_rv) + ee' + (statement_to_expr (var_def t n rv')) + | def_sub_expr_subs_assign_sub_lvalue: + forall t: type, + forall lv lv': lvalue t, + forall rv: rvalue t, + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' + (lvalue_to_expr t lv') -> + def_sub_expr_subs + (statement_to_expr (assign t lv rv)) + (assign_sub_lvalue t lv rv se_lv) + ee' + (statement_to_expr (assign t lv' rv)) + | def_sub_expr_subs_assign_sub_rvalue: + forall t: type, + forall lv: lvalue t, + forall rv rv': rvalue t, + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr t rv), + def_sub_expr_subs (rvalue_to_expr t rv) se_rv ee' + (rvalue_to_expr t rv') -> + def_sub_expr_subs + (statement_to_expr (assign t lv rv)) + (assign_sub_rvalue t lv rv se_rv) + ee' + (statement_to_expr (assign t lv rv')) + | def_sub_expr_subs_value_of_sub_lvalue: + forall t: type, + forall lv lv': lvalue t, + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (lvalue_to_expr t lv) se_lv ee' + (lvalue_to_expr t lv') -> + def_sub_expr_subs + (rvalue_to_expr t (value_of t lv)) + (value_of_sub_lvalue t lv se_lv) + ee' + (rvalue_to_expr t (value_of t lv')) + | def_sub_expr_subs_deref_l_sub_lvalue: + forall t: type, + forall lv lv': lvalue (pointer t), + forall ee': expr, + forall se_lv: executable_sub_expr (lvalue_to_expr (pointer t) lv), + def_sub_expr_subs (lvalue_to_expr (pointer t) lv) se_lv ee' + (lvalue_to_expr (pointer t) lv') -> + def_sub_expr_subs + (lvalue_to_expr t (deref_l t lv)) + (deref_l_sub_lvalue t lv se_lv) + ee' + (lvalue_to_expr t (deref_l t lv')) + | def_sub_expr_subs_deref_r_sub_rvalue: + forall t: type, + forall rv rv': rvalue (pointer t), + forall ee': expr, + forall se_rv: executable_sub_expr (rvalue_to_expr (pointer t) rv), + def_sub_expr_subs (rvalue_to_expr (pointer t) rv) se_rv ee' + (rvalue_to_expr (pointer t) rv') -> + def_sub_expr_subs + (lvalue_to_expr t (deref_r t rv)) + (deref_r_sub_rvalue t rv se_rv) + ee' + (lvalue_to_expr t (deref_r t rv')). + +Lemma type_dec: forall t t': type, {t = t'} + {t <> t'}. +Proof. +intros t. +induction t as [|t IH]. +destruct t'. +tauto. +right. +discriminate. +destruct t'. +right. +discriminate. +destruct (IH t') as [H|H]. +left. +f_equal. +tauto. +right. +injection. +tauto. +Qed. +Check type_dec. + +Definition sigT_get_proof: + forall T: Type, + forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, + forall P: T -> Type, + forall t: T, + P t -> + sigT P -> + P t. +intros T eq_dec_T P t H1 H2. +destruct H2 as [t' H2]. +destruct (eq_dec_T t t') as [H3|H3]. +rewrite H3. +exact H2. +exact H1. +Defined. + +Axiom sigT_get_proof_existT_same: + forall T: Type, + forall eq_dec_T: forall t t': T, {t = t'} + {~ t = t'}, + forall P: T -> Type, + forall t: T, + forall H1 H2: P t, + sigT_get_proof T eq_dec_T P t H1 (existT P t H2) = H2. + +Theorem existT_injective: + forall T, + (forall t1 t2: T, { t1 = t2 } + { t1 <> t2 }) -> + forall P: T -> Type, + forall t: T, + forall pt1 pt2: P t, + existT P t pt1 = existT P t pt2 -> + pt1 = pt2. +Proof. +intros T T_dec P t pt1 pt2 H1. +pose (H2 := f_equal (sigT_get_proof T T_dec P t pt1) H1). +repeat rewrite sigT_get_proof_existT_same in H2. +assumption. +Qed. + +Ltac decide_equality_sub dec x x' H := + destruct (dec x x') as [H|H]; + [subst x'; try tauto|try(right; injection; tauto; fail)]. + +Axiom value_set_dec: + forall t: type, + forall v v': value_set t, + {v = v'} + {v <> v'}. + +Theorem lvalue_dec: + forall (t: type) (l l': lvalue t), {l = l'} + {l <> l'} +with rvalue_dec: + forall (t: type) (r r': rvalue t), {r = r'} + {r <> r'}. +Admitted. + +Theorem sub_expr_subs_same_kind: + forall e: expr, + forall ee: executable_sub_expr e, + forall ee': expr, + forall e': expr, + def_sub_expr_subs e ee ee' e' -> + expr_to_kind e = expr_to_kind e'. +Proof. +intros e ee ee' e' H1. +case H1; try (intros; tauto; fail). +Qed. + +Theorem def_sub_expr_subs_assign_sub_lvalue_inversion: + forall t: type, + forall lv: lvalue t, + forall rv: rvalue t, + forall ee' e': expr, + forall ee_sub: executable_sub_expr (lvalue_to_expr t lv), + def_sub_expr_subs (statement_to_expr (assign t lv rv)) + (assign_sub_lvalue t lv rv ee_sub) ee' e' -> + { lv': lvalue t + | def_sub_expr_subs (lvalue_to_expr t lv) ee_sub ee' + (lvalue_to_expr t lv') + & e' = statement_to_expr (assign t lv' rv) }. +Proof. +intros t lv rv ee' [s'|t' lv''|t' rv''] ee_sub H1; + try discriminate (sub_expr_subs_same_kind _ _ _ _ H1). +destruct s' as [| | | |t' lv'' rv''| | | |]; + try(assert (H2: False); [inversion H1|elim H2]; fail). +destruct (type_dec t t') as [H2|H2]; + [|assert (H3: False); + [|elim H3; fail]]. +2: inversion H1 as [];tauto. +subst t'. +exists lv''. + inversion H1 as + [| |t' lv''' lv'''' rv''' ee'' ee_sub' H2 (H3_1,H3_2,H3_3) (H4_1,H4_2,H4_3,H4_4,H4_5) H5 (H6_1,H6_2)| | | |]. +(* Check that all names are the given ones: *) +clear t' lv''' lv'''' rv''' ee'' ee_sub' H2 H3_1 H3_2 H3_3 H4_1 H4_2 H4_3 H4_4 H4_5 H5 H6_1 H6_2. +Abort. diff --git a/test-suite/bugs/closed/2181.v b/test-suite/bugs/closed/bug_2181.v index 62820d8699..62820d8699 100644 --- a/test-suite/bugs/closed/2181.v +++ b/test-suite/bugs/closed/bug_2181.v diff --git a/test-suite/bugs/closed/bug_2193.v b/test-suite/bugs/closed/bug_2193.v new file mode 100644 index 0000000000..780636718e --- /dev/null +++ b/test-suite/bugs/closed/bug_2193.v @@ -0,0 +1,31 @@ +(* Computation of dependencies in the "match" return predicate was incomplete *) +(* Submitted by R. O'Connor, Nov 2009 *) + +Inductive Symbol : Set := + | VAR : Symbol. + +Inductive SExpression := + | atomic : Symbol -> SExpression. + +Inductive ProperExpr : SExpression -> SExpression -> Type := + | pe_3 : forall (x : Symbol) (alpha : SExpression), + ProperExpr alpha (atomic VAR) -> + ProperExpr (atomic x) alpha. + +Definition A (P : forall s : SExpression, Type) + (x alpha alpha1 : SExpression) + (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := + match t as pe in ProperExpr a b return option (a = atomic VAR) with + | pe_3 x0 alpha3 tye' => + (fun (x:Symbol) (alpha : SExpression) => @None (atomic x = atomic VAR)) + x0 alpha3 + end. + +Definition B (P : forall s : SExpression, Type) + (x alpha alpha1 : SExpression) + (t : ProperExpr (x) alpha1) : option (x = atomic VAR) := + match t as pe in ProperExpr a b return option (a = atomic VAR) with + | pe_3 x0 alpha3 tye' => + (fun (x:Symbol) (alpha : SExpression) (t:ProperExpr alpha (atomic VAR)) => @None (atomic x = atomic VAR)) + x0 alpha3 tye' + end. diff --git a/test-suite/bugs/closed/2230.v b/test-suite/bugs/closed/bug_2230.v index 5076fb2bb7..5076fb2bb7 100644 --- a/test-suite/bugs/closed/2230.v +++ b/test-suite/bugs/closed/bug_2230.v diff --git a/test-suite/bugs/closed/2231.v b/test-suite/bugs/closed/bug_2231.v index 03e2c9bbf4..03e2c9bbf4 100644 --- a/test-suite/bugs/closed/2231.v +++ b/test-suite/bugs/closed/bug_2231.v diff --git a/test-suite/bugs/closed/bug_2243.v b/test-suite/bugs/closed/bug_2243.v new file mode 100644 index 0000000000..65a4c15eff --- /dev/null +++ b/test-suite/bugs/closed/bug_2243.v @@ -0,0 +1,11 @@ +Inductive is_nul: nat -> Prop := X: is_nul 0. +Section O. +Variable u: nat. +Variable H: is_nul u. +Goal True. +Proof. +destruct H. +Undo. +revert H; intro H; destruct H. +Abort. +End O. diff --git a/test-suite/bugs/closed/bug_2244.v b/test-suite/bugs/closed/bug_2244.v new file mode 100644 index 0000000000..948251082c --- /dev/null +++ b/test-suite/bugs/closed/bug_2244.v @@ -0,0 +1,20 @@ +(* 1st-order unification did not work when in competition with pattern unif. *) + +Set Implicit Arguments. +Lemma test : forall + (A : Type) + (B : Type) + (f : A -> B) + (S : B -> Prop) + (EV : forall y (f':A->B), (forall x', S (f' x')) -> S (f y)) + (HS : forall x', S (f x')) + (x : A), + S (f x). +Proof. + intros. eapply EV. intros. + (* worked in v8.2 but not in v8.3beta, fixed in r12898 *) + apply HS. + + (* still not compatible with 8.2 because an evar can be solved in + two different ways and is left open *) +Abort. diff --git a/test-suite/bugs/closed/2245.v b/test-suite/bugs/closed/bug_2245.v index f0162f3b27..f0162f3b27 100644 --- a/test-suite/bugs/closed/2245.v +++ b/test-suite/bugs/closed/bug_2245.v diff --git a/test-suite/bugs/closed/2250.v b/test-suite/bugs/closed/bug_2250.v index 565d7b68fd..565d7b68fd 100644 --- a/test-suite/bugs/closed/2250.v +++ b/test-suite/bugs/closed/bug_2250.v diff --git a/test-suite/bugs/closed/2251.v b/test-suite/bugs/closed/bug_2251.v index d0fa3f2b33..d0fa3f2b33 100644 --- a/test-suite/bugs/closed/2251.v +++ b/test-suite/bugs/closed/bug_2251.v diff --git a/test-suite/bugs/closed/bug_2255.v b/test-suite/bugs/closed/bug_2255.v new file mode 100644 index 0000000000..7981dc1f20 --- /dev/null +++ b/test-suite/bugs/closed/bug_2255.v @@ -0,0 +1,22 @@ +(* Check injection in presence of dependencies hidden in applicative terms *) + +Inductive TupleT : nat -> Type := + nilT : TupleT 0 +| consT {n} A : (A -> TupleT n) -> TupleT (S n). + +Inductive Tuple : forall n, TupleT n -> Type := + nil : Tuple _ nilT +| cons {n} A (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). + +Goal forall n A F x X n0 A0 x0 F0 H0 (H : existT (fun n0 : nat => {H0 : TupleT +n0 & Tuple n0 H0}) + (S n0) + (existT (fun H0 : TupleT (S n0) => Tuple (S n0) H0) + (consT A0 F0) (cons A0 x0 F0 H0)) = + existT (fun n0 : nat => {H0 : TupleT n0 & Tuple n0 H0}) + (S n) + (existT (fun H0 : TupleT (S n) => Tuple (S n) H0) + (consT A F) (cons A x F X))), False. +intros. +injection H. +Abort. diff --git a/test-suite/bugs/closed/bug_2262.v b/test-suite/bugs/closed/bug_2262.v new file mode 100644 index 0000000000..1533960150 --- /dev/null +++ b/test-suite/bugs/closed/bug_2262.v @@ -0,0 +1,10 @@ + + +Generalizable Variables A. +Class Test A := { test : A }. + +Lemma mylemma : forall `{Test A}, test = test. +Admitted. (* works fine *) + +Definition mylemma' := forall `{Test A}, test = test. +About mylemma'. diff --git a/test-suite/bugs/closed/2281.v b/test-suite/bugs/closed/bug_2281.v index 8f549b9201..8f549b9201 100644 --- a/test-suite/bugs/closed/2281.v +++ b/test-suite/bugs/closed/bug_2281.v diff --git a/test-suite/bugs/closed/bug_2295.v b/test-suite/bugs/closed/bug_2295.v new file mode 100644 index 0000000000..584edf19b9 --- /dev/null +++ b/test-suite/bugs/closed/bug_2295.v @@ -0,0 +1,13 @@ +(* Check if omission of "as" in return clause works w/ section variables too *) + +Section sec. + +Variable b: bool. + +Definition d' := + (match b return b = true \/ b = false with + | true => or_introl _ (refl_equal true) + | false => or_intror _ (refl_equal false) + end). + +End sec. diff --git a/test-suite/bugs/closed/bug_2299.v b/test-suite/bugs/closed/bug_2299.v new file mode 100644 index 0000000000..2f0aad90b6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2299.v @@ -0,0 +1,16 @@ +(* Check that destruct refreshes universes in what it generalizes *) + +Section test. + +Variable A: Type. + +Inductive T: unit -> Type := C: A -> unit -> T tt. + +Let unused := T tt. + +Goal T tt -> False. + intro X. + destruct X. +Abort. + +End test. diff --git a/test-suite/bugs/closed/2300.v b/test-suite/bugs/closed/bug_2300.v index 4e587cbb25..4e587cbb25 100644 --- a/test-suite/bugs/closed/2300.v +++ b/test-suite/bugs/closed/bug_2300.v diff --git a/test-suite/bugs/closed/2303.v b/test-suite/bugs/closed/bug_2303.v index e614b9b552..e614b9b552 100644 --- a/test-suite/bugs/closed/2303.v +++ b/test-suite/bugs/closed/bug_2303.v diff --git a/test-suite/bugs/closed/bug_2304.v b/test-suite/bugs/closed/bug_2304.v new file mode 100644 index 0000000000..663c42e480 --- /dev/null +++ b/test-suite/bugs/closed/bug_2304.v @@ -0,0 +1,3 @@ +(* This used to fail with an anomaly NotASort at some time *) +Class A (O: Type): Type := a: O -> Type. +Fail Goal forall (x: a tt), @a x = @a x. diff --git a/test-suite/bugs/closed/bug_2307.v b/test-suite/bugs/closed/bug_2307.v new file mode 100644 index 0000000000..2c82a61a68 --- /dev/null +++ b/test-suite/bugs/closed/bug_2307.v @@ -0,0 +1,2 @@ +Inductive V: nat -> Type := VS n: V (S n). +Definition f (e: V 1): nat := match e with VS 0 => 3 end. diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/bug_2310.v index 14a3e5a7b0..14a3e5a7b0 100644 --- a/test-suite/bugs/closed/2310.v +++ b/test-suite/bugs/closed/bug_2310.v diff --git a/test-suite/bugs/closed/2319.v b/test-suite/bugs/closed/bug_2319.v index 73d95e91a1..73d95e91a1 100644 --- a/test-suite/bugs/closed/2319.v +++ b/test-suite/bugs/closed/bug_2319.v diff --git a/test-suite/bugs/closed/bug_2320.v b/test-suite/bugs/closed/bug_2320.v new file mode 100644 index 0000000000..8c9b1f5049 --- /dev/null +++ b/test-suite/bugs/closed/bug_2320.v @@ -0,0 +1,15 @@ +(* Managing metavariables in the return clause of a match *) + +(* This was working in 8.1 but is failing in 8.2 and 8.3. It works in + trunk thanks to the new proof engine. It could probably made to work in + 8.2 and 8.3 if a return predicate of the form "dummy 0" instead of + (or in addition to) a sophisticated predicate of the form + "as x in dummy y return match y with 0 => ?P | _ => ID end" *) + +Inductive dummy : nat -> Prop := constr : dummy 0. + +Lemma failure : forall (x : dummy 0), x = constr. +Proof. +intros x. +refine (match x with constr => _ end). +Abort. diff --git a/test-suite/bugs/closed/bug_2342.v b/test-suite/bugs/closed/bug_2342.v new file mode 100644 index 0000000000..e55bda05a6 --- /dev/null +++ b/test-suite/bugs/closed/bug_2342.v @@ -0,0 +1,7 @@ +(* Checking that the type inference algoithme does not commit to an + equality over sorts when only a subtyping constraint is around *) + +Parameter A : Set. +Parameter B : A -> Set. +Parameter F : Set -> Prop. +Check (F (forall x, B x)). diff --git a/test-suite/bugs/closed/bug_2347.v b/test-suite/bugs/closed/bug_2347.v new file mode 100644 index 0000000000..11456c7e35 --- /dev/null +++ b/test-suite/bugs/closed/bug_2347.v @@ -0,0 +1,10 @@ +Require Import EquivDec List. +Generalizable All Variables. + +Program Definition list_eqdec `(eqa : EqDec A eq) : EqDec (list A) eq := + (fun (x y : list A) => _). +Admit Obligations of list_eqdec. + +Program Definition list_eqdec' `(eqa : EqDec A eq) : EqDec (list A) eq := + (fun _ : nat => (fun (x y : list A) => _)) 0. +Admit Obligations of list_eqdec'. diff --git a/test-suite/bugs/closed/bug_2350.v b/test-suite/bugs/closed/bug_2350.v new file mode 100644 index 0000000000..18c7ebda54 --- /dev/null +++ b/test-suite/bugs/closed/bug_2350.v @@ -0,0 +1,7 @@ +(* Check that the fix tactic, when called from refine, reduces enough + to see the products *) + +Definition foo := forall n:nat, n=n. +Definition bar : foo. +refine (fix aux (n:nat) := _). +Abort. diff --git a/test-suite/bugs/closed/2353.v b/test-suite/bugs/closed/bug_2353.v index baae9a6ece..baae9a6ece 100644 --- a/test-suite/bugs/closed/2353.v +++ b/test-suite/bugs/closed/bug_2353.v diff --git a/test-suite/bugs/closed/bug_2360.v b/test-suite/bugs/closed/bug_2360.v new file mode 100644 index 0000000000..1aed53c6ed --- /dev/null +++ b/test-suite/bugs/closed/bug_2360.v @@ -0,0 +1,13 @@ +(* This failed in V8.3 because descend_in_conjunctions built ill-typed terms *) +Definition interp (etyp : nat -> Type) (p: nat) := etyp p. + +Record Value (etyp : nat -> Type) := Mk { + typ : nat; + value : interp etyp typ +}. + +Definition some_value (etyp : nat -> Type) : (Value etyp). +Proof. + intros. + Fail apply Mk. (* Check that it does not raise an anomaly *) +Abort. diff --git a/test-suite/bugs/closed/bug_2362.v b/test-suite/bugs/closed/bug_2362.v new file mode 100644 index 0000000000..ffd51a5dba --- /dev/null +++ b/test-suite/bugs/closed/bug_2362.v @@ -0,0 +1,36 @@ +Set Implicit Arguments. + +Class Pointed (M:Type -> Type) := +{ + creturn: forall {A: Type}, A -> M A +}. + +Unset Implicit Arguments. +Inductive FPair (A B:Type) (neutral: B) : Type:= + fpair : forall (a:A) (b:B), FPair A B neutral. +Arguments fpair {A B neutral}. + +Set Implicit Arguments. + +Notation "( x ,> y )" := (fpair x y) (at level 0). + +Instance Pointed_FPair B neutral: + Pointed (fun A => FPair A B neutral) := + { creturn := fun A (a:A) => (a,> neutral) }. +Definition blah_fail (x:bool) : FPair bool nat O := + creturn x. +Set Printing All. Print blah_fail. + +Definition blah_explicit (x:bool) : FPair bool nat O := + @creturn _ (Pointed_FPair _ ) _ x. + +Print blah_explicit. + + +Instance Pointed_FPair_mono: + Pointed (fun A => FPair A nat 0) := + { creturn := fun A (a:A) => (a,> 0) }. + + +Definition blah (x:bool) : FPair bool nat O := + creturn x. diff --git a/test-suite/bugs/closed/bug_2375.v b/test-suite/bugs/closed/bug_2375.v new file mode 100644 index 0000000000..f1ca269646 --- /dev/null +++ b/test-suite/bugs/closed/bug_2375.v @@ -0,0 +1,17 @@ +(* In the following code, the (superfluous) lemma [lem] is responsible +for the failure of congruence. *) + +Definition f : nat -> Prop := fun x => True. + +Lemma lem : forall x, (True -> True) = ( True -> f x). +Proof. + intros. reflexivity. +Qed. + +Goal forall (x:nat), x = x. +Proof. + intros. + assert (lem := lem). + (*clear ax.*) + congruence. +Qed. diff --git a/test-suite/bugs/closed/bug_2378.v b/test-suite/bugs/closed/bug_2378.v new file mode 100644 index 0000000000..a96a23ff40 --- /dev/null +++ b/test-suite/bugs/closed/bug_2378.v @@ -0,0 +1,613 @@ +Require Import TestSuite.admit. +(* test with Coq 8.3rc1 *) + +Require Import Program. + +Inductive Unit: Set := unit: Unit. + +Definition eq_dec T := forall x y:T, {x=y}+{x<>y}. + +Section TTS_TASM. + +Variable Time: Set. +Variable Zero: Time. +Variable tle: Time -> Time -> Prop. +Variable tlt: Time -> Time -> Prop. +Variable tadd: Time -> Time -> Time. +Variable tsub: Time -> Time -> Time. +Variable tmin: Time -> Time -> Time. +Notation "t1 @<= t2" := (tle t1 t2) (at level 70, no associativity). +Notation "t1 @< t2" := (tlt t1 t2) (at level 70, no associativity). +Notation "t1 @+ t2" := (tadd t1 t2) (at level 50, left associativity). +Notation "t1 @- t2" := (tsub t1 t2) (at level 50, left associativity). +Notation "t1 @<= t2 @<= t3" := ((tle t1 t2) /\ (tle t2 t3)) (at level 70, t2 at next level). +Notation "t1 @<= t2 @< t3" := ((tle t1 t2) /\ (tlt t2 t3)) (at level 70, t2 at next level). + +Variable tzerop: forall n, (n = Zero) + {Zero @< n}. +Variable tlt_eq_gt_dec: forall x y, {x @< y} + {x=y} + {y @< x}. +Variable tle_plus_l: forall n m, n @<= n @+ m. +Variable tle_lt_eq_dec: forall n m, n @<= m -> {n @< m} + {n = m}. + +Variable tzerop_zero: tzerop Zero = inleft (Zero @< Zero) (@eq_refl _ Zero). +Variable tplus_n_O: forall n, n @+ Zero = n. +Variable tlt_le_weak: forall n m, n @< m -> n @<= m. +Variable tlt_irrefl: forall n, ~ n @< n. +Variable tplus_nlt: forall n m, ~n @+ m @< n. +Variable tle_n: forall n, n @<= n. +Variable tplus_lt_compat_l: forall n m p, n @< m -> p @+ n @< p @+ m. +Variable tlt_trans: forall n m p, n @< m -> m @< p -> n @< p. +Variable tle_lt_trans: forall n m p, n @<= m -> m @< p -> n @< p. +Variable tlt_le_trans: forall n m p, n @< m -> m @<= p -> n @< p. +Variable tle_refl: forall n, n @<= n. +Variable tplus_le_0: forall n m, n @+ m @<= n -> m = Zero. +Variable Time_eq_dec: eq_dec Time. + +(*************************************************************) + +Section PropLogic. +Variable Predicate: Type. + +Inductive LP: Type := + LPPred: Predicate -> LP +| LPAnd: LP -> LP -> LP +| LPNot: LP -> LP. + +Variable State: Type. +Variable Sat: State -> Predicate -> Prop. + +Fixpoint lpSat st f: Prop := + match f with + LPPred p => Sat st p + | LPAnd f1 f2 => lpSat st f1 /\ lpSat st f2 + | LPNot f1 => ~lpSat st f1 + end. +End PropLogic. + +Arguments lpSat : default implicits. + +Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := + match f with + LPPred _ p => p2lp p + | LPAnd _ f1 f2 => LPAnd _ (LPTransfo Pred1 Pred2 p2lp f1) (LPTransfo Pred1 Pred2 p2lp f2) + | LPNot _ f1 => LPNot _ (LPTransfo Pred1 Pred2 p2lp f1) + end. +Arguments LPTransfo : default implicits. + +Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := + LPTransfo (fun p => LPPred _ (existT (fun i => Pred i) i p)) f. + +Section TTS. + +Variable State: Type. + +Record TTS: Type := mkTTS { + Init: State -> Prop; + Delay: State -> Time -> State -> Prop; + Next: State -> State -> Prop; + Predicate: Type; + Satisfy: State -> Predicate -> Prop +}. + +Definition TTSIndexedProduct Ind (tts: Ind -> TTS): TTS := mkTTS + (fun st => forall i, Init (tts i) st) + (fun st d st' => forall i, Delay (tts i) st d st') + (fun st st' => forall i, Next (tts i) st st') + { i: Ind & Predicate (tts i) } + (fun st p => Satisfy (tts (projT1 p)) st (projT2 p)). + +End TTS. + +Section SIMU_F. + +Variables StateA StateC: Type. + +Record mapping: Type := mkMapping { + mState: Type; + mInit: StateC -> mState; + mNext: mState -> StateC -> mState; + mDelay: mState -> StateC -> Time -> mState; + mabs: mState -> StateC -> StateA +}. + +Variable m: mapping. + +Record simu (Pred: Type) (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuPrf { + inv: (mState m) -> StateC -> Prop; + invInit: forall st, Init _ c st -> inv (mInit m st) st; + invDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> inv (mDelay m ex1 st1 d) st2; + invNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> inv (mNext m ex1 st1) st2; + simuInit: forall st, Init _ c st -> Init _ a (mabs m (mInit m st) st); + simuDelay: forall ex1 st1 st2 d, Delay _ c st1 d st2 -> inv ex1 st1 -> + Delay _ a (mabs m ex1 st1) d (mabs m (mDelay m ex1 st1 d) st2); + simuNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> + Next _ a (mabs m ex1 st1) (mabs m (mNext m ex1 st1) st2); + simuPred: forall ext st, inv ext st -> + (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) +}. + +Theorem satProd: forall State Ind Pred (Sat: forall i, State -> Pred i -> Prop) (st:State) i (f: LP (Pred i)), + lpSat (Sat i) st f + <-> + lpSat + (fun (st : State) (p : {i : Ind & Pred i}) => Sat (projT1 p) st (projT2 p)) st + (addIndex Ind _ i f). +Proof. + induction f; simpl; intros; split; intros; intuition. +Qed. + +Definition trProd (State: Type) Ind (Pred: Ind -> Type) (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))): + {i:Ind & Pred i} -> LP (Predicate _ (TTSIndexedProduct _ Ind tts)) := + fun p => addIndex Ind _ (projT1 p) (tr (projT1 p) (projT2 p)). + +Arguments trProd : default implicits. +Require Import Setoid. + +Theorem satTrProd: + forall State Ind Pred (tts: Ind -> TTS State) + (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))) (st:State) (p: {i:Ind & (Pred i)}), + lpSat (Satisfy _ (tts (projT1 p))) st (tr (projT1 p) (projT2 p)) + <-> + lpSat (Satisfy _ (TTSIndexedProduct _ _ tts)) st (trProd _ tts tr p). +Proof. + unfold trProd, TTSIndexedProduct; simpl; intros. + rewrite (satProd State Ind (fun i => Predicate State (tts i)) + (fun i => Satisfy _ (tts i))); tauto. +Qed. + +Theorem simuProd: + forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) + (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) + (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), + (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> + simu _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) + (trProd Pred tta tra) (trProd Pred ttc trc). +Proof. + intros. + apply simuPrf with (fun ex st => forall i, inv _ _ (ttc i) (tra i) (trc i) (X i) ex st); simpl; intros; auto. + eapply invInit; eauto. + eapply invDelay; eauto. + eapply invNext; eauto. + eapply simuInit; eauto. + eapply simuDelay; eauto. + eapply simuNext; eauto. + split; simpl; intros. + generalize (proj1 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. + rewrite <- (satTrProd StateA Ind Pred tta tra); apply H1. + rewrite (satTrProd StateC Ind Pred ttc trc); apply H0. + + generalize (proj2 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. + rewrite <- (satTrProd StateC Ind Pred ttc trc); apply H1. + rewrite (satTrProd StateA Ind Pred tta tra); apply H0. +Qed. + +End SIMU_F. + +Section TRANSFO. + +Record simu_equiv StateA StateC m1 m2 Pred (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predicate _ a)) (trc: Pred -> LP (Predicate _ c)): Type := simuEquivPrf { + simuLR: simu StateA StateC m1 Pred a c tra trc; + simuRL: simu StateC StateA m2 Pred c a trc tra +}. + +Theorem simu_equivProd: + forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) + (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) + (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), + (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> + simu_equiv StateA StateC m1 m2 _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) + (trProd _ _ Pred tta tra) (trProd _ _ Pred ttc trc). +Proof. + intros; split; intros. + apply simuProd; intro. + elim (X i); auto. + apply simuProd; intro. + elim (X i); auto. +Qed. + +Record RTLanguage: Type := mkRTLanguage { + Syntax: Type; + DynamicState: Syntax -> Type; + Semantic: forall (mdl:Syntax), TTS (DynamicState mdl); + MdlPredicate: Syntax -> Type; + MdlPredicateDefinition: forall mdl, MdlPredicate mdl -> LP (Predicate _ (Semantic mdl)) +}. + +Record Transformation (l1 l2: RTLanguage): Type := mkTransformation { + Tmodel: Syntax l1 -> Syntax l2; + Tl1l2: forall mdl, mapping (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)); + Tl2l1: forall mdl, mapping (DynamicState l2 (Tmodel mdl)) (DynamicState l1 mdl); + Tpred: forall mdl, MdlPredicate l1 mdl -> LP (MdlPredicate l2 (Tmodel mdl)); + Tsim: forall mdl, simu_equiv (DynamicState l1 mdl) (DynamicState l2 (Tmodel mdl)) (Tl1l2 mdl) (Tl2l1 mdl) + (MdlPredicate l1 mdl) (Semantic l1 mdl) (Semantic l2 (Tmodel mdl)) + (MdlPredicateDefinition l1 mdl) + (fun p => LPTransfo (MdlPredicateDefinition l2 (Tmodel mdl)) (Tpred mdl p)) +}. + +Section Product. + +Record PSyntax (L: RTLanguage): Type := mkPSyntax { + pIndex: Type; + pIsEmpty: pIndex + {pIndex -> False}; + pState: Type; + pComponents: pIndex -> Syntax L; + pIsShared: forall i, DynamicState L (pComponents i) = pState +}. + +Definition pPredicate (L: RTLanguage) (sys: PSyntax L) := { i : pIndex L sys & MdlPredicate L (pComponents L sys i)}. + +(* product with shared state *) + +Definition PLanguage (L: RTLanguage): RTLanguage := + mkRTLanguage + (PSyntax L) + (pState L) + (fun mdl => TTSIndexedProduct (pState L mdl) (pIndex L mdl) + (fun i => match pIsShared L mdl i in (_ = y) return TTS y with + eq_refl => Semantic L (pComponents L mdl i) + end)) + (pPredicate L) + (fun mdl => trProd _ _ _ _ + (fun i pi => match pIsShared L mdl i as e in (_ = y) return + (LP (Predicate y + match e in (_ = y0) return (TTS y0) with + | eq_refl => Semantic L (pComponents L mdl i) + end)) + with + | eq_refl => MdlPredicateDefinition L (pComponents L mdl i) pi + end)). + +Inductive Empty: Type :=. + +Record isSharedTransfo l1 l2 tr: Prop := isSharedTransfoPrf { +sameState: forall mdl i j, + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j)); +sameMState: forall mdl i j, + mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl i)) = + mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl j)); +sameM12: forall mdl i j, + Tl1l2 _ _ tr (pComponents l1 mdl i) = + match sym_eq (sameState mdl i j) in _=y return mapping _ y with + eq_refl => match sym_eq (pIsShared l1 mdl i) in _=x return mapping x _ with + eq_refl => match pIsShared l1 mdl j in _=x return mapping x _ with + eq_refl => Tl1l2 _ _ tr (pComponents l1 mdl j) + end + end + end; +sameM21: forall mdl i j, + Tl2l1 l1 l2 tr (pComponents l1 mdl i) = + match + sym_eq (sameState mdl i j) in (_ = y) + return (mapping y (DynamicState l1 (pComponents l1 mdl i))) + with eq_refl => + match + sym_eq (pIsShared l1 mdl i) in (_ = y) + return + (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) + with + | eq_refl => + match + pIsShared l1 mdl j in (_ = y) + return + (mapping + (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j))) y) + with + | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl j) + end + end +end +}. + +Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := + mkPSyntax l2 (pIndex l1 mdl) + (pIsEmpty l1 mdl) + (match pIsEmpty l1 mdl return Type with + inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + |inright h => pState l1 mdl + end) + (fun i => Tmodel l1 l2 tr (pComponents l1 mdl i)) + (fun i => match pIsEmpty l1 mdl as y return + (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = + match y with + | inleft i0 => + DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i0)) + | inright _ => pState l1 mdl + end) + with + inleft j => sameState l1 l2 tr h mdl i j + | inright h => match h i with end + end). + +Definition compSemantic l mdl i := + match pIsShared l mdl i in (_=y) return TTS y with + eq_refl => Semantic l (pComponents l mdl i) + end. + +Definition compSemanticEq l mdl i s (e: DynamicState l (pComponents l mdl i) = s) := + match e in (_=y) return TTS y with + eq_refl => Semantic l (pComponents l mdl i) + end. + +Definition Pmap12 l1 l2 tr (h: isSharedTransfo l1 l2 tr) (mdl : PSyntax l1) := +match + pIsEmpty l1 mdl as s + return + (mapping (pState l1 mdl) + match s with + | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + | inright _ => pState l1 mdl + end) +with +| inleft p => + match + pIsShared l1 mdl p in (_ = y) + return + (mapping y (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p)))) + with + | eq_refl => Tl1l2 l1 l2 tr (pComponents l1 mdl p) + end +| inright _ => + mkMapping (pState l1 mdl) (pState l1 mdl) Unit + (fun _ : pState l1 mdl => unit) + (fun (_ : Unit) (_ : pState l1 mdl) => unit) + (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) + (fun (_ : Unit) (X : pState l1 mdl) => X) +end. + +Definition Pmap21 l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl := +match + pIsEmpty l1 mdl as s + return + (mapping + match s with + | inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + | inright _ => pState l1 mdl + end (pState l1 mdl)) +with +| inleft p => + match + pIsShared l1 mdl p in (_ = y) + return + (mapping (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) y) + with + | eq_refl => Tl2l1 l1 l2 tr (pComponents l1 mdl p) + end +| inright _ => + mkMapping (pState l1 mdl) (pState l1 mdl) Unit + (fun _ : pState l1 mdl => unit) + (fun (_ : Unit) (_ : pState l1 mdl) => unit) + (fun (_ : Unit) (_ : pState l1 mdl) (_ : Time) => unit) + (fun (_ : Unit) (X : pState l1 mdl) => X) +end. + +Definition PTpred l1 l2 tr (h : isSharedTransfo l1 l2 tr) mdl (pp : pPredicate l1 mdl): + LP (MdlPredicate (PLanguage l2) (PTransfoSyntax l1 l2 tr h mdl)) := +match pIsEmpty l1 mdl with +| inleft _ => + let (x, p) := pp in + addIndex (pIndex l1 mdl) (fun i => MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) x + (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl x)) + (LPPred (MdlPredicate l1 (pComponents l1 mdl x)) p)) +| inright f => match f (projT1 pp) with end +end. + +Lemma simu_eqA: + forall A1 A2 C m P sa sc tta ttc (h: A2=A1), + simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) + P (match h in (_=y) return TTS y with eq_refl => sa end) + sc (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => tta p end) + ttc -> + simu A2 C m P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqC: + forall A C1 C2 m P sa sc tta ttc (h: C2=C1), + simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) + P sa (match h in (_=y) return TTS y with eq_refl => sc end) + tta (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => ttc p end) + -> + simu A C2 m P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqA1: + forall A1 A2 C m P sa sc tta ttc (h: A1=A2), + simu A1 C m + P + (match (sym_eq h) in (_=y) return TTS y with eq_refl => sa end) sc + (fun p => match (sym_eq h) as e in (_=y) return LP (Predicate y (match e in (_=z) return TTS z with eq_refl => sa end)) with eq_refl => tta p end) ttc + -> + simu A2 C (match h in (_=y) return mapping _ C with eq_refl => m end) P sa sc tta ttc. +admit. +Qed. + +Lemma simu_eqA2: + forall A1 A2 C m P sa sc tta ttc (h: A1=A2), + simu A1 C (match (sym_eq h) in (_=y) return mapping _ C with eq_refl => m end) + P + sa sc tta ttc + -> + simu A2 C m P + (match h in (_=y) return TTS y with eq_refl => sa end) sc + (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sa end) with eq_refl => tta p end) + ttc. +admit. +Qed. + +Lemma simu_eqC2: + forall A C1 C2 m P sa sc tta ttc (h: C1=C2), + simu A C1 (match (sym_eq h) in (_=y) return mapping A _ with eq_refl => m end) + P + sa sc tta ttc + -> + simu A C2 m P + sa (match h in (_=y) return TTS y with eq_refl => sc end) + tta (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sc end) with eq_refl => ttc p end). +admit. +Qed. + +Lemma simu_eqM: + forall A C m1 m2 P sa sc tta ttc (h: m1=m2), + simu A C m1 P sa sc tta ttc + -> + simu A C m2 P sa sc tta ttc. +admit. +Qed. + +Lemma LPTransfo_trans: + forall Pred1 Pred2 Pred3 (tr1: Pred1 -> LP Pred2) (tr2: Pred2 -> LP Pred3) f, + LPTransfo tr2 (LPTransfo tr1 f) = LPTransfo (fun x => LPTransfo tr2 (tr1 x)) f. +Proof. + admit. +Qed. + +Lemma LPTransfo_addIndex: + forall Ind Pred tr1 x (tr2: forall i, Pred i -> LP (tr1 i)) (p: LP (Pred x)), + addIndex Ind tr1 x (LPTransfo (tr2 x) p) = + LPTransfo + (fun p0 : {i : Ind & Pred i} => + addIndex Ind tr1 (projT1 p0) (tr2 (projT1 p0) (projT2 p0))) + (addIndex Ind Pred x p). +Proof. + unfold addIndex; intros. + rewrite LPTransfo_trans. + rewrite LPTransfo_trans. + simpl. + auto. +Qed. + +Record tr_compat I0 I1 tr := compatPrf { + and_compat: forall p1 p2, tr (LPAnd I0 p1 p2) = LPAnd I1 (tr p1) (tr p2); + not_compat: forall p, tr (LPNot I0 p) = LPNot I1 (tr p) +}. + +Lemma LPTransfo_addIndex_tr: + forall Ind Pred tr0 tr1 x (tr2: forall i, Pred i -> LP (tr0 i)) (tr3: forall i, LP (tr0 i) -> LP (tr1 i)) (p: LP (Pred x)), + (forall x, tr_compat (tr0 x) (tr1 x) (tr3 x)) -> + addIndex Ind tr1 x (tr3 x (LPTransfo (tr2 x) p)) = + LPTransfo + (fun p0 : {i : Ind & Pred i} => + addIndex Ind tr1 (projT1 p0) (tr3 (projT1 p0) (tr2 (projT1 p0) (projT2 p0)))) + (addIndex Ind Pred x p). +Proof. + unfold addIndex; simpl; intros. + rewrite LPTransfo_trans; simpl. + rewrite <- LPTransfo_trans. + f_equal. + induction p; simpl; intros; auto. + rewrite (and_compat _ _ _ (H x)). + rewrite <- IHp1, <- IHp2; auto. + rewrite <- IHp. + rewrite (not_compat _ _ _ (H x)); auto. +Qed. + +Require Export Coq.Logic.FunctionalExtensionality. +Print PLanguage. + +Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): +Transformation (PLanguage l1) (PLanguage l2) := + mkTransformation (PLanguage l1) (PLanguage l2) + (PTransfoSyntax l1 l2 tr h) + (Pmap12 l1 l2 tr h) + (Pmap21 l1 l2 tr h) + (PTpred l1 l2 tr h) + (fun mdl => simu_equivProd + (pState l1 mdl) + (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) + (Pmap12 l1 l2 tr h mdl) + (Pmap21 l1 l2 tr h mdl) + (pIndex l1 mdl) + (fun i => MdlPredicate l1 (pComponents l1 mdl i)) + (compSemantic l1 mdl) + (compSemantic l2 (PTransfoSyntax l1 l2 tr h mdl)) + _ + _ + _ + ). + +Next Obligation. + unfold compSemantic, PTransfoSyntax; simpl. + case (pIsEmpty l1 mdl); simpl; intros. + unfold pPredicate; simpl. + unfold pPredicate in X; simpl in X. + case (sameState l1 l2 tr h mdl i p). + apply (LPTransfo (MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). + apply (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl i))). + apply (LPPred _ X). + + apply False_rect; apply (f i). +Defined. + +Next Obligation. + split; intros. + unfold Pmap12; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + case (pIsEmpty l1 mdl); intros. + apply simu_eqA2. + apply simu_eqC2. + apply simu_eqM with (Tl1l2 l1 l2 tr (pComponents l1 mdl i)). + apply sameM12. + apply (simuLR _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. + + apply False_rect; apply (f i). + + unfold Pmap21; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + case (pIsEmpty l1 mdl); intros. + apply simu_eqC2. + apply simu_eqA2. + apply simu_eqM with (Tl2l1 l1 l2 tr (pComponents l1 mdl i)). + apply sameM21. + apply (simuRL _ _ _ _ _ _ _ _ _ (Tsim l1 l2 tr (pComponents l1 mdl i))); intro. + + apply False_rect; apply (f i). +Qed. + +Next Obligation. + unfold trProd; simpl. + unfold PTransfo_obligation_1; simpl. + unfold compSemantic; simpl. + unfold eq_ind, eq_rect, f_equal; simpl. + apply functional_extensionality; intro. + case x; clear x; intros. + unfold PTpred; simpl. + case (pIsEmpty l1 mdl); simpl; intros. + set (tr0 i := + Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) + (Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)))). + set (tr1 i := + Predicate (DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl p))) + match sameState l1 l2 tr h mdl i p in (_ = y) return (TTS y) with + | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) + end). + set (tr2 x := MdlPredicateDefinition l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). + set (Pred x := MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl x))). + set (tr3 x f := match + sameState l1 l2 tr h mdl x p as e in (_ = y) + return + (LP + (Predicate y + match e in (_ = y0) return (TTS y0) with + | eq_refl => Semantic l2 (Tmodel l1 l2 tr (pComponents l1 mdl x)) + end)) + with + | eq_refl => f + end). + apply (LPTransfo_addIndex_tr _ Pred tr0 tr1 x tr2 tr3 + (Tpred l1 l2 tr (pComponents l1 mdl x) m)). + unfold tr0, tr1, tr3; intros; split; simpl; intros; auto. + case (sameState l1 l2 tr h mdl x0 p); auto. + case (sameState l1 l2 tr h mdl x0 p); auto. + + apply False_rect; apply (f x). +Qed. + +End Product. + +End TRANSFO. +End TTS_TASM. diff --git a/test-suite/bugs/closed/bug_2388.v b/test-suite/bugs/closed/bug_2388.v new file mode 100644 index 0000000000..fbe5e20f2f --- /dev/null +++ b/test-suite/bugs/closed/bug_2388.v @@ -0,0 +1,9 @@ +(* Error message was not printed in the correct environment *) + +Fail Parameters (A:Prop) (a:A A). + +(* This is a variant (reported as part of bug #2347) *) + +Require Import EquivDec. +Fail Program Instance bool_eq_eqdec : EqDec bool eq := + {equiv_dec x y := (fix aux (x y : bool) {struct x}:= aux _ y) x y}. diff --git a/test-suite/bugs/closed/2393.v b/test-suite/bugs/closed/bug_2393.v index fb4f92619f..fb4f92619f 100644 --- a/test-suite/bugs/closed/2393.v +++ b/test-suite/bugs/closed/bug_2393.v diff --git a/test-suite/bugs/closed/bug_2404.v b/test-suite/bugs/closed/bug_2404.v new file mode 100644 index 0000000000..c284a15651 --- /dev/null +++ b/test-suite/bugs/closed/bug_2404.v @@ -0,0 +1,48 @@ +(* Check that dependencies in the indices of the type of the terms to + match are taken into account and correctly generalized *) + +Require Import Relations.Relation_Definitions. +Require Import Basics. + +Record Base := mkBase + {(* Primitives *) + World : Set + (* Names are real, links are theoretical *) + ; Name : World -> Set + + ; wweak : World -> World -> Prop + + ; exportw : forall a b : World, (wweak a b) -> (Name b) -> option (Name a) +}. + +Section Derived. + Variable base : Base. + Definition bWorld := World base. + Definition bName := Name base. + Definition bexportw := exportw base. + Definition bwweak := wweak base. + + Arguments bexportw [a b]. + +Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type := + starReflS : forall a, RstarSetProof T a a +| starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k. + +Arguments starTransS [I T i j k]. + +Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))). + +Definition bwweakFlip (b a : bWorld) : Prop := (bwweak a b). +Definition Rweak : forall a b : bWorld, Type := RstarInv bwweak. + +Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) := + match aRWb,y with + | starReflS _ a, y' => Some y' + | starTransS jWk jRWi, y' => + match (bexportw jWk y) with + | Some x => exportRweak jRWi x + | None => None + end + end. + +End Derived. diff --git a/test-suite/bugs/closed/2406.v b/test-suite/bugs/closed/bug_2406.v index 3766e795a0..3766e795a0 100644 --- a/test-suite/bugs/closed/2406.v +++ b/test-suite/bugs/closed/bug_2406.v diff --git a/test-suite/bugs/closed/2417.v b/test-suite/bugs/closed/bug_2417.v index b2f00ffc65..b2f00ffc65 100644 --- a/test-suite/bugs/closed/2417.v +++ b/test-suite/bugs/closed/bug_2417.v diff --git a/test-suite/bugs/closed/2428.v b/test-suite/bugs/closed/bug_2428.v index b398a76d91..b398a76d91 100644 --- a/test-suite/bugs/closed/2428.v +++ b/test-suite/bugs/closed/bug_2428.v diff --git a/test-suite/bugs/closed/2447.v b/test-suite/bugs/closed/bug_2447.v index fdeb69fcc7..fdeb69fcc7 100644 --- a/test-suite/bugs/closed/2447.v +++ b/test-suite/bugs/closed/bug_2447.v diff --git a/test-suite/bugs/closed/2456.v b/test-suite/bugs/closed/bug_2456.v index e5a392c4d3..e5a392c4d3 100644 --- a/test-suite/bugs/closed/2456.v +++ b/test-suite/bugs/closed/bug_2456.v diff --git a/test-suite/bugs/closed/2464.v b/test-suite/bugs/closed/bug_2464.v index b9db30359c..b9db30359c 100644 --- a/test-suite/bugs/closed/2464.v +++ b/test-suite/bugs/closed/bug_2464.v diff --git a/test-suite/bugs/closed/2467.v b/test-suite/bugs/closed/bug_2467.v index ad17814a8f..ad17814a8f 100644 --- a/test-suite/bugs/closed/2467.v +++ b/test-suite/bugs/closed/bug_2467.v diff --git a/test-suite/bugs/closed/bug_2473.v b/test-suite/bugs/closed/bug_2473.v new file mode 100644 index 0000000000..48987ea325 --- /dev/null +++ b/test-suite/bugs/closed/bug_2473.v @@ -0,0 +1,40 @@ +Require Import TestSuite.admit. + +Require Import Relations Program Setoid Morphisms. + +Section S1. + Variable R: nat -> relation bool. + Instance HR1: forall n, Transitive (R n). Admitted. + Instance HR2: forall n, Symmetric (R n). Admitted. + Hypothesis H: forall n a, R n (andb a a) a. + Goal forall n a b, R n b a. + intros. + (* rewrite <- H. *) (* Anomaly: Evar ?.. was not declared. Please report. *) + (* idem with setoid_rewrite *) +(* assert (HR2' := HR2 n). *) + rewrite <- H. (* ok *) + admit. + Qed. +End S1. + +Section S2. + Variable R: nat -> relation bool. + Instance HR: forall n, Equivalence (R n). Admitted. + Hypothesis H: forall n a, R n (andb a a) a. + Goal forall n a b, R n a b. + intros. rewrite <- H. admit. + Qed. +End S2. + +(* the parametrised relation is required to get the problem *) +Section S3. + Variable R: relation bool. + Instance HR1': Transitive R. Admitted. + Instance HR2': Symmetric R. Admitted. + Hypothesis H: forall a, R (andb a a) a. + Goal forall a b, R b a. + intros. + rewrite <- H. (* ok *) + admit. + Qed. +End S3. diff --git a/test-suite/bugs/closed/bug_2584.v b/test-suite/bugs/closed/bug_2584.v new file mode 100644 index 0000000000..fe3967ff67 --- /dev/null +++ b/test-suite/bugs/closed/bug_2584.v @@ -0,0 +1,89 @@ +Require Import List. + +Set Implicit Arguments. + +Definition err : Type := unit. + +Inductive res (A: Type) : Type := +| OK: A -> res A +| Error: err -> res A. + +Arguments Error [A]. + +Set Printing Universes. + +Section FOO. + +Inductive ftyp : Type := + | Funit : ftyp + | Ffun : list ftyp -> ftyp + | Fref : area -> ftyp +with area : Type := + | Stored : ftyp -> area +. + +Print ftyp. +(* yields: +Inductive ftyp : Type (* Top.27429 *) := + Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp + with area : Type (* Set *) := Stored : ftyp -> area +*) + +Fixpoint tc_wf_type (ftype: ftyp) {struct ftype}: res unit := + match ftype with + | Funit => OK tt + | Ffun args => + ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := + match ftypes with + | nil => OK tt + | t::ts => + match tc_wf_type t with + | OK tt => tc_wf_types ts + | Error m => Error m + end + end) args) + | Fref a => tc_wf_area a + end +with tc_wf_area (ar:area): res unit := + match ar with + | Stored c => tc_wf_type c + end. + +End FOO. + +Print ftyp. +(* yields: +Inductive ftyp : Type (* Top.27465 *) := + Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp + with area : Set := Stored : ftyp -> area +*) + +Fixpoint tc_wf_type' (ftype: ftyp) {struct ftype}: res unit := + match ftype with + | Funit => OK tt + | Ffun args => + ((fix tc_wf_types (ftypes: list ftyp){struct ftypes}: res unit := + match ftypes with + | nil => OK tt + | t::ts => + match tc_wf_type' t with + | OK tt => tc_wf_types ts + | Error m => Error m + end + end) args) + | Fref a => tc_wf_area' a + end +with tc_wf_area' (ar:area): res unit := + match ar with + | Stored c => tc_wf_type' c + end. + +(* yields: +Error: +Incorrect elimination of "ar" in the inductive type "area": +the return type has sort "Type (* max(Set, Top.27424) *)" while it +should be "Prop" or "Set". +Elimination of an inductive object of sort Set +is not allowed on a predicate in sort Type +because strong elimination on non-small inductive types leads to paradoxes. +*) diff --git a/test-suite/bugs/closed/2586.v b/test-suite/bugs/closed/bug_2586.v index e57bcc25bb..e57bcc25bb 100644 --- a/test-suite/bugs/closed/2586.v +++ b/test-suite/bugs/closed/bug_2586.v diff --git a/test-suite/bugs/closed/bug_2590.v b/test-suite/bugs/closed/bug_2590.v new file mode 100644 index 0000000000..504b453e92 --- /dev/null +++ b/test-suite/bugs/closed/bug_2590.v @@ -0,0 +1,19 @@ +Require Import TestSuite.admit. +Require Import Relation_Definitions RelationClasses Setoid SetoidClass. + +Section Bug. + + Context {A : Type} (R : relation A). + Hypothesis pre : PreOrder R. + Context `{SA : Setoid A}. + + Goal True. + set (SA' := SA). + assert ( forall SA0 : Setoid A, + @PartialOrder A (@equiv A SA0) (@setoid_equiv A SA0) R pre ). + rename SA into SA0. + intro SA. + admit. + admit. +Qed. +End Bug. diff --git a/test-suite/bugs/closed/bug_2602.v b/test-suite/bugs/closed/bug_2602.v new file mode 100644 index 0000000000..dd3551a7c3 --- /dev/null +++ b/test-suite/bugs/closed/bug_2602.v @@ -0,0 +1,9 @@ +Goal exists m, S m > 0. +eexists. +match goal with + | |- context [ S ?a ] => + match goal with + | |- S a > 0 => idtac + end +end. +Abort. diff --git a/test-suite/bugs/closed/2603.v b/test-suite/bugs/closed/bug_2603.v index 371bfdc575..371bfdc575 100644 --- a/test-suite/bugs/closed/2603.v +++ b/test-suite/bugs/closed/bug_2603.v diff --git a/test-suite/bugs/closed/2608.v b/test-suite/bugs/closed/bug_2608.v index a4c95ff97c..a4c95ff97c 100644 --- a/test-suite/bugs/closed/2608.v +++ b/test-suite/bugs/closed/bug_2608.v diff --git a/test-suite/bugs/closed/bug_2613.v b/test-suite/bugs/closed/bug_2613.v new file mode 100644 index 0000000000..6307dae1b2 --- /dev/null +++ b/test-suite/bugs/closed/bug_2613.v @@ -0,0 +1,17 @@ +Require Import TestSuite.admit. +(* Check that eq_sym is still pointing to Logic.eq_sym after use of Function *) + +Require Import ZArith. +Require Recdef. + +Axiom nat_eq_dec: forall x y : nat, {x=y}+{x<>y}. + +Locate eq_sym. (* Constant Coq.Init.Logic.eq_sym *) + +Function loop (n: nat) {measure (fun x => x) n} : bool := + if nat_eq_dec n 0 then false else loop (pred n). +Proof. + admit. +Defined. + +Check eq_sym eq_refl : 0=0. diff --git a/test-suite/bugs/closed/bug_2615.v b/test-suite/bugs/closed/bug_2615.v new file mode 100644 index 0000000000..7197d917bd --- /dev/null +++ b/test-suite/bugs/closed/bug_2615.v @@ -0,0 +1,17 @@ +Require Import TestSuite.admit. +(* This failed with an anomaly in pre-8.4 because of let-in not + properly taken into account in the test for unification pattern *) + +Inductive foo : forall A, A -> Prop := +| foo_intro : forall A x, foo A x. +Lemma bar A B f : foo (A -> B) f -> forall x : A, foo B (f x). +Fail induction 1. + +(* Whether these examples should succeed with a non-dependent return predicate + or fail because there is well-typed return predicate dependent in f + is questionable. As of 25 oct 2011, they succeed *) +refine (fun p => match p with _ => _ end). +Undo. +refine (fun p => match p with foo_intro _ _ => _ end). +admit. +Qed. diff --git a/test-suite/bugs/closed/bug_2616.v b/test-suite/bugs/closed/bug_2616.v new file mode 100644 index 0000000000..fee91dab24 --- /dev/null +++ b/test-suite/bugs/closed/bug_2616.v @@ -0,0 +1,8 @@ +(* Testing ill-typed rewrite which used to succeed in 8.3 *) +Goal + forall (N : nat -> Prop) (g : nat -> sig N) (IN : forall a : sig N, a = g 0), + N 0 -> False. +Proof. +intros. +Fail rewrite IN in H. +Abort. diff --git a/test-suite/bugs/closed/2629.v b/test-suite/bugs/closed/bug_2629.v index 759cd3dd28..759cd3dd28 100644 --- a/test-suite/bugs/closed/2629.v +++ b/test-suite/bugs/closed/bug_2629.v diff --git a/test-suite/bugs/closed/2667.v b/test-suite/bugs/closed/bug_2667.v index 0e6d0108cc..0e6d0108cc 100644 --- a/test-suite/bugs/closed/2667.v +++ b/test-suite/bugs/closed/bug_2667.v diff --git a/test-suite/bugs/closed/2668.v b/test-suite/bugs/closed/bug_2668.v index d5bbfd3f08..d5bbfd3f08 100644 --- a/test-suite/bugs/closed/2668.v +++ b/test-suite/bugs/closed/bug_2668.v diff --git a/test-suite/bugs/closed/2670.v b/test-suite/bugs/closed/bug_2670.v index 791889b24b..791889b24b 100644 --- a/test-suite/bugs/closed/2670.v +++ b/test-suite/bugs/closed/bug_2670.v diff --git a/test-suite/bugs/closed/bug_2680.v b/test-suite/bugs/closed/bug_2680.v new file mode 100644 index 0000000000..e5319f3b4d --- /dev/null +++ b/test-suite/bugs/closed/bug_2680.v @@ -0,0 +1,15 @@ +(* Tauto bug initially due to wrong test for binary connective *) + +Parameter A B : Type. + +Axiom P : A -> B -> Prop. + +Inductive IP (a : A) (b: B) : Prop := +| IP_def : P a b -> IP a b. + + +Goal forall (a : A) (b : B), IP a b -> ~ IP a b -> False. +Proof. + intros. + tauto. +Qed. diff --git a/test-suite/bugs/closed/bug_2713.v b/test-suite/bugs/closed/bug_2713.v new file mode 100644 index 0000000000..c8d4c6cecd --- /dev/null +++ b/test-suite/bugs/closed/bug_2713.v @@ -0,0 +1,17 @@ +Set Implicit Arguments. + +Definition pred_le A (P Q : A->Prop) := + forall x, P x -> Q x. + +Lemma pred_le_refl : forall A (P:A->Prop), + pred_le P P. +Proof. unfold pred_le. auto. Qed. + +Hint Resolve pred_le_refl. + +Lemma test : + forall (P1 P2:nat->Prop), + (forall Q, pred_le (fun a => P1 a /\ P2 a) Q -> True) -> + True. +Proof. intros. eapply H. eauto. (* used to work *) + apply pred_le_refl. Qed. diff --git a/test-suite/bugs/closed/bug_2729.v b/test-suite/bugs/closed/bug_2729.v new file mode 100644 index 0000000000..ff08bdc6bb --- /dev/null +++ b/test-suite/bugs/closed/bug_2729.v @@ -0,0 +1,116 @@ +(* This bug report actually revealed two bugs in the reconstruction of + a term with "match" in the vm *) + +(* A simplified form of the first problem *) + +(* Reconstruction of terms normalized with vm when a constructor has *) +(* let-ins arguments *) + +Record A : Type := C { a := 0 : nat; b : a=a }. +Goal forall d:A, match d with C a b => b end = match d with C a b => b end. +intro. +vm_compute. +(* Now check that it is well-typed *) +match goal with |- ?c = _ => first [let x := type of c in idtac | fail 2] end. +Abort. + +(* A simplified form of the second problem *) + +Parameter P : nat -> Type. + +Inductive box A := Box : A -> box A. + +Axiom com : {m : nat & box (P m) }. + +Lemma L : + (let (w, s) as com' return (com' = com -> Prop) := com in + let (s0) as s0 + return (existT (fun m : nat => box (P m)) w s0 = com -> Prop) := s in + fun _ : existT (fun m : nat => box (P m)) w (Box (P w) s0) = com => + True) eq_refl. +Proof. +vm_compute. +(* Now check that it is well-typed (the "P w" used to be turned into "P s") *) +match goal with |- ?c => first [let x := type of c in idtac | fail 2] end. +Abort. + +(* Then the original report *) + +Require Import Equality. + +Parameter NameSet : Set. +Parameter SignedName : Set. +Parameter SignedName_compare : forall (x y : SignedName), comparison. +Parameter pu_type : NameSet -> NameSet -> Type. +Parameter pu_nameOf : forall {from to : NameSet}, pu_type from to -> SignedName. +Parameter commute : forall {from mid1 mid2 to : NameSet}, + pu_type from mid1 -> pu_type mid1 to + -> pu_type from mid2 -> pu_type mid2 to -> Prop. + +Program Definition castPatchFrom {from from' to : NameSet} + (HeqFrom : from = from') + (p : pu_type from to) + : pu_type from' to + := p. + +Class PatchUniverse : Type := mkPatchUniverse { + + commutable : forall {from mid1 to : NameSet}, + pu_type from mid1 -> pu_type mid1 to -> Prop + := fun {from mid1 to : NameSet} + (p : pu_type from mid1) (q : pu_type mid1 to) => + exists mid2 : NameSet, + exists q' : pu_type from mid2, + exists p' : pu_type mid2 to, + commute p q q' p'; + + commutable_dec : forall {from mid to : NameSet} + (p : pu_type from mid) + (q : pu_type mid to), + {mid2 : NameSet & + { q' : pu_type from mid2 & + { p' : pu_type mid2 to & + commute p q q' p' }}} + + {~(commutable p q)} +}. + +Inductive SequenceBase (pu : PatchUniverse) + : NameSet -> NameSet -> Type + := Nil : forall {cxt : NameSet}, + SequenceBase pu cxt cxt + | Cons : forall {from mid to : NameSet} + (p : pu_type from mid) + (qs : SequenceBase pu mid to), + SequenceBase pu from to. +Arguments Nil [pu cxt]. +Arguments Cons [pu from mid to]. + +Program Fixpoint insertBase {pu : PatchUniverse} + {from mid to : NameSet} + (p : pu_type from mid) + (qs : SequenceBase pu mid to) + : SequenceBase pu from to + := match qs with + | Nil => Cons p Nil + | Cons q qs' => + match SignedName_compare (pu_nameOf p) (pu_nameOf q) with + | Lt => Cons p qs + | _ => match commutable_dec p (castPatchFrom _ q) with + | inleft (existT _ _ (existT _ q' (existT _ p' _))) => Cons q' +(insertBase p' qs') + | inright _ => Cons p qs + end + end + end. + +Lemma insertBaseConsLt {pu : PatchUniverse} + {o op opq opqr : NameSet} + (p : pu_type o op) + (q : pu_type op opq) + (rs : SequenceBase pu opq opqr) + (p_Lt_q : SignedName_compare (pu_nameOf p) (pu_nameOf q) += Lt) + : insertBase p (Cons q rs) = Cons p (Cons q rs). +Proof. +vm_compute. +Abort. diff --git a/test-suite/bugs/closed/2732.v b/test-suite/bugs/closed/bug_2732.v index f22a8cccc5..f22a8cccc5 100644 --- a/test-suite/bugs/closed/2732.v +++ b/test-suite/bugs/closed/bug_2732.v diff --git a/test-suite/bugs/closed/2733.v b/test-suite/bugs/closed/bug_2733.v index 24dd30b32e..24dd30b32e 100644 --- a/test-suite/bugs/closed/2733.v +++ b/test-suite/bugs/closed/bug_2733.v diff --git a/test-suite/bugs/closed/2734.v b/test-suite/bugs/closed/bug_2734.v index 3210214ea1..3210214ea1 100644 --- a/test-suite/bugs/closed/2734.v +++ b/test-suite/bugs/closed/bug_2734.v diff --git a/test-suite/bugs/closed/2750.v b/test-suite/bugs/closed/bug_2750.v index 9d65e51f63..9d65e51f63 100644 --- a/test-suite/bugs/closed/2750.v +++ b/test-suite/bugs/closed/bug_2750.v diff --git a/test-suite/bugs/closed/bug_2775.v b/test-suite/bugs/closed/bug_2775.v new file mode 100644 index 0000000000..484ac6fd38 --- /dev/null +++ b/test-suite/bugs/closed/bug_2775.v @@ -0,0 +1,6 @@ +Inductive typ : forall (T:Type), list T -> Type -> Prop := + | Get : forall (T:Type) (l:list T), typ T l T. + + +Derive Inversion inv with +(forall (X: Type) (y: list nat), typ nat y X) Sort Prop. diff --git a/test-suite/bugs/closed/2800.v b/test-suite/bugs/closed/bug_2800.v index 54c75e344c..54c75e344c 100644 --- a/test-suite/bugs/closed/2800.v +++ b/test-suite/bugs/closed/bug_2800.v diff --git a/test-suite/bugs/closed/2810.v b/test-suite/bugs/closed/bug_2810.v index a66078c60a..a66078c60a 100644 --- a/test-suite/bugs/closed/2810.v +++ b/test-suite/bugs/closed/bug_2810.v diff --git a/test-suite/bugs/closed/2814.v b/test-suite/bugs/closed/bug_2814.v index 99da1e3e44..99da1e3e44 100644 --- a/test-suite/bugs/closed/2814.v +++ b/test-suite/bugs/closed/bug_2814.v diff --git a/test-suite/bugs/closed/bug_2817.v b/test-suite/bugs/closed/bug_2817.v new file mode 100644 index 0000000000..5125ce072f --- /dev/null +++ b/test-suite/bugs/closed/bug_2817.v @@ -0,0 +1,10 @@ +(** Occur-check for Meta (up to application of already known instances) *) + +Goal forall (f: nat -> nat -> Prop) (x:bool) + (H: forall (u: nat), f u u -> True) + (H0: forall x0, f (if x then x0 else x0) x0), +False. + +intros. +Fail apply H in H0. (* should fail without exhausting the stack *) +Abort. diff --git a/test-suite/bugs/closed/2818.v b/test-suite/bugs/closed/bug_2818.v index 010855cfb7..010855cfb7 100644 --- a/test-suite/bugs/closed/2818.v +++ b/test-suite/bugs/closed/bug_2818.v diff --git a/test-suite/bugs/closed/bug_2828.v b/test-suite/bugs/closed/bug_2828.v new file mode 100644 index 0000000000..36ac4605f4 --- /dev/null +++ b/test-suite/bugs/closed/bug_2828.v @@ -0,0 +1,5 @@ +Parameter A B : Type. +Coercion POL (p : prod A B) := fst p. +Goal forall x : prod A B, A. + intro x. Fail exact x. +Abort. diff --git a/test-suite/bugs/closed/bug_2830.v b/test-suite/bugs/closed/bug_2830.v new file mode 100644 index 0000000000..801c61b132 --- /dev/null +++ b/test-suite/bugs/closed/bug_2830.v @@ -0,0 +1,227 @@ +(* Bug report #2830 (evar defined twice) covers different bugs *) + +(* 1- This was submitted by qb.h.agws *) + +Module A. + +Set Implicit Arguments. + +Inductive Bit := O | I. + +Inductive BitString: nat -> Set := +| bit: Bit -> BitString 0 +| bitStr: forall n: nat, Bit -> BitString n -> BitString (S n). + +Definition BitOr (a b: Bit) := + match a, b with + | O, O => O + | _, _ => I + end. + +(* Should fail with an error; used to failed in 8.4 and trunk with + anomaly Evd.define: cannot define an evar twice *) + +Fail Fixpoint StringOr (n m: nat) (a: BitString n) (b: BitString m) := + match a with + | bit a' => + match b with + | bit b' => bit (BitOr a' b') + | bitStr b' bT => bitStr b' (StringOr (bit a') bT) + end + | bitStr a' aT => + match b with + | bit b' => bitStr a' (StringOr aT (bit b')) + | bitStr b' bT => bitStr (BitOr a' b') (StringOr aT bT) + end + end. + +End A. + +(* 2- This was submitted by Andrew Appel *) + +Module B. + +Require Import Program Relations. + +Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A) := +{ af_unage : forall x x' y', level x' = level y' -> age1 x = Some x' -> exists y, age1 y = Some y' +; af_level1 : forall x, age1 x = None <-> level x = 0 +; af_level2 : forall x y, age1 x = Some y -> level x = S (level y) +}. + +Arguments af_unage {A level age1}. +Arguments af_level1 {A level age1}. +Arguments af_level2 {A level age1}. + +Class ageable (A:Type) := mkAgeable +{ level : A -> nat +; age1 : A -> option A +; age_facts : ageable_facts A level age1 +}. +Definition age {A} `{ageable A} (x y:A) := age1 x = Some y. +Definition necR {A} `{ageable A} : relation A := clos_refl_trans A age. +Delimit Scope pred with pred. +Local Open Scope pred. + +Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) := + forall a a':A, R a a' -> p a -> p a'. + +Definition pred (A:Type) {AG:ageable A} := + { p:A -> Prop | hereditary age p }. + +Bind Scope pred with pred. + +Definition app_pred {A} `{ageable A} (p:pred A) : A -> Prop := proj1_sig p. +Definition pred_hereditary `{ageable} (p:pred A) := proj2_sig p. +Coercion app_pred : pred >-> Funclass. +Global Opaque pred. + +Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a. +Arguments derives : default implicits. + +Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A := + fun a:A => P a /\ Q a. +Next Obligation. + intros; intro; intuition; apply pred_hereditary with a; auto. +Qed. + +Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A := + fun a:A => forall a':A, necR a a' -> P a' -> Q a'. +Next Obligation. + intros; intro; intuition. + apply H1; auto. + apply rt_trans with a'; auto. + apply rt_step; auto. +Qed. + +Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A + := fun a => forall b, f b a. +Next Obligation. + intros; intro; intuition. + apply pred_hereditary with a; auto. + apply H1. +Qed. + +Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred. +Notation "P '|--' Q" := (derives P Q) (at level 80, no associativity). +Notation "'All' x ':' T ',' P " := (allp (fun x:T => P%pred)) (at level 65, x at level 99) : pred. + +Lemma forall_pred_ext {A} `{agA : ageable A}: forall B P Q, + (All x : B, (P x <--> Q x)) |-- (All x : B, P x) <--> (All x: B, Q x). +Abort. + +End B. + +(* 3. *) + +(* This was submitted by Anthony Cowley *) + +Require Import Coq.Classes.Morphisms. +Require Import Setoid. + +Module C. + +Reserved Notation "a ~> b" (at level 70, right associativity). +Reserved Notation "a ≈ b" (at level 54). +Reserved Notation "a ∘ b" (at level 50, left associativity). +Generalizable All Variables. + +Class Category (Object:Type) (Hom:Object -> Object -> Type) := { + hom := Hom where "a ~> b" := (hom a b) : category_scope + ; ob := Object + ; id : forall a, hom a a + ; comp : forall c b a, hom b c -> hom a b -> hom a c + where "g ∘ f" := (comp _ _ _ g f) : category_scope + ; eqv : forall a b, hom a b -> hom a b -> Prop + where "f ≈ g" := (eqv _ _ f g) : category_scope + ; eqv_equivalence : forall a b, Equivalence (eqv a b) + ; comp_respects : forall a b c, + Proper (eqv b c ==> eqv a b ==> eqv a c) (comp c b a) + ; left_identity : forall `(f:a ~> b), id b ∘ f ≈ f + ; right_identity : forall `(f:a ~> b), f ∘ id a ≈ f + ; associativity : forall `(f:a~>b) `(g:b~>c) `(h:c~>d), + h ∘ (g ∘ f) ≈ (h ∘ g) ∘ f +}. +Notation "a ~> b" := (@hom _ _ _ a b) : category_scope. +Notation "g ∘ f" := (@comp _ _ _ _ _ _ g f) : category_scope. +Notation "a ≈ b" := (@eqv _ _ _ _ _ a b) : category_scope. +Notation "a ~{ C }~> b" := (@hom _ _ C a b) (at level 100) : category_scope. +Coercion ob : Category >-> Sortclass. + +Open Scope category_scope. + +Add Parametric Relation `(C:Category Ob Hom) (a b : Ob) : (hom a b) (eqv a b) + reflexivity proved by (@Equivalence_Reflexive _ _ (eqv_equivalence a b)) + symmetry proved by (@Equivalence_Symmetric _ _ (eqv_equivalence a b)) + transitivity proved by (@Equivalence_Transitive _ _ (eqv_equivalence a b)) + as parametric_relation_eqv. + +Add Parametric Morphism `(C:Category Ob Hom) (c b a : Ob) : (comp c b a) + with signature (eqv _ _ ==> eqv _ _ ==> eqv _ _) as parametric_morphism_comp. + intros x y Heq x' y'. apply comp_respects. exact Heq. + Defined. + +Class Functor `(C:Category) `(D:Category) (im : C -> D) := { + functor_im := im + ; fmap : forall {a b}, `(a ~> b) -> im a ~> im b + ; fmap_respects : forall a b (f f' : a ~> b), f ≈ f' -> fmap f ≈ fmap f' + ; fmap_preserves_id : forall a, fmap (id a) ≈ id (im a) + ; fmap_preserves_comp : forall `(f:a~>b) `(g:b~>c), + fmap g ∘ fmap f ≈ fmap (g ∘ f) +}. +Coercion functor_im : Functor >-> Funclass. +Arguments fmap [Object Hom C Object0 Hom0 D im] _ [a b]. + +Add Parametric Morphism `(C:Category) `(D:Category) + (Im:C->D) (F:Functor C D Im) (a b:C) : (@fmap _ _ C _ _ D Im F a b) + with signature (@eqv C _ C a b ==> @eqv D _ D (Im a) (Im b)) + as parametric_morphism_fmap. +intros. apply fmap_respects. assumption. Qed. + +(* HERE IS THE PROBLEMATIC INSTANCE. If we change this to a regular Definition, + then the problem goes away. *) +Instance functor_comp `{C:Category} `{D:Category} `{E:Category} + {Gim} (G:Functor D E Gim) {Fim} (F:Functor C D Fim) + : Functor C E (Basics.compose Gim Fim). +intros. apply Build_Functor with (fmap := fun a b f => fmap G (fmap F f)). +abstract (intros; rewrite H; reflexivity). +abstract (intros; repeat (rewrite fmap_preserves_id); reflexivity). +abstract (intros; repeat (rewrite fmap_preserves_comp); reflexivity). +Defined. + +Definition skel {A:Type} : relation A := @eq A. +Instance skel_equiv A : Equivalence (@skel A). +Admitted. + +Import FunctionalExtensionality. +Instance set_cat : Category Type (fun A B => A -> B) := { + id := fun A => fun x => x + ; comp c b a f g := fun x => f (g x) + ; eqv := fun A B => @skel (A -> B) +}. +intros. compute. symmetry. apply eta_expansion. +intros. compute. symmetry. apply eta_expansion. +intros. compute. reflexivity. Defined. + +(* The [list] type constructor is a Functor. *) + +Import List. + +Definition setList (A:set_cat) := list A. +Instance list_functor : Functor set_cat set_cat setList. +apply Build_Functor with (fmap := @map). +intros. rewrite H. reflexivity. +intros; simpl; apply functional_extensionality. + induction x; [auto|simpl]. rewrite IHx. reflexivity. +intros; simpl; apply functional_extensionality. + induction x; [auto|simpl]. rewrite IHx. reflexivity. +Defined. + +Local Notation "[ a , .. , b ]" := (a :: .. (b :: nil) ..) : list_scope. +Definition setFmap {Fim} {F:Functor set_cat set_cat Fim} `(f:A~>B) (xs:Fim A) := fmap F f xs. + +(* We want to infer the [Functor] instance based on the value's + structure, but the [functor_comp] instance throws things awry. *) +Eval cbv in setFmap (fun x => x * 3) [67,8]. + +End C. diff --git a/test-suite/bugs/closed/bug_2834.v b/test-suite/bugs/closed/bug_2834.v new file mode 100644 index 0000000000..afa405b8dd --- /dev/null +++ b/test-suite/bugs/closed/bug_2834.v @@ -0,0 +1,5 @@ +(* Testing typing of subst *) + +Lemma eqType2Set (a b : Set) (H : @eq Type a b) : @eq Set a b. +Fail subst. +Abort. diff --git a/test-suite/bugs/closed/bug_2836.v b/test-suite/bugs/closed/bug_2836.v new file mode 100644 index 0000000000..a2755be7dd --- /dev/null +++ b/test-suite/bugs/closed/bug_2836.v @@ -0,0 +1,41 @@ +(* Check that possible instantiation made during evar materialization + are taken into account and do not raise Not_found *) + +Set Implicit Arguments. + +Record SpecializedCategory (obj : Type) (Morphism : obj -> obj -> Type) := { + Object :> _ := obj; + + Identity' : forall o, Morphism o o; + Compose' : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' +}. + +Section SpecializedCategoryInterface. + Variable obj : Type. + Variable mor : obj -> obj -> Type. + Variable C : @SpecializedCategory obj mor. + + Definition Morphism (s d : C) := mor s d. + Definition Identity (o : C) : Morphism o o := C.(Identity') o. + Definition Compose (s d d' : C) (m : Morphism d d') (m0 : Morphism s d) : +Morphism s d' := C.(Compose') s d d' m m0. +End SpecializedCategoryInterface. + +Section ProductCategory. + Variable objC : Type. + Variable morC : objC -> objC -> Type. + Variable objD : Type. + Variable morD : objD -> objD -> Type. + Variable C : SpecializedCategory morC. + Variable D : SpecializedCategory morD. + +(* Should fail nicely *) +Definition ProductCategory : @SpecializedCategory (objC * objD)%type (fun s d +=> (morC (fst s) (fst d) * morD (snd s) (snd d))%type). +Fail refine {| + Identity' := (fun o => (Identity (fst o), Identity (snd o))); + Compose' := (fun s d d' m2 m1 => (Compose (fst m2) (fst m1), Compose (snd +m2) (snd m1))) + |}. +Abort. +End ProductCategory. diff --git a/test-suite/bugs/closed/bug_2837.v b/test-suite/bugs/closed/bug_2837.v new file mode 100644 index 0000000000..9982b96f79 --- /dev/null +++ b/test-suite/bugs/closed/bug_2837.v @@ -0,0 +1,16 @@ +Require Import JMeq. + +Axiom test : forall n m : nat, JMeq n m. + +Goal forall n m : nat, JMeq n m. + +(* I) with no intros nor variable hints, this should produce a regular error + instead of Uncaught exception Failure("nth"). *) +Fail rewrite test. + +(* II) with intros but indication of variables, still an error *) +Fail (intros; rewrite test). + +(* III) a working variant: *) +intros; rewrite (test n m). +Abort. diff --git a/test-suite/bugs/closed/bug_2839.v b/test-suite/bugs/closed/bug_2839.v new file mode 100644 index 0000000000..7388555a1f --- /dev/null +++ b/test-suite/bugs/closed/bug_2839.v @@ -0,0 +1,11 @@ +(* Check a case where ltac typing error should result in error, not anomaly *) + +Goal forall (H : forall x : nat, x = x), False. +intro. +Fail + let H := + match goal with + | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H' + end + in pose H. +Abort. diff --git a/test-suite/bugs/closed/2846.v b/test-suite/bugs/closed/bug_2846.v index 8d6d348a2e..8d6d348a2e 100644 --- a/test-suite/bugs/closed/2846.v +++ b/test-suite/bugs/closed/bug_2846.v diff --git a/test-suite/bugs/closed/2848.v b/test-suite/bugs/closed/bug_2848.v index e234630332..e234630332 100644 --- a/test-suite/bugs/closed/2848.v +++ b/test-suite/bugs/closed/bug_2848.v diff --git a/test-suite/bugs/closed/bug_2854.v b/test-suite/bugs/closed/bug_2854.v new file mode 100644 index 0000000000..6bc102f569 --- /dev/null +++ b/test-suite/bugs/closed/bug_2854.v @@ -0,0 +1,9 @@ +Section foo. + Let foo := Type. + Definition bar : foo -> foo := @id _. + Goal False. + subst foo. + Fail pose bar as f. + (* simpl in f. *) + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_2876.v b/test-suite/bugs/closed/bug_2876.v new file mode 100644 index 0000000000..c7df59e86b --- /dev/null +++ b/test-suite/bugs/closed/bug_2876.v @@ -0,0 +1,11 @@ +Lemma test_bug : forall (R:nat->nat->Prop) n m m' (P: Prop), + P -> + (P -> R n m) -> + (P -> R n m') -> + (forall u, R n u -> u = u -> True) -> + True. +Proof. + intros * HP H1 H2 H3. eapply H3. + eauto. (* H1 is used, but H2 should be used since it is the last hypothesis *) + auto. +Qed. diff --git a/test-suite/bugs/closed/2881.v b/test-suite/bugs/closed/bug_2881.v index b4f09305b4..b4f09305b4 100644 --- a/test-suite/bugs/closed/2881.v +++ b/test-suite/bugs/closed/bug_2881.v diff --git a/test-suite/bugs/closed/bug_2883.v b/test-suite/bugs/closed/bug_2883.v new file mode 100644 index 0000000000..9170ce41ca --- /dev/null +++ b/test-suite/bugs/closed/bug_2883.v @@ -0,0 +1,37 @@ +Require Import TestSuite.admit. +Require Import List. +Require Import Coq.Program.Equality. + +Inductive star {genv state : Type} + (step : genv -> state -> state -> Prop) + (ge : genv) : state -> state -> Prop := + | star_refl : forall s : state, star step ge s s + | star_step : + forall (s1 : state) (s2 : state) + (s3 : state), + step ge s1 s2 -> + star step ge s2 s3 -> + star step ge s1 s3. + +Parameter genv expr env mem : Type. +Definition genv' := genv. +Inductive state : Type := + | State : expr -> env -> mem -> state. +Parameter step : genv' -> state -> state -> Prop. + +Section Test. + +Variable ge : genv'. + +Lemma compat_eval_steps: + forall a b e a' b', + star step ge (State a e b) (State a' e b') -> + True. +Proof. + intros. dependent induction H. + trivial. + eapply IHstar; eauto. + replace s2 with (State a' e b') by admit. eauto. +Qed. (* Oups *) + +End Test. diff --git a/test-suite/bugs/closed/bug_2900.v b/test-suite/bugs/closed/bug_2900.v new file mode 100644 index 0000000000..93ea71848b --- /dev/null +++ b/test-suite/bugs/closed/bug_2900.v @@ -0,0 +1,29 @@ +(* Was raising stack overflow in 8.4 and assertion failed in future 8.5 *) +Set Implicit Arguments. + +Require Import List. +Require Import Coq.Program.Equality. + +(** Reflexive-transitive closure ( R* ) *) + +Inductive rtclosure (A : Type) (R : A-> A->Prop) : A->A->Prop := + | rtclosure_refl : forall x, + rtclosure R x x + | rtclosure_step : forall y x z, + R x y -> rtclosure R y z -> rtclosure R x z. + (* bug goes away if rtclosure_step is commented out *) + +(** The closure of the trivial binary relation [eq] *) + +Definition tr (A:Type) := rtclosure (@eq A). + +(** The bug *) + +Lemma bug : forall A B (l t:list A) (r s:list B), + length l = length r -> + tr (combine l r) (combine t s) -> tr l t. +Proof. + intros * E Hp. + (* bug goes away if [revert E] is called explicitly *) + dependent induction Hp. +Abort. diff --git a/test-suite/bugs/closed/2920.v b/test-suite/bugs/closed/bug_2920.v index 13548b9e44..13548b9e44 100644 --- a/test-suite/bugs/closed/2920.v +++ b/test-suite/bugs/closed/bug_2920.v diff --git a/test-suite/bugs/closed/2923.v b/test-suite/bugs/closed/bug_2923.v index 8a0003a397..8a0003a397 100644 --- a/test-suite/bugs/closed/2923.v +++ b/test-suite/bugs/closed/bug_2923.v diff --git a/test-suite/bugs/closed/2928.v b/test-suite/bugs/closed/bug_2928.v index 21e92ae20c..21e92ae20c 100644 --- a/test-suite/bugs/closed/2928.v +++ b/test-suite/bugs/closed/bug_2928.v diff --git a/test-suite/bugs/closed/2930.v b/test-suite/bugs/closed/bug_2930.v index 0994b6fb23..0994b6fb23 100644 --- a/test-suite/bugs/closed/2930.v +++ b/test-suite/bugs/closed/bug_2930.v diff --git a/test-suite/bugs/closed/2945.v b/test-suite/bugs/closed/bug_2945.v index 59b57c07b7..59b57c07b7 100644 --- a/test-suite/bugs/closed/2945.v +++ b/test-suite/bugs/closed/bug_2945.v diff --git a/test-suite/bugs/closed/bug_2946.v b/test-suite/bugs/closed/bug_2946.v new file mode 100644 index 0000000000..9c96ae021e --- /dev/null +++ b/test-suite/bugs/closed/bug_2946.v @@ -0,0 +1,10 @@ +Lemma toto (E : nat -> nat -> Prop) (x y : nat) + (Ex_ : forall z, E x z) (E_y : forall z, E z y) : True. + +(* OK *) +assert (pairE1 := let Exy := _ in (Ex_ y, E_y _) : Exy * Exy). + +(* FAIL *) +assert (pairE2 := let Exy := _ in (Ex_ _, E_y x) : Exy * Exy). + +Abort. diff --git a/test-suite/bugs/closed/2951.v b/test-suite/bugs/closed/bug_2951.v index 87d544416d..87d544416d 100644 --- a/test-suite/bugs/closed/2951.v +++ b/test-suite/bugs/closed/bug_2951.v diff --git a/test-suite/bugs/closed/bug_2955.v b/test-suite/bugs/closed/bug_2955.v new file mode 100644 index 0000000000..8b024f0730 --- /dev/null +++ b/test-suite/bugs/closed/bug_2955.v @@ -0,0 +1,52 @@ +Require Import Coq.Arith.Arith. + +Module A. + + Fixpoint foo (n:nat) := + match n with + | 0 => 0 + | S n => bar n + end + + with bar (n:nat) := + match n with + | 0 => 0 + | S n => foo n + end. + + Lemma using_foo: + forall (n:nat), foo n = 0 /\ bar n = 0. + Proof. + induction n ; split ; auto ; + destruct IHn ; auto. + Qed. + +End A. + + +Module B. + + Module A := A. + Import A. + +End B. + +Module E. + + Module B := B. + Import B.A. + + (* Bug 1 *) + Lemma test_1: + forall (n:nat), foo n = 0. + Proof. + intros ; destruct n. + reflexivity. + specialize (A.using_foo (S n)) ; intros. + simpl in H. + simpl. + destruct H. + assumption. + Qed. + +End E. diff --git a/test-suite/bugs/closed/bug_2966.v b/test-suite/bugs/closed/bug_2966.v new file mode 100644 index 0000000000..92d5b9cdc9 --- /dev/null +++ b/test-suite/bugs/closed/bug_2966.v @@ -0,0 +1,79 @@ +(** Non-termination and state monad with extraction *) +Require Import List. + +Set Implicit Arguments. +Set Asymmetric Patterns. + +Module MemSig. + Definition t: Type := list Type. + + Definition Nth (sig: t) (n: nat) := + nth n sig unit. +End MemSig. + +(** A memory of type [Mem.t s] is the union of cells whose type is specified + by [s]. *) +Module Mem. + Inductive t: MemSig.t -> Type := + | Nil: t nil + | Cons: forall (T: Type), option T -> forall (sig: MemSig.t), t sig -> + t (T :: sig). +End Mem. + +Module Ref. + Inductive t (sig: MemSig.t) (T: Type): Type := + | Input: t sig T. + + Definition Read (sig: MemSig.t) (T: Type) (ref: t sig T) (s: Mem.t sig) + : option T := + match ref with + | Input => None + end. +End Ref. + +Module Monad. + Definition t (sig: MemSig.t) (A: Type) := + Mem.t sig -> option A * Mem.t sig. + + Definition Return (sig: MemSig.t) (A: Type) (x: A): t sig A := + fun s => + (Some x, s). + + Definition Bind (sig: MemSig.t) (A B: Type) (x: t sig A) (f: A -> t sig B) + : t sig B := + fun s => + match x s with + | (Some x', s') => f x' s' + | (None, s') => (None, s') + end. + + Definition Select (T: Type) (f g: unit -> T): T := + f tt. + + (** Read in a reference. *) + Definition Read (sig: MemSig.t) (T: Type) (ref: Ref.t sig T) + : t sig T := + fun s => + match Ref.Read ref s with + | None => (None, s) + | Some x => (Some x, s) + end. +End Monad. + +Import Monad. + +Definition pop (sig: MemSig.t) (T: Type) (trace: Ref.t sig (list T)) + : Monad.t sig T := + Bind (Read trace) (fun _ s => (None, s)). + +Definition sig: MemSig.t := (list nat: Type) :: nil. + +Definition trace: Ref.t sig (list nat). +Admitted. + +Definition Gre (sig: MemSig.t) (trace: _) + (f: bool -> bool): Monad.t sig nat := + Select (fun _ => pop trace) (fun _ => Return 0). + +Definition Arg := + Gre trace (fun _ => false). diff --git a/test-suite/bugs/closed/2969.v b/test-suite/bugs/closed/bug_2969.v index 7b1a261789..7b1a261789 100644 --- a/test-suite/bugs/closed/2969.v +++ b/test-suite/bugs/closed/bug_2969.v diff --git a/test-suite/bugs/closed/bug_2981.v b/test-suite/bugs/closed/bug_2981.v new file mode 100644 index 0000000000..44e53ca46c --- /dev/null +++ b/test-suite/bugs/closed/bug_2981.v @@ -0,0 +1,14 @@ +Check let TTT := Type in (fun (a b : @sigT TTT (fun A : TTT => A)) + (f : @projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) => + @eq_refl + (@projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) + (fun x : @projT1 TTT (fun A : TTT => A) a => f x)) : + forall (a b : @sigT TTT (fun A : TTT => A)) + (f : @projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b), + @eq + (@projT1 TTT (fun A : TTT => A) a -> + @projT1 TTT (fun A : TTT => A) b) + (fun x : @projT1 TTT (fun A : TTT => A) a => f x) f. diff --git a/test-suite/bugs/closed/2983.v b/test-suite/bugs/closed/bug_2983.v index ad76350949..ad76350949 100644 --- a/test-suite/bugs/closed/2983.v +++ b/test-suite/bugs/closed/bug_2983.v diff --git a/test-suite/bugs/closed/2990.v b/test-suite/bugs/closed/bug_2990.v index 5f832626bc..5f832626bc 100644 --- a/test-suite/bugs/closed/2990.v +++ b/test-suite/bugs/closed/bug_2990.v diff --git a/test-suite/bugs/closed/2994.v b/test-suite/bugs/closed/bug_2994.v index 457b1893de..457b1893de 100644 --- a/test-suite/bugs/closed/2994.v +++ b/test-suite/bugs/closed/bug_2994.v diff --git a/test-suite/bugs/closed/bug_2995.v b/test-suite/bugs/closed/bug_2995.v new file mode 100644 index 0000000000..1a4d7e5040 --- /dev/null +++ b/test-suite/bugs/closed/bug_2995.v @@ -0,0 +1,13 @@ +Module Type Interface. + Parameter error: nat. +End Interface. + +Module Implementation <: Interface. + Definition t := bool. + Definition error: t := false. +Fail End Implementation. +(* A UserError here is expected, not an uncaught Not_found *) + + Reset error. + Definition error := 0. +End Implementation. diff --git a/test-suite/bugs/closed/bug_2996.v b/test-suite/bugs/closed/bug_2996.v new file mode 100644 index 0000000000..6736db898d --- /dev/null +++ b/test-suite/bugs/closed/bug_2996.v @@ -0,0 +1,33 @@ +Require Import TestSuite.admit. +(* Test on definitions referring to section variables that are not any + longer in the current context *) + +Section x. + + Hypothesis h : forall(n : nat), n < S n. + + Definition f(n m : nat)(less : n < m) : nat := n + m. + + Lemma a : forall(n : nat), f n (S n) (h n) = 1 + 2 * n. + Proof. + (* XXX *) admit. + Qed. + + Lemma b : forall(n : nat), n < 3 + n. + Proof. + clear. + intros n. + Fail assert (H := a n). + Abort. + + Let T := True. + Definition p := I : T. + + Lemma paradox : False. + Proof. + clear. + set (T := False). + Fail pose proof p as H. + Abort. + +End x. diff --git a/test-suite/bugs/closed/3000.v b/test-suite/bugs/closed/bug_3000.v index 27de34ed17..27de34ed17 100644 --- a/test-suite/bugs/closed/3000.v +++ b/test-suite/bugs/closed/bug_3000.v diff --git a/test-suite/bugs/closed/3001.v b/test-suite/bugs/closed/bug_3001.v index 6e56555499..6e56555499 100644 --- a/test-suite/bugs/closed/3001.v +++ b/test-suite/bugs/closed/bug_3001.v diff --git a/test-suite/bugs/closed/bug_3003.v b/test-suite/bugs/closed/bug_3003.v new file mode 100644 index 0000000000..2484605f54 --- /dev/null +++ b/test-suite/bugs/closed/bug_3003.v @@ -0,0 +1,13 @@ +(* This used to raise an anomaly in 8.4 and trunk up to 17 April 2013 *) + +Set Implicit Arguments. + +Inductive path (V : Type) (E : V -> V -> Type) (s : V) : V -> Type := + | NoEdges : path E s s + | AddEdge : forall d d' : V, path E s d -> E d d' -> path E s d'. +Inductive G_Vertex := G_v0 | G_v1. +Inductive G_Edge : G_Vertex -> G_Vertex -> Set := G_e : G_Edge G_v0 G_v1. +Goal forall x1 : G_Edge G_v1 G_v1, @AddEdge _ G_Edge G_v1 _ _ (NoEdges _ _) x1 = NoEdges _ _. +intro x1. +try destruct x1. (* now raises a typing error *) +Abort. diff --git a/test-suite/bugs/closed/3004.v b/test-suite/bugs/closed/bug_3004.v index 896b1958b0..896b1958b0 100644 --- a/test-suite/bugs/closed/3004.v +++ b/test-suite/bugs/closed/bug_3004.v diff --git a/test-suite/bugs/closed/3008.v b/test-suite/bugs/closed/bug_3008.v index 1979eda820..1979eda820 100644 --- a/test-suite/bugs/closed/3008.v +++ b/test-suite/bugs/closed/bug_3008.v diff --git a/test-suite/bugs/closed/3010b.v b/test-suite/bugs/closed/bug_3010b.v index 65fea42489..65fea42489 100644 --- a/test-suite/bugs/closed/3010b.v +++ b/test-suite/bugs/closed/bug_3010b.v diff --git a/test-suite/bugs/closed/bug_3016.v b/test-suite/bugs/closed/bug_3016.v new file mode 100644 index 0000000000..d9fd685eae --- /dev/null +++ b/test-suite/bugs/closed/bug_3016.v @@ -0,0 +1,6 @@ +Section foo. + Variable C : Type. + Goal True. + change (eq (A := ?C) ?x ?y) with (eq). + Abort. +End foo. diff --git a/test-suite/bugs/closed/3017.v b/test-suite/bugs/closed/bug_3017.v index 63a06bd3d6..63a06bd3d6 100644 --- a/test-suite/bugs/closed/3017.v +++ b/test-suite/bugs/closed/bug_3017.v diff --git a/test-suite/bugs/closed/3022.v b/test-suite/bugs/closed/bug_3022.v index dcfe733974..dcfe733974 100644 --- a/test-suite/bugs/closed/3022.v +++ b/test-suite/bugs/closed/bug_3022.v diff --git a/test-suite/bugs/closed/3023.v b/test-suite/bugs/closed/bug_3023.v index 70a1491e15..70a1491e15 100644 --- a/test-suite/bugs/closed/3023.v +++ b/test-suite/bugs/closed/bug_3023.v diff --git a/test-suite/bugs/closed/bug_3036.v b/test-suite/bugs/closed/bug_3036.v new file mode 100644 index 0000000000..dff15d4e10 --- /dev/null +++ b/test-suite/bugs/closed/bug_3036.v @@ -0,0 +1,171 @@ +(* Checking use of retyping in w_unify0 in the presence of unification +problems of the form \x:Meta.Meta = \x:ind.match x with ... end *) + +Require Import List. +Require Import QArith. +Require Import Qcanon. + +Set Implicit Arguments. + +Inductive dynamic : Type := + | Dyn : forall T, T -> dynamic. + +Definition perm := Qc. + +Locate Qle_bool. + +Definition compatibleb (p1 p2 : perm) : bool := +let p1pos := Qle_bool 0 p1 in + let p2pos := Qle_bool 0 p2 in + negb ( + (p1pos && p2pos) + || ((p1pos || p2pos) && (negb (Qle_bool 0 ((p1 + p2)%Qc)))))%Qc. + +Definition compatible (p1 p2 : perm) := compatibleb p1 p2 = true. + +Definition perm_plus (p1 p2 : perm) : option perm := + if compatibleb p1 p2 then Some (p1 + p2) else None. + +Infix "+p" := perm_plus (at level 60, no associativity). + +Axiom axiom_ptr : Set. + +Definition ptr := axiom_ptr. + +Axiom axiom_ptr_eq_dec : forall (a b : ptr), {a = b} + {a <> b}. + +Definition ptr_eq_dec := axiom_ptr_eq_dec. + +Definition hval := (dynamic * perm)%type. + +Definition heap := ptr -> option hval. + +Bind Scope heap_scope with heap. +Delimit Scope heap_scope with heap. +Local Open Scope heap_scope. + +Definition read (h : heap) (p : ptr) : option hval := h p. + +Notation "a # b" := (read a b) (at level 55, no associativity) : heap_scope. + +Definition val (v:hval) := fst v. +Definition frac (v:hval) := snd v. + +Definition hval_plus (v1 v2 : hval) : option hval := + match (frac v1) +p (frac v2) with + | None => None + | Some v1v2 => Some (val v1, v1v2) + end. + +Definition hvalo_plus (v1 v2 : option hval) := + match v1 with + | None => v2 + | Some v1' => + match v2 with + | None => v1 + | Some v2' => (hval_plus v1' v2') + end + end. + +Notation "v1 +o v2" := (hvalo_plus v1 v2) (at level 60, no associativity) : heap_scope. + +Definition join (h1 h2 : heap) : heap := + (fun p => (h1 p) +o (h2 p)). + +Infix "*" := join (at level 40, left associativity) : heap_scope. + +Definition hprop := heap -> Prop. + +Bind Scope hprop_scope with hprop. +Delimit Scope hprop_scope with hprop. + +Definition hprop_cell (p : ptr) T (v : T) (pi:Qc): hprop := fun h => + h#p = Some (Dyn v, pi) /\ forall p', p' <> p -> h#p' = None. + +Notation "p ---> v" := (hprop_cell p v (0%Qc)) (at level 38, no associativity) : hprop_scope. + +Definition empty : heap := fun _ => None. + +Definition hprop_empty : hprop := eq empty. +Notation "'emp'" := hprop_empty : hprop_scope. + +Definition hprop_inj (P : Prop) : hprop := fun h => h = empty /\ P. +Notation "[ P ]" := (hprop_inj P) (at level 0, P at level 200) : hprop_scope. + +Definition hprop_imp (p1 p2 : hprop) : Prop := forall h, p1 h -> p2 h. +Infix "==>" := hprop_imp (right associativity, at level 55). + +Definition hprop_ex T (p : T -> hprop) : hprop := fun h => exists v, p v h. +Notation "'Exists' v :@ T , p" := (hprop_ex (fun v : T => p%hprop)) + (at level 90, T at next level) : hprop_scope. + +Local Open Scope hprop_scope. +Definition disjoint (h1 h2 : heap) : Prop := + forall p, + match h1#p with + | None => True + | Some v1 => match h2#p with + | None => True + | Some v2 => val v1 = val v2 + /\ compatible (frac v1) (frac v2) + end + end. + +Infix "<#>" := disjoint (at level 40, no associativity) : heap_scope. + +Definition split (h h1 h2 : heap) : Prop := h1 <#> h2 /\ h = h1 * h2. + +Notation "h ~> h1 * h2" := (split h h1 h2) (at level 40, h1 at next level, no associativity). + +Definition hprop_sep (p1 p2 : hprop) : hprop := fun h => + exists h1, exists h2, h ~> h1 * h2 + /\ p1 h1 + /\ p2 h2. +Infix "*" := hprop_sep (at level 40, left associativity) : hprop_scope. + +Section Stack. + Variable T : Set. + + Record node : Set := Node { + data : T; + next : option ptr + }. + + Fixpoint listRep (ls : list T) (hd : option ptr) {struct ls} : hprop := + match ls with + | nil => [hd = None] + | h :: t => + match hd with + | None => [False] + | Some hd' => Exists p :@ option ptr, hd' ---> Node h p * listRep t p + end + end%hprop. + + Definition stack := ptr. + + Definition rep q ls := (Exists po :@ option ptr, q ---> po * listRep ls po)%hprop. + + Definition isExistential T (x : T) := True. + + Theorem himp_ex_conc_trivial : forall T p p1 p2, + p ==> p1 * p2 + -> T + -> p ==> hprop_ex (fun _ : T => p1) * p2. + Admitted. + + Goal forall (s : ptr) (x : T) (nd : ptr) (v : unit) (x0 : list T) (v0 : option ptr) + (H0 : isExistential v0), + nd ---> {| data := x; next := v0 |} * (s ---> Some nd * listRep x0 v0) ==> + (Exists po :@ option ptr, + s ---> po * + match po with + | Some hd' => + Exists p :@ option ptr, + hd' ---> {| data := x; next := p |} * listRep x0 p + | None => [False] + end) * emp. + Proof. + intros. + try apply himp_ex_conc_trivial. + Abort. +End Stack. diff --git a/test-suite/bugs/closed/bug_3037.v b/test-suite/bugs/closed/bug_3037.v new file mode 100644 index 0000000000..40d1bfde53 --- /dev/null +++ b/test-suite/bugs/closed/bug_3037.v @@ -0,0 +1,12 @@ +(* Anomaly before 4a8950ec7a0d9f2b216e67e69b446c064590a8e9 *) + +Require Import Recdef. + +Function f_R (a: nat) {wf (fun x y: nat => False) a}:Prop:= + match a:nat with + | 0 => True + | (S y') => f_R y' + end. +(* Anomaly: File "plugins/funind/recdef.ml", line 916, characters 13-19: Assertion failed. +Please report. *) +Abort. diff --git a/test-suite/bugs/closed/3043.v b/test-suite/bugs/closed/bug_3043.v index 654663b4fc..654663b4fc 100644 --- a/test-suite/bugs/closed/3043.v +++ b/test-suite/bugs/closed/bug_3043.v diff --git a/test-suite/bugs/closed/bug_3045.v b/test-suite/bugs/closed/bug_3045.v new file mode 100644 index 0000000000..90aa5ee9fd --- /dev/null +++ b/test-suite/bugs/closed/bug_3045.v @@ -0,0 +1,35 @@ + +Set Asymmetric Patterns. +Generalizable All Variables. +Set Implicit Arguments. +Set Universe Polymorphism. + +Record SpecializedCategory (obj : Type) := + { + Object :> _ := obj; + Morphism : obj -> obj -> Type; + + Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d' + }. + +Arguments Compose {obj} [C s d d'] _ _ : rename. + +Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -> Type := +| ReifiedComposedMorphism : forall objC C s d d', ReifiedMorphism C d d' -> ReifiedMorphism C s d -> @ReifiedMorphism objC C s d'. + +Fixpoint ReifiedMorphismDenote objC C s d (m : @ReifiedMorphism objC C s d) : Morphism C s d := + match m in @ReifiedMorphism objC C s d return Morphism C s d with + | ReifiedComposedMorphism _ _ _ _ _ m1 m2 => Compose (@ReifiedMorphismDenote _ _ _ _ m1) + (@ReifiedMorphismDenote _ _ _ _ m2) + end. + +Fixpoint ReifiedMorphismSimplifyWithProof objC C s d (m : @ReifiedMorphism objC C s d) +: { m' : ReifiedMorphism C s d | ReifiedMorphismDenote m = ReifiedMorphismDenote m' }. +refine match m with + | ReifiedComposedMorphism _ _ s0 d0 d0' m1 m2 => _ + end; clear m. +(* This fails with an error rather than an anomaly, but morally + it should work, if destruct were able to do the good generalization + in advance, before doing the "intros []". *) +Fail destruct (@ReifiedMorphismSimplifyWithProof T s1 d0 d0' m1) as [ [] ? ]. +Abort. diff --git a/test-suite/bugs/closed/3050.v b/test-suite/bugs/closed/bug_3050.v index 4b18722431..4b18722431 100644 --- a/test-suite/bugs/closed/3050.v +++ b/test-suite/bugs/closed/bug_3050.v diff --git a/test-suite/bugs/closed/3054.v b/test-suite/bugs/closed/bug_3054.v index 936e58e197..936e58e197 100644 --- a/test-suite/bugs/closed/3054.v +++ b/test-suite/bugs/closed/bug_3054.v diff --git a/test-suite/bugs/closed/3062.v b/test-suite/bugs/closed/bug_3062.v index a7b5fab03e..a7b5fab03e 100644 --- a/test-suite/bugs/closed/3062.v +++ b/test-suite/bugs/closed/bug_3062.v diff --git a/test-suite/bugs/closed/bug_3068.v b/test-suite/bugs/closed/bug_3068.v new file mode 100644 index 0000000000..00d00b421e --- /dev/null +++ b/test-suite/bugs/closed/bug_3068.v @@ -0,0 +1,67 @@ +Require Import TestSuite.admit. +Section Counted_list. + + Variable A : Type. + + Inductive counted_list : nat -> Type := + | counted_nil : counted_list 0 + | counted_cons : forall(n : nat), + A -> counted_list n -> counted_list (S n). + + + Fixpoint counted_def_nth{n : nat}(l : counted_list n) + (i : nat)(def : A) : A := + match i with + | 0 => match l with + | counted_nil => def + | counted_cons _ a _ => a + end + | S i => match l with + | counted_nil => def + | counted_cons _ _ tl => counted_def_nth tl i def + end + end. + + + Lemma counted_list_equal_nth_char : + forall(n : nat)(l1 l2 : counted_list n)(def : A), + (forall(i : nat), counted_def_nth l1 i def = counted_def_nth l2 i def) -> + l1 = l2. + Proof. + admit. + Qed. + +End Counted_list. + +Arguments counted_def_nth [A n]. + +Section Finite_nat_set. + + Variable set_size : nat. + + Definition fnat_subset : Type := counted_list bool set_size. + + Definition fnat_member(fs : fnat_subset)(n : nat) : Prop := + is_true (counted_def_nth fs n false). + + + Lemma fnat_subset_member_eq : forall(fs1 fs2 : fnat_subset), + fs1 = fs2 <-> + forall(n : nat), fnat_member fs1 n <-> fnat_member fs2 n. + + Proof. + intros fs1 fs2. + split. + intros H n. + subst fs1. + apply iff_refl. + intros H. + eapply (counted_list_equal_nth_char _ _ _ _ ?[def]). + intros i. + destruct (counted_def_nth fs1 i _ ) eqn:H0. + (* This was not part of the initial bug report; this is to check that + the existential variable kept its name *) + change (true = counted_def_nth fs2 i ?def). + + Abort. +End Finite_nat_set. diff --git a/test-suite/bugs/closed/bug_3070.v b/test-suite/bugs/closed/bug_3070.v new file mode 100644 index 0000000000..3ebfaa3131 --- /dev/null +++ b/test-suite/bugs/closed/bug_3070.v @@ -0,0 +1,7 @@ +(* Testing subst wrt chains of dependencies *) + +Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop) + (Ha : a1 = a2) (c : a1) (d : b1 c) : True. +Proof. + subst. +Abort. diff --git a/test-suite/bugs/closed/3071.v b/test-suite/bugs/closed/bug_3071.v index 53c2ef7b71..53c2ef7b71 100644 --- a/test-suite/bugs/closed/3071.v +++ b/test-suite/bugs/closed/bug_3071.v diff --git a/test-suite/bugs/closed/3080.v b/test-suite/bugs/closed/bug_3080.v index 36ab7ff599..36ab7ff599 100644 --- a/test-suite/bugs/closed/3080.v +++ b/test-suite/bugs/closed/bug_3080.v diff --git a/test-suite/bugs/closed/3088.v b/test-suite/bugs/closed/bug_3088.v index 3c362510e3..3c362510e3 100644 --- a/test-suite/bugs/closed/3088.v +++ b/test-suite/bugs/closed/bug_3088.v diff --git a/test-suite/bugs/closed/3093.v b/test-suite/bugs/closed/bug_3093.v index f6b4a03f3b..f6b4a03f3b 100644 --- a/test-suite/bugs/closed/3093.v +++ b/test-suite/bugs/closed/bug_3093.v diff --git a/test-suite/bugs/closed/bug_3100.v b/test-suite/bugs/closed/bug_3100.v new file mode 100644 index 0000000000..37e0cb7119 --- /dev/null +++ b/test-suite/bugs/closed/bug_3100.v @@ -0,0 +1,10 @@ +Fixpoint F (n : nat) (A : Type) : Type := + match n with + | 0 => True + | S n => forall (x : A), F n (x = x) + end. + +Goal forall A n, (forall (x : A) (e : x = x), F n (e = e)). +intros A n. +Fail change (forall x, F n (x = x)) with (F (S n)). +Abort. diff --git a/test-suite/bugs/closed/3125.v b/test-suite/bugs/closed/bug_3125.v index 797146174d..797146174d 100644 --- a/test-suite/bugs/closed/3125.v +++ b/test-suite/bugs/closed/bug_3125.v diff --git a/test-suite/bugs/closed/3142.v b/test-suite/bugs/closed/bug_3142.v index 988074e2f1..988074e2f1 100644 --- a/test-suite/bugs/closed/3142.v +++ b/test-suite/bugs/closed/bug_3142.v diff --git a/test-suite/bugs/closed/3164.v b/test-suite/bugs/closed/bug_3164.v index 3c9af8d0f3..3c9af8d0f3 100644 --- a/test-suite/bugs/closed/3164.v +++ b/test-suite/bugs/closed/bug_3164.v diff --git a/test-suite/bugs/closed/3188.v b/test-suite/bugs/closed/bug_3188.v index 0117602670..0117602670 100644 --- a/test-suite/bugs/closed/3188.v +++ b/test-suite/bugs/closed/bug_3188.v diff --git a/test-suite/bugs/closed/bug_3199.v b/test-suite/bugs/closed/bug_3199.v new file mode 100644 index 0000000000..d1bd9017c1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3199.v @@ -0,0 +1,19 @@ +Axiom P : nat -> Prop. +Axiom admit : forall n : nat, P n -> P n -> n = S n. +Axiom foo : forall n, P n. + +Create HintDb bar. +Hint Extern 3 => symmetry : bar. +Hint Resolve admit : bar. +Hint Immediate foo : bar. + +Lemma qux : forall n : nat, n = S n. +Proof. +intros n. +eauto with bar. +Defined. + +Goal True. +pose (e := eq_refl (qux 0)); unfold qux in e. +match type of e with context [eq_sym] => fail 1 | _ => idtac end. +Abort. diff --git a/test-suite/bugs/closed/3205.v b/test-suite/bugs/closed/bug_3205.v index 5c44f07036..5c44f07036 100644 --- a/test-suite/bugs/closed/3205.v +++ b/test-suite/bugs/closed/bug_3205.v diff --git a/test-suite/bugs/closed/bug_3209.v b/test-suite/bugs/closed/bug_3209.v new file mode 100644 index 0000000000..b4075086d0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3209.v @@ -0,0 +1,74 @@ +(* Avoiding some occur-check *) + +(* 1. Original example *) + +Inductive eqT {A} (x : A) : A -> Type := + reflT : eqT x x. +Definition Bi_inv (A B : Type) (f : (A -> B)) := + sigT (fun (g : B -> A) => + sigT (fun (h : B -> A) => + sigT (fun (α : forall b : B, eqT (f (g b)) b) => + forall a : A, eqT (h (f a)) a))). +Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f). + +Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B). +Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B := + sigT_rect (fun _ => TEquiv A B) + (fun (f : TEquiv A B -> eqT A B) H => + sigT_rect _ (* (fun _ => TEquiv A B) *) + (fun g _ => g e) + H) + (UA A B). + +(* 2. Alternative example by Guillaume *) + +Inductive foo (A : Prop) : Prop := Foo : foo A. +Axiom bar : forall (A : Prop) (P : foo A -> Prop), (A -> P (Foo A)) -> Prop. + +(* This used to fail with a Not_found, we fail more graciously but a + heuristic could be implemented, e.g. in some smart occur-check + function, to find a solution of then form ?P := fun _ => ?P' *) + +Fail Check (fun e : ?[T] => bar ?[A] ?[P] (fun g : ?[A'] => g e)). + +(* This works and tells which solution we could have inferred *) + +Check (fun e : ?[T] => bar ?[A] (fun _ => ?[P]) (fun g : ?[A'] => g e)). + +(* For the record, here is the trace in the failing example: + +In (fun e : ?T => bar ?[A] ?[P] (fun g : ?A' => g e)), we have the existential variables + +e:?T |- ?A : Prop +e:?T |- ?P : foo ?A -> Prop +e:?T |- ?A' : Type + +with constraints + +?A' == ?A +?A' == ?T -> ?P (Foo ?A) + +To type (g e), unification first defines + +?A := forall x:?B, ?P'{e:=e,x:=x} +with ?T <= ?B +and ?P'@{e:=e,x:=e} <= ?P@{e:=e} (Foo (forall x:?B, ?P'{e:=e,x:=x})) + +Then, since ?P'@{e:=e,x:=e} may use "e" in two different ways, it is +not a pattern and we define a new + +e:?T x:?B|- ?P'' : foo (?B' -> ?P''') -> Prop + +for some ?B' and ?P''', together with + +?P'@{e,x} := ?P''{e:=e,x:=e} (Foo (?B -> ?P') +?P@{e} := ?P''{e:=e,x:=e} + +Moreover, ?B' and ?P''' have to satisfy + +?B'@{e:=e,x:=e} == ?B@{e:=e} +?P'''@{e:=e,x:=e} == ?P'@{e:=e,x:=x} + +and this leads to define ?P' which was the initial existential +variable to define. +*) diff --git a/test-suite/bugs/closed/bug_3210.v b/test-suite/bugs/closed/bug_3210.v new file mode 100644 index 0000000000..b320c59d0f --- /dev/null +++ b/test-suite/bugs/closed/bug_3210.v @@ -0,0 +1,23 @@ +(* Test support of let-in in arity of inductive types *) + +Inductive Foo : let X := Set in X := +| I : Foo. + +Definition foo (x : Foo) : bool := + match x with + I => true + end. + +Definition foo' (x : Foo) : x = x. +case x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +elim x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +induction x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Undo 2. +destruct x. +match goal with |- I = I => idtac end. (* check form of the goal *) +Abort. diff --git a/test-suite/bugs/closed/3212.v b/test-suite/bugs/closed/bug_3212.v index 53d8dfe326..53d8dfe326 100644 --- a/test-suite/bugs/closed/3212.v +++ b/test-suite/bugs/closed/bug_3212.v diff --git a/test-suite/bugs/closed/3217.v b/test-suite/bugs/closed/bug_3217.v index ec846bf95b..ec846bf95b 100644 --- a/test-suite/bugs/closed/3217.v +++ b/test-suite/bugs/closed/bug_3217.v diff --git a/test-suite/bugs/closed/bug_3228.v b/test-suite/bugs/closed/bug_3228.v new file mode 100644 index 0000000000..7c0eba6e71 --- /dev/null +++ b/test-suite/bugs/closed/bug_3228.v @@ -0,0 +1,8 @@ +(* Check that variables in the context do not take precedence over + ltac variables *) + +Ltac bar x := exact x. +Goal False -> False. + intro x. + Fail bar doesnotexist. +Abort. diff --git a/test-suite/bugs/closed/3230.v b/test-suite/bugs/closed/bug_3230.v index 265310b1a3..265310b1a3 100644 --- a/test-suite/bugs/closed/3230.v +++ b/test-suite/bugs/closed/bug_3230.v diff --git a/test-suite/bugs/closed/bug_3242.v b/test-suite/bugs/closed/bug_3242.v new file mode 100644 index 0000000000..145375c1ad --- /dev/null +++ b/test-suite/bugs/closed/bug_3242.v @@ -0,0 +1 @@ +Inductive Foo (x := Type) := C : Foo -> Foo. diff --git a/test-suite/bugs/closed/3249.v b/test-suite/bugs/closed/bug_3249.v index 71d457b002..71d457b002 100644 --- a/test-suite/bugs/closed/3249.v +++ b/test-suite/bugs/closed/bug_3249.v diff --git a/test-suite/bugs/closed/bug_3251.v b/test-suite/bugs/closed/bug_3251.v new file mode 100644 index 0000000000..ef279688aa --- /dev/null +++ b/test-suite/bugs/closed/bug_3251.v @@ -0,0 +1,15 @@ +Goal True. +idtac. +Ltac foo := idtac. +(* print out happens twice: +foo is defined +foo is defined + +... that's fishy. But E. Tassi tells me that it's expected since "Ltac" generates a side +effect that escapes the proof. In the STM model this means the command is executed twice, +once in the proof branch, and another time in the main branch *) +Undo. +Ltac foo := idtac. +(* Before 5b39c3535f7b3383d89d7b844537244a4e7c0eca, this would print out: *) +(* Anomaly: Backtrack.backto to a state with no vcs_backup. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3257.v b/test-suite/bugs/closed/bug_3257.v new file mode 100644 index 0000000000..88e2e71911 --- /dev/null +++ b/test-suite/bugs/closed/bug_3257.v @@ -0,0 +1,6 @@ +Require Import Setoid Morphisms Basics. +Lemma foo A B (P : B -> Prop) : + pointwise_relation _ impl (fun z => A -> P z) P. +Proof. + Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3258.v b/test-suite/bugs/closed/bug_3258.v new file mode 100644 index 0000000000..946aff7d08 --- /dev/null +++ b/test-suite/bugs/closed/bug_3258.v @@ -0,0 +1,37 @@ +Require Import TestSuite.admit. +Require Import Coq.Classes.Morphisms Coq.Classes.RelationClasses Coq.Program.Program Coq.Setoids.Setoid. + +Global Set Implicit Arguments. + +Hint Extern 0 => apply reflexivity : typeclass_instances. + +Inductive Comp : Type -> Type := +| Pick : forall A, (A -> Prop) -> Comp A. + +Axiom computes_to : forall A, Comp A -> A -> Prop. + +Axiom refine : forall {A} (old : Comp A) (new : Comp A), Prop. + +Global Instance refine_PreOrder A : PreOrder (@refine A). +Admitted. +Add Parametric Morphism A +: (@Pick A) + with signature + (pointwise_relation _ (flip impl)) + ==> (@refine A) + as refine_flip_impl_Pick. + admit. +Defined. +Definition remove_forall_eq' A x B (P : A -> B -> Prop) : pointwise_relation _ impl (P x) (fun z => forall y : A, y = x -> P y z). + admit. +Defined. +Goal forall A B (x : A) (P : _ -> _ -> Prop), + refine (Pick (fun n : B => forall y, y = x -> P y n)) + (Pick (fun n : B => P x n)). +Proof. + intros. + setoid_rewrite (@remove_forall_eq' _ _ _ _). + Undo. + (* This failed with NotConvertible at some time *) + setoid_rewrite (@remove_forall_eq' _ _ _). +Abort. diff --git a/test-suite/bugs/closed/3259.v b/test-suite/bugs/closed/bug_3259.v index aa91fc3de7..aa91fc3de7 100644 --- a/test-suite/bugs/closed/3259.v +++ b/test-suite/bugs/closed/bug_3259.v diff --git a/test-suite/bugs/closed/bug_3260.v b/test-suite/bugs/closed/bug_3260.v new file mode 100644 index 0000000000..f07f449b12 --- /dev/null +++ b/test-suite/bugs/closed/bug_3260.v @@ -0,0 +1,8 @@ +Require Import Setoid. +Goal forall m n, n = m -> n+n = m+m. +intros. +replace n with m at 2. +lazymatch goal with +|- n + m = m + m => idtac +end. +Abort. diff --git a/test-suite/bugs/closed/bug_3262.v b/test-suite/bugs/closed/bug_3262.v new file mode 100644 index 0000000000..41b2c92281 --- /dev/null +++ b/test-suite/bugs/closed/bug_3262.v @@ -0,0 +1,80 @@ +(* Not having a [return] clause causes the [refine] at the bottom to stack overflow before f65fa9de8a4c9c12d933188a755b51508bd51921 *) + +Require Import Coq.Lists.List. +Require Import Relations RelationClasses. + +Set Implicit Arguments. +Set Strict Implicit. +Set Asymmetric Patterns. + +Section hlist. + Context {iT : Type}. + Variable F : iT -> Type. + + Inductive hlist : list iT -> Type := + | Hnil : hlist nil + | Hcons : forall l ls, F l -> hlist ls -> hlist (l :: ls). + + Definition hlist_hd {a b} (hl : hlist (a :: b)) : F a := + match hl in hlist x return match x with + | nil => unit + | l :: _ => F l + end with + | Hnil => tt + | Hcons _ _ x _ => x + end. + + Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b := + match hl in hlist x return match x with + | nil => unit + | _ :: ls => hlist ls + end with + | Hnil => tt + | Hcons _ _ _ x => x + end. + + Lemma hlist_eta : forall ls (h : hlist ls), + h = match ls as ls return hlist ls -> hlist ls with + | nil => fun _ => Hnil + | a :: b => fun h => Hcons (hlist_hd h) (hlist_tl h) + end h. + Proof. + intros. destruct h; auto. + Qed. + + Variable eqv : forall x, relation (F x). + + Inductive equiv_hlist : forall ls, hlist ls -> hlist ls -> Prop := + | hlist_eqv_nil : equiv_hlist Hnil Hnil + | hlist_eqv_cons : forall l ls x y h1 h2, eqv x y -> equiv_hlist h1 h2 -> + @equiv_hlist (l :: ls) (Hcons x h1) (Hcons y h2). + + Global Instance Reflexive_equiv_hlist (R : forall t, Reflexive (@eqv t)) ls + : Reflexive (@equiv_hlist ls). + Proof. + red. induction x; constructor; auto. reflexivity. + Qed. + + Global Instance Transitive_equiv_hlist (R : forall t, Transitive (@eqv t)) ls + : Transitive (@equiv_hlist ls). + Proof. + red. induction 1. + { intro; assumption. } + { rewrite (hlist_eta z). + Timeout 2 Fail refine + (fun H => + match H in @equiv_hlist ls X Y + return + (* Uncommenting the following gives an immediate error in 8.4pl3; commented out results in a stack overflow *) + match ls (*as ls return hlist ls -> hlist ls -> Type*) with + | nil => fun _ _ : hlist nil => True + | l :: ls => fun (X Y : hlist (l :: ls)) => + equiv_hlist (Hcons x h1) Y + end X Y + with + | hlist_eqv_nil => I + | hlist_eqv_cons l ls x y h1 h2 pf pf' => + _ + end). + Abort. +End hlist. diff --git a/test-suite/bugs/closed/3264.v b/test-suite/bugs/closed/bug_3264.v index 4eb218906f..4eb218906f 100644 --- a/test-suite/bugs/closed/3264.v +++ b/test-suite/bugs/closed/bug_3264.v diff --git a/test-suite/bugs/closed/3265.v b/test-suite/bugs/closed/bug_3265.v index 269c7b741e..269c7b741e 100644 --- a/test-suite/bugs/closed/3265.v +++ b/test-suite/bugs/closed/bug_3265.v diff --git a/test-suite/bugs/closed/3266.v b/test-suite/bugs/closed/bug_3266.v index fd4cbff85c..fd4cbff85c 100644 --- a/test-suite/bugs/closed/3266.v +++ b/test-suite/bugs/closed/bug_3266.v diff --git a/test-suite/bugs/closed/3267.v b/test-suite/bugs/closed/bug_3267.v index 8175d66ac7..8175d66ac7 100644 --- a/test-suite/bugs/closed/3267.v +++ b/test-suite/bugs/closed/bug_3267.v diff --git a/test-suite/bugs/closed/3281.v b/test-suite/bugs/closed/bug_3281.v index d340f0ca48..d340f0ca48 100644 --- a/test-suite/bugs/closed/3281.v +++ b/test-suite/bugs/closed/bug_3281.v diff --git a/test-suite/bugs/closed/3282.v b/test-suite/bugs/closed/bug_3282.v index ce7cab1cba..ce7cab1cba 100644 --- a/test-suite/bugs/closed/3282.v +++ b/test-suite/bugs/closed/bug_3282.v diff --git a/test-suite/bugs/closed/bug_3284.v b/test-suite/bugs/closed/bug_3284.v new file mode 100644 index 0000000000..854889e61e --- /dev/null +++ b/test-suite/bugs/closed/bug_3284.v @@ -0,0 +1,24 @@ +(* Several bugs: +- wrong env in pose_all_metas_as_evars leading to out of scope instance of evar +- check that metas posed as evars in pose_all_metas_as_evars were + resolved was not done +*) + +Axiom functional_extensionality_dep : + forall {A : Type} {B : A -> Type} (f g : forall x : A, B x), + (forall x : A, f x = g x) -> f = g. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g x H. + Fail apply @functional_extensionality_dep in H. + Fail apply functional_extensionality_dep in H. + eapply functional_extensionality_dep in H. +Abort. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), forall x:A, (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g x H. + specialize (H x). + apply functional_extensionality_dep in H. +Abort. diff --git a/test-suite/bugs/closed/3285.v b/test-suite/bugs/closed/bug_3285.v index 68e6b7386f..68e6b7386f 100644 --- a/test-suite/bugs/closed/3285.v +++ b/test-suite/bugs/closed/bug_3285.v diff --git a/test-suite/bugs/closed/bug_3286.v b/test-suite/bugs/closed/bug_3286.v new file mode 100644 index 0000000000..360a304a47 --- /dev/null +++ b/test-suite/bugs/closed/bug_3286.v @@ -0,0 +1,42 @@ +Require Import FunctionalExtensionality. + +Ltac make_apply_under_binders_in lem H := + let tac := make_apply_under_binders_in in + match type of H with + | forall x : ?T, @?P x + => let ret := constr:(fun x' : T => + let Hx := H x' in + ltac:(let ret' := tac lem Hx in + exact ret')) in + match eval cbv zeta in ret with + | fun x => Some (@?P x) => let P' := (eval cbv zeta in P) in + constr:(Some P') + end + | _ => let ret := constr:(ltac:(match goal with + | _ => (let H' := fresh in + pose H as H'; + apply lem in H'; + exact (Some H')) + | _ => exact (@None nat) + end + )) in + let ret' := (eval cbv beta zeta in ret) in + constr:(ret') + | _ => constr:(@None nat) + end. + +Ltac apply_under_binders_in lem H := + let H' := make_apply_under_binders_in lem H in + let H'0 := match H' with Some ?H'0 => constr:(H'0) end in + let H'' := fresh in + pose proof H'0 as H''; + clear H; + rename H'' into H. + +Goal forall A B C (f g : forall (x : A) (y : B x), C x y), (forall x y, f x y = g x y) -> True. +Proof. + intros A B C f g H. + let lem := constr:(@functional_extensionality_dep) in + apply_under_binders_in lem H. +(* Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/3287.v b/test-suite/bugs/closed/bug_3287.v index 4b3e7ff054..4b3e7ff054 100644 --- a/test-suite/bugs/closed/3287.v +++ b/test-suite/bugs/closed/bug_3287.v diff --git a/test-suite/bugs/closed/3289.v b/test-suite/bugs/closed/bug_3289.v index 4542b015d0..4542b015d0 100644 --- a/test-suite/bugs/closed/3289.v +++ b/test-suite/bugs/closed/bug_3289.v diff --git a/test-suite/bugs/closed/bug_3291.v b/test-suite/bugs/closed/bug_3291.v new file mode 100644 index 0000000000..19586abbfe --- /dev/null +++ b/test-suite/bugs/closed/bug_3291.v @@ -0,0 +1,10 @@ +Require Import Setoid. + +Definition segv : forall x, (x = 0%nat) -> (forall (y : nat), (y < x)%nat -> nat) = forall (y : nat), (y < 0)%nat -> nat. +intros x eq. +assert (H : forall y, (y < x)%nat = (y < 0)%nat). +rewrite -> eq. auto. +Set Typeclasses Debug. +Fail setoid_rewrite <- H. (* The command has indeed failed with message: +=> Stack overflow. *) +Abort. diff --git a/test-suite/bugs/closed/3294.v b/test-suite/bugs/closed/bug_3294.v index ed1a0c29ae..ed1a0c29ae 100644 --- a/test-suite/bugs/closed/3294.v +++ b/test-suite/bugs/closed/bug_3294.v diff --git a/test-suite/bugs/closed/bug_3297.v b/test-suite/bugs/closed/bug_3297.v new file mode 100644 index 0000000000..da8390c475 --- /dev/null +++ b/test-suite/bugs/closed/bug_3297.v @@ -0,0 +1,13 @@ +Goal forall (n : nat) (H := eq_refl : n = n) (H' : n = 0), H = eq_refl. + intros. + subst. (* Toplevel input, characters 15-20: +Error: Abstracting over the term "n" leads to a term +"λ n : nat, H = eq_refl" which is ill-typed. *) + Undo. + revert H. + subst. (* success *) + Undo. + intro. + clearbody H. + subst. (* success *) +Abort. diff --git a/test-suite/bugs/closed/3298.v b/test-suite/bugs/closed/bug_3298.v index f07ee1e6cf..f07ee1e6cf 100644 --- a/test-suite/bugs/closed/3298.v +++ b/test-suite/bugs/closed/bug_3298.v diff --git a/test-suite/bugs/closed/3300.v b/test-suite/bugs/closed/bug_3300.v index a28144b9ca..a28144b9ca 100644 --- a/test-suite/bugs/closed/3300.v +++ b/test-suite/bugs/closed/bug_3300.v diff --git a/test-suite/bugs/closed/3305.v b/test-suite/bugs/closed/bug_3305.v index f3f2195228..f3f2195228 100644 --- a/test-suite/bugs/closed/3305.v +++ b/test-suite/bugs/closed/bug_3305.v diff --git a/test-suite/bugs/closed/bug_3306.v b/test-suite/bugs/closed/bug_3306.v new file mode 100644 index 0000000000..ae78a8e714 --- /dev/null +++ b/test-suite/bugs/closed/bug_3306.v @@ -0,0 +1,12 @@ + +Inductive Foo(A : Type) : Prop := + foo: A -> Foo A. + +Arguments foo [A] _. + +Scheme Foo_elim := Induction for Foo Sort Prop. + +Goal forall (fn : Foo nat), { x: nat | foo x = fn }. +intro fn. +Fail induction fn as [n] using Foo_elim. (* should fail in a non-Prop context *) +Admitted. diff --git a/test-suite/bugs/closed/bug_3310.v b/test-suite/bugs/closed/bug_3310.v new file mode 100644 index 0000000000..339280b2f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3310.v @@ -0,0 +1,12 @@ +Set Primitive Projections. +Set Implicit Arguments. + +CoInductive stream A := cons { hd : A; tl : stream A }. + +CoFixpoint id {A} (s : stream A) := cons (hd s) (id (tl s)). + +Lemma id_spec : forall A (s : stream A), id s = s. +Proof. +intros A s. +Fail change (id s) with (cons (hd (id s)) (tl (id s))). +Abort. diff --git a/test-suite/bugs/closed/3314.v b/test-suite/bugs/closed/bug_3314.v index a5782298c3..a5782298c3 100644 --- a/test-suite/bugs/closed/3314.v +++ b/test-suite/bugs/closed/bug_3314.v diff --git a/test-suite/bugs/closed/3315.v b/test-suite/bugs/closed/bug_3315.v index b69097f921..b69097f921 100644 --- a/test-suite/bugs/closed/3315.v +++ b/test-suite/bugs/closed/bug_3315.v diff --git a/test-suite/bugs/closed/bug_3317.v b/test-suite/bugs/closed/bug_3317.v new file mode 100644 index 0000000000..7419916645 --- /dev/null +++ b/test-suite/bugs/closed/bug_3317.v @@ -0,0 +1,94 @@ +Set Implicit Arguments. +Module A. + Set Universe Polymorphism. + Set Primitive Projections. + Set Asymmetric Patterns. + Inductive paths {A} (x : A) : A -> Type := idpath : paths x x + where "x = y" := (@paths _ x y) : type_scope. + Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. + Arguments existT {A} _ _ _. + Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + Notation "x .1" := (projT1 x) (at level 3). + Notation "x .2" := (projT2 x) (at level 3). + Notation "( x ; y )" := (existT _ x y). + Set Printing All. + Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) + : u = v + := match pq with + | existT p q => + match u, v return (forall p0 : (u.1 = v.1), (transport P p0 u.2 = v.2) -> (u=v)) with + | (x;y), (x';y') => fun p1 (q1 : transport P p1 (existT P x y).2 = (existT P x' y').2) => + match p1 in (_ = x'') return (forall y'', (transport _ p1 y = y'') -> (x;y)=(x'';y'')) with + | idpath => fun y' (q2 : transport _ (@idpath _ _) y = y') => + match q2 in (_ = y'') return (x;y) = (x;y'') with + | idpath => @idpath _ _ + end + end y' q1 + end p q + end. + (* Toplevel input, characters 341-357: +Error: +In environment +A : Type +P : forall _ : A, Type +u : @sigT A P +v : @sigT A P +pq : +@sigT (@paths A (projT1 u) (projT1 v)) + (fun p : @paths A (projT1 u) (projT1 v) => + @paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) + (projT2 v)) +p : @paths A (projT1 u) (projT1 v) +q : +@paths (P (projT1 v)) (@transport A P (projT1 u) (projT1 v) p (projT2 u)) + (projT2 v) +x : A +y : P x +x' : A +y' : P x' +p1 : @paths A (projT1 (@existT A P x y)) (projT1 (@existT A P x' y')) +The term "projT2 (@existT A P x y)" has type "P (projT1 (@existT A P x y))" +while it is expected to have type "P (projT1 (@existT A P x y))". + *) +End A. + +Module B. + Set Universe Polymorphism. + Set Primitive Projections. + Set Asymmetric Patterns. + Inductive paths {A} (x : A) : A -> Type := idpath : paths x x + where "x = y" := (@paths _ x y) : type_scope. + Record sigT {A : Type} (P : A -> Type) := existT { projT1 : A; projT2 : P projT1 }. + Arguments existT {A} _ _ _. + Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + Notation "x .1" := (projT1 x) (at level 3). + Notation "x .2" := (projT2 x) (at level 3). + Notation "( x ; y )" := (existT _ x y). + Set Printing All. + + Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : sigT (fun p : u.1 = v.1 => transport _ p u.2 = v.2)) + : u = v. + Proof. + destruct u as [x y]. + destruct v. (* Toplevel input, characters 0-11: +Error: Illegal application: +The term "transport" of type + "forall (A : Type) (P : forall _ : A, Type) (x y : A) + (_ : @paths A x y) (_ : P x), P y" +cannot be applied to the terms + "A" : "Type" + "P" : "forall _ : A, Type" + "projT1 (@existT A P x y)" : "A" + "projT1 v" : "A" + "p" : "@paths A (projT1 (@existT A P x y)) (projT1 v)" + "projT2 (@existT A P x y)" : "P (projT1 (@existT A P x y))" +The 5th term has type "@paths A (projT1 (@existT A P x y)) (projT1 v)" +which should be coercible to + "@paths A (projT1 (@existT A P x y)) (projT1 v)". + *) + Abort. +End B. diff --git a/test-suite/bugs/closed/bug_3319.v b/test-suite/bugs/closed/bug_3319.v new file mode 100644 index 0000000000..9a9eac26c4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3319.v @@ -0,0 +1,27 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5353 lines to 4545 lines, then from 4513 lines to 4504 lines, then from 4515 lines to 4508 lines, then from 4519 lines to 132 lines, then from 111 lines to 66 lines, then from 68 lines to 35 lines *) +Set Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a + where "x = y" := (@paths _ x y) : type_scope. + +Record PreCategory := { obj :> Type; morphism : obj -> obj -> Type }. +Record NotionOfStructure (X : PreCategory) := + { structure :> X -> Type; + is_structure_homomorphism + : forall x y (f : morphism X x y) (a : structure x) (b : structure y), Type }. + +Section precategory. + Variable X : PreCategory. + Variable P : NotionOfStructure X. + Local Notation object := { x : X & P x }. + Record morphism' (xa yb : object) := {}. + + Lemma issig_morphism xa yb + : { f : morphism X (projT1 xa) (projT1 yb) + & is_structure_homomorphism _ _ _ f (projT2 xa) (projT2 yb) } + = morphism' xa yb. + Proof. + admit. + Defined. +End precategory. diff --git a/test-suite/bugs/closed/bug_3320.v b/test-suite/bugs/closed/bug_3320.v new file mode 100644 index 0000000000..200c63b15c --- /dev/null +++ b/test-suite/bugs/closed/bug_3320.v @@ -0,0 +1,6 @@ +Goal forall x : nat, True. + fix goal 1. + assumption. +Fail Qed. +Undo. +Abort. diff --git a/test-suite/bugs/closed/bug_3321.v b/test-suite/bugs/closed/bug_3321.v new file mode 100644 index 0000000000..0718cd1257 --- /dev/null +++ b/test-suite/bugs/closed/bug_3321.v @@ -0,0 +1,20 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 103 lines to 83 lines, then from 86 lines to 36 lines, then from 37 lines to 17 lines *) + +Axiom admit : forall {T}, T. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. +Definition equiv_path (A B : Type) (p : A = B) : Equiv A B := admit. +Class Univalence := { isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) }. +Definition path_universe `{Univalence} {A B : Type} (f : A -> B) {feq : IsEquiv f} : (A = B) := admit. +Context `{ua:Univalence}. +Variable A:Type. +Goal forall (I : Type) (f : I -> A), + {p : I = {a : A & @hfiber I A f a} & True }. +intros. +clear. +try exists (path_universe admit). (* Toplevel input, characters 15-44: +Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3322.v b/test-suite/bugs/closed/bug_3322.v new file mode 100644 index 0000000000..eb391042dd --- /dev/null +++ b/test-suite/bugs/closed/bug_3322.v @@ -0,0 +1,26 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 11971 lines to 11753 lines, then from 7702 lines to 564 lines, then from 571 lines to 61 lines *) +Set Asymmetric Patterns. +Axiom admit : forall {T}, T. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : {p : (projT1 u) = (projT1 v) & transport _ p (projT2 u) = (projT2 v)}) +: u = v. +Proof. + destruct pq as [p q], u as [x y], v as [x' y']; simpl in *. + destruct p, q; simpl; reflexivity. +Defined. +Arguments path_sigma_uncurried : simpl never. +Section opposite. + Let opposite_functor_involutive_helper + := @path_sigma_uncurried admit admit (existT _ admit admit) admit (existT _ admit admit). + + Goal True. + Opaque path_sigma_uncurried. + simpl in *. + Transparent path_sigma_uncurried. + (* This command should fail with "Error: Failed to progress.", as it does in 8.4; the simpl never directive should prevent simpl from progressing *) + Fail progress simpl in *. + Abort. +End opposite. diff --git a/test-suite/bugs/closed/bug_3323.v b/test-suite/bugs/closed/bug_3323.v new file mode 100644 index 0000000000..e81af07241 --- /dev/null +++ b/test-suite/bugs/closed/bug_3323.v @@ -0,0 +1,79 @@ +Require Import TestSuite.admit. +(* -*- coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 5302 lines to 4649 lines, then from 4660 lines to 355 lines, then from 360 lines to 269 lines, then from 269 lines to 175 lines, then from 144 lines to 119 lines, then from 297 lines to 117 lines, then from 95 lines to 79 lines, then from 82 lines to 68 lines *) + +Set Universe Polymorphism. +Generalizable All Variables. +Inductive sigT {A:Type} (P:A -> Type) : Type := existT : forall x:A, P x -> sigT P. +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Definition projT1 {A} {P : A -> Type} (x : sigT P) : A := let (a, _) := x in a. +Definition projT2 {A} {P : A -> Type} (x : sigT P) : P (projT1 x) := let (a, h) return P (projT1 x) := x in h. +Axiom admit : forall {T}, T. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }. +Record Equiv A B := BuildEquiv { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Existing Instance equiv_isequiv. +Global Instance isequiv_inverse `{IsEquiv A B f} : IsEquiv (@equiv_inv _ _ f _) | 10000 := admit. +Definition equiv_path_sigma `(P : A -> Type) (u v : sigT P) +: Equiv {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v} (u = v) := admit. +Definition hfiber {A B : Type} (f : A -> B) (y : B) := { x : A & f x = y }. +Definition path_universe {A B : Type} (f : A -> B) : (A = B) := admit. +Section AssumeFunext. + Let equiv_fibration_replacement_eissect {B C f} + : forall x : {y : B & {x : C & f x = y}}, + existT _ (f (projT1 (projT2 x))) (existT _ (projT1 (projT2 x)) idpath) = x. + admit. + Defined. + Definition equiv_fibration_replacement {B C} (f:C ->B): + Equiv C {y:B & {x:C & f x = y}}. + Proof. + refine (BuildEquiv + _ _ _ + (BuildIsEquiv + C {y:B & {x:C & f x = y}} + (fun c => existT _ (f c) (existT _ c idpath)) + (fun c => projT1 (projT2 c)) + equiv_fibration_replacement_eissect)). + Defined. + Definition equiv_total_paths (A : Type) (P : A-> Type) (x y : sigT P) : + Equiv (x = y) { p : projT1 x = projT1 y & transport P p (projT2 x) = (projT2 y) } + := BuildEquiv _ _ (@equiv_inv _ _ _ (equiv_path_sigma P x y)) _. + Variable A:Type. + Definition Fam A:=sigT (fun I:Type => I->A). + Definition p2f: (A->Type)-> Fam A := fun Q:(A->Type) => existT _ (sigT Q) (@projT1 _ _). + Definition f2p: Fam A -> (A->Type) := fun F => let (I, f) := F in (fun a => (hfiber f a)). + Definition exp {U V:Type}(w:Equiv U V):Equiv (U->A) (V->A). + exists (fun f:(U->A)=> (fun x => (f (@equiv_inv _ _ w _ x)))). + admit. + Defined. + Goal { h : Fam A -> A -> Type & Sect h p2f }. + exists f2p. + intros [I f]. + set (e:=@equiv_total_paths _ _ (@existT Type (fun I0 : Type => I0 -> A) I f) + (existT _ {a : A & hfiber f a} (@projT1 _ _))). + simpl in e. + cut ( {p : I = {a : A & @hfiber I A f a} & + @transport _ (fun I0 : Type => I0 -> A) _ _ p f = @projT1 _ _}). + { intro X. + apply (inverse (@equiv_inv _ _ _ e X)). } + set (w:=@equiv_fibration_replacement A I f). + exists (path_universe w). + assert (forall x, (exp w) f x = projT1 x); [ | admit ]. + intros [a [i p]]. + exact p. + Qed. +(* Toplevel input, characters 15-19: +Error: In pattern-matching on term "x" the branch for constructor +"existT(*Top.256 Top.258*)" has type + "forall (I : Type) (f : I -> A), + existT (fun I0 : Type => I0 -> A) {a : A & hfiber f a} projT1 = + existT (fun I0 : Type => I0 -> A) I f" which should be + "forall (x : Type) (H : x -> A), + p2f (f2p (existT (fun I : Type => I -> A) x H)) = + existT (fun I : Type => I -> A) x H". + *) +End AssumeFunext. diff --git a/test-suite/bugs/closed/3324.v b/test-suite/bugs/closed/bug_3324.v index 45dbb57aa2..45dbb57aa2 100644 --- a/test-suite/bugs/closed/3324.v +++ b/test-suite/bugs/closed/bug_3324.v diff --git a/test-suite/bugs/closed/3325.v b/test-suite/bugs/closed/bug_3325.v index 36c065ebe8..36c065ebe8 100644 --- a/test-suite/bugs/closed/3325.v +++ b/test-suite/bugs/closed/bug_3325.v diff --git a/test-suite/bugs/closed/bug_3326.v b/test-suite/bugs/closed/bug_3326.v new file mode 100644 index 0000000000..1c12685353 --- /dev/null +++ b/test-suite/bugs/closed/bug_3326.v @@ -0,0 +1,20 @@ +Class ORDER A := Order { + LEQ : A -> A -> bool; + leqRefl: forall x, true = LEQ x x +}. + +Section XXX. + +Variable A:Type. +Variable (O:ORDER A). +Definition aLeqRefl := @leqRefl _ O. + +Lemma OK : forall x, true = LEQ x x. +Proof. + intros. + unfold LEQ. + destruct O. + clear. + Fail apply aLeqRefl. +Abort. +End XXX. diff --git a/test-suite/bugs/closed/3329.v b/test-suite/bugs/closed/bug_3329.v index ecb09e8436..ecb09e8436 100644 --- a/test-suite/bugs/closed/3329.v +++ b/test-suite/bugs/closed/bug_3329.v diff --git a/test-suite/bugs/closed/bug_3330.v b/test-suite/bugs/closed/bug_3330.v new file mode 100644 index 0000000000..ae55ba59f6 --- /dev/null +++ b/test-suite/bugs/closed/bug_3330.v @@ -0,0 +1,1115 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 12106 lines to 1070 lines *) +Set Universe Polymorphism. +Definition setleq (A : Type@{i}) (B : Type@{j}) := A : Type@{j}. + +Inductive foo : Type@{l} := bar : foo . +Section MakeEq. + Variables (a : foo@{i}) (b : foo@{j}). + + Let t := ltac:(let ty := type of b in exact ty). + Definition make_eq (x:=b) := a : t. +End MakeEq. + +Definition same (x : foo@{i}) (y : foo@{i}) := x. + +Section foo. + + Variables x : foo@{i}. + Variables y : foo@{j}. + + Let AleqB := let foo := make_eq x y in (Type * Type)%type. + + Definition baz := same x y. +End foo. + +Definition baz' := Eval unfold baz in baz@{i j k l}. + +Module Export HoTT_DOT_Overture. +Module Export HoTT. +Module Export Overture. + +Definition relation (A : Type) := A -> A -> Type. +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := + fun x => g (f x). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. + +Open Scope function_scope. + +Set Printing Universes. Set Printing All. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. + +Notation "x = y" := (x = y :>_) : type_scope. + +Delimit Scope path_scope with path. + +Local Open Scope path_scope. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p q) (at level 20) : path_scope. + +Notation "p ^" := (inverse p) (at level 3) : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) : Type + := forall x:A, f x = g x. + +Hint Unfold pointwise_paths : typeclass_instances. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) + : f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Delimit Scope equiv_scope with equiv. + +Local Open Scope equiv_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint nat_to_trunc_index (n : nat) : trunc_index + := match n with + | 0 => trunc_S (trunc_S minus_two) + | S n' => trunc_S (nat_to_trunc_index n') + end. + +Coercion nat_to_trunc_index : nat >-> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation IsHSet := (IsTrunc 0). + +Class Funext := + { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. + +Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : + f == g -> f = g + := + (@apD10 A P f g)^-1. + +End Overture. + +End HoTT. + +End HoTT_DOT_Overture. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. + +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Set Printing Universes. +Set Printing All. +Record PreCategory := + Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + + identity_identity : forall x, identity x o identity x = identity x; + + trunc_morphism : forall s d, IsHSet (morphism s d) + }. + +Bind Scope category_scope with PreCategory. + +Arguments identity [!C%category] x%object : rename. +Arguments compose [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. + +Definition Build_PreCategory + object morphism compose identity + associativity left_identity right_identity + := @Build_PreCategory' + object + morphism + compose + identity + associativity + (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) + left_identity + right_identity + (fun _ => left_identity _ _ _). + +Existing Instance trunc_morphism. + +Hint Resolve @left_identity @right_identity @associativity : category morphism. + +Module Export CategoryCoreNotations. + + Infix "o" := compose : morphism_scope. +End CategoryCoreNotations. +End Core. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Core. + +Module Export HoTT_DOT_types_DOT_Forall. + +Module Export HoTT. +Module Export types. +Module Export Forall. +Generalizable Variables A B f g e n. + +Section AssumeFunext. + +Global Instance trunc_forall `{P : A -> Type} `{forall a, IsTrunc n (P a)} + : IsTrunc n (forall a, P a) | 100. + +admit. +Defined. +End AssumeFunext. + +End Forall. + +End types. + +End HoTT. + +End HoTT_DOT_types_DOT_Forall. + +Module Export HoTT_DOT_types_DOT_Prod. + +Module Export HoTT. +Module Export types. +Module Export Prod. +Local Open Scope path_scope. + +Definition path_prod_uncurried {A B : Type} (z z' : A * B) + (pq : (fst z = fst z') * (snd z = snd z')) + : (z = z') + := match pq with (p,q) => + match z, z' return + (fst z = fst z') -> (snd z = snd z') -> (z = z') with + | (a,b), (a',b') => fun p q => + match p, q with + idpath, idpath => 1 + end + end p q + end. + +Definition path_prod {A B : Type} (z z' : A * B) : + (fst z = fst z') -> (snd z = snd z') -> (z = z') + := fun p q => path_prod_uncurried z z' (p,q). + +Definition path_prod' {A B : Type} {x x' : A} {y y' : B} + : (x = x') -> (y = y') -> ((x,y) = (x',y')) + := fun p q => path_prod (x,y) (x',y') p q. + +End Prod. + +End types. + +End HoTT. + +End HoTT_DOT_types_DOT_Prod. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Delimit Scope functor_scope with functor. + +Local Open Scope morphism_scope. + +Section Functor. + + Variable C : PreCategory. + Variable D : PreCategory. + + Record Functor := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. + +End Functor. +Bind Scope functor_scope with Functor. + +Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Module Export FunctorCoreNotations. + + Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +End FunctorCoreNotations. +End Core. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Morphisms. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Morphisms. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + +Class Isomorphic {C : PreCategory} s d := + { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic + }. + +Module Export CategoryMorphismsNotations. + + Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. + +End CategoryMorphismsNotations. +End Morphisms. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Morphisms. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Dual. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section opposite. + + Definition opposite (C : PreCategory) : PreCategory + := @Build_PreCategory' + C + (fun s d => morphism C d s) + (identity (C := C)) + (fun _ _ _ m1 m2 => m2 o m1) + (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _) + (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _) + (fun _ _ => @right_identity _ _ _) + (fun _ _ => @left_identity _ _ _) + (@identity_identity C) + _. +End opposite. + +Module Export CategoryDualNotations. + + Notation "C ^op" := (opposite C) (at level 3) : category_scope. +End CategoryDualNotations. +End Dual. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Composition. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section composition. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable E : PreCategory. + Variable G : Functor D E. + Variable F : Functor C D. + + Local Notation c_object_of c := (G (F c)) (only parsing). + + Local Notation c_morphism_of m := (morphism_of G (morphism_of F m)) (only parsing). + + Let compose_composition_of' s d d' + (m1 : morphism C s d) (m2 : morphism C d d') + : c_morphism_of (m2 o m1) = c_morphism_of m2 o c_morphism_of m1. +admit. +Defined. + Definition compose_composition_of s d d' m1 m2 + := Eval cbv beta iota zeta delta + [compose_composition_of'] in + @compose_composition_of' s d d' m1 m2. + Let compose_identity_of' x + : c_morphism_of (identity x) = identity (c_object_of x). + +admit. +Defined. + Definition compose_identity_of x + := Eval cbv beta iota zeta delta + [compose_identity_of'] in + @compose_identity_of' x. + Definition compose : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)) + compose_composition_of + compose_identity_of. + +End composition. +Module Export FunctorCompositionCoreNotations. + + Infix "o" := compose : functor_scope. +End FunctorCompositionCoreNotations. +End Core. + +End Composition. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Composition_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Dual. +Set Universe Polymorphism. + +Set Implicit Arguments. + +Section opposite. + + Variable C : PreCategory. + Variable D : PreCategory. + Definition opposite (F : Functor C D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). + +End opposite. +Module Export FunctorDualNotations. + + Notation "F ^op" := (opposite F) : functor_scope. +End FunctorDualNotations. +End Dual. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Functor_DOT_Identity. + +Module Export HoTT. +Module Export categories. +Module Export Functor. +Module Export Identity. +Set Universe Polymorphism. + +Section identity. + + Definition identity C : Functor C C + := Build_Functor C C + (fun x => x) + (fun _ _ x => x) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). +End identity. +Module Export FunctorIdentityNotations. + + Notation "1" := (identity _) : functor_scope. +End FunctorIdentityNotations. +End Identity. + +End Functor. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Functor_DOT_Identity. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. + +Module Export HoTT. +Module Export categories. +Module Export NaturalTransformation. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section NaturalTransformation. + + Variable C : PreCategory. + Variable D : PreCategory. + Variables F G : Functor C D. + + Record NaturalTransformation := + Build_NaturalTransformation' { + components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), + components_of d o F _1 m = G _1 m o components_of s; + + commutes_sym : forall s d (m : C.(morphism) s d), + G _1 m o components_of s = components_of d o F _1 m + }. + +End NaturalTransformation. +End Core. + +End NaturalTransformation. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Core. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. + +Module Export HoTT. +Module Export categories. +Module Export NaturalTransformation. +Module Export Dual. +Set Universe Polymorphism. + +Section opposite. + + Variable C : PreCategory. + Variable D : PreCategory. + + Definition opposite + (F G : Functor C D) + (T : NaturalTransformation F G) + : NaturalTransformation G^op F^op + := Build_NaturalTransformation' (G^op) (F^op) + (components_of T) + (fun s d => commutes_sym T d s) + (fun s d => commutes T d s). + +End opposite. + +End Dual. + +End NaturalTransformation. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Dual. + +Module Export HoTT_DOT_categories_DOT_Category_DOT_Strict. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Strict. + +Export Category.Core. +Set Universe Polymorphism. + +End Strict. + +End Category. + +End categories. + +End HoTT. + +End HoTT_DOT_categories_DOT_Category_DOT_Strict. + +Module Export HoTT. +Module Export categories. +Module Export Category. +Module Export Prod. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section prod. + + Variable C : PreCategory. + Variable D : PreCategory. + Definition prod : PreCategory. + + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) + _ + _ + _ + _); admit. + Defined. +End prod. +Module Export CategoryProdNotations. + + Infix "*" := prod : category_scope. +End CategoryProdNotations. +End Prod. + +End Category. + +End categories. + +End HoTT. + +Module Functor. +Module Export Prod. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Section proj. + + Context {C : PreCategory}. + Context {D : PreCategory}. + Definition fst : Functor (C * D) C + := Build_Functor (C * D) C + (@fst _ _) + (fun _ _ => @fst _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + + Definition snd : Functor (C * D) D + := Build_Functor (C * D) D + (@snd _ _) + (fun _ _ => @snd _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + +End proj. + +Section prod. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable D' : PreCategory. + Definition prod (F : Functor C D) (F' : Functor C D') + : Functor C (D * D') + := Build_Functor + C (D * D') + (fun c => (F c, F' c)) + (fun s d m => (F _1 m, F' _1 m)) + (fun _ _ _ _ _ => path_prod' (composition_of F _ _ _ _ _) + (composition_of F' _ _ _ _ _)) + (fun _ => path_prod' (identity_of F _) (identity_of F' _)). + +End prod. +Local Infix "*" := prod : functor_scope. + +Section pair. + + Variable C : PreCategory. + Variable D : PreCategory. + Variable C' : PreCategory. + Variable D' : PreCategory. + Variable F : Functor C D. + Variable F' : Functor C' D'. + Definition pair : Functor (C * C') (D * D') + := (F o fst) * (F' o snd). + +End pair. + +Module Export FunctorProdNotations. + + Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : functor_scope. +End FunctorProdNotations. +End Prod. + +End Functor. + +Module Export HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. + +Module Export HoTT. +Module categories. +Module Export NaturalTransformation. +Module Export Composition. +Module Export Core. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope path_scope. + +Local Open Scope morphism_scope. + +Section composition. + + Section compose. + Variable C : PreCategory. + Variable D : PreCategory. + Variables F F' F'' : Functor C D. + Variable T' : NaturalTransformation F' F''. + + Variable T : NaturalTransformation F F'. + Local Notation CO c := (T' c o T c). + + Definition compose_commutes s d (m : morphism C s d) + : CO d o morphism_of F m = morphism_of F'' m o CO s + := (associativity _ _ _ _ _ _ _ _) + @ ap (fun x => _ o x) (commutes T _ _ m) + @ (associativity_sym _ _ _ _ _ _ _ _) + @ ap (fun x => x o _) (commutes T' _ _ m) + @ (associativity _ _ _ _ _ _ _ _). + + Definition compose_commutes_sym s d (m : morphism C s d) + : morphism_of F'' m o CO s = CO d o morphism_of F m + := (associativity_sym _ _ _ _ _ _ _ _) + @ ap (fun x => x o _) (commutes_sym T' _ _ m) + @ (associativity _ _ _ _ _ _ _ _) + @ ap (fun x => _ o x) (commutes_sym T _ _ m) + @ (associativity_sym _ _ _ _ _ _ _ _). + + Definition compose + : NaturalTransformation F F'' + := Build_NaturalTransformation' F F'' + (fun c => CO c) + compose_commutes + compose_commutes_sym. + + End compose. + End composition. +Module Export NaturalTransformationCompositionCoreNotations. + + Infix "o" := compose : natural_transformation_scope. +End NaturalTransformationCompositionCoreNotations. +End Core. + +End Composition. + +End NaturalTransformation. + +End categories. + +Set Universe Polymorphism. + +Section path_natural_transformation. + + Context `{Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + Variables F G : Functor C D. + + Global Instance trunc_natural_transformation + : IsHSet (NaturalTransformation F G). + +admit. +Defined. + Section path. + + Variables T U : NaturalTransformation F G. + + Lemma path'_natural_transformation + : components_of T = components_of U + -> T = U. + +admit. +Defined. + Lemma path_natural_transformation + : components_of T == components_of U + -> T = U. + + Proof. + intros. + apply path'_natural_transformation. + apply path_forall; assumption. + Qed. + End path. +End path_natural_transformation. + +Ltac path_natural_transformation := + repeat match goal with + | _ => intro + | _ => apply path_natural_transformation; simpl + end. + +Module Export Identity. +Set Universe Polymorphism. + +Set Implicit Arguments. +Local Open Scope morphism_scope. + +Local Open Scope path_scope. +Section identity. + + Variable C : PreCategory. + Variable D : PreCategory. + + Section generalized. + + Variables F G : Functor C D. + Hypothesis HO : object_of F = object_of G. + Hypothesis HM : transport (fun GO => forall s d, + morphism C s d + -> morphism D (GO s) (GO d)) + HO + (morphism_of F) + = morphism_of G. + Local Notation CO c := (transport (fun GO => morphism D (F c) (GO c)) + HO + (identity (F c))). + + Definition generalized_identity_commutes s d (m : morphism C s d) + : CO d o morphism_of F m = morphism_of G m o CO s. + + Proof. + case HM. +case HO. + exact (left_identity _ _ _ _ @ (right_identity _ _ _ _)^). + Defined. + Definition generalized_identity_commutes_sym s d (m : morphism C s d) + : morphism_of G m o CO s = CO d o morphism_of F m. + +admit. +Defined. + Definition generalized_identity + : NaturalTransformation F G + := Build_NaturalTransformation' + F G + (fun c => CO c) + generalized_identity_commutes + generalized_identity_commutes_sym. + + End generalized. + Definition identity (F : Functor C D) + : NaturalTransformation F F + := Eval simpl in @generalized_identity F F 1 1. + +End identity. +Module Export NaturalTransformationIdentityNotations. + + Notation "1" := (identity _) : natural_transformation_scope. +End NaturalTransformationIdentityNotations. +End Identity. + +Module Export Laws. +Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. +Set Universe Polymorphism. + +Local Open Scope natural_transformation_scope. +Section natural_transformation_identity. + + Context `{fs : Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + + Lemma left_identity (F F' : Functor C D) + (T : NaturalTransformation F F') + : 1 o T = T. + + Proof. + path_natural_transformation; auto with morphism. + Qed. + + Lemma right_identity (F F' : Functor C D) + (T : NaturalTransformation F F') + : T o 1 = T. + + Proof. + path_natural_transformation; auto with morphism. + Qed. +End natural_transformation_identity. +Section associativity. + + Section nt. + + Context `{fs : Funext}. + Definition associativity + C D F G H I + (V : @NaturalTransformation C D F G) + (U : @NaturalTransformation C D G H) + (T : @NaturalTransformation C D H I) + : (T o U) o V = T o (U o V). + + Proof. + path_natural_transformation. + apply associativity. + Qed. + End nt. +End associativity. +End Laws. + +Module Export FunctorCategory. +Module Export Core. +Import HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core.HoTT.categories. +Set Universe Polymorphism. + +Section functor_category. + + Context `{Funext}. + Variable C : PreCategory. + + Variable D : PreCategory. + + Definition functor_category : PreCategory + := @Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + (@identity C D) + (@compose C D) + (@associativity _ C D) + (@left_identity _ C D) + (@right_identity _ C D) + _. + +End functor_category. +Module Export FunctorCategoryCoreNotations. + + Notation "C -> D" := (functor_category C D) : category_scope. +End FunctorCategoryCoreNotations. +End Core. + +End FunctorCategory. + +Module Export Morphisms. +Set Universe Polymorphism. + +Set Implicit Arguments. + +Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := + @Isomorphic (C -> D) F G. + +Module Export FunctorCategoryMorphismsNotations. + + Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. +End FunctorCategoryMorphismsNotations. +End Morphisms. + +Module Export HSet. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. + +Global Existing Instance iss. +End HSet. + +Module Export Core. +Set Universe Polymorphism. + +Notation cat_of obj := + (@Build_PreCategory obj + (fun x y => x -> y) + (fun _ x => x) + (fun _ _ _ f g => f o g)%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + _). + +Definition set_cat `{Funext} : PreCategory := cat_of hSet. +Set Universe Polymorphism. + +Local Open Scope morphism_scope. + +Section hom_functor. + + Context `{Funext}. + Variable C : PreCategory. + Local Notation obj_of c'c := + (BuildhSet + (morphism + C + (fst (c'c : object (C^op * C))) + (snd (c'c : object (C^op * C)))) + _). + + Let hom_functor_morphism_of s's d'd (hf : morphism (C^op * C) s's d'd) + : morphism set_cat (obj_of s's) (obj_of d'd) + := fun g => snd hf o g o fst hf. + + Definition hom_functor : Functor (C^op * C) set_cat. + + refine (Build_Functor (C^op * C) set_cat + (fun c'c => obj_of c'c) + hom_functor_morphism_of + _ + _); + subst hom_functor_morphism_of; + simpl; admit. + Defined. +End hom_functor. +Set Universe Polymorphism. + +Import Category.Dual Functor.Dual. +Import Category.Prod Functor.Prod. +Import Functor.Composition.Core. +Import Functor.Identity. +Set Universe Polymorphism. + +Local Open Scope functor_scope. +Local Open Scope natural_transformation_scope. +Section Adjunction. + + Context `{Funext}. + Variable C : PreCategory. + Variable D : PreCategory. + Variable F : Functor C D. + Variable G : Functor D C. + + Let Adjunction_Type := + Eval simpl in (hom_functor D) o (F^op, 1) <~=~> (hom_functor C) o (1, G). + + Record AdjunctionHom := + { + mate_of : + @NaturalIsomorphism H + (Prod.prod (Category.Dual.opposite C) D) + (@set_cat H) + (@compose (Prod.prod (Category.Dual.opposite C) D) + (Prod.prod (Category.Dual.opposite D) D) + (@set_cat H) (@hom_functor H D) + (@pair (Category.Dual.opposite C) + (Category.Dual.opposite D) D D + (@opposite C D F) (identity D))) + (@compose (Prod.prod (Category.Dual.opposite C) D) + (Prod.prod (Category.Dual.opposite C) C) + (@set_cat H) (@hom_functor H C) + (@pair (Category.Dual.opposite C) + (Category.Dual.opposite C) D C + (identity (Category.Dual.opposite C)) G)) + }. +End Adjunction. +(* Error: Illegal application: +The term "NaturalIsomorphism" of type + "forall (H : Funext) (C D : PreCategory), + (C -> D)%category -> (C -> D)%category -> Type" +cannot be applied to the terms + "H" : "Funext" + "(C ^op * D)%category" : "PreCategory" + "set_cat" : "PreCategory" + "hom_functor D o (F ^op, 1)" : "Functor (C ^op * D) set_cat" + "hom_functor C o (1, G)" : "Functor (C ^op * D) set_cat" +The 5th term has type "Functor (C ^op * D) set_cat" +which should be coercible to "object (C ^op * D -> set_cat)". +*) +End Core. + +End HoTT. + +End HoTT_DOT_categories_DOT_NaturalTransformation_DOT_Composition_DOT_Core. diff --git a/test-suite/bugs/closed/bug_3331.v b/test-suite/bugs/closed/bug_3331.v new file mode 100644 index 0000000000..8047fc386b --- /dev/null +++ b/test-suite/bugs/closed/bug_3331.v @@ -0,0 +1,32 @@ +(* File reduced by coq-bug-finder from original input, then from 6303 lines to 66 lines, then from 63 lines to 36 lines *) +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y :> A" := (@paths A x y) : type_scope. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (x = y :>_) : type_scope. +Class Contr_internal (A : Type) := BuildContr { center : A ; contr : (forall y : A, center = y) }. +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. +Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A. +Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : IsTrunc n (x = y) := H x y. +Notation Contr := (IsTrunc minus_two). +Section groupoid_category. + Variable X : Type. + Context `{H : IsTrunc (trunc_S (trunc_S (trunc_S minus_two))) X}. + Goal X -> True. + intro d. + pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))) as H'. (* success *) + clear H'. + compute in H. + change (forall (x y : X) (p q : x = y) (r s : p = q), Contr (r = s)) in H. + assert (H' := H). + set (foo:=_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). (* success *) + clear H' foo. + Set Typeclasses Debug. + pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). +Abort. +End groupoid_category. diff --git a/test-suite/bugs/closed/3332.v b/test-suite/bugs/closed/bug_3332.v index a3564bfcce..a3564bfcce 100644 --- a/test-suite/bugs/closed/3332.v +++ b/test-suite/bugs/closed/bug_3332.v diff --git a/test-suite/bugs/closed/3336.v b/test-suite/bugs/closed/bug_3336.v index dc358c6004..dc358c6004 100644 --- a/test-suite/bugs/closed/3336.v +++ b/test-suite/bugs/closed/bug_3336.v diff --git a/test-suite/bugs/closed/bug_3337.v b/test-suite/bugs/closed/bug_3337.v new file mode 100644 index 0000000000..f8cfe985a9 --- /dev/null +++ b/test-suite/bugs/closed/bug_3337.v @@ -0,0 +1,5 @@ +Require Import Setoid. +Goal forall x y : Set, x = y -> x = y. +intros x y H. +rewrite_strat subterms H. +Abort. diff --git a/test-suite/bugs/closed/bug_3338.v b/test-suite/bugs/closed/bug_3338.v new file mode 100644 index 0000000000..57160503d4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3338.v @@ -0,0 +1,5 @@ +Require Import Setoid. +Goal forall x y : Set, x = y -> y = y. +intros x y H. +rewrite_strat try topdown terms H. +Abort. diff --git a/test-suite/bugs/closed/3344.v b/test-suite/bugs/closed/bug_3344.v index 880851c565..880851c565 100644 --- a/test-suite/bugs/closed/3344.v +++ b/test-suite/bugs/closed/bug_3344.v diff --git a/test-suite/bugs/closed/3346.v b/test-suite/bugs/closed/bug_3346.v index 09bd789345..09bd789345 100644 --- a/test-suite/bugs/closed/3346.v +++ b/test-suite/bugs/closed/bug_3346.v diff --git a/test-suite/bugs/closed/3347.v b/test-suite/bugs/closed/bug_3347.v index dcf5394eaf..dcf5394eaf 100644 --- a/test-suite/bugs/closed/3347.v +++ b/test-suite/bugs/closed/bug_3347.v diff --git a/test-suite/bugs/closed/3348.v b/test-suite/bugs/closed/bug_3348.v index 904de68964..904de68964 100644 --- a/test-suite/bugs/closed/3348.v +++ b/test-suite/bugs/closed/bug_3348.v diff --git a/test-suite/bugs/closed/3350.v b/test-suite/bugs/closed/bug_3350.v index c1ff292b3e..c1ff292b3e 100644 --- a/test-suite/bugs/closed/3350.v +++ b/test-suite/bugs/closed/bug_3350.v diff --git a/test-suite/bugs/closed/3352.v b/test-suite/bugs/closed/bug_3352.v index bf2f7a9d19..bf2f7a9d19 100644 --- a/test-suite/bugs/closed/3352.v +++ b/test-suite/bugs/closed/bug_3352.v diff --git a/test-suite/bugs/closed/3354.v b/test-suite/bugs/closed/bug_3354.v index a635285f2c..a635285f2c 100644 --- a/test-suite/bugs/closed/3354.v +++ b/test-suite/bugs/closed/bug_3354.v diff --git a/test-suite/bugs/closed/3355.v b/test-suite/bugs/closed/bug_3355.v index 46a5714781..46a5714781 100644 --- a/test-suite/bugs/closed/3355.v +++ b/test-suite/bugs/closed/bug_3355.v diff --git a/test-suite/bugs/closed/bug_3368.v b/test-suite/bugs/closed/bug_3368.v new file mode 100644 index 0000000000..e22b4118c8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3368.v @@ -0,0 +1,16 @@ +(* File reduced by coq-bug-finder from 7411 lines to 2271 lines., then from 889 lines to 119 lines, then from 76 lines to 19 lines *) +Set Universe Polymorphism. +Set Implicit Arguments. +Set Primitive Projections. +Record PreCategory := { object :> Type; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). +Definition opposite' C D (F : Functor C D) + := Build_Functor (opposite C) (opposite D) + (object_of F) + (fun s d => @morphism_of C D F d s). +(* Toplevel input, characters 15-191: +Anomaly: File "pretyping/reductionops.ml", line 149, characters 4-10: Assertion failed. +Please report. *) diff --git a/test-suite/bugs/closed/bug_3372.v b/test-suite/bugs/closed/bug_3372.v new file mode 100644 index 0000000000..eb70149a02 --- /dev/null +++ b/test-suite/bugs/closed/bug_3372.v @@ -0,0 +1,8 @@ +Set Universe Polymorphism. +Definition hProp : Type := sigT (fun _ : Type => True). +Goal Type. +Fail exact hProp@{Set}. (* test that it fails, but is not an anomaly *) +try (exact hProp@{Set}; fail 1). (* Toplevel input, characters 15-32: +Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). +Please report. *) +Abort. diff --git a/test-suite/bugs/closed/3373.v b/test-suite/bugs/closed/bug_3373.v index 051e695203..051e695203 100644 --- a/test-suite/bugs/closed/3373.v +++ b/test-suite/bugs/closed/bug_3373.v diff --git a/test-suite/bugs/closed/3374.v b/test-suite/bugs/closed/bug_3374.v index d8e72f4f20..d8e72f4f20 100644 --- a/test-suite/bugs/closed/3374.v +++ b/test-suite/bugs/closed/bug_3374.v diff --git a/test-suite/bugs/closed/3375.v b/test-suite/bugs/closed/bug_3375.v index 1e0c8e61f4..1e0c8e61f4 100644 --- a/test-suite/bugs/closed/3375.v +++ b/test-suite/bugs/closed/bug_3375.v diff --git a/test-suite/bugs/closed/3377.v b/test-suite/bugs/closed/bug_3377.v index abfcf1d355..abfcf1d355 100644 --- a/test-suite/bugs/closed/3377.v +++ b/test-suite/bugs/closed/bug_3377.v diff --git a/test-suite/bugs/closed/3382.v b/test-suite/bugs/closed/bug_3382.v index 3e374d9077..3e374d9077 100644 --- a/test-suite/bugs/closed/3382.v +++ b/test-suite/bugs/closed/bug_3382.v diff --git a/test-suite/bugs/closed/bug_3383.v b/test-suite/bugs/closed/bug_3383.v new file mode 100644 index 0000000000..b09b898adb --- /dev/null +++ b/test-suite/bugs/closed/bug_3383.v @@ -0,0 +1,7 @@ +Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end. +intro. +lazymatch goal with +| [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ] + => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b) +end. +Abort. diff --git a/test-suite/bugs/closed/bug_3386.v b/test-suite/bugs/closed/bug_3386.v new file mode 100644 index 0000000000..74a7d1796c --- /dev/null +++ b/test-suite/bugs/closed/bug_3386.v @@ -0,0 +1,18 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. +Set Printing Universes. +Record Cat := { Obj :> Type }. +Definition set_cat := {| Obj := Type |}. +Goal Type@{i} = Type@{j}. +Proof. + (* 1 subgoals +, subgoal 1 (ID 3) + + ============================ + Type@{Top.368} = Type@{Top.370} +(dependent evars:) *) + Fail change Type@{i} with (Obj set_cat@{i}). (* check that it fails *) + try change Type@{i} with (Obj set_cat@{i}). (* check that it's not an anomaly *) +(* Anomaly: Uncaught exception Invalid_argument("Array.iter2", _). +Please report. *) +Abort. diff --git a/test-suite/bugs/closed/3387.v b/test-suite/bugs/closed/bug_3387.v index 1d9e783374..1d9e783374 100644 --- a/test-suite/bugs/closed/3387.v +++ b/test-suite/bugs/closed/bug_3387.v diff --git a/test-suite/bugs/closed/3388.v b/test-suite/bugs/closed/bug_3388.v index 7826280498..7826280498 100644 --- a/test-suite/bugs/closed/3388.v +++ b/test-suite/bugs/closed/bug_3388.v diff --git a/test-suite/bugs/closed/bug_3390.v b/test-suite/bugs/closed/bug_3390.v new file mode 100644 index 0000000000..f4e405de72 --- /dev/null +++ b/test-suite/bugs/closed/bug_3390.v @@ -0,0 +1,10 @@ +Tactic Notation "basicapply" open_constr(R) "using" tactic3(tac) "sideconditions" tactic0(tacfin) := idtac. +Tactic Notation "basicapply" open_constr(R) := basicapply R using (fun Hlem => idtac) sideconditions (autounfold with spred; idtac). +(* segfault in coqtop *) + + +Tactic Notation "basicapply" tactic0(tacfin) := idtac. + +Goal True. +basicapply subst. +Abort. diff --git a/test-suite/bugs/closed/3392.v b/test-suite/bugs/closed/bug_3392.v index a03db77544..a03db77544 100644 --- a/test-suite/bugs/closed/3392.v +++ b/test-suite/bugs/closed/bug_3392.v diff --git a/test-suite/bugs/closed/bug_3393.v b/test-suite/bugs/closed/bug_3393.v new file mode 100644 index 0000000000..d2eb61e3e2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3393.v @@ -0,0 +1,155 @@ +Require Import TestSuite.admit. +(* -*- coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 8760 lines to 7519 lines, then from 7050 lines to 909 lines, then from 846 lines to 578 lines, then from 497 lines to 392 lines, then from 365 lines to 322 lines, then from 252 lines to 205 lines, then from 215 lines to 204 lines, then from 210 lines to 182 lines, then from 175 lines to 157 lines *) +Set Universe Polymorphism. +Axiom admit : forall {T}, T. +Set Implicit Arguments. +Generalizable All Variables. +Reserved Notation "g 'o' f" (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "a = b" := (@paths _ a b) : type_scope. +Arguments idpath {A a} , [A] a. +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { equiv_inv : B -> A }. +Delimit Scope equiv_scope with equiv. +Local Open Scope equiv_scope. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. +Class Funext := { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. +Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) : (forall x, f x = g x) -> f = g := (@apD10 A P f g)^-1. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' where "f 'o' g" := (compose f g); + associativity : forall x1 x2 x3 x4 (m1 : morphism x1 x2) (m2 : morphism x2 x3) (m3 : morphism x3 x4), (m3 o m2) o m1 = m3 o (m2 o m1) + }. +Bind Scope category_scope with PreCategory. +Bind Scope morphism_scope with morphism. +Infix "o" := (@compose _ _ _ _) : morphism_scope. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Bind Scope functor_scope with Functor. +Notation "F '_1' m" := (@morphism_of _ _ F _ _ m) (at level 10, no associativity) : morphism_scope. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Local Notation "m ^-1" := (morphism_inverse (m := m)) : morphism_scope. +Class Isomorphic {C : PreCategory} s d := + { morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. +Definition isisomorphism_inverse `(@IsIsomorphism C x y m) : IsIsomorphism m^-1 := {| morphism_inverse := m |}. + +Global Instance isisomorphism_compose `(@IsIsomorphism C y z m0) `(@IsIsomorphism C x y m1) : IsIsomorphism (m0 o m1). +Admitted. +Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. +Definition composef C D E (G : Functor D E) (F : Functor C D) : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => @morphism_of _ _ G _ _ (@morphism_of _ _ F _ _ m)). +Infix "o" := composef : functor_scope. +Delimit Scope natural_transformation_scope with natural_transformation. + +Local Open Scope morphism_scope. +Record NaturalTransformation C D (F G : Functor C D) := + { components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), components_of d o F _1 m = G _1 m o components_of s }. + +Definition composet C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') +: NaturalTransformation F F'' + := Build_NaturalTransformation F F'' (fun c => T' c o T c) admit. +Infix "o" := composet : natural_transformation_scope. +Section path_natural_transformation. + Context `{Funext}. + Variable C : PreCategory. + Variable D : PreCategory. + Variables F G : Functor C D. + Section path. + Variables T U : NaturalTransformation F G. + Lemma path'_natural_transformation + : components_of T = components_of U + -> T = U. + admit. + Defined. + Lemma path_natural_transformation + : (forall x, components_of T x = components_of U x) + -> T = U. + Proof. + intros. + apply path'_natural_transformation. + apply path_forall; assumption. + Qed. + End path. +End path_natural_transformation. +Ltac path_natural_transformation := + repeat match goal with + | _ => intro + | _ => apply path_natural_transformation; simpl + end. + +Local Open Scope natural_transformation_scope. +Definition associativityt `{fs : Funext} + C D F G H I + (V : @NaturalTransformation C D F G) + (U : @NaturalTransformation C D G H) + (T : @NaturalTransformation C D H I) +: (T o U) o V = T o (U o V). +Proof. + path_natural_transformation. + apply associativity. +Qed. +Definition functor_category `{Funext} (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) (@NaturalTransformation C D) (@composet C D) (@associativityt _ C D). +Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism `{Funext} (C D : PreCategory) F G := @Isomorphic (C -> D) F G. +Infix "<~=~>" := NaturalIsomorphism : natural_transformation_scope. +Global Instance isisomorphism_compose' `{Funext} + `(T' : @NaturalTransformation C D F' F'') + `(T : @NaturalTransformation C D F F') + `{@IsIsomorphism (C -> D) F' F'' T'} + `{@IsIsomorphism (C -> D) F F' T} +: @IsIsomorphism (C -> D) F F'' (T' o T)%natural_transformation + := @isisomorphism_compose (C -> D) _ _ T' _ _ T _. +Section lemmas. + Context `{Funext}. + Variable C : PreCategory. + Variable F : C -> PreCategory. + Context + {w y z} + {f : Functor (F w) (F z)} {f0 : Functor (F w) (F y)} + {f2 : Functor (F y) (F z)} + {f5 : Functor (F w) (F z)} + {n2 : f <~=~> (f2 o f0)%functor}. + Lemma p_composition_of_coherent_iso_for_rewrite__isisomorphism_helper' XX + : @IsIsomorphism + (F w -> F z) f5 f + (n2 ^-1 o XX)%natural_transformation. + Proof. + eapply isisomorphism_compose'. + eapply isisomorphism_inverse. (* Toplevel input, characters 22-43: +Error: +In environment +H : Funext +C : PreCategory +F : C -> PreCategory +w : C +y : C +z : C +f : Functor (F w) (F z) +f0 : Functor (F w) (F y) +f2 : Functor (F y) (F z) +f5 : Functor (F w) (F z) +n2 : f <~=~> (f2 o f0)%functor +XX : NaturalTransformation f5 (f2 o f0) +Unable to unify + "{| + object := Functor (F w) (F z); + morphism := NaturalTransformation (D:=F z); + compose := composet (D:=F z); + associativity := associativityt (D:=F z) |}" with + "{| + object := Functor (F w) (F z); + morphism := NaturalTransformation (D:=F z); + compose := composet (D:=F z); + associativity := associativityt (D:=F z) |}". *) + Abort. +End lemmas. diff --git a/test-suite/bugs/closed/3402.v b/test-suite/bugs/closed/bug_3402.v index b4705780db..b4705780db 100644 --- a/test-suite/bugs/closed/3402.v +++ b/test-suite/bugs/closed/bug_3402.v diff --git a/test-suite/bugs/closed/bug_3408.v b/test-suite/bugs/closed/bug_3408.v new file mode 100644 index 0000000000..62f5382bd1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3408.v @@ -0,0 +1,163 @@ +Require Import BinPos. + +Inductive expr : Type := + Var : nat -> expr +| App : expr -> expr -> expr +| Abs : unit -> expr -> expr. + +Inductive expr_acc +: expr -> expr -> Prop := + acc_App_l : forall f a : expr, + expr_acc f (App f a) +| acc_App_r : forall f a : expr, + expr_acc a (App f a) +| acc_Abs : forall (t : unit) (e : expr), + expr_acc e (Abs t e). + +Theorem wf_expr_acc : well_founded expr_acc. +Proof. + red. + refine (fix rec a : Acc expr_acc a := + match a as a return Acc expr_acc a with + | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => + match _H in expr_acc z Z + return match Z return Prop with + | Var _ => Acc _ y + | _ => True + end + with + | acc_App_l _ _ => I + | _ => I + end) + | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => + match pf in expr_acc z Z + return match Z return Prop with + | App a b => f = a -> x = b -> Acc expr_acc z + | _ => True + end + with + | acc_App_l f' x' => fun pf _ => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec f + end + | acc_App_r f' x' => fun _ pf => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec x + end + | _ => I + end eq_refl eq_refl) + | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => + match pf in expr_acc z Z + return match Z return Prop with + | Abs a b => e = b -> Acc expr_acc z + | _ => True + end + with + | acc_Abs f x => fun pf => match pf in _ = z return + Acc expr_acc z + with + | eq_refl => rec e + end + | _ => I + end eq_refl) + end). +Defined. + +Theorem wf_expr_acc_delay : well_founded expr_acc. +Proof. + red. + refine (fix rec a : Acc expr_acc a := + match a as a return Acc expr_acc a with + | Var v => Acc_intro _ (fun y (_H : expr_acc y (Var v)) => + match _H in expr_acc z Z + return match Z return Prop with + | Var _ => Acc _ y + | _ => True + end + with + | acc_App_l _ _ => I + | _ => I + end) + | App f x => Acc_intro _ (fun y (pf : expr_acc y (App f x)) => + match pf in expr_acc z Z + return match Z return Prop with + | App a b => (unit -> Acc expr_acc a) -> (unit -> Acc expr_acc b) -> Acc expr_acc z + | _ => True + end + with + | acc_App_l f' x' => fun pf _ => pf tt + | acc_App_r f' x' => fun _ pf => pf tt + | _ => I + end (fun _ => rec f) (fun _ => rec x)) + | Abs t e => Acc_intro _ (fun y (pf : expr_acc y (Abs t e)) => + match pf in expr_acc z Z + return match Z return Prop with + | Abs a b => (unit -> Acc expr_acc b) -> Acc expr_acc z + | _ => True + end + with + | acc_Abs f x => fun pf => pf tt + | _ => I + end (fun _ => rec e)) + end); + try solve [ inversion _H ]. +Defined. + +Fixpoint build_large (n : nat) : expr := + match n with + | 0 => Var 0 + | S n => + let e := build_large n in + App e e + end. + +Section guard. + Context {A : Type} {R : A -> A -> Prop}. + + Fixpoint guard (n : nat) (wfR : well_founded R) : well_founded R := + match n with + | 0 => wfR + | S n0 => + fun x : A => + Acc_intro x + (fun (y : A) (_ : R y x) => guard n0 (guard n0 wfR) y) + end. +End guard. + + +Definition sizeF_delay : expr -> positive. +refine + (@Fix expr (expr_acc) + (wf_expr_acc_delay) + (fun _ => positive) + (fun e => + match e as e return (forall l, expr_acc l e -> positive) -> positive with + | Var _ => fun _ => 1 + | App l r => fun rec => @rec l _ + @rec r _ + | Abs _ e => fun rec => 1 + @rec e _ + end%positive)). +eapply acc_App_l. +eapply acc_App_r. +eapply acc_Abs. +Defined. + +Definition sizeF_guard : expr -> positive. +refine + (@Fix expr (expr_acc) + (guard 5 wf_expr_acc) + (fun _ => positive) + (fun e => + match e as e return (forall l, expr_acc l e -> positive) -> positive with + | Var _ => fun _ => 1 + | App l r => fun rec => @rec l _ + @rec r _ + | Abs _ e => fun rec => 1 + @rec e _ + end%positive)). +eapply acc_App_l. +eapply acc_App_r. +eapply acc_Abs. +Defined. + +Time Eval native_compute in sizeF_delay (build_large 2). +Time Eval native_compute in sizeF_guard (build_large 2). diff --git a/test-suite/bugs/closed/3416.v b/test-suite/bugs/closed/bug_3416.v index 5cfb8f1ff4..5cfb8f1ff4 100644 --- a/test-suite/bugs/closed/3416.v +++ b/test-suite/bugs/closed/bug_3416.v diff --git a/test-suite/bugs/closed/3417.v b/test-suite/bugs/closed/bug_3417.v index 9d7c6f013d..9d7c6f013d 100644 --- a/test-suite/bugs/closed/3417.v +++ b/test-suite/bugs/closed/bug_3417.v diff --git a/test-suite/bugs/closed/3422.v b/test-suite/bugs/closed/bug_3422.v index 460ae8f110..460ae8f110 100644 --- a/test-suite/bugs/closed/3422.v +++ b/test-suite/bugs/closed/bug_3422.v diff --git a/test-suite/bugs/closed/bug_3427.v b/test-suite/bugs/closed/bug_3427.v new file mode 100644 index 0000000000..317efb0b32 --- /dev/null +++ b/test-suite/bugs/closed/bug_3427.v @@ -0,0 +1,198 @@ +Require Import TestSuite.admit. +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 0 lines to 7171 lines, then from 7184 lines to 558 lines, then from 556 lines to 209 lines *) +Generalizable All Variables. +Set Universe Polymorphism. +Notation Type0 := Set. +Notation idmap := (fun x => x). +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Delimit Scope path_scope with path. +Local Open Scope path_scope. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3) : path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) : forall x, f x = g x := fun x => match h with idpath => idpath end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) + }. +Record Equiv A B := BuildEquiv { + equiv_fun :> A -> B ; + equiv_isequiv :> IsEquiv equiv_fun + }. + +Delimit Scope equiv_scope with equiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3) : equiv_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) + }. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint nat_to_trunc_index (n : nat) : trunc_index + := match n with + | 0 => trunc_S (trunc_S minus_two) + | S n' => trunc_S (nat_to_trunc_index n') + end. + +Coercion nat_to_trunc_index : nat >-> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Notation minus_one:=(trunc_S minus_two). + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation Contr := (IsTrunc minus_two). +Notation IsHProp := (IsTrunc minus_one). +Notation IsHSet := (IsTrunc 0). + +Class Funext := + { isequiv_apD10 :> forall (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g) }. + +Definition concat_pV {A : Type} {x y : A} (p : x = y) : + p @ p^ = 1 + := + match p with idpath => 1 end. + +Definition concat_Vp {A : Type} {x y : A} (p : x = y) : + p^ @ p = 1 + := + match p with idpath => 1 end. + +Definition transport_pp {A : Type} (P : A -> Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) : + p @ q # u = q # p # u := + match q with idpath => + match p with idpath => 1 end + end. + +Definition transport2 {A : Type} (P : A -> Type) {x y : A} {p q : x = y} + (r : p = q) (z : P x) +: p # z = q # z + := ap (fun p' => p' # z) r. + +Inductive Unit : Type0 := + tt : Unit. + +Instance contr_unit : Contr Unit | 0 := let x := {| + center := tt; + contr := fun t : Unit => match t with tt => 1 end + |} in x. + +Instance trunc_succ `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. +admit. +Defined. + +Record hProp := hp { hproptype :> Type ; isp : IsHProp hproptype}. +Definition Unit_hp:hProp:=(hp Unit _). + +Global Instance isequiv_ap_hproptype `{Funext} X Y : IsEquiv (@ap _ _ hproptype X Y). +admit. +Defined. + +Definition path_hprop `{Funext} X Y := (@ap _ _ hproptype X Y)^-1%equiv. + +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Local Open Scope equiv_scope. + +Instance isequiv_path {A B : Type} (p : A = B) +: IsEquiv (transport (fun X:Type => X) p) | 0 + := BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) + (fun b => ((transport_pp idmap p^ p b)^ @ transport2 idmap (concat_Vp p) b)) + (fun a => ((transport_pp idmap p p^ a)^ @ transport2 idmap (concat_pV p) a)) + (fun a => match p in _ = C return + (transport_pp idmap p^ p (transport idmap p a))^ @ + transport2 idmap (concat_Vp p) (transport idmap p a) = + ap (transport idmap p) ((transport_pp idmap p p^ a) ^ @ + transport2 idmap (concat_pV p) a) with idpath => 1 end). + +Definition equiv_path (A B : Type) (p : A = B) : A <~> B + := BuildEquiv _ _ (transport (fun X:Type => X) p) _. + +Class Univalence := { + isequiv_equiv_path :> forall (A B : Type), IsEquiv (equiv_path A B) + }. + +Section Univalence. + Context `{Univalence}. + + Definition path_universe_uncurried {A B : Type} (f : A <~> B) : A = B + := (equiv_path A B)^-1 f. +End Univalence. + +Local Inductive minus1Trunc (A :Type) : Type := + min1 : A -> minus1Trunc A. + +Instance minus1Trunc_is_prop {A : Type} : IsHProp (minus1Trunc A) | 0. +admit. +Defined. + +Definition hexists {X} (P:X->Type):Type:= minus1Trunc (sigT P). + +Section AssumingUA. + + Definition isepi {X Y} `(f:X->Y) := forall Z: hSet, + forall g h: Y -> Z, g o f = h o f -> g = h. + Context {X Y : hSet} (f : X -> Y) (Hisepi : isepi f). + + Goal forall (X Y : hSet) (f : forall _ : setT X, setT Y), + let fib := + fun y : setT Y => + hp (@hexists (setT X) (fun x : setT X => @paths (setT Y) (f x) y)) + (@minus1Trunc_is_prop + (@sigT (setT X) (fun x : setT X => @paths (setT Y) (f x) y))) in + forall (x : setT X) (_ : Univalence) (_ : Funext), + @paths hProp (fib (f x)) Unit_hp. + intros. + + apply path_hprop. + simpl. + Set Printing Universes. + Set Printing All. + refine (path_universe_uncurried _). + Undo. + apply path_universe_uncurried. (* Toplevel input, characters 21-44: +Error: Refiner was given an argument + "@path_universe_uncurried (* Top.425 Top.426 Top.427 Top.428 Top.429 *) X1 + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit + ?63" of type + "@paths (* Top.428 *) Type (* Top.425 *) + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit" +instead of + "@paths (* Top.413 *) Type (* Set *) + (@hexists (* Top.405 Top.404 Set Set *) (setT (* Top.405 *) X0) + (fun x0 : setT (* Top.405 *) X0 => + @paths (* Top.404 *) (setT (* Top.404 *) Y0) (f0 x0) (f0 x))) Unit". + *) + Abort. +End AssumingUA. diff --git a/test-suite/bugs/closed/bug_3428.v b/test-suite/bugs/closed/bug_3428.v new file mode 100644 index 0000000000..4192be6d2d --- /dev/null +++ b/test-suite/bugs/closed/bug_3428.v @@ -0,0 +1,35 @@ +(* File reduced by coq-bug-finder from original input, then from 2809 lines to 39 lines *) +Set Primitive Projections. +Set Implicit Arguments. +Module Export foo. + Record prod (A B : Type) := pair { fst : A ; snd : B }. +End foo. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Axiom path_prod : forall {A B : Type} (z z' : prod A B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Notation fst := (@fst _ _). +Notation snd := (@snd _ _). +Definition ap_fst_path_prod {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') +: ap fst (path_prod z z' p q) = p. +Abort. + +Notation fstp x := (x.(foo.fst)). +Notation fstap x := (foo.fst x). + +Definition ap_fst_path_prod' {A B : Type} {z z' : prod A B} (p : @paths A (fst z) (fst z')) (q : snd z = snd z') +: ap (fun x => fstap x) (path_prod z z' p q) = p. + +Abort. + +(* Toplevel input, characters 137-138: +Error: +In environment +A : Type +B : Type +z : prod A B +z' : prod A B +p : @paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z') +q : @paths ?54 (foo.snd ?42 ?45 z) (foo.snd ?57 ?60 z') +The term "p" has type "@paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')" +while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *) diff --git a/test-suite/bugs/closed/3439.v b/test-suite/bugs/closed/bug_3439.v index e8c2d8b8ca..e8c2d8b8ca 100644 --- a/test-suite/bugs/closed/3439.v +++ b/test-suite/bugs/closed/bug_3439.v diff --git a/test-suite/bugs/closed/bug_3441.v b/test-suite/bugs/closed/bug_3441.v new file mode 100644 index 0000000000..52acb996f8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3441.v @@ -0,0 +1,24 @@ +Axiom f : nat -> nat -> nat. +Fixpoint do_n (n : nat) (k : nat) := + match n with + | 0 => k + | S n' => do_n n' (f k k) + end. + +Notation big := (_ = _). +Axiom k : nat. +Goal True. +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *) +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *) + +Timeout 1 Time let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) +Abort. diff --git a/test-suite/bugs/closed/bug_3446.v b/test-suite/bugs/closed/bug_3446.v new file mode 100644 index 0000000000..57e0efea8e --- /dev/null +++ b/test-suite/bugs/closed/bug_3446.v @@ -0,0 +1,51 @@ +(* File reduced by coq-bug-finder from original input, then from 7372 lines to 539 lines, then from 531 lines to 107 lines, then from 76 lines to 46 lines *) +Module First. +Set Asymmetric Patterns. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Notation "A -> B" := (forall (_ : A), B). +Set Universe Polymorphism. + + +Notation "x → y" := (x -> y) + (at level 99, y at level 200, right associativity): type_scope. +Record sigT A (P : A -> Type) := + { projT1 : A ; projT2 : P projT1 }. +Arguments projT1 {A P} s. +Arguments projT2 {A P} s. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Reserved Notation "x = y" (at level 70, no associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y). +Notation " x = y " := (paths x y) : type_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Reserved Notation "{ x : A & P }" (at level 0, x at level 99). +Notation "{ x : A & P }" := (sigT A (fun x => P)) : type_scope. + + +Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT A P) (pq : {p : projT1 u = projT1 v & transport _ p (projT2 u) = projT2 v}), u = v. +Axiom isequiv_pr1_contr : forall {A} {P : A -> Type}, (A -> {x : A & P x}). + +Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT _ P) := + @compose _ _ _ (path_sigma_uncurried P u v) (@isequiv_pr1_contr _ _). +End First. + +Set Asymmetric Patterns. +Set Universe Polymorphism. +Arguments projT1 {_ _} _. +Notation "( x ; y )" := (existT _ x y). +Notation pr1 := projT1. +Notation "x .1" := (projT1 x) (at level 3). +Notation "x .2" := (projT2 x) (at level 3). +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3). +Axiom path_sigma_uncurried : forall {A : Type} (P : A -> Type) (u v : sigT P) (pq : {p : u.1 = v.1 & p # u.2 = v.2}), u = v. +Instance isequiv_pr1_contr {A} {P : A -> Type} : IsEquiv (@pr1 A P) | 100. +Admitted. + +Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT P) : u.1 = v.1 -> u = v := + path_sigma_uncurried P u v o pr1^-1. diff --git a/test-suite/bugs/closed/3453.v b/test-suite/bugs/closed/bug_3453.v index 4ee9b400a3..4ee9b400a3 100644 --- a/test-suite/bugs/closed/3453.v +++ b/test-suite/bugs/closed/bug_3453.v diff --git a/test-suite/bugs/closed/bug_3454.v b/test-suite/bugs/closed/bug_3454.v new file mode 100644 index 0000000000..e4cd60cb24 --- /dev/null +++ b/test-suite/bugs/closed/bug_3454.v @@ -0,0 +1,63 @@ +Set Primitive Projections. +Set Implicit Arguments. + +Record prod {A} {B}:= pair { fst : A ; snd : B }. +Notation " A * B " := (@prod A B) : type_scope. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation pr1 := (@projT1 _ _). +Arguments prod : clear implicits. + +Check (@projT1 _ (fun x : nat => x = x)). +Check (fun s : @sigT nat (fun x : nat => x = x) => s.(projT1)). + +Record rimpl {b : bool} {n : nat} := { foo : forall {x : nat}, x = n }. + +Check (fun r : @rimpl true 0 => r.(foo) (x:=0)). +Check (fun r : @rimpl true 0 => @foo true 0 r 0). +Check (fun r : @rimpl true 0 => foo r (x:=0)). +Check (fun r : @rimpl true 0 => @foo _ _ r 0). +Check (fun r : @rimpl true 0 => r.(@foo _ _)). +Check (fun r : @rimpl true 0 => r.(foo)). + +Notation "{ x : T & P }" := (@sigT T P). +Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope. +(* Notation "{ x : T * U & P }" := (@sigT (T * U) P). *) + +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Class IsEquiv {A B : Type} (f : A -> B) := {}. + +Local Instance isequiv_tgt_compose A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B + (@compose {xy : B * B & fst xy = snd xy} _ B (@snd B B) pr1)). +(* Toplevel input, characters 220-223: *) +(* Error: Cannot infer this placeholder. *) + +Local Instance isequiv_tgt_compose' A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) pr1)). +(* Toplevel input, characters 221-232: *) +(* Error: *) +(* In environment *) +(* A : Type *) +(* B : Type *) +(* The term "pr1" has type "sigT ?30 -> ?29" while it is expected to have type *) +(* "{xy : B * B & fst xy = snd xy} -> ?27 * B". *) + +Local Instance isequiv_tgt_compose'' A B +: @IsEquiv (A -> {xy : B * B & fst xy = snd xy}) + (A -> B) + (@compose A {xy : B * B & fst xy = snd xy} B (@compose {xy : B * B & fst xy = snd xy} _ B (@snd _ _) + (fun s => s.(projT1)))). +(* Toplevel input, characters 15-241: +Error: +Cannot infer an internal placeholder of type "Type" in environment: + +A : Type +B : Type +x : ?32 +. *) diff --git a/test-suite/bugs/closed/bug_3461.v b/test-suite/bugs/closed/bug_3461.v new file mode 100644 index 0000000000..cad28a558c --- /dev/null +++ b/test-suite/bugs/closed/bug_3461.v @@ -0,0 +1,6 @@ +Lemma foo (b : bool) : + exists x : nat, x = x. +Proof. +eexists. +Fail eexact (eq_refl b). +Abort. diff --git a/test-suite/bugs/closed/3467.v b/test-suite/bugs/closed/bug_3467.v index 88ae030578..88ae030578 100644 --- a/test-suite/bugs/closed/3467.v +++ b/test-suite/bugs/closed/bug_3467.v diff --git a/test-suite/bugs/closed/bug_3469.v b/test-suite/bugs/closed/bug_3469.v new file mode 100644 index 0000000000..b43e65ab83 --- /dev/null +++ b/test-suite/bugs/closed/bug_3469.v @@ -0,0 +1,30 @@ +(* File reduced by coq-bug-finder from original input, then from 538 lines to 31 lines *) +Open Scope type_scope. +Global Set Primitive Projections. +Set Implicit Arguments. +Record sig (A : Type) (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. +Notation sigT := sig (only parsing). +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). +Variables X : Type. +Variable R : X -> X -> Type. +Lemma dependent_choice : + (forall x:X, {y : _ & R x y}) -> + forall x0, {f : nat -> X & (f O = x0) * (forall n, R (f n) (f (S n)))}. +Proof. + intros H x0. + set (f:=fix f n := match n with O => x0 | S n' => projT1 (H (f n')) end). + exists f. + split. + reflexivity. + induction n; simpl in *. + clear. + apply (proj2_sig (H x0)). + Undo. + apply @proj2_sig. + + +(* Toplevel input, characters 21-31: +Error: Found no subterm matching "proj1_sig ?206" in the current *) +Abort. diff --git a/test-suite/bugs/closed/bug_3477.v b/test-suite/bugs/closed/bug_3477.v new file mode 100644 index 0000000000..0690c22670 --- /dev/null +++ b/test-suite/bugs/closed/bug_3477.v @@ -0,0 +1,10 @@ +Set Primitive Projections. +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall A B : Set, True. +Proof. + intros A B. + evar (a : prod A B); evar (f : (prod A B -> Set)). + let a' := (eval unfold a in a) in + set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))). +Abort. diff --git a/test-suite/bugs/closed/bug_3480.v b/test-suite/bugs/closed/bug_3480.v new file mode 100644 index 0000000000..fd98232f96 --- /dev/null +++ b/test-suite/bugs/closed/bug_3480.v @@ -0,0 +1,50 @@ +Require Import TestSuite.admit. +Set Primitive Projections. +Axiom admit : forall {T}, T. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Set Implicit Arguments. +Delimit Scope category_scope with category. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Local Open Scope category_scope. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Class Isomorphic {C : PreCategory} s d := { morphism_isomorphic :> @morphism C s d ; isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. +Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. +Definition idtoiso (C : PreCategory) (x y : C) (H : x = y) : Isomorphic x y := admit. +Record NotionOfStructure (X : PreCategory) := { structure :> X -> Type }. +Record Smorphism (X : PreCategory) (P : NotionOfStructure X) (xa yb : { x : X & P x }) := { f : morphism X xa.1 yb.1 }. +Definition precategory_of_structures X (P : NotionOfStructure X) : PreCategory. +Proof. + refine (@Build_PreCategory _ (@Smorphism _ P)). +Defined. +Section sip. + Variable X : PreCategory. + Variable P : NotionOfStructure X. + + Let StrX := @precategory_of_structures X P. + + Definition sip_isotoid (xa yb : StrX) (f : xa <~=~> yb) : xa = yb. + admit. + Defined. + + Lemma structure_identity_principle_helper (xa yb : StrX) + (x : xa <~=~> yb) : Smorphism P xa yb. + Proof. + refine ((idtoiso (precategory_of_structures P) (sip_isotoid x) : @morphism _ _ _) : morphism _ _ _). +(* Toplevel input, characters 24-95: +Error: +In environment +X : PreCategory +P : NotionOfStructure X +StrX := precategory_of_structures P : PreCategory +xa : object StrX +yb : object StrX +x : xa <~=~> yb +The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb" +has type "@morphism (precategory_of_structures P) xa yb" +while it is expected to have type "morphism ?40 ?41 ?42". *) + Abort. +End sip. diff --git a/test-suite/bugs/closed/bug_3481.v b/test-suite/bugs/closed/bug_3481.v new file mode 100644 index 0000000000..41e1a8e959 --- /dev/null +++ b/test-suite/bugs/closed/bug_3481.v @@ -0,0 +1,67 @@ + +Set Implicit Arguments. + +Require Import Logic. +Module NonPrim. +Local Set Nonrecursive Elimination Schemes. +Record prodwithlet (A B : Type) : Type := + pair' { fst : A; fst' := fst; snd : B }. + +Definition letreclet (p : prodwithlet nat nat) := + let (x, x', y) := p in x + y. + +Definition pletreclet (p : prodwithlet nat nat) := + let 'pair' x x' y := p in x + y + x'. + +Definition pletreclet2 (p : prodwithlet nat nat) := + let 'pair' x y := p in x + y. + +Check (pair 0 0). +End NonPrim. + +Global Set Universe Polymorphism. +Global Set Asymmetric Patterns. +Local Set Nonrecursive Elimination Schemes. +Local Set Primitive Projections. + +Record prod (A B : Type) : Type := + pair { fst : A; snd : B }. + +Print prod_rect. + +(* What I really want: *) +Definition prod_rect' A B (P : prod A B -> Type) (u : forall (fst : A) (snd : B), P (pair fst snd)) + (p : prod A B) : P p + := u (fst p) (snd p). + +Definition conv : @prod_rect = @prod_rect'. +Proof. reflexivity. Defined. + +Definition imposs := + (fun A B P f (p : prod A B) => match p as p0 return P p0 with + | {| fst := x ; snd := x0 |} => f x x0 + end). + +Definition letrec (p : prod nat nat) := + let (x, y) := p in x + y. +Eval compute in letrec (pair 1 5). + +Goal forall p : prod nat nat, letrec p = fst p + snd p. +Proof. + reflexivity. + Undo. + intros p. + case p. simpl. unfold letrec. simpl. reflexivity. +Defined. + +Eval compute in conv. (* = eq_refl + : prod_rect = prod_rect' *) + +Check eq_refl : @prod_rect = @prod_rect'. (* Toplevel input, characters 6-13: +Error: +The term "eq_refl" has type "prod_rect = prod_rect" +while it is expected to have type "prod_rect = prod_rect'" +(cannot unify "prod_rect" and "prod_rect'"). *) + +Record sigma (A : Type) (B : A -> Type) : Type := + dpair { pi1 : A ; pi2 : B pi1 }. diff --git a/test-suite/bugs/closed/3482.v b/test-suite/bugs/closed/bug_3482.v index 87fd2723c9..87fd2723c9 100644 --- a/test-suite/bugs/closed/3482.v +++ b/test-suite/bugs/closed/bug_3482.v diff --git a/test-suite/bugs/closed/bug_3483.v b/test-suite/bugs/closed/bug_3483.v new file mode 100644 index 0000000000..970363f00a --- /dev/null +++ b/test-suite/bugs/closed/bug_3483.v @@ -0,0 +1,4 @@ +(* Check proper failing when using notation of non-constructors in + pattern-bmatching *) + +Fail Definition nonsense ( x : False ) := match x with y + 2 => 0 end. diff --git a/test-suite/bugs/closed/bug_3484.v b/test-suite/bugs/closed/bug_3484.v new file mode 100644 index 0000000000..aa25bde9cd --- /dev/null +++ b/test-suite/bugs/closed/bug_3484.v @@ -0,0 +1,31 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 14259 lines to 305 lines, then from 237 lines to 120 lines, then from 100 lines to 30 lines *) +Set Primitive Projections. +Set Implicit Arguments. +Record sigT (A : Type) (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation "{ x : A & P }" := (@sigT A (fun x : A => P)) : type_scope. +Notation pr1 := (@projT1 _ _). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Goal forall (T : Type) (H : { g : T & g = g }) (x : T), projT1 H = projT1 (existT (fun g : T => g = g) x idpath). +Proof. + intros. + let y := match goal with |- projT1 ?x = projT1 ?y => constr:(y) end in + apply (@ap _ _ pr1 _ y). + Undo. + Unset Printing Notations. + apply (ap pr1). + Undo. + refine (ap pr1 _). +admit. +Defined. + +(* Toplevel input, characters 22-28: +Error: +In environment +T : Type +H : sigT T (fun g : T => paths g g) +x : T +Unable to unify "paths (@projT1 ?24 ?23 ?25) (@projT1 ?24 ?23 ?26)" with + "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *) diff --git a/test-suite/bugs/closed/3485.v b/test-suite/bugs/closed/bug_3485.v index ede6b3cb27..ede6b3cb27 100644 --- a/test-suite/bugs/closed/3485.v +++ b/test-suite/bugs/closed/bug_3485.v diff --git a/test-suite/bugs/closed/3487.v b/test-suite/bugs/closed/bug_3487.v index 1321a8598c..1321a8598c 100644 --- a/test-suite/bugs/closed/3487.v +++ b/test-suite/bugs/closed/bug_3487.v diff --git a/test-suite/bugs/closed/bug_3490.v b/test-suite/bugs/closed/bug_3490.v new file mode 100644 index 0000000000..957736d0b9 --- /dev/null +++ b/test-suite/bugs/closed/bug_3490.v @@ -0,0 +1,27 @@ +Inductive T : Type := +| Var : nat -> T +| Arr : T -> T -> T. + +Inductive Tele : list T -> Type := +| Tnil : @Tele nil +| Tcons : forall ls, forall (t : @Tele ls) (l : T), @Tele (l :: ls). + +Fail Fixpoint TeleD (ls : list T) (t : Tele ls) {struct t} + : { x : Type & x -> nat -> Type } := + match t return { x : Type & x -> nat -> Type } with + | Tnil => @existT Type (fun x => x -> nat -> Type) unit (fun (_ : unit) (_ : nat) => unit) + | Tcons ls t' l => + let (result, get) := TeleD ls t' in + @existT Type (fun x => x -> nat -> Type) + { v : result & (fix TD (t : T) {struct t} := + match t with + | Var n => + get v n + | Arr a b => TD a -> TD b + end) l } + (fun x n => + match n return Type with + | 0 => projT2 x + | S n => get (projT1 x) n + end) + end. diff --git a/test-suite/bugs/closed/3491.v b/test-suite/bugs/closed/bug_3491.v index fd394ddbc3..fd394ddbc3 100644 --- a/test-suite/bugs/closed/3491.v +++ b/test-suite/bugs/closed/bug_3491.v diff --git a/test-suite/bugs/closed/bug_3495.v b/test-suite/bugs/closed/bug_3495.v new file mode 100644 index 0000000000..7b0883f910 --- /dev/null +++ b/test-suite/bugs/closed/bug_3495.v @@ -0,0 +1,19 @@ +Require Import RelationClasses. + +Axiom R : Prop -> Prop -> Prop. +Declare Instance : Reflexive R. + +Class bar := { x : False }. +Record foo := { a : Prop ; b : bar }. + +Definition default_foo (a0 : Prop) `{b : bar} : foo := {| a := a0 ; b := b |}. + +Goal exists k, R k True. +Proof. +eexists. +evar (b : bar). +let e := match goal with |- R ?e _ => constr:(e) end in +unify e (a (default_foo True)). +subst b. +reflexivity. +Abort. diff --git a/test-suite/bugs/closed/3505.v b/test-suite/bugs/closed/bug_3505.v index 2695bc796e..2695bc796e 100644 --- a/test-suite/bugs/closed/3505.v +++ b/test-suite/bugs/closed/bug_3505.v diff --git a/test-suite/bugs/closed/3509.v b/test-suite/bugs/closed/bug_3509.v index 8226622670..8226622670 100644 --- a/test-suite/bugs/closed/3509.v +++ b/test-suite/bugs/closed/bug_3509.v diff --git a/test-suite/bugs/closed/3510.v b/test-suite/bugs/closed/bug_3510.v index 4cbae33590..4cbae33590 100644 --- a/test-suite/bugs/closed/3510.v +++ b/test-suite/bugs/closed/bug_3510.v diff --git a/test-suite/bugs/closed/bug_3513.v b/test-suite/bugs/closed/bug_3513.v new file mode 100644 index 0000000000..462a615d91 --- /dev/null +++ b/test-suite/bugs/closed/bug_3513.v @@ -0,0 +1,74 @@ +(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *) +Require Coq.Setoids.Setoid. +Import Coq.Setoids.Setoid. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Class Equiv (A : Type) := equiv : relation A. +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Class ILogicOps Frm := { lentails: relation Frm; + ltrue: Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm }. +Infix "|--" := lentails (at level 79, no associativity). +Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. +Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. +Infix "-|-" := lequiv (at level 85, no associativity). +Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. +Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. + Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. +End ILogic_Fun. +Arguments ILFunFrm _ {e} _ {ILOps}. +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; + ltrue := True; + land P Q := P /\ Q; + lor P Q := P \/ Q |}. +Axiom Action : Set. +Definition Actions := list Action. +Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. +Definition OPred := ILFunFrm Actions Prop. +Local Existing Instance ILFun_Ops. +Local Existing Instance ILFun_ILogic. +Definition catOP (P Q: OPred) : OPred := admit. +Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. +apply admit. +Defined. +Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. +Class IsPointed (T : Type) := point : T. +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. +Existing Instance OPred_inhabited. +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. +Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) + (tr : T -> T) (O2 : PointedOPred) (x : T) + (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), + exists e1 e2, + catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. + intros; do 2 esplit. + rewrite <- catOPA. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) + (@Morphisms.respectful OPred (OPred -> OPred) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> + @lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP + catOP_entails_m_Proper a a' H b b' H') in + pose P; + refine (P _ _) + end; unfold Basics.flip. + Focus 2. + (* As in 8.5, allow a shelved subgoal to remain *) + apply reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_3520.v b/test-suite/bugs/closed/bug_3520.v new file mode 100644 index 0000000000..01bf6667f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3520.v @@ -0,0 +1,9 @@ +Set Primitive Projections. + +Record foo (A : Type) := + { bar : Type ; baz := Set; bad : baz = bar }. + +Set Nonrecursive Elimination Schemes. + +Record notprim : Prop := + { irrel : True; relevant : nat }. diff --git a/test-suite/bugs/closed/bug_3531.v b/test-suite/bugs/closed/bug_3531.v new file mode 100644 index 0000000000..552092bc39 --- /dev/null +++ b/test-suite/bugs/closed/bug_3531.v @@ -0,0 +1,54 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 270 lines to +198 lines, then from 178 lines to 82 lines, then from 88 lines to 59 lines *) +(* coqc version trunk (August 2014) compiled on Aug 19 2014 14:40:15 with OCaml +4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(56ece74efc25af1b0e09265f3c7fcf74323abcaf) *) +Require Import Coq.Lists.List. +Set Implicit Arguments. +Definition mem := nat -> option nat. +Definition pred := mem -> Prop. +Delimit Scope pred_scope with pred. +Definition exis A (p : A -> pred) : pred := fun m => exists x, p x m. +Notation "'exists' x .. y , p" := (exis (fun x => .. (exis (fun y => p)) ..)) : +pred_scope. +Definition emp : pred := fun m => forall a, m a = None. +Definition lift_empty (P : Prop) : pred := fun m => P /\ forall a, m a = None. +Notation "[[ P ]]" := (lift_empty P) : pred_scope. +Definition pimpl (p q : pred) := forall m, p m -> q m. +Notation "p ==> q" := (pimpl p%pred q%pred) (right associativity, at level 90). +Definition piff (p q : pred) : Prop := (p ==> q) /\ (q ==> p). +Notation "p <==> q" := (piff p%pred q%pred) (at level 90). +Parameter sep_star : pred -> pred -> pred. +Infix "*" := sep_star : pred_scope. +Definition memis (m : mem) : pred := eq m. +Definition mptsto (m : mem) (a : nat) (v : nat) := m a = Some v. +Notation "m @ a |-> v" := (mptsto m a v) (a at level 34, at level 35). +Lemma piff_trans: forall a b c, (a <==> b) -> (b <==> c) -> (a <==> c). +Admitted. +Lemma piff_refl: forall a, (a <==> a). +Admitted. +Definition stars (ps : list pred) := fold_left sep_star ps emp. +Lemma flatten_exists: forall T PT p ps P, + (forall (a:T), (p a <==> exists (x:PT), stars (ps a x) * [[P a x]])) + -> (exists (a:T), p a) <==> + (exists (x:(T*PT)), stars (ps (fst x) (snd x)) * [[P (fst x) (snd x)]]). +Admitted. +Goal forall b, (exists e1 e2 e3, + (exists (m : mem) (v : nat) (F : pred), b) + <==> (exists x : e1, stars (e2 x) * [[e3 x]])). + intros. + Set Printing Universes. + Show Universes. + do 3 eapply ex_intro. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + eapply piff_trans; [ apply flatten_exists | apply piff_refl ]; intros. + assert (H : False) by (clear; admit); destruct H. + Grab Existential Variables. + admit. + admit. + admit. + Show Universes. +Time Qed. diff --git a/test-suite/bugs/closed/3537.v b/test-suite/bugs/closed/bug_3537.v index 158642f01d..158642f01d 100644 --- a/test-suite/bugs/closed/3537.v +++ b/test-suite/bugs/closed/bug_3537.v diff --git a/test-suite/bugs/closed/bug_3539.v b/test-suite/bugs/closed/bug_3539.v new file mode 100644 index 0000000000..3796a7b308 --- /dev/null +++ b/test-suite/bugs/closed/bug_3539.v @@ -0,0 +1,67 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 11678 lines to 11330 lines, then from 10721 lines to 9544 lines, then from 9549 lines to 794 lines, then from 810 lines to 785 lines, then from 628 lines to 246 lines, then from 220 lines to 89 lines, then from 80 lines to 47 lines *) +(* coqc version trunk (August 2014) compiled on Aug 22 2014 4:17:28 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (a67cc6941434124465f20b14a1256f2ede31a60e) *) + +Set Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := match p with idpath => u end. +Local Set Primitive Projections. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Axiom path_prod : forall {A B : Type} (z z' : A * B), (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Axiom transport_path_prod : forall A B (P : A * B -> Type) (x y : A * B) (HA : fst x = fst y) (HB : snd x = snd y) Px, + transport P (path_prod _ _ HA HB) Px + = transport (fun x => P (x, snd y)) HA (transport (fun y => P (fst x, y)) HB Px). +Goal forall (T0 : Type) (snd1 snd0 f : T0) (p : @paths T0 f snd0) + (f0 : T0) (p1 : @paths T0 f0 snd1) (T1 : Type) + (fst1 fst0 : T1) (p0 : @paths T1 fst0 fst0) (p2 : @paths T1 fst1 fst1) + (T : Type) (x2 : T) (T2 : Type) (T3 : forall (_ : T2) (_ : T2), Type) + (x' : forall (_ : T1) (_ : T), T2) (m : T3 (x' fst1 x2) (x' fst0 x2)), + @paths (T3 (x' fst1 x2) (x' fst0 x2)) + (@transport (prod T1 T0) + (fun x : prod T1 T0 => + T3 (x' fst1 x2) (x' (fst x) x2)) + (@pair T1 T0 fst0 f) (@pair T1 T0 fst0 snd0) + (@path_prod T1 T0 (@pair T1 T0 fst0 f) + (@pair T1 T0 fst0 snd0) p0 p) + (@transport (prod T1 T0) + (fun x : prod T1 T0 => + T3 (x' (fst x) x2) (x' fst0 x2)) + (@pair T1 T0 fst1 f0) (@pair T1 T0 fst1 snd1) + (@path_prod T1 T0 (@pair T1 T0 fst1 f0) + (@pair T1 T0 fst1 snd1) p2 p1) m)) m. + intros. + match goal with + | [ |- context[transport ?P (path_prod ?x ?y ?HA ?HB) ?Px] ] + => rewrite (transport_path_prod P x y HA HB Px) + end || fail "bad". + Undo. + Set Printing All. + rewrite transport_path_prod. (* Toplevel input, characters 15-43: +Error: +In environment +T0 : Type +snd1 : T0 +snd0 : T0 +f : T0 +p : @paths T0 f snd0 +f0 : T0 +p1 : @paths T0 f0 snd1 +T1 : Type +fst1 : T1 +fst0 : T1 +p0 : @paths T1 fst0 fst0 +p2 : @paths T1 fst1 fst1 +T : Type +x2 : T +T2 : Type +T3 : forall (_ : T2) (_ : T2), Type +x' : forall (_ : T1) (_ : T), T2 +m : T3 (x' fst1 x2) (x' fst0 x2) +Unable to unify "?25 (@pair ?23 ?24 (fst ?27) (snd ?27))" with +"?25 ?27". + *) +Abort. diff --git a/test-suite/bugs/closed/bug_3542.v b/test-suite/bugs/closed/bug_3542.v new file mode 100644 index 0000000000..e9a8460622 --- /dev/null +++ b/test-suite/bugs/closed/bug_3542.v @@ -0,0 +1,8 @@ +Section foo. + Context {A:Type} {B : A -> Type}. + Context (f : forall x, B x). + Goal True. + pose (r := fun k => existT (fun g => forall x, f x = g x) + (fun x => projT1 (k x)) (fun x => projT2 (k x))). + Abort. +End foo. diff --git a/test-suite/bugs/closed/bug_3546.v b/test-suite/bugs/closed/bug_3546.v new file mode 100644 index 0000000000..88724a52fc --- /dev/null +++ b/test-suite/bugs/closed/bug_3546.v @@ -0,0 +1,18 @@ +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {_ _} _ _. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Definition ap11 {A B} {f g:A->B} (h:f=g) {x y:A} (p:x=y) : f x = g y. +Admitted. +Goal forall x y z w : Set, (x, y) = (z, w). +Proof. + intros. + apply ap11. (* Toplevel input, characters 21-25: +Error: In environment +x : Set +y : Set +z : Set +w : Set +Unable to unify "?31 ?191 = ?32 ?192" with "(x, y) = (z, w)". + *) +Abort. diff --git a/test-suite/bugs/closed/bug_3554.v b/test-suite/bugs/closed/bug_3554.v new file mode 100644 index 0000000000..2c88b79bc8 --- /dev/null +++ b/test-suite/bugs/closed/bug_3554.v @@ -0,0 +1,2 @@ +Example foo (f : forall {_ : Type}, Type) : Type. +Abort. diff --git a/test-suite/bugs/closed/bug_3559.v b/test-suite/bugs/closed/bug_3559.v new file mode 100644 index 0000000000..e26945c3bb --- /dev/null +++ b/test-suite/bugs/closed/bug_3559.v @@ -0,0 +1,88 @@ +Unset Strict Universe Declaration. +(* File reduced by coq-bug-finder from original input, then from 8657 lines to +4731 lines, then from 4174 lines to 192 lines, then from 161 lines to 55 lines, +then from 51 lines to 37 lines, then from 43 lines to 30 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml +4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Require Import Coq.Init.Notations. +Set Universe Polymorphism. +Generalizable All Variables. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {_ _} _ _. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x <-> y" (at level 95, no associativity). +Reserved Notation "x = y" (at level 70, no associativity). +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Open Scope type_scope. + +Definition iff A B := prod (A -> B) (B -> A). +Infix "<->" := iff : type_scope. +Inductive paths {A : Type@{i}} (a : A) : A -> Type@{i} := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Class Contr_internal (A : Type) := { center : A ; contr : (forall y : A, center += y) }. +Inductive trunc_index : Type := minus_two | trunc_S (_ : trunc_index). +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type@{i}) : Type@{i} := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. +Notation minus_one:=(trunc_S minus_two). +Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : +IsTrunc_internal n A. +Instance istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) : +IsTrunc n (x = y) := H x y. + +Axiom cheat : forall {A}, A. + +Lemma paths_lift (A : Type@{i}) (x y : A) (p : x = y) : paths@{j} x y. +Proof. + destruct p. apply idpath. +Defined. + +Lemma paths_change (A : Type@{i}) (x y : A) : paths@{j} x y = paths@{i} x y. +Proof. (* require Univalence *) + apply cheat. +Defined. + +Lemma IsTrunc_lift (n : trunc_index) : + forall (A : Type@{i}), IsTrunc_internal@{i} n A -> IsTrunc_internal@{j} n A. +Proof. + induction n; simpl; intros. + destruct X. exists center0. intros. apply (paths_lift _ _ _ (contr0 y)). + + rewrite paths_change. + apply IHn, X. +Defined. + +Notation IsHProp := (IsTrunc minus_one). +(* Record hProp := hp { hproptype :> Type ; isp : IsTrunc minus_one hproptype}. *) +(* Make the truncation proof polymorphic, i.e., available at any level greater or equal + to the carrier type level j *) +Record hProp := hp { hproptype :> Type@{j} ; isp : IsTrunc minus_one hproptype}. +Axiom path_iff_hprop_uncurried : forall `{IsHProp A, IsHProp B}, (A <-> B) -> A += B. +Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V. +Axiom is0trunc_V : IsTrunc (trunc_S (trunc_S minus_two)) V. +Existing Instance is0trunc_V. +Axiom bisimulation : V@{U' U} -> V@{U' U} -> hProp@{U'}. +Axiom bisimulation_refl : forall (v : V), bisimulation v v. +Axiom bisimulation_eq : forall (u v : V), bisimulation u v -> u = v. +Notation "u ~~ v" := (bisimulation u v) (at level 30). +Lemma bisimulation_equals_id : forall u v : V@{i j}, (u = v) = (u ~~ v). +Proof. + intros u v. + refine (@path_iff_hprop_uncurried _ _ _ _ _). +(* path_iff_hprop_uncurried : *) +(* forall A : Type@{Top.74}, *) +(* IsHProp A -> forall B : Type@{Top.74}, IsHProp B -> A <-> B -> A = B *) +(* (* Top.74 *) +(* Top.78 |= Top.74 < Top.78 *) +(* *) *) + + Show Universes. + exact (isp _). + split; intros. destruct X. apply bisimulation_refl. + apply bisimulation_eq, X. +Defined. diff --git a/test-suite/bugs/closed/3560.v b/test-suite/bugs/closed/bug_3560.v index a740675f30..a740675f30 100644 --- a/test-suite/bugs/closed/3560.v +++ b/test-suite/bugs/closed/bug_3560.v diff --git a/test-suite/bugs/closed/bug_3561.v b/test-suite/bugs/closed/bug_3561.v new file mode 100644 index 0000000000..7485c697f2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3561.v @@ -0,0 +1,25 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6343 lines to 2362 lines, then from 2115 lines to 303 lines, then from 321 lines to 90 lines, then from 95 lines to 41 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing). +Lemma ap_transport {A} {P Q : A -> Type} {x y : A} (p : x = y) (f : forall x, P x -> Q x) (z : P x) : + f y (p # z) = (p # (f x z)). +Proof. admit. +Defined. +Lemma foo A B (f : A * B -> A) : f = f. +Admitted. +Goal forall (H0 H2 : Type) x p, + @transport (prod H0 H2) + (fun GO : prod H0 H2 => x (fst GO)) = p. + intros. + match goal with + | [ |- context[x (?f _)] ] => set(foo':=f) + end. +Abort. diff --git a/test-suite/bugs/closed/bug_3562.v b/test-suite/bugs/closed/bug_3562.v new file mode 100644 index 0000000000..bdb3fcb65f --- /dev/null +++ b/test-suite/bugs/closed/bug_3562.v @@ -0,0 +1,7 @@ +(* Should not be an anomaly as it was at some time in + September/October 2014 but some "Disjunctive/conjunctive + introduction pattern expected" error *) + +Theorem t: True. +Fail destruct 0 as x. +Abort. diff --git a/test-suite/bugs/closed/bug_3563.v b/test-suite/bugs/closed/bug_3563.v new file mode 100644 index 0000000000..f6a84933b7 --- /dev/null +++ b/test-suite/bugs/closed/bug_3563.v @@ -0,0 +1,39 @@ +(* File reduced by coq-bug-finder from original input, then from 11716 lines to 11295 lines, then from 10518 lines to 21 lines, then \ +from 37 lines to 21 lines *) +(* coqc version trunk (August 2014) compiled on Aug 31 2014 10:12:32 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (437b91a3ffd7327975a129b95b24d3f66ad7f3e4) *) +Set Primitive Projections. +Record prod A B := pair { fst : A ; snd : B }. +Arguments pair {A B} _ _. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0) + (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = + H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2))), + transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7. + intros. + match goal with + | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ] + => set(foo:=h); idtac + end. + match goal with + | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ] + => idtac + end. +Abort. +Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0) + (H4 : (fun c : H1 => (fst (H3 c), snd (H3 c))%core) = + H3) (H5 : H -> Type) (H6 H7 : H5 (fst (H3 H2) H2)), + transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7. + intros. + match goal with + | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ] + => set(foo:=X) + end. +(* Anomaly: Uncaught exception Not_found(_). Please report. *) + +(* Anomaly: Uncaught exception Not_found(_). Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3566.v b/test-suite/bugs/closed/bug_3566.v new file mode 100644 index 0000000000..1255f0640f --- /dev/null +++ b/test-suite/bugs/closed/bug_3566.v @@ -0,0 +1,24 @@ +Unset Strict Universe Declaration. +Notation idmap := (fun x => x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Delimit Scope path_scope with path. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3, format "p '^'") : path_scope. +Class IsEquiv {A B : Type} (f : A -> B) := {}. +Axiom path_universe : forall {A B : Type} (f : A -> B) {feq : IsEquiv f}, (A = B). + +Definition Lift : Type@{i} -> Type@{j} + := Eval hnf in let lt := Type@{i} : Type@{j} in fun T => T. + +Definition lift {T} : T -> Lift T := fun x => x. + +Goal forall x y : Type, x = y. + intros. + pose proof ((fun H0 : idmap _ => (@path_universe _ _ (@lift x) (H0 x) @ + (@path_universe _ _ (@lift x) (H0 x))^)))%path as H''. +Abort. diff --git a/test-suite/bugs/closed/bug_3567.v b/test-suite/bugs/closed/bug_3567.v new file mode 100644 index 0000000000..be05bb9453 --- /dev/null +++ b/test-suite/bugs/closed/bug_3567.v @@ -0,0 +1,69 @@ + +(* File reduced by coq-bug-finder from original input, then from 2901 lines to 69 lines, then from 80 lines to 63 lines *) +(* coqc version trunk (September 2014) compiled on Sep 2 2014 2:7:1 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3c5daf4e23ee20f0788c0deab688af452e83ccf0) *) + +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Add Printing Let prod. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Unset Implicit Arguments. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := + { equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) }. +Definition path_prod_uncurried {A B : Type} (z z' : A * B) (pq : (fst z = fst z') * (snd z = snd z')) +: (z = z') + := match fst pq in (_ = z'1), snd pq in (_ = z'2) return z = (z'1, z'2) with + | idpath, idpath => idpath + end. +Definition path_prod {A B : Type} (z z' : A * B) : + (fst z = fst z') -> (snd z = snd z') -> (z = z') + := fun p q => path_prod_uncurried z z' (p,q). +Definition path_prod' {A B : Type} {x x' : A} {y y' : B} +: (x = x') -> (y = y') -> ((x,y) = (x',y')) + := fun p q => path_prod (x,y) (x',y') p q. +Axiom ap_fst_path_prod : forall {A B : Type} {z z' : A * B} + (p : fst z = fst z') (q : snd z = snd z'), + ap fst (path_prod _ _ p q) = p. +Axiom ap_snd_path_prod : forall {A B : Type} {z z' : A * B} + (p : fst z = fst z') (q : snd z = snd z'), + ap snd (path_prod _ _ p q) = q. +Axiom eta_path_prod : forall {A B : Type} {z z' : A * B} (p : z = z'), + path_prod _ _(ap fst p) (ap snd p) = p. +Definition isequiv_path_prod {A B : Type} {z z' : A * B} : IsEquiv (path_prod_uncurried z z'). +Proof. + refine (Build_IsEquiv + _ _ _ + (fun r => (ap fst r, ap snd r)) + eta_path_prod + (fun pq => match pq with + | (p,q) => path_prod' + (ap_fst_path_prod p q) (ap_snd_path_prod p q) + end) _). + destruct z as [x y], z' as [x' y']. simpl. +(* Toplevel input, characters 15-50: +Error: Abstracting over the term "z" leads to a term +fun z0 : A * B => +forall x : (fst z0 = fst z') * (snd z0 = snd z'), +eta_path_prod (path_prod_uncurried z0 z' x) = +ap (path_prod_uncurried z0 z') + (let (p, q) as pq + return + ((ap (fst) (path_prod_uncurried z0 z' pq), + ap (snd) (path_prod_uncurried z0 z' pq)) = pq) := x in + path_prod' (ap_fst_path_prod p q) (ap_snd_path_prod p q)) +which is ill-typed. +Reason is: Pattern-matching expression on an object of inductive type prod +has invalid information. + *) +Abort. diff --git a/test-suite/bugs/closed/3584.v b/test-suite/bugs/closed/bug_3584.v index 37fe46376e..37fe46376e 100644 --- a/test-suite/bugs/closed/3584.v +++ b/test-suite/bugs/closed/bug_3584.v diff --git a/test-suite/bugs/closed/bug_3590.v b/test-suite/bugs/closed/bug_3590.v new file mode 100644 index 0000000000..2f15aa9ea1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3590.v @@ -0,0 +1,12 @@ +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Definition idS := Set. +Goal forall x y : prod Set Set, forall H : fst x = fst y, fst x = fst y. + intros. + change (@fst _ _ ?z) with (@fst Set idS z) at 2. + apply H. +Qed. + +(* Toplevel input, characters 20-58: +Error: Failed to get enough information from the left-hand side to type the +right-hand side. *) diff --git a/test-suite/bugs/closed/bug_3593.v b/test-suite/bugs/closed/bug_3593.v new file mode 100644 index 0000000000..0d7e93ee02 --- /dev/null +++ b/test-suite/bugs/closed/bug_3593.v @@ -0,0 +1,10 @@ +Set Universe Polymorphism. +Set Printing All. +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Goal forall x : prod Set Set, let f := @fst _ in f _ x = @fst _ _ x. +simpl; intros. + constr_eq (@fst Set Set x) (fst (A := Set) (B := Set) x). + Fail progress change (@fst Set Set x) with (fst (A := Set) (B := Set) x). + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3594.v b/test-suite/bugs/closed/bug_3594.v new file mode 100644 index 0000000000..221fc99bfa --- /dev/null +++ b/test-suite/bugs/closed/bug_3594.v @@ -0,0 +1,51 @@ +(* File reduced by coq-bug-finder from original input, then from 8752 lines to 735 lines, then from 735 lines to 310 lines, then from 228 lines to 105 lines, then from 98 lines to 41 lines *) +(* coqc version trunk (September 2014) compiled on Sep 6 2014 6:15:6 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (3ea6d6888105edd5139ae0a4d8f8ecdb586aff6c) *) +Notation idmap := (fun x => x). +Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), (forall x, f x = g x) -> f = g. +Local Set Primitive Projections. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Bind Scope category_scope with PreCategory. +Set Implicit Arguments. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := {}. +Definition opposite (C : PreCategory) : PreCategory := @Build_PreCategory C (fun s d => morphism C d s). +Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. +Definition oppositeF C D (F : Functor C D) : Functor C^op D^op := Build_Functor (C^op) (D^op). +Local Notation "F ^op" := (oppositeF F) (at level 3, format "F ^op") : functor_scope. +Axiom oppositeF_involutive : forall C D (F : Functor C D), ((F^op)^op)%functor = F. +Local Open Scope functor_scope. +Goal forall C D : PreCategory, + (fun c : Functor C^op D^op => (c^op)^op) = idmap. + intros. + exact (path_forall (fun F : Functor C^op D^op => (F^op)^op) _ (@oppositeF_involutive _ _)). + Undo. + Unset Printing Notations. + Set Debug Unification. +(* Check (eq_refl : Build_PreCategory (opposite D).(object) *) +(* (fun s d : (opposite D).(object) => *) +(* (opposite D).(morphism) d s) = *) +(* @Build_PreCategory D (fun s d => morphism D d s)). *) +(* opposite D). *) + exact (path_forall (fun F => (F^op)^op) _ (@oppositeF_involutive _ _)). +Qed. + (* Toplevel input, characters 22-101: +Error: +In environment +C : PreCategory +D : PreCategory +The term + "path_forall + (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) + (fun F : Functor (opposite C) (opposite D) => F) + (oppositeF_involutive (D:=opposite D))" has type + "eq (fun F : Functor (opposite C) (opposite D) => oppositeF (oppositeF F)) + (fun F : Functor (opposite C) (opposite D) => F)" +while it is expected to have type + "eq (fun c : Functor (opposite C) (opposite D) => oppositeF (oppositeF c)) + (fun x : Functor (opposite C) (opposite D) => x)" +(cannot unify "{| + object := opposite D; + morphism := fun s d : opposite D => morphism (opposite D) d s |}" +and "opposite D"). + *) diff --git a/test-suite/bugs/closed/bug_3596.v b/test-suite/bugs/closed/bug_3596.v new file mode 100644 index 0000000000..69db360838 --- /dev/null +++ b/test-suite/bugs/closed/bug_3596.v @@ -0,0 +1,19 @@ +Require Import TestSuite.admit. +Set Implicit Arguments. +Record foo := { fx : nat }. +Set Primitive Projections. +Record bar := { bx : nat }. +Definition Foo (f : foo) : f = f. + destruct f as [fx]; destruct fx; admit. +Defined. +Definition Bar (b : bar) : b = b. + destruct b as [fx]; destruct fx; admit. +Defined. +Goal forall f b, Bar b = Bar b -> Foo f = Foo f. + intros f b. + destruct f, b. + simpl. + Fail progress unfold Bar. (* success *) + Fail progress unfold Foo. (* failed to progress *) + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_3612.v b/test-suite/bugs/closed/bug_3612.v new file mode 100644 index 0000000000..b6dcd55346 --- /dev/null +++ b/test-suite/bugs/closed/bug_3612.v @@ -0,0 +1,55 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter" "-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 3595 lines to 3518 lines, then from 3133 lines to 2950 lines, then from 2911 lines to 415 lines, then from 431 lines to 407 \ +lines, then from 421 lines to 428 lines, then from 444 lines to 429 lines, then from 434 lines to 66 lines, then from 163 lines to 48 lines *) +(* coqc version trunk (September 2014) compiled on Sep 11 2014 14:48:8 with OCaml 4.01.0 + coqtop version cagnode17:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (580b25e05c7cc9e7a31430b3d9edb14ae12b7598) *) +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x = y :> T" (at level 70, y at next level, no associativity). +Reserved Notation "x = y" (at level 70, no associativity). +Delimit Scope type_scope with type. +Bind Scope type_scope with Sortclass. +Open Scope type_scope. +Global Set Universe Polymorphism. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Generalizable All Variables. +Local Set Primitive Projections. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Arguments projT1 {A P} _ / . +Arguments projT2 {A P} _ / . +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y . +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Local Open Scope path_scope. +Axiom pr1_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), u.1 = v.1. +Notation "p ..1" := (pr1_path p) (at level 3) : fibration_scope. +Axiom pr2_path : forall `{P : A -> Type} {u v : sigT P} (p : u = v), p..1 # u.2 = v.2. +Notation "p ..2" := (pr2_path p) (at level 3) : fibration_scope. +Axiom path_path_sigma : forall {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (r : p..1 = q..1) + (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2), +p = q. + +Declare ML Module "ltac_plugin". + +Set Default Proof Mode "Classic". + +Goal forall (A : Type) (B : forall _ : A, Type) (x : @sigT A (fun x : A => B x)) + (xx : @paths (@sigT A (fun x0 : A => B x0)) x x), + @paths (@paths (@sigT A (fun x0 : A => B x0)) x x) xx + (@idpath (@sigT A (fun x0 : A => B x0)) x). + intros A B x xx. + Set Printing All. + change (fun x => B x) with B in xx. + pose (path_path_sigma B x x xx) as x''. + clear x''. + Check (path_path_sigma B x x xx). +Abort. diff --git a/test-suite/bugs/closed/bug_3616.v b/test-suite/bugs/closed/bug_3616.v new file mode 100644 index 0000000000..bb501f158c --- /dev/null +++ b/test-suite/bugs/closed/bug_3616.v @@ -0,0 +1,4 @@ +(* Was failing from April 2014 to September 2014 because of injection *) +Goal forall P e es t, (e :: es = existT P tt t :: es)%list -> True. +inversion 1. +Abort. diff --git a/test-suite/bugs/closed/bug_3618.v b/test-suite/bugs/closed/bug_3618.v new file mode 100644 index 0000000000..4b5171c082 --- /dev/null +++ b/test-suite/bugs/closed/bug_3618.v @@ -0,0 +1,103 @@ +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition concat {A} {x y z : A} : x = y -> y = z -> x = z. Admitted. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x. Admitted. +Notation "p @ q" := (concat p q) (at level 20). +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y. Admitted. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y. Admitted. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : forall x, f (equiv_inv x) = x; + eissect : forall x, equiv_inv (f x) = x +}. + +Class Contr_internal (A : Type). + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | minus_two => Contr_internal A + | trunc_S n' => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. +Definition istrunc_paths (A : Type) n `{H : IsTrunc (trunc_S n) A} (x y : A) +: IsTrunc n (x = y). +Admitted. + +Hint Extern 4 (IsTrunc _ (_ = _)) => eapply @istrunc_paths : typeclass_instances. + +Class Funext. + +Instance isequiv_compose A B C f g `{IsEquiv A B f} `{IsEquiv B C g} + : IsEquiv (compose g f) | 1000. +Admitted. + +Section IsEquivHomotopic. + Context (A B : Type) `(f : A -> B) `(g : A -> B) `{IsEquiv A B f} (h : forall x:A, f x = g x). + Let sect := (fun b:B => inverse (h (@equiv_inv _ _ f _ b)) @ @eisretr _ _ f _ b). + Let retr := (fun a:A => inverse (ap (@equiv_inv _ _ f _) (h a)) @ @eissect _ _ f _ a). + Global Instance isequiv_homotopic : IsEquiv g | 10000 + := ( BuildIsEquiv _ _ g (@equiv_inv _ _ f _) sect retr). +End IsEquivHomotopic. + +Instance trunc_succ A n `{IsTrunc n A} : IsTrunc (trunc_S n) A | 1000. Admitted. + +Global Instance trunc_forall A n `{P : A -> Type} `{forall a, IsTrunc n (P a)} + : IsTrunc n (forall a, P a) | 100. +Admitted. + +Instance trunc_prod A B n `{IsTrunc n A} `{IsTrunc n B} : IsTrunc n (A * B) | 100. +Admitted. + +Global Instance trunc_arrow n {A B : Type} `{IsTrunc n B} : IsTrunc n (A -> B) | 100. +Admitted. + +Instance isequiv_pr1_contr {A} {P : A -> Type} `{forall a, IsTrunc minus_two (P a)} +: IsEquiv (@projT1 A P) | 100. +Admitted. + +Instance trunc_sigma n A `{P : A -> Type} `{IsTrunc n A} `{forall a, IsTrunc n (P a)} +: IsTrunc n (sigT P) | 100. +Admitted. + +Global Instance trunc_trunc `{Funext} A m n : IsTrunc (trunc_S n) (IsTrunc m A) | 0. +Admitted. + +Definition BiInv {A B} (f : A -> B) : Type +:= ( {g : B -> A & forall x, g (f x) = x} * {h : B -> A & forall x, f (h x) = x}). + +Global Instance isprop_biinv {A B} (f : A -> B) : IsTrunc (trunc_S minus_two) (BiInv f) | 0. +Admitted. + +Instance isequiv_path {A B : Type} (p : A = B) +: IsEquiv (transport (fun X:Type => X) p) | 0. +Admitted. + +Class ReflectiveSubuniverse_internal := + { inO_internal : Type -> Type ; + O : Type -> Type ; + O_unit : forall T, T -> O T }. + +Class ReflectiveSubuniverse := + ReflectiveSubuniverse_wrap : Funext -> ReflectiveSubuniverse_internal. +Global Existing Instance ReflectiveSubuniverse_wrap. + +Class inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) := + isequiv_inO : inO_internal T. + +Global Instance hprop_inO {fs : Funext} {subU : ReflectiveSubuniverse} (T : Type) : IsTrunc (trunc_S minus_two) (inO T) . +Admitted. + +(* To avoid looping class resolution *) +Hint Mode IsEquiv - - + : typeclass_instances. + +Fail Definition equiv_O_rectnd {fs : Funext} {subU : ReflectiveSubuniverse} + (P Q : Type) {Q_inO : inO_internal Q} +: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _. diff --git a/test-suite/bugs/closed/3623.v b/test-suite/bugs/closed/bug_3623.v index 202b900164..202b900164 100644 --- a/test-suite/bugs/closed/3623.v +++ b/test-suite/bugs/closed/bug_3623.v diff --git a/test-suite/bugs/closed/3624.v b/test-suite/bugs/closed/bug_3624.v index 024243cfd3..024243cfd3 100644 --- a/test-suite/bugs/closed/3624.v +++ b/test-suite/bugs/closed/bug_3624.v diff --git a/test-suite/bugs/closed/3625.v b/test-suite/bugs/closed/bug_3625.v index d4b2cc5ccc..d4b2cc5ccc 100644 --- a/test-suite/bugs/closed/3625.v +++ b/test-suite/bugs/closed/bug_3625.v diff --git a/test-suite/bugs/closed/3628.v b/test-suite/bugs/closed/bug_3628.v index 4001cf7c2b..4001cf7c2b 100644 --- a/test-suite/bugs/closed/3628.v +++ b/test-suite/bugs/closed/bug_3628.v diff --git a/test-suite/bugs/closed/bug_3633.v b/test-suite/bugs/closed/bug_3633.v new file mode 100644 index 0000000000..7a82a2685e --- /dev/null +++ b/test-suite/bugs/closed/bug_3633.v @@ -0,0 +1,10 @@ +Set Typeclasses Strict Resolution. +Class Contr (A : Type) := { center : A }. +Definition foo {A} `{Contr A} : A. +Proof. + apply center. + Undo. + (* Ensure the constraints are solved independently, otherwise a frozen ?A + makes a search for Contr ?A fail when finishing to apply (fun x => x) *) + apply (fun x => x), center. +Qed. diff --git a/test-suite/bugs/closed/3637.v b/test-suite/bugs/closed/bug_3637.v index 868f45c89a..868f45c89a 100644 --- a/test-suite/bugs/closed/3637.v +++ b/test-suite/bugs/closed/bug_3637.v diff --git a/test-suite/bugs/closed/bug_3638.v b/test-suite/bugs/closed/bug_3638.v new file mode 100644 index 0000000000..4545738837 --- /dev/null +++ b/test-suite/bugs/closed/bug_3638.v @@ -0,0 +1,26 @@ +(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from 104 lines to 28 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Primitive Projections. +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. +Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. +Global Existing Instance rsubu_usubu. +Context {subU : ReflectiveSubuniverse}. +Goal forall (A B : Type) (x : O A * O B) (x0 : B), + { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) + (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = + g x0 }. + eexists. + Show Existentials. Set Printing Existential Instances. + match goal with + | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in set (e' := e) + end. + + +(* Toplevel input, characters 15-114: +Anomaly: Bad recursive type. Please report. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3640.v b/test-suite/bugs/closed/bug_3640.v new file mode 100644 index 0000000000..d0d634bea5 --- /dev/null +++ b/test-suite/bugs/closed/bug_3640.v @@ -0,0 +1,32 @@ +(* File reduced by coq-bug-finder from original input, then from 14990 lines to 70 lines, then from 44 lines to 29 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} P := existT { pr1 : A ; pr2 : P pr1 }. +Notation "{ x : A & P }" := (sigT (A := A) (fun x : A => P)) : type_scope. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'"). +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'"). +Record Equiv A B := { equiv_fun :> A -> B }. +Notation "A <~> B" := (Equiv A B) (at level 85). +Inductive Bool : Type := true | false. +Definition negb (b : Bool) := if b then false else true. +Axiom eval_bool_isequiv : forall (f : Bool -> Bool), f false = negb (f true). +Lemma bool_map_equiv_not_idmap (f : { f : Bool <~> Bool & ~(forall x, f x = x) }) +: forall b, ~(f.1 b = b). +Proof. + intro b. + intro H''. + apply f.2. + intro b'. + pose proof (eval_bool_isequiv f.1) as H. + destruct b', b. + Fail match type of H with + | _ = negb (f.1 true) => fail 1 "no f.1 true" + end. (* Error: No matching clauses for match. *) + destruct (f.1 true). + simpl in *. + Fail match type of H with + | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true" + end. (* Error: Tactic failure: still has f.1 true. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3641.v b/test-suite/bugs/closed/bug_3641.v new file mode 100644 index 0000000000..eefec04851 --- /dev/null +++ b/test-suite/bugs/closed/bug_3641.v @@ -0,0 +1,22 @@ +(* File reduced by coq-bug-finder from original input, then from 7593 lines to 243 lines, then from 256 lines to 102 lines, then from\ + 104 lines to 28 lines *) +(* coqc version trunk (September 2014) compiled on Sep 17 2014 0:22:30 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d34e1eed232c84590ddb80d70db9f7f7cf13584a) *) +Set Implicit Arguments. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. +Class UnitSubuniverse := { O : Type -> Type ; O_unit : forall T, T -> O T }. +Class ReflectiveSubuniverse := { rsubu_usubu : UnitSubuniverse ; O_rectnd : forall {P Q : Type} (f : P -> Q), O P -> Q }. +Global Existing Instance rsubu_usubu. +Context {subU : ReflectiveSubuniverse}. +Goal forall (A B : Type) (x : O A * O B) (x0 : B), + { g : _ & O_rectnd (fun z : A * B => (O_unit (fst z), O_unit (snd z))) + (O_rectnd (fun a : A => O_unit (a, x0)) (fst x)) = + g x0 }. + eexists. + match goal with + | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e) + end. + Fail change ?g with e'. (* Stack overflow *) +Abort. diff --git a/test-suite/bugs/closed/bug_3647.v b/test-suite/bugs/closed/bug_3647.v new file mode 100644 index 0000000000..80dd99709a --- /dev/null +++ b/test-suite/bugs/closed/bug_3647.v @@ -0,0 +1,655 @@ +Require Import TestSuite.admit. +Require Coq.Setoids.Setoid. + +Axiom BITS : nat -> Set. +Definition n7 := 7. +Definition n15 := 15. +Definition n31 := 31. +Notation n8 := (S n7). +Notation n16 := (S n15). +Notation n32 := (S n31). +Inductive OpSize := OpSize1 | OpSize2 | OpSize4 . +Definition VWORD s := BITS (match s with OpSize1 => n8 | OpSize2 => n16 | OpSize4 => n32 end). +Definition BYTE := VWORD OpSize1. +Definition WORD := VWORD OpSize2. +Definition DWORD := VWORD OpSize4. +Ltac subst_body := + repeat match goal with + | [ H := _ |- _ ] => subst H + end. +Import Coq.Setoids.Setoid. +Class Equiv (A : Type) := equiv : relation A. +Infix "===" := equiv (at level 70, no associativity). +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Definition setoid_resp {T T'} (f : T -> T') `{e : type T} `{e' : type T'} := forall x y, x === y -> f x === f y. +Record morphism T T' `{e : type T} `{e' : type T'} := + mkMorph { + morph :> T -> T'; + morph_resp : setoid_resp morph}. +Arguments mkMorph [T T' e0 e e1 e']. +Infix "-s>" := morphism (at level 45, right associativity). +Section Morphisms. + Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. + Global Instance morph_equiv : Equiv (S -s> T). + admit. + Defined. + + Global Instance morph_type : type (S -s> T). + admit. + Defined. + + Program Definition mcomp (f: T -s> U) (g: S -s> T) : (S -s> U) := + mkMorph (fun x => f (g x)) _. + Next Obligation. + admit. + Defined. + +End Morphisms. + +Infix "<<" := mcomp (at level 35). + +Section MorphConsts. + Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. + + Definition lift2s (f : S -> T -> U) p q : (S -s> T -s> U) := + mkMorph (fun x => mkMorph (f x) (p x)) q. + +End MorphConsts. +Instance Equiv_PropP : Equiv Prop. +admit. +Defined. + +Section SetoidProducts. + Context {A B : Type} `{eA : type A} `{eB : type B}. + Global Instance Equiv_prod : Equiv (A * B). + admit. + Defined. + + Global Instance type_prod : type (A * B). + admit. + Defined. + + Program Definition mfst : (A * B) -s> A := + mkMorph (fun p => fst p) _. + Next Obligation. + admit. + Defined. + + Program Definition msnd : (A * B) -s> B := + mkMorph (fun p => snd p) _. + Next Obligation. + admit. + Defined. + + Context {C} `{eC : type C}. + + Program Definition mprod (f: C -s> A) (g: C -s> B) : C -s> (A * B) := + mkMorph (fun c => (f c, g c)) _. + Next Obligation. + admit. + Defined. + +End SetoidProducts. + +Section IndexedProducts. + + Record ttyp := {carr :> Type; eqc : Equiv carr; eqok : type carr}. + Global Instance ttyp_proj_eq {A : ttyp} : Equiv A. + admit. + Defined. + Global Instance ttyp_proj_prop {A : ttyp} : type A. + admit. + Defined. + Context {I : Type} {P : I -> ttyp}. + + Global Program Instance Equiv_prodI : Equiv (forall i, P i) := + fun p p' : forall i, P i => (forall i : I, @equiv _ (eqc _) (p i) (p' i)). + + Global Instance type_prodI : type (forall i, P i). + admit. + Defined. + + Program Definition mprojI (i : I) : (forall i, P i) -s> P i := + mkMorph (fun X => X i) _. + Next Obligation. + admit. + Defined. + + Context {C : Type} `{eC : type C}. + + Program Definition mprodI (f : forall i, C -s> P i) : C -s> (forall i, P i) := + mkMorph (fun c i => f i c) _. + Next Obligation. + admit. + Defined. + +End IndexedProducts. + +Section Exponentials. + + Context {A B C D} `{eA : type A} `{eB : type B} `{eC : type C} `{eD : type D}. + + Program Definition comps : (B -s> C) -s> (A -s> B) -s> A -s> C := + lift2s (fun f g => f << g) _ _. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + + Program Definition muncurry (f : A -s> B -s> C) : A * B -s> C := + mkMorph (fun p => f (fst p) (snd p)) _. + Next Obligation. + admit. + Defined. + + Program Definition mcurry (f : A * B -s> C) : A -s> B -s> C := + lift2s (fun a b => f (a, b)) _ _. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + + Program Definition meval : (B -s> A) * B -s> A := + mkMorph (fun p => fst p (snd p)) _. + Next Obligation. + admit. + Defined. + + Program Definition mid : A -s> A := mkMorph (fun x => x) _. + Next Obligation. + admit. + Defined. + + Program Definition mconst (b : B) : A -s> B := mkMorph (fun _ => b) _. + Next Obligation. + admit. + Defined. + +End Exponentials. + +Inductive empty : Set := . +Instance empty_Equiv : Equiv empty. +admit. +Defined. +Instance empty_type : type empty. +admit. +Defined. + +Section Initials. + Context {A} `{eA : type A}. + + Program Definition mzero_init : empty -s> A := mkMorph (fun x => match x with end) _. + Next Obligation. + admit. + Defined. + +End Initials. + +Section Subsetoid. + + Context {A} `{eA : type A} {P : A -> Prop}. + Global Instance subset_Equiv : Equiv {a : A | P a}. + admit. + Defined. + Global Instance subset_type : type {a : A | P a}. + admit. + Defined. + + Program Definition mforget : {a : A | P a} -s> A := + mkMorph (fun x => x) _. + Next Obligation. + admit. + Defined. + + Context {B} `{eB : type B}. + Program Definition minherit (f : B -s> A) (HB : forall b, P (f b)) : B -s> {a : A | P a} := + mkMorph (fun b => exist P (f b) (HB b)) _. + Next Obligation. + admit. + Defined. + +End Subsetoid. + +Section Option. + + Context {A} `{eA : type A}. + Global Instance option_Equiv : Equiv (option A). + admit. + Defined. + + Global Instance option_type : type (option A). + admit. + Defined. + +End Option. + +Section OptDefs. + Context {A B} `{eA : type A} `{eB : type B}. + + Program Definition msome : A -s> option A := mkMorph (fun a => Some a) _. + Next Obligation. + admit. + Defined. + + Program Definition moptionbind (f : A -s> option B) : option A -s> option B := + mkMorph (fun oa => match oa with None => None | Some a => f a end) _. + Next Obligation. + admit. + Defined. + +End OptDefs. + +Generalizable Variables Frm. + +Class ILogicOps Frm := { + lentails: relation Frm; + ltrue: Frm; + lfalse: Frm; + limpl: Frm -> Frm -> Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm; + lforall: forall {T}, (T -> Frm) -> Frm; + lexists: forall {T}, (T -> Frm) -> Frm + }. + +Infix "|--" := lentails (at level 79, no associativity). +Infix "//\\" := land (at level 75, right associativity). +Infix "\\//" := lor (at level 76, right associativity). +Infix "-->>" := limpl (at level 77, right associativity). +Notation "'Forall' x .. y , p" := + (lforall (fun x => .. (lforall (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). +Notation "'Exists' x .. y , p" := + (lexists (fun x => .. (lexists (fun y => p)) .. )) (at level 78, x binder, y binder, right associativity). + +Class ILogic Frm {ILOps: ILogicOps Frm} := { + lentailsPre:> PreOrder lentails; + ltrueR: forall C, C |-- ltrue; + lfalseL: forall C, lfalse |-- C; + lforallL: forall T x (P: T -> Frm) C, P x |-- C -> lforall P |-- C; + lforallR: forall T (P: T -> Frm) C, (forall x, C |-- P x) -> C |-- lforall P; + lexistsL: forall T (P: T -> Frm) C, (forall x, P x |-- C) -> lexists P |-- C; + lexistsR: forall T x (P: T -> Frm) C, C |-- P x -> C |-- lexists P; + landL1: forall P Q C, P |-- C -> P //\\ Q |-- C; + landL2: forall P Q C, Q |-- C -> P //\\ Q |-- C; + lorR1: forall P Q C, C |-- P -> C |-- P \\// Q; + lorR2: forall P Q C, C |-- Q -> C |-- P \\// Q; + landR: forall P Q C, C |-- P -> C |-- Q -> C |-- P //\\ Q; + lorL: forall P Q C, P |-- C -> Q |-- C -> P \\// Q |-- C; + landAdj: forall P Q C, C |-- (P -->> Q) -> C //\\ P |-- Q; + limplAdj: forall P Q C, C //\\ P |-- Q -> C |-- (P -->> Q) + }. +Hint Extern 0 (?x |-- ?x) => reflexivity. + +Section ILogicExtra. + Context `{IL: ILogic Frm}. + Definition lpropand (p: Prop) Q := Exists _: p, Q. + Definition lpropimpl (p: Prop) Q := Forall _: p, Q. + +End ILogicExtra. + +Infix "/\\" := lpropand (at level 75, right associativity). +Infix "->>" := lpropimpl (at level 77, right associativity). + +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + + Record ILFunFrm := mkILFunFrm { + ILFunFrm_pred :> T -> Frm; + ILFunFrm_closed: forall t t': T, t === t' -> + ILFunFrm_pred t |-- ILFunFrm_pred t' + }. + + Notation "'mk'" := @mkILFunFrm. + + Program Definition ILFun_Ops : ILogicOps ILFunFrm := {| + lentails P Q := forall t:T, P t |-- Q t; + ltrue := mk (fun t => ltrue) _; + lfalse := mk (fun t => lfalse) _; + limpl P Q := mk (fun t => P t -->> Q t) _; + land P Q := mk (fun t => P t //\\ Q t) _; + lor P Q := mk (fun t => P t \\// Q t) _; + lforall A P := mk (fun t => Forall a, P a t) _; + lexists A P := mk (fun t => Exists a, P a t) _ + |}. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + +End ILogic_Fun. + +Arguments ILFunFrm _ {e} _ {ILOps}. +Arguments mkILFunFrm [T] _ [Frm ILOps]. + +Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) : + @ILFunFrm T _ R ILOps := + @mkILFunFrm T eq R ILOps P _. +Next Obligation. + admit. +Defined. + +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| + lentails P Q := (P : Prop) -> Q; + ltrue := True; + lfalse := False; + limpl P Q := P -> Q; + land P Q := P /\ Q; + lor P Q := P \/ Q; + lforall T F := forall x:T, F x; + lexists T F := exists x:T, F x + |}. + +Instance ILogic_Prop : ILogic Prop. +admit. +Defined. + +Section FunEq. + Context A `{eT: type A}. + + Global Instance FunEquiv {T} : Equiv (T -> A) := { + equiv P Q := forall a, P a === Q a + }. +End FunEq. + +Section SepAlgSect. + Class SepAlgOps T `{eT : type T}:= { + sa_unit : T; + + sa_mul : T -> T -> T -> Prop + }. + + Class SepAlg T `{SAOps: SepAlgOps T} : Type := { + sa_mul_eqL a b c d : sa_mul a b c -> c === d -> sa_mul a b d; + sa_mul_eqR a b c d : sa_mul a b c -> sa_mul a b d -> c === d; + sa_mon a b c : a === b -> sa_mul a c === sa_mul b c; + sa_mulC a b : sa_mul a b === sa_mul b a; + sa_mulA a b c : forall bc abc, sa_mul a bc abc -> sa_mul b c bc -> + exists ac, sa_mul b ac abc /\ sa_mul a c ac; + sa_unitI a : sa_mul a sa_unit a + }. + +End SepAlgSect. + +Section BILogic. + + Class BILOperators (A : Type) := { + empSP : A; + sepSP : A -> A -> A; + wandSP : A -> A -> A + }. + +End BILogic. + +Notation "a '**' b" := (sepSP a b) + (at level 75, right associativity). + +Section BISepAlg. + Context {A} `{sa : SepAlg A}. + Context {B} `{IL: ILogic B}. + + Program Instance SABIOps: BILOperators (ILFunFrm A B) := { + empSP := mkILFunFrm e (fun x => sa_unit === x /\\ ltrue) _; + sepSP P Q := mkILFunFrm e (fun x => Exists x1, Exists x2, sa_mul x1 x2 x /\\ + P x1 //\\ Q x2) _; + wandSP P Q := mkILFunFrm e (fun x => Forall x1, Forall x2, sa_mul x x1 x2 ->> + P x1 -->> Q x2) _ + }. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + Next Obligation. + admit. + Defined. + +End BISepAlg. + +Set Implicit Arguments. + +Definition Chan := WORD. +Definition Data := BYTE. + +Inductive Action := +| Out (c:Chan) (d:Data) +| In (c:Chan) (d:Data). + +Definition Actions := list Action. + +Instance ActionsEquiv : Equiv Actions := { + equiv a1 a2 := a1 = a2 + }. + +Definition OPred := ILFunFrm Actions Prop. +Definition mkOPred (P : Actions -> Prop) : OPred. + admit. +Defined. + +Definition eq_opred s := mkOPred (fun s' => s === s'). +Definition empOP : OPred. + exact (eq_opred nil). +Defined. +Definition catOP (P Q: OPred) : OPred. + admit. +Defined. + +Class IsPointed (T : Type) := point : T. + +Generalizable All Variables. + +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). + +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. + +Existing Instance OPred_inhabited. + +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_eq_opred x : IsPointed_OPred (eq_opred x). +admit. +Defined. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q). +admit. +Defined. + +Definition Flag := BITS 5. +Definition OF: Flag. + admit. +Defined. + +Inductive FlagVal := mkFlag (b: bool) | FlagUnspecified. +Coercion mkFlag : bool >-> FlagVal. +Inductive NonSPReg := EAX | EBX | ECX | EDX | ESI | EDI | EBP. + +Inductive Reg := nonSPReg (r: NonSPReg) | ESP. + +Inductive AnyReg := regToAnyReg (r: Reg) | EIP. + +Inductive BYTEReg := AL|BL|CL|DL|AH|BH|CH|DH. + +Inductive WORDReg := mkWordReg (r:Reg). +Definition PState : Type. +admit. +Defined. + +Instance PStateEquiv : Equiv PState. +admit. +Defined. + +Instance PStateType : type PState. +admit. +Defined. + +Instance PStateSepAlgOps: SepAlgOps PState. +admit. +Defined. +Definition SPred : Type. +exact (ILFunFrm PState Prop). +Defined. + +Local Existing Instance ILFun_Ops. +Local Existing Instance SABIOps. +Axiom BYTEregIs : BYTEReg -> BYTE -> SPred. + +Inductive RegOrFlag := +| RegOrFlagDWORD :> AnyReg -> RegOrFlag +| RegOrFlagWORD :> WORDReg -> RegOrFlag +| RegOrFlagBYTE :> BYTEReg -> RegOrFlag +| RegOrFlagF :> Flag -> RegOrFlag. + +Definition RegOrFlag_target rf := + match rf with + | RegOrFlagDWORD _ => DWORD + | RegOrFlagWORD _ => WORD + | RegOrFlagBYTE _ => BYTE + | RegOrFlagF _ => FlagVal + end. + +Inductive Condition := +| CC_O | CC_B | CC_Z | CC_BE | CC_S | CC_P | CC_L | CC_LE. + +Section ILSpecSect. + + Axiom spec : Type. + Global Instance ILOps: ILogicOps spec | 2. + admit. + Defined. + +End ILSpecSect. + +Axiom parameterized_basic : forall {T_OPred} {proj : T_OPred -> OPred} {T} (P : SPred) (c : T) (O : OPred) (Q : SPred), spec. +Global Notation loopy_basic := (@parameterized_basic PointedOPred OPred_pred _). + +Axiom program : Type. + +Axiom ConditionIs : forall (cc : Condition) (cv : RegOrFlag_target OF), SPred. + +Axiom foldl : forall {T R}, (R -> T -> R) -> R -> list T -> R. +Axiom nth : forall {T}, T -> list T -> nat -> T. +Axiom while : forall (ptest: program) + (cond: Condition) (value: bool) + (pbody: program), program. + +Lemma while_rule_ind {quantT} + {ptest} {cond : Condition} {value : bool} {pbody} + {S} + {transition_body : quantT -> quantT} + {P : quantT -> SPred} {Otest : quantT -> OPred} {Obody : quantT -> OPred} {O : quantT -> PointedOPred} + {O_after_test : quantT -> PointedOPred} + {I_state : quantT -> bool -> SPred} + {I_logic : quantT -> bool -> bool} + {Q : quantT -> SPred} + (Htest : S |-- (Forall (x : quantT), + (loopy_basic (P x) + ptest + (Otest x) + (Exists b, I_logic x b = true /\\ I_state x b ** ConditionIs cond b)))) + (Hbody : S |-- (Forall (x : quantT), + (loopy_basic (I_logic x value = true /\\ I_state x value ** ConditionIs cond value) + pbody + (Obody x) + (P (transition_body x))))) + (H_after_test : forall x, catOP (Otest x) (O_after_test x) |-- O x) + (H_body_after_test : forall x, I_logic x value = true -> catOP (Obody x) (O (transition_body x)) |-- O_after_test x) + (H_empty : forall x, I_logic x (negb value) = true -> empOP |-- O_after_test x) + (Q_correct : forall x, I_logic x (negb value) = true /\\ I_state x (negb value) ** ConditionIs cond (negb value) |-- Q x) + (Q_safe : forall x, I_logic x value = true -> Q (transition_body x) |-- Q x) +: S |-- (Forall (x : quantT), + loopy_basic (P x) + (while ptest cond value pbody) + (O x) + (Q x)). +admit. +Defined. +Axiom behead : forall {T}, list T -> list T. +Axiom all : forall {T}, (T -> bool) -> list T -> bool. +Axiom all_behead : forall {T} (xs : list T) P, all P xs = true -> all P (behead xs) = true. +Instance IsPointed_foldlOP A B C f g (init : A * B) `{IsPointed_OPred (g init)} + `{forall a acc, IsPointed_OPred (g acc) -> IsPointed_OPred (g (f acc a))} + (ls : list C) +: IsPointed_OPred (g (foldl f init ls)). +admit. +Defined. +Goal forall (ptest : program) (cond : Condition) (value : bool) + (pbody : program) (T ioT : Type) (P : T -> SPred) + (I : T -> bool -> SPred) (accumulate : T -> ioT -> T) + (Otest Obody : T -> ioT -> PointedOPred) + (coq_test__is_finished : ioT -> bool) (S : spec) + (al : BYTE), + (forall (initial : T) (xs : list ioT) (x : ioT), + all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> + coq_test__is_finished x = true -> + S + |-- loopy_basic (P initial ** BYTEregIs AL al) ptest + (Otest initial (nth x xs 0)) + (I initial + (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end) ** + ConditionIs cond + (match coq_test__is_finished (nth x xs 0) with true => negb value | false => value end))) -> + (forall (initial : T) (xs : list ioT) (x : ioT), + all (fun t : ioT => negb (coq_test__is_finished t)) xs = true -> + xs <> nil -> + coq_test__is_finished x = true -> + S + |-- loopy_basic (I initial value ** ConditionIs cond value) pbody + (Obody initial (nth x xs 0)) + (P (accumulate initial (nth x xs 0)) ** BYTEregIs AL al)) -> + forall x : ioT, + coq_test__is_finished x = true -> + S + |-- Forall ixsp : {init_xs : T * list ioT & + all (fun t : ioT => negb (coq_test__is_finished t)) + (snd init_xs) = true}, + loopy_basic (P (fst (projT1 ixsp)) ** BYTEregIs AL al) + (while ptest cond value pbody) + (catOP + (snd + (foldl + (fun (xy : T * OPred) (v : ioT) => + (accumulate (fst xy) v, + catOP (catOP (Otest (fst xy) v) (Obody (fst xy) v)) + (snd xy))) (fst (projT1 ixsp), empOP) + (snd (projT1 ixsp)))) + (Otest (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) + x)) + (I (foldl accumulate (fst (projT1 ixsp)) (snd (projT1 ixsp))) + (negb value) ** ConditionIs cond (negb value)). + intros. + eapply @while_rule_ind + with (I_logic := fun ixsp b => match (match (coq_test__is_finished (nth x (snd (projT1 ixsp)) 0)) with true => negb value | false => value end), b with true, true => true | false, false => true | _, _ => false end) + (Otest := fun ixsp => Otest (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) + (Obody := fun ixsp => Obody (fst (projT1 ixsp)) (nth x (snd (projT1 ixsp)) 0)) + (I_state := fun ixsp => I (fst (projT1 ixsp))) + (transition_body := fun ixsp => let initial := fst (projT1 ixsp) in + let xs := snd (projT1 ixsp) in + existT _ (accumulate initial (nth x xs 0), behead xs) _) + (O_after_test := fun ixsp => let initial := fst (projT1 ixsp) in + let xs := snd (projT1 ixsp) in + match xs with | nil => default_PointedOPred empOP | _ => Obody initial (nth x xs 0) end); + simpl projT1; simpl projT2; simpl fst; simpl snd; clear; let H := fresh in assert (H : False) by (clear; admit); destruct H. + + Grab Existential Variables. + subst_body; simpl. + Fail refine (all_behead (projT2 _)). + Unset Solve Unification Constraints. refine (all_behead (projT2 _)). +Abort. diff --git a/test-suite/bugs/closed/bug_3648.v b/test-suite/bugs/closed/bug_3648.v new file mode 100644 index 0000000000..ec13115102 --- /dev/null +++ b/test-suite/bugs/closed/bug_3648.v @@ -0,0 +1,84 @@ +(* File reduced by coq-bug-finder from original input, then from 8808 lines to 424 lines, then from 432 lines to 196 lines, then from\ + 145 lines to 82 lines *) +(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) + +Reserved Infix "o" (at level 40, left associativity). +Global Set Primitive Projections. + +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. + +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g) + }. +Arguments identity {!C%category} / x%object : rename. + +Infix "o" := (@compose _ _ _ _) : morphism_scope. + +Local Open Scope morphism_scope. +Definition prodC (C D : PreCategory) : PreCategory. + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1))). +Defined. + +Local Infix "*" := prodC : category_scope. + +Delimit Scope functor_scope with functor. + +Record Functor (C D : PreCategory) := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. +Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. +Axiom cheat : forall {A}, A. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) cheat cheat). +Defined. + +Local Notation "C -> D" := (functor_category C D) : category_scope. +Variable C1 : PreCategory. +Variable C2 : PreCategory. +Variable D : PreCategory. + +Definition functor_object_of +: (C1 -> (C2 -> D))%category -> (C1 * C2 -> D)%category. +Proof. + intro F; hnf in F |- *. + refine (Build_Functor + (prodC C1 C2) D + (fun c1c2 => F (fst c1c2) (snd c1c2)) + (fun s d m => F (fst d) _1 (snd m) o (@morphism_of _ _ F _ _ (fst m)) (snd s)) + _). + intros. + rewrite identity_of. + cbn. + rewrite (identity_of _ _ F (fst x)). + Undo. +(* Toplevel input, characters 20-55: +Error: +Found no subterm matching "F _1 (identity (fst x))" in the current goal. *) + rewrite identity_of. (* Toplevel input, characters 15-34: +Error: +Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *) +Abort. diff --git a/test-suite/bugs/closed/bug_3649.v b/test-suite/bugs/closed/bug_3649.v new file mode 100644 index 0000000000..2f907ccc32 --- /dev/null +++ b/test-suite/bugs/closed/bug_3649.v @@ -0,0 +1,61 @@ +(* -*- coq-prog-args: ("-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *) +(* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *) +Declare ML Module "ltac_plugin". +Set Default Proof Mode "Classic". +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x = y" (at level 70, no associativity). +Delimit Scope type_scope with type. +Bind Scope type_scope with Sortclass. +Open Scope type_scope. +Axiom admit : forall {T}, T. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Reserved Infix "o" (at level 40, left associativity). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Global Set Primitive Projections. +Delimit Scope morphism_scope with morphism. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g) }. +Infix "o" := (@compose _ _ _ _) : morphism_scope. +Set Implicit Arguments. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d) }. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { morphism_inverse : morphism C d s }. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Definition composeT C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F') +: NaturalTransformation F F''. + exact admit. +Defined. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + admit + (@composeT C D)). +Defined. +Goal forall (C D : PreCategory) (G G' : Functor C D) + (T : @NaturalTransformation C D G G') + (H : @IsIsomorphism (@functor_category C D) G G' T) + (x : C), + @paths (morphism D (G x) (G x)) + (@compose D (G x) (G' x) (G x) + ((@morphism_inverse (@functor_category C D) G G' T H) x) + (T x)) (@identity D (G x)). + intros. + (** This [change] succeeded, but did not progress, in 07e4438bd758c2ced8caf09a6961ccd77d84e42b, because [T0 x o T1 x] was not found in the goal *) + let T0 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T0) end in + let T1 := match goal with |- context[components_of ?T0 ?x o components_of ?T1 ?x] => constr:(T1) end in + progress change (T0 x o T1 x) with ((fun y => y) (T0 x o T1 x)). +Abort. diff --git a/test-suite/bugs/closed/bug_3652.v b/test-suite/bugs/closed/bug_3652.v new file mode 100644 index 0000000000..915cfcac27 --- /dev/null +++ b/test-suite/bugs/closed/bug_3652.v @@ -0,0 +1,100 @@ +Require Setoid. +Require ZArith. +Import ZArith. + +Inductive Erasable(A : Set) : Prop := + erasable: A -> Erasable A. + +Arguments erasable [A] _. + +Hint Constructors Erasable. + +Scheme Erasable_elim := Induction for Erasable Sort Prop. + +Notation "## T" := (Erasable T) (at level 1, format "## T") : Erasable_scope. +Notation "# x" := (erasable x) (at level 1, format "# x") : Erasable_scope. +Open Scope Erasable_scope. + +Axiom Erasable_inj : forall {A : Set}{a b : A}, #a=#b -> a=b. + +Lemma Erasable_rw : forall (A: Set)(a b : A), (#a=#b) <-> (a=b). +Proof. + intros A a b. + split. + - apply Erasable_inj. + - congruence. +Qed. + +Open Scope Z_scope. +Opaque Z.mul. + +Infix "^" := Zpower_nat : Z_scope. + +Notation "f ; v <- x" := (let (v) := x in f) + (at level 199, left associativity) : Erasable_scope. +Notation "f ; < v" := (f ; v <- v) + (at level 199, left associativity) : Erasable_scope. +Notation "f |# v <- x" := (#f ; v <- x) + (at level 199, left associativity) : Erasable_scope. +Notation "f |# < v" := (#f ; < v) + (at level 199, left associativity) : Erasable_scope. + +Ltac name_evars id := + repeat match goal with |- context[?V] => + is_evar V; let H := fresh id in set (H:=V) in * end. + +Lemma Twoto0 : 2^0 = 1. +Proof. compute. reflexivity. Qed. + +Ltac ring_simplify' := rewrite ?Twoto0; ring_simplify. + +Definition mp2a1s(x : Z)(n : nat) := x * 2^n + (2^n-1). + +Hint Unfold mp2a1s. + +Definition zotval(n1s : nat)(is2 : bool)(next_value : Z) : Z := + 2 * mp2a1s next_value n1s + if is2 then 2 else 0. + +Inductive zot'(eis2 : ##bool)(value : ##Z) : Set := +| Zot'(is2 : bool) + (iseq : eis2=#is2) + {next_is2 : ##bool} + (ok : is2=true -> next_is2=#false) + {next_value : ##Z} + (n1s : nat) + (veq : value = (zotval n1s is2 next_value |#<next_value)) + (next : zot' next_is2 next_value) + : zot' eis2 value. + +Definition de2{eis2 value}(z : zot' eis2 value) : zot' #false value. +Proof. + case z. + intros is2 iseq next_is2 ok next_value n1s veq next. + subst. + destruct is2. + 2:trivial. + clear z. + specialize (ok eq_refl). subst. + destruct n1s. + - refine (Zot' _ _ _ _ _ _ _ _). + all:shelve_unifiable. + reflexivity. + discriminate. + name_evars e. + case_eq next_value. intros next_valueU next_valueEU. + case_eq e. intros eU eEU. + f_equal. + unfold zotval. + unfold mp2a1s. + ring_simplify'. + replace 2 with (2*1) at 2 7 by omega. + rewrite <-?Z.mul_assoc. + rewrite <-?Z.mul_add_distr_l. + rewrite <-Z.mul_sub_distr_l. + rewrite Z.mul_cancel_l by omega. + replace 1 with (2-1) at 1 by omega. + rewrite Z.add_sub_assoc. + rewrite Z.sub_cancel_r. + Unshelve. + all:case_eq next. +Abort. diff --git a/test-suite/bugs/closed/3653.v b/test-suite/bugs/closed/bug_3653.v index b97689676b..b97689676b 100644 --- a/test-suite/bugs/closed/3653.v +++ b/test-suite/bugs/closed/bug_3653.v diff --git a/test-suite/bugs/closed/3654.v b/test-suite/bugs/closed/bug_3654.v index 15277235b1..15277235b1 100644 --- a/test-suite/bugs/closed/3654.v +++ b/test-suite/bugs/closed/bug_3654.v diff --git a/test-suite/bugs/closed/bug_3656.v b/test-suite/bugs/closed/bug_3656.v new file mode 100644 index 0000000000..cf32cac09d --- /dev/null +++ b/test-suite/bugs/closed/bug_3656.v @@ -0,0 +1,54 @@ +Module A. + Set Primitive Projections. + Record hSet : Type := BuildhSet { setT : Type; iss : True }. + Ltac head_hnf_under_binders x := + match eval hnf in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal forall s : hSet, True. +intros. +let x := head_hnf_under_binders setT in pose x. + +set (foo := eq_refl (@setT )). generalize foo. simpl. cbn. +Abort. +End A. + +Module A'. +Set Universe Polymorphism. + Set Primitive Projections. +Record hSet (A : Type) : Type := BuildhSet { setT : Type; iss : True }. +Ltac head_hnf_under_binders x := + match eval compute in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal forall s : @hSet nat, True. +intros. +let x := head_hnf_under_binders setT in pose x. + +set (foo := eq_refl (@setT nat)). generalize foo. simpl. cbn. +Abort. +End A'. + +Set Primitive Projections. +Record hSet : Type := BuildhSet { setT : Type; iss : True }. +Ltac head_hnf_under_binders x := + match eval hnf in x with + | ?f _ => head_hnf_under_binders f + | (fun y => ?f y) => head_hnf_under_binders f + | ?y => y + end. +Goal setT = setT. + progress unfold setT. (* should not succeed *) + match goal with + | |- (fun h => setT h) = (fun h => setT h) => fail 1 "should not eta-expand" + | _ => idtac + end. (* should not fail *) +Abort. + +Goal forall h, setT h = setT h. +Proof. intro. progress unfold setT. +Abort. diff --git a/test-suite/bugs/closed/bug_3657.v b/test-suite/bugs/closed/bug_3657.v new file mode 100644 index 0000000000..49c334e620 --- /dev/null +++ b/test-suite/bugs/closed/bug_3657.v @@ -0,0 +1,13 @@ +(* Check typing of replaced objects in change - even though the failure + was already a proper error message (but with a helpless content) *) + +Class foo {A} {a : A} := { bar := a; baz : bar = bar }. +Arguments bar {_} _ {_}. +Instance: forall A a, @foo A a. +intros; constructor. +abstract reflexivity. +Defined. +Goal @bar _ Set _ = (@bar _ (fun _ : Set => Set) _) nat. +Proof. + Fail change (bar (fun _ : Set => Set)) with (bar Set). +Abort. diff --git a/test-suite/bugs/closed/3658.v b/test-suite/bugs/closed/bug_3658.v index 74f4e82dbb..74f4e82dbb 100644 --- a/test-suite/bugs/closed/3658.v +++ b/test-suite/bugs/closed/bug_3658.v diff --git a/test-suite/bugs/closed/bug_3660.v b/test-suite/bugs/closed/bug_3660.v new file mode 100644 index 0000000000..f00ffef9e9 --- /dev/null +++ b/test-suite/bugs/closed/bug_3660.v @@ -0,0 +1,29 @@ +Require Import TestSuite.admit. +Generalizable All Variables. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. +Axiom IsHSet : Type -> Type. +Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (compose g f) | 1000. +admit. +Defined. +Set Primitive Projections. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Global Instance isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). +admit. +Defined. +Local Open Scope equiv_scope. +Axiom equiv_path : forall (A B : Type) (p : A = B), A <~> B. + +Goal forall (C D : hSet), IsEquiv (fun x : C = D => (equiv_path C D (ap setT x))). + intros. + change (IsEquiv (equiv_path C D o @ap _ _ setT C D)). + apply @isequiv_compose; [ | admit ]. + Set Typeclasses Debug. + typeclasses eauto. +Abort. diff --git a/test-suite/bugs/closed/bug_3661.v b/test-suite/bugs/closed/bug_3661.v new file mode 100644 index 0000000000..e040c9d39f --- /dev/null +++ b/test-suite/bugs/closed/bug_3661.v @@ -0,0 +1,89 @@ +(* File reduced by coq-bug-finder from original input, then from 11218 lines to 438 lines, then from 434 lines to 202 lines, then from 140 lines to 94 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Bind Scope category_scope with PreCategory. +Local Open Scope morphism_scope. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +Set Primitive Projections. +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { morphism_inverse : morphism C d s }. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Unset Primitive Projections. +Class Isomorphic {C : PreCategory} s d := + { morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Arguments morphism_inverse {C s d} m {_} / . +Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Generalizable All Variables. +Definition isisomorphism_components_of `{@IsIsomorphism (C -> D) F G T} x : IsIsomorphism (T x). +Proof. + constructor. + exact (T^-1 x). +Defined. +Hint Immediate isisomorphism_components_of : typeclass_instances. +Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3) + (x35 : @Isomorphic (@functor_category x9 x3) f0 x12) + (x37 : object x9) + (H3 : morphism x3 (@object_of x9 x3 f0 x37) + (@object_of x9 x3 f0 x37)) + (x34 : @Isomorphic (@functor_category x9 x3) x12 f0) + (m : morphism x3 (x12 x37) (f0 x37) -> + morphism x3 (f0 x37) (x12 x37) -> + morphism x3 (f0 x37) (f0 x37)), + @paths + (morphism x3 (@object_of x9 x3 f0 x37) (@object_of x9 x3 f0 x37)) + H3 + (m + (@components_of x9 x3 x12 f0 + (@morphism_inverse (@functor_category x9 x3) f0 x12 + (@morphism_isomorphic (@functor_category x9 x3) f0 x12 x35) + (@isisomorphism_isomorphic (@functor_category x9 x3) f0 x12 + x35)) x37) + (@components_of x9 x3 f0 x12 + (@morphism_inverse (@functor_category x9 x3) x12 f0 + (@morphism_isomorphic (@functor_category x9 x3) x12 f0 x34) + (@isisomorphism_isomorphic (@functor_category x9 x3) x12 f0 + x34)) x37)). + Unset Printing All. + intros. + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T1 := constr:(T^-1 x) in + let T2 := constr:((T x)^-1) in + change T1 with T2 || fail 1 "too early" + end. + + Undo. + + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T1 := constr:(T^-1 x) in + change T1 with ((T x)^-1) || fail 1 "too early 2" + end. + + Undo. + + match goal with + | [ |- context[components_of ?T^-1 ?x] ] + => progress let T2 := constr:((T x)^-1) in + change (T^-1 x) with T2 + end. (* not convertible *) + +(* + + (@components_of x9 x3 x12 f0 + (@morphism_inverse _ _ _ + (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37) + +*) +Abort. diff --git a/test-suite/bugs/closed/bug_3662.v b/test-suite/bugs/closed/bug_3662.v new file mode 100644 index 0000000000..3f6d879bc0 --- /dev/null +++ b/test-suite/bugs/closed/bug_3662.v @@ -0,0 +1,46 @@ +Set Primitive Projections. +Set Implicit Arguments. +Set Nonrecursive Elimination Schemes. +Record prod A B := pair { fst : A ; snd : B }. +Definition f : Set -> Type := fun x => x. + +Goal (fst (pair (fun x => x + 1) nat) 0) = 0. +compute. +Undo. +cbv. +Undo. +Opaque fst. +cbn. +Transparent fst. +cbn. +Undo. +simpl. +Undo. +Abort. + +Goal f (fst (pair nat nat)) = nat. +compute. + match goal with + | [ |- fst ?x = nat ] => fail 1 "compute failed" + | [ |- nat = nat ] => idtac + end. + reflexivity. +Defined. + +Goal fst (pair nat nat) = nat. + unfold fst. + match goal with + | [ |- fst ?x = nat ] => fail 1 "compute failed" + | [ |- nat = nat ] => idtac + end. + reflexivity. +Defined. + +Lemma eta A B : forall x : prod A B, x = pair (fst x) (snd x). reflexivity. Qed. + +Goal forall x : prod nat nat, fst x = 0. + intros. unfold fst. + Fail match goal with + | [ |- fst ?x = 0 ] => idtac + end. +Abort. diff --git a/test-suite/bugs/closed/3664.v b/test-suite/bugs/closed/bug_3664.v index cd1427a143..cd1427a143 100644 --- a/test-suite/bugs/closed/3664.v +++ b/test-suite/bugs/closed/bug_3664.v diff --git a/test-suite/bugs/closed/3665.v b/test-suite/bugs/closed/bug_3665.v index f6a13596ca..f6a13596ca 100644 --- a/test-suite/bugs/closed/3665.v +++ b/test-suite/bugs/closed/bug_3665.v diff --git a/test-suite/bugs/closed/3666.v b/test-suite/bugs/closed/bug_3666.v index c7bc2f22a8..c7bc2f22a8 100644 --- a/test-suite/bugs/closed/3666.v +++ b/test-suite/bugs/closed/bug_3666.v diff --git a/test-suite/bugs/closed/bug_3667.v b/test-suite/bugs/closed/bug_3667.v new file mode 100644 index 0000000000..a0c112e7cc --- /dev/null +++ b/test-suite/bugs/closed/bug_3667.v @@ -0,0 +1,24 @@ + +Set Primitive Projections. +Axiom ap10 : forall {A B} {f g:A->B} (h:f=g) x, f x = g x. +Axiom IsHSet : Type -> Type. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d) }. +Set Implicit Arguments. +Record NaturalTransformation C D (F G : Functor C D) := + { components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), components_of s = components_of s }. +Definition set_cat : PreCategory. + exact ((@Build_PreCategory hSet + (fun x y => x -> y))). +Defined. +Goal forall (A : PreCategory) (F : Functor A set_cat) + (a : A) (x : F a) (nt :NaturalTransformation F F), x = x. + intros. + pose (fun c d m => ap10 (commutes nt c d m)). +Abort. diff --git a/test-suite/bugs/closed/bug_3668.v b/test-suite/bugs/closed/bug_3668.v new file mode 100644 index 0000000000..3ce37d4f85 --- /dev/null +++ b/test-suite/bugs/closed/bug_3668.v @@ -0,0 +1,54 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 6329 lines to 110 lines, then from 115 lines to 88 lines, then from 93 lines to 72 lines *) +(* coqc version trunk (September 2014) compiled on Sep 25 2014 2:53:46 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (bec7e0914f4a7144cd4efa8ffaccc9f72dbdb790) *) + +Notation "( x ; y )" := (existT _ x y). +Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Notation "A <~> B" := (Equiv A B) (at level 85). +Axiom IsHProp : Type -> Type. +Inductive Bool := true | false. +Definition negb (b : Bool) := if b then false else true. +Hypothesis LEM : forall A : Type, IsHProp A -> A + (A -> False). +Axiom cheat : forall {A},A. +Module NonPrim. + Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Definition Book_6_9 : forall X, X -> X. + Proof. + intro X. + pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. + destruct contrXEquiv as [[f H]|H]; [ exact f.1 | exact (fun x => x) ]. + Defined. + Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. + Proof. + unfold Book_6_9. + destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. + match goal with + | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac + | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" + end. + all:admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Class Contr (A : Type) := { center : A ; contr : (forall y : A, center = y) }. + Definition Book_6_9 : forall X, X -> X. + Proof. + intro X. + pose proof (@LEM (Contr { f : X <~> X & ~(forall x, f x = x) }) cheat) as contrXEquiv. + destruct contrXEquiv as [[f H]|H]; [ exact (f.1) | exact (fun x => x) ]. + Defined. + Lemma Book_6_9_not_id b : Book_6_9 Bool b = negb b. + Proof. + unfold Book_6_9. + destruct (@LEM (Contr { f : Bool <~> Bool & ~(forall x, f x = x) }) _) as [[f H']|H']. + match goal with + | [ |- equiv_fun Bool Bool f.1 b = negb b ] => idtac + | [ |- equiv_fun Bool Bool center.1 b = negb b ] => fail 1 "bad" + end. (* Tactic failure: bad *) + all:admit. + Defined. +End Prim. diff --git a/test-suite/bugs/closed/bug_3670.v b/test-suite/bugs/closed/bug_3670.v new file mode 100644 index 0000000000..bdf4550a76 --- /dev/null +++ b/test-suite/bugs/closed/bug_3670.v @@ -0,0 +1,24 @@ +Set Universe Polymorphism. +Module Type FOO. + Parameter f : Type -> Type. + Parameter h : forall T, f T. +End FOO. + +Module Type BAR. + Include FOO. +End BAR. + +Module Type BAZ. + Include FOO. +End BAZ. + +Module BAR_FROM_BAZ (baz : BAZ) <: BAR. + + Definition f : Type -> Type. + Proof. exact baz.f. Defined. + + Definition h : forall T, f T. + Admitted. + +Fail End BAR_FROM_BAZ. +Reset BAR_FROM_BAZ. diff --git a/test-suite/bugs/closed/bug_3672.v b/test-suite/bugs/closed/bug_3672.v new file mode 100644 index 0000000000..5573b818b3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3672.v @@ -0,0 +1,27 @@ +Set Primitive Projections. (* No failures without this option. *) + +Record AT := +{ atype :> Type +; coerce : atype -> Type +}. +Coercion coerce : atype >-> Sortclass. + +Record Ar C (A:AT) := { ar : forall (X Y : C), A }. + +Definition t := forall C A a X, coerce _ (ar C A a X X). +Definition t' := forall C A a X, ar C A a X X. + +(* The command has indeed failed with message: +=> Error: The term "ar C A a X X" has type "atype A" which is not a (co-)inductive type. +*) + +Record Ar2 C (A:AT) := +{ ar2 : forall (X Y : C), A +; id2 : forall X, coerce _ (ar2 X X) }. + +Record Ar3 C (A:AT) := +{ ar3 : forall (X Y : C), A +; id3 : forall X, ar3 X X }. +(* The command has indeed failed with message: +=> Anomaly: Bad recursive type. Please report. +*) diff --git a/test-suite/bugs/closed/bug_3675.v b/test-suite/bugs/closed/bug_3675.v new file mode 100644 index 0000000000..529c1504cf --- /dev/null +++ b/test-suite/bugs/closed/bug_3675.v @@ -0,0 +1,21 @@ +Set Primitive Projections. +Definition compose {A B C : Type} (g : B -> C) (f : A -> B) := fun x => g (f x). +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope. +Arguments idpath {A a} , [A] a. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. +Local Open Scope path_scope. +Local Open Scope equiv_scope. +Generalizable Variables A B C f g. +Lemma isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} +: IsEquiv (compose g f). +Proof. + refine (Build_IsEquiv A C + (compose g f) + (compose f^-1 g^-1) _). + exact (fun c => ap g (@eisretr _ _ f _ (g^-1 c)) @ (@eisretr _ _ g _ c)). +Abort. diff --git a/test-suite/bugs/closed/3681.v b/test-suite/bugs/closed/bug_3681.v index 194113c6ed..194113c6ed 100644 --- a/test-suite/bugs/closed/3681.v +++ b/test-suite/bugs/closed/bug_3681.v diff --git a/test-suite/bugs/closed/3682.v b/test-suite/bugs/closed/bug_3682.v index 9d37d1a2d0..9d37d1a2d0 100644 --- a/test-suite/bugs/closed/3682.v +++ b/test-suite/bugs/closed/bug_3682.v diff --git a/test-suite/bugs/closed/3684.v b/test-suite/bugs/closed/bug_3684.v index 130d57779d..130d57779d 100644 --- a/test-suite/bugs/closed/3684.v +++ b/test-suite/bugs/closed/bug_3684.v diff --git a/test-suite/bugs/closed/bug_3685.v b/test-suite/bugs/closed/bug_3685.v new file mode 100644 index 0000000000..5d91d84d98 --- /dev/null +++ b/test-suite/bugs/closed/bug_3685.v @@ -0,0 +1,76 @@ +Require Import TestSuite.admit. +Set Universe Polymorphism. +Class Funext := { }. +Delimit Scope category_scope with category. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Set Implicit Arguments. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d); + identity_of : forall s m, morphism_of s s m = morphism_of s s m }. +Definition sub_pre_cat `{Funext} (P : PreCategory -> Type) : PreCategory. +Proof. + exact (@Build_PreCategory PreCategory Functor). +Defined. +Definition opposite (C : PreCategory) : PreCategory. +Proof. + exact (@Build_PreCategory C (fun s d => morphism C d s)). +Defined. +Local Notation "C ^op" := (opposite C) (at level 3, format "C '^op'") : category_scope. +Definition prod (C D : PreCategory) : PreCategory. +Proof. + refine (@Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) * morphism D (snd s) (snd d))%type)). +Defined. +Local Infix "*" := prod : category_scope. +Record NaturalTransformation C D (F G : Functor C D) := {}. +Definition functor_category (C D : PreCategory) : PreCategory. +Proof. + exact (@Build_PreCategory (Functor C D) (@NaturalTransformation C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Module Export PointwiseCore. + Local Open Scope category_scope. + Definition pointwise + (C C' : PreCategory) + (F : Functor C' C) + (D D' : PreCategory) + (G : Functor D D') + : Functor (C -> D) (C' -> D'). + Proof. + unshelve (refine (Build_Functor + (C -> D) (C' -> D') + _ + _ + _)); + abstract admit. + Defined. +End PointwiseCore. +Axiom Pidentity_of : forall (C D : PreCategory) (F : Functor C C) (G : Functor D D), pointwise F G = pointwise F G. +Local Open Scope category_scope. +Module Success. + Definition functor_uncurried `{Funext} (P : PreCategory -> Type) + (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) + : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) + := Eval cbv zeta in + let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => @Pidentity_of _ _ _ _). +End Success. +Module Bad. + Include PointwiseCore. + Definition functor_uncurried `{Funext} (P : PreCategory -> Type) + (has_functor_categories : forall C D : sub_pre_cat P, P (C -> D)) + : object (((sub_pre_cat P)^op * (sub_pre_cat P)) -> (sub_pre_cat P)) + := Eval cbv zeta in + let object_of := (fun CD => (((fst CD) -> (snd CD)))) + in Build_Functor + ((sub_pre_cat P)^op * (sub_pre_cat P)) (sub_pre_cat P) + object_of + (fun CD C'D' FG => pointwise (fst FG) (snd FG)) + (fun _ _ => @Pidentity_of _ _ _ _). +End Bad. diff --git a/test-suite/bugs/closed/3686.v b/test-suite/bugs/closed/bug_3686.v index df5f667480..df5f667480 100644 --- a/test-suite/bugs/closed/3686.v +++ b/test-suite/bugs/closed/bug_3686.v diff --git a/test-suite/bugs/closed/3690.v b/test-suite/bugs/closed/bug_3690.v index fa30132ab5..fa30132ab5 100644 --- a/test-suite/bugs/closed/3690.v +++ b/test-suite/bugs/closed/bug_3690.v diff --git a/test-suite/bugs/closed/3692.v b/test-suite/bugs/closed/bug_3692.v index 72973a8d81..72973a8d81 100644 --- a/test-suite/bugs/closed/3692.v +++ b/test-suite/bugs/closed/bug_3692.v diff --git a/test-suite/bugs/closed/bug_3698.v b/test-suite/bugs/closed/bug_3698.v new file mode 100644 index 0000000000..21978b7108 --- /dev/null +++ b/test-suite/bugs/closed/bug_3698.v @@ -0,0 +1,27 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 5479 lines to 4682 lines, then from 4214 lines to 86 lines, then from 60 lines to 25 lines *) +(* coqc version trunk (October 2014) compiled on Oct 1 2014 18:13:54 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (68846802a7be637ec805a5e374655a426b5723a5) *) +Set Primitive Projections. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Axiom ap : forall {A B:Type} (f:A -> B) {x y:A} (p:x = y), f x = f y. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A }. +Record Equiv A B := { equiv_fun :> A -> B ; equiv_isequiv :> IsEquiv equiv_fun }. +Global Existing Instance equiv_isequiv. +Notation "A <~> B" := (Equiv A B) (at level 85) : equiv_scope. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : equiv_scope. +Axiom IsHSet : Type -> Type. +Local Open Scope equiv_scope. +Record hSet := BuildhSet {setT:> Type; iss :> IsHSet setT}. +Canonical Structure default_HSet:= fun T P => (@BuildhSet T P). +Axiom issig_hSet: (sigT IsHSet) <~> hSet. +Definition isequiv_ap_setT X Y : IsEquiv (@ap _ _ setT X Y). +Proof. + assert (H'' : forall g : X = Y -> (issig_hSet^-1 X).1 = (issig_hSet^-1 Y).1, + g = g -> IsEquiv g) by admit. + Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)). + Fail apply H''. (* stack overflow *) +Abort. diff --git a/test-suite/bugs/closed/3699.v b/test-suite/bugs/closed/bug_3699.v index dbb10f94f2..dbb10f94f2 100644 --- a/test-suite/bugs/closed/3699.v +++ b/test-suite/bugs/closed/bug_3699.v diff --git a/test-suite/bugs/closed/3700.v b/test-suite/bugs/closed/bug_3700.v index bac443e337..bac443e337 100644 --- a/test-suite/bugs/closed/3700.v +++ b/test-suite/bugs/closed/bug_3700.v diff --git a/test-suite/bugs/closed/3703.v b/test-suite/bugs/closed/bug_3703.v index feeb04d64e..feeb04d64e 100644 --- a/test-suite/bugs/closed/3703.v +++ b/test-suite/bugs/closed/bug_3703.v diff --git a/test-suite/bugs/closed/bug_3709.v b/test-suite/bugs/closed/bug_3709.v new file mode 100644 index 0000000000..680a81da9e --- /dev/null +++ b/test-suite/bugs/closed/bug_3709.v @@ -0,0 +1,26 @@ +Require Import TestSuite.admit. +Module NonPrim. + Unset Primitive Projections. + Record hProp := hp { hproptype :> Type }. + Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, + (forall y, h y = y) -> + h (fun b : Type => {| hproptype := f b |}) = k. + Proof. + intros h k f H. + etransitivity. + apply H. + admit. + Defined. +End NonPrim. +Module Prim. + Set Primitive Projections. + Record hProp := hp { hproptype :> Type }. + Goal forall (h : (Type -> hProp) -> (Type -> hProp)) k f, + (forall y, h y = y) -> + h (fun b : Type => {| hproptype := f b |}) = k. + Proof. + intros h k f H. + etransitivity. + apply H. + Abort. +End Prim. diff --git a/test-suite/bugs/closed/bug_3710.v b/test-suite/bugs/closed/bug_3710.v new file mode 100644 index 0000000000..07208ffa87 --- /dev/null +++ b/test-suite/bugs/closed/bug_3710.v @@ -0,0 +1,49 @@ +(* File reduced by coq-bug-finder from original input, then from 13477 lines to 1457 lines, then from 1553 lines to 1586 lines, then \ +from 1574 lines to 823 lines, then from 837 lines to 802 lines, then from 793 lines to 657 lines, then from 661 lines to 233 lines, t\ +hen from 142 lines to 65 lines *) +(* coqc version trunk (October 2014) compiled on Oct 8 2014 13:38:17 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (335cf2860bfd9e714d14228d75a52fd2c88db386) *) +Set Universe Polymorphism. +Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. +Definition relation (A : Type) := A -> A -> Type. +Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. +Notation "( x ; y )" := (existT _ x y). +Notation "x .1" := (projT1 x) (at level 3, format "x '.1'"). +Reserved Infix "o" (at level 40, left associativity). +Delimit Scope category_scope with category. +Record PreCategory := + { object :> Type; + morphism : object -> object -> Type; + compose : forall s d d', morphism d d' -> morphism s d -> morphism s d' }. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Local Open Scope category_scope. +Class Isomorphic {C : PreCategory} (s d : C) := {}. +Axiom composeF : forall C D E (G : Functor D E) (F : Functor C D), Functor C E. +Infix "o" := composeF : functor_scope. +Local Open Scope functor_scope. +Definition sub_pre_cat {P : PreCategory -> Type} : PreCategory. + exact (@Build_PreCategory + { C : PreCategory & P C } + (fun C D => Functor C.1 D.1) + (fun _ _ _ F G => F o G)). +Defined. +Record NaturalTransformation C D (F G : Functor C D) := { components_of :> forall c, morphism D (F c) (G c) }. +Axiom composeT : forall C D (F F' F'' : Functor C D) (T' : NaturalTransformation F' F'') (T : NaturalTransformation F F'), + NaturalTransformation F F''. +Definition functor_category (C D : PreCategory) : PreCategory. + exact (@Build_PreCategory (Functor C D) + (@NaturalTransformation C D) + (@composeT C D)). +Defined. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism (C D : PreCategory) F G : Type := @Isomorphic (C -> D) F G. +Context `{P : PreCategory -> Type}. +Local Notation cat := (@sub_pre_cat P). +Goal forall (s d d' : cat) (m1 : morphism cat d d') (m2 : morphism cat s d), + NaturalIsomorphism (m1 o m2) (m1 o m2)%functor. +Fail exact (fun _ _ _ _ _ => reflexivity _). +Abort. diff --git a/test-suite/bugs/closed/3723.v b/test-suite/bugs/closed/bug_3723.v index d0b77c451b..d0b77c451b 100644 --- a/test-suite/bugs/closed/3723.v +++ b/test-suite/bugs/closed/bug_3723.v diff --git a/test-suite/bugs/closed/bug_3732.v b/test-suite/bugs/closed/bug_3732.v new file mode 100644 index 0000000000..e6715ee44e --- /dev/null +++ b/test-suite/bugs/closed/bug_3732.v @@ -0,0 +1,105 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 2073 lines to 358 lines, then from 359 lines to 218 lines, then from 107 lines to 92 lines *) +(* coqc version trunk (October 2014) compiled on Oct 11 2014 1:13:41 with OCaml 4.01.0 + coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *) +Require Coq.Lists.List. + +Import Coq.Lists.List. + +Set Implicit Arguments. +Global Set Asymmetric Patterns. + +Section machine. + Variables pc state : Type. + + Inductive propX (i := pc) (j := state) : list Type -> Type := + | Inj : forall G, Prop -> propX G + | ExistsX : forall G A, propX (A :: G) -> propX G. + + Arguments Inj [G]. + + Definition PropX := propX nil. + Fixpoint last (G : list Type) : Type. + exact (match G with + | nil => unit + | T :: nil => T + | _ :: G' => last G' + end). + Defined. + Fixpoint eatLast (G : list Type) : list Type. + exact (match G with + | nil => nil + | _ :: nil => nil + | x :: G' => x :: eatLast G' + end). + Defined. + + Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) := + match p with + | Inj _ P => fun _ => Inj P + | ExistsX G A p1 => fun p' => + match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with + | nil => fun p1 _ => ExistsX p1 + | _ :: _ => fun _ rc => ExistsX rc + end p1 (subst p1 (match G return (last G -> PropX) -> last (A :: G) -> PropX with + | nil => fun _ _ => Inj True + | _ => fun p' => p' + end p')) + end. + + Definition spec := state -> PropX. + Definition codeSpec := pc -> option spec. + + Inductive valid (specs : codeSpec) (G : list PropX) : PropX -> Prop := Env : forall P, In P G -> valid specs G P. + Definition interp specs := valid specs nil. +End machine. +Notation "'ExX' : A , P" := (ExistsX (A := A) P) (at level 89) : PropX_scope. +Bind Scope PropX_scope with PropX propX. +Variables pc state : Type. + +Inductive subs : list Type -> Type := +| SNil : subs nil +| SCons : forall T Ts, (last (T :: Ts) -> PropX pc state) -> subs (eatLast (T :: Ts)) -> subs (T :: Ts). + +Fixpoint SPush G T (s : subs G) (f : T -> PropX pc state) : subs (T :: G) := + match s in subs G return subs (T :: G) with + | SNil => SCons _ nil f SNil + | SCons T' Ts f' s' => SCons T (T' :: Ts) f' (SPush s' f) + end. + +Fixpoint Substs G (s : subs G) : propX pc state G -> PropX pc state := + match s in subs G return propX pc state G -> PropX pc state with + | SNil => fun p => p + | SCons _ _ f s' => fun p => Substs s' (subst p f) + end. +Variable specs : codeSpec pc state. + +Lemma simplify_fwd_ExistsX : forall G A s (p : propX pc state (A :: G)), + interp specs (Substs s (ExX : A, p)) + -> exists a, interp specs (Substs (SPush s a) p). +admit. +Defined. + +Goal forall (G : list Type) (A : Type) (p : propX pc state (@cons Type A G)) + (s : subs G) + (_ : @interp pc state specs (@Substs G s (@ExistsX pc state G A p))) + (P : forall _ : subs (@cons Type A G), Prop) + (_ : forall (s0 : subs (@cons Type A G)) + (_ : @interp pc state specs (@Substs (@cons Type A G) s0 p)), + P s0), + @ex (forall _ : A, PropX pc state) + (fun a : forall _ : A, PropX pc state => P (@SPush G A s a)). + intros ? ? ? ? H ? H'. + apply simplify_fwd_ExistsX in H. + firstorder. +Qed. + (* Toplevel input, characters 15-19: +Error: Illegal application: +The term "cons" of type "forall A : Type, A -> list A -> list A" +cannot be applied to the terms + "Type" : "Type" + "T" : "Type" + "G0" : "list Type" +The 2nd term has type "Type@{Top.53}" which should be coercible to + "Type@{Top.12}". + *) diff --git a/test-suite/bugs/closed/bug_3735.v b/test-suite/bugs/closed/bug_3735.v new file mode 100644 index 0000000000..00886cbc60 --- /dev/null +++ b/test-suite/bugs/closed/bug_3735.v @@ -0,0 +1,4 @@ +Require Import Coq.Program.Tactics. +Class Foo := { bar : Type }. +Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *) +Fail Program Lemma foo : Foo -> bar. diff --git a/test-suite/bugs/closed/3736.v b/test-suite/bugs/closed/bug_3736.v index 637b77cc58..637b77cc58 100644 --- a/test-suite/bugs/closed/3736.v +++ b/test-suite/bugs/closed/bug_3736.v diff --git a/test-suite/bugs/closed/3743.v b/test-suite/bugs/closed/bug_3743.v index ca78987bf3..ca78987bf3 100644 --- a/test-suite/bugs/closed/3743.v +++ b/test-suite/bugs/closed/bug_3743.v diff --git a/test-suite/bugs/closed/3746.v b/test-suite/bugs/closed/bug_3746.v index a9463f94bb..a9463f94bb 100644 --- a/test-suite/bugs/closed/3746.v +++ b/test-suite/bugs/closed/bug_3746.v diff --git a/test-suite/bugs/closed/3753.v b/test-suite/bugs/closed/bug_3753.v index f586438cdd..f586438cdd 100644 --- a/test-suite/bugs/closed/3753.v +++ b/test-suite/bugs/closed/bug_3753.v diff --git a/test-suite/bugs/closed/bug_3755.v b/test-suite/bugs/closed/bug_3755.v new file mode 100644 index 0000000000..5485a0f8cf --- /dev/null +++ b/test-suite/bugs/closed/bug_3755.v @@ -0,0 +1,17 @@ +(* File reduced by coq-bug-finder from original input, then from 6729 lines to +411 lines, then from 148 lines to 115 lines, then from 99 lines to 70 lines, +then from 85 lines to 63 lines, then from 76 lines to 55 lines, then from 61 +lines to 17 lines *) +(* coqc version trunk (January 2015) compiled on Jan 17 2015 21:58:5 with OCaml +4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk +(9e6b28c04ad98369a012faf3bd4d630cf123a473) *) +Set Printing Universes. +Section param. + Variable typeD : Set -> Set. + Variable STex : forall (T : Type) (p : T -> Set), Set. + Definition existsEach_cons' v (P : @sigT _ typeD -> Set) := + @STex _ (fun x => P (@existT _ _ v x)). + + Check @existT _ _ STex STex. +End param. diff --git a/test-suite/bugs/closed/bug_3777.v b/test-suite/bugs/closed/bug_3777.v new file mode 100644 index 0000000000..9ca36cdd9f --- /dev/null +++ b/test-suite/bugs/closed/bug_3777.v @@ -0,0 +1,18 @@ +Unset Strict Universe Declaration. +Module WithoutPoly. + Unset Universe Polymorphism. + Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. + Set Printing Universes. + Definition bla := ((@foo : Set -> _ -> _) : _ -> Type -> _). + (* ((fun A : Set => foo A):Set -> Type@{Top.55} -> Type@{Top.55}) +:Set -> Type@{Top.55} -> Type@{Top.55} + : Set -> Type@{Top.55} -> Type@{Top.55} +(* |= Set <= Top.55 + *) *) +End WithoutPoly. +Module WithPoly. + Set Universe Polymorphism. + Definition foo (A : Type@{i}) (B : Type@{i}) := A -> B. + Set Printing Universes. + Fail Check ((@foo : Set -> _ -> _) : _ -> Type -> _). +End WithPoly. diff --git a/test-suite/bugs/closed/3779.v b/test-suite/bugs/closed/bug_3779.v index 2b44e225e8..2b44e225e8 100644 --- a/test-suite/bugs/closed/3779.v +++ b/test-suite/bugs/closed/bug_3779.v diff --git a/test-suite/bugs/closed/3782.v b/test-suite/bugs/closed/bug_3782.v index 16b0b8b603..16b0b8b603 100644 --- a/test-suite/bugs/closed/3782.v +++ b/test-suite/bugs/closed/bug_3782.v diff --git a/test-suite/bugs/closed/3783.v b/test-suite/bugs/closed/bug_3783.v index f7e2b54353..f7e2b54353 100644 --- a/test-suite/bugs/closed/3783.v +++ b/test-suite/bugs/closed/bug_3783.v diff --git a/test-suite/bugs/closed/3786.v b/test-suite/bugs/closed/bug_3786.v index 23d19e946f..23d19e946f 100644 --- a/test-suite/bugs/closed/3786.v +++ b/test-suite/bugs/closed/bug_3786.v diff --git a/test-suite/bugs/closed/3788.v b/test-suite/bugs/closed/bug_3788.v index 2c5b9cb018..2c5b9cb018 100644 --- a/test-suite/bugs/closed/3788.v +++ b/test-suite/bugs/closed/bug_3788.v diff --git a/test-suite/bugs/closed/3792.v b/test-suite/bugs/closed/bug_3792.v index 39057b9c52..39057b9c52 100644 --- a/test-suite/bugs/closed/3792.v +++ b/test-suite/bugs/closed/bug_3792.v diff --git a/test-suite/bugs/closed/3798.v b/test-suite/bugs/closed/bug_3798.v index b9f0daa71c..b9f0daa71c 100644 --- a/test-suite/bugs/closed/3798.v +++ b/test-suite/bugs/closed/bug_3798.v diff --git a/test-suite/bugs/closed/3804.v b/test-suite/bugs/closed/bug_3804.v index da9290cbad..da9290cbad 100644 --- a/test-suite/bugs/closed/3804.v +++ b/test-suite/bugs/closed/bug_3804.v diff --git a/test-suite/bugs/closed/3807.v b/test-suite/bugs/closed/bug_3807.v index a6286f0377..a6286f0377 100644 --- a/test-suite/bugs/closed/3807.v +++ b/test-suite/bugs/closed/bug_3807.v diff --git a/test-suite/bugs/closed/3808.v b/test-suite/bugs/closed/bug_3808.v index ac6a850193..ac6a850193 100644 --- a/test-suite/bugs/closed/3808.v +++ b/test-suite/bugs/closed/bug_3808.v diff --git a/test-suite/bugs/closed/bug_3815.v b/test-suite/bugs/closed/bug_3815.v new file mode 100644 index 0000000000..a89f9ac307 --- /dev/null +++ b/test-suite/bugs/closed/bug_3815.v @@ -0,0 +1,10 @@ +Require Import Setoid Coq.Program.Basics. +Global Open Scope program_scope. +Axiom foo : forall A (f : A -> A), f ∘ f = f. +Require Import Coq.Program.Combinators. +Hint Rewrite foo. +Theorem t {A B C D} (f : A -> A) (g : B -> C) (h : C -> D) +: f ∘ f = f. +Proof. + rewrite_strat topdown (hints core). +Abort. diff --git a/test-suite/bugs/closed/3819.v b/test-suite/bugs/closed/bug_3819.v index 0b9c3183cc..0b9c3183cc 100644 --- a/test-suite/bugs/closed/3819.v +++ b/test-suite/bugs/closed/bug_3819.v diff --git a/test-suite/bugs/closed/bug_3821.v b/test-suite/bugs/closed/bug_3821.v new file mode 100644 index 0000000000..f6056c51d3 --- /dev/null +++ b/test-suite/bugs/closed/bug_3821.v @@ -0,0 +1,2 @@ +Unset Strict Universe Declaration. +Inductive quotient {A : Type@{i}} {B : Type@{j}} : Type@{max(i, j)} := . diff --git a/test-suite/bugs/closed/bug_3825.v b/test-suite/bugs/closed/bug_3825.v new file mode 100644 index 0000000000..b141965f0f --- /dev/null +++ b/test-suite/bugs/closed/bug_3825.v @@ -0,0 +1,23 @@ +Set Universe Polymorphism. +Set Printing Universes. + +Axiom foo@{i j} : Type@{i} -> Type@{j}. + +Notation bar := foo. + +Monomorphic Universes i j. + +Check bar@{i j}. +Fail Check bar@{i}. + +Notation qux := (nat -> nat). + +Fail Check qux@{i}. + +Axiom TruncType@{i} : nat -> Type@{i}. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (0)-Type. + +Check hProp. +Check hProp@{i}. diff --git a/test-suite/bugs/closed/bug_3828.v b/test-suite/bugs/closed/bug_3828.v new file mode 100644 index 0000000000..3c01dfd734 --- /dev/null +++ b/test-suite/bugs/closed/bug_3828.v @@ -0,0 +1,3 @@ +Goal 0 = 0. +Fail pose ?Goal. +Abort. diff --git a/test-suite/bugs/closed/3848.v b/test-suite/bugs/closed/bug_3848.v index c0ef02f1e8..c0ef02f1e8 100644 --- a/test-suite/bugs/closed/3848.v +++ b/test-suite/bugs/closed/bug_3848.v diff --git a/test-suite/bugs/closed/bug_3849.v b/test-suite/bugs/closed/bug_3849.v new file mode 100644 index 0000000000..bde75afa69 --- /dev/null +++ b/test-suite/bugs/closed/bug_3849.v @@ -0,0 +1,9 @@ +Tactic Notation "foo" hyp_list(hs) := clear hs. + +Tactic Notation "bar" hyp_list(hs) := foo hs. + +Goal True. +do 5 pose proof 0 as ?n0. +foo n1 n2. +bar n3 n4. +Abort. diff --git a/test-suite/bugs/closed/bug_3854.v b/test-suite/bugs/closed/bug_3854.v new file mode 100644 index 0000000000..877e4ba48b --- /dev/null +++ b/test-suite/bugs/closed/bug_3854.v @@ -0,0 +1,23 @@ +Require Import TestSuite.admit. +Definition relation (A : Type) := A -> A -> Type. +Class Reflexive {A} (R : relation A) := reflexivity : forall x : A, R x x. +Axiom IsHProp : Type -> Type. +Existing Class IsHProp. +Inductive Empty : Set := . +Notation "~ x" := (x -> Empty) : type_scope. +Record hProp := BuildhProp { type :> Type ; trunc : IsHProp type }. +Arguments BuildhProp _ {_}. +Canonical Structure default_hProp := fun T P => (@BuildhProp T P). +Generalizable Variables A B f g e n. +Axiom trunc_forall : forall `{P : A -> Type}, IsHProp (forall a, P a). +Existing Instance trunc_forall. +Inductive V : Type := | set {A : Type} (f : A -> V) : V. +Axiom mem : V -> V -> hProp. +Axiom mem_induction +: forall (C : V -> hProp), (forall v, (forall x, mem x v -> C x) -> C v) -> forall v, C v. +Definition irreflexive_mem : forall x, (fun x y => ~ mem x y) x x. +Proof. + pose (fun x => BuildhProp (~ mem x x)). + refine (mem_induction (fun x => BuildhProp (~ mem x x)) _); simpl in *. + admit. +Abort. diff --git a/test-suite/bugs/closed/bug_3881.v b/test-suite/bugs/closed/bug_3881.v new file mode 100644 index 0000000000..d7e097e326 --- /dev/null +++ b/test-suite/bugs/closed/bug_3881.v @@ -0,0 +1,34 @@ +(* -*- coq-prog-args: ("-nois" "-R" "../theories" "Coq") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2236 lines to 1877 lines, then from 1652 lines to 160 lines, then from 102 lines to 34 lines *) +(* coqc version trunk (December 2014) compiled on Dec 23 2014 22:6:43 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (90ed6636dea41486ddf2cc0daead83f9f0788163) *) +Generalizable All Variables. +Require Import Coq.Init.Notations. +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Axiom admit : forall {T}, T. +Notation "g 'o' f" := (fun x => g (f x)) (at level 40, left associativity). +Notation "g 'o' f" := ltac:(let g' := g in let f' := f in exact (fun x => g' (f' x))) (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *) +Inductive eq {A} (x:A) : A -> Prop := eq_refl : x = x where "x = y" := (@eq _ x y) : type_scope. +Arguments eq_refl {_ _}. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with eq_refl => eq_refl end. +Class IsEquiv {A B : Type} (f : A -> B) := { equiv_inv : B -> A ; eisretr : forall x, f (equiv_inv x) = x }. +Arguments eisretr {A B} f {_} _. +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'"). +Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} : IsEquiv (g o f) | 1000 := admit. +Definition isequiv_homotopic {A B} (f : A -> B) (g : A -> B) `{IsEquiv A B f} (h : forall x, f x = g x) : IsEquiv g := admit. +Global Instance isequiv_inverse {A B} (f : A -> B) {feq : IsEquiv f} : IsEquiv f^-1 | 10000 := admit. +Definition cancelR_isequiv {A B C} (f : A -> B) {g : B -> C} `{IsEquiv A B f} `{IsEquiv A C (g o f)} : IsEquiv g. +Proof. + pose (fun H => @isequiv_homotopic _ _ ((g o f) o f^-1) _ H + (fun b => ap g (eisretr f b))) as k. + revert k. + let x := match goal with |- let k := ?x in _ => constr:(x) end in + intro k; clear k; + pose (x _). + pose (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ + (fun b => ap g (eisretr f b))). + Undo. + apply (@isequiv_homotopic _ _ ((g o f) o f^-1) g _ + (fun b => ap g (eisretr f b))). +Qed. diff --git a/test-suite/bugs/closed/3886.v b/test-suite/bugs/closed/bug_3886.v index b523b117e5..b523b117e5 100644 --- a/test-suite/bugs/closed/3886.v +++ b/test-suite/bugs/closed/bug_3886.v diff --git a/test-suite/bugs/closed/3892.v b/test-suite/bugs/closed/bug_3892.v index 833722ba9a..833722ba9a 100644 --- a/test-suite/bugs/closed/3892.v +++ b/test-suite/bugs/closed/bug_3892.v diff --git a/test-suite/bugs/closed/bug_3895.v b/test-suite/bugs/closed/bug_3895.v new file mode 100644 index 0000000000..53fd6b2da2 --- /dev/null +++ b/test-suite/bugs/closed/bug_3895.v @@ -0,0 +1,23 @@ +Notation pr1 := (@projT1 _ _). +Notation compose := (fun g' f' x => g' (f' x)). +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : +function_scope. +Open Scope function_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p +with eq_refl => eq_refl end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) := forall x:A, +f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. +Theorem Univalence_implies_FunextNondep (A B : Type) +: forall f g : A -> B, f == g -> f = g. +Proof. + intros f g p. + pose (d := fun x : A => existT (fun xy => fst xy = snd xy) (f x, f x) +(eq_refl (f x))). + pose (e := fun x : A => existT (fun xy => fst xy = snd xy) (f x, g x) (p x)). + change f with ((snd o pr1) o d). + change g with ((snd o pr1) o e). + apply (ap (fun g => snd o pr1 o g)). +(* Used to raise a not Found due to a "typo" in solve_evar_evar *) +Abort. diff --git a/test-suite/bugs/closed/bug_3896.v b/test-suite/bugs/closed/bug_3896.v new file mode 100644 index 0000000000..5ccc9c5d3a --- /dev/null +++ b/test-suite/bugs/closed/bug_3896.v @@ -0,0 +1,5 @@ +Goal True. +pose proof 0 as n. +Fail apply pair in n. +(* Used to be an anomaly for a while *) +Abort. diff --git a/test-suite/bugs/closed/3899.v b/test-suite/bugs/closed/bug_3899.v index 7754934c0b..7754934c0b 100644 --- a/test-suite/bugs/closed/3899.v +++ b/test-suite/bugs/closed/bug_3899.v diff --git a/test-suite/bugs/closed/3900.v b/test-suite/bugs/closed/bug_3900.v index 6be2161c2f..6be2161c2f 100644 --- a/test-suite/bugs/closed/3900.v +++ b/test-suite/bugs/closed/bug_3900.v diff --git a/test-suite/bugs/closed/bug_3911.v b/test-suite/bugs/closed/bug_3911.v new file mode 100644 index 0000000000..de728213d4 --- /dev/null +++ b/test-suite/bugs/closed/bug_3911.v @@ -0,0 +1,26 @@ +(* Tested against coq ee596bc *) + +Set Nonrecursive Elimination Schemes. +Set Primitive Projections. +Set Universe Polymorphism. + +Record setoid := { base : Type }. + +Definition catdata (Obj Arr : Type) : Type := nat. + (* [nat] can be replaced by any other type, it seems, + without changing the error *) + +Record cat : Type := + { + obj : setoid; + arr : Type; + dta : catdata (base obj) arr + }. + +Definition bcwa (C:cat) (B:setoid) :Type := nat. + (* As above, nothing special about [nat] here. *) + +Record temp {C}{B} (e:bcwa C B) := + { fld : base (obj C) }. + +Print temp_rect. diff --git a/test-suite/bugs/closed/bug_3916.v b/test-suite/bugs/closed/bug_3916.v new file mode 100644 index 0000000000..9d8da11017 --- /dev/null +++ b/test-suite/bugs/closed/bug_3916.v @@ -0,0 +1,2 @@ +Require Import List. +Fail Hint Resolve -> in_map. diff --git a/test-suite/bugs/closed/bug_3920.v b/test-suite/bugs/closed/bug_3920.v new file mode 100644 index 0000000000..25a76242ba --- /dev/null +++ b/test-suite/bugs/closed/bug_3920.v @@ -0,0 +1,8 @@ +Require Import Setoid. +Axiom P : nat -> Prop. +Axiom P_or : forall x y, P (x + y) <-> P x \/ P y. +Lemma foo (H : P 3) : False. +eapply or_introl in H. +erewrite <- P_or in H. +(* Error: No such hypothesis: H *) +Abort. diff --git a/test-suite/bugs/closed/bug_3922.v b/test-suite/bugs/closed/bug_3922.v new file mode 100644 index 0000000000..6e982f8103 --- /dev/null +++ b/test-suite/bugs/closed/bug_3922.v @@ -0,0 +1,86 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +Set Universe Polymorphism. +Notation Type0 := Set. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g f) (at level 40, left associativity) : function_scope. +Open Scope function_scope. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) +}. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Notation Contr := (IsTrunc -2). +Notation IsHProp := (IsTrunc -1). + +Monomorphic Axiom dummy_funext_type : Type0. +Monomorphic Class Funext := { dummy_funext_value : dummy_funext_type }. + +Inductive Unit : Set := + tt : Unit. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type +}. + +Arguments BuildTruncType _ _ {_}. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hProp := (-1)-Type. + +Notation BuildhProp := (BuildTruncType -1). + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + +Global Instance istrunc_truncation (n : trunc_index) (A : Type@{i}) +: IsTrunc@{j} n (Trunc@{i} n A). +Admitted. + +Definition Trunc_ind {n A} + (P : Trunc n A -> Type) {Pt : forall aa, IsTrunc n (P aa)} + : (forall a, P (tr a)) -> (forall aa, P aa) +:= (fun f aa => match aa with tr a => fun _ => f a end Pt). +Definition merely (A : Type@{i}) : hProp := BuildhProp (Trunc -1 A). +Definition cconst_factors_contr `{Funext} {X Y : Type} (f : X -> Y) + (P : Type) `{Pc : X -> Contr P} + (g : X -> P) (h : P -> Y) (p : h o g == f) +: Unit. +Proof. + assert (merely X -> IsHProp P) by admit. + refine (let g' := Trunc_ind (fun _ => P) g : merely X -> P in _); + [ assumption.. | ]. + pose (g'' := Trunc_ind (fun _ => P) g : merely X -> P). +Abort. diff --git a/test-suite/bugs/closed/3923.v b/test-suite/bugs/closed/bug_3923.v index 1d9488c6e1..1d9488c6e1 100644 --- a/test-suite/bugs/closed/3923.v +++ b/test-suite/bugs/closed/bug_3923.v diff --git a/test-suite/bugs/closed/bug_3929.v b/test-suite/bugs/closed/bug_3929.v new file mode 100644 index 0000000000..e65a8252cc --- /dev/null +++ b/test-suite/bugs/closed/bug_3929.v @@ -0,0 +1,67 @@ +Universes i j. +Set Printing Universes. +Set Printing All. +Polymorphic Definition lt@{x y} : Type@{y} := Type@{x}. +Goal True. +evar (T:Type@{i}). +set (Z := nat : Type@{j}). simpl in Z. +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +(** This enforces i <= j *) +Fail pose (lt@{i j}). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +exact I. +Defined. + +Goal True. +evar (T:nat). +pose (Z:=0). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal True. +evar (T:Set). +pose (Z:=nat). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal forall (A:Type)(a:A), True. +intros A a. +evar (T:A). +pose (Z:=a). +let Tv:=eval cbv delta [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. + +Goal True. +evar (T:Type). +pose (Z:=nat). +let Tv:=eval cbv [T] in T in +pose (x:=Tv). +revert x. +refine (_ : let x:=Z in True). +let Zv:=eval cbv [Z] in Z in +let Tv:=eval cbv [T] in T in +constr_eq Zv Tv. +Abort. diff --git a/test-suite/bugs/closed/bug_3938.v b/test-suite/bugs/closed/bug_3938.v new file mode 100644 index 0000000000..a27600957a --- /dev/null +++ b/test-suite/bugs/closed/bug_3938.v @@ -0,0 +1,9 @@ +Require Import TestSuite.admit. +Require Import Coq.Arith.PeanoNat. +Hint Extern 1 => admit : typeclass_instances. +Require Import Setoid. +Goal forall a b (f : nat -> Set) (R : nat -> nat -> Prop), + Equivalence R -> R a b -> f a = f b. + intros a b f H. + intros. Fail rewrite H1. +Abort. diff --git a/test-suite/bugs/closed/bug_3943.v b/test-suite/bugs/closed/bug_3943.v new file mode 100644 index 0000000000..151a6ea275 --- /dev/null +++ b/test-suite/bugs/closed/bug_3943.v @@ -0,0 +1,51 @@ +(* File reduced by coq-bug-finder from original input, then from 9492 lines to 119 lines *) +(* coqc version 8.5beta1 (January 2015) compiled on Jan 18 2015 7:27:36 with OCaml 3.12.1 + coqtop version 8.5beta1 (January 2015) *) + +Set Typeclasses Dependency Order. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Set Implicit Arguments. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. + +Record PreCategory := Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' }. +Arguments identity {!C%category} / x%object : rename. +Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. + +Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := { + morphism_inverse : morphism C d s; + left_inverse : compose morphism_inverse m = identity _; + right_inverse : compose m morphism_inverse = identity _ }. +Arguments morphism_inverse {C s d} m {_}. +Local Notation "m ^-1" := (morphism_inverse m) (at level 3, format "m '^-1'") : morphism_scope. + +Class Isomorphic {C : PreCategory} s d := { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic }. +Coercion morphism_isomorphic : Isomorphic >-> morphism. + +Variable C : PreCategory. +Variables s d : C. + +Definition path_isomorphic (i j : Isomorphic s d) +: @morphism_isomorphic _ _ _ i = @morphism_isomorphic _ _ _ j -> i = j. +Admitted. + +Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q +: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q. +Abort. diff --git a/test-suite/bugs/closed/bug_3944.v b/test-suite/bugs/closed/bug_3944.v new file mode 100644 index 0000000000..c9e9795d9e --- /dev/null +++ b/test-suite/bugs/closed/bug_3944.v @@ -0,0 +1,6 @@ +Require Import Setoid. +Definition C (T : Type) := T. +Goal forall T (i : C T) (v : T), True. +Proof. +Fail setoid_rewrite plus_n_Sm. +Abort. diff --git a/test-suite/bugs/closed/3948.v b/test-suite/bugs/closed/bug_3948.v index 56b1e3ffb4..56b1e3ffb4 100644 --- a/test-suite/bugs/closed/3948.v +++ b/test-suite/bugs/closed/bug_3948.v diff --git a/test-suite/bugs/closed/bug_3953.v b/test-suite/bugs/closed/bug_3953.v new file mode 100644 index 0000000000..f473f63545 --- /dev/null +++ b/test-suite/bugs/closed/bug_3953.v @@ -0,0 +1,6 @@ +(* Checking subst on instances of evars (was bugged in 8.5 beta 1) *) +Goal forall (a b : unit), a = b -> exists c, b = c. + intros. + eexists. + subst. +Abort. diff --git a/test-suite/bugs/closed/bug_3956.v b/test-suite/bugs/closed/bug_3956.v new file mode 100644 index 0000000000..115284ec02 --- /dev/null +++ b/test-suite/bugs/closed/bug_3956.v @@ -0,0 +1,143 @@ +(* -*- mode: coq; coq-prog-args: ("-indices-matter"); mode: visual-line -*- *) +Set Universe Polymorphism. +Set Primitive Projections. +Close Scope nat_scope. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Arguments pair {A B} _ _. +Arguments fst {A B} _ / . +Arguments snd {A B} _ / . +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +Unset Strict Universe Declaration. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. +Definition Type2 := Eval hnf in let gt := (Type1 : Type@{i}) in Type@{i}. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (@paths _ x y) : type_scope. +Definition concat {A} {x y z : A} (p : x = y) (q : y = z) : x = z + := match p, q with idpath, idpath => idpath end. + +Definition path_prod {A B : Type} (z z' : A * B) +: (fst z = fst z') -> (snd z = snd z') -> (z = z'). +Proof. + destruct z, z'; simpl; intros [] []; reflexivity. +Defined. + +Module Type TypeM. + Parameter m : Type2. +End TypeM. + +Module ProdM (XM : TypeM) (YM : TypeM) <: TypeM. + Definition m := XM.m * YM.m. +End ProdM. + +Module Type FunctionM (XM YM : TypeM). + Parameter m : XM.m -> YM.m. +End FunctionM. + +Module IdmapM (XM : TypeM) <: FunctionM XM XM. + Definition m := (fun x => x) : XM.m -> XM.m. +End IdmapM. + +Module Type HomotopyM (XM YM : TypeM) (fM gM : FunctionM XM YM). + Parameter m : forall x, fM.m x = gM.m x. +End HomotopyM. + +Module ComposeM (XM YM ZM : TypeM) + (gM : FunctionM YM ZM) (fM : FunctionM XM YM) + <: FunctionM XM ZM. + Definition m := (fun x => gM.m (fM.m x)). +End ComposeM. + +Module Type CorecM (YM ZM : TypeM) (fM : FunctionM YM ZM) + (XM : TypeM) (gM : FunctionM XM ZM). + Parameter m : XM.m -> YM.m. + Parameter m_beta : forall x, fM.m (m x) = gM.m x. +End CorecM. + +Module Type CoindpathsM (YM ZM : TypeM) (fM : FunctionM YM ZM) + (XM : TypeM) (hM kM : FunctionM XM YM). + Module fhM := ComposeM XM YM ZM fM hM. + Module fkM := ComposeM XM YM ZM fM kM. + Declare Module mM (pM : HomotopyM XM ZM fhM fkM) + : HomotopyM XM YM hM kM. +End CoindpathsM. + +Module Type Comodality (XM : TypeM). + Parameter m : Type2. + Module mM <: TypeM. + Definition m := m. + End mM. + Parameter from : m -> XM.m. + Module fromM <: FunctionM mM XM. + Definition m := from. + End fromM. + Declare Module corecM : CorecM mM XM fromM. + Declare Module coindpathsM : CoindpathsM mM XM fromM. +End Comodality. + +Module Comodality_Theory (F : Comodality). + + Module F_functor_M (XM YM : TypeM) (fM : FunctionM XM YM) + (FXM : Comodality XM) (FYM : Comodality YM). + Module f_o_from_M <: FunctionM FXM.mM YM. + Definition m := fun x => fM.m (FXM.from x). + End f_o_from_M. + Module mM := FYM.corecM FXM.mM f_o_from_M. + Definition m := mM.m. + End F_functor_M. + + Module F_prod_cmp_M (XM YM : TypeM) + (FXM : Comodality XM) (FYM : Comodality YM). + Module PM := ProdM XM YM. + Module PFM := ProdM FXM FYM. + Module fstM <: FunctionM PM XM. + Definition m := @fst XM.m YM.m. + End fstM. + Module sndM <: FunctionM PM YM. + Definition m := @snd XM.m YM.m. + End sndM. + Module FPM := F PM. + Module FfstM := F_functor_M PM XM fstM FPM FXM. + Module FsndM := F_functor_M PM YM sndM FPM FYM. + Definition m : FPM.m -> PFM.m + := fun z => (FfstM.m z , FsndM.m z). + End F_prod_cmp_M. + + Module isequiv_F_prod_cmp_M + (XM YM : TypeM) + (FXM : Comodality XM) (FYM : Comodality YM). + (** The comparison map *) + Module cmpM := F_prod_cmp_M XM YM FXM FYM. + Module FPM := cmpM.FPM. + (** We construct an inverse to it using corecursion. *) + Module prod_from_M <: FunctionM cmpM.PFM cmpM.PM. + Definition m : cmpM.PFM.m -> cmpM.PM.m + := fun z => ( FXM.from (fst z) , FYM.from (snd z) ). + End prod_from_M. + Module cmpinvM <: FunctionM cmpM.PFM FPM + := FPM.corecM cmpM.PFM prod_from_M. + (** We prove the first homotopy *) + Module cmpinv_o_cmp_M <: FunctionM FPM FPM + := ComposeM FPM cmpM.PFM FPM cmpinvM cmpM. + Module idmap_FPM <: FunctionM FPM FPM + := IdmapM FPM. + Module cip_FPM := FPM.coindpathsM FPM cmpinv_o_cmp_M idmap_FPM. + Module cip_FPHM <: HomotopyM FPM cmpM.PM cip_FPM.fhM cip_FPM.fkM. + Definition m : forall x, cip_FPM.fhM.m@{i j} x = cip_FPM.fkM.m@{i j} x. + Proof. + intros x. + refine (concat (cmpinvM.m_beta@{i j} (cmpM.m@{i j} x)) _). + apply path_prod@{i i i}; simpl. + - exact (cmpM.FfstM.mM.m_beta@{i j} x). + - exact (cmpM.FsndM.mM.m_beta@{i j} x). + Defined. + End cip_FPHM. + End isequiv_F_prod_cmp_M. + +End Comodality_Theory. diff --git a/test-suite/bugs/closed/3957.v b/test-suite/bugs/closed/bug_3957.v index e20a6e97f0..e20a6e97f0 100644 --- a/test-suite/bugs/closed/3957.v +++ b/test-suite/bugs/closed/bug_3957.v diff --git a/test-suite/bugs/closed/3960.v b/test-suite/bugs/closed/bug_3960.v index 3527312486..3527312486 100644 --- a/test-suite/bugs/closed/3960.v +++ b/test-suite/bugs/closed/bug_3960.v diff --git a/test-suite/bugs/closed/bug_3974.v b/test-suite/bugs/closed/bug_3974.v new file mode 100644 index 0000000000..b166e73fa1 --- /dev/null +++ b/test-suite/bugs/closed/bug_3974.v @@ -0,0 +1,8 @@ +Module Type S. +End S. + +Module Type M (X : S). + Fail Module P (X : S). + (* Used to say: Anomaly: X already exists. Please report. *) + (* Should rather say now: Error: X already exists. *) +End M. diff --git a/test-suite/bugs/closed/bug_3975.v b/test-suite/bugs/closed/bug_3975.v new file mode 100644 index 0000000000..afd35815df --- /dev/null +++ b/test-suite/bugs/closed/bug_3975.v @@ -0,0 +1,9 @@ +Module Type S. End S. + +Module M (X:S). End M. + +Module Type P (X : S). + Print M. + (* Used to say: Anomaly: X already exists. Please report. *) + (* Should rather : print something :-) *) +End P. diff --git a/test-suite/bugs/closed/bug_3978.v b/test-suite/bugs/closed/bug_3978.v new file mode 100644 index 0000000000..5606bf1c7e --- /dev/null +++ b/test-suite/bugs/closed/bug_3978.v @@ -0,0 +1,27 @@ +Require Import Structures.OrderedType. +Require Import Structures.OrderedTypeEx. + +Module Type M. Parameter X : Type. + +Declare Module Export XOrd : OrderedType + with Definition t := X + with Definition eq := @Logic.eq X. +End M. + +Module M' : M. + Definition X := nat. + + Module XOrd := Nat_as_OT. +End M'. + +Module Type MyOt. + Parameter t : Type. + Parameter eq : t -> t -> Prop. +End MyOt. + +Module Type M2. Parameter X : Type. + +Declare Module Export XOrd : MyOt + with Definition t := X + with Definition eq := @Logic.eq X. +End M2. diff --git a/test-suite/bugs/closed/bug_3993.v b/test-suite/bugs/closed/bug_3993.v new file mode 100644 index 0000000000..a1ab3bf615 --- /dev/null +++ b/test-suite/bugs/closed/bug_3993.v @@ -0,0 +1,4 @@ +(* Test smooth failure on not fully applied term to destruct with eqn: given *) +Goal True. +Fail induction S eqn:H. +Abort. diff --git a/test-suite/bugs/closed/3998.v b/test-suite/bugs/closed/bug_3998.v index e17550e904..e17550e904 100644 --- a/test-suite/bugs/closed/3998.v +++ b/test-suite/bugs/closed/bug_3998.v diff --git a/test-suite/bugs/closed/bug_4001.v b/test-suite/bugs/closed/bug_4001.v new file mode 100644 index 0000000000..25ce692318 --- /dev/null +++ b/test-suite/bugs/closed/bug_4001.v @@ -0,0 +1,18 @@ +(* Computing the type constraints to be satisfied when building the + return clause of a match with a match *) + +Set Implicit Arguments. +Set Asymmetric Patterns. + +Variable A : Type. +Variable typ : A -> Type. + +Inductive t : list A -> Type := +| snil : t nil +| scons : forall (x : A) (e : typ x) (lx : list A) (le : t lx), t (x::lx). + +Definition car (x:A) (lx : list A) (s: t (x::lx)) : typ x := + match s in t l' with + | snil => False + | scons _ e _ _ => e + end. diff --git a/test-suite/bugs/closed/4012.v b/test-suite/bugs/closed/bug_4012.v index 1748e3baad..1748e3baad 100644 --- a/test-suite/bugs/closed/4012.v +++ b/test-suite/bugs/closed/bug_4012.v diff --git a/test-suite/bugs/closed/bug_4016.v b/test-suite/bugs/closed/bug_4016.v new file mode 100644 index 0000000000..c1c9aa673c --- /dev/null +++ b/test-suite/bugs/closed/bug_4016.v @@ -0,0 +1,11 @@ +Require Import Setoid. + +Parameter eq : relation nat. +Declare Instance Equivalence_eq : Equivalence eq. + +Lemma foo : forall z, eq z 0 -> forall x, eq x 0 -> eq z x. +Proof. +intros z Hz x Hx. +rewrite <- Hx in Hz. +destruct z. +Abort. diff --git a/test-suite/bugs/closed/bug_4017.v b/test-suite/bugs/closed/bug_4017.v new file mode 100644 index 0000000000..90d4fc7d22 --- /dev/null +++ b/test-suite/bugs/closed/bug_4017.v @@ -0,0 +1,8 @@ +Set Implicit Arguments. + +(* Use of implicit arguments was lost in multiple variable declarations *) +Variables + (A1 : Type) + (A2 : forall (x1 : A1), Type) + (A3 : forall (x1 : A1) (x2 : A2 x1), Type) + (A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type). diff --git a/test-suite/bugs/closed/bug_4018.v b/test-suite/bugs/closed/bug_4018.v new file mode 100644 index 0000000000..d7929372ad --- /dev/null +++ b/test-suite/bugs/closed/bug_4018.v @@ -0,0 +1,4 @@ +(* Catching PatternMatchingFailure was lost at some point *) +Goal nat -> True. +Fail intros [=]. +Abort. diff --git a/test-suite/bugs/closed/bug_4031.v b/test-suite/bugs/closed/bug_4031.v new file mode 100644 index 0000000000..d2d86a9d13 --- /dev/null +++ b/test-suite/bugs/closed/bug_4031.v @@ -0,0 +1,14 @@ +Definition something (P:Type) (e:P) := e. + +Inductive myunit : Set := mytt. + (* Proof below works when definition is in Type, + however builtin types such as unit are in Set. *) + +Lemma demo_hide_generic : + let x := mytt in x = x. +Proof. + intros. + change mytt with (@something _ mytt) in x. + subst x. (* Proof works if this line is removed *) + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/bug_4034.v b/test-suite/bugs/closed/bug_4034.v new file mode 100644 index 0000000000..5f1b60fc8d --- /dev/null +++ b/test-suite/bugs/closed/bug_4034.v @@ -0,0 +1,26 @@ +(* This checks compatibility of interpretation scope used for exact + between 8.4 and 8.5. See discussion at + https://coq.inria.fr/bugs/show_bug.cgi?id=4034. It is not clear + what we would like exactly, but certainly, if exact is interpreted + in a special scope, it should be interpreted consistently so also + in ltac code. *) + +Record Foo := {}. +Bind Scope foo_scope with Foo. +Notation "!" := Build_Foo : foo_scope. +Notation "!" := 1 : core_scope. +Open Scope foo_scope. +Open Scope core_scope. + +Goal Foo. + Fail exact !. +(* ... but maybe will we want it to succeed eventually if we ever + would be able to make it working the same in + +Ltac myexact e := exact e. + +Goal Foo. + myexact !. +Defined. +*) +Abort. diff --git a/test-suite/bugs/closed/bug_4035.v b/test-suite/bugs/closed/bug_4035.v new file mode 100644 index 0000000000..461a95e82d --- /dev/null +++ b/test-suite/bugs/closed/bug_4035.v @@ -0,0 +1,14 @@ +(* Supporting tactic notations within Ltac in the presence of an + "ident" entry which does not expect a fresh ident *) +(* Of course, this is a matter of convention of what "ident" is + supposed to denote, but in practice, it seems more convenient to + have less constraints on ident at interpretation time, as + otherwise more ad hoc entries would be necessary (as e.g. a special + "quantified_hypothesis" entry for dependent destruction). *) +Require Import Program. +Goal nat -> Type. + intro x. + lazymatch goal with + | [ x : nat |- _ ] => dependent destruction x + end. +Abort. diff --git a/test-suite/bugs/closed/bug_4046.v b/test-suite/bugs/closed/bug_4046.v new file mode 100644 index 0000000000..c33e2b9feb --- /dev/null +++ b/test-suite/bugs/closed/bug_4046.v @@ -0,0 +1,6 @@ +Module Import Foo. + Class Foo := { foo : Type }. +End Foo. + +Instance f : Foo := { foo := nat }. (* works fine *) +Instance f' : Foo.Foo := { Foo.foo := nat }. diff --git a/test-suite/bugs/closed/bug_4057.v b/test-suite/bugs/closed/bug_4057.v new file mode 100644 index 0000000000..f5889d253c --- /dev/null +++ b/test-suite/bugs/closed/bug_4057.v @@ -0,0 +1,211 @@ +Require Coq.Strings.String. + +Set Implicit Arguments. + +Axiom falso : False. +Ltac admit := destruct falso. + +Reserved Notation "[ x ]". + +Record string_like (CharType : Type) := + { + String :> Type; + Singleton : CharType -> String where "[ x ]" := (Singleton x); + Empty : String; + Concat : String -> String -> String where "x ++ y" := (Concat x y); + bool_eq : String -> String -> bool; + bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; + Length : String -> nat + }. + +Delimit Scope string_like_scope with string_like. +Bind Scope string_like_scope with String. +Arguments Length {_%type_scope _} _%string_like. +Infix "++" := (@Concat _ _) : string_like_scope. + +Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) + := Length s1 < Length s2 \/ s1 = s2. +Infix "≤s" := str_le (at level 70, right associativity). + +Module Export ContextFreeGrammar. + Import Coq.Strings.String. + Import Coq.Lists.List. + + Section cfg. + Variable CharType : Type. + + Section definitions. + + Inductive item := + | NonTerminal (name : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions + }. + End definitions. + + Section parse. + Variable String : string_like CharType. + Variable G : grammar. + + Inductive parse_of : String -> productions -> Type := + | ParseHead : forall str pat pats, parse_of_production str pat + -> parse_of str (pat::pats) + | ParseTail : forall str pat pats, parse_of str pats + -> parse_of str (pat::pats) + with parse_of_production : String -> production -> Type := + | ParseProductionCons : forall str pat strs pats, + parse_of_item str pat + -> parse_of_production strs pats + -> parse_of_production (str ++ strs) (pat::pats) + with parse_of_item : String -> item -> Type := + | ParseNonTerminal : forall name str, parse_of str (Lookup G name) + -> parse_of_item str (NonTerminal +name). + End parse. + End cfg. + +End ContextFreeGrammar. +Module Export ContextFreeGrammarProperties. + + Section cfg. + Context CharType (String : string_like CharType) (G : grammar) + (P : String.string -> Type). + + Fixpoint Forall_parse_of {str pats} (p : parse_of String G str pats) + := match p with + | @ParseHead _ _ _ str pat pats p' + => Forall_parse_of_production p' + | @ParseTail _ _ _ _ _ _ p' + => Forall_parse_of p' + end + with Forall_parse_of_production {str pat} (p : parse_of_production String G +str pat) + := let Forall_parse_of_item {str it} (p : parse_of_item String G str +it) + := match p return Type with + | @ParseNonTerminal _ _ _ name str p' + => (P name * Forall_parse_of p')%type + end in + match p return Type with + | @ParseProductionCons _ _ _ str pat strs pats p' p'' + => (Forall_parse_of_item p' * Forall_parse_of_production +p'')%type + end. + + Definition Forall_parse_of_item {str it} (p : parse_of_item String G str it) + := match p return Type with + | @ParseNonTerminal _ _ _ name str p' + => (P name * Forall_parse_of p')%type + end. + End cfg. + +End ContextFreeGrammarProperties. + +Module Export DependentlyTyped. + Import Coq.Strings.String. + + Section recursive_descent_parser. + + Class parser_computational_predataT := + { nonterminal_names_listT : Type; + initial_nonterminal_names_data : nonterminal_names_listT; + is_valid_nonterminal_name : nonterminal_names_listT -> string -> bool; + remove_nonterminal_name : nonterminal_names_listT -> string -> +nonterminal_names_listT }. + + End recursive_descent_parser. + +End DependentlyTyped. +Import Coq.Strings.String. +Import Coq.Lists.List. + +Section cfg. + Context CharType (String : string_like CharType) (G : grammar). + Context (names_listT : Type) + (initial_names_data : names_listT) + (is_valid_name : names_listT -> string -> bool) + (remove_name : names_listT -> string -> names_listT). + + Inductive minimal_parse_of + : forall (str0 : String) (valid : names_listT) + (str : String), + productions -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : names_listT) + (str : String), + production -> Type := + | MinParseProductionNil : forall str0 valid, + @minimal_parse_of_production str0 valid (Empty _) +nil + | MinParseProductionCons : forall str0 valid str strs pat pats, + str ++ strs ≤s str0 + -> @minimal_parse_of_item str0 valid str pat + -> @minimal_parse_of_production str0 valid strs +pats + -> @minimal_parse_of_production str0 valid (str +++ strs) (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : names_listT) + (str : String), + item -> Type := + | MinParseNonTerminal + : forall str0 valid str name, + @minimal_parse_of_name str0 valid str name + -> @minimal_parse_of_item str0 valid str (NonTerminal name) + with minimal_parse_of_name + : forall (str0 : String) (valid : names_listT) + (str : String), + string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid name str, + @minimal_parse_of str initial_names_data str (Lookup G name) + -> @minimal_parse_of_name str0 valid str name + | MinParseNonTerminalStrEq + : forall str valid name, + @minimal_parse_of str (remove_name valid name) str (Lookup G name) + -> @minimal_parse_of_name str valid str name. + Definition parse_of_item_name__of__minimal_parse_of_name + : forall {str0 valid str name} (p : @minimal_parse_of_name str0 valid str +name), + parse_of_item String G str (NonTerminal name). + Proof. + admit. + Defined. + +End cfg. + +Section recursive_descent_parser. + Context (CharType : Type) + (String : string_like CharType) + (G : grammar). + Context {premethods : parser_computational_predataT}. + Let P : string -> Prop. + Proof. + admit. + Defined. + + Let mp_parse_nonterminal_name str0 valid str nonterminal_name + := { p' : minimal_parse_of_name String G initial_nonterminal_names_data +remove_nonterminal_name str0 valid str nonterminal_name & Forall_parse_of_item +P (parse_of_item_name__of__minimal_parse_of_name p') }. + + Goal False. + Proof. + clear -mp_parse_nonterminal_name. + subst P. + simpl in *. + admit. + Qed. +End recursive_descent_parser. diff --git a/test-suite/bugs/closed/bug_4069.v b/test-suite/bugs/closed/bug_4069.v new file mode 100644 index 0000000000..69d5bc6c03 --- /dev/null +++ b/test-suite/bugs/closed/bug_4069.v @@ -0,0 +1,106 @@ + +Lemma test1 : +forall (v : nat) (f g : nat -> nat), +f v = g v. +intros. f_equal. +(* +Goal in v8.5: f v = g v +Goal in v8.4: v = v -> f v = g v +Expected: f = g +*) +Admitted. + +Lemma test2 : +forall (v u : nat) (f g : nat -> nat), +f v = g u. +intros. f_equal. +(* +In both v8.4 And v8.5 +Goal 1: v = u -> f v = g u +Goal 2: v = u + +Expected Goal 1: f = g +Expected Goal 2: v = u +*) +Admitted. + +Lemma test3 : +forall (v : nat) (u : list nat) (f : nat -> nat) (g : list nat -> nat), +f v = g u. +intros. f_equal. +(* +In both v8.4 And v8.5, the goal is unchanged. +*) +Admitted. + +Require Import List. +Lemma foo n (l k : list nat) : k ++ skipn n l = skipn n l. +Proof. f_equal. +(* + 8.4: leaves the goal unchanged, i.e. k ++ skipn n l = skipn n l + 8.5: 2 goals, skipn n l = l -> k ++ skipn n l = skipn n l + and skipn n l = l +*) +Abort. + +Require Import List. +Fixpoint replicate {A} (n : nat) (x : A) : list A := + match n with 0 => nil | S n => x :: replicate n x end. +Lemma bar {A} n m (x : A) : + skipn n (replicate m x) = replicate (m - n) x -> + skipn n (replicate m x) = replicate (m - n) x. +Proof. intros. f_equal. +(* 8.5: one goal, n = m - n *) +Abort. + +Variable F : nat -> Set. +Variable X : forall n, F (n + 1). + +Definition sequator{X Y: Set}{eq:X=Y}(x:X) : Y := eq_rec _ _ x _ eq. +Definition tequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. +Polymorphic Definition pequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq. + +Goal {n:nat & F (S n)}. +eexists. +unshelve eapply (sequator (X _)). +f_equal. (*behaves*) +Undo 2. +unshelve eapply (pequator (X _)). +f_equal. (*behaves*) +Undo 2. +unshelve eapply (tequator (X _)). +f_equal. (*behaves now *) +Focus 2. exact 0. +simpl. +reflexivity. +Defined. + +(* Part 2: modulo casts introduced by refine due to reductions in goals *) + +Goal {n:nat & F (S n)}. +eexists. +(*misbehaves, although same goal as above*) +Set Printing All. +unshelve refine (sequator (X _)); revgoals. +2:exact 0. reflexivity. +Undo 3. +unshelve refine (pequator (X _)); revgoals. +f_equal. +Undo 2. +unshelve refine (tequator (X _)); revgoals. +f_equal. +Admitted. + +Goal @eq Set nat nat. +congruence. +Qed. + +Goal @eq Type nat nat. +congruence. +Qed. + +Variable T : Type. + +Goal @eq Type T T. +congruence. +Qed. diff --git a/test-suite/bugs/closed/4078.v b/test-suite/bugs/closed/bug_4078.v index 236cd2fbb1..236cd2fbb1 100644 --- a/test-suite/bugs/closed/4078.v +++ b/test-suite/bugs/closed/bug_4078.v diff --git a/test-suite/bugs/closed/bug_4089.v b/test-suite/bugs/closed/bug_4089.v new file mode 100644 index 0000000000..38fbec0464 --- /dev/null +++ b/test-suite/bugs/closed/bug_4089.v @@ -0,0 +1,376 @@ +Unset Strict Universe Declaration. +Require Import TestSuite.admit. +(* -*- mode: coq; coq-prog-args: ("-indices-matter") -*- *) +(* File reduced by coq-bug-finder from original input, then from 6522 lines to 318 lines, then from 1139 lines to 361 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) +Open Scope type_scope. + +Global Set Universe Polymorphism. +Module Export Datatypes. + +Set Implicit Arguments. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. + +Notation "x * y" := (prod x y) : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +End Datatypes. +Module Export Specif. + +Set Implicit Arguments. + +Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P proj1_sig }. + +Notation sigT := sig (only parsing). +Notation existT := exist (only parsing). + +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +End Specif. + +Ltac rapply p := + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _ _) || + refine (p _ _ _ _ _ _) || + refine (p _ _ _ _ _) || + refine (p _ _ _ _) || + refine (p _ _ _) || + refine (p _ _) || + refine (p _) || + refine p. + +Local Unset Elimination Schemes. + +Definition relation (A : Type) := A -> A -> Type. + +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Class Transitive {A} (R : relation A) := + transitivity : forall x y z, R x y -> R y z -> R x z. + +Tactic Notation "etransitivity" open_constr(y) := + let R := match goal with |- ?R ?x ?z => constr:(R) end in + let x := match goal with |- ?R ?x ?z => constr:(x) end in + let z := match goal with |- ?R ?x ?z => constr:(z) end in + let pre_proof_term_head := constr:(@transitivity _ R _) in + let proof_term_head := (eval cbn in pre_proof_term_head) in + refine (proof_term_head x y z _ _); [ change (R x y) | change (R y z) ]. + +Ltac transitivity x := etransitivity x. + +Definition Type1 := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation "( x ; y )" := (existT _ x y) : fibration_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Scheme paths_ind := Induction for paths Sort Type. + +Definition paths_rect := paths_ind. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Local Open Scope path_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Arguments concat {A x y z} p q : simpl nomatch. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) + : f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B}%type_scope f%function_scope {_} _. +Arguments eissect {A B}%type_scope f%function_scope {_} _. +Arguments eisadj {A B}%type_scope f%function_scope {_} _. + +Record Equiv A B := BuildEquiv { + equiv_fun : A -> B ; + equiv_isequiv : IsEquiv equiv_fun +}. + +Coercion equiv_fun : Equiv >-> Funclass. + +Global Existing Instance equiv_isequiv. + +Bind Scope equiv_scope with Equiv. + +Notation "A <~> B" := (Equiv A B) (at level 85) : type_scope. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. + +Inductive Unit : Set := + tt : Unit. + +Ltac done := + trivial; intros; solve + [ repeat first + [ solve [trivial] + | solve [symmetry; trivial] + | reflexivity + + | contradiction + | split ] + | match goal with + H : ~ _ |- _ => solve [destruct H; trivial] + end ]. +Tactic Notation "by" tactic(tac) := + tac; done. + +Definition concat_p1 {A : Type} {x y : A} (p : x = y) : + p @ 1 = p + := + match p with idpath => 1 end. + +Definition concat_1p {A : Type} {x y : A} (p : x = y) : + 1 @ p = p + := + match p with idpath => 1 end. + +Definition ap_pp {A B : Type} (f : A -> B) {x y z : A} (p : x = y) (q : y = z) : + ap f (p @ q) = (ap f p) @ (ap f q) + := + match q with + idpath => + match p with idpath => 1 end + end. + +Definition ap_compose {A B C : Type} (f : A -> B) (g : B -> C) {x y : A} (p : x = y) : + ap (g o f) p = ap g (ap f p) + := + match p with idpath => 1 end. + +Definition concat_A1p {A : Type} {f : A -> A} (p : forall x, f x = x) {x y : A} (q : x = y) : + (ap f q) @ (p y) = (p x) @ q + := + match q with + | idpath => concat_1p _ @ ((concat_p1 _) ^) + end. + +Definition concat2 {A} {x y z : A} {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') + : p @ q = p' @ q' +:= match h, h' with idpath, idpath => 1 end. + +Notation "p @@ q" := (concat2 p q)%path (at level 20) : path_scope. + +Definition whiskerL {A : Type} {x y z : A} (p : x = y) + {q r : y = z} (h : q = r) : p @ q = p @ r +:= 1 @@ h. + +Definition ap02 {A B : Type} (f:A->B) {x y:A} {p q:x=y} (r:p=q) : ap f p = ap f q + := match r with idpath => 1 end. +Module Export Equivalences. + +Generalizable Variables A B C f g. + +Global Instance isequiv_idmap (A : Type) : IsEquiv idmap | 0 := + BuildIsEquiv A A idmap idmap (fun _ => 1) (fun _ => 1) (fun _ => 1). + +Definition equiv_idmap (A : Type) : A <~> A := BuildEquiv A A idmap _. + +Arguments equiv_idmap {A} , A. + +Notation "1" := equiv_idmap : equiv_scope. + +Global Instance isequiv_compose `{IsEquiv A B f} `{IsEquiv B C g} + : IsEquiv (compose g f) | 1000 + := BuildIsEquiv A C (compose g f) + (compose f^-1 g^-1) + (fun c => ap g (eisretr f (g^-1 c)) @ eisretr g c) + (fun a => ap (f^-1) (eissect g (f a)) @ eissect f a) + (fun a => + (whiskerL _ (eisadj g (f a))) @ + (ap_pp g _ _)^ @ + ap02 g + ( (concat_A1p (eisretr f) (eissect g (f a)))^ @ + (ap_compose f^-1 f _ @@ eisadj f a) @ + (ap_pp f _ _)^ + ) @ + (ap_compose f g _)^ + ). + +Definition equiv_compose {A B C : Type} (g : B -> C) (f : A -> B) + `{IsEquiv B C g} `{IsEquiv A B f} + : A <~> C + := BuildEquiv A C (compose g f) _. + +Global Instance transitive_equiv : Transitive Equiv | 0 := + fun _ _ _ f g => equiv_compose g f. + +Theorem equiv_inverse {A B : Type} : (A <~> B) -> (B <~> A). +admit. +Defined. + +Global Instance symmetric_equiv : Symmetric Equiv | 0 := @equiv_inverse. + +End Equivalences. + +Definition path_prod_uncurried {A B : Type} (z z' : A * B) + (pq : (fst z = fst z') * (snd z = snd z')) + : (z = z'). +admit. +Defined. + +Global Instance isequiv_path_prod {A B : Type} {z z' : A * B} +: IsEquiv (path_prod_uncurried z z') | 0. +admit. +Defined. + +Definition equiv_path_prod {A B : Type} (z z' : A * B) + : (fst z = fst z') * (snd z = snd z') <~> (z = z') + := BuildEquiv _ _ (path_prod_uncurried z z') _. + +Generalizable Variables X A B C f g n. + +Definition functor_sigma `{P : A -> Type} `{Q : B -> Type} + (f : A -> B) (g : forall a, P a -> Q (f a)) +: sigT P -> sigT Q + := fun u => (f u.1 ; g u.1 u.2). + +Global Instance isequiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} + `{IsEquiv A B f} `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} +: IsEquiv (functor_sigma f g) | 1000. +admit. +Defined. + +Definition equiv_functor_sigma `{P : A -> Type} `{Q : B -> Type} + (f : A -> B) `{IsEquiv A B f} + (g : forall a, P a -> Q (f a)) + `{forall a, @IsEquiv (P a) (Q (f a)) (g a)} +: sigT P <~> sigT Q + := BuildEquiv _ _ (functor_sigma f g) _. + +Definition equiv_functor_sigma' `{P : A -> Type} `{Q : B -> Type} + (f : A <~> B) + (g : forall a, P a <~> Q (f a)) +: sigT P <~> sigT Q + := equiv_functor_sigma f g. + +Definition equiv_functor_sigma_id `{P : A -> Type} `{Q : A -> Type} + (g : forall a, P a <~> Q a) +: sigT P <~> sigT Q + := equiv_functor_sigma' 1 g. + +Definition Bip : Type := { C : Type & C * C }. + +Definition BipMor (X Y : Bip) : Type := + match X, Y with (C;(c0,c1)), (D;(d0,d1)) => + { f : C -> D & (f c0 = d0) * (f c1 = d1) } + end. + +Definition bipmor2map {X Y : Bip} : BipMor X Y -> X.1 -> Y.1 := + match X, Y with (C;(c0,c1)), (D;(d0,d1)) => fun i => + match i with (f;_) => f end + end. + +Definition bipidmor {X : Bip} : BipMor X X := + match X with (C;(c0,c1)) => (idmap; (1, 1)) end. + +Definition bipcompmor {X Y Z : Bip} : BipMor X Y -> BipMor Y Z -> BipMor X Z := + match X, Y, Z with (C;(c0,c1)), (D;(d0,d1)), (E;(e0,e1)) => fun i j => + match i, j with (f;(f0,f1)), (g;(g0,g1)) => + (g o f; (ap g f0 @ g0, ap g f1 @ g1)) + end + end. + +Definition isbipequiv {X Y : Bip} (i : BipMor X Y) : Type := + { l : BipMor Y X & bipcompmor i l = bipidmor } * + { r : BipMor Y X & bipcompmor r i = bipidmor }. + +Lemma bipequivEQequiv : forall {X Y : Bip} (i : BipMor X Y), + isbipequiv i <~> IsEquiv (bipmor2map i). +Proof. +assert (equivcompmor : forall {X Y : Bip} (i : BipMor X Y) j, +(bipcompmor i j = bipidmor) <~> Unit). + intros; set (U := X); set (V := Y); destruct X as [C [c0 c1]], Y as [D [d0 d1]]. + transitivity { n : (bipcompmor i j).1 = (@bipidmor U).1 & + (bipcompmor i j).2 = transport (fun h => (h c0 = c0) * (h c1 = c1)) n^ (@bipidmor U).2}. + admit. + destruct i as [f [f0 f1]]; destruct j as [g [g0 g1]]. + + transitivity { n : g o f = idmap & (ap g f0 @ g0 = apD10 n c0 @ 1) * + (ap g f1 @ g1 = apD10 n c1 @ 1)}. + apply equiv_functor_sigma_id; intro n. + assert (Ggen : forall (h0 h1 : C -> C) (p : h0 = h1) u0 u1 v0 v1, + ((u0, u1) = transport (fun h => (h c0 = c0) * (h c1 = c1)) p^ (v0, v1)) <~> + (u0 = apD10 p c0 @ v0) * (u1 = apD10 p c1 @ v1)). + induction p; intros; simpl; rewrite !concat_1p; apply symmetry. + by apply (equiv_path_prod (u0,u1) (v0,v1)). + rapply Ggen. + pose (@paths C). + Check (@paths C). + Undo. + Check (@paths C). (* Toplevel input, characters 0-17: +Error: Illegal application: +The term "@paths" of type "forall A : Type, A -> A -> Type" +cannot be applied to the term + "C" : "Type" +This term has type "Type@{Top.892}" which should be coercible to + "Type@{Top.882}". +*) +Abort. diff --git a/test-suite/bugs/closed/bug_4095.v b/test-suite/bugs/closed/bug_4095.v new file mode 100644 index 0000000000..3d3015c383 --- /dev/null +++ b/test-suite/bugs/closed/bug_4095.v @@ -0,0 +1,88 @@ +(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) +Require Import Coq.Setoids.Setoid. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Ltac admit := apply admit. +Class Equiv (A : Type) := equiv : relation A. +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Class ILogicOps Frm := { lentails: relation Frm; + ltrue: Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm }. +Infix "|--" := lentails (at level 79, no associativity). +Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. +Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. +Infix "-|-" := lequiv (at level 85, no associativity). +Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. +Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. + Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. +End ILogic_Fun. +Arguments ILFunFrm _ {e} _ {ILOps}. +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; + ltrue := True; + land P Q := P /\ Q; + lor P Q := P \/ Q |}. +Axiom Action : Set. +Definition Actions := list Action. +Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. +Definition OPred := ILFunFrm Actions Prop. +Local Existing Instance ILFun_Ops. +Local Existing Instance ILFun_ILogic. +Definition catOP (P Q: OPred) : OPred := admit. +Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. +admit. +Defined. +Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. +Class IsPointed (T : Type) := point : T. +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. +Existing Instance OPred_inhabited. +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. +Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) + (tr : T -> T) (O2 : PointedOPred) (x : T) + (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), + exists e1 e2, + catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. + intros; do 2 esplit. + rewrite <- catOPA. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) + (@Morphisms.respectful OPred (OPred -> OPred) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> + @lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP + catOP_entails_m_Proper a a' H b b' H') in + pose P; + refine (P _ _) + end. + Undo. + Fail lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in + set(p:=P) + end. (* Toplevel input, characters 15-182: +Error: Cannot infer an instance of type +"PointedOPred" for the variable p in environment: +T : Type +O0 : T -> OPred +O1 : T -> PointedOPred +tr : T -> T +O2 : PointedOPred +x0 : T +H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) +Abort. diff --git a/test-suite/bugs/closed/4097.v b/test-suite/bugs/closed/bug_4097.v index 183b860d1f..183b860d1f 100644 --- a/test-suite/bugs/closed/4097.v +++ b/test-suite/bugs/closed/bug_4097.v diff --git a/test-suite/bugs/closed/bug_4101.v b/test-suite/bugs/closed/bug_4101.v new file mode 100644 index 0000000000..19e6f65805 --- /dev/null +++ b/test-suite/bugs/closed/bug_4101.v @@ -0,0 +1,20 @@ +(* File reduced by coq-bug-finder from original input, then from 10940 lines to 152 lines, then from 509 lines to 163 lines, then from 178 lines to 66 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 2 2015 18:53:10 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (e77f178e60918f14eacd1ec0364a491d4cfd0f3f) *) + +Global Set Primitive Projections. +Set Implicit Arguments. +Record sigT {A} (P : A -> Type) := existT { projT1 : A ; projT2 : P projT1 }. +Axiom path_forall : forall {A : Type} {P : A -> Type} (f g : forall x : A, P x), + (forall x, f x = g x) -> f = g. +Lemma sigT_obj_eq +: forall (T : Type) (T0 : T -> Type) + (s s0 : forall s : sigT T0, + sigT (fun _ : T0 (projT1 s) => unit) -> + sigT (fun _ : T0 (projT1 s) => unit)), + s0 = s. +Proof. + intros. + Set Debug Tactic Unification. + apply path_forall. +Abort. diff --git a/test-suite/bugs/closed/bug_4103.v b/test-suite/bugs/closed/bug_4103.v new file mode 100644 index 0000000000..690511a86c --- /dev/null +++ b/test-suite/bugs/closed/bug_4103.v @@ -0,0 +1,13 @@ +Set Primitive Projections. + +CoInductive stream A := { hd : A; tl : stream A }. + +CoFixpoint ticks (n : nat) : stream unit := {| hd := tt; tl := ticks n |}. + +Lemma expand : exists n : nat, (ticks n) = (ticks n).(tl _). +Proof. + eexists. + (* Set Debug Tactic Unification. *) + (* Set Debug RAKAM. *) + reflexivity. +Abort. diff --git a/test-suite/bugs/closed/bug_4116.v b/test-suite/bugs/closed/bug_4116.v new file mode 100644 index 0000000000..17c7bbe5eb --- /dev/null +++ b/test-suite/bugs/closed/bug_4116.v @@ -0,0 +1,385 @@ +(* File reduced by coq-bug-finder from original input, then from 13191 lines to 1315 lines, then from 1601 lines to 595 lines, then from 585 lines to 379 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 3 2015 3:50:31 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ac62cda8a4f488b94033b108c37556877232137a) *) + +Axiom admit : False. +Ltac admit := exfalso; exact admit. + +Global Set Primitive Projections. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +Definition relation (A : Type) := A -> A -> Type. + +Class Reflexive {A} (R : relation A) := + reflexivity : forall x : A, R x x. + +Class Symmetric {A} (R : relation A) := + symmetry : forall x y, R x y -> R y x. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope path_scope. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Global Instance symmetric_paths {A} : Symmetric (@paths A) | 0 := @inverse A. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "1" := idpath : path_scope. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : type_scope. + +Definition apD10 {A} {B:A->Type} {f g : forall x, B x} (h:f=g) +: f == g + := fun x => match h with idpath => 1 end. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) + }. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : function_scope. + +Class Contr_internal (A : Type) := BuildContr { + center : A ; + contr : (forall y : A, center = y) + }. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. + +Notation "n .+1" := (trunc_S n) (at level 2, left associativity, format "n .+1") : trunc_scope. +Local Open Scope trunc_scope. +Notation "-2" := minus_two (at level 0) : trunc_scope. +Notation "-1" := (-2.+1) (at level 0) : trunc_scope. +Notation "0" := (-1.+1) : trunc_scope. + +Fixpoint IsTrunc_internal (n : trunc_index) (A : Type) : Type := + match n with + | -2 => Contr_internal A + | n'.+1 => forall (x y : A), IsTrunc_internal n' (x = y) + end. + +Class IsTrunc (n : trunc_index) (A : Type) : Type := + Trunc_is_trunc : IsTrunc_internal n A. + +Tactic Notation "transparent" "assert" "(" ident(name) ":" constr(type) ")" := + unshelve refine (let __transparent_assert_hypothesis := (_ : type) in _); + [ + | ( + let H := match goal with H := _ |- _ => constr:(H) end in + rename H into name) ]. + +Definition transport_idmap_ap A (P : A -> Type) x y (p : x = y) (u : P x) +: transport P p u = transport idmap (ap P p) u + := match p with idpath => idpath end. + +Section Adjointify. + + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). + admit. + Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. + +End Adjointify. + +Record TruncType (n : trunc_index) := BuildTruncType { + trunctype_type : Type ; + istrunc_trunctype_type : IsTrunc n trunctype_type + }. +Arguments trunctype_type {_} _. + +Coercion trunctype_type : TruncType >-> Sortclass. + +Notation "n -Type" := (TruncType n) (at level 1) : type_scope. +Notation hSet := 0-Type. + +Module Export Category. + Module Export Core. + Set Implicit Arguments. + + Delimit Scope morphism_scope with morphism. + Delimit Scope category_scope with category. + Delimit Scope object_scope with object. + + Record PreCategory := + Build_PreCategory' { + object :> Type; + morphism : object -> object -> Type; + + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + + identity_identity : forall x, identity x o identity x = identity x + }. + Arguments identity {!C%category} / x%object : rename. + Arguments compose {!C%category} / {s d d'}%object (m1 m2)%morphism : rename. + + Definition Build_PreCategory + object morphism compose identity + associativity left_identity right_identity + := @Build_PreCategory' + object + morphism + compose + identity + associativity + (fun _ _ _ _ _ _ _ => symmetry _ _ (associativity _ _ _ _ _ _ _)) + left_identity + right_identity + (fun _ => left_identity _ _ _). + + Module Export CategoryCoreNotations. + Infix "o" := compose : morphism_scope. + Notation "1" := (identity _) : morphism_scope. + End CategoryCoreNotations. + + End Core. + +End Category. +Module Export Core. + Set Implicit Arguments. + + Delimit Scope functor_scope with functor. + + Local Open Scope morphism_scope. + + Section Functor. + Variables C D : PreCategory. + + Record Functor := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. + End Functor. + Arguments morphism_of [C%category] [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. + +End Core. +Module Export Morphisms. + Set Implicit Arguments. + + Local Open Scope category_scope. + Local Open Scope morphism_scope. + + Class IsIsomorphism {C : PreCategory} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + + Class Isomorphic {C : PreCategory} s d := + { + morphism_isomorphic :> morphism C s d; + isisomorphism_isomorphic :> IsIsomorphism morphism_isomorphic + }. + + Coercion morphism_isomorphic : Isomorphic >-> morphism. + + Local Infix "<~=~>" := Isomorphic (at level 70, no associativity) : category_scope. + + Section iso_equiv_relation. + Variable C : PreCategory. + + Global Instance isisomorphism_identity (x : C) : IsIsomorphism (identity x) + := {| morphism_inverse := identity x; + left_inverse := left_identity C x x (identity x); + right_inverse := right_identity C x x (identity x) |}. + + Global Instance isomorphic_refl : Reflexive (@Isomorphic C) + := fun x : C => {| morphism_isomorphic := identity x |}. + + Definition idtoiso (x y : C) (H : x = y) : Isomorphic x y + := match H in (_ = y0) return (x <~=~> y0) with + | 1%path => reflexivity x + end. + End iso_equiv_relation. + +End Morphisms. + +Notation IsCategory C := (forall s d : object C, IsEquiv (@idtoiso C s d)). + +Notation isotoid C s d := (@equiv_inv _ _ (@idtoiso C s d) _). + +Notation cat_of obj := + (@Build_PreCategory obj + (fun x y => x -> y) + (fun _ x => x) + (fun _ _ _ f g => f o g)%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + ). +Definition set_cat : PreCategory := cat_of hSet. +Set Implicit Arguments. + +Local Open Scope morphism_scope. + +Section Grothendieck. + Variable C : PreCategory. + Variable F : Functor C set_cat. + + Record Pair := + { + c : C; + x : F c + }. + + Local Notation Gmorphism s d := + { f : morphism C s.(c) d.(c) + | morphism_of F f s.(x) = d.(x) }. + + Definition identity_H s + := apD10 (identity_of F s.(c)) s.(x). + + Definition Gidentity s : Gmorphism s s. + Proof. + exists 1. + apply identity_H. + Defined. + + Definition Gcategory : PreCategory. + Proof. + unshelve refine (@Build_PreCategory + Pair + (fun s d => Gmorphism s d) + Gidentity + _ + _ + _ + _); admit. + Defined. +End Grothendieck. + +Lemma isotoid_1 {C} `{IsCategory C} {x : C} {H : IsIsomorphism (identity x)} +: isotoid C x x {| morphism_isomorphic := (identity x) ; isisomorphism_isomorphic := H |} + = idpath. + admit. +Defined. +Generalizable All Variables. + +Section Grothendieck2. + Context `{IsCategory C}. + Variable F : Functor C set_cat. + + Instance iscategory_grothendieck_toset : IsCategory (Gcategory F). + Proof. + intros s d. + unshelve refine (isequiv_adjointify _ _ _ _). + { + intro m. + transparent assert (H' : (s.(c) = d.(c))). + { + apply (idtoiso C (x := s.(c)) (y := d.(c)))^-1%function. + exists (m : morphism _ _ _).1. + admit. + + } + { + transitivity {| x := transport (fun x => F x) H' s.(x) |}. + admit. + + { + change d with {| c := d.(c) ; x := d.(x) |}; simpl. + apply ap. + subst H'. + simpl. + refine (transport_idmap_ap _ (fun x => F x : Type) _ _ _ _ @ _ @ (m : morphism _ _ _).2). + change (fun x => F x : Type) with (trunctype_type o object_of F)%function. + admit. + } + } + } + { + admit. + } + + { + intro x. + hnf in s, d. + destruct x. + simpl. + erewrite @isotoid_1. + Abort. +End Grothendieck2. diff --git a/test-suite/bugs/closed/4120.v b/test-suite/bugs/closed/bug_4120.v index 315dc0d242..315dc0d242 100644 --- a/test-suite/bugs/closed/4120.v +++ b/test-suite/bugs/closed/bug_4120.v diff --git a/test-suite/bugs/closed/4121.v b/test-suite/bugs/closed/bug_4121.v index b236846710..b236846710 100644 --- a/test-suite/bugs/closed/4121.v +++ b/test-suite/bugs/closed/bug_4121.v diff --git a/test-suite/bugs/closed/4132.v b/test-suite/bugs/closed/bug_4132.v index 806ffb771f..806ffb771f 100644 --- a/test-suite/bugs/closed/4132.v +++ b/test-suite/bugs/closed/bug_4132.v diff --git a/test-suite/bugs/closed/4149.v b/test-suite/bugs/closed/bug_4149.v index b81c680cd7..b81c680cd7 100644 --- a/test-suite/bugs/closed/4149.v +++ b/test-suite/bugs/closed/bug_4149.v diff --git a/test-suite/bugs/closed/bug_4151.v b/test-suite/bugs/closed/bug_4151.v new file mode 100644 index 0000000000..9ec8c01ac6 --- /dev/null +++ b/test-suite/bugs/closed/bug_4151.v @@ -0,0 +1,405 @@ +Lemma foo (H : forall A, A) : forall A, A. + Show Universes. + eexact H. +Qed. + +(* File reduced by coq-bug-finder from original input, then from 6390 lines to 397 lines *) +(* coqc version 8.5beta1 (March 2015) compiled on Mar 17 2015 12:34:25 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (1b3759e78f227eb85a128c58b8ce8c11509dd8c3) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Import Coq.Lists.SetoidList. +Require Export Coq.Program.Program. + +Global Set Implicit Arguments. +Global Set Asymmetric Patterns. + +Fixpoint combine_sig_helper {T} {P : T -> Prop} (ls : list T) : (forall x, In x ls -> P x) -> list (sig P). + admit. +Defined. + +Lemma Forall_forall1_transparent_helper_1 {A P} {x : A} {xs : list A} {l : list A} + (H : Forall P l) (H' : x::xs = l) +: P x. + admit. +Defined. +Lemma Forall_forall1_transparent_helper_2 {A P} {x : A} {xs : list A} {l : list A} + (H : Forall P l) (H' : x::xs = l) +: Forall P xs. + admit. +Defined. + +Fixpoint Forall_forall1_transparent {A} (P : A -> Prop) (l : list A) {struct l} +: Forall P l -> forall x, In x l -> P x + := match l as l return Forall P l -> forall x, In x l -> P x with + | nil => fun _ _ f => match f : False with end + | x::xs => fun H x' H' => + match H' with + | or_introl H'' => eq_rect x + P + (Forall_forall1_transparent_helper_1 H eq_refl) + _ + H'' + | or_intror H'' => @Forall_forall1_transparent A P xs (Forall_forall1_transparent_helper_2 H eq_refl) _ H'' + end + end. + +Definition combine_sig {T P ls} (H : List.Forall P ls) : list (@sig T P) + := combine_sig_helper ls (@Forall_forall1_transparent T P ls H). +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +Record string_like (CharType : Type) := + { + String :> Type; + Singleton : CharType -> String where "[ x ]" := (Singleton x); + Empty : String; + Concat : String -> String -> String where "x ++ y" := (Concat x y); + bool_eq : String -> String -> bool; + bool_eq_correct : forall x y : String, bool_eq x y = true <-> x = y; + Length : String -> nat; + Associativity : forall x y z, (x ++ y) ++ z = x ++ (y ++ z); + LeftId : forall x, Empty ++ x = x; + RightId : forall x, x ++ Empty = x; + Singleton_Length : forall x, Length (Singleton x) = 1; + Length_correct : forall s1 s2, Length s1 + Length s2 = Length (s1 ++ s2); + Length_Empty : Length Empty = 0; + Empty_Length : forall s1, Length s1 = 0 -> s1 = Empty; + Not_Singleton_Empty : forall x, Singleton x <> Empty; + SplitAt : nat -> String -> String * String; + SplitAt_correct : forall n s, fst (SplitAt n s) ++ snd (SplitAt n s) = s; + SplitAt_concat_correct : forall s1 s2, SplitAt (Length s1) (s1 ++ s2) = (s1, s2); + SplitAtLength_correct : forall n s, Length (fst (SplitAt n s)) = min (Length s) n + }. + +Delimit Scope string_like_scope with string_like. +Bind Scope string_like_scope with String. +Arguments Length {_%type_scope _} _%string_like. +Notation "[[ x ]]" := (@Singleton _ _ x) : string_like_scope. +Infix "++" := (@Concat _ _) : string_like_scope. +Infix "=s" := (@bool_eq _ _) (at level 70, right associativity) : string_like_scope. + +Definition str_le {CharType} {String : string_like CharType} (s1 s2 : String) + := Length s1 < Length s2 \/ s1 = s2. +Infix "≤s" := str_le (at level 70, right associativity). + +Record StringWithSplitState {CharType} (String : string_like CharType) (split_stateT : String -> Type) := + { string_val :> String; + state_val : split_stateT string_val }. + +Module Export ContextFreeGrammar. + Require Import Coq.Strings.String. + + Section cfg. + Variable CharType : Type. + + Section definitions. + + Inductive item := + | Terminal (_ : CharType) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + End cfg. + +End ContextFreeGrammar. +Module Export BaseTypes. + Import Coq.Strings.String. + + Local Open Scope string_like_scope. + + Inductive any_grammar CharType := + | include_item (_ : item CharType) + | include_production (_ : production CharType) + | include_productions (_ : productions CharType) + | include_nonterminal (_ : string). + Global Coercion include_item : item >-> any_grammar. + Global Coercion include_production : production >-> any_grammar. + + Section recursive_descent_parser. + Context {CharType : Type} + {String : string_like CharType} + {G : grammar CharType}. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + initial_nonterminals_data : nonterminals_listT; + is_valid_nonterminal : nonterminals_listT -> string -> bool; + remove_nonterminal : nonterminals_listT -> string -> nonterminals_listT; + nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal = true + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + ntl_wf : well_founded nonterminals_listT_R }. + + Class parser_computational_types_dataT := + { predata :> parser_computational_predataT; + split_stateT : String -> nonterminals_listT -> any_grammar CharType -> String -> Type }. + + Class parser_computational_dataT' `{parser_computational_types_dataT} := + { split_string_for_production + : forall (str0 : String) (valid : nonterminals_listT) (it : item CharType) (its : production CharType) (str : StringWithSplitState String (split_stateT str0 valid (it::its : production CharType))), + list (StringWithSplitState String (split_stateT str0 valid it) + * StringWithSplitState String (split_stateT str0 valid its)); + split_string_for_production_correct + : forall str0 valid it its str, + let P f := List.Forall f (@split_string_for_production str0 valid it its str) in + P (fun s1s2 => (fst s1s2 ++ snd s1s2 =s str) = true) }. + End recursive_descent_parser. + +End BaseTypes. +Import Coq.Strings.String. + +Section cfg. + Context CharType (String : string_like CharType) (G : grammar CharType). + Context (names_listT : Type) + (initial_names_data : names_listT) + (is_valid_name : names_listT -> string -> bool) + (remove_name : names_listT -> string -> names_listT) + (names_listT_R : names_listT -> names_listT -> Prop) + (remove_name_dec : forall ls name, + is_valid_name ls name = true + -> names_listT_R (remove_name ls name) ls) + (remove_name_1 + : forall ls ps ps', + is_valid_name (remove_name ls ps) ps' = true + -> is_valid_name ls ps' = true) + (remove_name_2 + : forall ls ps ps', + is_valid_name (remove_name ls ps) ps' = false + <-> is_valid_name ls ps' = false \/ ps = ps') + (ntl_wf : well_founded names_listT_R). + + Inductive minimal_parse_of + : forall (str0 : String) (valid : names_listT) + (str : String), + productions CharType -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : names_listT) + (str : String), + production CharType -> Type := + | MinParseProductionNil : forall str0 valid, + @minimal_parse_of_production str0 valid (Empty _) nil + | MinParseProductionCons : forall str0 valid str strs pat pats, + str ++ strs ≤s str0 + -> @minimal_parse_of_item str0 valid str pat + -> @minimal_parse_of_production str0 valid strs pats + -> @minimal_parse_of_production str0 valid (str ++ strs) (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : names_listT) + (str : String), + item CharType -> Type := + | MinParseTerminal : forall str0 valid x, + @minimal_parse_of_item str0 valid [[ x ]]%string_like (Terminal x) + | MinParseNonTerminal + : forall str0 valid str name, + @minimal_parse_of_name str0 valid str name + -> @minimal_parse_of_item str0 valid str (NonTerminal CharType name) + with minimal_parse_of_name + : forall (str0 : String) (valid : names_listT) + (str : String), + string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid name str, + Length str < Length str0 + -> is_valid_name initial_names_data name = true + -> @minimal_parse_of str initial_names_data str (Lookup G name) + -> @minimal_parse_of_name str0 valid str name + | MinParseNonTerminalStrEq + : forall str valid name, + is_valid_name initial_names_data name = true + -> is_valid_name valid name = true + -> @minimal_parse_of str (remove_name valid name) str (Lookup G name) + -> @minimal_parse_of_name str valid str name. +End cfg. + +Local Coercion is_true : bool >-> Sortclass. + +Local Open Scope string_like_scope. + +Section general. + Context {CharType} {String : string_like CharType} {G : grammar CharType}. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_stateT : String -> Type; + data' :> _ := {| BaseTypes.predata := predata ; BaseTypes.split_stateT := fun _ _ _ => split_stateT |}; + split_string_for_production + : forall it its, + StringWithSplitState String split_stateT + -> list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT); + split_string_for_production_correct + : forall it its (str : StringWithSplitState String split_stateT), + let P f := List.Forall f (split_string_for_production it its str) in + P (fun s1s2 => + (fst s1s2 ++ snd s1s2 =s str) = true); + premethods :> parser_computational_dataT' + := @Build_parser_computational_dataT' + _ String data' + (fun _ _ => split_string_for_production) + (fun _ _ => split_string_for_production_correct) }. + + Definition split_list_completeT `{data : boolean_parser_dataT} + {str0 valid} + (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) + (split_list : list (StringWithSplitState String split_stateT * StringWithSplitState String split_stateT)) + (it : item CharType) (its : production CharType) + := ({ s1s2 : String * String + & (fst s1s2 ++ snd s1s2 =s str) + * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) + * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type) + -> ({ s1s2 : StringWithSplitState String split_stateT * StringWithSplitState String split_stateT + & (In s1s2 split_list) + * (minimal_parse_of_item _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (fst s1s2) it) + * (minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid (snd s1s2) its) }%type). +End general. + +Section recursive_descent_parser. + Context {CharType} + {String : string_like CharType} + {G : grammar CharType}. + Context `{data : @boolean_parser_dataT _ String}. + + Section bool. + Section parts. + Definition parse_item + (str_matches_nonterminal : string -> bool) + (str : StringWithSplitState String split_stateT) + (it : item CharType) + : bool + := match it with + | Terminal ch => [[ ch ]] =s str + | NonTerminal nt => str_matches_nonterminal nt + end. + + Section production. + Context {str0} + (parse_nonterminal + : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Fixpoint parse_production + (str : StringWithSplitState String split_stateT) + (pf : str ≤s str0) + (prod : production CharType) + : bool. + Proof. + refine + match prod with + | nil => + + str =s Empty _ + | it::its + => let parse_production' := fun str pf => parse_production str pf its in + fold_right + orb + false + (let mapF f := map f (combine_sig (split_string_for_production_correct it its str)) in + mapF (fun s1s2p => + (parse_item + (parse_nonterminal (fst (proj1_sig s1s2p)) _) + (fst (proj1_sig s1s2p)) + it) + && parse_production' (snd (proj1_sig s1s2p)) _)%bool) + end; + revert pf; clear; intros; admit. + Defined. + End production. + + End parts. + End bool. +End recursive_descent_parser. + +Section sound. + Context CharType (String : string_like CharType) (G : grammar CharType). + Context `{data : @boolean_parser_dataT CharType String}. + + Section production. + Context (str0 : String) + (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Definition parse_nonterminal_completeT P + := forall valid (str : StringWithSplitState String split_stateT) pf nonterminal (H_sub : P str0 valid nonterminal), + minimal_parse_of_name _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal + -> @parse_nonterminal str pf nonterminal = true. + + Lemma parse_production_complete + valid Pv + (parse_nonterminal_complete : parse_nonterminal_completeT Pv) + (Hinit : forall str (pf : str ≤s str0) nonterminal, + minimal_parse_of_name String G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str nonterminal + -> Pv str0 valid nonterminal) + (str : StringWithSplitState String split_stateT) (pf : str ≤s str0) + (prod : production CharType) + (split_string_for_production_complete' + : forall str0 valid str pf, + Forall_tails + (fun prod' => + match prod' return Type with + | nil => True + | it::its => split_list_completeT (G := G) (valid := valid) (str0 := str0) str pf (split_string_for_production it its str) it its + end) + prod) + : minimal_parse_of_production _ G initial_nonterminals_data is_valid_nonterminal remove_nonterminal str0 valid str prod + -> parse_production parse_nonterminal str pf prod = true. + admit. + Defined. + End production. + Context (str0 : String) + (parse_nonterminal : forall (str : StringWithSplitState String split_stateT), + str ≤s str0 + -> string + -> bool). + + Goal forall (a : production CharType), + (forall (str1 : String) (valid : nonterminals_listT) + (str : StringWithSplitState String split_stateT) + (pf : str ≤s str1), + Forall_tails + (fun prod' : list (item CharType) => + match prod' with + | [] => True + | it :: its => + split_list_completeT (G := G) (valid := valid) str pf + (split_string_for_production it its str) it its + end) a) -> + forall (str : String) (pf : str ≤s str0) (st : split_stateT str), + parse_production parse_nonterminal + {| string_val := str; state_val := st |} pf a = true. + Proof. + intros a X **. + eapply parse_production_complete. + Focus 3. + exact X. + Undo. + assumption. + Undo. + eassumption. (* no applicable tactic *) + Abort. +End sound. diff --git a/test-suite/bugs/closed/4161.v b/test-suite/bugs/closed/bug_4161.v index d2003ab1f0..d2003ab1f0 100644 --- a/test-suite/bugs/closed/4161.v +++ b/test-suite/bugs/closed/bug_4161.v diff --git a/test-suite/bugs/closed/bug_4165.v b/test-suite/bugs/closed/bug_4165.v new file mode 100644 index 0000000000..5333a0f6cf --- /dev/null +++ b/test-suite/bugs/closed/bug_4165.v @@ -0,0 +1,8 @@ +Lemma foo : True. +Proof. +pose (fun x : nat => (let H:=true in x)) as s. +match eval cbv delta [s] in s with +| context C[true] => + let C':=context C[false] in pose C' as s' +end. +Abort. diff --git a/test-suite/bugs/closed/bug_4187.v b/test-suite/bugs/closed/bug_4187.v new file mode 100644 index 0000000000..d729d1a287 --- /dev/null +++ b/test-suite/bugs/closed/bug_4187.v @@ -0,0 +1,714 @@ +(* Lifted from https://coq.inria.fr/bugs/show_bug.cgi?id=4187 *) +(* File reduced by coq-bug-finder from original input, then from 715 lines to 696 lines *) +(* coqc version 8.4pl5 (December 2014) compiled on Dec 28 2014 03:23:16 with OCaml 4.01.0 + coqtop version 8.4pl5 (December 2014) *) +Set Asymmetric Patterns. +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Import Coq.Lists.List. +Require Import Coq.Setoids.Setoid. +Require Import Coq.Numbers.Natural.Peano.NPeano. +Global Set Implicit Arguments. +Global Generalizable All Variables. +Coercion is_true : bool >-> Sortclass. +Coercion bool_of_sumbool {A B} (x : {A} + {B}) : bool := if x then true else false. +Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type + := match ls return Type with + | nil => True + | x::xs => (P x * ForallT P xs)%type + end. +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +Module Export ADTSynthesis_DOT_Common_DOT_Wf. +Module Export ADTSynthesis. +Module Export Common. +Module Export Wf. + +Section wf. + Section wf_prod. + Context A B (RA : relation A) (RB : relation B). +Definition prod_relation : relation (A * B). +exact (fun ab a'b' => + RA (fst ab) (fst a'b') \/ (fst a'b' = fst ab /\ RB (snd ab) (snd a'b'))). +Defined. + + Fixpoint well_founded_prod_relation_helper + a b + (wf_A : Acc RA a) (wf_B : well_founded RB) {struct wf_A} + : Acc prod_relation (a, b) + := match wf_A with + | Acc_intro fa => (fix wf_B_rec b' (wf_B' : Acc RB b') : Acc prod_relation (a, b') + := Acc_intro + _ + (fun ab => + match ab as ab return prod_relation ab (a, b') -> Acc prod_relation ab with + | (a'', b'') => + fun pf => + match pf with + | or_introl pf' + => @well_founded_prod_relation_helper + _ _ + (fa _ pf') + wf_B + | or_intror (conj pfa pfb) + => match wf_B' with + | Acc_intro fb + => eq_rect + _ + (fun a'' => Acc prod_relation (a'', b'')) + (wf_B_rec _ (fb _ pfb)) + _ + pfa + end + end + end) + ) b (wf_B b) + end. + + Definition well_founded_prod_relation : well_founded RA -> well_founded RB -> well_founded prod_relation. + Proof. + intros wf_A wf_B [a b]; hnf in *. + apply well_founded_prod_relation_helper; auto. + Defined. + End wf_prod. + + Section wf_projT1. + Context A (B : A -> Type) (R : relation A). +Definition projT1_relation : relation (sigT B). +exact (fun ab a'b' => + R (projT1 ab) (projT1 a'b')). +Defined. + + Definition well_founded_projT1_relation : well_founded R -> well_founded projT1_relation. + Proof. + intros wf [a b]; hnf in *. + induction (wf a) as [a H IH]. + constructor. + intros y r. + specialize (IH _ r (projT2 y)). + destruct y. + exact IH. + Defined. + End wf_projT1. +End wf. + +Section Fix3. + Context A (B : A -> Type) (C : forall a, B a -> Type) (D : forall a b, C a b -> Type) + (R : A -> A -> Prop) (Rwf : well_founded R) + (P : forall a b c, D a b c -> Type) + (F : forall x : A, (forall y : A, R y x -> forall b c d, P y b c d) -> forall b c d, P x b c d). +Definition Fix3 a b c d : @P a b c d. +exact (@Fix { a : A & { b : B a & { c : C b & D c } } } + (fun x y => R (projT1 x) (projT1 y)) + (well_founded_projT1_relation Rwf) + (fun abcd => P (projT2 (projT2 (projT2 abcd)))) + (fun x f => @F (projT1 x) (fun y r b c d => f (existT _ y (existT _ b (existT _ c d))) r) _ _ _) + (existT _ a (existT _ b (existT _ c d)))). +Defined. +End Fix3. + +End Wf. + +End Common. + +End ADTSynthesis. + +End ADTSynthesis_DOT_Common_DOT_Wf. + +Module Export ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. +Module Export ADTSynthesis. +Module Export Parsers. +Module Export StringLike. +Module Export Core. +Import Coq.Setoids.Setoid. +Import Coq.Classes.Morphisms. + + + +Module Export StringLike. + Class StringLike {Char : Type} := + { + String :> Type; + is_char : String -> Char -> bool; + length : String -> nat; + take : nat -> String -> String; + drop : nat -> String -> String; + bool_eq : String -> String -> bool; + beq : relation String := fun x y => bool_eq x y + }. + + Arguments StringLike : clear implicits. + Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. + Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. + Local Open Scope string_like_scope. + + Definition str_le `{StringLike Char} (s1 s2 : String) + := length s1 < length s2 \/ s1 =s s2. + Infix "≤s" := str_le (at level 70, right associativity). + + Class StringLikeProperties (Char : Type) `{StringLike Char} := + { + singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; + length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; + bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; + is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; + length_Proper :> Proper (beq ==> eq) length; + take_Proper :> Proper (eq ==> beq ==> beq) take; + drop_Proper :> Proper (eq ==> beq ==> beq) drop; + bool_eq_Equivalence :> Equivalence beq; + bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; + take_short_length : forall str n, n <= length str -> length (take n str) = n; + take_long : forall str n, length str <= n -> take n str =s str; + take_take : forall str n m, take n (take m str) =s take (min n m) str; + drop_length : forall str n, length (drop n str) = length str - n; + drop_0 : forall str, drop 0 str =s str; + drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; + drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); + take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str) + }. + + Arguments StringLikeProperties Char {_}. +End StringLike. + +End Core. + +End StringLike. + +End Parsers. + +End ADTSynthesis. + +End ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core. + +Module Export ADTSynthesis. +Module Export Parsers. +Module Export ContextFreeGrammar. +Require Import Coq.Strings.String. +Require Import Coq.Lists.List. +Export ADTSynthesis.Parsers.StringLike.Core. +Import ADTSynthesis.Common. + +Local Open Scope string_like_scope. + +Section cfg. + Context {Char : Type}. + + Section definitions. + + Inductive item := + | Terminal (_ : Char) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + Section parse. + Context {HSL : StringLike Char}. + Variable G : grammar. + + Inductive parse_of (str : String) : productions -> Type := + | ParseHead : forall pat pats, parse_of_production str pat + -> parse_of str (pat::pats) + | ParseTail : forall pat pats, parse_of str pats + -> parse_of str (pat::pats) + with parse_of_production (str : String) : production -> Type := + | ParseProductionNil : length str = 0 -> parse_of_production str nil + | ParseProductionCons : forall n pat pats, + parse_of_item (take n str) pat + -> parse_of_production (drop n str) pats + -> parse_of_production str (pat::pats) + with parse_of_item (str : String) : item -> Type := + | ParseTerminal : forall ch, str ~= [ ch ] -> parse_of_item str (Terminal ch) + | ParseNonTerminal : forall nt, parse_of str (Lookup G nt) + -> parse_of_item str (NonTerminal nt). + End parse. +End cfg. + +Arguments item _ : clear implicits. +Arguments production _ : clear implicits. +Arguments productions _ : clear implicits. +Arguments grammar _ : clear implicits. + +End ContextFreeGrammar. +End Parsers. +End ADTSynthesis. + +Module Export BaseTypes. + +Section recursive_descent_parser. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + initial_nonterminals_data : nonterminals_listT; + is_valid_nonterminal : nonterminals_listT -> String.string -> bool; + remove_nonterminal : nonterminals_listT -> String.string -> nonterminals_listT; + nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + ntl_wf : well_founded nonterminals_listT_R }. + + Class parser_removal_dataT' `{predata : parser_computational_predataT} := + { remove_nonterminal_1 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' + -> is_valid_nonterminal ls ps'; + remove_nonterminal_2 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' = false + <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. +End recursive_descent_parser. + +End BaseTypes. +Import Coq.Lists.List. +Import ADTSynthesis.Parsers.ContextFreeGrammar. + +Local Open Scope string_like_scope. + +Section cfg. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + Context {predata : @parser_computational_predataT} + {rdata' : @parser_removal_dataT' predata}. + + Inductive minimal_parse_of + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + productions Char -> Type := + | MinParseHead : forall str0 valid str pat pats, + @minimal_parse_of_production str0 valid str pat + -> @minimal_parse_of str0 valid str (pat::pats) + | MinParseTail : forall str0 valid str pat pats, + @minimal_parse_of str0 valid str pats + -> @minimal_parse_of str0 valid str (pat::pats) + with minimal_parse_of_production + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + production Char -> Type := + | MinParseProductionNil : forall str0 valid str, + length str = 0 + -> @minimal_parse_of_production str0 valid str nil + | MinParseProductionCons : forall str0 valid str n pat pats, + str ≤s str0 + -> @minimal_parse_of_item str0 valid (take n str) pat + -> @minimal_parse_of_production str0 valid (drop n str) pats + -> @minimal_parse_of_production str0 valid str (pat::pats) + with minimal_parse_of_item + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + item Char -> Type := + | MinParseTerminal : forall str0 valid str ch, + str ~= [ ch ] + -> @minimal_parse_of_item str0 valid str (Terminal ch) + | MinParseNonTerminal + : forall str0 valid str (nt : String.string), + @minimal_parse_of_nonterminal str0 valid str nt + -> @minimal_parse_of_item str0 valid str (NonTerminal nt) + with minimal_parse_of_nonterminal + : forall (str0 : String) (valid : nonterminals_listT) + (str : String), + String.string -> Type := + | MinParseNonTerminalStrLt + : forall str0 valid (nt : String.string) str, + length str < length str0 + -> is_valid_nonterminal initial_nonterminals_data nt + -> @minimal_parse_of str initial_nonterminals_data str (Lookup G nt) + -> @minimal_parse_of_nonterminal str0 valid str nt + | MinParseNonTerminalStrEq + : forall str0 str valid nonterminal, + str =s str0 + -> is_valid_nonterminal initial_nonterminals_data nonterminal + -> is_valid_nonterminal valid nonterminal + -> @minimal_parse_of str0 (remove_nonterminal valid nonterminal) str (Lookup G nonterminal) + -> @minimal_parse_of_nonterminal str0 valid str nonterminal. +End cfg. +Import ADTSynthesis.Common. + +Section general. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_string_for_production + : item Char -> production Char -> String -> list nat }. + + Global Coercion predata : boolean_parser_dataT >-> parser_computational_predataT. + + Definition split_list_completeT `{data : @parser_computational_predataT} + {str0 valid} + (it : item Char) (its : production Char) + (str : String) + (pf : str ≤s str0) + (split_list : list nat) + + := ({ n : nat + & (minimal_parse_of_item (G := G) (predata := data) str0 valid (take n str) it) + * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type) + -> ({ n : nat + & (In n split_list) + * (minimal_parse_of_item (G := G) str0 valid (take n str) it) + * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type). + + Class boolean_parser_completeness_dataT' `{data : boolean_parser_dataT} := + { split_string_for_production_complete + : forall str0 valid str (pf : str ≤s str0) nt, + is_valid_nonterminal initial_nonterminals_data nt + -> ForallT + (Forall_tails + (fun prod + => match prod return Type with + | nil => True + | it::its + => @split_list_completeT data str0 valid it its str pf (split_string_for_production it its str) + end)) + (Lookup G nt) }. +End general. + +Module Export BooleanRecognizer. +Import Coq.Numbers.Natural.Peano.NPeano. +Import Coq.Arith.Compare_dec. +Import Coq.Arith.Wf_nat. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}. + Context {data : @boolean_parser_dataT Char _}. + + Section bool. + Section parts. +Definition parse_item + (str_matches_nonterminal : String.string -> bool) + (str : String) + (it : item Char) + : bool. +Admitted. + + Section production. + Context {str0} + (parse_nonterminal + : forall (str : String), + str ≤s str0 + -> String.string + -> bool). + + Fixpoint parse_production + (str : String) + (pf : str ≤s str0) + (prod : production Char) + : bool. + Proof. + refine + match prod with + | nil => + + Nat.eq_dec (length str) 0 + | it::its + => let parse_production' := fun str pf => parse_production str pf its in + fold_right + orb + false + (map (fun n => + (parse_item + (parse_nonterminal (str := take n str) _) + (take n str) + it) + && parse_production' (drop n str) _)%bool + (split_string_for_production it its str)) + end; + revert pf; clear -HSLP; intros; admit. + Defined. + End production. + + Section productions. + Context {str0} + (parse_nonterminal + : forall (str : String) + (pf : str ≤s str0), + String.string -> bool). +Definition parse_productions + (str : String) + (pf : str ≤s str0) + (prods : productions Char) + : bool. +exact (fold_right orb + false + (map (parse_production parse_nonterminal pf) + prods)). +Defined. + End productions. + + Section nonterminals. + Section step. + Context {str0 valid} + (parse_nonterminal + : forall (p : String * nonterminals_listT), + prod_relation (ltof _ length) nonterminals_listT_R p (str0, valid) + -> forall str : String, + str ≤s fst p -> String.string -> bool). + + Definition parse_nonterminal_step + (str : String) + (pf : str ≤s str0) + (nt : String.string) + : bool. + Proof. + refine + (if lt_dec (length str) (length str0) + then + parse_productions + (@parse_nonterminal + (str : String, initial_nonterminals_data) + (or_introl _)) + (or_intror (reflexivity _)) + (Lookup G nt) + else + if Sumbool.sumbool_of_bool (is_valid_nonterminal valid nt) + then + parse_productions + (@parse_nonterminal + (str0 : String, remove_nonterminal valid nt) + (or_intror (conj eq_refl (remove_nonterminal_dec _ nt _)))) + (str := str) + _ + (Lookup G nt) + else + false); + assumption. + Defined. + End step. + + Section wf. +Definition parse_nonterminal_or_abort + : forall (p : String * nonterminals_listT) + (str : String), + str ≤s fst p + -> String.string + -> bool. +exact (Fix3 + _ _ _ + (well_founded_prod_relation + (well_founded_ltof _ length) + ntl_wf) + _ + (fun sl => @parse_nonterminal_step (fst sl) (snd sl))). +Defined. +Definition parse_nonterminal + (str : String) + (nt : String.string) + : bool. +exact (@parse_nonterminal_or_abort + (str : String, initial_nonterminals_data) str + (or_intror (reflexivity _)) nt). +Defined. + End wf. + End nonterminals. + End parts. + End bool. +End recursive_descent_parser. + +Section cfg. + Context {Char} {HSL : StringLike Char} {HSLP : @StringLikeProperties Char HSL} (G : grammar Char). + + Section definitions. + Context (P : String -> String.string -> Type). + + Definition Forall_parse_of_item' + (Forall_parse_of : forall {str pats} (p : parse_of G str pats), Type) + {str it} (p : parse_of_item G str it) + := match p return Type with + | ParseTerminal ch pf => unit + | ParseNonTerminal nt p' + => (P str nt * Forall_parse_of p')%type + end. + + Fixpoint Forall_parse_of {str pats} (p : parse_of G str pats) + := match p with + | ParseHead pat pats p' + => Forall_parse_of_production p' + | ParseTail _ _ p' + => Forall_parse_of p' + end + with Forall_parse_of_production {str pat} (p : parse_of_production G str pat) + := match p return Type with + | ParseProductionNil pf => unit + | ParseProductionCons pat strs pats p' p'' + => (Forall_parse_of_item' (@Forall_parse_of) p' * Forall_parse_of_production p'')%type + end. + + Definition Forall_parse_of_item {str it} (p : parse_of_item G str it) + := @Forall_parse_of_item' (@Forall_parse_of) str it p. + End definitions. + + End cfg. + +Section recursive_descent_parser_list. + Context {Char} {HSL : StringLike Char} {HLSP : StringLikeProperties Char} {G : grammar Char}. +Definition rdp_list_nonterminals_listT : Type. +exact (list String.string). +Defined. +Definition rdp_list_is_valid_nonterminal : rdp_list_nonterminals_listT -> String.string -> bool. +admit. +Defined. +Definition rdp_list_remove_nonterminal : rdp_list_nonterminals_listT -> String.string -> rdp_list_nonterminals_listT. +admit. +Defined. +Definition rdp_list_nonterminals_listT_R : rdp_list_nonterminals_listT -> rdp_list_nonterminals_listT -> Prop. +exact (ltof _ (@List.length _)). +Defined. + Lemma rdp_list_remove_nonterminal_dec : forall ls prods, + @rdp_list_is_valid_nonterminal ls prods = true + -> @rdp_list_nonterminals_listT_R (@rdp_list_remove_nonterminal ls prods) ls. +admit. +Defined. + Lemma rdp_list_ntl_wf : well_founded rdp_list_nonterminals_listT_R. + Proof. + unfold rdp_list_nonterminals_listT_R. + intro. + apply well_founded_ltof. + Defined. + + Global Instance rdp_list_predata : parser_computational_predataT + := { nonterminals_listT := rdp_list_nonterminals_listT; + initial_nonterminals_data := Valid_nonterminals G; + is_valid_nonterminal := rdp_list_is_valid_nonterminal; + remove_nonterminal := rdp_list_remove_nonterminal; + nonterminals_listT_R := rdp_list_nonterminals_listT_R; + remove_nonterminal_dec := rdp_list_remove_nonterminal_dec; + ntl_wf := rdp_list_ntl_wf }. +End recursive_descent_parser_list. + +Section sound. + Section general. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). + Context {data : @boolean_parser_dataT Char _} + {cdata : @boolean_parser_completeness_dataT' Char _ G data} + {rdata : @parser_removal_dataT' predata}. + + Section parts. + + Section nonterminals. + Section wf. + + Lemma parse_nonterminal_sound + (str : String) (nonterminal : String.string) + : parse_nonterminal (G := G) str nonterminal + = true + -> parse_of_item G str (NonTerminal nonterminal). +admit. +Defined. + End wf. + End nonterminals. + End parts. + End general. +End sound. + +Import Coq.Strings.String. +Import ADTSynthesis.Parsers.ContextFreeGrammar. + +Fixpoint list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T + := match ls with + | nil => fun _ => default + | (str, t)::ls' => fun s => if string_dec str s + then t + else list_to_productions default ls' s + end. + +Fixpoint list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T + := {| Start_symbol := hd ""%string (map (@fst _ _) ls); + Lookup := list_to_productions default ls; + Valid_nonterminals := map (@fst _ _) ls |}. + +Section interface. + Context {Char} (G : grammar Char). +Definition production_is_reachable (p : production Char) : Prop. +admit. +Defined. +Definition split_list_is_complete `{HSL : StringLike Char} (str : String) (it : item Char) (its : production Char) + (splits : list nat) + : Prop. +exact (forall n, + n <= length str + -> parse_of_item G (take n str) it + -> parse_of_production G (drop n str) its + -> production_is_reachable (it::its) + -> List.In n splits). +Defined. + + Record Splitter := + { + string_type :> StringLike Char; + splits_for : String -> item Char -> production Char -> list nat; + + string_type_properties :> StringLikeProperties Char; + splits_for_complete : forall str it its, + split_list_is_complete str it its (splits_for str it its) + + }. + Global Existing Instance string_type_properties. + + Record Parser (HSL : StringLike Char) := + { + has_parse : @String Char HSL -> bool; + + has_parse_sound : forall str, + has_parse str = true + -> parse_of_item G str (NonTerminal (Start_symbol G)); + + has_parse_complete : forall str (p : parse_of_item G str (NonTerminal (Start_symbol G))), + Forall_parse_of_item + (fun _ nt => List.In nt (Valid_nonterminals G)) + p + -> has_parse str = true + }. +End interface. + +Module Export ParserImplementation. + +Section implementation. + Context {Char} {G : grammar Char}. + Context (splitter : Splitter G). + + Local Instance parser_data : @boolean_parser_dataT Char _ := + { predata := rdp_list_predata (G := G); + split_string_for_production it its str + := splits_for splitter str it its }. + + Program Definition parser : Parser G splitter + := {| has_parse str := parse_nonterminal (G := G) (data := parser_data) str (Start_symbol G); + has_parse_sound str Hparse := parse_nonterminal_sound G _ _ Hparse; + has_parse_complete str p Hp := _ |}. + Next Obligation. +admit. +Defined. +End implementation. + +End ParserImplementation. + +Section implementation. + Context {Char} {ls : list (String.string * productions Char)}. + Local Notation G := (list_to_grammar (nil::nil) ls) (only parsing). + Context (splitter : Splitter G). + + Local Instance parser_data : @boolean_parser_dataT Char _ := parser_data splitter. + + Goal forall str : @String Char splitter, + let G' := + @BooleanRecognizer.parse_nonterminal Char splitter splitter G parser_data str G = true in + G'. + intros str G'. + Timeout 1 assert (pf' : G' -> Prop) by abstract admit. + Abort. +End implementation. +End BooleanRecognizer. diff --git a/test-suite/bugs/closed/bug_4190.v b/test-suite/bugs/closed/bug_4190.v new file mode 100644 index 0000000000..7e975587f6 --- /dev/null +++ b/test-suite/bugs/closed/bug_4190.v @@ -0,0 +1,18 @@ +Module Type A . + Tactic Notation "bar" := idtac "ITSME". +End A. + +Module Type B. + Tactic Notation "foo" := fail "NOTME". +End B. + +Module Type C := A <+ B. + +Module Type F (Import M : C). + +Lemma foo : True. +Proof. +bar. +Abort. + +End F. diff --git a/test-suite/bugs/closed/bug_4191.v b/test-suite/bugs/closed/bug_4191.v new file mode 100644 index 0000000000..d9268dbe2f --- /dev/null +++ b/test-suite/bugs/closed/bug_4191.v @@ -0,0 +1,5 @@ +(* Test maximal implicit arguments in the presence of let-ins *) +Definition foo (x := 1) {y : nat} (H : y = y) : True := I. +Definition bar {y : nat} (x := 1) (H : y = y) : True := I. +Check bar (eq_refl 1). +Check foo (eq_refl 1). diff --git a/test-suite/bugs/closed/4193.v b/test-suite/bugs/closed/bug_4193.v index 885d04a927..885d04a927 100644 --- a/test-suite/bugs/closed/4193.v +++ b/test-suite/bugs/closed/bug_4193.v diff --git a/test-suite/bugs/closed/bug_4198.v b/test-suite/bugs/closed/bug_4198.v new file mode 100644 index 0000000000..53381b10a5 --- /dev/null +++ b/test-suite/bugs/closed/bug_4198.v @@ -0,0 +1,39 @@ +(* Check that the subterms of the predicate of a match are taken into account *) + +Require Import List. +Open Scope list_scope. +Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'), + let k := + (match H in (_ = y) return x = hd x y with + | eq_refl => eq_refl + end : x = x') + in k = k. + simpl. + intros. + match goal with + | [ |- context G[@hd] ] => idtac + end. +Abort. + +(* This second example comes from CFGV where inspecting subterms of a + match is expecting to inspect first the term to match (even though + it would certainly be better to provide a "match x with _ end" + construct for generically matching a "match") *) + +Ltac find_head_of_head_match T := + match T with context [?E] => + match T with + | E => fail 1 + | _ => constr:(E) + end + end. + +Ltac mydestruct := + match goal with + | |- ?T1 = _ => let E := find_head_of_head_match T1 in destruct E + end. + +Goal forall x, match x with 0 => 0 | _ => 0 end = 0. +intros. +mydestruct. +Abort. diff --git a/test-suite/bugs/closed/4202.v b/test-suite/bugs/closed/bug_4202.v index 522a3604a3..522a3604a3 100644 --- a/test-suite/bugs/closed/4202.v +++ b/test-suite/bugs/closed/bug_4202.v diff --git a/test-suite/bugs/closed/4203.v b/test-suite/bugs/closed/bug_4203.v index eb6867a033..eb6867a033 100644 --- a/test-suite/bugs/closed/4203.v +++ b/test-suite/bugs/closed/bug_4203.v diff --git a/test-suite/bugs/closed/bug_4205.v b/test-suite/bugs/closed/bug_4205.v new file mode 100644 index 0000000000..b6cf214cf9 --- /dev/null +++ b/test-suite/bugs/closed/bug_4205.v @@ -0,0 +1,9 @@ +(* Testing a regression from 8.5beta1 to 8.5beta2 in evar-evar tactic unification problems *) + + +Inductive test : nat -> nat -> nat -> nat -> Prop := + | test1 : forall m n, test m n m n. + +Goal test 1 2 3 4. +erewrite f_equal2 with (f := fun k l => test _ _ k l). +Abort. diff --git a/test-suite/bugs/closed/4214.v b/test-suite/bugs/closed/bug_4214.v index 2e620fce2a..2e620fce2a 100644 --- a/test-suite/bugs/closed/4214.v +++ b/test-suite/bugs/closed/bug_4214.v diff --git a/test-suite/bugs/closed/bug_4216.v b/test-suite/bugs/closed/bug_4216.v new file mode 100644 index 0000000000..5b4f3da160 --- /dev/null +++ b/test-suite/bugs/closed/bug_4216.v @@ -0,0 +1,20 @@ +Generalizable Variables T A. + +Inductive path `(a: A): A -> Type := idpath: path a a. + +Class TMonad (T: Type -> Type) := { + bind: forall {A B: Type}, (T A) -> (A -> T B) -> T B; + ret: forall {A: Type}, A -> T A; + ret_unit_left: forall {A B: Type} (k: A -> T B) (a: A), + path (bind (ret a) k) (k a) + }. + +Let T_fzip `{TMonad T} := fun (A B: Type) (f: T (A -> B)) (t: T A) + => bind t (fun a => bind f (fun g => ret (g a) )). +Let T_pure `{TMonad T} := @ret _ _. + +Let T_pure_id `{TMonad T} {A: Type} (t: A -> A) (x: T A): + path (T_fzip A A (T_pure (A -> A) t) x) x. + unfold T_fzip, T_pure. + Fail rewrite (ret_unit_left (fun g a => ret (g a)) (fun x => x)). +Abort. diff --git a/test-suite/bugs/closed/bug_4217.v b/test-suite/bugs/closed/bug_4217.v new file mode 100644 index 0000000000..af1fe2c755 --- /dev/null +++ b/test-suite/bugs/closed/bug_4217.v @@ -0,0 +1,7 @@ +(* Checking correct index of implicit by pos in fixpoints *) + +Fixpoint ith_default + {default_A : nat} + {As : list nat} + {struct As} : Set. +Abort. diff --git a/test-suite/bugs/closed/bug_4221.v b/test-suite/bugs/closed/bug_4221.v new file mode 100644 index 0000000000..f433c85455 --- /dev/null +++ b/test-suite/bugs/closed/bug_4221.v @@ -0,0 +1,10 @@ +(* Some test checking that interpreting binder names using ltac + context does not accidentally break the bindings *) + +Goal (forall x : nat, x = 1 -> False) -> 1 = 1 -> False. + intros H0 x. + lazymatch goal with + | [ x : forall k : nat, _ |- _ ] + => specialize (fun H0 => x 1 H0) + end. +Abort. diff --git a/test-suite/bugs/closed/4232.v b/test-suite/bugs/closed/bug_4232.v index 61e544a914..61e544a914 100644 --- a/test-suite/bugs/closed/4232.v +++ b/test-suite/bugs/closed/bug_4232.v diff --git a/test-suite/bugs/closed/bug_4234.v b/test-suite/bugs/closed/bug_4234.v new file mode 100644 index 0000000000..0da4313063 --- /dev/null +++ b/test-suite/bugs/closed/bug_4234.v @@ -0,0 +1,8 @@ +Definition UU := Type. + +Definition dirprodpair {X Y : UU} := existT (fun x : X => Y). + +Definition funtoprodtoprod {X Y Z : UU} : { a : X -> Y & X -> Z }. +Proof. + refine (dirprodpair _ (fun x => _)). +Abort. diff --git a/test-suite/bugs/closed/bug_4240.v b/test-suite/bugs/closed/bug_4240.v new file mode 100644 index 0000000000..0009844fb6 --- /dev/null +++ b/test-suite/bugs/closed/bug_4240.v @@ -0,0 +1,13 @@ +(* Check that closure of filter did not restrict the former evar filter *) + +Lemma foo (new : nat) : False. +evar (H1: nat). +set (H3 := 0). +assert (H3' := id H3). +evar (H5: nat). +clear H3. +assert (H5 = new). +unfold H5. +unfold H1. +exact (eq_refl new). +Abort. diff --git a/test-suite/bugs/closed/4250.v b/test-suite/bugs/closed/bug_4250.v index f5d0d1a523..f5d0d1a523 100644 --- a/test-suite/bugs/closed/4250.v +++ b/test-suite/bugs/closed/bug_4250.v diff --git a/test-suite/bugs/closed/bug_4251.v b/test-suite/bugs/closed/bug_4251.v new file mode 100644 index 0000000000..776851cebb --- /dev/null +++ b/test-suite/bugs/closed/bug_4251.v @@ -0,0 +1,17 @@ + +Inductive array : Type -> Type := +| carray : forall A, array A. + +Inductive Mtac : Type -> Prop := +| bind : forall {A B}, Mtac A -> (A -> Mtac B) -> Mtac B +| array_make : forall {A}, A -> Mtac (array A). + +Definition Ref := array. + +Definition ref : forall {A}, A -> Mtac (Ref A) := + fun A x=> array_make x. +Check array Type. +Check fun A : Type => Ref A. + +Definition abs_val (a : Type) := + bind (ref a) (fun r : array Type => array_make tt). diff --git a/test-suite/bugs/closed/4254.v b/test-suite/bugs/closed/bug_4254.v index ef219973df..ef219973df 100644 --- a/test-suite/bugs/closed/4254.v +++ b/test-suite/bugs/closed/bug_4254.v diff --git a/test-suite/bugs/closed/bug_4256.v b/test-suite/bugs/closed/bug_4256.v new file mode 100644 index 0000000000..a88bd28aa9 --- /dev/null +++ b/test-suite/bugs/closed/bug_4256.v @@ -0,0 +1,44 @@ +(* Testing 8.5 regression with type classes not solving evars + redefined while trying to solve them with the type class mechanism *) + +Global Set Universe Polymorphism. +Monomorphic Universe i. +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Inductive trunc_index : Type := +| minus_two : trunc_index +| trunc_S : trunc_index -> trunc_index. +Notation "-1" := (trunc_S minus_two) (at level 0). + +Class IsPointed (A : Type) := point : A. +Arguments point A {_}. + +Record pType := + { pointed_type : Type ; + ispointed_type : IsPointed pointed_type }. +Coercion pointed_type : pType >-> Sortclass. +Existing Instance ispointed_type. + +Private Inductive Trunc (n : trunc_index) (A :Type) : Type := + tr : A -> Trunc n A. +Arguments tr {n A} a. + + + +Record ooGroup := + { classifying_space : pType@{i} }. + +Definition group_loops (X : pType) +: ooGroup. +Proof. + (** This works: *) + pose (x0 := point X). + pose (H := existT (fun x:X => Trunc -1 (x = point X)) x0 (tr idpath)). + clear H x0. + (** But this doesn't: *) + pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)). +Abort. diff --git a/test-suite/bugs/closed/4272.v b/test-suite/bugs/closed/bug_4272.v index aeb4c9bb95..aeb4c9bb95 100644 --- a/test-suite/bugs/closed/4272.v +++ b/test-suite/bugs/closed/bug_4272.v diff --git a/test-suite/bugs/closed/bug_4273.v b/test-suite/bugs/closed/bug_4273.v new file mode 100644 index 0000000000..5ff78b1ef2 --- /dev/null +++ b/test-suite/bugs/closed/bug_4273.v @@ -0,0 +1,9 @@ + + +Set Primitive Projections. +Record total2 (P : nat -> Prop) := tpair { pr1 : nat; pr2 : P pr1 }. +Theorem onefiber' (q : total2 (fun y => y = 0)) : True. +Proof. assert (foo:=pr2 _ q). simpl in foo. + destruct foo. (* Error: q is used in conclusion. *) exact I. Qed. + +Print onefiber'. diff --git a/test-suite/bugs/closed/bug_4276.v b/test-suite/bugs/closed/bug_4276.v new file mode 100644 index 0000000000..f0da3e490a --- /dev/null +++ b/test-suite/bugs/closed/bug_4276.v @@ -0,0 +1,11 @@ +Set Primitive Projections. + +Record box (T U : Type) (x := T) := wrap { unwrap : T }. +Definition mybox : box True False := wrap _ _ I. +Definition unwrap' := @unwrap. + +Definition bad' : True := mybox.(unwrap _ _). + +Fail Definition bad : False := unwrap _ _ mybox. + +(* Closed under the global context *) diff --git a/test-suite/bugs/closed/4280.v b/test-suite/bugs/closed/bug_4280.v index fd7897509e..fd7897509e 100644 --- a/test-suite/bugs/closed/4280.v +++ b/test-suite/bugs/closed/bug_4280.v diff --git a/test-suite/bugs/closed/bug_4283.v b/test-suite/bugs/closed/bug_4283.v new file mode 100644 index 0000000000..2a8b517bd4 --- /dev/null +++ b/test-suite/bugs/closed/bug_4283.v @@ -0,0 +1,7 @@ +Require Import Hurkens. + +Polymorphic Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. + +Definition unwrap' := fun (X : Type) (b : box X) => let (unwrap) := b in unwrap. + +Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _ Type)) eq_refl. diff --git a/test-suite/bugs/closed/bug_4284.v b/test-suite/bugs/closed/bug_4284.v new file mode 100644 index 0000000000..167a562fe8 --- /dev/null +++ b/test-suite/bugs/closed/bug_4284.v @@ -0,0 +1,7 @@ +Set Primitive Projections. +Record total2 { T: Type } ( P: T -> Type ) := tpair { pr1 : T; pr2 : P pr1 }. +Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True. +Proof. +set (Q1 := total2 (fun f => pr1 P f = x)). +set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)). +Abort. diff --git a/test-suite/bugs/closed/bug_4287.v b/test-suite/bugs/closed/bug_4287.v new file mode 100644 index 0000000000..de97431520 --- /dev/null +++ b/test-suite/bugs/closed/bug_4287.v @@ -0,0 +1,127 @@ +Unset Strict Universe Declaration. + +Universe b. + +Universe c. + +Definition UU : Type@{b} := Type@{c}. + +Module Type MT. + +Definition T := Prop. +End MT. + +Module M : MT. + Definition T := Type@{b}. + +Print Universes. +Fail End M. + + Reset T. + Definition T := Prop. +End M. + +Set Universe Polymorphism. + +(* This is a modified version of Hurkens with all universes floating *) +Section Hurkens. + +Variable down : Type -> Type. +Variable up : Type -> Type. + +Hypothesis back : forall A, up (down A) -> A. + +Hypothesis forth : forall A, A -> up (down A). + +Hypothesis backforth : forall (A:Type) (P:A->Type) (a:A), + P (back A (forth A a)) -> P a. + +Hypothesis backforth_r : forall (A:Type) (P:A->Type) (a:A), + P a -> P (back A (forth A a)). + +(** Proof *) +Definition V : Type := forall A:Type, ((up A -> Type) -> up A -> Type) -> up A -> Type. +Definition U : Type := V -> Type. + +Definition sb (z:V) : V := fun A r a => r (z A r) a. +Definition le (i:U -> Type) (x:U) : Type := x (fun A r a => i (fun v => sb v A r a)). +Definition le' (i:up (down U) -> Type) (x:up (down U)) : Type := le (fun a:U => i (forth _ a)) (back _ x). +Definition induct (i:U -> Type) : Type := forall x:U, up (le i x) -> up (i x). +Definition WF : U := fun z => down (induct (fun a => z (down U) le' (forth _ a))). +Definition I (x:U) : Type := + (forall i:U -> Type, up (le i x) -> up (i (fun v => sb v (down U) le' (forth _ x)))) -> False. + +Lemma Omega : forall i:U -> Type, induct i -> up (i WF). +Proof. +intros i y. +apply y. +unfold le, WF, induct. +apply forth. +intros x H0. +apply y. +unfold sb, le', le. +compute. +apply backforth_r. +exact H0. +Qed. + +Lemma lemma1 : induct (fun u => down (I u)). +Proof. +unfold induct. +intros x p. +apply forth. +intro q. +generalize (q (fun u => down (I u)) p). +intro r. +apply back in r. +apply r. +intros i j. +unfold le, sb, le', le in j |-. +apply backforth in j. +specialize q with (i := fun y => i (fun v:V => sb v (down U) le' (forth _ y))). +apply q. +exact j. +Qed. + +Lemma lemma2 : (forall i:U -> Type, induct i -> up (i WF)) -> False. +Proof. +intro x. +generalize (x (fun u => down (I u)) lemma1). +intro r; apply back in r. +apply r. +intros i H0. +apply (x (fun y => i (fun v => sb v (down U) le' (forth _ y)))). +unfold le, WF in H0. +apply back in H0. +exact H0. +Qed. + +Theorem paradox : False. +Proof. +exact (lemma2 Omega). +Qed. + +End Hurkens. + +Polymorphic Record box (T : Type) := wrap {unwrap : T}. + +(* Here we instantiate to Set *) + +Fail Definition down (x : Type) : Prop := box x. +Definition up (x : Prop) : Type := x. + +Fail Definition back A : up (down A) -> A := unwrap A. + +Fail Definition forth A : A -> up (down A) := wrap A. + +Definition id {A : Type} (a : A) := a. +Definition setlt (A : Type@{i}) := + let foo := Type@{i} : Type@{j} in True. + +Definition setle (B : Type@{i}) := + let foo (A : Type@{j}) := A in foo B. + +Fail Check @setlt@{j Prop}. +Fail Definition foo := @setle@{j Prop}. +Check setlt@{Set i}. +Check setlt@{Set j}. diff --git a/test-suite/bugs/closed/4292.v b/test-suite/bugs/closed/bug_4292.v index 403e155eaf..403e155eaf 100644 --- a/test-suite/bugs/closed/4292.v +++ b/test-suite/bugs/closed/bug_4292.v diff --git a/test-suite/bugs/closed/4293.v b/test-suite/bugs/closed/bug_4293.v index 21d333fa63..21d333fa63 100644 --- a/test-suite/bugs/closed/4293.v +++ b/test-suite/bugs/closed/bug_4293.v diff --git a/test-suite/bugs/closed/4294.v b/test-suite/bugs/closed/bug_4294.v index 1d5e3c71b8..1d5e3c71b8 100644 --- a/test-suite/bugs/closed/4294.v +++ b/test-suite/bugs/closed/bug_4294.v diff --git a/test-suite/bugs/closed/4298.v b/test-suite/bugs/closed/bug_4298.v index 875612ddf4..875612ddf4 100644 --- a/test-suite/bugs/closed/4298.v +++ b/test-suite/bugs/closed/bug_4298.v diff --git a/test-suite/bugs/closed/bug_4299.v b/test-suite/bugs/closed/bug_4299.v new file mode 100644 index 0000000000..d4a2e19717 --- /dev/null +++ b/test-suite/bugs/closed/bug_4299.v @@ -0,0 +1,13 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. + +Module Type Foo. + Definition U := Type : Type. + Parameter eq : Type = U. +End Foo. + +Module M : Foo with Definition U := Type : Type. + Definition U := let X := Type in Type. + Definition eq : Type = U := eq_refl. +Fail End M. +Reset M. diff --git a/test-suite/bugs/closed/bug_4301.v b/test-suite/bugs/closed/bug_4301.v new file mode 100644 index 0000000000..2b942371fe --- /dev/null +++ b/test-suite/bugs/closed/bug_4301.v @@ -0,0 +1,13 @@ +Unset Strict Universe Declaration. +Set Universe Polymorphism. + +Module Type Foo. + Parameter U : Type. +End Foo. + +Module Lower (X : Foo with Definition U := True : Type). +End Lower. + +Module M : Foo. + Definition U := nat : Type@{i}. +End M. diff --git a/test-suite/bugs/closed/4305.v b/test-suite/bugs/closed/bug_4305.v index 39fc02d22b..39fc02d22b 100644 --- a/test-suite/bugs/closed/4305.v +++ b/test-suite/bugs/closed/bug_4305.v diff --git a/test-suite/bugs/closed/4306.v b/test-suite/bugs/closed/bug_4306.v index 80c348d207..80c348d207 100644 --- a/test-suite/bugs/closed/4306.v +++ b/test-suite/bugs/closed/bug_4306.v diff --git a/test-suite/bugs/closed/4316.v b/test-suite/bugs/closed/bug_4316.v index 68dec1334a..68dec1334a 100644 --- a/test-suite/bugs/closed/4316.v +++ b/test-suite/bugs/closed/bug_4316.v diff --git a/test-suite/bugs/closed/4318.v b/test-suite/bugs/closed/bug_4318.v index e3140ed5ab..e3140ed5ab 100644 --- a/test-suite/bugs/closed/4318.v +++ b/test-suite/bugs/closed/bug_4318.v diff --git a/test-suite/bugs/closed/bug_4325.v b/test-suite/bugs/closed/bug_4325.v new file mode 100644 index 0000000000..de3e4bfa8c --- /dev/null +++ b/test-suite/bugs/closed/bug_4325.v @@ -0,0 +1,6 @@ +Goal (forall a b : nat, Set = (a = b)) -> Set. +Proof. + clear. + intro H. + erewrite (fun H' => H _ H'). +Abort. diff --git a/test-suite/bugs/closed/4328.v b/test-suite/bugs/closed/bug_4328.v index b40b3a4830..b40b3a4830 100644 --- a/test-suite/bugs/closed/4328.v +++ b/test-suite/bugs/closed/bug_4328.v diff --git a/test-suite/bugs/closed/4346.v b/test-suite/bugs/closed/bug_4346.v index b50dff2411..b50dff2411 100644 --- a/test-suite/bugs/closed/4346.v +++ b/test-suite/bugs/closed/bug_4346.v diff --git a/test-suite/bugs/closed/bug_4347.v b/test-suite/bugs/closed/bug_4347.v new file mode 100644 index 0000000000..3f68444040 --- /dev/null +++ b/test-suite/bugs/closed/bug_4347.v @@ -0,0 +1,18 @@ +Fixpoint demo_recursion(n:nat) := match n with + |0 => Type + |S k => (demo_recursion k) -> Type + end. + +Record Demonstration := mkDemo +{ + demo_law : forall n:nat, demo_recursion n; + demo_stuff : forall n:nat, forall q:(fix demo_recursion (n : nat) : Type := + match n with + | 0 => Type + | S k => demo_recursion k -> Type + end) n, (demo_law (S n)) q +}. + +Theorem DemoError : Demonstration. +Fail apply mkDemo. (*Anomaly: Uncaught exception Not_found. Please report.*) +Abort. diff --git a/test-suite/bugs/closed/4354.v b/test-suite/bugs/closed/bug_4354.v index c55b4cf02a..c55b4cf02a 100644 --- a/test-suite/bugs/closed/4354.v +++ b/test-suite/bugs/closed/bug_4354.v diff --git a/test-suite/bugs/closed/4363.v b/test-suite/bugs/closed/bug_4363.v index 9895548c1d..9895548c1d 100644 --- a/test-suite/bugs/closed/4363.v +++ b/test-suite/bugs/closed/bug_4363.v diff --git a/test-suite/bugs/closed/4366.v b/test-suite/bugs/closed/bug_4366.v index 403c2d2026..403c2d2026 100644 --- a/test-suite/bugs/closed/4366.v +++ b/test-suite/bugs/closed/bug_4366.v diff --git a/test-suite/bugs/closed/4372.v b/test-suite/bugs/closed/bug_4372.v index 428192a344..428192a344 100644 --- a/test-suite/bugs/closed/4372.v +++ b/test-suite/bugs/closed/bug_4372.v diff --git a/test-suite/bugs/closed/bug_4375.v b/test-suite/bugs/closed/bug_4375.v new file mode 100644 index 0000000000..ef358b15e0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4375.v @@ -0,0 +1,106 @@ + + +Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + + +Module A. +Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => foo t n + end. +End A. + +Module B. +Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => foo t n + end. +End B. + +Module C. +Fail Polymorphic Fixpoint foo@{i} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{j} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End C. + +Module D. +Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{i j} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End D. + +Module E. +Fail Polymorphic Fixpoint foo@{i j} (t : Type@{i}) (n : nat) : Type@{i} := + match n with + | 0 => t + | S n => bar t n + end + +with bar@{j i} (t : Type@{j}) (n : nat) : Type@{j} := + match n with + | 0 => t + | S n => foo t n + end. +End E. + +(* +Polymorphic Fixpoint g@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + +Print g. + +Polymorphic Fixpoint a@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t +with b@{i} (t : Type@{i}) (n : nat) : Type@{i} := + t. + +Print a. +Print b. +*) + +Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} := +| A : foo T -> foo T. + +Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (cg t). + +Print cg. + +Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (cb t) +with cb@{i} (t : Type@{i}) : foo@{i} t := + @A@{i} t (ca t). + +Print ca. +Print cb. diff --git a/test-suite/bugs/closed/bug_4378.v b/test-suite/bugs/closed/bug_4378.v new file mode 100644 index 0000000000..c50fd2c800 --- /dev/null +++ b/test-suite/bugs/closed/bug_4378.v @@ -0,0 +1,10 @@ +Tactic Notation "epose" open_constr(a) := + let a' := fresh in + pose a as a'. +Tactic Notation "epose2" open_constr(a) tactic3(tac) := + let a' := fresh in + pose a as a'. +Goal True. + epose _. Undo. + epose2 _ idtac. +Abort. diff --git a/test-suite/bugs/closed/4390.v b/test-suite/bugs/closed/bug_4390.v index c069b2d9dc..c069b2d9dc 100644 --- a/test-suite/bugs/closed/4390.v +++ b/test-suite/bugs/closed/bug_4390.v diff --git a/test-suite/bugs/closed/bug_4397.v b/test-suite/bugs/closed/bug_4397.v new file mode 100644 index 0000000000..576e8186dd --- /dev/null +++ b/test-suite/bugs/closed/bug_4397.v @@ -0,0 +1,4 @@ +Require Import Equality. +Theorem foo (u : unit) (H : u = u) : True. +dependent destruction H. +Abort. diff --git a/test-suite/bugs/closed/4403.v b/test-suite/bugs/closed/bug_4403.v index a80f38fe2a..a80f38fe2a 100644 --- a/test-suite/bugs/closed/4403.v +++ b/test-suite/bugs/closed/bug_4403.v diff --git a/test-suite/bugs/closed/bug_4404.v b/test-suite/bugs/closed/bug_4404.v new file mode 100644 index 0000000000..4125ea1c1b --- /dev/null +++ b/test-suite/bugs/closed/bug_4404.v @@ -0,0 +1,4 @@ +Inductive Foo : Type -> Type := foo A : Foo A. +Goal True. + remember Foo. +Abort. diff --git a/test-suite/bugs/closed/bug_4412.v b/test-suite/bugs/closed/bug_4412.v new file mode 100644 index 0000000000..a1fb3de4db --- /dev/null +++ b/test-suite/bugs/closed/bug_4412.v @@ -0,0 +1,5 @@ +Require Import Coq.Bool.Bool Coq.Setoids.Setoid. +Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True. + intros. + Fail rewrite Bool.andb_true_iff in H. +Abort. diff --git a/test-suite/bugs/closed/bug_4416.v b/test-suite/bugs/closed/bug_4416.v new file mode 100644 index 0000000000..600a8aa311 --- /dev/null +++ b/test-suite/bugs/closed/bug_4416.v @@ -0,0 +1,5 @@ +Goal exists x, x. +Unset Solve Unification Constraints. +unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. +(* Error: Incorrect number of goals (expected 2 tactics). *) +Abort. diff --git a/test-suite/bugs/closed/bug_4420.v b/test-suite/bugs/closed/bug_4420.v new file mode 100644 index 0000000000..b81185a555 --- /dev/null +++ b/test-suite/bugs/closed/bug_4420.v @@ -0,0 +1,18 @@ +Module foo. + Context (Char : Type). + Axiom foo : Type -> Type. + Goal foo Char = foo Char. + change foo with (fun x => foo x). + cbv beta. + reflexivity. + Defined. +End foo. + +Inductive foo (A : Type) : Prop := I. (*Top.1*) +Lemma bar : foo Type. (*Top.3*) +Proof. + Set Printing Universes. +change foo with (fun x : Type => foo x). (*Top.4*) +cbv beta. +apply I. (* I Type@{Top.3} : (fun x : Type@{Top.4} => foo x) Type@{Top.3} *) +Defined. diff --git a/test-suite/bugs/closed/4429.v b/test-suite/bugs/closed/bug_4429.v index bf0e570ab8..bf0e570ab8 100644 --- a/test-suite/bugs/closed/4429.v +++ b/test-suite/bugs/closed/bug_4429.v diff --git a/test-suite/bugs/closed/4433.v b/test-suite/bugs/closed/bug_4433.v index 83c0e3f81f..83c0e3f81f 100644 --- a/test-suite/bugs/closed/4433.v +++ b/test-suite/bugs/closed/bug_4433.v diff --git a/test-suite/bugs/closed/4443.v b/test-suite/bugs/closed/bug_4443.v index a3a8717d98..a3a8717d98 100644 --- a/test-suite/bugs/closed/4443.v +++ b/test-suite/bugs/closed/bug_4443.v diff --git a/test-suite/bugs/closed/4450.v b/test-suite/bugs/closed/bug_4450.v index c1fe44315a..c1fe44315a 100644 --- a/test-suite/bugs/closed/4450.v +++ b/test-suite/bugs/closed/bug_4450.v diff --git a/test-suite/bugs/closed/bug_4453.v b/test-suite/bugs/closed/bug_4453.v new file mode 100644 index 0000000000..9248b2ab8c --- /dev/null +++ b/test-suite/bugs/closed/bug_4453.v @@ -0,0 +1,10 @@ + +Section Foo. +Variable A : Type. +Lemma foo : A -> True. now intros _. Qed. +Goal Type -> True. +rename A into B. +intros A. +Fail apply foo. +Abort. +End Foo. diff --git a/test-suite/bugs/closed/bug_4456.v b/test-suite/bugs/closed/bug_4456.v new file mode 100644 index 0000000000..7685552725 --- /dev/null +++ b/test-suite/bugs/closed/bug_4456.v @@ -0,0 +1,651 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *) +(* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0 + coqtop version 8.5beta3 (November 2015) *) +(* Variable P : forall n m : nat, n = m -> Prop. *) +(* Axiom Prefl : forall n : nat, P n n eq_refl. *) +Axiom proof_admitted : False. + +Tactic Notation "admit" := case proof_admitted. + +Require Coq.Program.Program. +Require Coq.Strings.String. +Require Coq.omega.Omega. +Module Export Fiat_DOT_Common. +Module Export Fiat. +Module Common. +Import Coq.Lists.List. +Export Coq.Program.Program. + +Global Set Implicit Arguments. + +Global Coercion is_true : bool >-> Sortclass. +Coercion bool_of_sum {A B} (b : sum A B) : bool := if b then true else false. + +Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type + := match ls return Type with + | nil => True + | x::xs => (P x * ForallT P xs)%type + end. +Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type + := match ls with + | nil => P nil + | x::xs => (P (x::xs) * Forall_tails P xs)%type + end. + +End Common. + +End Fiat. + +End Fiat_DOT_Common. +Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. +Module Export Fiat. +Module Export Parsers. +Module Export StringLike. +Module Export Core. +Import Coq.Relations.Relation_Definitions. +Import Coq.Classes.Morphisms. + +Local Coercion is_true : bool >-> Sortclass. + +Module Export StringLike. + Class StringLike {Char : Type} := + { + String :> Type; + is_char : String -> Char -> bool; + length : String -> nat; + take : nat -> String -> String; + drop : nat -> String -> String; + get : nat -> String -> option Char; + unsafe_get : nat -> String -> Char; + bool_eq : String -> String -> bool; + beq : relation String := fun x y => bool_eq x y + }. + + Arguments StringLike : clear implicits. + Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope. + Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope. + Local Open Scope string_like_scope. + + Class StringLikeProperties (Char : Type) `{StringLike Char} := + { + singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch'; + singleton_exists : forall s, length s = 1 -> exists ch, s ~= [ ch ]; + get_0 : forall s ch, take 1 s ~= [ ch ] <-> get 0 s = Some ch; + get_S : forall n s, get (S n) s = get n (drop 1 s); + unsafe_get_correct : forall n s ch, get n s = Some ch -> unsafe_get n s = ch; + length_singleton : forall s ch, s ~= [ ch ] -> length s = 1; + bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s'; + is_char_Proper :> Proper (beq ==> eq ==> eq) is_char; + length_Proper :> Proper (beq ==> eq) length; + take_Proper :> Proper (eq ==> beq ==> beq) take; + drop_Proper :> Proper (eq ==> beq ==> beq) drop; + bool_eq_Equivalence :> Equivalence beq; + bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str'; + take_short_length : forall str n, n <= length str -> length (take n str) = n; + take_long : forall str n, length str <= n -> take n str =s str; + take_take : forall str n m, take n (take m str) =s take (min n m) str; + drop_length : forall str n, length (drop n str) = length str - n; + drop_0 : forall str, drop 0 str =s str; + drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str; + drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str); + take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str); + bool_eq_from_get : forall str str', (forall n, get n str = get n str') -> str =s str' + }. +Global Arguments StringLikeProperties _ {_}. +End StringLike. + +End Core. + +End StringLike. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_StringLike_DOT_Core. + +Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Core. +Import Coq.Strings.String. +Import Coq.Lists.List. +Export Fiat.Parsers.StringLike.Core. + +Section cfg. + Context {Char : Type}. + + Section definitions. + + Inductive item := + | Terminal (_ : Char) + | NonTerminal (_ : string). + + Definition production := list item. + Definition productions := list production. + + Record grammar := + { + Start_symbol :> string; + Lookup :> string -> productions; + Start_productions :> productions := Lookup Start_symbol; + Valid_nonterminals : list string; + Valid_productions : list productions := map Lookup Valid_nonterminals + }. + End definitions. + + End cfg. + +Arguments item _ : clear implicits. +Arguments production _ : clear implicits. +Arguments productions _ : clear implicits. +Arguments grammar _ : clear implicits. + +End Core. + +End ContextFreeGrammar. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core. + +Module Export Fiat_DOT_Parsers_DOT_BaseTypes. +Module Export Fiat. +Module Export Parsers. +Module Export BaseTypes. +Import Coq.Arith.Wf_nat. + +Local Coercion is_true : bool >-> Sortclass. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Class parser_computational_predataT := + { nonterminals_listT : Type; + nonterminal_carrierT : Type; + of_nonterminal : String.string -> nonterminal_carrierT; + to_nonterminal : nonterminal_carrierT -> String.string; + initial_nonterminals_data : nonterminals_listT; + nonterminals_length : nonterminals_listT -> nat; + is_valid_nonterminal : nonterminals_listT -> nonterminal_carrierT -> bool; + remove_nonterminal : nonterminals_listT -> nonterminal_carrierT -> nonterminals_listT }. + + Class parser_removal_dataT' `{predata : parser_computational_predataT} := + { nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop + := ltof _ nonterminals_length; + nonterminals_length_zero : forall ls, + nonterminals_length ls = 0 + -> forall nt, is_valid_nonterminal ls nt = false; + remove_nonterminal_dec : forall ls nonterminal, + is_valid_nonterminal ls nonterminal + -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls; + remove_nonterminal_noninc : forall ls nonterminal, + ~nonterminals_listT_R ls (remove_nonterminal ls nonterminal); + initial_nonterminals_correct : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) <-> List.In nonterminal (Valid_nonterminals G); + initial_nonterminals_correct' : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data nonterminal <-> List.In (to_nonterminal nonterminal) (Valid_nonterminals G); + to_of_nonterminal : forall nonterminal, + List.In nonterminal (Valid_nonterminals G) + -> to_nonterminal (of_nonterminal nonterminal) = nonterminal; + of_to_nonterminal : forall nonterminal, + is_valid_nonterminal initial_nonterminals_data nonterminal + -> of_nonterminal (to_nonterminal nonterminal) = nonterminal; + ntl_wf : well_founded nonterminals_listT_R + := well_founded_ltof _ _; + remove_nonterminal_1 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' + -> is_valid_nonterminal ls ps'; + remove_nonterminal_2 + : forall ls ps ps', + is_valid_nonterminal (remove_nonterminal ls ps) ps' = false + <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }. + + Class split_dataT := + { split_string_for_production + : item Char -> production Char -> String -> list nat }. + + Class boolean_parser_dataT := + { predata :> parser_computational_predataT; + split_data :> split_dataT }. +End recursive_descent_parser. + +End BaseTypes. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_BaseTypes. + +Module Export Fiat_DOT_Common_DOT_List_DOT_Operations. +Module Export Fiat. +Module Export Common. +Module Export List. +Module Export Operations. + +Import Coq.Lists.List. + +Module Export List. + Section InT. + Context {A : Type} (a : A). + + Fixpoint InT (ls : list A) : Set + := match ls return Set with + | nil => False + | b :: m => (b = a) + InT m + end%type. + End InT. + + End List. + +End Operations. + +End List. + +End Common. + +End Fiat. + +End Fiat_DOT_Common_DOT_List_DOT_Operations. + +Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. +Module Export Fiat. +Module Export Parsers. +Module Export StringLike. +Module Export Properties. + +Section String. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char}. + + Lemma take_length {str n} + : length (take n str) = min n (length str). +admit. +Defined. + + End String. + +End Properties. + +End StringLike. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties. + +Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Properties. + +Local Open Scope list_scope. +Definition production_is_reachableT {Char} (G : grammar Char) (p : production Char) + := { nt : _ + & { prefix : _ + & List.In nt (Valid_nonterminals G) + * List.InT + (prefix ++ p) + (Lookup G nt) } }%type. + +End Properties. + +End ContextFreeGrammar. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties. + +Module Export Fiat_DOT_Parsers_DOT_MinimalParse. +Module Export Fiat. +Module Export Parsers. +Module Export MinimalParse. +Import Coq.Lists.List. +Import Fiat.Parsers.ContextFreeGrammar.Core. + +Local Coercion is_true : bool >-> Sortclass. +Local Open Scope string_like_scope. + +Section cfg. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + Context {predata : @parser_computational_predataT} + {rdata' : @parser_removal_dataT' _ G predata}. + + Inductive minimal_parse_of + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + productions Char -> Type := + | MinParseHead : forall len0 valid str pat pats, + @minimal_parse_of_production len0 valid str pat + -> @minimal_parse_of len0 valid str (pat::pats) + | MinParseTail : forall len0 valid str pat pats, + @minimal_parse_of len0 valid str pats + -> @minimal_parse_of len0 valid str (pat::pats) + with minimal_parse_of_production + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + production Char -> Type := + | MinParseProductionNil : forall len0 valid str, + length str = 0 + -> @minimal_parse_of_production len0 valid str nil + | MinParseProductionCons : forall len0 valid str n pat pats, + length str <= len0 + -> @minimal_parse_of_item len0 valid (take n str) pat + -> @minimal_parse_of_production len0 valid (drop n str) pats + -> @minimal_parse_of_production len0 valid str (pat::pats) + with minimal_parse_of_item + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + item Char -> Type := + | MinParseTerminal : forall len0 valid str ch, + str ~= [ ch ] + -> @minimal_parse_of_item len0 valid str (Terminal ch) + | MinParseNonTerminal + : forall len0 valid str (nt : String.string), + @minimal_parse_of_nonterminal len0 valid str nt + -> @minimal_parse_of_item len0 valid str (NonTerminal nt) + with minimal_parse_of_nonterminal + : forall (len0 : nat) (valid : nonterminals_listT) + (str : String), + String.string -> Type := + | MinParseNonTerminalStrLt + : forall len0 valid (nt : String.string) str, + length str < len0 + -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) + -> @minimal_parse_of (length str) initial_nonterminals_data str (Lookup G nt) + -> @minimal_parse_of_nonterminal len0 valid str nt + | MinParseNonTerminalStrEq + : forall len0 str valid nonterminal, + length str = len0 + -> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) + -> is_valid_nonterminal valid (of_nonterminal nonterminal) + -> @minimal_parse_of len0 (remove_nonterminal valid (of_nonterminal nonterminal)) str (Lookup G nonterminal) + -> @minimal_parse_of_nonterminal len0 valid str nonterminal. + +End cfg. + +End MinimalParse. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_MinimalParse. + +Module Export Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. +Module Export Fiat. +Module Export Parsers. +Module Export CorrectnessBaseTypes. +Import Coq.Lists.List. +Import Fiat.Parsers.ContextFreeGrammar.Core. +Import Fiat_DOT_Common.Fiat.Common. +Section general. + Context {Char} {HSL : StringLike Char} {G : grammar Char}. + + Definition split_list_completeT_for {data : @parser_computational_predataT} + {len0 valid} + (it : item Char) (its : production Char) + (str : String) + (pf : length str <= len0) + (split_list : list nat) + + := ({ n : nat + & (minimal_parse_of_item (G := G) (predata := data) len0 valid (take n str) it) + * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type) + -> ({ n : nat + & (In (min (length str) n) (map (min (length str)) split_list)) + * (minimal_parse_of_item (G := G) len0 valid (take n str) it) + * (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type). + + Definition split_list_completeT {data : @parser_computational_predataT} + (splits : item Char -> production Char -> String -> list nat) + := forall len0 valid str (pf : length str <= len0) nt, + is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt) + -> ForallT + (Forall_tails + (fun prod + => match prod return Type with + | nil => True + | it::its + => @split_list_completeT_for data len0 valid it its str pf (splits it its str) + end)) + (Lookup G nt). + + Class boolean_parser_completeness_dataT' {data : boolean_parser_dataT} := + { split_string_for_production_complete + : split_list_completeT split_string_for_production }. +End general. + +End CorrectnessBaseTypes. + +End Parsers. + +End Fiat. + +End Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes. + +Module Export Fiat. +Module Export Parsers. +Module Export ContextFreeGrammar. +Module Export Valid. +Export Fiat.Parsers.StringLike.Core. + +Section cfg. + Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) + {predata : parser_computational_predataT}. + + Definition item_valid (it : item Char) + := match it with + | Terminal _ => True + | NonTerminal nt' => is_true (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt')) + end. + + Definition production_valid pat + := List.Forall item_valid pat. + + Definition productions_valid pats + := List.Forall production_valid pats. + + Definition grammar_valid + := forall nt, + List.In nt (Valid_nonterminals G) + -> productions_valid (Lookup G nt). +End cfg. + +End Valid. +End ContextFreeGrammar. +End Parsers. +End Fiat. + +Section app. + Context {Char : Type} {HSL : StringLike Char} (G : grammar Char) + {predata : parser_computational_predataT}. + + Lemma hd_production_valid + (it : item Char) + (its : production Char) + (H : production_valid (it :: its)) + : item_valid it. +admit. +Defined. + + Lemma production_valid_cons + (it : item Char) + (its : production Char) + (H : production_valid (it :: its)) + : production_valid its. +admit. +Defined. + + End app. + +Import Coq.Lists.List. +Import Coq.omega.Omega. +Import Fiat_DOT_Common.Fiat.Common. +Import Fiat.Parsers.ContextFreeGrammar.Valid. +Local Open Scope string_like_scope. + +Section recursive_descent_parser. + Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char). + Context {data : @boolean_parser_dataT Char _} + {cdata : @boolean_parser_completeness_dataT' Char _ G data} + {rdata : @parser_removal_dataT' _ G _} + {gvalid : grammar_valid G}. + + Local Notation dec T := (T + (T -> False))%type (only parsing). + + Local Notation iffT x y := ((x -> y) * (y -> x))%type (only parsing). + + Lemma dec_prod {A B} (HA : dec A) (HB : dec B) : dec (A * B). +admit. +Defined. + + Lemma dec_In {A} {P : A -> Type} (HA : forall a, dec (P a)) ls + : dec { a : _ & (In a ls * P a) }. +admit. +Defined. + + Section item. + Context {len0 valid} + (str : String) + (str_matches_nonterminal' + : nonterminal_carrierT -> bool) + (str_matches_nonterminal + : forall nt : nonterminal_carrierT, + dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). + + Section valid. + Context (Hmatches + : forall nt, + is_valid_nonterminal initial_nonterminals_data nt + -> str_matches_nonterminal nt = str_matches_nonterminal' nt :> bool) + (it : item Char) + (Hvalid : item_valid it). + + Definition parse_item' + : dec (minimal_parse_of_item (G := G) len0 valid str it). + Proof. + clear Hvalid. + refine (match it return dec (minimal_parse_of_item len0 valid str it) with + | Terminal ch => if Sumbool.sumbool_of_bool (str ~= [ ch ]) + then inl (MinParseTerminal _ _ _ _ _) + else inr (fun _ => !) + | NonTerminal nt => if str_matches_nonterminal (of_nonterminal nt) + then inl (MinParseNonTerminal _) + else inr (fun _ => !) + end); + clear str_matches_nonterminal Hmatches; + admit. + Defined. + End valid. + + End item. + Context {len0 valid} + (parse_nonterminal + : forall (str : String) (len : nat) (Hlen : length str = len) (pf : len <= len0) (nt : nonterminal_carrierT), + dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))). + + Lemma dec_in_helper {ls it its str} + : iffT {n0 : nat & + (In (min (length str) n0) (map (min (length str)) ls) * + minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} + {n0 : nat & + (In n0 ls * + (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its))%type}. +admit. +Defined. + + Lemma parse_production'_helper {str it its} (pf : length str <= len0) + : dec {n0 : nat & + (minimal_parse_of_item (G := G) len0 valid (take n0 str) it * + minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type} + -> dec (minimal_parse_of_production (G := G) len0 valid str (it :: its)). +admit. +Defined. + Local Ltac t_parse_production_for := repeat + match goal with + | [ H : (beq_nat _ _) = true |- _ ] => apply EqNat.beq_nat_true in H + | _ => progress subst + | _ => solve [ constructor; assumption ] + | [ H : minimal_parse_of_production _ _ _ nil |- _ ] => (inversion H; clear H) + | [ H : minimal_parse_of_production _ _ _ (_::_) |- _ ] => (inversion H; clear H) + | [ H : ?x = 0, H' : context[?x] |- _ ] => rewrite H in H' + | _ => progress simpl in * + | _ => discriminate + | [ H : forall x, (_ * _)%type -> _ |- _ ] => specialize (fun x y z => H x (y, z)) + | _ => solve [ eauto with nocore ] + | _ => solve [ apply Min.min_case_strong; omega ] + | _ => omega + | [ H : production_valid (_::_) |- _ ] + => let H' := fresh in + pose proof H as H'; + apply production_valid_cons in H; + apply hd_production_valid in H' + end. + + Definition parse_production'_for + (splits : item Char -> production Char -> String -> list nat) + (Hsplits : forall str it its (Hreachable : production_is_reachableT G (it::its)) pf', split_list_completeT_for (len0 := len0) (G := G) (valid := valid) it its str pf' (splits it its str)) + (str : String) + (len : nat) + (Hlen : length str = len) + (pf : len <= len0) + (prod : production Char) + (Hreachable : production_is_reachableT G prod) + : dec (minimal_parse_of_production (G := G) len0 valid str prod). + Proof. + revert prod Hreachable str len Hlen pf. + refine + ((fun pf_helper => + list_rect + (fun prod => + forall (Hreachable : production_is_reachableT G prod) + (str : String) + (len : nat) + (Hlen : length str = len) + (pf : len <= len0), + dec (minimal_parse_of_production (G := G) len0 valid str prod)) + ( + fun Hreachable str len Hlen pf + => match Utils.dec (beq_nat len 0) with + | left H => inl _ + | right H => inr (fun p => _) + end) + (fun it its parse_production' Hreachable str len Hlen pf + => parse_production'_helper + _ + (let parse_item := (fun n pf => parse_item' (parse_nonterminal (take n str) (len := min n len) (eq_trans take_length (f_equal (min _) Hlen)) pf) it) in + let parse_item := (fun n => parse_item n (Min.min_case_strong n len (fun k => k <= len0) (fun Hlen => (Nat.le_trans _ _ _ Hlen pf)) (fun Hlen => pf))) in + let parse_production := (fun n => parse_production' (pf_helper it its Hreachable) (drop n str) (len - n) (eq_trans (drop_length _ _) (f_equal (fun x => x - _) Hlen)) (Nat.le_trans _ _ _ (Nat.le_sub_l _ _) pf)) in + match dec_In + (fun n => dec_prod (parse_item n) (parse_production n)) + (splits it its str) + with + | inl p => inl (existT _ (projT1 p) (snd (projT2 p))) + | inr p + => let pf' := (Nat.le_trans _ _ _ (Nat.eq_le_incl _ _ Hlen) pf) in + let H := (_ : split_list_completeT_for (G := G) (len0 := len0) (valid := valid) it its str pf' (splits it its str)) in + inr (fun p' => p (fst dec_in_helper (H p'))) + end) + )) _); + [ clear parse_nonterminal Hsplits splits rdata cdata + | clear parse_nonterminal Hsplits splits rdata cdata + | .. + | admit ]. + abstract t_parse_production_for. + abstract t_parse_production_for. + abstract t_parse_production_for. + abstract t_parse_production_for. + Defined. +End recursive_descent_parser. diff --git a/test-suite/bugs/closed/bug_4462.v b/test-suite/bugs/closed/bug_4462.v new file mode 100644 index 0000000000..be6d2bea76 --- /dev/null +++ b/test-suite/bugs/closed/bug_4462.v @@ -0,0 +1,8 @@ +Variables P Q : Prop. +Axiom pqrw : P <-> Q. + +Require Setoid. + +Goal P -> Q. +unshelve (rewrite pqrw). +Abort. diff --git a/test-suite/bugs/closed/bug_4464.v b/test-suite/bugs/closed/bug_4464.v new file mode 100644 index 0000000000..a0c266c0ee --- /dev/null +++ b/test-suite/bugs/closed/bug_4464.v @@ -0,0 +1,5 @@ +Goal True -> True. +Proof. + intro H'. + let H := H' in destruct H; try destruct H. +Abort. diff --git a/test-suite/bugs/closed/4467.v b/test-suite/bugs/closed/bug_4467.v index 6f8631d458..6f8631d458 100644 --- a/test-suite/bugs/closed/4467.v +++ b/test-suite/bugs/closed/bug_4467.v diff --git a/test-suite/bugs/closed/bug_4471.v b/test-suite/bugs/closed/bug_4471.v new file mode 100644 index 0000000000..dec181e430 --- /dev/null +++ b/test-suite/bugs/closed/bug_4471.v @@ -0,0 +1,7 @@ +Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : forall (x : A) (x' : B), P (@pair A B x x')), + @eq (P (@pair A B a b)) (p (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))) + (p0 (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))). +Proof. + intros. + Fail generalize dependent (a, b). +Abort. diff --git a/test-suite/bugs/closed/bug_4479.v b/test-suite/bugs/closed/bug_4479.v new file mode 100644 index 0000000000..442555b319 --- /dev/null +++ b/test-suite/bugs/closed/bug_4479.v @@ -0,0 +1,4 @@ +Goal True. +Fail autorewrite with foo. +try autorewrite with foo. +Abort. diff --git a/test-suite/bugs/closed/bug_4480.v b/test-suite/bugs/closed/bug_4480.v new file mode 100644 index 0000000000..da15e8cf33 --- /dev/null +++ b/test-suite/bugs/closed/bug_4480.v @@ -0,0 +1,12 @@ +Require Import Setoid. + +Definition proj (P Q : Prop) := P. + +Lemma foo (P : Prop) : proj P P = P. +Admitted. +Lemma trueI : True <-> True. +Admitted. +Goal True. + Fail setoid_rewrite foo. + Fail setoid_rewrite trueI. +Abort. diff --git a/test-suite/bugs/closed/bug_4484.v b/test-suite/bugs/closed/bug_4484.v new file mode 100644 index 0000000000..adf7c82401 --- /dev/null +++ b/test-suite/bugs/closed/bug_4484.v @@ -0,0 +1,11 @@ +(* Testing 8.5 regression with type classes not solving evars + redefined while trying to solve them with the type class mechanism *) + +Class A := {}. +Axiom foo : forall {ac : A}, bool. +Lemma bar (ac : A) : True. +Check (match foo as k return foo = k -> True with + | true => _ + | false => _ + end eq_refl). +Abort. diff --git a/test-suite/bugs/closed/4495.v b/test-suite/bugs/closed/bug_4495.v index 8b032db5f5..8b032db5f5 100644 --- a/test-suite/bugs/closed/4495.v +++ b/test-suite/bugs/closed/bug_4495.v diff --git a/test-suite/bugs/closed/4498.v b/test-suite/bugs/closed/bug_4498.v index 379e46b3e3..379e46b3e3 100644 --- a/test-suite/bugs/closed/4498.v +++ b/test-suite/bugs/closed/bug_4498.v diff --git a/test-suite/bugs/closed/4503.v b/test-suite/bugs/closed/bug_4503.v index 5162f352df..5162f352df 100644 --- a/test-suite/bugs/closed/4503.v +++ b/test-suite/bugs/closed/bug_4503.v diff --git a/test-suite/bugs/closed/bug_4511.v b/test-suite/bugs/closed/bug_4511.v new file mode 100644 index 0000000000..11ee4ccd6f --- /dev/null +++ b/test-suite/bugs/closed/bug_4511.v @@ -0,0 +1,3 @@ +Goal True. +Fail evar I. +Abort. diff --git a/test-suite/bugs/closed/bug_4519.v b/test-suite/bugs/closed/bug_4519.v new file mode 100644 index 0000000000..2c984cad1c --- /dev/null +++ b/test-suite/bugs/closed/bug_4519.v @@ -0,0 +1,21 @@ +Set Universe Polymorphism. +Section foo. + Universe i. + Context (foo : Type@{i}) (bar : Type@{i}). + Definition qux@{i} (baz : Type@{i}) := foo -> bar. +End foo. +Set Printing Universes. +Print qux. (* qux@{Top.42 Top.43} = +fun foo bar _ : Type@{Top.42} => foo -> bar + : Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} -> Type@{Top.42} +(* Top.42 Top.43 |= *) +(* This is wrong; the first two types are equal, but the last one is not *) + +qux is universe polymorphic +Argument scopes are [type_scope type_scope type_scope] + *) +Check qux nat nat nat : Set. +Check qux nat nat Set : Set. (* Error: +The term "qux@{Top.50 Top.51} ?T ?T0 Set" has type "Type@{Top.50}" while it is +expected to have type "Set" +(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *) diff --git a/test-suite/bugs/closed/bug_4527.v b/test-suite/bugs/closed/bug_4527.v new file mode 100644 index 0000000000..4f8a8dd272 --- /dev/null +++ b/test-suite/bugs/closed/bug_4527.v @@ -0,0 +1,272 @@ +(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1199 lines to +430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, +then from 269 lines to 255 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml +4.01.0 + coqtop version 8.5 (January 2016) *) +Declare ML Module "ltac_plugin". +Inductive False := . +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Init.Datatypes. + +Import Coq.Init.Notations. + +Global Set Universe Polymorphism. + +Notation "A -> B" := (forall (_ : A), B) : type_scope. + +Inductive True : Type := + I : True. +Module Export Datatypes. + +Set Implicit Arguments. +Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. +Notation S := Coq.Init.Datatypes.S. +Notation two := (S (S O)). + +Record prod (A B : Type) := pair { fst : A ; snd : B }. + +Notation "x * y" := (prod x y) : type_scope. + +Open Scope nat_scope. + +End Datatypes. +Module Export Specif. + +Set Implicit Arguments. + +Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P +proj1_sig }. + +Notation sigT := sig (only parsing). + +Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + +Notation projT1 := proj1_sig (only parsing). +Notation projT2 := proj2_sig (only parsing). + +End Specif. +Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. + +Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in +Type@{i}. + +Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in + let ge := ((fun x => x) : Type1@{j} -> +Type@{i}) in Type@{i}. + +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. + +Notation pr1 := projT1. +Notation pr2 := projT2. + +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. + +Notation compose := (fun g f x => g (f x)). + +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left +associativity) : function_scope. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Arguments idpath {A a} , [A] a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. + +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. + +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. + +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. + +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. + +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. + +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. + +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr (f x) = ap f (eissect x) +}. + +Arguments eisretr {A B}%type_scope f%function_scope {_} _. +Arguments eissect {A B}%type_scope f%function_scope {_} _. + +Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : +function_scope. + +Inductive Unit : Type1 := + tt : Unit. + +Local Open Scope path_scope. + +Section EquivInverse. + + Context {A B : Type} (f : A -> B) {feq : IsEquiv f}. + + Theorem other_adj (b : B) : eissect f (f^-1 b) = ap f^-1 (eisretr f b). +admit. +Defined. + + Global Instance isequiv_inverse : IsEquiv f^-1 | 10000 + := BuildIsEquiv B A f^-1 f (eissect f) (eisretr f) other_adj. +End EquivInverse. + +Section Adjointify. + + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). +admit. +Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. + +End Adjointify. + + Definition ExtensionAlong {A B : Type} (f : A -> B) + (P : B -> Type) (d : forall x:A, P (f x)) + := { s : forall y:B, P y & forall x:A, s (f x) = d x }. + + Fixpoint ExtendableAlong@{i j k l} + (n : nat) {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := match n with + | O => Unit@{l} + | S n => (forall (g : forall a, C (f a)), + ExtensionAlong@{i j k l l} f C g) * + forall (h k : forall b, C b), + ExtendableAlong n f (fun b => h b = k b) + end. + + Definition ooExtendableAlong@{i j k l} + {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := forall n, ExtendableAlong@{i j k l} n f C. + +Module Type ReflectiveSubuniverses. + + Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter inO_equiv_inO@{u a i j k} : + forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j}) + (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f), + + let gei := ((fun x => x) : Type@{i} -> Type@{k}) in + let gej := ((fun x => x) : Type@{j} -> Type@{k}) in + In@{u a j} O U. + + Parameter extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : +Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). + +End ReflectiveSubuniverses. + +Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). +Export Os. + +Existing Class In. + + Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. + +Arguments inO_equiv_inO {O} T {U} {_} f {_}. +Global Existing Instance O_inO. + +Section ORecursion. + Context {O : ReflectiveSubuniverse}. + + Definition O_indpaths {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o to O P == h o to O P) + : g == h + := (fst (snd (extendable_to_O O two) g h) p).1. + + Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) + : O_indpaths g h p (to O P x) = p x + := (fst (snd (extendable_to_O O two) g h) p).2 x. + +End ORecursion. + +Section Reflective_Subuniverse. + Universes Ou Oa. + Context (O : ReflectiveSubuniverse@{Ou Oa}). + + Definition inO_isequiv_to_O (T:Type) + : IsEquiv (to O T) -> In O T + := fun _ => inO_equiv_inO (O T) (to O T)^-1. + + Definition inO_to_O_retract (T:Type) (mu : O T -> T) + : Sect (to O T) mu -> In O T. + Proof. + unfold Sect; intros H. + apply inO_isequiv_to_O. + apply isequiv_adjointify with (g:=mu). + - + refine (O_indpaths (to O T o mu) idmap _). + intros x; exact (ap (to O T) (H x)). + - + exact H. + Defined. + + Definition inO_paths@{i} (S : Type@{i}) {S_inO : In@{Ou Oa i} O S} (x y : +S) : In@{Ou Oa i} O (x=y). + Proof. + simple refine (inO_to_O_retract@{i} _ _ _); intro u. + - + assert (p : (fun _ : O (x=y) => x) == (fun _=> y)). + { + refine (O_indpaths _ _ _); simpl. + intro v; exact v. +} + exact (p u). + - + hnf. + rewrite O_indpaths_beta; reflexivity. + Qed. + Check inO_paths@{Type}. +End Reflective_Subuniverse. +End ReflectiveSubuniverses_Theory. diff --git a/test-suite/bugs/closed/bug_4529.v b/test-suite/bugs/closed/bug_4529.v new file mode 100644 index 0000000000..8e04bdca86 --- /dev/null +++ b/test-suite/bugs/closed/bug_4529.v @@ -0,0 +1,45 @@ +(* File reduced by coq-bug-finder from original input, then from 1334 lines to 1518 lines, then from 849 lines to 59 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 22 2016 18:20:47 with OCaml 4.02.3 + coqtop version r-schnelltop:/home/r/src/coq/coq,(HEAD detached at V8.5) (5e23fb90b39dfa014ae5c4fb46eb713cca09dbff) *) +Require Coq.Setoids.Setoid. +Import Coq.Setoids.Setoid. + +Class Equiv A := equiv: relation A. +Infix "≡" := equiv (at level 70, no associativity). +Notation "(≡)" := equiv (only parsing). + +(* If I remove this line, everything compiles. *) +Set Primitive Projections. + +Class Dist A := dist : nat -> relation A. +Notation "x ={ n }= y" := (dist n x y) + (at level 70, n at next level, format "x ={ n }= y"). + +Record CofeMixin A `{Equiv A, Dist A} := { + mixin_equiv_dist x y : x ≡ y <-> forall n, x ={n}= y; + mixin_dist_equivalence n : Equivalence (dist n); +}. + +Structure cofeT := CofeT { + cofe_car :> Type; + cofe_equiv : Equiv cofe_car; + cofe_dist : Dist cofe_car; + cofe_mixin : CofeMixin cofe_car +}. +Existing Instances cofe_equiv cofe_dist. +Arguments cofe_car : simpl never. + +Section cofe_mixin. + Context {A : cofeT}. + Implicit Types x y : A. + Lemma equiv_dist x y : x ≡ y <-> forall n, x ={n}= y. +Admitted. +End cofe_mixin. + Context {A : cofeT}. + Global Instance cofe_equivalence : Equivalence ((≡) : relation A). + Proof. + split. + * + intros x. +apply equiv_dist. + Abort. diff --git a/test-suite/bugs/closed/bug_4533.v b/test-suite/bugs/closed/bug_4533.v new file mode 100644 index 0000000000..d2f9fb9099 --- /dev/null +++ b/test-suite/bugs/closed/bug_4533.v @@ -0,0 +1,232 @@ +(* -*- mode: coq; coq-prog-args: ("-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_lex_wrong_rewrite_02") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1125 lines to +346 lines, then from 360 lines to 346 lines, then from 822 lines to 271 lines, +then from 285 lines to 271 lines *) +(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml +4.01.0 + coqtop version 8.5 (January 2016) *) +Declare ML Module "ltac_plugin". +Inductive False := . +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Init.Datatypes. +Import Coq.Init.Notations. +Global Set Universe Polymorphism. +Global Set Primitive Projections. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Module Export Datatypes. + Set Implicit Arguments. + Notation nat := Coq.Init.Datatypes.nat. + Notation O := Coq.Init.Datatypes.O. + Notation S := Coq.Init.Datatypes.S. + Notation one := (S O). + Notation two := (S one). + Record prod (A B : Type) := pair { fst : A ; snd : B }. + Notation "x * y" := (prod x y) : type_scope. + Delimit Scope nat_scope with nat. + Open Scope nat_scope. +End Datatypes. +Module Export Specif. + Set Implicit Arguments. + Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P +proj1_sig }. + Notation sigT := sig (only parsing). + Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope. + Notation projT1 := proj1_sig (only parsing). + Notation projT2 := proj2_sig (only parsing). +End Specif. +Global Set Keyed Unification. +Global Unset Strict Universe Declaration. +Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}. +Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in +Type@{i}. +Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in + let ge := ((fun x => x) : Type1@{j} -> +Type@{i}) in Type@{i}. +Notation idmap := (fun x => x). +Delimit Scope function_scope with function. +Delimit Scope path_scope with path. +Delimit Scope fibration_scope with fibration. +Open Scope fibration_scope. +Open Scope function_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope. +Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope. +Notation compose := (fun g f x => g (f x)). +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left +associativity) : function_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope. +Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x) + := forall x:A, f x = g x. +Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : +type_scope. +Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := + forall x : A, r (s x) = x. +Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv { + equiv_inv : B -> A ; + eisretr : Sect equiv_inv f; + eissect : Sect f equiv_inv; + eisadj : forall x : A, eisretr +(f x) = ap f (eissect x) + }. +Arguments eissect {A B}%type_scope f%function_scope {_} _. +Inductive Unit : Type1 := tt : Unit. +Local Open Scope path_scope. +Definition concat_p_pp {A : Type} {x y z t : A} (p : x = y) (q : y = z) (r : z += t) : + p @ (q @ r) = (p @ q) @ r := + match r with idpath => + match q with idpath => + match p with idpath => 1 + end end end. +Section Adjointify. + Context {A B : Type} (f : A -> B) (g : B -> A). + Context (isretr : Sect g f) (issect : Sect f g). + Let issect' := fun x => + ap g (ap f (issect x)^) @ ap g (isretr (f x)) @ issect x. + + Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a). + admit. + Defined. + + Definition isequiv_adjointify : IsEquiv f + := BuildIsEquiv A B f g isretr issect' is_adjoint'. +End Adjointify. +Definition ExtensionAlong {A B : Type} (f : A -> B) + (P : B -> Type) (d : forall x:A, P (f x)) + := { s : forall y:B, P y & forall x:A, s (f x) = d x }. +Fixpoint ExtendableAlong@{i j k l} + (n : nat) {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := match n with + | O => Unit@{l} + | S n => (forall (g : forall a, C (f a)), + ExtensionAlong@{i j k l l} f C g) * + forall (h k : forall b, C b), + ExtendableAlong n f (fun b => h b = k b) + end. + +Definition ooExtendableAlong@{i j k l} + {A : Type@{i}} {B : Type@{j}} + (f : A -> B) (C : B -> Type@{k}) : Type@{l} + := forall n, ExtendableAlong@{i j k l} n f C. + +Module Type ReflectiveSubuniverses. + + Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}. + + Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}), + Type2le@{i a} -> Type2le@{i a}. + + Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + In@{u a i} O (O_reflector@{u a i} O T). + + Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : +Type@{i}), + T -> O_reflector@{u a i} O T. + + Parameter extendable_to_O@{u a i j k} + : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : +Type2le@{j a}} {Q_inO : In@{u a j} O Q}, + ooExtendableAlong@{i i j k} (to O P) (fun _ => Q). + +End ReflectiveSubuniverses. + +Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). + Export Os. + Existing Class In. + Module Export Coercions. + Coercion O_reflector : ReflectiveSubuniverse >-> Funclass. + End Coercions. + Global Existing Instance O_inO. + + Section ORecursion. + Context {O : ReflectiveSubuniverse}. + + Definition O_rec {P Q : Type} {Q_inO : In O Q} + (f : P -> Q) + : O P -> Q + := (fst (extendable_to_O O one) f).1. + + Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} + (f : P -> Q) (x : P) + : O_rec f (to O P x) = f x + := (fst (extendable_to_O O one) f).2 x. + + Definition O_indpaths {P Q : Type} {Q_inO : In O Q} + (g h : O P -> Q) (p : g o to O P == h o to O P) + : g == h + := (fst (snd (extendable_to_O O two) g h) p).1. + + End ORecursion. + + + Section Reflective_Subuniverse. + Context (O : ReflectiveSubuniverse@{Ou Oa}). + + Definition isequiv_to_O_inO@{u a i} (T : Type@{i}) `{In@{u a i} O T} : +IsEquiv@{i i} (to O T). + Proof. + + pose (g := O_rec@{u a i i i i i} idmap). + refine (isequiv_adjointify (to O T) g _ _). + - + refine (O_indpaths@{u a i i i i i} (to O T o g) idmap _). + intros x. + apply ap. + apply O_rec_beta. + - + intros x. + apply O_rec_beta. + Defined. + Global Existing Instance isequiv_to_O_inO. + + End Reflective_Subuniverse. + +End ReflectiveSubuniverses_Theory. + +Module Type Preserves_Fibers (Os : ReflectiveSubuniverses). + Module Export Os_Theory := ReflectiveSubuniverses_Theory Os. +End Preserves_Fibers. + +Opaque eissect. +Module Lex_Reflective_Subuniverses + (Os : ReflectiveSubuniverses) (Opf : Preserves_Fibers Os). + Import Opf. + Goal forall (O : ReflectiveSubuniverse) (A : Type) (B : A -> Type) (A_inO : +In O A), + + forall g, + forall (x : O {x : A & B x}) v v' v'' (p2 : v'' = v') (p0 : v' = v) (p1 : +v = _) r, + (p2 + @ (p0 + @ p1)) + @ eissect (to O A) (g x) = r. + intros. + cbv zeta. + rewrite concat_p_pp. + match goal with + | [ |- p2 @ p0 @ p1 @ eissect (to O A) (g x) = r ] => idtac "good" + | [ |- ?G ] => fail 1 "bad" G + end. + Fail rewrite concat_p_pp. + Abort. +End Lex_Reflective_Subuniverses. diff --git a/test-suite/bugs/closed/4538.v b/test-suite/bugs/closed/bug_4538.v index f925aae9e5..f925aae9e5 100644 --- a/test-suite/bugs/closed/4538.v +++ b/test-suite/bugs/closed/bug_4538.v diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/bug_4544.v index 13c47edc8f..13c47edc8f 100644 --- a/test-suite/bugs/closed/4544.v +++ b/test-suite/bugs/closed/bug_4544.v diff --git a/test-suite/bugs/closed/bug_4574.v b/test-suite/bugs/closed/bug_4574.v new file mode 100644 index 0000000000..cd6458c174 --- /dev/null +++ b/test-suite/bugs/closed/bug_4574.v @@ -0,0 +1,8 @@ +Require Import Setoid. + +Definition block A (a : A) := a. + +Goal forall A (a : A), block Type nat. +Proof. +Fail reflexivity. +Abort. diff --git a/test-suite/bugs/closed/4576.v b/test-suite/bugs/closed/bug_4576.v index 2c643ea779..2c643ea779 100644 --- a/test-suite/bugs/closed/4576.v +++ b/test-suite/bugs/closed/bug_4576.v diff --git a/test-suite/bugs/closed/bug_4580.v b/test-suite/bugs/closed/bug_4580.v new file mode 100644 index 0000000000..a8a446cc9b --- /dev/null +++ b/test-suite/bugs/closed/bug_4580.v @@ -0,0 +1,7 @@ +Require Import Program. + +Class Foo (A : Type) := foo : A. + +Unset Refine Instance Mode. +Program Instance f1 : Foo nat := S _. +Next Obligation. exact 0. Defined. diff --git a/test-suite/bugs/closed/4582.v b/test-suite/bugs/closed/bug_4582.v index 0842fb8fa7..0842fb8fa7 100644 --- a/test-suite/bugs/closed/4582.v +++ b/test-suite/bugs/closed/bug_4582.v diff --git a/test-suite/bugs/closed/4588.v b/test-suite/bugs/closed/bug_4588.v index ff66277e03..ff66277e03 100644 --- a/test-suite/bugs/closed/4588.v +++ b/test-suite/bugs/closed/bug_4588.v diff --git a/test-suite/bugs/closed/bug_4596.v b/test-suite/bugs/closed/bug_4596.v new file mode 100644 index 0000000000..bdd5edbdfb --- /dev/null +++ b/test-suite/bugs/closed/bug_4596.v @@ -0,0 +1,15 @@ +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. + +Definition T (x : bool) := x = true. + +Goal forall (S : Type) (b b0 : S -> nat -> bool) (str : S) (p : nat) + (s : forall n : nat, bool) + (s0 s1 : nat -> S -> S), + (forall (str0 : S) (n m : nat), + (if s m then T (b0 (s1 n str0) 0) else T (b (s1 n str0) 0)) -> T (b (s0 n str0) m) -> + T (b str0 m)) -> + T (b str p). +Proof. +intros ???????? H0. +rewrite H0. +Abort. diff --git a/test-suite/bugs/closed/bug_4603.v b/test-suite/bugs/closed/bug_4603.v new file mode 100644 index 0000000000..1879c06d49 --- /dev/null +++ b/test-suite/bugs/closed/bug_4603.v @@ -0,0 +1,10 @@ +Axiom A : Type. + +Goal True. exact I. +Check (fun P => P A). +Abort. + +Goal True. +Definition foo (A : Type) : Prop:= True. + set (x:=foo). split. +Qed. diff --git a/test-suite/bugs/closed/4612.v b/test-suite/bugs/closed/bug_4612.v index ce95f26acc..ce95f26acc 100644 --- a/test-suite/bugs/closed/4612.v +++ b/test-suite/bugs/closed/bug_4612.v diff --git a/test-suite/bugs/closed/4616.v b/test-suite/bugs/closed/bug_4616.v index d6660e3553..d6660e3553 100644 --- a/test-suite/bugs/closed/4616.v +++ b/test-suite/bugs/closed/bug_4616.v diff --git a/test-suite/bugs/closed/4622.v b/test-suite/bugs/closed/bug_4622.v index ffa478cb87..ffa478cb87 100644 --- a/test-suite/bugs/closed/4622.v +++ b/test-suite/bugs/closed/bug_4622.v diff --git a/test-suite/bugs/closed/4623.v b/test-suite/bugs/closed/bug_4623.v index 7ecfd98b67..7ecfd98b67 100644 --- a/test-suite/bugs/closed/4623.v +++ b/test-suite/bugs/closed/bug_4623.v diff --git a/test-suite/bugs/closed/4624.v b/test-suite/bugs/closed/bug_4624.v index f5ce981cd0..f5ce981cd0 100644 --- a/test-suite/bugs/closed/4624.v +++ b/test-suite/bugs/closed/bug_4624.v diff --git a/test-suite/bugs/closed/4627.v b/test-suite/bugs/closed/bug_4627.v index 4f56e19584..4f56e19584 100644 --- a/test-suite/bugs/closed/4627.v +++ b/test-suite/bugs/closed/bug_4627.v diff --git a/test-suite/bugs/closed/4628.v b/test-suite/bugs/closed/bug_4628.v index 7d4a15d689..7d4a15d689 100644 --- a/test-suite/bugs/closed/4628.v +++ b/test-suite/bugs/closed/bug_4628.v diff --git a/test-suite/bugs/closed/4634.v b/test-suite/bugs/closed/bug_4634.v index 77e31e108f..77e31e108f 100644 --- a/test-suite/bugs/closed/4634.v +++ b/test-suite/bugs/closed/bug_4634.v diff --git a/test-suite/bugs/closed/bug_4644.v b/test-suite/bugs/closed/bug_4644.v new file mode 100644 index 0000000000..d8f284834c --- /dev/null +++ b/test-suite/bugs/closed/bug_4644.v @@ -0,0 +1,53 @@ +(* Testing a regression of unification in 8.5 in problems of the form + "match ?y with ... end = ?x args" *) + +Lemma foo : exists b, forall a, match a with tt => tt end = b a. +Proof. +eexists. intro. +refine (_ : _ = match _ with tt => _ end). +refine eq_refl. +Qed. + +(**********************************************************************) + +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Export Coq.Classes.Morphisms. +Require Import Coq.Lists.List. + +Global Set Implicit Arguments. + +Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) + ls + : P ls + := match ls with + | nil => N + | x::xs => C x xs + end. + +Axiom list_caset_Proper' + : forall {A P}, + Proper (eq + ==> pointwise_relation _ (pointwise_relation _ eq) + ==> eq + ==> eq) + (@list_caset A (fun _ => P)). +Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool), + match a3 with + | nil => 0 + | (_ :: _)%list => 1 + end = y2 a4. + clear; eexists; intros. + reflexivity. Undo. + Local Ltac t := + lazymatch goal with + | [ |- match ?v with nil => ?N | cons x xs => @?C x xs end = _ :> ?P ] + => let T := type of v in + let A := match (eval hnf in T) with list ?A => A end in + refine (@list_caset_Proper' A P _ _ _ _ _ _ _ _ _ + : @list_caset A (fun _ => P) N C v = match _ with nil => _ | cons x xs => _ end) + end. + (etransitivity; [ t | reflexivity ]) || fail 0 "too early". + Undo. + t. +Abort. diff --git a/test-suite/bugs/closed/4653.v b/test-suite/bugs/closed/bug_4653.v index 4514342c5e..4514342c5e 100644 --- a/test-suite/bugs/closed/4653.v +++ b/test-suite/bugs/closed/bug_4653.v diff --git a/test-suite/bugs/closed/bug_4661.v b/test-suite/bugs/closed/bug_4661.v new file mode 100644 index 0000000000..ffcfbdd7ea --- /dev/null +++ b/test-suite/bugs/closed/bug_4661.v @@ -0,0 +1,11 @@ +Module Type Test. + Parameter t : Type. +End Test. + +Module Type Func (T:Test). + Parameter x : Type. +End Func. + +Module Shortest_path (T : Test). +Print Func. +End Shortest_path. diff --git a/test-suite/bugs/closed/4663.v b/test-suite/bugs/closed/bug_4663.v index b76619882a..b76619882a 100644 --- a/test-suite/bugs/closed/4663.v +++ b/test-suite/bugs/closed/bug_4663.v diff --git a/test-suite/bugs/closed/4670.v b/test-suite/bugs/closed/bug_4670.v index 6113992953..6113992953 100644 --- a/test-suite/bugs/closed/4670.v +++ b/test-suite/bugs/closed/bug_4670.v diff --git a/test-suite/bugs/closed/bug_4673.v b/test-suite/bugs/closed/bug_4673.v new file mode 100644 index 0000000000..f5ee4e3b57 --- /dev/null +++ b/test-suite/bugs/closed/bug_4673.v @@ -0,0 +1,58 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *) +(* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3 + coqtop version 8.5 (February 2016) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := case proof_admitted. +Require Coq.Lists.List. +Import Coq.Lists.List. +Import Coq.Classes.Morphisms. + +Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs)) + ls + : P ls + := match ls with + | nil => N + | x::xs => C x xs + end. + +Global Instance list_caset_Proper' {A P} + : Proper (eq + ==> pointwise_relation _ (pointwise_relation _ eq) + ==> eq + ==> eq) + (@list_caset A (fun _ => P)). +admit. +Defined. + +Global Instance list_caset_Proper'' {A P} + : (Proper (eq ==> pointwise_relation _ (pointwise_relation _ eq) ==> forall_relation (fun _ => eq)) + (list_caset A (fun _ => P))). +Admitted. + +Goal forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l0 : forall _ : forall _ : Char, bool, list bool) + + (T : Type) (T0 : forall _ : T, Type) (t : T), + + let predata := t in + + forall (splitdata : T0 predata) (l5 : forall _ : T0 t, list nat) (T1 : Type) (b : forall (_ : T1) (_ : Char), bool) + + (T2 : Type) (a11 : T2) (xs : list T2) (T3 : Type) (i0 : T3) (P0 : Set) (b1 : forall (_ : nat) (_ : P0), bool) + + (l2 : forall (_ : forall _ : T1, list bool) (_ : forall _ : P0, list bool) (_ : T2), list bool) + + (l1 : forall (_ : forall _ : forall _ : Char, bool, list bool) (_ : forall _ : P0, list bool) (_ : T3), list bool) + + (_ : forall NT : forall _ : P0, list bool, @eq (list bool) (l1 l0 NT i0) (l2 (fun f : T1 => l0 (b f)) NT a11)), + + P + (@list_caset T2 (fun _ : list T2 => list bool) l + (fun (_ : T2) (_ : list T2) => l1 l0 (fun a9 : P0 => @map nat bool (fun x0 : nat => b1 x0 a9) (l5 splitdata)) i0 +) xs). + intros. + subst predata; + let H := match goal with H : forall _, _ = _ |- _ => H end in + setoid_rewrite H || fail 0 "too early". + Undo. + setoid_rewrite H. +Abort. diff --git a/test-suite/bugs/closed/4679.v b/test-suite/bugs/closed/bug_4679.v index 3f41c5d6b1..3f41c5d6b1 100644 --- a/test-suite/bugs/closed/4679.v +++ b/test-suite/bugs/closed/bug_4679.v diff --git a/test-suite/bugs/closed/4684.v b/test-suite/bugs/closed/bug_4684.v index 9c0bed42c4..9c0bed42c4 100644 --- a/test-suite/bugs/closed/4684.v +++ b/test-suite/bugs/closed/bug_4684.v diff --git a/test-suite/bugs/closed/bug_4695.v b/test-suite/bugs/closed/bug_4695.v new file mode 100644 index 0000000000..27e35c2ac0 --- /dev/null +++ b/test-suite/bugs/closed/bug_4695.v @@ -0,0 +1,38 @@ +(* +The Qed at the end of this file was slow in 8.5 and 8.5pl1 because the kernel +term comparison after evaluation was done on constants according to their user +names. The conversion still succeeded because delta applied, but was much +slower than with a canonical names comparison. +*) + +Module Mod0. + + Fixpoint rec_ t d : nat := + match d with + | O => O + | S d' => + match t with + | true => rec_ t d' + | false => rec_ t d' + end + end. + + Definition depth := 1000. + + Definition rec t := rec_ t depth. + +End Mod0. + + +Module Mod1. + Module M := Mod0. +End Mod1. + + +Axiom rec_prop : forall t d n, Mod1.M.rec_ t d = n. + +Lemma slow_qed : forall t n, + Mod0.rec t = n. +Proof. + intros; unfold Mod0.rec; apply rec_prop. +Timeout 2 Qed. diff --git a/test-suite/bugs/closed/4708.v b/test-suite/bugs/closed/bug_4708.v index ad2e581004..ad2e581004 100644 --- a/test-suite/bugs/closed/4708.v +++ b/test-suite/bugs/closed/bug_4708.v diff --git a/test-suite/bugs/closed/4709.v b/test-suite/bugs/closed/bug_4709.v index a9edcc8043..a9edcc8043 100644 --- a/test-suite/bugs/closed/4709.v +++ b/test-suite/bugs/closed/bug_4709.v diff --git a/test-suite/bugs/closed/4710.v b/test-suite/bugs/closed/bug_4710.v index e792a36234..e792a36234 100644 --- a/test-suite/bugs/closed/4710.v +++ b/test-suite/bugs/closed/bug_4710.v diff --git a/test-suite/bugs/closed/4713.v b/test-suite/bugs/closed/bug_4713.v index 5d4d73be3f..5d4d73be3f 100644 --- a/test-suite/bugs/closed/4713.v +++ b/test-suite/bugs/closed/bug_4713.v diff --git a/test-suite/bugs/closed/4717.v b/test-suite/bugs/closed/bug_4717.v index bd9bac37ef..bd9bac37ef 100644 --- a/test-suite/bugs/closed/4717.v +++ b/test-suite/bugs/closed/bug_4717.v diff --git a/test-suite/bugs/closed/4718.v b/test-suite/bugs/closed/bug_4718.v index 12a4e8fc1a..12a4e8fc1a 100644 --- a/test-suite/bugs/closed/4718.v +++ b/test-suite/bugs/closed/bug_4718.v diff --git a/test-suite/bugs/closed/4720.v b/test-suite/bugs/closed/bug_4720.v index 704331e784..704331e784 100644 --- a/test-suite/bugs/closed/4720.v +++ b/test-suite/bugs/closed/bug_4720.v diff --git a/test-suite/bugs/closed/4723.v b/test-suite/bugs/closed/bug_4723.v index 5fb9696f3f..5fb9696f3f 100644 --- a/test-suite/bugs/closed/4723.v +++ b/test-suite/bugs/closed/bug_4723.v diff --git a/test-suite/bugs/closed/bug_4725.v b/test-suite/bugs/closed/bug_4725.v new file mode 100644 index 0000000000..3c014ea17c --- /dev/null +++ b/test-suite/bugs/closed/bug_4725.v @@ -0,0 +1,39 @@ +Require Import EquivDec Equivalence List Program. +Require Import Relation_Definitions. +Import ListNotations. +Generalizable All Variables. + +Fixpoint removeV `{eqDecV : @EqDec V eqV equivV}`(x : V) (l : list V) : list V +:= + match l with + | nil => nil + | y::tl => if (equiv_dec x y) then removeV x tl else y::(removeV x tl) + end. + +Lemma remove_le {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : +@EqDec V eqV equivV} (xs : list V) (x : V) : + length (removeV x xs) < length (x :: xs). + Proof. Admitted. + +(* Function version *) +Set Printing Universes. + +Require Import Recdef. + +Function nubV {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV : +@EqDec V eqV equivV} (l : list V) { measure length l} := + match l with + | nil => nil + | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) + end. +Proof. intros. apply remove_le. Qed. + +(* Program version *) + +Program Fixpoint nubV' `{eqDecV : @EqDec V eqV equivV} (l : list V) + { measure (@length V l) lt } := + match l with + | nil => nil + | x::xs => x :: @nubV' V eqV equivV eqDecV (removeV x xs) _ + end. +Next Obligation. apply remove_le. Defined. diff --git a/test-suite/bugs/closed/bug_4726.v b/test-suite/bugs/closed/bug_4726.v new file mode 100644 index 0000000000..cb87e9e409 --- /dev/null +++ b/test-suite/bugs/closed/bug_4726.v @@ -0,0 +1,19 @@ +Set Universe Polymorphism. + +Definition le@{i j} : Type@{j} := + (fun A : Type@{j} => A) + (unit : Type@{i}). +Definition eq@{i j} : Type@{j} := let x := le@{i j} in le@{j i}. + +Record Inj@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := + { inj : A }. + +Monomorphic Universe u1. +Let ty1 : Type@{u1} := Set. +Check Inj@{Set u1}. +(* Would fail with univ inconsistency if the universe was minimized *) + +Record Inj'@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} := + { inj' : A; foo : Type@{j} := eq@{i j} }. +Fail Check Inj'@{Set u1}. (* Do not drop constraint i = j *) +Check Inj'@{Set Set}. diff --git a/test-suite/bugs/closed/4737.v b/test-suite/bugs/closed/bug_4737.v index 84ed45e454..84ed45e454 100644 --- a/test-suite/bugs/closed/4737.v +++ b/test-suite/bugs/closed/bug_4737.v diff --git a/test-suite/bugs/closed/4745.v b/test-suite/bugs/closed/bug_4745.v index c090125e64..c090125e64 100644 --- a/test-suite/bugs/closed/4745.v +++ b/test-suite/bugs/closed/bug_4745.v diff --git a/test-suite/bugs/closed/4746.v b/test-suite/bugs/closed/bug_4746.v index d64cc6fe68..d64cc6fe68 100644 --- a/test-suite/bugs/closed/4746.v +++ b/test-suite/bugs/closed/bug_4746.v diff --git a/test-suite/bugs/closed/4754.v b/test-suite/bugs/closed/bug_4754.v index 67d645a68f..67d645a68f 100644 --- a/test-suite/bugs/closed/4754.v +++ b/test-suite/bugs/closed/bug_4754.v diff --git a/test-suite/bugs/closed/bug_4762.v b/test-suite/bugs/closed/bug_4762.v new file mode 100644 index 0000000000..62e2abbf98 --- /dev/null +++ b/test-suite/bugs/closed/bug_4762.v @@ -0,0 +1,23 @@ +Inductive myand (P Q : Prop) := myconj : P -> Q -> myand P Q. + +Lemma foo P Q R : R = myand P Q -> P -> Q -> R. +Proof. intros ->; constructor; auto. Qed. + +Hint Extern 0 (myand _ _) => eapply foo; [reflexivity| |] : test1. + +Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). +Proof. + intros. + eauto with test1. +Qed. + +Hint Extern 0 => + match goal with + | |- myand _ _ => eapply foo; [reflexivity| |] + end : test2. + +Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R). +Proof. + intros. + eauto with test2. (* works *) +Qed. diff --git a/test-suite/bugs/closed/4763.v b/test-suite/bugs/closed/bug_4763.v index 9613b5c248..9613b5c248 100644 --- a/test-suite/bugs/closed/4763.v +++ b/test-suite/bugs/closed/bug_4763.v diff --git a/test-suite/bugs/closed/4764.v b/test-suite/bugs/closed/bug_4764.v index e545cc1b71..e545cc1b71 100644 --- a/test-suite/bugs/closed/4764.v +++ b/test-suite/bugs/closed/bug_4764.v diff --git a/test-suite/bugs/closed/bug_4769.v b/test-suite/bugs/closed/bug_4769.v new file mode 100644 index 0000000000..34ce03d231 --- /dev/null +++ b/test-suite/bugs/closed/bug_4769.v @@ -0,0 +1,94 @@ + +(* -*- mode: coq; coq-prog-args: ("-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *) +(* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3 + coqtop version trunk (June 2016) *) + +Reserved Notation "x -> y" (at level 99, right associativity, y at level 200). +Reserved Notation "x * y" (at level 40, left associativity). +Delimit Scope type_scope with type. +Open Scope type_scope. +Global Set Universe Polymorphism. +Notation "A -> B" := (forall (_ : A), B) : type_scope. +Set Implicit Arguments. +Global Set Nonrecursive Elimination Schemes. +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Notation "x * y" := (prod x y) : type_scope. +Axiom admit : forall {T}, T. +Delimit Scope function_scope with function. +Notation compose := (fun g f x => g (f x)). +Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope. +Record PreCategory := + Build_PreCategory { + object :> Type; + morphism : object -> object -> Type; + identity : forall x, morphism x x }. +Bind Scope category_scope with PreCategory. +Record Functor (C D : PreCategory) := { object_of :> C -> D }. +Bind Scope functor_scope with Functor. +Class Isomorphic {C : PreCategory} (s d : C) := {}. +Definition oppositeC (C : PreCategory) : PreCategory + := @Build_PreCategory C (fun s d => morphism C d s) admit. +Notation "C ^op" := (oppositeC C) (at level 3, format "C '^op'") : category_scope. +Definition oppositeF C D (F : Functor C D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) (object_of F). +Definition set_cat : PreCategory := @Build_PreCategory Type (fun x y => x -> y) admit. +Definition prodC (C D : PreCategory) : PreCategory + := @Build_PreCategory + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + admit. +Infix "*" := prodC : category_scope. +Section composition. + Variables B C D E : PreCategory. + Definition composeF (G : Functor D E) (F : Functor C D) : Functor C E := Build_Functor C E (fun c => G (F c)). +End composition. +Infix "o" := composeF : functor_scope. +Definition fstF {C D} : Functor (C * D) C := admit. +Definition sndF {C D} : Functor (C * D) D := admit. +Definition prodF C D D' (F : Functor C D) (F' : Functor C D') : Functor C (D * D') := admit. +Local Infix "*" := prodF : functor_scope. +Definition pairF C D C' D' (F : Functor C D) (F' : Functor C' D') : Functor (C * C') (D * D') + := (F o fstF) * (F' o sndF). +Section hom_functor. + Variable C : PreCategory. + Local Notation obj_of c'c := + ((morphism + C + (fst (c'c : object (C^op * C))) + (snd (c'c : object (C^op * C))))). + Definition hom_functor : Functor (C^op * C) set_cat + := Build_Functor (C^op * C) set_cat (fun c'c => obj_of c'c). +End hom_functor. +Definition identityF C : Functor C C := admit. +Definition functor_category (C D : PreCategory) : PreCategory + := @Build_PreCategory (Functor C D) admit admit. +Local Notation "C -> D" := (functor_category C D) : category_scope. +Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G. + +Section Adjunction. + Variables C D : PreCategory. + Variable F : Functor C D. + Variable G : Functor D C. + + Record AdjunctionHom := + { + mate_of : @NaturalIsomorphism + (prodC (oppositeC C) D) + (@set_cat) + (@composeF + (prodC (oppositeC C) D) + (prodC (oppositeC D) D) + (@set_cat) (@hom_functor D) + (@pairF (oppositeC C) + (oppositeC D) D D + (@oppositeF C D F) (identityF D))) + (@composeF + (prodC (oppositeC C) D) + (prodC (oppositeC C) C) + (@set_cat) (@hom_functor C) + (@pairF (oppositeC C) + (oppositeC C) D C + (identityF (oppositeC C)) G)) + }. +End Adjunction. diff --git a/test-suite/bugs/closed/4772.v b/test-suite/bugs/closed/bug_4772.v index c3109fa31c..c3109fa31c 100644 --- a/test-suite/bugs/closed/4772.v +++ b/test-suite/bugs/closed/bug_4772.v diff --git a/test-suite/bugs/closed/bug_4780.v b/test-suite/bugs/closed/bug_4780.v new file mode 100644 index 0000000000..7ed56d2179 --- /dev/null +++ b/test-suite/bugs/closed/bug_4780.v @@ -0,0 +1,105 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Top" "-top" "bug_bad_induction_01") -*- *) +(* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *) +(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 + coqtop version 8.5pl1 (April 2016) *) +Axiom proof_admitted : False. +Tactic Notation "admit" := abstract case proof_admitted. +Global Set Universe Polymorphism. +Global Set Asymmetric Patterns. +Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..)) + (at level 200, x binder, right associativity, + format "'[' 'exists' '/ ' x .. y , '/ ' p ']'") + : type_scope. +Definition relation (A : Type) := A -> A -> Type. +Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. +Tactic Notation "etransitivity" open_constr(y) := + let R := match goal with |- ?R ?x ?z => constr:(R) end in + let x := match goal with |- ?R ?x ?z => constr:(x) end in + let z := match goal with |- ?R ?x ?z => constr:(z) end in + refine (@transitivity _ R _ x y z _ _). +Tactic Notation "etransitivity" := etransitivity _. +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation pr1 := projT1. +Notation pr2 := projT2. +Notation "x .1" := (projT1 x) (at level 3) : fibration_scope. +Notation "x .2" := (projT2 x) (at level 3) : fibration_scope. +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Arguments paths_rect [A] a P f y p. +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Delimit Scope path_scope with path. +Local Open Scope path_scope. +Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := + match p, q with idpath, idpath => idpath end. +Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A. +Definition inverse {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. +Notation "1" := idpath : path_scope. +Notation "p @ q" := (concat p q) (at level 20) : path_scope. +Notation "p ^" := (inverse p) (at level 3) : path_scope. +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y := + match p with idpath => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope. +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with idpath => idpath end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): + p # (f x) = f y + := match p with idpath => idpath end. +Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B) + (p : x = y) (z : P (f x)) + : transport (fun x => P (f x)) p z = transport P (ap f p) z. +admit. +Defined. +Local Open Scope path_scope. +Generalizable Variables X A B C f g n. +Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (pq : {p : u.1 = v.1 & p # u.2 = v.2}) + : u = v + := match pq with + | existT p q => + match u, v return (forall p0 : (u.1 = v.1), (p0 # u.2 = v.2) -> (u=v)) with + | (x;y), (x';y') => fun p1 q1 => + match p1 in (_ = x'') return (forall y'', (p1 # y = y'') -> (x;y)=(x'';y'')) with + | idpath => fun y' q2 => + match q2 in (_ = y'') return (x;y) = (x;y'') with + | idpath => 1 + end + end y' q1 + end p q + end. +Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P) + (p : u.1 = v.1) (q : p # u.2 = v.2) + : u = v + := path_sigma_uncurried P u v (p;q). +Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v) + : u.1 = v.1 + := + ap (@projT1 _ _) p. +Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope. +Definition projT2_path `{P : A -> Type} {u v : sigT P} (p : u = v) + : p..1 # u.2 = v.2 + := (transport_compose P (@projT1 _ _) p u.2)^ + @ (@apD {x:A & P x} _ (@projT2 _ _) _ _ p). +Notation "p ..2" := (projT2_path p) (at level 3) : fibration_scope. +Definition eta_path_sigma_uncurried `{P : A -> Type} {u v : sigT P} + (p : u = v) + : path_sigma_uncurried _ _ _ (p..1; p..2) = p. +admit. +Defined. +Definition eta_path_sigma `{P : A -> Type} {u v : sigT P} (p : u = v) + : path_sigma _ _ _ (p..1) (p..2) = p + := eta_path_sigma_uncurried p. + +Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P) + (p q : u = v) + (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2}) + : p = q. +Proof. + destruct rs, p, u. + etransitivity; [ | apply eta_path_sigma ]. + simpl in *. + induction p0. + admit. +Defined. diff --git a/test-suite/bugs/closed/bug_4782.v b/test-suite/bugs/closed/bug_4782.v new file mode 100644 index 0000000000..be17a96f15 --- /dev/null +++ b/test-suite/bugs/closed/bug_4782.v @@ -0,0 +1,25 @@ +(* About typing of with bindings *) + +Record r : Type := mk_r { type : Type; cond : type -> Prop }. + +Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p. + +Goal p. +Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil. +Abort. + +(* A simplification of an example from coquelicot, which was failing + at some time after a fix #4782 was committed. *) + +Record T := { dom : Type }. +Definition pairT A B := {| dom := (dom A * dom B)%type |}. +Class C (A:Type). +Parameter B:T. +Instance c (A:T) : C (dom A). +Instance cn : C (dom B). +Parameter F : forall A:T, C (dom A) -> forall x:dom A, x=x -> A = A. +Set Typeclasses Debug. +Goal forall (A:T) (x:dom A), pairT A A = pairT A A. +intros. +apply (F _ _) with (x,x). +Abort. diff --git a/test-suite/bugs/closed/4785.v b/test-suite/bugs/closed/bug_4785.v index 0d347b262d..0d347b262d 100644 --- a/test-suite/bugs/closed/4785.v +++ b/test-suite/bugs/closed/bug_4785.v diff --git a/test-suite/bugs/closed/bug_4787.v b/test-suite/bugs/closed/bug_4787.v new file mode 100644 index 0000000000..a1444a4f63 --- /dev/null +++ b/test-suite/bugs/closed/bug_4787.v @@ -0,0 +1,7 @@ +(* [Unset Bracketing Last Introduction Pattern] was not working *) + +Unset Bracketing Last Introduction Pattern. + +Goal forall T (x y : T * T), fst x = fst y /\ snd x = snd y -> x = y. +do 10 ((intros [] || intro); simpl); reflexivity. +Qed. diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/bug_4798.v index 41a1251ca5..41a1251ca5 100644 --- a/test-suite/bugs/closed/4798.v +++ b/test-suite/bugs/closed/bug_4798.v diff --git a/test-suite/bugs/closed/bug_4811.v b/test-suite/bugs/closed/bug_4811.v new file mode 100644 index 0000000000..b90257cb3f --- /dev/null +++ b/test-suite/bugs/closed/bug_4811.v @@ -0,0 +1,1686 @@ +(* Test about a slowness of f_equal in 8.5pl1 *) + +(* Submitted by Jason Gross *) + +(* -*- mode: coq; coq-prog-args: ("-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *) +(* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *) +(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3 + coqtop version 8.5pl1 (April 2016) *) +Require Coq.ZArith.ZArith. + +Import Coq.ZArith.ZArith. + +Axiom F : Z -> Set. +Definition Let_In {A P} (x : A) (f : forall y : A, P y) + := let y := x in f y. +Local Open Scope Z_scope. +Definition modulus : Z := 2^255 - 19. +Axiom decode : list Z -> F modulus. +Goal forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z, + let Zmul := Z.mul in + let Zadd := Z.add in + let Zsub := Z.sub in + let Zpow_pos := Z.pow_pos in + @eq (F (Zsub (Zpow_pos (Zpos (xO xH)) (xI (xI (xI (xI (xI (xI (xI xH)))))))) (Zpos (xI (xI (xO (xO xH))))))) + (@decode + (@Let_In Z (fun _ : Z => list Z) + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (fun z : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (fun z0 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z0 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (fun z1 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z1 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) + (fun z2 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z2 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (fun z3 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z3 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (fun z4 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z4 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (fun z5 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z5 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (fun z6 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z6 (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) + (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (fun z7 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Z.shiftr z7 (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) + (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) + (Zmul x1 y8)) (Zmul x0 y9))) + (fun z8 : Z => + @Let_In Z (fun _ : Z => list Z) + (Zadd (Zmul (Zpos (xI (xI (xO (xO xH))))) (Z.shiftr z8 (Zpos (xI (xO (xO (xI xH))))))) + (Z.land z + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (fun z9 : Z => + @cons Z + (Z.land z9 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Zadd (Z.shiftr z9 (Zpos (xO (xI (xO (xI xH)))))) + (Z.land z0 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z1 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z2 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z3 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z4 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z5 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z6 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land z7 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land z8 + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@nil Z))))))))))))))))))))))) + (@decode + (@cons Z + (Z.land + (Zadd + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) + (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) + (Zmul x0 y8)) (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) (Zmul x5 y4)) + (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) + (Zpos (xI (xO (xO (xI xH))))))) + (Z.land + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Zadd + (Z.shiftr + (Zadd + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2)) + (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4)) + (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) + (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) + (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) + (Zmul x1 y8)) (Zmul x0 y9))) (Zpos (xI (xO (xO (xI xH))))))) + (Z.land + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Z.land + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) + (Zmul x6 y5)) (Zmul x5 y6)) (Zmul x4 y7)) + (Zmul x3 y8)) (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) + (Zmul x6 y5)) (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul (Zmul x9 y1) (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul (Zmul x7 y3) (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) (Zmul x6 y5)) + (Zmul x5 y6)) (Zmul x4 y7)) + (Zmul x3 y8)) (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul (Zmul x5 y5) (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul (Zmul x3 y7) (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y2) (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) (Zmul x3 y8)) + (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) + (Zmul x6 y7)) (Zmul x5 y8)) + (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) + (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2)) + (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) + (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3)) + (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul + (Zmul x3 y7) + (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y3) + (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul (Zmul x7 y5) (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul (Zmul x5 y7) (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) + (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) (Zmul x6 y7)) + (Zmul x5 y8)) (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) + (Zmul x8 y6)) (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) + (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) + (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) + (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) + (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) + (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))) + (@cons Z + (Z.land + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd + (Z.shiftr + (Zadd (Zmul x0 y0) + (Zmul + (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y1) + (Zpos (xO xH))) + (Zmul x8 y2)) + (Zmul + (Zmul x7 y3) + (Zpos (xO xH)))) + (Zmul x6 y4)) + (Zmul + (Zmul x5 y5) + (Zpos (xO xH)))) + (Zmul x4 y6)) + (Zmul + (Zmul x3 y7) + (Zpos (xO xH)))) + (Zmul x2 y8)) + (Zmul + (Zmul x1 y9) + (Zpos (xO xH)))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul x9 y2) + (Zmul x8 y3)) + (Zmul x7 y4)) + (Zmul x6 y5)) + (Zmul x5 y6)) + (Zmul x4 y7)) + (Zmul x3 y8)) + (Zmul x2 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zmul x2 y0) + (Zmul (Zmul x1 y1) (Zpos (xO xH)))) + (Zmul x0 y2)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zmul + (Zmul x9 y3) + (Zpos (xO xH))) + (Zmul x8 y4)) + (Zmul + (Zmul x7 y5) + (Zpos (xO xH)))) + (Zmul x6 y6)) + (Zmul + (Zmul x5 y7) + (Zpos (xO xH)))) + (Zmul x4 y8)) + (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) + (Zmul x1 y2)) (Zmul x0 y3)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x9 y4) (Zmul x8 y5)) + (Zmul x7 y6)) + (Zmul x6 y7)) + (Zmul x5 y8)) + (Zmul x4 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x4 y0) + (Zmul (Zmul x3 y1) (Zpos (xO xH)))) + (Zmul x2 y2)) + (Zmul (Zmul x1 y3) (Zpos (xO xH)))) + (Zmul x0 y4)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd + (Zadd + (Zadd + (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) + (Zmul x8 y6)) + (Zmul (Zmul x7 y7) (Zpos (xO xH)))) + (Zmul x6 y8)) + (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) + (Zmul x2 y3)) (Zmul x1 y4)) + (Zmul x0 y5)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) + (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zmul x6 y0) + (Zmul (Zmul x5 y1) (Zpos (xO xH)))) + (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH)))) + (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH)))) + (Zmul x0 y6)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) + (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8)) + (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) + (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5)) + (Zmul x1 y6)) (Zmul x0 y7)) + (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9))))) + (Zpos (xI (xO (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) + (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH)))) + (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH)))) + (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) + (Zmul x0 y8)) + (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH))))) + (Zpos (xO (xI (xO (xI xH)))))) + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd + (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) + (Zmul x6 y3)) (Zmul x5 y4)) (Zmul x4 y5)) + (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9))) + (Zpos + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI + (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))) + (@nil Z)))))))))))). + cbv beta zeta. + intros. + (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early". + Undo. + Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *) +Abort. diff --git a/test-suite/bugs/closed/bug_4813.v b/test-suite/bugs/closed/bug_4813.v new file mode 100644 index 0000000000..d1a2ebe820 --- /dev/null +++ b/test-suite/bugs/closed/bug_4813.v @@ -0,0 +1,10 @@ +(* On the strength of "apply with" (see also #4782) *) + +Record ProverT := { Facts : Type }. +Record ProverT_correct (P : ProverT) := { Valid : Facts P -> Prop ; + Valid_weaken : Valid = Valid }. +Definition reflexivityValid (_ : unit) := True. +Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}. +Proof. + eapply Build_ProverT_correct with (Valid := reflexivityValid). +Abort. diff --git a/test-suite/bugs/closed/4816.v b/test-suite/bugs/closed/bug_4816.v index 00a523842e..00a523842e 100644 --- a/test-suite/bugs/closed/4816.v +++ b/test-suite/bugs/closed/bug_4816.v diff --git a/test-suite/bugs/closed/bug_4818.v b/test-suite/bugs/closed/bug_4818.v new file mode 100644 index 0000000000..186c4425c1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4818.v @@ -0,0 +1,25 @@ +(* -*- mode: coq; coq-prog-args: ("-R" "." "Prob" "-top" "Product") -*- *) +(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *) +(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3 + coqtop version 8.5pl1 (June 2016) *) +Set Universe Polymorphism. + +Inductive GCov (I : Type) : Type := | Foo : I -> GCov I. + +Section Product. + +Variables S IS : Type. +Variable locS : IS -> True. + +Goal GCov (IS * S) -> GCov IS. +intros X0. induction X0; intros. +destruct i. +specialize (locS i). +clear -locS. +destruct locS. Show Universes. +Admitted. + +(* +Anomaly: Universe Product.5189 undefined. Please report. +*) +End Product. diff --git a/test-suite/bugs/closed/4844.v b/test-suite/bugs/closed/bug_4844.v index f140939ccd..f140939ccd 100644 --- a/test-suite/bugs/closed/4844.v +++ b/test-suite/bugs/closed/bug_4844.v diff --git a/test-suite/bugs/closed/bug_4852.v b/test-suite/bugs/closed/bug_4852.v new file mode 100644 index 0000000000..e2e00f05d3 --- /dev/null +++ b/test-suite/bugs/closed/bug_4852.v @@ -0,0 +1,53 @@ +(** BZ 4852 : unsatisfactory Extraction Implicit for a fixpoint defined via wf *) + +Require Import Coq.Lists.List. +Import ListNotations. +Require Import Omega. + +Definition wfi_lt := well_founded_induction_type Wf_nat.lt_wf. + +Tactic Notation "wfinduction" constr(term) "on" ne_hyp_list(Hs) "as" ident(H) := + let R := fresh in + let E := fresh in + remember term as R eqn:E; + revert E; revert Hs; + induction R as [R H] using wfi_lt; + intros; subst R. + +Hint Rewrite @app_comm_cons @app_assoc @app_length : app_rws. + +Ltac solve_nat := autorewrite with app_rws in *; cbn in *; omega. + +Notation "| x |" := (length x) (at level 11, no associativity, format "'|' x '|'"). + +Definition split_acc (ls : list nat) : forall acc1 acc2, + (|acc1| = |acc2| \/ |acc1| = S (|acc2|)) -> + { lss : list nat * list nat | + let '(ls1, ls2) := lss in |ls1++ls2| = |ls++acc1++acc2| /\ (|ls1| = |ls2| \/ |ls1| = S (|ls2|))}. +Proof. + induction ls as [|a ls IHls]. all:intros acc1 acc2 H. + { exists (acc1, acc2). cbn. intuition reflexivity. } + destruct (IHls (a::acc2) acc1) as [[ls1 ls2] (H1 & H2)]. 1:solve_nat. + exists (ls1, ls2). cbn. intuition solve_nat. +Defined. + +Definition join(ls : list nat) : { rls : list nat | |rls| = |ls| }. +Proof. + wfinduction (|ls|) on ls as IH. + case (split_acc ls [] []). 1:solve_nat. + intros (ls1 & ls2) (H1 & H2). + destruct ls2 as [|a ls2]. + - exists ls1. solve_nat. + - unshelve eelim (IH _ _ ls1 eq_refl). 1:solve_nat. intros rls1 H3. + unshelve eelim (IH _ _ ls2 eq_refl). 1:solve_nat. intros rls2 H4. + exists (a :: rls1 ++ rls2). solve_nat. +Defined. + +Require Import ExtrOcamlNatInt. +Extract Inlined Constant length => "List.length". +Extract Inlined Constant app => "List.append". + +Extraction Inline wfi_lt. +Extraction Implicit wfi_lt [1 3]. +Recursive Extraction join. (* was: Error: An implicit occurs after extraction *) +Extraction TestCompile join. diff --git a/test-suite/bugs/closed/4858.v b/test-suite/bugs/closed/bug_4858.v index a2fa93832a..a2fa93832a 100644 --- a/test-suite/bugs/closed/4858.v +++ b/test-suite/bugs/closed/bug_4858.v diff --git a/test-suite/bugs/closed/4859.v b/test-suite/bugs/closed/bug_4859.v index 7be0bedcfc..7be0bedcfc 100644 --- a/test-suite/bugs/closed/4859.v +++ b/test-suite/bugs/closed/bug_4859.v diff --git a/test-suite/bugs/closed/bug_4863.v b/test-suite/bugs/closed/bug_4863.v new file mode 100644 index 0000000000..be2be5683e --- /dev/null +++ b/test-suite/bugs/closed/bug_4863.v @@ -0,0 +1,33 @@ +Require Import Classes.DecidableClass. + +Inductive Foo : Set := +| foo1 | foo2. + +Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. +Proof. + intros P H. + refine (Build_Decidable _ (if H then true else false) _). + intuition congruence. +Qed. + +Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances. + +Goal forall (a b : Foo), {a=b}+{a<>b}. +intros. +abstract (abstract (decide equality)). (*abstract works here*) +Qed. + +Check ltac:(abstract (exact I)) : True. + +Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). +intros. +split. typeclasses eauto. +typeclasses eauto. Qed. + +Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). +intros. +split. +refine _. +refine _. +Defined. +(*fails*) diff --git a/test-suite/bugs/closed/bug_4865.v b/test-suite/bugs/closed/bug_4865.v new file mode 100644 index 0000000000..4fd55d1c62 --- /dev/null +++ b/test-suite/bugs/closed/bug_4865.v @@ -0,0 +1,52 @@ +(* Check discharge of arguments scopes + other checks *) + +(* This is bug #4865 *) + +Notation "<T>" := true : bool_scope. +Section A. + Check negb <T>. + Global Arguments negb : clear scopes. + Fail Check negb <T>. +End A. + +(* Check that no scope is re-computed *) +Fail Check negb <T>. + +(* Another test about arguments scopes in sections *) + +Notation "0" := true. +Section B. + Variable x : nat. + Let T := nat -> nat. + Definition f y : T := fun z => x + y + z. + Fail Check f 1 0. (* 0 in nat, 0 in bool *) + Fail Check f 0 0. (* 0 in nat, 0 in bool *) + Check f 0 1. (* 0 and 1 in nat *) + Global Arguments f _%nat_scope _%nat_scope. + Check f 0 0. (* both 0 in nat *) +End B. + +(* Check that only the scope for the extra product on x is re-computed *) +Check f 0 0 0. (* All 0 in nat *) + +Section C. + Variable x : nat. + Let T := nat -> nat. + Definition g y : T := fun z => x + y + z. + Global Arguments g : clear scopes. + Check g 1. (* 1 in nat *) +End C. + +(* Check that only the scope for the extra product on x is re-computed *) +Check g 0. (* 0 in nat *) +Fail Check g 0 1 0. (* 2nd 0 in bool *) +Fail Check g 0 0 1. (* 2nd 0 in bool *) + +(* Another test on arguments scopes: checking scope for expanding arities *) +(* Not sure this is very useful, but why not *) + +Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end. +Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n end. +Notation "0" := true. +Arguments lam _%nat_scope _%nat_scope : extra scopes. +Check (lam 1 0). diff --git a/test-suite/bugs/closed/4869.v b/test-suite/bugs/closed/bug_4869.v index ac5d7ea287..ac5d7ea287 100644 --- a/test-suite/bugs/closed/4869.v +++ b/test-suite/bugs/closed/bug_4869.v diff --git a/test-suite/bugs/closed/4873.v b/test-suite/bugs/closed/bug_4873.v index 39299883ad..39299883ad 100644 --- a/test-suite/bugs/closed/4873.v +++ b/test-suite/bugs/closed/bug_4873.v diff --git a/test-suite/bugs/closed/4877.v b/test-suite/bugs/closed/bug_4877.v index 7d153d9828..7d153d9828 100644 --- a/test-suite/bugs/closed/4877.v +++ b/test-suite/bugs/closed/bug_4877.v diff --git a/test-suite/bugs/closed/4880.v b/test-suite/bugs/closed/bug_4880.v index 5569798d54..5569798d54 100644 --- a/test-suite/bugs/closed/4880.v +++ b/test-suite/bugs/closed/bug_4880.v diff --git a/test-suite/bugs/closed/bug_4893.v b/test-suite/bugs/closed/bug_4893.v new file mode 100644 index 0000000000..1b1ca7c108 --- /dev/null +++ b/test-suite/bugs/closed/bug_4893.v @@ -0,0 +1,5 @@ +Goal True. +evar (P: Prop). +assert (H : P); [|subst P]; [exact I|]. +let T := type of H in not_evar T. +Abort. diff --git a/test-suite/bugs/closed/4904.v b/test-suite/bugs/closed/bug_4904.v index a47c3b07a9..a47c3b07a9 100644 --- a/test-suite/bugs/closed/4904.v +++ b/test-suite/bugs/closed/bug_4904.v diff --git a/test-suite/bugs/closed/4932.v b/test-suite/bugs/closed/bug_4932.v index 219d532ac6..219d532ac6 100644 --- a/test-suite/bugs/closed/4932.v +++ b/test-suite/bugs/closed/bug_4932.v diff --git a/test-suite/bugs/closed/bug_4955.v b/test-suite/bugs/closed/bug_4955.v new file mode 100644 index 0000000000..cadc6e5da1 --- /dev/null +++ b/test-suite/bugs/closed/bug_4955.v @@ -0,0 +1,98 @@ +(* An example involving a first-order unification triggering a cyclic constraint *) + +Module A. +Notation "{ x : A | P }" := (sigT (fun x:A => P)). +Notation "( x ; y )" := (existT _ x y) : fibration_scope. +Open Scope fibration_scope. +Notation "p @ q" := (eq_trans p q) (at level 20). +Notation "p ^" := (eq_sym p) (at level 3). +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) +: P y := + match p with eq_refl => u end. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only +parsing). +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with eq_refl => eq_refl end. +Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): p # (f +x) = f y + := match p with eq_refl => eq_refl end. +Axiom transport_compose + : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f +x)), + transport (fun x => P (f x)) p z = transport P (ap f p) z. +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Delimit Scope functor_scope with functor. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) +(object_of d) }. +Arguments object_of {C%category D%category} f%functor c%object : rename, simpl +nomatch. +Arguments morphism_of [C%category] [D%category] f%functor [s%object d%object] +m%morphism : rename, simpl nomatch. +Section path_functor. + Variable C : PreCategory. + Variable D : PreCategory. + + Local Notation path_functor'_T F G + := { HO : object_of F = object_of G + | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) +(GO d)) + HO + (morphism_of F) + = morphism_of G } + (only parsing). + Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> +path_functor'_T F G + := fun H' + => (ap object_of H'; + (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). + +End path_functor. +End A. + +(* A variant of it with more axioms *) + +Module B. +Notation "{ x : A | P }" := (sigT (fun x:A => P)). +Notation "( x ; y )" := (existT _ x y). +Notation "p @ q" := (eq_trans p q) (at level 20). +Notation "p ^" := (eq_sym p) (at level 3). +Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y. +Notation "p # x" := (transport _ p x) (right associativity, at level 65, only +parsing). +Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y + := match p with eq_refl => eq_refl end. +Axiom apD : forall {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y), p # (f +x) = f y. +Axiom transport_compose + : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f +x)), + transport (fun x => P (f x)) p z = transport P (ap f p) z. +Record PreCategory := { object :> Type ; morphism : object -> object -> Type }. +Record Functor (C D : PreCategory) := + { object_of :> C -> D; + morphism_of : forall s d, morphism C s d -> morphism D (object_of s) +(object_of d) }. +Arguments object_of {C D} f c : rename, simpl nomatch. +Arguments morphism_of [C] [D] f [s d] m : rename, simpl nomatch. +Section path_functor. + Variable C D : PreCategory. + Local Notation path_functor'_T F G + := { HO : object_of F = object_of G + | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) +(GO d)) + HO + (morphism_of F) + = morphism_of G }. + Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> +path_functor'_T F G + := fun H' + => (ap object_of H'; + (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H'). + +End path_functor. +End B. diff --git a/test-suite/bugs/closed/4957.v b/test-suite/bugs/closed/bug_4957.v index 0efd87ac0d..0efd87ac0d 100644 --- a/test-suite/bugs/closed/4957.v +++ b/test-suite/bugs/closed/bug_4957.v diff --git a/test-suite/bugs/closed/4966.v b/test-suite/bugs/closed/bug_4966.v index bd93cdc858..bd93cdc858 100644 --- a/test-suite/bugs/closed/4966.v +++ b/test-suite/bugs/closed/bug_4966.v diff --git a/test-suite/bugs/closed/bug_4969.v b/test-suite/bugs/closed/bug_4969.v new file mode 100644 index 0000000000..d6d3021200 --- /dev/null +++ b/test-suite/bugs/closed/bug_4969.v @@ -0,0 +1,12 @@ +Require Import Classes.Init. + +Class C A := c : A. +Instance nat_C : C nat := 0. +Instance bool_C : C bool := true. +Lemma silly {A} `{C A} : 0 = 0 -> c = c -> True. +Proof. auto. Qed. + +Goal True. + class_apply @silly; [reflexivity|]. + reflexivity. Fail Qed. +Abort. diff --git a/test-suite/bugs/closed/4970.v b/test-suite/bugs/closed/bug_4970.v index 7a896582f5..7a896582f5 100644 --- a/test-suite/bugs/closed/4970.v +++ b/test-suite/bugs/closed/bug_4970.v diff --git a/test-suite/bugs/closed/5011.v b/test-suite/bugs/closed/bug_5011.v index c3043ca5d1..c3043ca5d1 100644 --- a/test-suite/bugs/closed/5011.v +++ b/test-suite/bugs/closed/bug_5011.v diff --git a/test-suite/bugs/closed/5012.v b/test-suite/bugs/closed/bug_5012.v index 5326c0fbb1..5326c0fbb1 100644 --- a/test-suite/bugs/closed/5012.v +++ b/test-suite/bugs/closed/bug_5012.v diff --git a/test-suite/bugs/closed/5019.v b/test-suite/bugs/closed/bug_5019.v index 7c973f88b5..7c973f88b5 100644 --- a/test-suite/bugs/closed/5019.v +++ b/test-suite/bugs/closed/bug_5019.v diff --git a/test-suite/bugs/closed/5036.v b/test-suite/bugs/closed/bug_5036.v index 83f1677455..83f1677455 100644 --- a/test-suite/bugs/closed/5036.v +++ b/test-suite/bugs/closed/bug_5036.v diff --git a/test-suite/bugs/closed/5043.v b/test-suite/bugs/closed/bug_5043.v index 4e6a0f878f..4e6a0f878f 100644 --- a/test-suite/bugs/closed/5043.v +++ b/test-suite/bugs/closed/bug_5043.v diff --git a/test-suite/bugs/closed/bug_5045.v b/test-suite/bugs/closed/bug_5045.v new file mode 100644 index 0000000000..bda2adc760 --- /dev/null +++ b/test-suite/bugs/closed/bug_5045.v @@ -0,0 +1,4 @@ +Axiom silly : 1 = 1 -> nat -> nat. +Goal forall pf : 1 = 1, silly pf 0 = 0 -> True. + Fail generalize (@eq nat). +Abort. diff --git a/test-suite/bugs/closed/5065.v b/test-suite/bugs/closed/bug_5065.v index 932fee8b3b..932fee8b3b 100644 --- a/test-suite/bugs/closed/5065.v +++ b/test-suite/bugs/closed/bug_5065.v diff --git a/test-suite/bugs/closed/5066.v b/test-suite/bugs/closed/bug_5066.v index eed7f0f3ff..eed7f0f3ff 100644 --- a/test-suite/bugs/closed/5066.v +++ b/test-suite/bugs/closed/bug_5066.v diff --git a/test-suite/bugs/closed/bug_5077.v b/test-suite/bugs/closed/bug_5077.v new file mode 100644 index 0000000000..dee321c027 --- /dev/null +++ b/test-suite/bugs/closed/bug_5077.v @@ -0,0 +1,8 @@ +(* Testing robustness of typing for a fixpoint with evars in its type *) + +Inductive foo (n : nat) : Type := . +Definition foo_denote {n} (x : foo n) : Type := match x with end. + +Definition baz : forall n (x : foo n), foo_denote x. +refine (fix go n (x : foo n) : foo_denote x := _). +Abort. diff --git a/test-suite/bugs/closed/bug_5078.v b/test-suite/bugs/closed/bug_5078.v new file mode 100644 index 0000000000..f07085d900 --- /dev/null +++ b/test-suite/bugs/closed/bug_5078.v @@ -0,0 +1,6 @@ +(* Test coercion from ident to evaluable reference *) +Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H]. +Goal True -> Type. + intro H''. + Fail unfold_hyp H''. +Abort. diff --git a/test-suite/bugs/closed/bug_5093.v b/test-suite/bugs/closed/bug_5093.v new file mode 100644 index 0000000000..4b6d774405 --- /dev/null +++ b/test-suite/bugs/closed/bug_5093.v @@ -0,0 +1,12 @@ +Axiom P : nat -> Prop. +Axiom PS : forall n, P n -> P (S n). +Axiom P0 : P 0. + +Hint Resolve PS : foobar. +Hint Resolve P0 : foobar. + +Goal P 100. +Proof. +Fail typeclasses eauto 100 with foobar. +typeclasses eauto 101 with foobar. +Abort. diff --git a/test-suite/bugs/closed/bug_5095.v b/test-suite/bugs/closed/bug_5095.v new file mode 100644 index 0000000000..b8d97f0eb2 --- /dev/null +++ b/test-suite/bugs/closed/bug_5095.v @@ -0,0 +1,6 @@ +(* Checking let-in abstraction *) +Goal let x := Set in let y := x in True. + intros x y. + (* There used to have a too strict dependency test there *) + set (s := Set) in (value of x). +Abort. diff --git a/test-suite/bugs/closed/bug_5096.v b/test-suite/bugs/closed/bug_5096.v new file mode 100644 index 0000000000..18ce5c7305 --- /dev/null +++ b/test-suite/bugs/closed/bug_5096.v @@ -0,0 +1,220 @@ +(* coq-prog-args: ("-top" "bug_5096") *) +Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List. + +Set Asymmetric Patterns. + +Notation eta x := (fst x, snd x). + +Inductive expr {var : Type} : Type := +| Const : expr +| LetIn : expr -> (var -> expr) -> expr. + +Definition Expr := forall var, @expr var. + +Fixpoint count_binders (e : @expr unit) : nat := +match e with +| LetIn _ eC => 1 + @count_binders (eC tt) +| _ => 0 +end. + +Definition CountBinders (e : Expr) : nat := count_binders (e _). + +Class Context (Name : Type) (var : Type) := + { ContextT : Type; + extendb : ContextT -> Name -> var -> ContextT; + empty : ContextT }. +Coercion ContextT : Context >-> Sortclass. +Arguments ContextT {_ _ _}, {_ _} _. +Arguments extendb {_ _ _} _ _ _. +Arguments empty {_ _ _}. + +Module Export Named. +Inductive expr Name : Type := +| Const : expr Name +| LetIn : Name -> expr Name -> expr Name -> expr Name. +End Named. + +Global Arguments Const {_}. +Global Arguments LetIn {_} _ _ _. + +Definition split_onames {Name : Type} (ls : list (option Name)) + : option (Name) * list (option Name) + := match ls with + | cons n ls' + => (n, ls') + | nil => (None, nil) + end. + +Section internal. + Context (InName OutName : Type) + {InContext : Context InName (OutName)} + {ReverseContext : Context OutName (InName)} + (InName_beq : InName -> InName -> bool). + + Fixpoint register_reassign (ctxi : InContext) (ctxr : ReverseContext) + (e : expr InName) (new_names : list (option OutName)) + : option (expr OutName) + := match e in Named.expr _ return option (expr _) with + | Const => Some Const + | LetIn n ex eC + => let '(n', new_names') := eta (split_onames new_names) in + match n', @register_reassign ctxi ctxr ex nil with + | Some n', Some x + => let ctxi := @extendb _ _ _ ctxi n n' in + let ctxr := @extendb _ _ _ ctxr n' n in + option_map (LetIn n' x) (@register_reassign ctxi ctxr eC new_names') + | None, Some x + => let ctxi := ctxi in + @register_reassign ctxi ctxr eC new_names' + | _, None => None + end + end. + +End internal. + +Global Instance pos_context (var : Type) : Context positive var + := { ContextT := PositiveMap.t var; + extendb ctx key v := PositiveMap.add key v ctx; + empty := PositiveMap.empty _ }. + +Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _. + +Section language5. + Context (Name : Type). + + Local Notation expr := (@bug_5096.expr Name). + Local Notation nexpr := (@Named.expr Name). + + Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e} + : option (nexpr) + := match e in @bug_5096.expr _ return option (nexpr) with + | bug_5096.Const => Some Named.Const + | bug_5096.LetIn ex eC + => match @ocompile ex nil, split_onames ls with + | Some x, (Some n, ls')%core + => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls') + | _, _ => None + end + end. + + Definition compile (e : expr) (ls : list Name) := @ocompile e (List.map (@Some _) ls). +End language5. + +Global Arguments compile {_} e ls. + +Fixpoint merge_liveness (ls1 ls2 : list unit) := + match ls1, ls2 with + | cons x xs, cons y ys => cons tt (@merge_liveness xs ys) + | nil, ls | ls, nil => ls + end. + +Section internal1. + Context (Name : Type) + (OutName : Type) + {Context : Context Name (list unit)}. + + Definition compute_livenessf_step + (compute_livenessf : forall (ctx : Context) (e : expr Name) (prefix : list unit), list unit) + (ctx : Context) + (e : expr Name) (prefix : list unit) + : list unit + := match e with + | Const => prefix + | LetIn n ex eC + => let lx := @compute_livenessf ctx ex prefix in + let lx := merge_liveness lx (prefix ++ repeat tt 1) in + let ctx := @extendb _ _ _ ctx n (lx) in + @compute_livenessf ctx eC (prefix ++ repeat tt 1) + end. + + Fixpoint compute_liveness ctx e prefix + := @compute_livenessf_step (@compute_liveness) ctx e prefix. + + Fixpoint insert_dead_names_gen def (ls : list unit) (lsn : list OutName) + : list (option OutName) + := match ls with + | nil => nil + | cons live xs + => match lsn with + | cons n lsn' => Some n :: @insert_dead_names_gen def xs lsn' + | nil => def :: @insert_dead_names_gen def xs nil + end + end. + Definition insert_dead_names def (e : expr Name) + := insert_dead_names_gen def (compute_liveness empty e nil). +End internal1. + +Global Arguments insert_dead_names {_ _ _} def e lsn. + +Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y. + +Section language7. + Context {Context : Context unit (positive)}. + + Local Notation nexpr := (@Named.expr unit). + + Definition CompileAndEliminateDeadCode (e : Expr) (ls : list unit) + : option (nexpr) + := let e := compile (Name:=positive) (e _) (List.map Pos.of_nat (seq 1 (CountBinders e))) in + match e with + | Some e => Let_In (insert_dead_names None e ls) (* help vm_compute by factoring this out *) + (fun names => register_reassign empty empty e names) + | None => None + end. +End language7. + +Global Arguments CompileAndEliminateDeadCode {_} e ls. + +Definition ContextOn {Name1 Name2} f {var} (Ctx : Context Name1 var) : Context Name2 var + := {| ContextT := Ctx; + extendb ctx n v := extendb ctx (f n) v; + empty := empty |}. + +Definition Register := Datatypes.unit. + +Global Instance RegisterContext {var : Type} : Context Register var + := ContextOn (fun _ => 1%positive) (pos_context var). + +Definition syntax := Named.expr Register. + +Definition AssembleSyntax e ls (res := CompileAndEliminateDeadCode e ls) + := match res return match res with None => _ | _ => _ end with + | Some v => v + | None => I + end. + +Definition dummy_registers (n : nat) : list Register + := List.map (fun _ => tt) (seq 0 n). +Definition DefaultRegisters (e : Expr) : list Register + := dummy_registers (CountBinders e). + +Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e). + +Notation "'slet' x := A 'in' b" := (bug_5096.LetIn A (fun x => b)) (at level 200, b at level 200). +Notation "#[ var ]#" := (@bug_5096.Const var). + +Definition compiled_syntax : Expr := fun (var : Type) => +( + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + slet x1 := #[ var ]# in + @bug_5096.Const var). + +Definition v := + Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)). + +Timeout 2 Eval vm_compute in v. diff --git a/test-suite/bugs/closed/5097.v b/test-suite/bugs/closed/bug_5097.v index 37b239cf61..37b239cf61 100644 --- a/test-suite/bugs/closed/5097.v +++ b/test-suite/bugs/closed/bug_5097.v diff --git a/test-suite/bugs/closed/5123.v b/test-suite/bugs/closed/bug_5123.v index 17231bffcf..17231bffcf 100644 --- a/test-suite/bugs/closed/5123.v +++ b/test-suite/bugs/closed/bug_5123.v diff --git a/test-suite/bugs/closed/5127.v b/test-suite/bugs/closed/bug_5127.v index 831e8fb507..831e8fb507 100644 --- a/test-suite/bugs/closed/5127.v +++ b/test-suite/bugs/closed/bug_5127.v diff --git a/test-suite/bugs/closed/5145.v b/test-suite/bugs/closed/bug_5145.v index 0533d21e0c..0533d21e0c 100644 --- a/test-suite/bugs/closed/5145.v +++ b/test-suite/bugs/closed/bug_5145.v diff --git a/test-suite/bugs/closed/bug_5149.v b/test-suite/bugs/closed/bug_5149.v new file mode 100644 index 0000000000..ae32217057 --- /dev/null +++ b/test-suite/bugs/closed/bug_5149.v @@ -0,0 +1,46 @@ +Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x. +intros. +eexists. +rewrite <- H. +eassumption. +Qed. + +Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) + (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : +flat_type -> Type) + (v v' : interp_flat_type1 t'), + v = v' -> + forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0) + (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> +interp_flat_type0 t0) + (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t)) + (x' : interp_flat_type1 (Tbase t)) (T : Type) + (flatten_binding_list : forall t0 : flat_type, + interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T) + (P : T -> list T -> Prop) (prod : Type -> Type -> Type) + (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) +(interp_flat_type1 (Tbase x0)) -> T) + (pair : forall A B : Type, A -> B -> prod A B), + P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x')) + (flatten_binding_list t' (SmartVarVar t' v') v) -> + (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 +t'0) + (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)), + P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 +x'0)) + (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf +(Tbase t0) x0 = x'0) -> + interpf (Tbase t) x = x'. +Proof. + intros ?????????????????????? interpf_SmartVarVar. + solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail +"too early". + Undo. + (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *) + Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. + solve [eapply interpf_SmartVarVar; subst; eassumption]. + Undo. + Unset Solve Unification Constraints. + (* User control of when constraints are solved *) + solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. +Qed. diff --git a/test-suite/bugs/closed/bug_5153.v b/test-suite/bugs/closed/bug_5153.v new file mode 100644 index 0000000000..80d308f782 --- /dev/null +++ b/test-suite/bugs/closed/bug_5153.v @@ -0,0 +1,9 @@ +(* An example where it does not hurt having more type-classes resolution *) +Class some_type := { Ty : Type }. +Instance: some_type := { Ty := nat }. +Arguments Ty : clear implicits. +Goal forall (H : forall t : some_type, @Ty t -> False) (H' : False -> 1 = 2), 1 = 2. +Proof. +intros H H'. +specialize (H' (@H _ O)). (* was failing *) +Abort. diff --git a/test-suite/bugs/closed/5161.v b/test-suite/bugs/closed/bug_5161.v index d28303b8ab..d28303b8ab 100644 --- a/test-suite/bugs/closed/5161.v +++ b/test-suite/bugs/closed/bug_5161.v diff --git a/test-suite/bugs/closed/5177.v b/test-suite/bugs/closed/bug_5177.v index 7c8af1e46e..7c8af1e46e 100644 --- a/test-suite/bugs/closed/5177.v +++ b/test-suite/bugs/closed/bug_5177.v diff --git a/test-suite/bugs/closed/bug_5180.v b/test-suite/bugs/closed/bug_5180.v new file mode 100644 index 0000000000..c26ce52da2 --- /dev/null +++ b/test-suite/bugs/closed/bug_5180.v @@ -0,0 +1,65 @@ +Universes a b c ω ω'. +Definition Typeω := Type@{ω}. +Definition Type2 : Typeω := Type@{c}. +Definition Type1 : Type2 := Type@{b}. +Definition Type0 : Type1 := Type@{a}. + +Set Universe Polymorphism. +Set Printing Universes. + +Definition Typei' (n : nat) + := match n return Type@{ω'} with + | 0 => Type0 + | 1 => Type1 + | 2 => Type2 + | _ => Typeω + end. +Definition TypeOfTypei' {n} (x : Typei' n) : Type@{ω'} + := match n return Typei' n -> Type@{ω'} with + | 0 | 1 | 2 | _ => fun x => x + end x. +Definition Typei (n : nat) : Typei' (S n) + := match n return Typei' (S n) with + | 0 => Type0 + | 1 => Type1 + | _ => Type2 + end. +Definition TypeOfTypei {n} (x : TypeOfTypei' (Typei n)) : Type@{ω'} + := match n return TypeOfTypei' (Typei n) -> Type@{ω'} with + | 0 | 1 | _ => fun x => x + end x. +Check Typei 0 : Typei 1. +Check Typei 1 : Typei 2. + +Definition lift' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) + := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => (x : Type) + end. +Definition lift'' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) + := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => x + end. (* The command has indeed failed with message: +In environment +n : nat +x : TypeOfTypei' (Typei 0) +The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type + "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). + *) +Check (fun x : TypeOfTypei' (Typei 0) => TypeOfTypei' (Typei 1)). + +Definition lift''' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)). + refine match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with + | 0 | 1 | 2 | _ => fun x => _ + end. + exact x. + Undo. + (* The command has indeed failed with message: +In environment +n : nat +x : TypeOfTypei' (Typei 0) +The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type + "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because a < b). + *) + all:compute in *. + all:exact x. +Abort. diff --git a/test-suite/bugs/closed/bug_5181.v b/test-suite/bugs/closed/bug_5181.v new file mode 100644 index 0000000000..89f54e1bec --- /dev/null +++ b/test-suite/bugs/closed/bug_5181.v @@ -0,0 +1,2 @@ +Definition foo (x y : nat) := x. +Fail Arguments foo {_} : assert. diff --git a/test-suite/bugs/closed/5188.v b/test-suite/bugs/closed/bug_5188.v index e29ebfb4ec..e29ebfb4ec 100644 --- a/test-suite/bugs/closed/5188.v +++ b/test-suite/bugs/closed/bug_5188.v diff --git a/test-suite/bugs/closed/bug_5193.v b/test-suite/bugs/closed/bug_5193.v new file mode 100644 index 0000000000..0a52dcdef1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5193.v @@ -0,0 +1,15 @@ +Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}. + +Typeclasses eauto := debug. +Set Typeclasses Debug Verbosity 2. + +Inductive Finx(n : nat) : Set := +| Fx1(i : nat)(e : n = S i) +| FxS(i : nat)(f : Finx i)(e : n = S i). + +Context `{Finx_eqdec : forall n, Eqdec (Finx n)}. + +Goal {x : Type & Eqdec x}. + eexists. + try typeclasses eauto 1 with typeclass_instances. +Abort. diff --git a/test-suite/bugs/closed/bug_5198.v b/test-suite/bugs/closed/bug_5198.v new file mode 100644 index 0000000000..5d4409f89b --- /dev/null +++ b/test-suite/bugs/closed/bug_5198.v @@ -0,0 +1,39 @@ +(* -*- mode: coq; coq-prog-args: ("-boot" "-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 286 lines to +27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, +then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from +253 lines to 65 lines, then from 79 lines to 65 lines *) +(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with +OCaml 4.02.3 + coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 +(7e992fa784ee6fa48af8a2e461385c094985587d) *) +Axiom admit : forall {T}, T. +Set Printing Implicit. +Inductive nat := O | S (_ : nat). +Axiom f : forall (_ _ : nat), nat. +Class ZLikeOps (e : nat) + := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT +}. +Class BarrettParameters := + { b : nat ; k : nat ; ops : ZLikeOps (f b k) }. +Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters} + (_ : @LargeT _ (@ops params)), + @SmallT _ (@ops params). + +Global Instance ZZLikeOps e : ZLikeOps (f (S O) e) + := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }. +Definition SRep := nat. +Local Instance x86_25519_Barrett : BarrettParameters + := { b := S O ; k := O ; ops := ZZLikeOps O }. +Definition SRepAdd : forall (_ _ : SRep), SRep + := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in + v. +Definition SRepAdd' : forall (_ _ : SRep), SRep + := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)). +(* Error: +In environment +x : SRep +y : SRep +The term "x" has type "SRep" while it is expected to have type + "@LargeT ?e ?ZLikeOps". + *) diff --git a/test-suite/bugs/closed/bug_5203.v b/test-suite/bugs/closed/bug_5203.v new file mode 100644 index 0000000000..2c4d1a9fb7 --- /dev/null +++ b/test-suite/bugs/closed/bug_5203.v @@ -0,0 +1,5 @@ +Goal True. + Typeclasses eauto := debug. + Fail solve [ typeclasses eauto ]. + Fail typeclasses eauto. +Abort. diff --git a/test-suite/bugs/closed/5205.v b/test-suite/bugs/closed/bug_5205.v index 406f37a4b1..406f37a4b1 100644 --- a/test-suite/bugs/closed/5205.v +++ b/test-suite/bugs/closed/bug_5205.v diff --git a/test-suite/bugs/closed/5208.v b/test-suite/bugs/closed/bug_5208.v index b7a684a27c..b7a684a27c 100644 --- a/test-suite/bugs/closed/5208.v +++ b/test-suite/bugs/closed/bug_5208.v diff --git a/test-suite/bugs/closed/5215.v b/test-suite/bugs/closed/bug_5215.v index ecf5291596..ecf5291596 100644 --- a/test-suite/bugs/closed/5215.v +++ b/test-suite/bugs/closed/bug_5215.v diff --git a/test-suite/bugs/closed/5215_2.v b/test-suite/bugs/closed/bug_5215_2.v index 399947f00f..399947f00f 100644 --- a/test-suite/bugs/closed/5215_2.v +++ b/test-suite/bugs/closed/bug_5215_2.v diff --git a/test-suite/bugs/closed/bug_5219.v b/test-suite/bugs/closed/bug_5219.v new file mode 100644 index 0000000000..6798c1ae4d --- /dev/null +++ b/test-suite/bugs/closed/bug_5219.v @@ -0,0 +1,11 @@ +(* Test surgical use of beta-iota in the type of variables coming from + pattern-matching for refine *) + +Goal forall x : sigT (fun x => x = 1), True. + intro x; refine match x with + | existT _ x' e' => _ + end. + lazymatch goal with + | [ H : _ = _ |- _ ] => idtac + end. +Abort. diff --git a/test-suite/bugs/closed/5233.v b/test-suite/bugs/closed/bug_5233.v index 06286c740d..06286c740d 100644 --- a/test-suite/bugs/closed/5233.v +++ b/test-suite/bugs/closed/bug_5233.v diff --git a/test-suite/bugs/closed/5245.v b/test-suite/bugs/closed/bug_5245.v index e5bca5b5e4..e5bca5b5e4 100644 --- a/test-suite/bugs/closed/5245.v +++ b/test-suite/bugs/closed/bug_5245.v diff --git a/test-suite/bugs/closed/5255.v b/test-suite/bugs/closed/bug_5255.v index 5daaf9edbf..5daaf9edbf 100644 --- a/test-suite/bugs/closed/5255.v +++ b/test-suite/bugs/closed/bug_5255.v diff --git a/test-suite/bugs/closed/bug_5277.v b/test-suite/bugs/closed/bug_5277.v new file mode 100644 index 0000000000..449bb9b0a7 --- /dev/null +++ b/test-suite/bugs/closed/bug_5277.v @@ -0,0 +1,11 @@ +(* Scheme Equality not robust wrt names *) + +Module A1. + Inductive A (T : Type) := C (a : T). + Scheme Equality for A. (* success *) +End A1. + +Module A2. + Inductive A (x : Type) := C (a : x). + Scheme Equality for A. +End A2. diff --git a/test-suite/bugs/closed/5281.v b/test-suite/bugs/closed/bug_5281.v index 03bafdc9ae..03bafdc9ae 100644 --- a/test-suite/bugs/closed/5281.v +++ b/test-suite/bugs/closed/bug_5281.v diff --git a/test-suite/bugs/closed/5286.v b/test-suite/bugs/closed/bug_5286.v index 98d4e5c968..98d4e5c968 100644 --- a/test-suite/bugs/closed/5286.v +++ b/test-suite/bugs/closed/bug_5286.v diff --git a/test-suite/bugs/closed/5300.v b/test-suite/bugs/closed/bug_5300.v index 18202df508..18202df508 100644 --- a/test-suite/bugs/closed/5300.v +++ b/test-suite/bugs/closed/bug_5300.v diff --git a/test-suite/bugs/closed/bug_5315.v b/test-suite/bugs/closed/bug_5315.v new file mode 100644 index 0000000000..7ecd511651 --- /dev/null +++ b/test-suite/bugs/closed/bug_5315.v @@ -0,0 +1,10 @@ +Require Import Recdef. + +Function dumb_works (a:nat) {struct a} := + match (fun x => x) a with O => O | S n' => dumb_works n' end. + +Function dumb_nope (a:nat) {struct a} := + match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end. + +(* This check is just present to ensure Function worked well *) +Check R_dumb_nope_complete. diff --git a/test-suite/bugs/closed/bug_5321.v b/test-suite/bugs/closed/bug_5321.v new file mode 100644 index 0000000000..37866fcc94 --- /dev/null +++ b/test-suite/bugs/closed/bug_5321.v @@ -0,0 +1,19 @@ +Definition proj1_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) + : proj1_sig u = proj1_sig v + := f_equal (@proj1_sig _ _) p. + +Definition proj2_sig_path {A} {P : A -> Prop} {u v : sig P} (p : u = v) + : eq_rect _ _ (proj2_sig u) _ (proj1_sig_path p) = proj2_sig v + := match p with eq_refl => eq_refl end. + +Goal forall sz : nat, + let sz' := sz in + forall pf : sz = sz', + let feq_refl := exist (fun x : nat => sz = x) sz' eq_refl in + let fpf := exist (fun x : nat => sz = x) sz' pf in feq_refl = fpf -> +proj2_sig feq_refl = proj2_sig fpf. +Proof. + intros. + etransitivity; [ | exact (proj2_sig_path H) ]. + Fail clearbody fpf. +Abort. diff --git a/test-suite/bugs/closed/bug_5322.v b/test-suite/bugs/closed/bug_5322.v new file mode 100644 index 0000000000..7664d312e9 --- /dev/null +++ b/test-suite/bugs/closed/bug_5322.v @@ -0,0 +1,15 @@ +(* Regression in computing types of branches in "match" *) +Inductive flat_type := Unit | Prod (A B : flat_type). +Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type +-> Type := +| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. +Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit. +Arguments Op {_ _ _ _} _ _. +Definition bound_op {var} + {src2 dst2} + (opc2 : op src2 dst2) + : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2. + refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with + | _ => _ + end. +Abort. diff --git a/test-suite/bugs/closed/bug_5323.v b/test-suite/bugs/closed/bug_5323.v new file mode 100644 index 0000000000..dec423338c --- /dev/null +++ b/test-suite/bugs/closed/bug_5323.v @@ -0,0 +1,26 @@ +(* Revealed a missing re-consideration of postponed problems *) + +Module A. +Inductive flat_type := Unit | Prod (A B : flat_type). +Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type +-> Type := +| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR. +Inductive op : flat_type -> flat_type -> Type := . +Arguments Op {_ _ _ _} _ _. +Definition bound_op {var} + {src2 dst2} + (opc2 : op src2 dst2) + : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2 + := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end. +End A. + +(* A shorter variant *) +Module B. +Inductive exprf (op : unit -> Type) : Type := +| A : exprf op +| Op tR (opc : op tR) (args : exprf op) : exprf op. +Inductive op : unit -> Type := . +Definition bound_op (dst2 : unit) (opc2 : op dst2) + : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op + := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end. +End B. diff --git a/test-suite/bugs/closed/bug_5331.v b/test-suite/bugs/closed/bug_5331.v new file mode 100644 index 0000000000..901389e02e --- /dev/null +++ b/test-suite/bugs/closed/bug_5331.v @@ -0,0 +1,10 @@ +(* Checking no anomaly on some unexpected intropattern *) + +Ltac ih H := induction H as H. +Ltac ih' H H' := induction H as H'. + +Goal True -> True. +Fail intro H; ih H. +intro H; ih' H ipattern:([]). +exact I. +Qed. diff --git a/test-suite/bugs/closed/5345.v b/test-suite/bugs/closed/bug_5345.v index d8448f35db..d8448f35db 100644 --- a/test-suite/bugs/closed/5345.v +++ b/test-suite/bugs/closed/bug_5345.v diff --git a/test-suite/bugs/closed/5346.v b/test-suite/bugs/closed/bug_5346.v index 0118c18704..0118c18704 100644 --- a/test-suite/bugs/closed/5346.v +++ b/test-suite/bugs/closed/bug_5346.v diff --git a/test-suite/bugs/closed/5347.v b/test-suite/bugs/closed/bug_5347.v index 9267b3eb69..9267b3eb69 100644 --- a/test-suite/bugs/closed/5347.v +++ b/test-suite/bugs/closed/bug_5347.v diff --git a/test-suite/bugs/closed/bug_5359.v b/test-suite/bugs/closed/bug_5359.v new file mode 100644 index 0000000000..1f202e4396 --- /dev/null +++ b/test-suite/bugs/closed/bug_5359.v @@ -0,0 +1,219 @@ +Require Import Coq.nsatz.Nsatz. +Goal False. + + (* the first (succeeding) goal was reached by clearing one hypothesis in the second goal which overflows 6GB of stack space *) + let sugar := constr:( 0%Z ) in + let nparams := constr:( (-1)%Z ) in + let reified_goal := constr:( + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) ) in + let power := constr:( N.one ) in + let reified_givens := constr:( + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 9)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) (Ring_polynom.PEX Z 8))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + Nsatz.nsatz_compute + (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). + + let sugar := constr:( 0%Z ) in + let nparams := constr:( (-1)%Z ) in + let reified_goal := constr:( + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) ) in + let power := constr:( N.one ) in + let reified_givens := constr:( + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) + :: Ring_polynom.PEadd + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6)))) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 6)) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 5)))) (Ring_polynom.PEX Z 7)) + (Ring_polynom.PEsub + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) (Ring_polynom.PEX Z 6)) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)))) + (Ring_polynom.PEX Z 8)) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) (Ring_polynom.PEX Z 5)) + (Ring_polynom.PEX Z 3)) (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEX Z 10)) (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEmul + (Ring_polynom.PEsub (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEX Z 2)) + (Ring_polynom.PEX Z 5)) (Ring_polynom.PEX Z 3)) + (Ring_polynom.PEX Z 6))) (Ring_polynom.PEX Z 9)) + (Ring_polynom.PEc 1%Z) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 7) + (Ring_polynom.PEX Z 7))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 8) + (Ring_polynom.PEX Z 8)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 5) + (Ring_polynom.PEX Z 5))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 6) + (Ring_polynom.PEX Z 6)))) + :: Ring_polynom.PEsub + (Ring_polynom.PEadd + (Ring_polynom.PEmul (Ring_polynom.PEX Z 1) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3))) + (Ring_polynom.PEadd (Ring_polynom.PEc 1%Z) + (Ring_polynom.PEmul + (Ring_polynom.PEmul (Ring_polynom.PEX Z 4) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 2) + (Ring_polynom.PEX Z 2))) + (Ring_polynom.PEmul (Ring_polynom.PEX Z 3) + (Ring_polynom.PEX Z 3)))) :: nil)%list ) in + Nsatz.nsatz_compute + (@cons _ (@Ring_polynom.PEc _ sugar) (@cons _ (@Ring_polynom.PEc _ nparams) (@cons _ (@Ring_polynom.PEpow _ reified_goal power) reified_givens))). +Abort. diff --git a/test-suite/bugs/closed/5365.v b/test-suite/bugs/closed/bug_5365.v index be360d24d2..be360d24d2 100644 --- a/test-suite/bugs/closed/5365.v +++ b/test-suite/bugs/closed/bug_5365.v diff --git a/test-suite/bugs/closed/5368.v b/test-suite/bugs/closed/bug_5368.v index 410fe1707d..410fe1707d 100644 --- a/test-suite/bugs/closed/5368.v +++ b/test-suite/bugs/closed/bug_5368.v diff --git a/test-suite/bugs/closed/bug_5372.v b/test-suite/bugs/closed/bug_5372.v new file mode 100644 index 0000000000..e36b7a5d70 --- /dev/null +++ b/test-suite/bugs/closed/bug_5372.v @@ -0,0 +1,9 @@ +(* coq bug 5372: https://coq.inria.fr/bugs/show_bug.cgi?id=5372 *) +Require Import FunInd. +Function odd (n:nat) := + match n with + | 0 => false + | S n => true + end +with even (n:nat) := false. +Reset odd. diff --git a/test-suite/bugs/closed/5377.v b/test-suite/bugs/closed/bug_5377.v index 130d9f9abf..130d9f9abf 100644 --- a/test-suite/bugs/closed/5377.v +++ b/test-suite/bugs/closed/bug_5377.v diff --git a/test-suite/bugs/closed/5401.v b/test-suite/bugs/closed/bug_5401.v index 95193b993b..95193b993b 100644 --- a/test-suite/bugs/closed/5401.v +++ b/test-suite/bugs/closed/bug_5401.v diff --git a/test-suite/bugs/closed/bug_5414.v b/test-suite/bugs/closed/bug_5414.v new file mode 100644 index 0000000000..bf4e7133b7 --- /dev/null +++ b/test-suite/bugs/closed/bug_5414.v @@ -0,0 +1,13 @@ +(* Use of idents bound to ltac names in a "match" *) + +Definition foo : Type. +Proof. + let x := fresh "a" in + refine (forall k : nat * nat, let '(x, _) := k in (_ : Type)). + exact (a = a). +Defined. +Goal foo. +intros k. elim k. (* elim because elim keeps names *) +intros. +Check a. (* We check that the name is "a" *) +Abort. diff --git a/test-suite/bugs/closed/bug_5434.v b/test-suite/bugs/closed/bug_5434.v new file mode 100644 index 0000000000..b15e947531 --- /dev/null +++ b/test-suite/bugs/closed/bug_5434.v @@ -0,0 +1,19 @@ +(* About binders which remain unnamed after typing *) + +Global Set Asymmetric Patterns. + +Definition proj2_sig_map {A} {P Q : A -> Prop} (f : forall a, P a -> Q a) (x : +@sig A P) : @sig A Q + := let 'exist a p := x in exist Q a (f a p). +Axioms (feBW' : Type) (g : Prop -> Prop) (f' : feBW' -> Prop). +Definition foo := @proj2_sig_map feBW' (fun H => True = f' _) (fun H => + g True = g (f' H)) + (fun (a : feBW') (p : (fun H : feBW' => True = + f' H) a) => @f_equal Prop Prop g True (f' a) p). +Print foo. +Goal True. + lazymatch type of foo with + | sig (fun a : ?A => ?P) -> _ + => pose (fun a : A => a = a /\ P = P) + end. +Abort. diff --git a/test-suite/bugs/closed/bug_5435.v b/test-suite/bugs/closed/bug_5435.v new file mode 100644 index 0000000000..62e3b2a1a1 --- /dev/null +++ b/test-suite/bugs/closed/bug_5435.v @@ -0,0 +1 @@ +Definition foo (x : nat) := Eval native_compute in x. diff --git a/test-suite/bugs/closed/bug_5449.v b/test-suite/bugs/closed/bug_5449.v new file mode 100644 index 0000000000..47ecba956e --- /dev/null +++ b/test-suite/bugs/closed/bug_5449.v @@ -0,0 +1,7 @@ +(* An example of decide equality which was failing due to a lhs dep into the rhs *) + +Require Import Coq.PArith.BinPos. +Goal forall x y, {Pos.compare_cont Gt x y = Gt} + {Pos.compare_cont Gt x y <> Gt}. +intros. +decide equality. +Abort. diff --git a/test-suite/bugs/closed/5460.v b/test-suite/bugs/closed/bug_5460.v index 50221cdd83..50221cdd83 100644 --- a/test-suite/bugs/closed/5460.v +++ b/test-suite/bugs/closed/bug_5460.v diff --git a/test-suite/bugs/closed/5470.v b/test-suite/bugs/closed/bug_5470.v index 5b3984b6df..5b3984b6df 100644 --- a/test-suite/bugs/closed/5470.v +++ b/test-suite/bugs/closed/bug_5470.v diff --git a/test-suite/bugs/closed/bug_5476.v b/test-suite/bugs/closed/bug_5476.v new file mode 100644 index 0000000000..4bfa011762 --- /dev/null +++ b/test-suite/bugs/closed/bug_5476.v @@ -0,0 +1,29 @@ +Require Setoid. + +Goal forall (P : Prop) (T : Type) (m m' : T) (T0 T1 : Type) (P2 : forall _ : +Prop, Prop) + (P0 : Set) (x0 : P0) (P1 : forall (_ : P0) (_ : T), Prop) + (P3 : forall (_ : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (_ : +T) (_ : Prop), Prop) + (o : forall _ : P0, option T1) + (_ : P3 + (fun (k : P0) (_ : T0) (_ : Prop) => + match o k return Prop with + | Some _ => True + | None => False + end) m' P) (_ : P2 (P1 x0 m)) + (_ : forall (f : forall (_ : P0) (_ : T0) (_ : Prop), Prop) (m1 m2 +: T) + (k : P0) (e : T0) (_ : P2 (P1 k m1)), iff (P3 f m2 P) +(f k e (P3 f m1 P))), False. +Proof. + intros ???????????? H0 H H1. + rewrite H1 in H0; eauto with nocore. + { lazymatch goal with + | H : match ?X with _ => _ end |- _ + => first [ lazymatch goal with + | [ H' : context[X] |- _ ] => idtac H + end + | fail 1 "could not find" X ] + end. +Abort. diff --git a/test-suite/bugs/closed/bug_5486.v b/test-suite/bugs/closed/bug_5486.v new file mode 100644 index 0000000000..b086fbfa6e --- /dev/null +++ b/test-suite/bugs/closed/bug_5486.v @@ -0,0 +1,16 @@ +Axiom proof_admitted : False. +Tactic Notation "admit" := abstract case proof_admitted. +Goal forall (T : Type) (p : prod (prod T T) bool) (Fm : Set) (f : Fm) (k : + forall _ : T, Fm), + @eq Fm + (k + match p return T with + | pair p0 swap => fst p0 + end) f. + intros. + (* next statement failed in Bug 5486 *) + match goal with + | [ |- ?f (let (a, b) := ?d in @?e a b) = ?rhs ] + => pose (let (a, b) := d in e a b) as t0 + end. +Abort. diff --git a/test-suite/bugs/closed/bug_5487.v b/test-suite/bugs/closed/bug_5487.v new file mode 100644 index 0000000000..36999f76df --- /dev/null +++ b/test-suite/bugs/closed/bug_5487.v @@ -0,0 +1,10 @@ +(* Was a collision between an ltac pattern variable and an evar *) + +Goal forall n, exists m, n = m :> nat. +Proof. + eexists. + Fail match goal with + | [ |- ?x = ?y ] + => match x with y => idtac end + end. +Abort. diff --git a/test-suite/bugs/closed/5500.v b/test-suite/bugs/closed/bug_5500.v index aa63e2ab0e..aa63e2ab0e 100644 --- a/test-suite/bugs/closed/5500.v +++ b/test-suite/bugs/closed/bug_5500.v diff --git a/test-suite/bugs/closed/bug_5501.v b/test-suite/bugs/closed/bug_5501.v new file mode 100644 index 0000000000..e5e8a89278 --- /dev/null +++ b/test-suite/bugs/closed/bug_5501.v @@ -0,0 +1,22 @@ +Set Universe Polymorphism. + +Record Pred@{A} := + { car :> Type@{A} + ; P : car -> Prop + }. + +Class All@{A} (A : Pred@{A}) : Type := + { proof : forall (a : A), P A a + }. + +Record Pred_All@{A} : Type := + { P' :> Pred@{A} + ; P'_All : All P' + }. + +Global Instance Pred_All_instance (A : Pred_All) : All A := P'_All A. + +Definition Pred_All_proof {A : Pred_All} (a : A) : P A a. +Proof. +solve[auto using proof]. +Abort. diff --git a/test-suite/bugs/closed/5522.v b/test-suite/bugs/closed/bug_5522.v index 0fae9ede42..0fae9ede42 100644 --- a/test-suite/bugs/closed/5522.v +++ b/test-suite/bugs/closed/bug_5522.v diff --git a/test-suite/bugs/closed/5523.v b/test-suite/bugs/closed/bug_5523.v index d7582a3797..d7582a3797 100644 --- a/test-suite/bugs/closed/5523.v +++ b/test-suite/bugs/closed/bug_5523.v diff --git a/test-suite/bugs/closed/5526.v b/test-suite/bugs/closed/bug_5526.v index 88f219be30..88f219be30 100644 --- a/test-suite/bugs/closed/5526.v +++ b/test-suite/bugs/closed/bug_5526.v diff --git a/test-suite/bugs/closed/5532.v b/test-suite/bugs/closed/bug_5532.v index ee5446e548..ee5446e548 100644 --- a/test-suite/bugs/closed/5532.v +++ b/test-suite/bugs/closed/bug_5532.v diff --git a/test-suite/bugs/closed/5539.v b/test-suite/bugs/closed/bug_5539.v index 48e5568e9b..48e5568e9b 100644 --- a/test-suite/bugs/closed/5539.v +++ b/test-suite/bugs/closed/bug_5539.v diff --git a/test-suite/bugs/closed/bug_5547.v b/test-suite/bugs/closed/bug_5547.v new file mode 100644 index 0000000000..ee4a9b083a --- /dev/null +++ b/test-suite/bugs/closed/bug_5547.v @@ -0,0 +1,17 @@ +(* Checking typability of intermediate return predicates in nested pattern-matching *) + +Inductive A : (Type->Type) -> Type := J : A (fun x => x). +Definition ret (x : nat * A (fun x => x)) + := match x return Type with + | (y,z) => match z in A f return f Type with + | J => bool + end + end. +Definition foo : forall x, ret x. +Proof. +Fail refine (fun x + => match x return ret x with + | (y,J) => true + end + ). +Abort. diff --git a/test-suite/bugs/closed/5550.v b/test-suite/bugs/closed/bug_5550.v index bb1222489a..bb1222489a 100644 --- a/test-suite/bugs/closed/5550.v +++ b/test-suite/bugs/closed/bug_5550.v diff --git a/test-suite/bugs/closed/bug_5578.v b/test-suite/bugs/closed/bug_5578.v new file mode 100644 index 0000000000..a8a4dd6e30 --- /dev/null +++ b/test-suite/bugs/closed/bug_5578.v @@ -0,0 +1,58 @@ +(* File reduced by coq-bug-finder from original input, then from 1549 lines to 298 lines, then from 277 lines to 133 lines, then from 985 lines to 138 lines, then from 206 lines to 139 lines, then from 203 lines to 142 lines, then from 262 lines to 152 lines, then from 567 lines to 151 lines, then from 3746 lines to 151 lines, then from 577 lines to 151 lines, then from 187 lines to 151 lines, thenfrom 981 lines to 940 lines, then from 938 lines to 175 lines, then from 589 lines to 205 lines, then from 3797 lines to 205 lines, then from 628 lines to 206 lines, then from 238 lines to 205 lines, then from 1346 lines to 213 lines, then from 633 lines to 214 lines, then from 243 lines to 213 lines, then from 5656 lines to 245 lines, then from 661 lines to 272 lines, then from 3856 lines to 352 lines, then from 1266 lines to 407 lines, then from 421 lines to 406 lines, then from 424 lines to 91 lines, then from 105 lines to 91 lines, then from 85 lines to 55 lines, then from 69 lines to 55 lines *) +(* coqc version trunk (May 2017) compiled on May 30 2017 13:28:59 with OCaml +4.02.3 + coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-trunk,trunk (fd36c0451c26e44b1b7e93299d3367ad2d35fee3) *) + +Class Proper {A} (R : A -> A -> Prop) (m : A) := mkp : R m m. +Definition respectful {A B} (R : A -> A -> Prop) (R' : B -> B -> Prop) (f g : A -> B) := forall x y, R x y -> R' (f x) (g y). +Set Implicit Arguments. + +Class EqDec (A : Set) := { + eqb : A -> A -> bool ; + eqb_leibniz : forall x y, eqb x y = true <-> x = y +}. + +Infix "?=" := eqb (at level 70) : eq_scope. + +Inductive Comp : Set -> Type := +| Bind : forall (A B : Set), Comp B -> (B -> Comp A) -> Comp A. + +Open Scope eq_scope. + +Goal forall (Rat : Set) (PositiveMap_t : Set -> Set) + type (t : type) (interp_type_list_message interp_type_rand interp_type_message : nat -> Set), + (forall eta : nat, PositiveMap_t (interp_type_rand eta) -> interp_type_list_message eta -> interp_type_message eta) -> + ((nat -> Rat) -> Prop) -> + forall (interp_type_sbool : nat -> Set) (interp_type0 : type -> nat -> Set), + (forall eta : nat, + (interp_type_list_message eta -> interp_type_message eta) -> PositiveMap_t (interp_type_rand eta) -> interp_type0 t eta) + -> (forall (t0 : type) (eta : nat), EqDec (interp_type0 t0 eta)) + -> (bool -> Comp bool) -> False. + clear. + intros Rat PositiveMap_t type t interp_type_list_message interp_type_rand interp_type_message adv negligible interp_type_sbool + interp_type interp_term_fixed_t_x + EqDec_interp_type ret_bool. + assert (forall f adv' k + (lem : forall (eta : nat) (evil_rands rands : PositiveMap_t +(interp_type_rand eta)), + (interp_term_fixed_t_x eta (adv eta evil_rands) rands + ?= interp_term_fixed_t_x eta (adv eta evil_rands) rands) = true), + (forall (eta : nat), Proper (respectful eq eq) (f eta)) + -> negligible + (fun eta : nat => + f eta ( + (Bind (k eta) (fun rands => + ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). + Undo. + assert (forall f adv' k + (lem : forall (eta : nat) (rands : PositiveMap_t +(interp_type_rand eta)), + (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands) = true), + (forall (eta : nat), Proper (respectful eq eq) (f eta)) + -> negligible + (fun eta : nat => + f eta ( + (Bind (k eta) (fun rands => + ret_bool (interp_term_fixed_t_x eta (adv' eta) rands ?= interp_term_fixed_t_x eta (adv' eta) rands)))))). + (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *) +Abort. diff --git a/test-suite/bugs/closed/5598.v b/test-suite/bugs/closed/bug_5598.v index 55fef1a575..55fef1a575 100644 --- a/test-suite/bugs/closed/5598.v +++ b/test-suite/bugs/closed/bug_5598.v diff --git a/test-suite/bugs/closed/bug_5608.v b/test-suite/bugs/closed/bug_5608.v new file mode 100644 index 0000000000..7e1c2f2491 --- /dev/null +++ b/test-suite/bugs/closed/bug_5608.v @@ -0,0 +1,33 @@ +Reserved Notation "'slet' x .. y := A 'in' b" + (at level 200, x binder, y binder, b at level 200, format "'slet' x .. y := A 'in' '//' b"). +Reserved Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" + (at level 200, format "T x [1] = { A } ; '//' 'return' ( b0 , b1 , .. , b2 )"). + +Delimit Scope ctype_scope with ctype. +Local Open Scope ctype_scope. +Delimit Scope expr_scope with expr. +Inductive base_type := TZ | TWord (logsz : nat). +Inductive flat_type := Tbase (T : base_type) | Prod (A B : flat_type). +Context {var : base_type -> Type}. +Fixpoint interp_flat_type (interp_base_type : base_type -> Type) (t : +flat_type) := + match t with + | Tbase t => interp_base_type t + | Prod x y => prod (interp_flat_type interp_base_type x) (interp_flat_type +interp_base_type y) + end. +Inductive exprf : flat_type -> Type := +| Var {t} (v : var t) : exprf (Tbase t) +| LetIn {tx} (ex : exprf tx) {tC} (eC : interp_flat_type var tx -> exprf tC) : +exprf tC +| Pair {tx} (ex : exprf tx) {ty} (ey : exprf ty) : exprf (Prod tx ty). +Global Arguments Var {_} _. +Global Arguments LetIn {_} _ {_} _. +Global Arguments Pair {_} _ {_} _. +Notation "T x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" := (LetIn (tx:=T) A +(fun x => Pair .. (Pair b0%expr b1%expr) .. b2%expr)) : expr_scope. +Definition foo := + (fun x3 => + (LetIn (Var x3) (fun x18 : var TZ + => (Pair (Var x18) (Var x18))))). +Print foo. diff --git a/test-suite/bugs/closed/5618.v b/test-suite/bugs/closed/bug_5618.v index 47e0e92d2a..47e0e92d2a 100644 --- a/test-suite/bugs/closed/5618.v +++ b/test-suite/bugs/closed/bug_5618.v diff --git a/test-suite/bugs/closed/5641.v b/test-suite/bugs/closed/bug_5641.v index 9f3246f33d..9f3246f33d 100644 --- a/test-suite/bugs/closed/5641.v +++ b/test-suite/bugs/closed/bug_5641.v diff --git a/test-suite/bugs/closed/bug_5666.v b/test-suite/bugs/closed/bug_5666.v new file mode 100644 index 0000000000..1fe7fa19eb --- /dev/null +++ b/test-suite/bugs/closed/bug_5666.v @@ -0,0 +1,5 @@ +Inductive foo := Foo : False -> foo. +Goal foo. +try (constructor ; fail 0). +Fail try (constructor ; fail 1). +Abort. diff --git a/test-suite/bugs/closed/bug_5671.v b/test-suite/bugs/closed/bug_5671.v new file mode 100644 index 0000000000..dfa7ed5d69 --- /dev/null +++ b/test-suite/bugs/closed/bug_5671.v @@ -0,0 +1,8 @@ +(* Fixing Meta-unclean specialize *) + +Require Import Setoid. +Axiom a : forall x, x=0 -> True. +Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. +specialize a with (1:=H). clear H x. intros _. +setoid_rewrite H0. +Abort. diff --git a/test-suite/bugs/closed/5683.v b/test-suite/bugs/closed/bug_5683.v index b5c6a48ec0..b5c6a48ec0 100644 --- a/test-suite/bugs/closed/5683.v +++ b/test-suite/bugs/closed/bug_5683.v diff --git a/test-suite/bugs/closed/5692.v b/test-suite/bugs/closed/bug_5692.v index 4c8d464f19..4c8d464f19 100644 --- a/test-suite/bugs/closed/5692.v +++ b/test-suite/bugs/closed/bug_5692.v diff --git a/test-suite/bugs/closed/5696.v b/test-suite/bugs/closed/bug_5696.v index a20ad1b4da..a20ad1b4da 100644 --- a/test-suite/bugs/closed/5696.v +++ b/test-suite/bugs/closed/bug_5696.v diff --git a/test-suite/bugs/closed/5697.v b/test-suite/bugs/closed/bug_5697.v index c653f992af..c653f992af 100644 --- a/test-suite/bugs/closed/5697.v +++ b/test-suite/bugs/closed/bug_5697.v diff --git a/test-suite/bugs/closed/bug_5707.v b/test-suite/bugs/closed/bug_5707.v new file mode 100644 index 0000000000..096069049a --- /dev/null +++ b/test-suite/bugs/closed/bug_5707.v @@ -0,0 +1,13 @@ +(* Destruct and primitive projections *) + +(* Checking the (superficial) part of #5707: + "destruct" should be able to use non-dependent case analysis when + dependent case analysis is not available and unneeded *) + +Set Primitive Projections. + +Inductive foo := Foo { proj1 : nat; proj2 : nat }. + +Goal forall x : foo, True. +Proof. intros x. destruct x. +Abort. diff --git a/test-suite/bugs/closed/5713.v b/test-suite/bugs/closed/bug_5713.v index 9daf9647fc..9daf9647fc 100644 --- a/test-suite/bugs/closed/5713.v +++ b/test-suite/bugs/closed/bug_5713.v diff --git a/test-suite/bugs/closed/5717.v b/test-suite/bugs/closed/bug_5717.v index 1bfd917d25..1bfd917d25 100644 --- a/test-suite/bugs/closed/5717.v +++ b/test-suite/bugs/closed/bug_5717.v diff --git a/test-suite/bugs/closed/5719.v b/test-suite/bugs/closed/bug_5719.v index 0fad5f54ea..0fad5f54ea 100644 --- a/test-suite/bugs/closed/5719.v +++ b/test-suite/bugs/closed/bug_5719.v diff --git a/test-suite/bugs/closed/5726.v b/test-suite/bugs/closed/bug_5726.v index 53ef473572..53ef473572 100644 --- a/test-suite/bugs/closed/5726.v +++ b/test-suite/bugs/closed/bug_5726.v diff --git a/test-suite/bugs/closed/bug_5741.v b/test-suite/bugs/closed/bug_5741.v new file mode 100644 index 0000000000..27bf9e76ef --- /dev/null +++ b/test-suite/bugs/closed/bug_5741.v @@ -0,0 +1,5 @@ +(* Check no anomaly in info_trivial *) + +Goal True. +info_trivial. +Abort. diff --git a/test-suite/bugs/closed/bug_5749.v b/test-suite/bugs/closed/bug_5749.v new file mode 100644 index 0000000000..7a2944dc7e --- /dev/null +++ b/test-suite/bugs/closed/bug_5749.v @@ -0,0 +1,21 @@ +(* Checking computation of free vars of a term for generalization *) + +Definition Decision := fun P : Prop => {P} + {~ P}. +Class SetUnfold (P Q : Prop) : Prop := Build_SetUnfold { set_unfold : P <-> Q +}. + +Section Filter_Help. + + Context {A: Type}. + Context (fold_right : forall A B : Type, (B -> A -> A) -> A -> list B -> A). + Definition lType2 := (sigT (fun (P : A -> Prop) => forall a, Decision (P +a))). + Definition test (X: lType2) := let (x, _) := X in x. + + Global Instance foo `{fhl1 : list lType2} m Q: + SetUnfold (Q) + (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P +m)) (Q) (fhl1)). + Abort. + +End Filter_Help. diff --git a/test-suite/bugs/closed/bug_5750.v b/test-suite/bugs/closed/bug_5750.v new file mode 100644 index 0000000000..d5527d9303 --- /dev/null +++ b/test-suite/bugs/closed/bug_5750.v @@ -0,0 +1,4 @@ +(* Check printability of the hole of the context *) +Goal 0 = 0. +match goal with |- context c [0] => idtac c end. +Abort. diff --git a/test-suite/bugs/closed/5755.v b/test-suite/bugs/closed/bug_5755.v index e07fdcf831..e07fdcf831 100644 --- a/test-suite/bugs/closed/5755.v +++ b/test-suite/bugs/closed/bug_5755.v diff --git a/test-suite/bugs/closed/bug_5757.v b/test-suite/bugs/closed/bug_5757.v new file mode 100644 index 0000000000..4d90c44cfe --- /dev/null +++ b/test-suite/bugs/closed/bug_5757.v @@ -0,0 +1,77 @@ +(* Check that resolved status of evars follows "restrict" *) + +Axiom H : forall (v : nat), Some 0 = Some v -> True. +Lemma L : True. +eapply H with _; +match goal with + | |- Some 0 = Some ?v => change (Some (0+0) = Some v) +end. +Abort. + +(* The original example *) + +Set Default Proof Using "Type". + +Module heap_lang. + +Inductive expr := + | InjR (e : expr). + +Inductive val := + | InjRV (v : val). + +Bind Scope val_scope with val. + +Fixpoint of_val (v : val) : expr := + match v with + | InjRV v => InjR (of_val v) + end. + +Fixpoint to_val (e : expr) : option val := None. + +End heap_lang. +Export heap_lang. + +Module W. +Inductive expr := + | Val (v : val) + (* Sums *) + | InjR (e : expr). + +Fixpoint to_expr (e : expr) : heap_lang.expr := + match e with + | Val v => of_val v + | InjR e => heap_lang.InjR (to_expr e) + end. + +End W. + + + +Section Tests. + + Context (iProp: Type). + Context (WPre: expr -> Prop). + + Context (tac_wp_alloc : + forall (e : expr) (v : val), + to_val e = Some v -> WPre e). + + Lemma push_atomic_spec (x: val) : + WPre (InjR (of_val x)). + Proof. +(* This works. *) +eapply tac_wp_alloc with _. +match goal with + | |- to_val ?e = Some ?v => + change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) +end. +Undo. Undo. +(* This is fixed *) +eapply tac_wp_alloc with _; +match goal with + | |- to_val ?e = Some ?v => + change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v) +end. +Abort. +End Tests. diff --git a/test-suite/bugs/closed/5761.v b/test-suite/bugs/closed/bug_5761.v index 6f28d1981a..6f28d1981a 100644 --- a/test-suite/bugs/closed/5761.v +++ b/test-suite/bugs/closed/bug_5761.v diff --git a/test-suite/bugs/closed/5762.v b/test-suite/bugs/closed/bug_5762.v index 55d36bd722..55d36bd722 100644 --- a/test-suite/bugs/closed/5762.v +++ b/test-suite/bugs/closed/bug_5762.v diff --git a/test-suite/bugs/closed/5765.v b/test-suite/bugs/closed/bug_5765.v index 343ab49357..343ab49357 100644 --- a/test-suite/bugs/closed/5765.v +++ b/test-suite/bugs/closed/bug_5765.v diff --git a/test-suite/bugs/closed/5769.v b/test-suite/bugs/closed/bug_5769.v index 42573aad87..42573aad87 100644 --- a/test-suite/bugs/closed/5769.v +++ b/test-suite/bugs/closed/bug_5769.v diff --git a/test-suite/bugs/closed/bug_5786.v b/test-suite/bugs/closed/bug_5786.v new file mode 100644 index 0000000000..f25fcd3eb2 --- /dev/null +++ b/test-suite/bugs/closed/bug_5786.v @@ -0,0 +1,26 @@ +(* Printing all kinds of Ltac generic arguments *) + +Tactic Notation "myidtac" string(v) := idtac v. +Goal True. +myidtac "foo". +Abort. + +Tactic Notation "myidtac2" ref(c) := idtac c. +Goal True. +myidtac2 True. +Abort. + +Tactic Notation "myidtac3" preident(s) := idtac s. +Goal True. +myidtac3 foo. +Abort. + +Tactic Notation "myidtac4" int_or_var(n) := idtac n. +Goal True. +myidtac4 3. +Abort. + +Tactic Notation "myidtac5" ident(id) := idtac id. +Goal True. +myidtac5 foo. +Abort. diff --git a/test-suite/bugs/closed/5790.v b/test-suite/bugs/closed/bug_5790.v index 6c93a3906e..6c93a3906e 100644 --- a/test-suite/bugs/closed/5790.v +++ b/test-suite/bugs/closed/bug_5790.v diff --git a/test-suite/bugs/closed/bug_5797.v b/test-suite/bugs/closed/bug_5797.v new file mode 100644 index 0000000000..23d86a0a20 --- /dev/null +++ b/test-suite/bugs/closed/bug_5797.v @@ -0,0 +1,212 @@ +Set Implicit Arguments. + +Open Scope type_scope. + +Inductive One : Set := inOne: One. + +Definition maybe: forall A B:Set,(A -> B) -> One + A -> One + B. +Proof. + intros A B f c. + case c. + left; assumption. + right; apply f; assumption. +Defined. + +Definition id (A:Set)(a:A):=a. + +Definition LamF (X: Set -> Set)(A:Set) :Set := + A + (X A)*(X A) + X(One + A). + +Definition LamF' (X: Set -> Set)(A:Set) :Set := + LamF X A. + +Require Import List. +Require Import Bool. + +Definition index := list bool. + +Inductive L (A:Set) : index -> Set := + initL: A -> L A nil + | pluslL: forall l:index, One -> L A (false::l) + | plusrL: forall l:index, L A l -> L A (false::l) + | varL: forall l:index, L A l -> L A (true::l) + | appL: forall l:index, L A (true::l) -> L A (true::l) -> L A (true::l) + | absL: forall l:index, L A (true::false::l) -> L A (true::l). + +Scheme L_rec_simp := Minimality for L Sort Set. + +Definition Lam' (A:Set) := L A (true::nil). + +Definition aczelapp: forall (l1 l2: index)(A:Set), L (L A l2) l1 -> L A + (l1++l2). +Proof. + intros l1 l2 A. + generalize l1. + clear l1. + (* Check (fun i:index => L A (i++l2)). *) + apply (L_rec_simp (A:=L A l2) (fun i:index => L A (i++l2))). + trivial. + intros l o. + simpl app. + apply pluslL; assumption. + intros l _ t. + simpl app. + apply plusrL; assumption. + intros l _ t. + simpl app. + apply varL; assumption. + intros l _ t1 _ t2. + simpl app in *|-*. + Check 0. + apply appL; [exact t1| exact t2]. + intros l _ t. + simpl app in *|-*. + Check 0. + apply absL; assumption. +Defined. + +Definition monL: forall (l:index)(A:Set)(B:Set), (A->B) -> L A l -> L B l. +Proof. + intros l A B f. + intro t. + elim t. + intro a. + exact (initL (f a)). + intros i u. + exact (pluslL _ _ u). + intros i _ r. + exact (plusrL r). + intros i _ r. + exact (varL r). + intros i _ r1 _ r2. + exact (appL r1 r2). + intros i _ r. + exact (absL r). +Defined. + +Definition lam': forall (A B:Set), (A -> B) -> Lam' A -> Lam' B. +Proof. + intros A B f t. + unfold Lam' in *|-*. + Check 0. + exact (monL f t). +Defined. + +Definition inLam': forall A:Set, LamF' Lam' A -> Lam' A. +Proof. + intros A [[a|[t1 t2]]|r]. + unfold Lam'. + exact (varL (initL a)). + exact (appL t1 t2). + unfold Lam' in * |- *. + Check 0. + apply absL. + change (L A ((true::nil) ++ (false::nil))). + apply aczelapp. + (* Check (fun x:One + A => (match (maybe (fun a:A => initL a) x) with + | inl u => pluslL _ _ u + | inr t' => plusrL t' end)). *) + exact (monL (fun x:One + A => + (match (maybe (fun a:A => initL a) x) with + | inl u => pluslL _ _ u + | inr t' => plusrL t' end)) r). +Defined. + +Section minimal. + +Definition sub1 (F G: Set -> Set):= forall A:Set, F A->G A. +Hypothesis G: Set -> Set. +Hypothesis step: sub1 (LamF' G) G. + +Fixpoint L'(A:Set)(i:index){struct i} : Set := + match i with + nil => A + | false::l => One + L' A l + | true::l => G (L' A l) + end. + +Definition LinL': forall (A:Set)(i:index), L A i -> L' A i. +Proof. + intros A i t. + elim t. + intro a. + unfold L'. + assumption. + intros l u. + left; assumption. + intros l _ r. + right; assumption. + intros l _ r. + apply (step (A:=L' A l)). + exact (inl _ (inl _ r)). + intros l _ r1 _ r2. + apply (step (A:=L' A l)). + (* unfold L' in * |- *. + Check 0. *) + exact (inl _ (inr _ (pair r1 r2))). + intros l _ r. + apply (step (A:=L' A l)). + exact (inr _ r). +Defined. + +Definition L'inG: forall A: Set, L' A (true::nil) -> G A. +Proof. + intros A t. + unfold L' in t. + assumption. +Defined. + +Definition Itbasic: sub1 Lam' G. +Proof. + intros A t. + apply L'inG. + unfold Lam' in t. + exact (LinL' t). +Defined. + +End minimal. + +Definition recid := Itbasic inLam'. + +Definition L'Lam'inL: forall (i:index)(A:Set), L' Lam' A i -> L A i. +Proof. + intros i A t. + induction i. + unfold L' in t. + apply initL. + assumption. + induction a. + simpl L' in t. + apply (aczelapp (l1:=true::nil) (l2:=i)). + exact (lam' IHi t). + simpl L' in t. + induction t. + exact (pluslL _ _ a). + exact (plusrL (IHi b)). +Defined. + + +Lemma recidgen: forall(A:Set)(i:index)(t:L A i), L'Lam'inL i A (LinL' inLam' t) + = t. +Proof. + intros A i t. + induction t. + trivial. + trivial. + simpl. + rewrite IHt. + trivial. + simpl L'Lam'inL. + rewrite IHt. + trivial. + simpl L'Lam'inL. + simpl L'Lam'inL in IHt1. + unfold lam' in IHt1. + simpl L'Lam'inL in IHt2. + unfold lam' in IHt2. + + (* going on. This fails for the original solution. *) + rewrite IHt1. + rewrite IHt2. + trivial. +Abort. (* one goal still left *) diff --git a/test-suite/bugs/closed/5845.v b/test-suite/bugs/closed/bug_5845.v index ea3347a851..ea3347a851 100644 --- a/test-suite/bugs/closed/5845.v +++ b/test-suite/bugs/closed/bug_5845.v diff --git a/test-suite/bugs/closed/bug_5940.v b/test-suite/bugs/closed/bug_5940.v new file mode 100644 index 0000000000..32c55f667b --- /dev/null +++ b/test-suite/bugs/closed/bug_5940.v @@ -0,0 +1,11 @@ +Require Import Setoid. + +Parameter P : nat -> Prop. +Parameter Q : nat -> Prop. +Parameter PQ : forall n, P n <-> Q n. + +Lemma PQ2 : forall n, P n -> Q n. + intros. + rewrite PQ in H. + trivial. +Qed. diff --git a/test-suite/bugs/closed/6070.v b/test-suite/bugs/closed/bug_6070.v index 49b16f6254..49b16f6254 100644 --- a/test-suite/bugs/closed/6070.v +++ b/test-suite/bugs/closed/bug_6070.v diff --git a/test-suite/bugs/closed/6129.v b/test-suite/bugs/closed/bug_6129.v index e4a2a2ba95..e4a2a2ba95 100644 --- a/test-suite/bugs/closed/6129.v +++ b/test-suite/bugs/closed/bug_6129.v diff --git a/test-suite/bugs/closed/6191.v b/test-suite/bugs/closed/bug_6191.v index e0d912509b..e0d912509b 100644 --- a/test-suite/bugs/closed/6191.v +++ b/test-suite/bugs/closed/bug_6191.v diff --git a/test-suite/bugs/closed/6297.v b/test-suite/bugs/closed/bug_6297.v index a28607058f..a28607058f 100644 --- a/test-suite/bugs/closed/6297.v +++ b/test-suite/bugs/closed/bug_6297.v diff --git a/test-suite/bugs/closed/6313.v b/test-suite/bugs/closed/bug_6313.v index 4d263c5a82..4d263c5a82 100644 --- a/test-suite/bugs/closed/6313.v +++ b/test-suite/bugs/closed/bug_6313.v diff --git a/test-suite/bugs/closed/6323.v b/test-suite/bugs/closed/bug_6323.v index fdc33befc6..fdc33befc6 100644 --- a/test-suite/bugs/closed/6323.v +++ b/test-suite/bugs/closed/bug_6323.v diff --git a/test-suite/bugs/closed/6378.v b/test-suite/bugs/closed/bug_6378.v index 68ae7961dd..68ae7961dd 100644 --- a/test-suite/bugs/closed/6378.v +++ b/test-suite/bugs/closed/bug_6378.v diff --git a/test-suite/bugs/closed/6490.v b/test-suite/bugs/closed/bug_6490.v index dcf9ff29ed..dcf9ff29ed 100644 --- a/test-suite/bugs/closed/6490.v +++ b/test-suite/bugs/closed/bug_6490.v diff --git a/test-suite/bugs/closed/6529.v b/test-suite/bugs/closed/bug_6529.v index 8d90819998..8d90819998 100644 --- a/test-suite/bugs/closed/6529.v +++ b/test-suite/bugs/closed/bug_6529.v diff --git a/test-suite/bugs/closed/bug_6534.v b/test-suite/bugs/closed/bug_6534.v new file mode 100644 index 0000000000..8e3c2bb1a1 --- /dev/null +++ b/test-suite/bugs/closed/bug_6534.v @@ -0,0 +1,8 @@ +Goal forall x : nat, x = x. +Proof. +intros x. +refine ((fun x x => _ tt) tt tt). +let t := match goal with [ |- ?P ] => P end in +let _ := type of t in +idtac. +Abort. diff --git a/test-suite/bugs/closed/6617.v b/test-suite/bugs/closed/bug_6617.v index 9cabd62d48..9cabd62d48 100644 --- a/test-suite/bugs/closed/6617.v +++ b/test-suite/bugs/closed/bug_6617.v diff --git a/test-suite/bugs/closed/bug_6631.v b/test-suite/bugs/closed/bug_6631.v new file mode 100644 index 0000000000..0833ae17ff --- /dev/null +++ b/test-suite/bugs/closed/bug_6631.v @@ -0,0 +1,8 @@ +Require Import Coq.derive.Derive. + +Derive f SuchThat (f = 1 + 1) As feq. +Proof. + transitivity 2; [refine (eq_refl 2)|]. + transitivity 2. + 2:abstract exact (eq_refl 2). +Abort. diff --git a/test-suite/bugs/closed/6634.v b/test-suite/bugs/closed/bug_6634.v index 7f33afcc2f..7f33afcc2f 100644 --- a/test-suite/bugs/closed/6634.v +++ b/test-suite/bugs/closed/bug_6634.v diff --git a/test-suite/bugs/closed/6661.v b/test-suite/bugs/closed/bug_6661.v index e88a3704d8..e88a3704d8 100644 --- a/test-suite/bugs/closed/6661.v +++ b/test-suite/bugs/closed/bug_6661.v diff --git a/test-suite/bugs/closed/6677.v b/test-suite/bugs/closed/bug_6677.v index 99e47bb87c..99e47bb87c 100644 --- a/test-suite/bugs/closed/6677.v +++ b/test-suite/bugs/closed/bug_6677.v diff --git a/test-suite/bugs/closed/6770.v b/test-suite/bugs/closed/bug_6770.v index 9bcc740830..9bcc740830 100644 --- a/test-suite/bugs/closed/6770.v +++ b/test-suite/bugs/closed/bug_6770.v diff --git a/test-suite/bugs/closed/6774.v b/test-suite/bugs/closed/bug_6774.v index 9625af91f5..9625af91f5 100644 --- a/test-suite/bugs/closed/6774.v +++ b/test-suite/bugs/closed/bug_6774.v diff --git a/test-suite/bugs/closed/6775.v b/test-suite/bugs/closed/bug_6775.v index 206df23bce..206df23bce 100644 --- a/test-suite/bugs/closed/6775.v +++ b/test-suite/bugs/closed/bug_6775.v diff --git a/test-suite/bugs/closed/6878.v b/test-suite/bugs/closed/bug_6878.v index 70f1b3127a..70f1b3127a 100644 --- a/test-suite/bugs/closed/6878.v +++ b/test-suite/bugs/closed/bug_6878.v diff --git a/test-suite/bugs/closed/6910.v b/test-suite/bugs/closed/bug_6910.v index 5167a5364a..5167a5364a 100644 --- a/test-suite/bugs/closed/6910.v +++ b/test-suite/bugs/closed/bug_6910.v diff --git a/test-suite/bugs/closed/6951.v b/test-suite/bugs/closed/bug_6951.v index 419f8d7c4e..419f8d7c4e 100644 --- a/test-suite/bugs/closed/6951.v +++ b/test-suite/bugs/closed/bug_6951.v diff --git a/test-suite/bugs/closed/6956.v b/test-suite/bugs/closed/bug_6956.v index ee21adbbfd..ee21adbbfd 100644 --- a/test-suite/bugs/closed/6956.v +++ b/test-suite/bugs/closed/bug_6956.v diff --git a/test-suite/bugs/closed/7011.v b/test-suite/bugs/closed/bug_7011.v index 296e4e11e5..296e4e11e5 100644 --- a/test-suite/bugs/closed/7011.v +++ b/test-suite/bugs/closed/bug_7011.v diff --git a/test-suite/bugs/closed/7068.v b/test-suite/bugs/closed/bug_7068.v index 9fadb195bf..9fadb195bf 100644 --- a/test-suite/bugs/closed/7068.v +++ b/test-suite/bugs/closed/bug_7068.v diff --git a/test-suite/bugs/closed/7076.v b/test-suite/bugs/closed/bug_7076.v index 0abc88c282..0abc88c282 100644 --- a/test-suite/bugs/closed/7076.v +++ b/test-suite/bugs/closed/bug_7076.v diff --git a/test-suite/bugs/closed/7092.v b/test-suite/bugs/closed/bug_7092.v index d90de8b932..d90de8b932 100644 --- a/test-suite/bugs/closed/7092.v +++ b/test-suite/bugs/closed/bug_7092.v diff --git a/test-suite/bugs/closed/7113.v b/test-suite/bugs/closed/bug_7113.v index 976e60f20c..976e60f20c 100644 --- a/test-suite/bugs/closed/7113.v +++ b/test-suite/bugs/closed/bug_7113.v diff --git a/test-suite/bugs/closed/7195.v b/test-suite/bugs/closed/bug_7195.v index ea97747ac9..ea97747ac9 100644 --- a/test-suite/bugs/closed/7195.v +++ b/test-suite/bugs/closed/bug_7195.v diff --git a/test-suite/bugs/closed/7333.v b/test-suite/bugs/closed/bug_7333.v index fba5b9029d..fba5b9029d 100644 --- a/test-suite/bugs/closed/7333.v +++ b/test-suite/bugs/closed/bug_7333.v diff --git a/test-suite/bugs/closed/bug_7392.v b/test-suite/bugs/closed/bug_7392.v new file mode 100644 index 0000000000..df4408d899 --- /dev/null +++ b/test-suite/bugs/closed/bug_7392.v @@ -0,0 +1,10 @@ +Inductive R : nat -> Prop := ER : forall n, R n -> R (S n). + +Goal (forall (n : nat), R n -> False) -> True -> False. +Proof. +intros H0 H1. +eapply H0. +clear H1. +apply ER. +simpl. +Abort. diff --git a/test-suite/bugs/closed/7421.v b/test-suite/bugs/closed/bug_7421.v index afcdd35fcc..afcdd35fcc 100644 --- a/test-suite/bugs/closed/7421.v +++ b/test-suite/bugs/closed/bug_7421.v diff --git a/test-suite/bugs/closed/7462.v b/test-suite/bugs/closed/bug_7462.v index 40ca39e38a..40ca39e38a 100644 --- a/test-suite/bugs/closed/7462.v +++ b/test-suite/bugs/closed/bug_7462.v diff --git a/test-suite/bugs/closed/7554.v b/test-suite/bugs/closed/bug_7554.v index 12b0aa2cb5..12b0aa2cb5 100644 --- a/test-suite/bugs/closed/7554.v +++ b/test-suite/bugs/closed/bug_7554.v diff --git a/test-suite/bugs/closed/7615.v b/test-suite/bugs/closed/bug_7615.v index cd8c4ad7df..cd8c4ad7df 100644 --- a/test-suite/bugs/closed/7615.v +++ b/test-suite/bugs/closed/bug_7615.v diff --git a/test-suite/bugs/closed/7631.v b/test-suite/bugs/closed/bug_7631.v index 34eb8b8676..34eb8b8676 100644 --- a/test-suite/bugs/closed/7631.v +++ b/test-suite/bugs/closed/bug_7631.v diff --git a/test-suite/bugs/closed/7695.v b/test-suite/bugs/closed/bug_7695.v index 42bdb076b6..42bdb076b6 100644 --- a/test-suite/bugs/closed/7695.v +++ b/test-suite/bugs/closed/bug_7695.v diff --git a/test-suite/bugs/closed/7700.v b/test-suite/bugs/closed/bug_7700.v index 56f5481baa..56f5481baa 100644 --- a/test-suite/bugs/closed/7700.v +++ b/test-suite/bugs/closed/bug_7700.v diff --git a/test-suite/bugs/closed/7712.v b/test-suite/bugs/closed/bug_7712.v index a4e9697fad..a4e9697fad 100644 --- a/test-suite/bugs/closed/7712.v +++ b/test-suite/bugs/closed/bug_7712.v diff --git a/test-suite/bugs/closed/7723.v b/test-suite/bugs/closed/bug_7723.v index 2162901231..2162901231 100644 --- a/test-suite/bugs/closed/7723.v +++ b/test-suite/bugs/closed/bug_7723.v diff --git a/test-suite/bugs/closed/7754.v b/test-suite/bugs/closed/bug_7754.v index 229df93773..229df93773 100644 --- a/test-suite/bugs/closed/7754.v +++ b/test-suite/bugs/closed/bug_7754.v diff --git a/test-suite/bugs/closed/7779.v b/test-suite/bugs/closed/bug_7779.v index 78936b5958..78936b5958 100644 --- a/test-suite/bugs/closed/7779.v +++ b/test-suite/bugs/closed/bug_7779.v diff --git a/test-suite/bugs/closed/7780.v b/test-suite/bugs/closed/bug_7780.v index 2318f4d6ec..2318f4d6ec 100644 --- a/test-suite/bugs/closed/7780.v +++ b/test-suite/bugs/closed/bug_7780.v diff --git a/test-suite/bugs/closed/7795.v b/test-suite/bugs/closed/bug_7795.v index 5db0f81cc5..5db0f81cc5 100644 --- a/test-suite/bugs/closed/7795.v +++ b/test-suite/bugs/closed/bug_7795.v diff --git a/test-suite/bugs/closed/7811.v b/test-suite/bugs/closed/bug_7811.v index fee330f22d..fee330f22d 100644 --- a/test-suite/bugs/closed/7811.v +++ b/test-suite/bugs/closed/bug_7811.v diff --git a/test-suite/bugs/closed/7854.v b/test-suite/bugs/closed/bug_7854.v index ab1a29b632..ab1a29b632 100644 --- a/test-suite/bugs/closed/7854.v +++ b/test-suite/bugs/closed/bug_7854.v diff --git a/test-suite/bugs/closed/7867.v b/test-suite/bugs/closed/bug_7867.v index d0c7902756..d0c7902756 100644 --- a/test-suite/bugs/closed/7867.v +++ b/test-suite/bugs/closed/bug_7867.v diff --git a/test-suite/bugs/closed/7900.v b/test-suite/bugs/closed/bug_7900.v index 583ef0ef3b..583ef0ef3b 100644 --- a/test-suite/bugs/closed/7900.v +++ b/test-suite/bugs/closed/bug_7900.v diff --git a/test-suite/bugs/closed/7903.v b/test-suite/bugs/closed/bug_7903.v index 55c7ee99a7..55c7ee99a7 100644 --- a/test-suite/bugs/closed/7903.v +++ b/test-suite/bugs/closed/bug_7903.v diff --git a/test-suite/bugs/closed/7967.v b/test-suite/bugs/closed/bug_7967.v index 2c8855fd54..2c8855fd54 100644 --- a/test-suite/bugs/closed/7967.v +++ b/test-suite/bugs/closed/bug_7967.v diff --git a/test-suite/bugs/closed/8004.v b/test-suite/bugs/closed/bug_8004.v index 818639997a..818639997a 100644 --- a/test-suite/bugs/closed/8004.v +++ b/test-suite/bugs/closed/bug_8004.v diff --git a/test-suite/bugs/closed/8081.v b/test-suite/bugs/closed/bug_8081.v index 0f2501aaa8..0f2501aaa8 100644 --- a/test-suite/bugs/closed/8081.v +++ b/test-suite/bugs/closed/bug_8081.v diff --git a/test-suite/bugs/closed/808_2411.v b/test-suite/bugs/closed/bug_808_2411.v index 1169b2036b..1169b2036b 100644 --- a/test-suite/bugs/closed/808_2411.v +++ b/test-suite/bugs/closed/bug_808_2411.v diff --git a/test-suite/bugs/closed/8106.v b/test-suite/bugs/closed/bug_8106.v index a711c5adef..a711c5adef 100644 --- a/test-suite/bugs/closed/8106.v +++ b/test-suite/bugs/closed/bug_8106.v diff --git a/test-suite/bugs/closed/8119.v b/test-suite/bugs/closed/bug_8119.v index c6329a7328..c6329a7328 100644 --- a/test-suite/bugs/closed/8119.v +++ b/test-suite/bugs/closed/bug_8119.v diff --git a/test-suite/bugs/closed/8121.v b/test-suite/bugs/closed/bug_8121.v index 99267612ca..99267612ca 100644 --- a/test-suite/bugs/closed/8121.v +++ b/test-suite/bugs/closed/bug_8121.v diff --git a/test-suite/bugs/closed/8126.v b/test-suite/bugs/closed/bug_8126.v index f52dfc6b47..f52dfc6b47 100644 --- a/test-suite/bugs/closed/8126.v +++ b/test-suite/bugs/closed/bug_8126.v diff --git a/test-suite/bugs/closed/8215.v b/test-suite/bugs/closed/bug_8215.v index c4b29a6354..c4b29a6354 100644 --- a/test-suite/bugs/closed/8215.v +++ b/test-suite/bugs/closed/bug_8215.v diff --git a/test-suite/bugs/closed/8270.v b/test-suite/bugs/closed/bug_8270.v index f36f757f10..f36f757f10 100644 --- a/test-suite/bugs/closed/8270.v +++ b/test-suite/bugs/closed/bug_8270.v diff --git a/test-suite/bugs/closed/8288.v b/test-suite/bugs/closed/bug_8288.v index 0350be9c06..0350be9c06 100644 --- a/test-suite/bugs/closed/8288.v +++ b/test-suite/bugs/closed/bug_8288.v diff --git a/test-suite/bugs/closed/8432.v b/test-suite/bugs/closed/bug_8432.v index 844ee12668..844ee12668 100644 --- a/test-suite/bugs/closed/8432.v +++ b/test-suite/bugs/closed/bug_8432.v diff --git a/test-suite/bugs/closed/8478.v b/test-suite/bugs/closed/bug_8478.v index 8baaf8686a..8baaf8686a 100644 --- a/test-suite/bugs/closed/8478.v +++ b/test-suite/bugs/closed/bug_8478.v diff --git a/test-suite/bugs/closed/8532.v b/test-suite/bugs/closed/bug_8532.v index 00aa66e701..00aa66e701 100644 --- a/test-suite/bugs/closed/8532.v +++ b/test-suite/bugs/closed/bug_8532.v diff --git a/test-suite/bugs/opened/1615.v b/test-suite/bugs/opened/1615.v deleted file mode 100644 index 2825701410..0000000000 --- a/test-suite/bugs/opened/1615.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import Omega. - -Lemma foo : forall n m : Z, (n >= 0)%Z -> (n * m >= 0)%Z -> (n <= n + n * m)%Z. -Proof. - intros. omega. -Qed. - -Lemma foo' : forall n m : nat, n <= n + n * m. -Proof. - intros. Fail omega. -Abort. - diff --git a/test-suite/bugs/opened/3277.v b/test-suite/bugs/opened/3277.v deleted file mode 100644 index 5f4231363a..0000000000 --- a/test-suite/bugs/opened/3277.v +++ /dev/null @@ -1,7 +0,0 @@ -Tactic Notation "evarr" open_constr(x) := let y := constr:(x) in exact y. - -Goal True. - evarr _. -Admitted. -Goal True. - Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *) diff --git a/test-suite/bugs/opened/3311.v b/test-suite/bugs/opened/3311.v deleted file mode 100644 index 1c66bc1e55..0000000000 --- a/test-suite/bugs/opened/3311.v +++ /dev/null @@ -1,10 +0,0 @@ -Require Import Setoid. -Axiom bar : True = False. -Goal True. - Fail setoid_rewrite bar. (* Toplevel input, characters 15-33: -Error: -Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. - -Could not find an instance for "subrelation eq (Basics.flip Basics.impl)". -With the following constraints: -?3 : "True" *) diff --git a/test-suite/bugs/opened/3312.v b/test-suite/bugs/opened/3312.v deleted file mode 100644 index 749921e2f6..0000000000 --- a/test-suite/bugs/opened/3312.v +++ /dev/null @@ -1,5 +0,0 @@ -Require Import Setoid. -Axiom bar : 0 = 1. -Goal 0 = 1. - Fail rewrite_strat bar. (* Toplevel input, characters 15-32: -Error: Tactic failure:setoid rewrite failed: Nothing to rewrite. *) diff --git a/test-suite/bugs/opened/3343.v b/test-suite/bugs/opened/3343.v deleted file mode 100644 index 6c5a85f9cf..0000000000 --- a/test-suite/bugs/opened/3343.v +++ /dev/null @@ -1,46 +0,0 @@ -(* File reduced by coq-bug-finder from original input, then from 13699 lines to 656 lines, then from 584 lines to 200 lines *) -Set Asymmetric Patterns. -Require Export Coq.Lists.List. -Export List.ListNotations. - -Record CFGV := { Terminal : Type; VarSym : Type }. - -Section Gram. - Context {G : CFGV}. - - Inductive Pattern : (Terminal G) -> Type := - | ptleaf : forall (T : Terminal G), - nat -> Pattern T - with Mixture : list (Terminal G) -> Type := - | mtcons : forall {h: Terminal G} - {tl: list (Terminal G)}, - Pattern h -> Mixture tl -> Mixture (h::tl). - - Variable vc : VarSym G. - - Fixpoint pBVars {gs} (p : Pattern gs) : (list nat) := - match p with - | ptleaf _ _ => [] - end - with mBVars {lgs} (pts : Mixture lgs) : (list nat) := - match pts with - | mtcons _ _ _ tl => mBVars tl - end. - - Lemma mBndngVarsAsNth : - forall mp (m : @Mixture mp), - mBVars m = [2]. - Proof. - intros. - induction m. progress simpl. - Admitted. -End Gram. - -Lemma mBndngVarsAsNth' {G : CFGV} { vc : VarSym G} : - forall mp (m : @Mixture G mp), - mBVars m = [2]. -Proof. - intros. - induction m. - Fail progress simpl. - (* simpl did nothing here, while it does something inside the section; this is probably a bug*) diff --git a/test-suite/bugs/opened/3345.v b/test-suite/bugs/opened/3345.v deleted file mode 100644 index 3e3da6df71..0000000000 --- a/test-suite/bugs/opened/3345.v +++ /dev/null @@ -1,145 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from original input, then from 1972 lines to 136 lines, then from 119 lines to 105 lines *) -Global Set Implicit Arguments. -Require Import Coq.Lists.List Program. -Section IndexBound. - Context {A : Set}. - Class IndexBound (a : A) (Bound : list A) := - { ibound :> nat; - boundi : nth_error Bound ibound = Some a}. - Global Arguments ibound [a Bound] _ . - Global Arguments boundi [a Bound] _. - Record BoundedIndex (Bound : list A) := { bindex :> A; indexb :> IndexBound bindex Bound }. -End IndexBound. -Context {A : Type} {C : Set}. -Variable (projAC : A -> C). -Lemma None_neq_Some -: forall (AnyT AnyT' : Type) (a : AnyT), - None = Some a -> AnyT'. - admit. -Defined. -Program Definition nth_Bounded' - (Bound : list A) - (c : C) - (a_opt : option A) - (nth_n : option_map projAC a_opt = Some c) -: A := match a_opt as x - return (option_map projAC x = Some c) -> A with - | Some a => fun _ => a - | None => fun f : None = Some _ => ! - end nth_n. -Lemma nth_error_map : - forall n As c_opt, - nth_error (map projAC As) n = c_opt - -> option_map projAC (nth_error As n) = c_opt. - admit. -Defined. -Definition nth_Bounded - (Bound : list A) - (idx : BoundedIndex (map projAC Bound)) -: A := nth_Bounded' Bound (nth_error Bound (ibound idx)) - (nth_error_map _ _ (boundi idx)). -Program Definition nth_Bounded_ind2 - (P : forall As, BoundedIndex (map projAC As) - -> BoundedIndex (map projAC As) - -> A -> A -> Prop) -: forall (Bound : list A) - (idx : BoundedIndex (map projAC Bound)) - (idx' : BoundedIndex (map projAC Bound)), - match nth_error Bound (ibound idx), nth_error Bound (ibound idx') with - | Some a, Some a' => P Bound idx idx' a a' - | _, _ => True - end - -> P Bound idx idx' (nth_Bounded _ idx) (nth_Bounded _ idx'):= - fun Bound idx idx' => - match (nth_error Bound (ibound idx)) as e, (nth_error Bound (ibound idx')) as e' - return - (forall (f : option_map _ e = Some (bindex idx)) - (f' : option_map _ e' = Some (bindex idx')), - (match e, e' with - | Some a, Some a' => P Bound idx idx' a a' - | _, _ => True - end) - -> P Bound idx idx' - (match e as e'' return - option_map _ e'' = Some (bindex idx) - -> A - with - | Some a => fun _ => a - | _ => fun f => _ - end f) - (match e' as e'' return - option_map _ e'' = Some (bindex idx') - -> A - with - | Some a => fun _ => a - | _ => fun f => _ - end f')) with - | Some a, Some a' => fun _ _ H => _ - | _, _ => fun f => _ - end (nth_error_map _ _ (boundi idx)) - (nth_error_map _ _ (boundi idx')). - -Lemma nth_Bounded_eq -: forall (Bound : list A) - (idx idx' : BoundedIndex (map projAC Bound)), - ibound idx = ibound idx' - -> nth_Bounded Bound idx = nth_Bounded Bound idx'. -Proof. - intros. - eapply nth_Bounded_ind2 with (idx := idx) (idx' := idx'). - simpl. - (* The [case_eq] should not Fail. More importantly, [Fail case_eq ...] should succeed if [case_eq ...] fails. It doesn't!!! So I resort to [Fail Fail try (case_eq ...)]. *) - Fail Fail try (case_eq (nth_error Bound (ibound idx'))). -(* Toplevel input, characters 15-54: -In nested Ltac calls to "case_eq" and "pattern x at - 1", last call failed. -Error: The abstracted term -"fun e : Exc A => - forall e0 : nth_error Bound (ibound idx') = e, - match - nth_error Bound (ibound idx) as anonymous'0 - return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) - with - | Some a => - match - e as anonymous' - return - (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) - with - | Some a' => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => - a = a' - | None => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => - True - end - | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True - end eq_refl e0" is not well typed. -Illegal application: -The term - "match - nth_error Bound (ibound idx) as anonymous'0 - return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) - with - | Some a => - match - e as anonymous' - return - (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) - with - | Some a' => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => - a = a' - | None => - fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => - True - end - | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True - end" of type - "nth_error Bound (ibound idx) = nth_error Bound (ibound idx) -> - e = e -> Prop" -cannot be applied to the terms - "eq_refl" : "nth_error Bound (ibound idx) = nth_error Bound (ibound idx)" - "e0" : "nth_error Bound (ibound idx') = e" -The 2nd term has type "nth_error Bound (ibound idx') = e" -which should be coercible to "e = e". *) diff --git a/test-suite/bugs/opened/3370.v b/test-suite/bugs/opened/3370.v deleted file mode 100644 index 4964bf96c0..0000000000 --- a/test-suite/bugs/opened/3370.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import String. - -Local Ltac set_strings := - let s := match goal with |- context[String ?s1 ?s2] => constr:(String s1 s2) end in - let H := fresh s in - set (H := s). - -Local Open Scope string_scope. - -Goal "asdf" = "bds". -Fail set_strings. (* Error: Ltac variable s is bound to "asdf" which cannot be coerced to -a fresh identifier. *) diff --git a/test-suite/bugs/opened/3395.v b/test-suite/bugs/opened/3395.v deleted file mode 100644 index 5ca48fc9d6..0000000000 --- a/test-suite/bugs/opened/3395.v +++ /dev/null @@ -1,231 +0,0 @@ -Require Import TestSuite.admit. -(* File reduced by coq-bug-finder from originally 10918 lines, then 3649 lines to 3177 lines, then from 3189 lines to 3164 lines, then from 2653 lines to 2496 lines, 2653 lines, then from 1642 lines to 651 lines, then from 736 lines to 473 lines, then from 433 lines to 275 lines, then from 258 lines to 235 lines. *) -Generalizable All Variables. -Set Implicit Arguments. - -Arguments fst {_ _} _. -Arguments snd {_ _} _. - -Axiom cheat : forall {T}, T. - -Reserved Notation "g 'o' f" (at level 40, left associativity). - -Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. -Arguments idpath {A a} , [A] a. -Notation "x = y" := (paths x y) : type_scope. - -Definition symmetry {A : Type} {x y : A} (p : x = y) : y = x - := match p with idpath => idpath end. - -Delimit Scope morphism_scope with morphism. -Delimit Scope category_scope with category. -Delimit Scope object_scope with object. -Record PreCategory (object : Type) := - Build_PreCategory' { - object :> Type := object; - morphism : object -> object -> Type; - identity : forall x, morphism x x; - compose : forall s d d', - morphism d d' - -> morphism s d - -> morphism s d' - where "f 'o' g" := (compose f g); - associativity : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - (m3 o m2) o m1 = m3 o (m2 o m1); - associativity_sym : forall x1 x2 x3 x4 - (m1 : morphism x1 x2) - (m2 : morphism x2 x3) - (m3 : morphism x3 x4), - m3 o (m2 o m1) = (m3 o m2) o m1; - left_identity : forall a b (f : morphism a b), identity b o f = f; - right_identity : forall a b (f : morphism a b), f o identity a = f; - identity_identity : forall x, identity x o identity x = identity x - }. -Bind Scope category_scope with PreCategory. -Arguments PreCategory {_}. -Arguments identity {_} [!C%category] x%object : rename. - -Arguments compose {_} [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. - -Infix "o" := compose : morphism_scope. - -Delimit Scope functor_scope with functor. -Local Open Scope morphism_scope. -Record Functor `(C : @PreCategory objC, D : @PreCategory objD) := - { - object_of :> C -> D; - morphism_of : forall s d, morphism C s d - -> morphism D (object_of s) (object_of d); - composition_of : forall s d d' - (m1 : morphism C s d) (m2: morphism C d d'), - morphism_of _ _ (m2 o m1) - = (morphism_of _ _ m2) o (morphism_of _ _ m1); - identity_of : forall x, morphism_of _ _ (identity x) - = identity (object_of x) - }. -Bind Scope functor_scope with Functor. - -Arguments morphism_of {_} [C%category] {_} [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. - -Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. - -Class IsIsomorphism `{C : @PreCategory objC} {s d} (m : morphism C s d) := - { - morphism_inverse : morphism C d s; - left_inverse : morphism_inverse o m = identity _; - right_inverse : m o morphism_inverse = identity _ - }. - -Definition opposite `(C : @PreCategory objC) : PreCategory - := @Build_PreCategory' - C - (fun s d => morphism C d s) - (identity (C := C)) - (fun _ _ _ m1 m2 => m2 o m1) - (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _ _) - (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _ _) - (fun _ _ => @right_identity _ _ _ _) - (fun _ _ => @left_identity _ _ _ _) - (@identity_identity _ C). - -Notation "C ^op" := (opposite C) (at level 3) : category_scope. - -Definition prod `(C : @PreCategory objC, D : @PreCategory objD) : @PreCategory (objC * objD). - refine (@Build_PreCategory' - (C * D)%type - (fun s d => (morphism C (fst s) (fst d) - * morphism D (snd s) (snd d))%type) - (fun x => (identity (fst x), identity (snd x))) - (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) - _ - _ - _ - _ - _); admit. -Defined. -Infix "*" := prod : category_scope. - -Definition compose_functor `(C : @PreCategory objC, D : @PreCategory objD, E : @PreCategory objE) (G : Functor D E) (F : Functor C D) : Functor C E - := Build_Functor - C E - (fun c => G (F c)) - (fun _ _ m => morphism_of G (morphism_of F m)) - cheat - cheat. - -Infix "o" := compose_functor : functor_scope. - -Record NaturalTransformation `(C : @PreCategory objC, D : @PreCategory objD) (F G : Functor C D) := - Build_NaturalTransformation' { - components_of :> forall c, morphism D (F c) (G c); - commutes : forall s d (m : morphism C s d), - components_of d o F _1 m = G _1 m o components_of s; - - commutes_sym : forall s d (m : C.(morphism) s d), - G _1 m o components_of s = components_of d o F _1 m - }. -Definition functor_category `(C : @PreCategory objC, D : @PreCategory objD) : PreCategory - := @Build_PreCategory' (Functor C D) - (@NaturalTransformation _ C _ D) - cheat - cheat - cheat - cheat - cheat - cheat - cheat. - -Definition opposite_functor `(F : @Functor objC C objD D) : Functor C^op D^op - := Build_Functor (C^op) (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). - -Definition opposite_invL `(F : @Functor objC C^op objD D) : Functor C D^op - := Build_Functor C (D^op) - (object_of F) - (fun s d => morphism_of F (s := d) (d := s)) - (fun d' d s m1 m2 => composition_of F s d d' m2 m1) - (identity_of F). -Notation "F ^op" := (opposite_functor F) : functor_scope. - -Notation "F ^op'L" := (opposite_invL F) (at level 3) : functor_scope. -Definition fst `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) C - := Build_Functor (C * D) C - (@fst _ _) - (fun _ _ => @fst _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). - -Definition snd `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) D - := Build_Functor (C * D) D - (@snd _ _) - (fun _ _ => @snd _ _) - (fun _ _ _ _ _ => idpath) - (fun _ => idpath). -Definition prod_functor `(F : @Functor objC C objD D, F' : @Functor objC C objD' D') -: Functor C (D * D') - := Build_Functor - C (D * D') - (fun c => (F c, F' c)) - (fun s d m => (F _1 m, F' _1 m))%morphism - cheat - cheat. -Definition pair `(F : @Functor objC C objD D, F' : @Functor objC' C' objD' D') : Functor (C * C') (D * D') - := (prod_functor (F o fst) (F' o snd))%functor. -Notation cat_of obj := - (@Build_PreCategory' obj - (fun x y => forall _ : x, y) - (fun _ x => x) - (fun _ _ _ f g x => f (g x))%core - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ _ _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ _ _ => idpath) - (fun _ => idpath)). - -Definition hom_functor `(C : @PreCategory objC) : Functor (C^op * C) (cat_of Type) - := Build_Functor _ _ cheat cheat cheat cheat. - -Definition induced_hom_natural_transformation `(F : @Functor objC C objD D) -: NaturalTransformation (hom_functor C) (hom_functor D o pair F^op F) - := Build_NaturalTransformation' _ _ cheat cheat cheat. - -Class IsFullyFaithful `(F : @Functor objC C objD D) - := is_fully_faithful - : forall x y : C, - IsIsomorphism (induced_hom_natural_transformation F (x, y)). - -Definition coyoneda `(A : @PreCategory objA) : Functor A^op (@functor_category _ A _ (cat_of Type)) - := cheat. - -Definition yoneda `(A : @PreCategory objA) : Functor A (@functor_category _ A^op _ (cat_of Type)) - := (((coyoneda A^op)^op'L)^op'L)%functor. -Definition coyoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@coyoneda _ A). -Admitted. - -Definition yoneda_embedding_fast `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). -Proof. - intros a b. - pose proof (coyoneda_embedding A^op a b) as CYE. - unfold yoneda. - Time let t := (type of CYE) in - let t' := (eval simpl in t) in pose proof ((fun (x : t) => (x : t')) CYE) as CYE'. (* Finished transaction in 0. secs (0.216013u,0.004s) *) - Fail Timeout 1 let t := match goal with |- ?G => constr:(G) end in - let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). - Time let t := match goal with |- ?G => constr:(G) end in - let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). (* Finished transaction in 0. secs (0.248016u,0.s) *) -Fail Timeout 2 Defined. -Time Defined. (* Finished transaction in 1. secs (0.432027u,0.s) *) - -Definition yoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). -Proof. - intros a b. - pose proof (coyoneda_embedding A^op a b) as CYE. - unfold yoneda; simpl in *. - Fail Timeout 1 exact CYE. - Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *) diff --git a/test-suite/bugs/opened/3463.v b/test-suite/bugs/opened/3463.v deleted file mode 100644 index 541db37fb7..0000000000 --- a/test-suite/bugs/opened/3463.v +++ /dev/null @@ -1,13 +0,0 @@ -Tactic Notation "test1" open_constr(t) ident(r):= - pose t. -Tactic Notation "test2" constr(r) open_constr(t):= - pose t. -Tactic Notation "test3" open_constr(t) constr(r):= - pose t. - -Goal True. - test1 (1 + _) nat. - test2 nat (1 + _). - test3 (1 + _) nat. - test3 (1 + _ : nat) nat. - diff --git a/test-suite/bugs/opened/3655.v b/test-suite/bugs/opened/3655.v deleted file mode 100644 index 841f77febb..0000000000 --- a/test-suite/bugs/opened/3655.v +++ /dev/null @@ -1,9 +0,0 @@ -Ltac bar x := pose x. -Tactic Notation "foo" open_constr(x) := bar x. -Class baz := { baz' : Type }. -Goal True. -(* Original error was an anomaly which is fixed; now, it succeeds but - leaving an evar, while calling pose would not leave an evar, so I - guess it is still a bug in the sense that the semantics of pose is - not preserved *) - foo baz'. diff --git a/test-suite/bugs/opened/3890.v b/test-suite/bugs/opened/3890.v deleted file mode 100644 index f9ac9be2c8..0000000000 --- a/test-suite/bugs/opened/3890.v +++ /dev/null @@ -1,18 +0,0 @@ -Class Foo. -Class Bar := b : Type. - -Instance foo : Foo := _. -(* 1 subgoals, subgoal 1 (ID 4) - - ============================ - Foo *) - -Instance bar : Bar. -exact Type. -Defined. -(* bar is defined *) - -About foo. -(* foo not a defined object. *) - -Fail Defined. diff --git a/test-suite/bugs/opened/4755.v b/test-suite/bugs/opened/4755.v deleted file mode 100644 index 9cc0d361ea..0000000000 --- a/test-suite/bugs/opened/4755.v +++ /dev/null @@ -1,34 +0,0 @@ -(*I'm not sure which behavior is better. But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*) - -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. -Definition f (v : option nat) := match v with - | Some k => Some k - | None => None - end. - -Axioms F G : (option nat -> option nat) -> Prop. -Axiom FG : forall f, f None = None -> F f = G f. - -Axiom admit : forall {T}, T. - -Existing Instance eq_Reflexive. - -Global Instance foo (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Global Instance bar (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> eq ==> Basics.flip Basics.impl) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. -Proof. - intro. - pose proof (_ : (Proper (_ ==> eq ==> _) and)). - Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) diff --git a/test-suite/bugs/opened/4778.v b/test-suite/bugs/opened/4778.v deleted file mode 100644 index 633d158e96..0000000000 --- a/test-suite/bugs/opened/4778.v +++ /dev/null @@ -1,35 +0,0 @@ -Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. -Definition f (v : option nat) := match v with - | Some k => Some k - | None => None - end. - -Axioms F G : (option nat -> option nat) -> Prop. -Axiom FG : forall f, f None = None -> F f = G f. - -Axiom admit : forall {T}, T. - -Existing Instance eq_Reflexive. - -(* This instance is needed in 8.4, but is useless in 8.5 *) -Global Instance foo (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. - -(* -(* This is required in 8.5, but useless in 8.4 *) -Global Instance bar (A := nat) - : Proper ((pointwise_relation _ eq) - ==> eq ==> eq ==> Basics.flip Basics.impl) - (@option_rect A (fun _ => Prop)) | 0. -exact admit. -Qed. -*) - -Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof. - intro. - pose proof (_ : (Proper (_ ==> eq ==> _) and)). - Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) diff --git a/test-suite/bugs/opened/HoTT_coq_106.v b/test-suite/bugs/opened/HoTT_coq_106.v index a566459546..5873ba6c5d 100644 --- a/test-suite/bugs/opened/HoTT_coq_106.v +++ b/test-suite/bugs/opened/HoTT_coq_106.v @@ -50,3 +50,4 @@ UNDEFINED UNIVERSES: Top.32 Top.33CONSTRAINTS:[] [A H B] |- ?13 == ?12 [] [A H B H0] |- ?12 == ?15 *) +Abort. diff --git a/test-suite/bugs/opened/1338.v-disabled b/test-suite/bugs/opened/bug_1338.v-disabled index ab0f98202d..ab0f98202d 100644 --- a/test-suite/bugs/opened/1338.v-disabled +++ b/test-suite/bugs/opened/bug_1338.v-disabled diff --git a/test-suite/bugs/opened/1596.v b/test-suite/bugs/opened/bug_1596.v index 820022d995..820022d995 100644 --- a/test-suite/bugs/opened/1596.v +++ b/test-suite/bugs/opened/bug_1596.v diff --git a/test-suite/bugs/opened/bug_1615.v b/test-suite/bugs/opened/bug_1615.v new file mode 100644 index 0000000000..c045335410 --- /dev/null +++ b/test-suite/bugs/opened/bug_1615.v @@ -0,0 +1,11 @@ +Require Import Omega. + +Lemma foo : forall n m : Z, (n >= 0)%Z -> (n * m >= 0)%Z -> (n <= n + n * m)%Z. +Proof. + intros. omega. +Qed. + +Lemma foo' : forall n m : nat, n <= n + n * m. +Proof. + intros. Fail omega. +Abort. diff --git a/test-suite/bugs/opened/1671.v b/test-suite/bugs/opened/bug_1671.v index b4e653f687..b4e653f687 100644 --- a/test-suite/bugs/opened/1671.v +++ b/test-suite/bugs/opened/bug_1671.v diff --git a/test-suite/bugs/opened/1811.v b/test-suite/bugs/opened/bug_1811.v index 57c1744313..57c1744313 100644 --- a/test-suite/bugs/opened/1811.v +++ b/test-suite/bugs/opened/bug_1811.v diff --git a/test-suite/bugs/opened/2572.v-disabled b/test-suite/bugs/opened/bug_2572.v-disabled index 3f6c6a0d14..3f6c6a0d14 100644 --- a/test-suite/bugs/opened/2572.v-disabled +++ b/test-suite/bugs/opened/bug_2572.v-disabled diff --git a/test-suite/bugs/opened/3010.v-disabled b/test-suite/bugs/opened/bug_3010.v-disabled index f2906bd6a6..f2906bd6a6 100644 --- a/test-suite/bugs/opened/3010.v-disabled +++ b/test-suite/bugs/opened/bug_3010.v-disabled diff --git a/test-suite/bugs/opened/3092.v b/test-suite/bugs/opened/bug_3092.v index 9db21d156e..9db21d156e 100644 --- a/test-suite/bugs/opened/3092.v +++ b/test-suite/bugs/opened/bug_3092.v diff --git a/test-suite/bugs/opened/3166.v b/test-suite/bugs/opened/bug_3166.v index e1c29a954c..e1c29a954c 100644 --- a/test-suite/bugs/opened/3166.v +++ b/test-suite/bugs/opened/bug_3166.v diff --git a/test-suite/bugs/opened/3186.v-disabled b/test-suite/bugs/opened/bug_3186.v-disabled index d0bcb920cc..d0bcb920cc 100644 --- a/test-suite/bugs/opened/3186.v-disabled +++ b/test-suite/bugs/opened/bug_3186.v-disabled diff --git a/test-suite/bugs/opened/3248.v b/test-suite/bugs/opened/bug_3248.v index 33c408a28c..33c408a28c 100644 --- a/test-suite/bugs/opened/3248.v +++ b/test-suite/bugs/opened/bug_3248.v diff --git a/test-suite/bugs/opened/bug_3277.v b/test-suite/bugs/opened/bug_3277.v new file mode 100644 index 0000000000..54629d8511 --- /dev/null +++ b/test-suite/bugs/opened/bug_3277.v @@ -0,0 +1,8 @@ +Tactic Notation "evarr" open_constr(x) := let y := constr:(x) in exact y. + +Goal True. + evarr _. +Admitted. +Goal True. + Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *) +Abort. diff --git a/test-suite/bugs/opened/3278.v b/test-suite/bugs/opened/bug_3278.v index 1c6deae94b..1c6deae94b 100644 --- a/test-suite/bugs/opened/3278.v +++ b/test-suite/bugs/opened/bug_3278.v diff --git a/test-suite/bugs/opened/3283.v b/test-suite/bugs/opened/bug_3283.v index 3ab5416e8c..3ab5416e8c 100644 --- a/test-suite/bugs/opened/3283.v +++ b/test-suite/bugs/opened/bug_3283.v diff --git a/test-suite/bugs/opened/3295.v b/test-suite/bugs/opened/bug_3295.v index c09649de73..c09649de73 100644 --- a/test-suite/bugs/opened/3295.v +++ b/test-suite/bugs/opened/bug_3295.v diff --git a/test-suite/bugs/opened/3304.v b/test-suite/bugs/opened/bug_3304.v index 66668930c7..66668930c7 100644 --- a/test-suite/bugs/opened/3304.v +++ b/test-suite/bugs/opened/bug_3304.v diff --git a/test-suite/bugs/opened/bug_3311.v b/test-suite/bugs/opened/bug_3311.v new file mode 100644 index 0000000000..23752acf1c --- /dev/null +++ b/test-suite/bugs/opened/bug_3311.v @@ -0,0 +1,11 @@ +Require Import Setoid. +Axiom bar : True = False. +Goal True. + Fail setoid_rewrite bar. (* Toplevel input, characters 15-33: +Error: +Tactic failure:setoid rewrite failed: Unable to satisfy the rewriting constraints. + +Could not find an instance for "subrelation eq (Basics.flip Basics.impl)". +With the following constraints: +?3 : "True" *) +Abort. diff --git a/test-suite/bugs/opened/bug_3312.v b/test-suite/bugs/opened/bug_3312.v new file mode 100644 index 0000000000..bf87c3995f --- /dev/null +++ b/test-suite/bugs/opened/bug_3312.v @@ -0,0 +1,6 @@ +Require Import Setoid. +Axiom bar : 0 = 1. +Goal 0 = 1. + Fail rewrite_strat bar. (* Toplevel input, characters 15-32: +Error: Tactic failure:setoid rewrite failed: Nothing to rewrite. *) +Abort. diff --git a/test-suite/bugs/opened/bug_3343.v b/test-suite/bugs/opened/bug_3343.v new file mode 100644 index 0000000000..7c0470bf96 --- /dev/null +++ b/test-suite/bugs/opened/bug_3343.v @@ -0,0 +1,47 @@ +(* File reduced by coq-bug-finder from original input, then from 13699 lines to 656 lines, then from 584 lines to 200 lines *) +Set Asymmetric Patterns. +Require Export Coq.Lists.List. +Export List.ListNotations. + +Record CFGV := { Terminal : Type; VarSym : Type }. + +Section Gram. + Context {G : CFGV}. + + Inductive Pattern : (Terminal G) -> Type := + | ptleaf : forall (T : Terminal G), + nat -> Pattern T + with Mixture : list (Terminal G) -> Type := + | mtcons : forall {h: Terminal G} + {tl: list (Terminal G)}, + Pattern h -> Mixture tl -> Mixture (h::tl). + + Variable vc : VarSym G. + + Fixpoint pBVars {gs} (p : Pattern gs) : (list nat) := + match p with + | ptleaf _ _ => [] + end + with mBVars {lgs} (pts : Mixture lgs) : (list nat) := + match pts with + | mtcons _ _ _ tl => mBVars tl + end. + + Lemma mBndngVarsAsNth : + forall mp (m : @Mixture mp), + mBVars m = [2]. + Proof. + intros. + induction m. progress simpl. + Admitted. +End Gram. + +Lemma mBndngVarsAsNth' {G : CFGV} { vc : VarSym G} : + forall mp (m : @Mixture G mp), + mBVars m = [2]. +Proof. + intros. + induction m. + Fail progress simpl. + (* simpl did nothing here, while it does something inside the section; this is probably a bug*) +Abort. diff --git a/test-suite/bugs/opened/bug_3345.v b/test-suite/bugs/opened/bug_3345.v new file mode 100644 index 0000000000..bc0f1a8604 --- /dev/null +++ b/test-suite/bugs/opened/bug_3345.v @@ -0,0 +1,146 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from original input, then from 1972 lines to 136 lines, then from 119 lines to 105 lines *) +Global Set Implicit Arguments. +Require Import Coq.Lists.List Program. +Section IndexBound. + Context {A : Set}. + Class IndexBound (a : A) (Bound : list A) := + { ibound :> nat; + boundi : nth_error Bound ibound = Some a}. + Global Arguments ibound [a Bound] _ . + Global Arguments boundi [a Bound] _. + Record BoundedIndex (Bound : list A) := { bindex :> A; indexb :> IndexBound bindex Bound }. +End IndexBound. +Context {A : Type} {C : Set}. +Variable (projAC : A -> C). +Lemma None_neq_Some +: forall (AnyT AnyT' : Type) (a : AnyT), + None = Some a -> AnyT'. + admit. +Defined. +Program Definition nth_Bounded' + (Bound : list A) + (c : C) + (a_opt : option A) + (nth_n : option_map projAC a_opt = Some c) +: A := match a_opt as x + return (option_map projAC x = Some c) -> A with + | Some a => fun _ => a + | None => fun f : None = Some _ => ! + end nth_n. +Lemma nth_error_map : + forall n As c_opt, + nth_error (map projAC As) n = c_opt + -> option_map projAC (nth_error As n) = c_opt. + admit. +Defined. +Definition nth_Bounded + (Bound : list A) + (idx : BoundedIndex (map projAC Bound)) +: A := nth_Bounded' Bound (nth_error Bound (ibound idx)) + (nth_error_map _ _ (boundi idx)). +Program Definition nth_Bounded_ind2 + (P : forall As, BoundedIndex (map projAC As) + -> BoundedIndex (map projAC As) + -> A -> A -> Prop) +: forall (Bound : list A) + (idx : BoundedIndex (map projAC Bound)) + (idx' : BoundedIndex (map projAC Bound)), + match nth_error Bound (ibound idx), nth_error Bound (ibound idx') with + | Some a, Some a' => P Bound idx idx' a a' + | _, _ => True + end + -> P Bound idx idx' (nth_Bounded _ idx) (nth_Bounded _ idx'):= + fun Bound idx idx' => + match (nth_error Bound (ibound idx)) as e, (nth_error Bound (ibound idx')) as e' + return + (forall (f : option_map _ e = Some (bindex idx)) + (f' : option_map _ e' = Some (bindex idx')), + (match e, e' with + | Some a, Some a' => P Bound idx idx' a a' + | _, _ => True + end) + -> P Bound idx idx' + (match e as e'' return + option_map _ e'' = Some (bindex idx) + -> A + with + | Some a => fun _ => a + | _ => fun f => _ + end f) + (match e' as e'' return + option_map _ e'' = Some (bindex idx') + -> A + with + | Some a => fun _ => a + | _ => fun f => _ + end f')) with + | Some a, Some a' => fun _ _ H => _ + | _, _ => fun f => _ + end (nth_error_map _ _ (boundi idx)) + (nth_error_map _ _ (boundi idx')). + +Lemma nth_Bounded_eq +: forall (Bound : list A) + (idx idx' : BoundedIndex (map projAC Bound)), + ibound idx = ibound idx' + -> nth_Bounded Bound idx = nth_Bounded Bound idx'. +Proof. + intros. + eapply nth_Bounded_ind2 with (idx := idx) (idx' := idx'). + simpl. + (* The [case_eq] should not Fail. More importantly, [Fail case_eq ...] should succeed if [case_eq ...] fails. It doesn't!!! So I resort to [Fail Fail try (case_eq ...)]. *) + Fail Fail try (case_eq (nth_error Bound (ibound idx'))). +(* Toplevel input, characters 15-54: +In nested Ltac calls to "case_eq" and "pattern x at - 1", last call failed. +Error: The abstracted term +"fun e : Exc A => + forall e0 : nth_error Bound (ibound idx') = e, + match + nth_error Bound (ibound idx) as anonymous'0 + return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) + with + | Some a => + match + e as anonymous' + return + (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) + with + | Some a' => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => + a = a' + | None => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => + True + end + | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True + end eq_refl e0" is not well typed. +Illegal application: +The term + "match + nth_error Bound (ibound idx) as anonymous'0 + return (anonymous'0 = nth_error Bound (ibound idx) -> e = e -> Prop) + with + | Some a => + match + e as anonymous' + return + (Some a = nth_error Bound (ibound idx) -> anonymous' = e -> Prop) + with + | Some a' => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : Some a' = e) => + a = a' + | None => + fun (_ : Some a = nth_error Bound (ibound idx)) (_ : None = e) => + True + end + | None => fun (_ : None = nth_error Bound (ibound idx)) (_ : e = e) => True + end" of type + "nth_error Bound (ibound idx) = nth_error Bound (ibound idx) -> + e = e -> Prop" +cannot be applied to the terms + "eq_refl" : "nth_error Bound (ibound idx) = nth_error Bound (ibound idx)" + "e0" : "nth_error Bound (ibound idx') = e" +The 2nd term has type "nth_error Bound (ibound idx') = e" +which should be coercible to "e = e". *) +Abort. diff --git a/test-suite/bugs/opened/3357.v b/test-suite/bugs/opened/bug_3357.v index c479158877..c479158877 100644 --- a/test-suite/bugs/opened/3357.v +++ b/test-suite/bugs/opened/bug_3357.v diff --git a/test-suite/bugs/opened/3363.v b/test-suite/bugs/opened/bug_3363.v index 800d89573c..800d89573c 100644 --- a/test-suite/bugs/opened/3363.v +++ b/test-suite/bugs/opened/bug_3363.v diff --git a/test-suite/bugs/opened/bug_3370.v b/test-suite/bugs/opened/bug_3370.v new file mode 100644 index 0000000000..d6fc88a03a --- /dev/null +++ b/test-suite/bugs/opened/bug_3370.v @@ -0,0 +1,13 @@ +Require Import String. + +Local Ltac set_strings := + let s := match goal with |- context[String ?s1 ?s2] => constr:(String s1 s2) end in + let H := fresh s in + set (H := s). + +Local Open Scope string_scope. + +Goal "asdf" = "bds". +Fail set_strings. (* Error: Ltac variable s is bound to "asdf" which cannot be coerced to +a fresh identifier. *) +Abort. diff --git a/test-suite/bugs/opened/bug_3395.v b/test-suite/bugs/opened/bug_3395.v new file mode 100644 index 0000000000..70b3a48a06 --- /dev/null +++ b/test-suite/bugs/opened/bug_3395.v @@ -0,0 +1,232 @@ +Require Import TestSuite.admit. +(* File reduced by coq-bug-finder from originally 10918 lines, then 3649 lines to 3177 lines, then from 3189 lines to 3164 lines, then from 2653 lines to 2496 lines, 2653 lines, then from 1642 lines to 651 lines, then from 736 lines to 473 lines, then from 433 lines to 275 lines, then from 258 lines to 235 lines. *) +Generalizable All Variables. +Set Implicit Arguments. + +Arguments fst {_ _} _. +Arguments snd {_ _} _. + +Axiom cheat : forall {T}, T. + +Reserved Notation "g 'o' f" (at level 40, left associativity). + +Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a. +Arguments idpath {A a} , [A] a. +Notation "x = y" := (paths x y) : type_scope. + +Definition symmetry {A : Type} {x y : A} (p : x = y) : y = x + := match p with idpath => idpath end. + +Delimit Scope morphism_scope with morphism. +Delimit Scope category_scope with category. +Delimit Scope object_scope with object. +Record PreCategory (object : Type) := + Build_PreCategory' { + object :> Type := object; + morphism : object -> object -> Type; + identity : forall x, morphism x x; + compose : forall s d d', + morphism d d' + -> morphism s d + -> morphism s d' + where "f 'o' g" := (compose f g); + associativity : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + (m3 o m2) o m1 = m3 o (m2 o m1); + associativity_sym : forall x1 x2 x3 x4 + (m1 : morphism x1 x2) + (m2 : morphism x2 x3) + (m3 : morphism x3 x4), + m3 o (m2 o m1) = (m3 o m2) o m1; + left_identity : forall a b (f : morphism a b), identity b o f = f; + right_identity : forall a b (f : morphism a b), f o identity a = f; + identity_identity : forall x, identity x o identity x = identity x + }. +Bind Scope category_scope with PreCategory. +Arguments PreCategory {_}. +Arguments identity {_} [!C%category] x%object : rename. + +Arguments compose {_} [!C%category s%object d%object d'%object] m1%morphism m2%morphism : rename. + +Infix "o" := compose : morphism_scope. + +Delimit Scope functor_scope with functor. +Local Open Scope morphism_scope. +Record Functor `(C : @PreCategory objC, D : @PreCategory objD) := + { + object_of :> C -> D; + morphism_of : forall s d, morphism C s d + -> morphism D (object_of s) (object_of d); + composition_of : forall s d d' + (m1 : morphism C s d) (m2: morphism C d d'), + morphism_of _ _ (m2 o m1) + = (morphism_of _ _ m2) o (morphism_of _ _ m1); + identity_of : forall x, morphism_of _ _ (identity x) + = identity (object_of x) + }. +Bind Scope functor_scope with Functor. + +Arguments morphism_of {_} [C%category] {_} [D%category] F%functor [s%object d%object] m%morphism : rename, simpl nomatch. + +Notation "F '_1' m" := (morphism_of F m) (at level 10, no associativity) : morphism_scope. + +Class IsIsomorphism `{C : @PreCategory objC} {s d} (m : morphism C s d) := + { + morphism_inverse : morphism C d s; + left_inverse : morphism_inverse o m = identity _; + right_inverse : m o morphism_inverse = identity _ + }. + +Definition opposite `(C : @PreCategory objC) : PreCategory + := @Build_PreCategory' + C + (fun s d => morphism C d s) + (identity (C := C)) + (fun _ _ _ m1 m2 => m2 o m1) + (fun _ _ _ _ _ _ _ => @associativity_sym _ _ _ _ _ _ _ _ _) + (fun _ _ _ _ _ _ _ => @associativity _ _ _ _ _ _ _ _ _) + (fun _ _ => @right_identity _ _ _ _) + (fun _ _ => @left_identity _ _ _ _) + (@identity_identity _ C). + +Notation "C ^op" := (opposite C) (at level 3) : category_scope. + +Definition prod `(C : @PreCategory objC, D : @PreCategory objD) : @PreCategory (objC * objD). + refine (@Build_PreCategory' + (C * D)%type + (fun s d => (morphism C (fst s) (fst d) + * morphism D (snd s) (snd d))%type) + (fun x => (identity (fst x), identity (snd x))) + (fun s d d' m2 m1 => (fst m2 o fst m1, snd m2 o snd m1)) + _ + _ + _ + _ + _); admit. +Defined. +Infix "*" := prod : category_scope. + +Definition compose_functor `(C : @PreCategory objC, D : @PreCategory objD, E : @PreCategory objE) (G : Functor D E) (F : Functor C D) : Functor C E + := Build_Functor + C E + (fun c => G (F c)) + (fun _ _ m => morphism_of G (morphism_of F m)) + cheat + cheat. + +Infix "o" := compose_functor : functor_scope. + +Record NaturalTransformation `(C : @PreCategory objC, D : @PreCategory objD) (F G : Functor C D) := + Build_NaturalTransformation' { + components_of :> forall c, morphism D (F c) (G c); + commutes : forall s d (m : morphism C s d), + components_of d o F _1 m = G _1 m o components_of s; + + commutes_sym : forall s d (m : C.(morphism) s d), + G _1 m o components_of s = components_of d o F _1 m + }. +Definition functor_category `(C : @PreCategory objC, D : @PreCategory objD) : PreCategory + := @Build_PreCategory' (Functor C D) + (@NaturalTransformation _ C _ D) + cheat + cheat + cheat + cheat + cheat + cheat + cheat. + +Definition opposite_functor `(F : @Functor objC C objD D) : Functor C^op D^op + := Build_Functor (C^op) (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). + +Definition opposite_invL `(F : @Functor objC C^op objD D) : Functor C D^op + := Build_Functor C (D^op) + (object_of F) + (fun s d => morphism_of F (s := d) (d := s)) + (fun d' d s m1 m2 => composition_of F s d d' m2 m1) + (identity_of F). +Notation "F ^op" := (opposite_functor F) : functor_scope. + +Notation "F ^op'L" := (opposite_invL F) (at level 3) : functor_scope. +Definition fst `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) C + := Build_Functor (C * D) C + (@fst _ _) + (fun _ _ => @fst _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). + +Definition snd `{C : @PreCategory objC, D : @PreCategory objD} : Functor (C * D) D + := Build_Functor (C * D) D + (@snd _ _) + (fun _ _ => @snd _ _) + (fun _ _ _ _ _ => idpath) + (fun _ => idpath). +Definition prod_functor `(F : @Functor objC C objD D, F' : @Functor objC C objD' D') +: Functor C (D * D') + := Build_Functor + C (D * D') + (fun c => (F c, F' c)) + (fun s d m => (F _1 m, F' _1 m))%morphism + cheat + cheat. +Definition pair `(F : @Functor objC C objD D, F' : @Functor objC' C' objD' D') : Functor (C * C') (D * D') + := (prod_functor (F o fst) (F' o snd))%functor. +Notation cat_of obj := + (@Build_PreCategory' obj + (fun x y => forall _ : x, y) + (fun _ x => x) + (fun _ _ _ f g x => f (g x))%core + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ _ _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ _ _ => idpath) + (fun _ => idpath)). + +Definition hom_functor `(C : @PreCategory objC) : Functor (C^op * C) (cat_of Type) + := Build_Functor _ _ cheat cheat cheat cheat. + +Definition induced_hom_natural_transformation `(F : @Functor objC C objD D) +: NaturalTransformation (hom_functor C) (hom_functor D o pair F^op F) + := Build_NaturalTransformation' _ _ cheat cheat cheat. + +Class IsFullyFaithful `(F : @Functor objC C objD D) + := is_fully_faithful + : forall x y : C, + IsIsomorphism (induced_hom_natural_transformation F (x, y)). + +Definition coyoneda `(A : @PreCategory objA) : Functor A^op (@functor_category _ A _ (cat_of Type)) + := cheat. + +Definition yoneda `(A : @PreCategory objA) : Functor A (@functor_category _ A^op _ (cat_of Type)) + := (((coyoneda A^op)^op'L)^op'L)%functor. +Definition coyoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@coyoneda _ A). +Admitted. + +Definition yoneda_embedding_fast `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). +Proof. + intros a b. + pose proof (coyoneda_embedding A^op a b) as CYE. + unfold yoneda. + Time let t := (type of CYE) in + let t' := (eval simpl in t) in pose proof ((fun (x : t) => (x : t')) CYE) as CYE'. (* Finished transaction in 0. secs (0.216013u,0.004s) *) + Fail Timeout 1 let t := match goal with |- ?G => constr:(G) end in + let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). + Time let t := match goal with |- ?G => constr:(G) end in + let t' := (eval simpl in t) in exact ((fun (x : t') => (x : t)) CYE'). (* Finished transaction in 0. secs (0.248016u,0.s) *) +Fail Timeout 2 Defined. +Time Defined. (* Finished transaction in 1. secs (0.432027u,0.s) *) + +Definition yoneda_embedding `(A : @PreCategory objA) : @IsFullyFaithful _ _ _ _ (@yoneda _ A). +Proof. + intros a b. + pose proof (coyoneda_embedding A^op a b) as CYE. + unfold yoneda; simpl in *. + Fail Timeout 1 exact CYE. + Time exact CYE. (* Finished transaction in 0. secs (0.012001u,0.s) *) +Abort. diff --git a/test-suite/bugs/opened/3424.v b/test-suite/bugs/opened/bug_3424.v index d1c5bb68f9..d1c5bb68f9 100644 --- a/test-suite/bugs/opened/3424.v +++ b/test-suite/bugs/opened/bug_3424.v diff --git a/test-suite/bugs/opened/3459.v b/test-suite/bugs/opened/bug_3459.v index 762611f751..762611f751 100644 --- a/test-suite/bugs/opened/3459.v +++ b/test-suite/bugs/opened/bug_3459.v diff --git a/test-suite/bugs/opened/bug_3463.v b/test-suite/bugs/opened/bug_3463.v new file mode 100644 index 0000000000..3de9e2ee5f --- /dev/null +++ b/test-suite/bugs/opened/bug_3463.v @@ -0,0 +1,13 @@ +Tactic Notation "test1" open_constr(t) ident(r):= + pose t. +Tactic Notation "test2" constr(r) open_constr(t):= + pose t. +Tactic Notation "test3" open_constr(t) constr(r):= + pose t. + +Goal True. + test1 (1 + _) nat. + test2 nat (1 + _). + test3 (1 + _) nat. + test3 (1 + _ : nat) nat. +Abort. diff --git a/test-suite/bugs/opened/3478.v-disabled b/test-suite/bugs/opened/bug_3478.v-disabled index cc926b2167..cc926b2167 100644 --- a/test-suite/bugs/opened/3478.v-disabled +++ b/test-suite/bugs/opened/bug_3478.v-disabled diff --git a/test-suite/bugs/opened/3626.v b/test-suite/bugs/opened/bug_3626.v index 46a6c009eb..46a6c009eb 100644 --- a/test-suite/bugs/opened/3626.v +++ b/test-suite/bugs/opened/bug_3626.v diff --git a/test-suite/bugs/opened/bug_3655.v b/test-suite/bugs/opened/bug_3655.v new file mode 100644 index 0000000000..a9735be932 --- /dev/null +++ b/test-suite/bugs/opened/bug_3655.v @@ -0,0 +1,10 @@ +Ltac bar x := pose x. +Tactic Notation "foo" open_constr(x) := bar x. +Class baz := { baz' : Type }. +Goal True. +(* Original error was an anomaly which is fixed; now, it succeeds but + leaving an evar, while calling pose would not leave an evar, so I + guess it is still a bug in the sense that the semantics of pose is + not preserved *) + foo baz'. +Abort. diff --git a/test-suite/bugs/opened/3754.v b/test-suite/bugs/opened/bug_3754.v index a717bbe735..a717bbe735 100644 --- a/test-suite/bugs/opened/3754.v +++ b/test-suite/bugs/opened/bug_3754.v diff --git a/test-suite/bugs/opened/3794.v b/test-suite/bugs/opened/bug_3794.v index e4711a38c0..e4711a38c0 100644 --- a/test-suite/bugs/opened/3794.v +++ b/test-suite/bugs/opened/bug_3794.v diff --git a/test-suite/bugs/opened/3889.v b/test-suite/bugs/opened/bug_3889.v index 6b287324cc..6b287324cc 100644 --- a/test-suite/bugs/opened/3889.v +++ b/test-suite/bugs/opened/bug_3889.v diff --git a/test-suite/bugs/opened/bug_3890.v b/test-suite/bugs/opened/bug_3890.v new file mode 100644 index 0000000000..5c74addb62 --- /dev/null +++ b/test-suite/bugs/opened/bug_3890.v @@ -0,0 +1,18 @@ +Class Foo. +Class Bar := b : Type. + +Instance foo : Foo := _. +(* 1 subgoals, subgoal 1 (ID 4) + + ============================ + Foo *) + +Instance bar : Bar. +exact Type. +Defined. +(* bar is defined *) + +About foo. +(* foo not a defined object. *) + +Fail Defined. diff --git a/test-suite/bugs/opened/3919.v-disabled b/test-suite/bugs/opened/bug_3919.v-disabled index 0d661de9c4..0d661de9c4 100644 --- a/test-suite/bugs/opened/3919.v-disabled +++ b/test-suite/bugs/opened/bug_3919.v-disabled diff --git a/test-suite/bugs/opened/3922.v-disabled b/test-suite/bugs/opened/bug_3922.v-disabled index ce4f509cad..ce4f509cad 100644 --- a/test-suite/bugs/opened/3922.v-disabled +++ b/test-suite/bugs/opened/bug_3922.v-disabled diff --git a/test-suite/bugs/opened/3928.v-disabled b/test-suite/bugs/opened/bug_3928.v-disabled index b470eb229b..b470eb229b 100644 --- a/test-suite/bugs/opened/3928.v-disabled +++ b/test-suite/bugs/opened/bug_3928.v-disabled diff --git a/test-suite/bugs/opened/3938.v b/test-suite/bugs/opened/bug_3938.v index 2d0d1930f1..2d0d1930f1 100644 --- a/test-suite/bugs/opened/3938.v +++ b/test-suite/bugs/opened/bug_3938.v diff --git a/test-suite/bugs/opened/3946.v b/test-suite/bugs/opened/bug_3946.v index e77bdbc652..e77bdbc652 100644 --- a/test-suite/bugs/opened/3946.v +++ b/test-suite/bugs/opened/bug_3946.v diff --git a/test-suite/bugs/opened/4701.v b/test-suite/bugs/opened/bug_4701.v index 9286f0f1f0..9286f0f1f0 100644 --- a/test-suite/bugs/opened/4701.v +++ b/test-suite/bugs/opened/bug_4701.v diff --git a/test-suite/bugs/opened/4721.v b/test-suite/bugs/opened/bug_4721.v index 1f184b3930..1f184b3930 100644 --- a/test-suite/bugs/opened/4721.v +++ b/test-suite/bugs/opened/bug_4721.v diff --git a/test-suite/bugs/opened/4728.v b/test-suite/bugs/opened/bug_4728.v index 230b4beb6c..230b4beb6c 100644 --- a/test-suite/bugs/opened/4728.v +++ b/test-suite/bugs/opened/bug_4728.v diff --git a/test-suite/bugs/opened/bug_4755.v b/test-suite/bugs/opened/bug_4755.v new file mode 100644 index 0000000000..50e40c5fad --- /dev/null +++ b/test-suite/bugs/opened/bug_4755.v @@ -0,0 +1,35 @@ +(*I'm not sure which behavior is better. But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*) + +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. +Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) +Abort. diff --git a/test-suite/bugs/opened/4771.v b/test-suite/bugs/opened/bug_4771.v index 396d74bdbf..396d74bdbf 100644 --- a/test-suite/bugs/opened/4771.v +++ b/test-suite/bugs/opened/bug_4771.v diff --git a/test-suite/bugs/opened/bug_4778.v b/test-suite/bugs/opened/bug_4778.v new file mode 100644 index 0000000000..d66373ed7c --- /dev/null +++ b/test-suite/bugs/opened/bug_4778.v @@ -0,0 +1,36 @@ +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +(* This instance is needed in 8.4, but is useless in 8.5 *) +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +(* +(* This is required in 8.5, but useless in 8.4 *) +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. +*) + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) +Abort. diff --git a/test-suite/bugs/opened/4781.v b/test-suite/bugs/opened/bug_4781.v index 8b651ac22e..8b651ac22e 100644 --- a/test-suite/bugs/opened/4781.v +++ b/test-suite/bugs/opened/bug_4781.v diff --git a/test-suite/bugs/opened/4813.v b/test-suite/bugs/opened/bug_4813.v index 2ac5535934..2ac5535934 100644 --- a/test-suite/bugs/opened/4813.v +++ b/test-suite/bugs/opened/bug_4813.v diff --git a/test-suite/bugs/opened/6393.v b/test-suite/bugs/opened/bug_6393.v index 8d5d092333..8d5d092333 100644 --- a/test-suite/bugs/opened/6393.v +++ b/test-suite/bugs/opened/bug_6393.v diff --git a/test-suite/bugs/opened/6602.v b/test-suite/bugs/opened/bug_6602.v index 3690adf90a..3690adf90a 100644 --- a/test-suite/bugs/opened/6602.v +++ b/test-suite/bugs/opened/bug_6602.v diff --git a/test-suite/failure/ClearBody.v b/test-suite/failure/ClearBody.v index e321e59f58..e865f121e8 100644 --- a/test-suite/failure/ClearBody.v +++ b/test-suite/failure/ClearBody.v @@ -6,3 +6,4 @@ set (n := 0) in *. set (I := refl_equal 0) in *. change (n = 0) in (type of I). Fail clearbody n. +Abort. diff --git a/test-suite/failure/Reordering.v b/test-suite/failure/Reordering.v index e79b20737b..75cf372b43 100644 --- a/test-suite/failure/Reordering.v +++ b/test-suite/failure/Reordering.v @@ -3,3 +3,4 @@ Goal forall (A:Set) (x:A) (A':=A), True. intros. Fail change ((fun (_:A') => Set) x) in (type of A). +Abort. diff --git a/test-suite/failure/Sections.v b/test-suite/failure/Sections.v index 928e214f47..815fadd8a5 100644 --- a/test-suite/failure/Sections.v +++ b/test-suite/failure/Sections.v @@ -2,3 +2,5 @@ Module A. Section B. Fail End A. (*End A.*) +End B. +End A. diff --git a/test-suite/failure/Tauto.v b/test-suite/failure/Tauto.v index 81d5b6358e..c10cb0b869 100644 --- a/test-suite/failure/Tauto.v +++ b/test-suite/failure/Tauto.v @@ -20,3 +20,4 @@ Goal (forall A : Prop, A \/ ~ A) -> forall x y : nat, x = y \/ x <> y. Proof. Fail tauto. +Abort. diff --git a/test-suite/failure/autorewritein.v b/test-suite/failure/autorewritein.v index 191e035b3a..b734d85933 100644 --- a/test-suite/failure/autorewritein.v +++ b/test-suite/failure/autorewritein.v @@ -10,6 +10,4 @@ Lemma ResAck2 : forall H:(Ack 2 2 = 7 -> False), H=H -> False. Proof. intros. Fail autorewrite with base0 in * using try (apply H1;reflexivity). - - - +Abort. diff --git a/test-suite/failure/clashes.v b/test-suite/failure/clashes.v index 1a59ec66d1..1abec329c4 100644 --- a/test-suite/failure/clashes.v +++ b/test-suite/failure/clashes.v @@ -7,3 +7,4 @@ Section S. Variable n : nat. Fail Inductive P : Set := n : P. +End S. diff --git a/test-suite/failure/coqbugs0266.v b/test-suite/failure/coqbugs0266.v index cc3f307a20..79ea5ede47 100644 --- a/test-suite/failure/coqbugs0266.v +++ b/test-suite/failure/coqbugs0266.v @@ -5,3 +5,5 @@ Let a := 0. Definition b := a. Goal b = b. Fail clear a. +Abort. +End S. diff --git a/test-suite/failure/evarclear1.v b/test-suite/failure/evarclear1.v index 60adadef40..82697bf41e 100644 --- a/test-suite/failure/evarclear1.v +++ b/test-suite/failure/evarclear1.v @@ -7,4 +7,4 @@ unfold z. clear y z. (* should fail because the evar should no longer be allowed to depend on z *) Fail instantiate (1:=z). - +Abort. diff --git a/test-suite/failure/evarclear2.v b/test-suite/failure/evarclear2.v index 0f7768112b..45eeef6aa7 100644 --- a/test-suite/failure/evarclear2.v +++ b/test-suite/failure/evarclear2.v @@ -7,3 +7,4 @@ rename y into z. unfold z at 1 2. (* should fail because the evar type depends on z *) Fail clear z. +Abort. diff --git a/test-suite/failure/fixpoint2.v b/test-suite/failure/fixpoint2.v index 7f11a99b16..2d2d6a02cd 100644 --- a/test-suite/failure/fixpoint2.v +++ b/test-suite/failure/fixpoint2.v @@ -4,3 +4,4 @@ Goal nat->nat. fix f 1. intro n; apply f; assumption. Fail Guarded. +Abort. diff --git a/test-suite/failure/guard-cofix.v b/test-suite/failure/guard_cofix.v index 3ae8770546..3ae8770546 100644 --- a/test-suite/failure/guard-cofix.v +++ b/test-suite/failure/guard_cofix.v diff --git a/test-suite/failure/ltac1.v b/test-suite/failure/ltac1.v index eef16525d6..1cd119f3eb 100644 --- a/test-suite/failure/ltac1.v +++ b/test-suite/failure/ltac1.v @@ -5,3 +5,4 @@ Ltac X := match goal with Goal True -> True -> True. intros. Fail X. +Abort. diff --git a/test-suite/failure/ltac2.v b/test-suite/failure/ltac2.v index d66fb6808d..8a9157df84 100644 --- a/test-suite/failure/ltac2.v +++ b/test-suite/failure/ltac2.v @@ -4,3 +4,4 @@ Goal True -> True. Fail E ltac:(match goal with | |- _ => intro H end). +Abort. diff --git a/test-suite/failure/ltac4.v b/test-suite/failure/ltac4.v index 5b0396d164..58b791eb38 100644 --- a/test-suite/failure/ltac4.v +++ b/test-suite/failure/ltac4.v @@ -3,4 +3,4 @@ Goal forall n : nat, n = n. induction n. Fail try REflexivity. - +Abort. diff --git a/test-suite/failure/pattern.v b/test-suite/failure/pattern.v index 216eb254c1..480f579502 100644 --- a/test-suite/failure/pattern.v +++ b/test-suite/failure/pattern.v @@ -7,3 +7,4 @@ Variable P : forall m : nat, m = n -> Prop. Goal forall p : n = n, P n p. intro. Fail pattern n, p. +Abort. diff --git a/test-suite/failure/prop-set-proof-irrelevance.v b/test-suite/failure/prop-set-proof-irrelevance.v deleted file mode 100644 index fee33432b0..0000000000 --- a/test-suite/failure/prop-set-proof-irrelevance.v +++ /dev/null @@ -1,12 +0,0 @@ -Require Import ProofIrrelevance. - -Lemma proof_irrelevance_set : forall (P : Set) (p1 p2 : P), p1 = p2. - Fail exact proof_irrelevance. -(*Qed. - -Lemma paradox : False. - assert (H : 0 <> 1) by discriminate. - apply H. - Fail apply proof_irrelevance. (* inlined version is rejected *) - apply proof_irrelevance_set. -Qed.*) diff --git a/test-suite/failure/prop_set_proof_irrelevance.v b/test-suite/failure/prop_set_proof_irrelevance.v new file mode 100644 index 0000000000..ed6d4300e0 --- /dev/null +++ b/test-suite/failure/prop_set_proof_irrelevance.v @@ -0,0 +1,13 @@ +Require Import ProofIrrelevance. + +Lemma proof_irrelevance_set : forall (P : Set) (p1 p2 : P), p1 = p2. + Fail exact proof_irrelevance. +(*Qed. + +Lemma paradox : False. + assert (H : 0 <> 1) by discriminate. + apply H. + Fail apply proof_irrelevance. (* inlined version is rejected *) + apply proof_irrelevance_set. +Qed.*) +Abort. diff --git a/test-suite/failure/rewrite_in_goal.v b/test-suite/failure/rewrite_in_goal.v index dedfdf01eb..e7823f1cb1 100644 --- a/test-suite/failure/rewrite_in_goal.v +++ b/test-suite/failure/rewrite_in_goal.v @@ -1,3 +1,4 @@ Goal forall T1 T2 (H:T1=T2) (f:T1->Prop) (x:T1) , f x -> Type. intros until x. Fail rewrite H in x. +Abort. diff --git a/test-suite/failure/rewrite_in_hyp.v b/test-suite/failure/rewrite_in_hyp.v index 1eef0fa033..f1b2203acc 100644 --- a/test-suite/failure/rewrite_in_hyp.v +++ b/test-suite/failure/rewrite_in_hyp.v @@ -1,3 +1,4 @@ Goal forall (T1 T2 : Type) (f:T1 -> Prop) (x:T1) (H:T1=T2), f x -> 0=1. intros T1 T2 f x H fx. Fail rewrite H in x. +Abort. diff --git a/test-suite/failure/rewrite_in_hyp2.v b/test-suite/failure/rewrite_in_hyp2.v index 112a856e32..60994fe1ed 100644 --- a/test-suite/failure/rewrite_in_hyp2.v +++ b/test-suite/failure/rewrite_in_hyp2.v @@ -6,3 +6,4 @@ Goal forall b, S b = O -> (fun a => 0 = (S a)) b -> True. intros b H H0. Fail rewrite H in H0. +Abort. diff --git a/test-suite/failure/subtyping.v b/test-suite/failure/subtyping.v index e48c668916..6996f4232a 100644 --- a/test-suite/failure/subtyping.v +++ b/test-suite/failure/subtyping.v @@ -19,3 +19,10 @@ Module TT : T. | L1 : (A -> Prop) -> L. Fail End TT. + + Reset L. + Inductive L : Prop := + | L0 + | L1 : (A -> Prop) -> L. + +End TT. diff --git a/test-suite/failure/universes-buraliforti.v b/test-suite/failure/universes_buraliforti.v index dba1a794fa..dba1a794fa 100644 --- a/test-suite/failure/universes-buraliforti.v +++ b/test-suite/failure/universes_buraliforti.v diff --git a/test-suite/failure/universes-buraliforti-redef.v b/test-suite/failure/universes_buraliforti_redef.v index e016815880..e016815880 100644 --- a/test-suite/failure/universes-buraliforti-redef.v +++ b/test-suite/failure/universes_buraliforti_redef.v diff --git a/test-suite/failure/universes-sections1.v b/test-suite/failure/universes_sections1.v index 3f8e444623..3f8e444623 100644 --- a/test-suite/failure/universes-sections1.v +++ b/test-suite/failure/universes_sections1.v diff --git a/test-suite/failure/universes-sections2.v b/test-suite/failure/universes_sections2.v index 34b2a11ded..34b2a11ded 100644 --- a/test-suite/failure/universes-sections2.v +++ b/test-suite/failure/universes_sections2.v diff --git a/test-suite/interactive/4289.v b/test-suite/interactive/bug_4289.v index 610a509c9b..610a509c9b 100644 --- a/test-suite/interactive/4289.v +++ b/test-suite/interactive/bug_4289.v diff --git a/test-suite/modules/SeveralWith.v b/test-suite/modules/SeveralWith.v index bbf72a7648..4426f2710a 100644 --- a/test-suite/modules/SeveralWith.v +++ b/test-suite/modules/SeveralWith.v @@ -10,3 +10,4 @@ End ES. Module Make (AX : S) (X : ES with Definition A := AX.A with Definition eq := @eq AX.A). +End Make. diff --git a/test-suite/modules/WithDefUBinders.v b/test-suite/modules/WithDefUBinders.v index e683455162..00a93b5fdf 100644 --- a/test-suite/modules/WithDefUBinders.v +++ b/test-suite/modules/WithDefUBinders.v @@ -13,3 +13,5 @@ Fail Module M' : T with Definition foo := Type. (* Without the binder expression we have to do trickery to get the universes in the right order. *) Module M' : T with Definition foo := let t := Type in t. +Definition foo := let t := Type in t. +End M'. diff --git a/test-suite/modules/errors.v b/test-suite/modules/errors.v index d1658786ea..487de5801c 100644 --- a/test-suite/modules/errors.v +++ b/test-suite/modules/errors.v @@ -1,70 +1,90 @@ +(* coq-prog-args: ("-impredicative-set") *) (* Inductive mismatches *) Module Type SA. Inductive TA : nat -> Prop := CA : nat -> TA 0. End SA. Module MA : SA. Inductive TA : Prop := CA : bool -> TA. Fail End MA. +Reset Initial. -Module Type SA. Inductive TA := CA : nat -> TA. End SA. -Module MA : SA. Inductive TA := CA : bool -> TA. Fail End MA. +Module Type SA0. Inductive TA0 := CA0 : nat -> TA0. End SA0. +Module MA0 : SA0. Inductive TA0 := CA0 : bool -> TA0. Fail End MA0. +Reset Initial. -Module Type SA. Inductive TA := CA : nat -> TA. End SA. -Module MA : SA. Inductive TA := CA : bool -> nat -> TA. Fail End MA. +Module Type SA1. Inductive TA1 := CA1 : nat -> TA1. End SA1. +Module MA1 : SA1. Inductive TA1 := CA1 : bool -> nat -> TA1. Fail End MA1. +Reset Initial. Module Type SA2. Inductive TA2 := CA2 : nat -> TA2. End SA2. Module MA2 : SA2. Inductive TA2 := CA2 : nat -> TA2 | DA2 : TA2. Fail End MA2. +Reset Initial. Module Type SA3. Inductive TA3 := CA3 : nat -> TA3. End SA3. Module MA3 : SA3. Inductive TA3 := CA3 : nat -> TA3 with UA3 := DA3. Fail End MA3. +Reset Initial. Module Type SA4. Inductive TA4 := CA4 : nat -> TA4 with UA4 := DA4. End SA4. Module MA4 : SA4. Inductive TA4 := CA4 : nat -> TA4 with VA4 := DA4. Fail End MA4. +Reset Initial. Module Type SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := DA5. End SA5. Module MA5 : SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := EA5. Fail End MA5. +Reset Initial. Module Type SA6. Inductive TA6 (A:Type) := CA6 : A -> TA6 A. End SA6. Module MA6 : SA6. Inductive TA6 (A B:Type):= CA6 : A -> TA6 A B. Fail End MA6. +Reset Initial. Module Type SA7. Inductive TA7 (A:Type) := CA7 : A -> TA7 A. End SA7. Module MA7 : SA7. CoInductive TA7 (A:Type):= CA7 : A -> TA7 A. Fail End MA7. +Reset Initial. Module Type SA8. CoInductive TA8 (A:Type) := CA8 : A -> TA8 A. End SA8. Module MA8 : SA8. Inductive TA8 (A:Type):= CA8 : A -> TA8 A. Fail End MA8. +Reset Initial. Module Type SA9. Record TA9 (A:Type) := { CA9 : A }. End SA9. Module MA9 : SA9. Inductive TA9 (A:Type):= CA9 : A -> TA9 A. Fail End MA9. +Reset Initial. Module Type SA10. Inductive TA10 (A:Type) := CA10 : A -> TA10 A. End SA10. Module MA10 : SA10. Record TA10 (A:Type):= { CA10 : A }. Fail End MA10. +Reset Initial. Module Type SA11. Record TA11 (A:Type):= { CA11 : A }. End SA11. Module MA11 : SA11. Record TA11 (A:Type):= { DA11 : A }. Fail End MA11. +Reset Initial. (* Basic mismatches *) Module Type SB. Inductive TB := CB : nat -> TB. End SB. Module MB : SB. Module Type TB. End TB. Fail End MB. +Inductive TB := CB : nat -> TB. End MB. Module Type SC. Module Type TC. End TC. End SC. Module MC : SC. Inductive TC := CC : nat -> TC. Fail End MC. +Reset Initial. Module Type SD. Module TD. End TD. End SD. Module MD : SD. Inductive TD := DD : nat -> TD. Fail End MD. +Reset Initial. Module Type SE. Definition DE := nat. End SE. Module ME : SE. Definition DE := bool. Fail End ME. +Reset Initial. Module Type SF. Parameter DF : nat. End SF. Module MF : SF. Definition DF := bool. Fail End MF. +Reset Initial. (* Needs a type constraint in module type *) Module Type SG. Definition DG := Type. End SG. Module MG : SG. Definition DG := Type : Type. Fail End MG. +Reset Initial. (* Should work *) -Module Type SA7. Inductive TA7 (A:Type) := CA7 : A -> TA7 A. End SA7. -Module MA7 : SA7. Inductive TA7 (B:Type):= CA7 : B -> TA7 B. End MA7. +Module Type SA70. Inductive TA70 (A:Type) := CA70 : A -> TA70 A. End SA70. +Module MA70 : SA70. Inductive TA70 (B:Type):= CA70 : B -> TA70 B. End MA70. -Module Type SA11. Record TA11 (B:Type):= { CA11 : B }. End SA11. -Module MA11 : SA11. Record TA11 (A:Type):= { CA11 : A }. End MA11. +Module Type SA12. Record TA12 (B:Type):= { CA12 : B }. End SA12. +Module MA12 : SA12. Record TA12 (A:Type):= { CA12 : A }. End MA12. -Module Type SE. Parameter DE : Type. End SE. -Module ME : SE. Definition DE := Type : Type. End ME. +Module Type SH. Parameter DH : Type. End SH. +Module MH : SH. Definition DH := Type : Type. End MH. diff --git a/test-suite/modules/fun_objects.v b/test-suite/modules/fun_objects.v index dce2ffd50b..fe1372298e 100644 --- a/test-suite/modules/fun_objects.v +++ b/test-suite/modules/fun_objects.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-impredicative-set") *) Set Implicit Arguments. Unset Strict Implicit. diff --git a/test-suite/modules/modeq.v b/test-suite/modules/modeq.v index c8129eec5e..4ebcae82e5 100644 --- a/test-suite/modules/modeq.v +++ b/test-suite/modules/modeq.v @@ -1,10 +1,11 @@ +(* coq-prog-args: ("-top" "modeq") *) Module M. Definition T := nat. Definition x : T := 0. End M. Module Type SIG. - Module M := Top.M. + Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. @@ -12,7 +13,7 @@ Module Type SIG. End SIG. Module Z. - Module M := Top.M. + Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. diff --git a/test-suite/modules/modul.v b/test-suite/modules/modul.v index 36a542ef0a..9b3772b0d9 100644 --- a/test-suite/modules/modul.v +++ b/test-suite/modules/modul.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "modul") *) Module M. Parameter rel : nat -> nat -> Prop. @@ -32,4 +33,4 @@ Locate rel. Locate Module M. -Module N := Top.M. +Module N := modul.M. diff --git a/test-suite/output/Arguments.out b/test-suite/output/Arguments.out index 979396969a..d587d1f09b 100644 --- a/test-suite/output/Arguments.out +++ b/test-suite/output/Arguments.out @@ -42,32 +42,32 @@ Arguments D1, C1 are implicit and maximally inserted Argument scopes are [foo_scope type_scope _ _ _ _ _] The reduction tactics never unfold pf pf is transparent -Expands to: Constant Top.pf +Expands to: Constant Arguments.pf fcomp : forall A B C : Type, (B -> C) -> (A -> B) -> A -> C Arguments A, B, C are implicit and maximally inserted Argument scopes are [type_scope type_scope type_scope _ _ _] The reduction tactics unfold fcomp when applied to 6 arguments fcomp is transparent -Expands to: Constant Top.fcomp +Expands to: Constant Arguments.fcomp volatile : nat -> nat Argument scope is [nat_scope] The reduction tactics always unfold volatile volatile is transparent -Expands to: Constant Top.volatile +Expands to: Constant Arguments.volatile f : T1 -> T2 -> nat -> unit -> nat -> nat Argument scopes are [_ _ nat_scope _ nat_scope] f is transparent -Expands to: Constant Top.S1.S2.f +Expands to: Constant Arguments.S1.S2.f f : T1 -> T2 -> nat -> unit -> nat -> nat Argument scopes are [_ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 3rd, 4th and 5th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.S1.S2.f +Expands to: Constant Arguments.S1.S2.f f : forall T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat Argument T2 is implicit @@ -75,7 +75,7 @@ Argument scopes are [type_scope _ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 4th, 5th and 6th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.S1.f +Expands to: Constant Arguments.S1.f f : forall T1 T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat Arguments T1, T2 are implicit @@ -83,7 +83,7 @@ Argument scopes are [type_scope type_scope _ _ nat_scope _ nat_scope] The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.f +Expands to: Constant Arguments.f = forall v : unit, f 0 0 5 v 3 = 2 : Prop = 2 = 2 @@ -93,7 +93,7 @@ f : forall T1 T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent -Expands to: Constant Top.f +Expands to: Constant Arguments.f forall w : r, w 3 true = tt : Prop The command has indeed failed with message: diff --git a/test-suite/output/Arguments.v b/test-suite/output/Arguments.v index b67ac4f0df..97df40f882 100644 --- a/test-suite/output/Arguments.v +++ b/test-suite/output/Arguments.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Arguments") *) Arguments Nat.sub n m : simpl nomatch. About Nat.sub. Arguments Nat.sub n / m : simpl nomatch. diff --git a/test-suite/output/ArgumentsScope.out b/test-suite/output/ArgumentsScope.out index 6643c1429a..febe160820 100644 --- a/test-suite/output/ArgumentsScope.out +++ b/test-suite/output/ArgumentsScope.out @@ -10,12 +10,12 @@ negb'' : bool -> bool Argument scope is [bool_scope] negb'' is transparent -Expands to: Constant Top.A.B.negb'' +Expands to: Constant ArgumentsScope.A.B.negb'' negb' : bool -> bool Argument scope is [bool_scope] negb' is transparent -Expands to: Constant Top.A.negb' +Expands to: Constant ArgumentsScope.A.negb' negb : bool -> bool Argument scope is [bool_scope] @@ -34,11 +34,11 @@ Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is transparent -Expands to: Constant Top.A.negb' +Expands to: Constant ArgumentsScope.A.negb' negb'' : bool -> bool negb'' is transparent -Expands to: Constant Top.A.B.negb'' +Expands to: Constant ArgumentsScope.A.B.negb'' a : bool -> bool Expands to: Variable a @@ -49,8 +49,8 @@ Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is transparent -Expands to: Constant Top.negb' +Expands to: Constant ArgumentsScope.negb' negb'' : bool -> bool negb'' is transparent -Expands to: Constant Top.negb'' +Expands to: Constant ArgumentsScope.negb'' diff --git a/test-suite/output/ArgumentsScope.v b/test-suite/output/ArgumentsScope.v index 3a90cb79d7..ec49d85161 100644 --- a/test-suite/output/ArgumentsScope.v +++ b/test-suite/output/ArgumentsScope.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "ArgumentsScope") *) (* A few tests to check Global Argument Scope command *) Section A. diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out index c0b04eb53f..1755886967 100644 --- a/test-suite/output/Arguments_renaming.out +++ b/test-suite/output/Arguments_renaming.out @@ -1,6 +1,6 @@ The command has indeed failed with message: Flag "rename" expected to rename A into B. -File "stdin", line 2, characters 0-25: +File "stdin", line 3, characters 0-25: Warning: This command is just asserting the names of arguments of identity. If this is what you want add ': assert' to silence the warning. If you want to clear implicit arguments add ': clear implicits'. If you want to clear @@ -41,7 +41,7 @@ myrefl : forall (B : Type) (x : A), B -> myEq B x x Arguments are renamed to C, x, _ Argument C is implicit and maximally inserted Argument scopes are [type_scope _ _] -Expands to: Constructor Top.Test1.myrefl +Expands to: Constructor Arguments_renaming.Test1.myrefl myplus = fix myplus (T : Type) (t : T) (n m : nat) {struct n} : nat := match n with @@ -61,7 +61,7 @@ Argument scopes are [type_scope _ nat_scope nat_scope] The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent -Expands to: Constant Top.Test1.myplus +Expands to: Constant Arguments_renaming.Test1.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat Inductive myEq (A B : Type) (x : A) : A -> Prop := @@ -76,7 +76,7 @@ myrefl : forall (A B : Type) (x : A), B -> myEq A B x x Arguments are renamed to A, C, x, _ Argument C is implicit and maximally inserted Argument scopes are [type_scope type_scope _ _] -Expands to: Constructor Top.myrefl +Expands to: Constructor Arguments_renaming.myrefl myrefl : forall (A C : Type) (x : A), C -> myEq A C x x myplus = @@ -98,7 +98,7 @@ Argument scopes are [type_scope _ nat_scope nat_scope] The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent -Expands to: Constant Top.myplus +Expands to: Constant Arguments_renaming.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat The command has indeed failed with message: diff --git a/test-suite/output/Arguments_renaming.v b/test-suite/output/Arguments_renaming.v index 0cb331347d..9713a9dbbe 100644 --- a/test-suite/output/Arguments_renaming.v +++ b/test-suite/output/Arguments_renaming.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Arguments_renaming") *) Fail Arguments eq_refl {B y}, [B] y. Arguments identity A _ _. Arguments eq_refl A x : assert. diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v index e4fa7044e7..43718a0f07 100644 --- a/test-suite/output/Cases.v +++ b/test-suite/output/Cases.v @@ -187,6 +187,7 @@ let p := fresh "p" in |- eq_refl ?p = _ => pose (match eq_refl p in _ = z return p=p /\ z=z with eq_refl => conj eq_refl eq_refl end) end. Show. +Abort. Set Printing Allow Match Default Clause. diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out index 24180c4553..cf2d5b2850 100644 --- a/test-suite/output/Errors.out +++ b/test-suite/output/Errors.out @@ -1,5 +1,5 @@ The command has indeed failed with message: -The field t is missing in Top.M. +The field t is missing in Errors.M. The command has indeed failed with message: Unable to unify "nat" with "True". The command has indeed failed with message: diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v index c9b5091347..edc35f17b4 100644 --- a/test-suite/output/Errors.v +++ b/test-suite/output/Errors.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Errors") *) (* Test error messages *) (* Test non-regression of bug fixed in r13486 (bad printer for module names) *) @@ -31,3 +32,6 @@ Abort. Fail Goal forall a f, f a = 0. Fail Goal forall f x, id f x = 0. Fail Goal forall f P, P (f 0). + +Definition t := unit. +End M. diff --git a/test-suite/output/Existentials.v b/test-suite/output/Existentials.v index 7388468399..924f1f5592 100644 --- a/test-suite/output/Existentials.v +++ b/test-suite/output/Existentials.v @@ -12,3 +12,5 @@ clearbody q. clear p. (* Error ... *) Show Existentials. +Abort. +End Test. diff --git a/test-suite/output/Match_subterm.v b/test-suite/output/Match_subterm.v index 2c44b1879f..bf862c946d 100644 --- a/test-suite/output/Match_subterm.v +++ b/test-suite/output/Match_subterm.v @@ -4,3 +4,4 @@ match goal with idtac v ; fail | _ => idtac 2 end. +Abort. diff --git a/test-suite/output/Nametab.out b/test-suite/output/Nametab.out index c11621d7c1..47b19b71b3 100644 --- a/test-suite/output/Nametab.out +++ b/test-suite/output/Nametab.out @@ -1,36 +1,39 @@ -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Constant Top.Q.N.K.foo -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N.K -Module Top.Q.N.K (shorter name to refer to it in current context is Q.N.K) -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q.N -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q -Module Top.Q (shorter name to refer to it in current context is Q) -Constant Top.Q.N.K.foo +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N.K +Module Nametab.Q.N.K + (shorter name to refer to it in current context is Q.N.K) +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q.N +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q +Module Nametab.Q (shorter name to refer to it in current context is Q) +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Constant Top.Q.N.K.foo +Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) -Module Top.Q.N.K -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N.K (shorter name to refer to it in current context is K) -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q.N -Module Top.Q.N (shorter name to refer to it in current context is Q.N) -Module Top.Q -Module Top.Q (shorter name to refer to it in current context is Q) +Module Nametab.Q.N.K +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N.K (shorter name to refer to it in current context is K) +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q.N +Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) +Module Nametab.Q +Module Nametab.Q (shorter name to refer to it in current context is Q) diff --git a/test-suite/output/Nametab.v b/test-suite/output/Nametab.v index 357ba98243..4bbc5ca239 100644 --- a/test-suite/output/Nametab.v +++ b/test-suite/output/Nametab.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "Nametab") *) Module Q. Module N. Module K. @@ -10,19 +11,19 @@ End Q. (* Bad *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. -(* OK *) Locate Top.Q.N.K.foo. +(* OK *) Locate Nametab.Q.N.K.foo. (* Bad *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. -(* OK *) Locate Module Top.Q.N.K. +(* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. -(* OK *) Locate Module Top.Q.N. +(* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. -(* OK *) Locate Module Top.Q. +(* OK *) Locate Module Nametab.Q. Import Q.N. @@ -32,16 +33,16 @@ Import Q.N. (* OK *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. -(* OK *) Locate Top.Q.N.K.foo. +(* OK *) Locate Nametab.Q.N.K.foo. (* OK *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. -(* OK *) Locate Module Top.Q.N.K. +(* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. -(* OK *) Locate Module Top.Q.N. +(* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. -(* OK *) Locate Module Top.Q. +(* OK *) Locate Module Nametab.Q. diff --git a/test-suite/output/Naming.v b/test-suite/output/Naming.v index 327643dc57..7f3b332d7d 100644 --- a/test-suite/output/Naming.v +++ b/test-suite/output/Naming.v @@ -89,3 +89,4 @@ Show. apply H with (a:=a). (* test compliance with printing *) Abort. +End A. diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out index 975b2ef7ff..38a16e01c2 100644 --- a/test-suite/output/PrintInfos.out +++ b/test-suite/output/PrintInfos.out @@ -77,7 +77,7 @@ Expanded type for implicit arguments bar : forall x : nat, x = 0 Argument x is implicit and maximally inserted -Expands to: Constant Top.bar +Expands to: Constant PrintInfos.bar *** [ bar : foo ] Expanded type for implicit arguments diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v index 62aa80f8ab..d7c271c3ec 100644 --- a/test-suite/output/PrintInfos.v +++ b/test-suite/output/PrintInfos.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "PrintInfos") *) About existT. Print existT. Print Implicit existT. diff --git a/test-suite/output/ShowMatch.v b/test-suite/output/ShowMatch.v index 02b7eada83..9cf6ad35b8 100644 --- a/test-suite/output/ShowMatch.v +++ b/test-suite/output/ShowMatch.v @@ -11,3 +11,4 @@ Module B. Inductive foo := f. (* local foo shadows A.foo, so constructor "f" needs disambiguation *) Show Match A.foo. +End B. diff --git a/test-suite/output/ShowProof.v b/test-suite/output/ShowProof.v index 73ecaf2200..19822ac50e 100644 --- a/test-suite/output/ShowProof.v +++ b/test-suite/output/ShowProof.v @@ -4,3 +4,4 @@ Proof. split. - exact I. Show Proof. (* Was not finding an evar name at some time *) +Abort. diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v index 75b66e463a..fa12f09a46 100644 --- a/test-suite/output/Tactics.v +++ b/test-suite/output/Tactics.v @@ -21,3 +21,4 @@ Proof. intros H. Fail intros [H%myid ?]. Fail destruct 1 as [H%myid ?]. +Abort. diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v index d38e2a50e4..2e4008ae56 100644 --- a/test-suite/output/TypeclassDebug.v +++ b/test-suite/output/TypeclassDebug.v @@ -6,3 +6,4 @@ Hint Resolve H : foo. Goal foo. Typeclasses eauto := debug. Fail typeclasses eauto 5 with foo. +Abort. diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out index 1e50ba511a..acc37f653c 100644 --- a/test-suite/output/UnivBinders.out +++ b/test-suite/output/UnivBinders.out @@ -42,10 +42,10 @@ bar@{u} = nat *) bar is universe polymorphic -foo@{u Top.17 v} = -Type@{Top.17} -> Type@{v} -> Type@{u} - : Type@{max(u+1,Top.17+1,v+1)} -(* u Top.17 v |= *) +foo@{u UnivBinders.17 v} = +Type@{UnivBinders.17} -> Type@{v} -> Type@{u} + : Type@{max(u+1,UnivBinders.17+1,v+1)} +(* u UnivBinders.17 v |= *) foo is universe polymorphic Type@{i} -> Type@{j} @@ -86,10 +86,10 @@ Type@{M} -> Type@{N} -> Type@{E} (* E M N |= *) foo is universe polymorphic -foo@{u Top.17 v} = -Type@{Top.17} -> Type@{v} -> Type@{u} - : Type@{max(u+1,Top.17+1,v+1)} -(* u Top.17 v |= *) +foo@{u UnivBinders.17 v} = +Type@{UnivBinders.17} -> Type@{v} -> Type@{u} + : Type@{max(u+1,UnivBinders.17+1,v+1)} +(* u UnivBinders.17 v |= *) foo is universe polymorphic NonCumulative Inductive Empty@{E} : Type@{E} := @@ -104,7 +104,7 @@ punwrap@{K} : forall A : Type@{K}, PWrap@{K} A -> A punwrap is universe polymorphic Argument scopes are [type_scope _] punwrap is transparent -Expands to: Constant Top.punwrap +Expands to: Constant UnivBinders.punwrap The command has indeed failed with message: Universe instance should have length 3 The command has indeed failed with message: @@ -163,27 +163,29 @@ inmod@{u} -> Type@{v} (* u v |= *) Applied.infunct is universe polymorphic -axfoo@{i Top.55 Top.56} : Type@{Top.55} -> Type@{i} -(* i Top.55 Top.56 |= *) +axfoo@{i UnivBinders.55 UnivBinders.56} : +Type@{UnivBinders.55} -> Type@{i} +(* i UnivBinders.55 UnivBinders.56 |= *) axfoo is universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axfoo -axbar@{i Top.55 Top.56} : Type@{Top.56} -> Type@{i} -(* i Top.55 Top.56 |= *) +Expands to: Constant UnivBinders.axfoo +axbar@{i UnivBinders.55 UnivBinders.56} : +Type@{UnivBinders.56} -> Type@{i} +(* i UnivBinders.55 UnivBinders.56 |= *) axbar is universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axbar -axfoo' : Type@{Top.58} -> Type@{axbar'.i} +Expands to: Constant UnivBinders.axbar +axfoo' : Type@{UnivBinders.58} -> Type@{axbar'.i} axfoo' is not universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axfoo' -axbar' : Type@{Top.58} -> Type@{axbar'.i} +Expands to: Constant UnivBinders.axfoo' +axbar' : Type@{UnivBinders.58} -> Type@{axbar'.i} axbar' is not universe polymorphic Argument scope is [type_scope] -Expands to: Constant Top.axbar' +Expands to: Constant UnivBinders.axbar' The command has indeed failed with message: When declaring multiple axioms in one command, only the first is allowed a universe binder (which will be shared by the whole block). diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v index 9aebce1b9a..56474a0723 100644 --- a/test-suite/output/UnivBinders.v +++ b/test-suite/output/UnivBinders.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "UnivBinders") *) Set Universe Polymorphism. Set Printing Universes. (* Unset Strict Universe Declaration. *) @@ -58,7 +59,7 @@ Import mono. Check monomono. (* unqualified MONOU *) Check mono. (* still qualified mono.u *) -Monomorphic Constraint Set < Top.mono.u. +Monomorphic Constraint Set < UnivBinders.mono.u. Module mono2. Monomorphic Universe u. @@ -76,10 +77,10 @@ Module SecLet. Definition bobmorane := tt -> ff. End foo. Print bobmorane. (* - bobmorane@{Top.15 Top.16 ff.u ff.v} = - let tt := Type@{Top.16} in let ff := Type@{ff.v} in tt -> ff - : Type@{max(Top.15,ff.u)} - (* Top.15 Top.16 ff.u ff.v |= Top.16 < Top.15 + bobmorane@{UnivBinders.15 UnivBinders.16 ff.u ff.v} = + let tt := Type@{UnivBinders.16} in let ff := Type@{ff.v} in tt -> ff + : Type@{max(UnivBinders.15,ff.u)} + (* UnivBinders.15 UnivBinders.16 ff.u ff.v |= UnivBinders.16 < UnivBinders.15 ff.v < ff.u *) diff --git a/test-suite/output/names.v b/test-suite/output/names.v index f1efd0df2a..e9033bd732 100644 --- a/test-suite/output/names.v +++ b/test-suite/output/names.v @@ -7,3 +7,4 @@ Fail Definition b y : {x:nat|x=y} := a y. Goal (forall n m, n <= m -> m <= n -> n = m) -> True. intro H; epose proof (H _ 3) as H. Show. +Abort. diff --git a/test-suite/output/optimize_heap.v b/test-suite/output/optimize_heap.v index e566bd7bab..31b4510397 100644 --- a/test-suite/output/optimize_heap.v +++ b/test-suite/output/optimize_heap.v @@ -5,3 +5,4 @@ Goal True. Show. optimize_heap. Show. +Abort. diff --git a/test-suite/output/qualification.out b/test-suite/output/qualification.out index e9c70d1efc..cfa295010f 100644 --- a/test-suite/output/qualification.out +++ b/test-suite/output/qualification.out @@ -1,4 +1,5 @@ -File "stdin", line 19, characters 0-7: +File "stdin", line 20, characters 0-7: Error: Signature components for label test do not match: expected type -"Top.M2.t = Top.M2.M.t" but found type "Top.M2.t = Top.M2.t". +"qualification.M2.t = qualification.M2.M.t" but found type +"qualification.M2.t = qualification.M2.t". diff --git a/test-suite/output/qualification.v b/test-suite/output/qualification.v index d39097e2dd..877bc84d14 100644 --- a/test-suite/output/qualification.v +++ b/test-suite/output/qualification.v @@ -1,3 +1,4 @@ +(* coq-prog-args: ("-top" "qualification") *) Module Type T1. Parameter t : Type. End T1. diff --git a/test-suite/output/rewrite-2172.v b/test-suite/output/rewrite-2172.v deleted file mode 100644 index 212b1c1259..0000000000 --- a/test-suite/output/rewrite-2172.v +++ /dev/null @@ -1,21 +0,0 @@ -(* This checks an error message as reported in bug #2172 *) - -Axiom axiom : forall (E F : nat), E = F. -Lemma test : forall (E F : nat), E = F. -Proof. - intros. -(* This used to raise the following non understandable error message: - - Error: Unable to find an instance for the variable x - - The reason this error was that rewrite generated the proof - - "eq_ind ?A ?x ?P ? ?y (axiom ?E ?F)" - - and the equation ?x=?E was solved in the way ?E:=?x leaving ?x - unresolved. A stupid hack for solve this consisted in ordering - meta=meta equations the other way round (with most recent evars - instantiated first - since they are assumed to come first from the - user in rewrite/induction/destruct calls). -*) - Fail rewrite <- axiom. diff --git a/test-suite/output/rewrite-2172.out b/test-suite/output/rewrite_2172.out index 27b0dc1b7b..27b0dc1b7b 100644 --- a/test-suite/output/rewrite-2172.out +++ b/test-suite/output/rewrite_2172.out diff --git a/test-suite/output/rewrite_2172.v b/test-suite/output/rewrite_2172.v new file mode 100644 index 0000000000..864fc21cdd --- /dev/null +++ b/test-suite/output/rewrite_2172.v @@ -0,0 +1,22 @@ +(* This checks an error message as reported in bug #2172 *) + +Axiom axiom : forall (E F : nat), E = F. +Lemma test : forall (E F : nat), E = F. +Proof. + intros. +(* This used to raise the following non understandable error message: + + Error: Unable to find an instance for the variable x + + The reason this error was that rewrite generated the proof + + "eq_ind ?A ?x ?P ? ?y (axiom ?E ?F)" + + and the equation ?x=?E was solved in the way ?E:=?x leaving ?x + unresolved. A stupid hack for solve this consisted in ordering + meta=meta equations the other way round (with most recent evars + instantiated first - since they are assumed to come first from the + user in rewrite/induction/destruct calls). +*) + Fail rewrite <- axiom. +Abort. diff --git a/test-suite/success/CaseInClause.v b/test-suite/success/CaseInClause.v index 6424fe92dd..ca93c8ea79 100644 --- a/test-suite/success/CaseInClause.v +++ b/test-suite/success/CaseInClause.v @@ -20,6 +20,7 @@ Theorem foo : forall (n m : nat) (pf : n = m), match pf in _ = N with | eq_refl => unit end. +Abort. (* Check redundant clause is removed *) Inductive I : nat * nat -> Type := C : I (0,0). diff --git a/test-suite/success/Cases-bug1834.v b/test-suite/success/Cases-bug1834.v deleted file mode 100644 index cf102486a6..0000000000 --- a/test-suite/success/Cases-bug1834.v +++ /dev/null @@ -1,13 +0,0 @@ -(* Bug in the computation of generalization *) - -(* The following bug, elaborated by Bruno Barras, is solved from r11083 *) - -Parameter P : unit -> Prop. -Definition T := sig P. -Parameter Q : T -> Prop. -Definition U := sig Q. -Parameter a : U. -Check (match a with exist _ (exist _ tt e2) e3 => e3=e3 end). - -(* There is still a form submitted by Pierre Corbineau (#1834) which fails *) - diff --git a/test-suite/success/Cases_bug1834.v b/test-suite/success/Cases_bug1834.v new file mode 100644 index 0000000000..65372c2da4 --- /dev/null +++ b/test-suite/success/Cases_bug1834.v @@ -0,0 +1,12 @@ +(* Bug in the computation of generalization *) + +(* The following bug, elaborated by Bruno Barras, is solved from r11083 *) + +Parameter P : unit -> Prop. +Definition T := sig P. +Parameter Q : T -> Prop. +Definition U := sig Q. +Parameter a : U. +Check (match a with exist _ (exist _ tt e2) e3 => e3=e3 end). + +(* There is still a form submitted by Pierre Corbineau (#1834) which fails *) diff --git a/test-suite/success/Cases-bug3758.v b/test-suite/success/Cases_bug3758.v index e48f452326..e48f452326 100644 --- a/test-suite/success/Cases-bug3758.v +++ b/test-suite/success/Cases_bug3758.v diff --git a/test-suite/success/ImplicitArguments.v b/test-suite/success/ImplicitArguments.v index 9a19b595ef..b16e4a1186 100644 --- a/test-suite/success/ImplicitArguments.v +++ b/test-suite/success/ImplicitArguments.v @@ -27,6 +27,7 @@ Parameters (a:_) (b:a=0). Definition foo6 (x:=1) : forall {n:nat}, n=n := fun n => eq_refl. Fixpoint foo7 (x:=1) (n:nat) {p:nat} {struct n} : nat. +Abort. (* Some example which should succeed with local implicit arguments *) diff --git a/test-suite/success/Print.v b/test-suite/success/Print.v index c4726bf3ff..c1cb86caf1 100644 --- a/test-suite/success/Print.v +++ b/test-suite/success/Print.v @@ -17,3 +17,4 @@ Print Coercion Paths nat Sortclass. Print Section A. +End A. diff --git a/test-suite/success/Scopes.v b/test-suite/success/Scopes.v index 2da630633d..06697af901 100644 --- a/test-suite/success/Scopes.v +++ b/test-suite/success/Scopes.v @@ -25,4 +25,4 @@ Definition c := ε : U. Goal True. assert (nat * nat). - +Abort. diff --git a/test-suite/success/all-check.v b/test-suite/success/all_check.v index 391bc540e4..391bc540e4 100644 --- a/test-suite/success/all-check.v +++ b/test-suite/success/all_check.v diff --git a/test-suite/success/attribute-syntax.v b/test-suite/success/attribute-syntax.v deleted file mode 100644 index 241d4eb200..0000000000 --- a/test-suite/success/attribute-syntax.v +++ /dev/null @@ -1,33 +0,0 @@ -From Coq Require Program.Wf. - -Section Scope. - -#[local] Coercion nat_of_bool (b: bool) : nat := - if b then 0 else 1. - -Check (refl_equal : true = 0 :> nat). - -End Scope. - -Fail Check 0 = true :> nat. - -#[polymorphic] -Definition ι T (x: T) := x. - -Check ι _ ι. - -#[program] -Fixpoint f (n: nat) {wf lt n} : nat := _. - -#[deprecated(since="8.9.0")] -Ltac foo := foo. - -Module M. - #[local] #[polymorphic] Definition zed := Type. - - #[local, polymorphic] Definition kats := Type. -End M. -Check M.zed@{_}. -Fail Check zed. -Check M.kats@{_}. -Fail Check kats. diff --git a/test-suite/success/attribute_syntax.v b/test-suite/success/attribute_syntax.v new file mode 100644 index 0000000000..7b972f4ed9 --- /dev/null +++ b/test-suite/success/attribute_syntax.v @@ -0,0 +1,34 @@ +From Coq Require Program.Wf. + +Section Scope. + +#[local] Coercion nat_of_bool (b: bool) : nat := + if b then 0 else 1. + +Check (refl_equal : true = 0 :> nat). + +End Scope. + +Fail Check 0 = true :> nat. + +#[polymorphic] +Definition ι T (x: T) := x. + +Check ι _ ι. + +#[program] +Fixpoint f (n: nat) {wf lt n} : nat := _. +Reset f. + +#[deprecated(since="8.9.0")] +Ltac foo := foo. + +Module M. + #[local] #[polymorphic] Definition zed := Type. + + #[local, polymorphic] Definition kats := Type. +End M. +Check M.zed@{_}. +Fail Check zed. +Check M.kats@{_}. +Fail Check kats. diff --git a/test-suite/success/autorewrite.v b/test-suite/success/autorewrite.v index 5e9064f8af..71d333d439 100644 --- a/test-suite/success/autorewrite.v +++ b/test-suite/success/autorewrite.v @@ -27,3 +27,4 @@ Goal forall y, exists x, y+x = y. eexists. autorewrite with base1. Fail reflexivity. +Abort. diff --git a/test-suite/success/change_pattern.v b/test-suite/success/change_pattern.v index 874abf49f1..104585a720 100644 --- a/test-suite/success/change_pattern.v +++ b/test-suite/success/change_pattern.v @@ -32,3 +32,4 @@ clearbody e. if this is not the case because the inferred argument does not coincide with the one in the considered term. *) progress (change (dim (traverse unit a x)) with (dim X) in e). +Abort. diff --git a/test-suite/success/dtauto-let-deps.v b/test-suite/success/dtauto_let_deps.v index 094b2f8b3c..094b2f8b3c 100644 --- a/test-suite/success/dtauto-let-deps.v +++ b/test-suite/success/dtauto_let_deps.v diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v index 448febed25..5d53fd2f09 100644 --- a/test-suite/success/ltac.v +++ b/test-suite/success/ltac.v @@ -225,9 +225,9 @@ Qed. (* Illegal application used to make Ltac loop. *) Section LtacLoopTest. - Ltac f x := idtac. + Ltac g x := idtac. Goal True. - Timeout 1 try f()(). + Timeout 1 try g()(). Abort. End LtacLoopTest. diff --git a/test-suite/success/rewrite_evar.v b/test-suite/success/rewrite_evar.v index f7ad261cbb..3bfd3c674a 100644 --- a/test-suite/success/rewrite_evar.v +++ b/test-suite/success/rewrite_evar.v @@ -6,3 +6,4 @@ Goal forall (T2 MT1 MT2 : Type) (x : T2) (M2 m2 : MT2) (M1 m1 : MT1) (F : T2 -> rewrite (H' _) in *. (** The above rewrite should also rewrite in H. *) Fail progress rewrite H' in H. +Abort. diff --git a/test-suite/success/setoid_unif.v b/test-suite/success/setoid_unif.v index 912596b4a3..d579911323 100644 --- a/test-suite/success/setoid_unif.v +++ b/test-suite/success/setoid_unif.v @@ -25,3 +25,4 @@ Goal forall x, ~ In _ x (t Empty). Proof. intros x. rewrite foo. +Abort. diff --git a/test-suite/success/unfold.v b/test-suite/success/unfold.v index de8aa252b8..72f0d94dea 100644 --- a/test-suite/success/unfold.v +++ b/test-suite/success/unfold.v @@ -23,3 +23,4 @@ Goal let x := 0 in True. intro x. Fail (clear x; unfold x). Abort. +End toto. diff --git a/test-suite/success/unidecls.v b/test-suite/success/unidecls.v index c4a1d7c28f..7c298c98b6 100644 --- a/test-suite/success/unidecls.v +++ b/test-suite/success/unidecls.v @@ -1,22 +1,23 @@ +(* coq-prog-args: ("-top" "unidecls") *) Set Printing Universes. -Module unidecls. +Module decls. Universes a b. -End unidecls. +End decls. Universe a. -Constraint a < unidecls.a. +Constraint a < decls.a. Print Universes. (** These are different universes *) Check Type@{a}. -Check Type@{unidecls.a}. +Check Type@{decls.a}. -Check Type@{unidecls.b}. +Check Type@{decls.b}. -Fail Check Type@{unidecls.c}. +Fail Check Type@{decls.c}. Fail Check Type@{i}. Universe foo. @@ -39,7 +40,7 @@ Check Type@{Foo.bar}. Check Type@{Foo.foo}. (** The same *) Check Type@{foo}. -Check Type@{Top.foo}. +Check Type@{unidecls.foo}. Universe secfoo. Section Foo'. diff --git a/test-suite/success/universes-coercion.v b/test-suite/success/universes-coercion.v deleted file mode 100644 index d750434027..0000000000 --- a/test-suite/success/universes-coercion.v +++ /dev/null @@ -1,22 +0,0 @@ -(* This example used to emphasize the absence of LEGO-style universe - polymorphism; Matthieu's improvements of typing on 2011/3/11 now - makes (apparently) that Amokrane's automatic eta-expansion in the - coercion mechanism works; this makes its illustration as a "weakness" - of universe polymorphism obsolete (example submitted by Randy Pollack). - - Note that this example is not an evidence that the current - non-kernel eta-expansion behavior is the most expected one. -*) - -Parameter K : forall T : Type, T -> T. -Check (K (forall T : Type, T -> T) K). - -(* - note that the inferred term is - "(K (forall T (* u1 *) : Type, T -> T) (fun T:Type (* u1 *) => K T))" - which is not eta-equivalent to - "(K (forall T : Type, T -> T) K" - because the eta-expansion of the latter - "(K (forall T : Type, T -> T) (fun T:Type (* u2 *) => K T)" - assuming K of type "forall T (* u2 *) : Type, T -> T" -*) diff --git a/test-suite/success/universes_coercion.v b/test-suite/success/universes_coercion.v new file mode 100644 index 0000000000..272d3ec74a --- /dev/null +++ b/test-suite/success/universes_coercion.v @@ -0,0 +1,22 @@ +(* This example used to emphasize the absence of LEGO-style universe + polymorphism; Matthieu's improvements of typing on 2011/3/11 now + makes (apparently) that Amokrane's automatic eta-expansion in the + coercion mechanism works; this makes its illustration as a "weakness" + of universe polymorphism obsolete (example submitted by Randy Pollack). + + Note that this example is not an evidence that the current + non-kernel eta-expansion behavior is the most expected one. +*) + +Parameter K : forall T : Type, T -> T. +Check (K (forall T : Type, T -> T) K). + +(* + note that the inferred term is + "(K (forall T (* u1 *) : Type, T -> T) (fun T:Type (* u1 *) => K T))" + which is not eta-equivalent to + "(K (forall T : Type, T -> T) K" + because the eta-expansion of the latter + "(K (forall T : Type, T -> T) (fun T:Type (* u2 *) => K T)" + assuming K of type "forall T (* u2 *) : Type, T -> T" +*) diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml index b000745961..15c0278f47 100644 --- a/vernac/assumptions.ml +++ b/vernac/assumptions.ml @@ -119,7 +119,7 @@ and fields_of_expression x = fields_of_functor fields_of_expr x let lookup_constant_in_impl cst fallback = try - let mp,dp,lab = KerName.repr (Constant.canonical cst) in + let mp,lab = KerName.repr (Constant.canonical cst) in let fields = memoize_fields_of_mp mp in (* A module found this way is necessarily closed, in particular our constant cannot be in an opened section : *) @@ -143,7 +143,7 @@ let lookup_constant cst = let lookup_mind_in_impl mind = try - let mp,dp,lab = KerName.repr (MutInd.canonical mind) in + let mp,lab = KerName.repr (MutInd.canonical mind) in let fields = memoize_fields_of_mp mp in search_mind_label lab fields with Not_found -> @@ -157,9 +157,9 @@ let lookup_mind mind = traversed objects *) let label_of = function - | ConstRef kn -> pi3 (Constant.repr3 kn) + | ConstRef kn -> Constant.label kn | IndRef (kn,_) - | ConstructRef ((kn,_),_) -> pi3 (MutInd.repr3 kn) + | ConstructRef ((kn,_),_) -> MutInd.label kn | VarRef id -> Label.of_id id let fold_constr_with_full_binders g f n acc c = diff --git a/vernac/classes.ml b/vernac/classes.ml index c738d14af9..37ee33b19f 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -99,7 +99,7 @@ let type_ctx_instance env sigma ctx inst subst = let id_of_class cl = match cl.cl_impl with - | ConstRef kn -> let _,_,l = Constant.repr3 kn in Label.to_id l + | ConstRef kn -> Label.to_id @@ Constant.label kn | IndRef (kn,i) -> let mip = (Environ.lookup_mind kn (Global.env ())).Declarations.mind_packets in mip.(0).Declarations.mind_typename diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index 750ed35cbc..9497f2fb03 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -84,8 +84,7 @@ match local with in (gr,inst,Lib.is_modtype_strict ()) -let interp_assumption sigma env impls bl c = - let c = mkCProdN ?loc:(local_binders_loc bl) bl c in +let interp_assumption sigma env impls c = let sigma, (ty, impls) = interp_type_evars_impls env sigma ~impls c in sigma, (ty, impls) @@ -148,7 +147,7 @@ let do_assumptions kind nl l = in (* We intepret all declarations in the same evar_map, i.e. as a telescope. *) let (sigma,_,_),l = List.fold_left_map (fun (sigma,env,ienv) (is_coe,(idl,c)) -> - let sigma,(t,imps) = interp_assumption sigma env ienv [] c in + let sigma,(t,imps) = interp_assumption sigma env ienv c in let env = EConstr.push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (id,t)) idl) env in let ienv = List.fold_right (fun {CAst.v=id} ienv -> diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml index 37258c2d45..04cd4173a8 100644 --- a/vernac/comFixpoint.ml +++ b/vernac/comFixpoint.ml @@ -1,3 +1,13 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + open Pp open CErrors open Util diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg index cf69a84b8b..895737b538 100644 --- a/vernac/g_vernac.mlg +++ b/vernac/g_vernac.mlg @@ -296,7 +296,7 @@ GRAMMAR EXTEND Gram { if List.exists (function CLocalPattern _ -> true | _ -> false) bl then (* FIXME: "red" will be applied to types in bl and Cast with remain *) - let c = mkCLambdaN ~loc bl c in + let c = mkLambdaCN ~loc bl c in DefineBody ([], red, c, None) else (match c with @@ -308,7 +308,7 @@ GRAMMAR EXTEND Gram then (* FIXME: "red" will be applied to types in bl and Cast with remain *) let c = CAst.make ~loc @@ CCast (c, CastConv t) in - (([],mkCLambdaN ~loc bl c), None) + (([],mkLambdaCN ~loc bl c), None) else ((bl, c), Some t) in DefineBody (bl, red, c, tyo) } @@ -419,16 +419,16 @@ GRAMMAR EXTEND Gram ; record_binder_body: [ [ l = binders; oc = of_type_with_opt_coercion; - t = lconstr -> { fun id -> (oc,AssumExpr (id,mkCProdN ~loc l t)) } + t = lconstr -> { fun id -> (oc,AssumExpr (id,mkProdCN ~loc l t)) } | l = binders; oc = of_type_with_opt_coercion; t = lconstr; ":="; b = lconstr -> { fun id -> - (oc,DefExpr (id,mkCLambdaN ~loc l b,Some (mkCProdN ~loc l t))) } + (oc,DefExpr (id,mkLambdaCN ~loc l b,Some (mkProdCN ~loc l t))) } | l = binders; ":="; b = lconstr -> { fun id -> match b.CAst.v with | CCast(b', (CastConv t|CastVM t|CastNative t)) -> - (None,DefExpr(id,mkCLambdaN ~loc l b',Some (mkCProdN ~loc l t))) + (None,DefExpr(id,mkLambdaCN ~loc l b',Some (mkProdCN ~loc l t))) | _ -> - (None,DefExpr(id,mkCLambdaN ~loc l b,None)) } ] ] + (None,DefExpr(id,mkLambdaCN ~loc l b,None)) } ] ] ; record_binder: [ [ id = name -> { (None,AssumExpr(id, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))) } @@ -448,9 +448,9 @@ GRAMMAR EXTEND Gram constructor_type: [[ l = binders; t= [ coe = of_type_with_opt_coercion; c = lconstr -> - { fun l id -> (not (Option.is_empty coe),(id,mkCProdN ~loc l c)) } + { fun l id -> (not (Option.is_empty coe),(id,mkProdCN ~loc l c)) } | -> - { fun l id -> (false,(id,mkCProdN ~loc l (CAst.make ~loc @@ CHole (None, IntroAnonymous, None)))) } ] + { fun l id -> (false,(id,mkProdCN ~loc l (CAst.make ~loc @@ CHole (None, IntroAnonymous, None)))) } ] -> { t l } ]] ; diff --git a/vernac/lemmas.ml b/vernac/lemmas.ml index aa9bd20bf3..4f0bf1b5d2 100644 --- a/vernac/lemmas.ml +++ b/vernac/lemmas.ml @@ -533,7 +533,3 @@ let save_proof ?proof = function (* if the proof is given explicitly, nothing has to be deleted *) if Option.is_empty proof then Proof_global.discard_current (); Proof_global.(apply_terminator terminator (Proved (is_opaque,idopt,proof_obj))) - -(* Miscellaneous *) -let get_current_context () = Pfedit.get_current_context () - diff --git a/vernac/lemmas.mli b/vernac/lemmas.mli index 38683ed6b2..62b25946d9 100644 --- a/vernac/lemmas.mli +++ b/vernac/lemmas.mli @@ -67,10 +67,3 @@ val initialize_named_context_for_proof : unit -> Environ.named_context_val val set_save_hook : (Proof.t -> unit) -> unit val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit - -(** [get_current_context ()] returns the evar context and env of the - current open proof if any, otherwise returns the empty evar context - and the current global env *) - -val get_current_context : unit -> Evd.evar_map * Environ.env -[@@ocaml.deprecated "please use [Pfedit.get_current_context]"] diff --git a/vernac/misctypes.ml b/vernac/misctypes.ml deleted file mode 100644 index ef9cd3c351..0000000000 --- a/vernac/misctypes.ml +++ /dev/null @@ -1,75 +0,0 @@ -(* Compat module, to be removed in 8.10 *) -open Names - -type lident = Names.lident -[@@ocaml.deprecated "use [Names.lident"] -type lname = Names.lname -[@@ocaml.deprecated "use [Names.lname]"] -type lstring = Names.lstring -[@@ocaml.deprecated "use [Names.lstring]"] - -type 'a or_by_notation_r = 'a Constrexpr.or_by_notation_r = - | AN of 'a [@ocaml.deprecated "use version in [Constrexpr]"] - | ByNotation of (string * string option) [@ocaml.deprecated "use version in [Constrexpr]"] -[@@ocaml.deprecated "use [Constrexpr.or_by_notation_r]"] - -type 'a or_by_notation = 'a Constrexpr.or_by_notation -[@@ocaml.deprecated "use [Constrexpr.or_by_notation]"] - -type intro_pattern_naming_expr = Namegen.intro_pattern_naming_expr = - | IntroIdentifier of Id.t [@ocaml.deprecated "Use version in [Namegen]"] - | IntroFresh of Id.t [@ocaml.deprecated "Use version in [Namegen]"] - | IntroAnonymous [@ocaml.deprecated "Use version in [Namegen]"] -[@@ocaml.deprecated "use [Namegen.intro_pattern_naming_expr]"] - -type 'a or_var = 'a Locus.or_var = - | ArgArg of 'a [@ocaml.deprecated "Use version in [Locus]"] - | ArgVar of Names.lident [@ocaml.deprecated "Use version in [Locus]"] -[@@ocaml.deprecated "use [Locus.or_var]"] - -type quantified_hypothesis = Tactypes.quantified_hypothesis = - AnonHyp of int [@ocaml.deprecated "Use version in [Tactypes]"] - | NamedHyp of Id.t [@ocaml.deprecated "Use version in [Tactypes]"] -[@@ocaml.deprecated "use [Tactypes.quantified_hypothesis]"] - -type multi = Equality.multi = - | Precisely of int [@ocaml.deprecated "use version in [Equality]"] - | UpTo of int [@ocaml.deprecated "use version in [Equality]"] - | RepeatStar [@ocaml.deprecated "use version in [Equality]"] - | RepeatPlus [@ocaml.deprecated "use version in [Equality]"] -[@@ocaml.deprecated "use [Equality.multi]"] - -type 'a bindings = 'a Tactypes.bindings = - | ImplicitBindings of 'a list [@ocaml.deprecated "use version in [Tactypes]"] - | ExplicitBindings of 'a Tactypes.explicit_bindings [@ocaml.deprecated "use version in [Tactypes]"] - | NoBindings [@ocaml.deprecated "use version in [Tactypes]"] -[@@ocaml.deprecated "use [Tactypes.bindings]"] - -type 'constr intro_pattern_expr = 'constr Tactypes.intro_pattern_expr = - | IntroForthcoming of bool [@ocaml.deprecated "use version in [Tactypes]"] - | IntroNaming of Namegen.intro_pattern_naming_expr [@ocaml.deprecated "use version in [Tactypes]"] - | IntroAction of 'constr Tactypes.intro_pattern_action_expr [@ocaml.deprecated "use version in [Tactypes]"] -and 'constr intro_pattern_action_expr = 'constr Tactypes.intro_pattern_action_expr = - | IntroWildcard [@ocaml.deprecated "use [Tactypes]"] - | IntroOrAndPattern of 'constr Tactypes.or_and_intro_pattern_expr [@ocaml.deprecated "use [Tactypes]"] - | IntroInjection of ('constr intro_pattern_expr) CAst.t list [@ocaml.deprecated "use [Tactypes]"] - | IntroApplyOn of 'constr CAst.t * 'constr intro_pattern_expr CAst.t [@ocaml.deprecated "use [Tactypes]"] - | IntroRewrite of bool [@ocaml.deprecated "use [Tactypes]"] -and 'constr or_and_intro_pattern_expr = 'constr Tactypes.or_and_intro_pattern_expr = - | IntroOrPattern of ('constr intro_pattern_expr) CAst.t list list [@ocaml.deprecated "use [Tactypes]"] - | IntroAndPattern of ('constr intro_pattern_expr) CAst.t list [@ocaml.deprecated "use [Tactypes]"] -[@@ocaml.deprecated "use version in [Tactypes]"] - -type 'id move_location = 'id Logic.move_location = - | MoveAfter of 'id [@ocaml.deprecated "use version in [Logic]"] - | MoveBefore of 'id [@ocaml.deprecated "use version in [Logic]"] - | MoveFirst [@ocaml.deprecated "use version in [Logic]"] - | MoveLast [@ocaml.deprecated "use version in [Logic]"] -[@@ocaml.deprecated "use version in [Logic]"] - -type 'a cast_type = 'a Glob_term.cast_type = - | CastConv of 'a [@ocaml.deprecated "use version in [Glob_term]"] - | CastVM of 'a [@ocaml.deprecated "use version in [Glob_term]"] - | CastCoerce [@ocaml.deprecated "use version in [Glob_term]"] - | CastNative of 'a [@ocaml.deprecated "use version in [Glob_term]"] -[@@ocaml.deprecated "use version in [Glob_term]"] diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 015d5fabef..cf2fecb9c1 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -249,8 +249,7 @@ let print_namespace ns = in let print_list pr l = prlist_with_sep (fun () -> str".") pr l in let print_kn kn = - (* spiwack: I'm ignoring the dirpath, is that bad? *) - let (mp,_,lbl) = Names.KerName.repr kn in + let (mp,lbl) = Names.KerName.repr kn in let qn = (qualified_minus (List.length ns) mp)@[Names.Label.to_id lbl] in print_list Id.print qn in diff --git a/vernac/vernacexpr.ml b/vernac/vernacexpr.ml index a5601d8c85..a2ea706b75 100644 --- a/vernac/vernacexpr.ml +++ b/vernac/vernacexpr.ml @@ -15,14 +15,6 @@ open Libnames (** Vernac expressions, produced by the parser *) type class_rawexpr = FunClass | SortClass | RefClass of qualid or_by_notation -type goal_selector = Goal_select.t = - | SelectAlreadyFocused [@ocaml.deprecated "Use Goal_select.SelectAlreadyFocused"] - | SelectNth of int [@ocaml.deprecated "Use Goal_select.SelectNth"] - | SelectList of (int * int) list [@ocaml.deprecated "Use Goal_select.SelectList"] - | SelectId of Id.t [@ocaml.deprecated "Use Goal_select.SelectId"] - | SelectAll [@ocaml.deprecated "Use Goal_select.SelectAll"] -[@@ocaml.deprecated "Use Goal_select.t"] - type goal_identifier = string type scope_name = string @@ -31,9 +23,6 @@ type goal_reference = | NthGoal of int | GoalId of Id.t -type univ_name_list = UnivNames.univ_name_list -[@@ocaml.deprecated "Use [UnivNames.univ_name_list]"] - type printable = | PrintTables | PrintFullContext @@ -102,54 +91,12 @@ type comment = | CommentString of string | CommentInt of int -type reference_or_constr = Hints.reference_or_constr = - | HintsReference of qualid [@ocaml.deprecated "Use Hints.HintsReference"] - | HintsConstr of constr_expr [@ocaml.deprecated "Use Hints.HintsConstr"] -[@@ocaml.deprecated "Please use [Hints.reference_or_constr]"] - -type hint_mode = Hints.hint_mode = - | ModeInput [@ocaml.deprecated "Use Hints.ModeInput"] - | ModeNoHeadEvar [@ocaml.deprecated "Use Hints.ModeNoHeadEvar"] - | ModeOutput [@ocaml.deprecated "Use Hints.ModeOutput"] -[@@ocaml.deprecated "Please use [Hints.hint_mode]"] - -type 'a hint_info_gen = 'a Typeclasses.hint_info_gen = - { hint_priority : int option; [@ocaml.deprecated "Use Typeclasses.hint_priority"] - hint_pattern : 'a option [@ocaml.deprecated "Use Typeclasses.hint_pattern"] } -[@@ocaml.deprecated "Please use [Typeclasses.hint_info_gen]"] - -type hint_info_expr = Hints.hint_info_expr -[@@ocaml.deprecated "Please use [Hints.hint_info_expr]"] - -type hints_expr = Hints.hints_expr = - | HintsResolve of (Hints.hint_info_expr * bool * Hints.reference_or_constr) list - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsResolveIFF of bool * qualid list * int option - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsImmediate of Hints.reference_or_constr list - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsUnfold of qualid list - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsTransparency of qualid Hints.hints_transparency_target * bool - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsMode of qualid * Hints.hint_mode list - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsConstructors of qualid list - [@ocaml.deprecated "Use the constructor in module [Hints]"] - | HintsExtern of int * constr_expr option * Genarg.raw_generic_argument - [@ocaml.deprecated "Use the constructor in module [Hints]"] -[@@ocaml.deprecated "Please use [Hints.hints_expr]"] - type search_restriction = | SearchInside of qualid list | SearchOutside of qualid list type rec_flag = bool (* true = Rec; false = NoRec *) type verbose_flag = bool (* true = Verbose; false = Silent *) -type opacity_flag = Proof_global.opacity_flag = - Opaque [@ocaml.deprecated "Use Proof_global.Opaque"] - | Transparent [@ocaml.deprecated "Use Proof_global.Transparent"] - [@ocaml.deprecated "Please use [Proof_global.opacity_flag]"] type coercion_flag = bool (* true = AddCoercion false = NoCoercion *) type instance_flag = bool option (* Some true = Backward instance; Some false = Forward instance, None = NoInstance *) @@ -285,33 +232,8 @@ type register_kind = | RegisterInline | RegisterRetroknowledge of qualid -type bullet = Proof_bullet.t -[@@ocaml.deprecated "Alias type, please use [Proof_bullet.t]"] - (** {6 Types concerning the module layer} *) -(** Rigid / flexible module signature *) - -type 'a module_signature = 'a Declaremods.module_signature = - | Enforce of 'a (** ... : T *) - [@ocaml.deprecated "Use the constructor in module [Declaremods]"] - | Check of 'a list (** ... <: T1 <: T2, possibly empty *) - [@ocaml.deprecated "Use the constructor in module [Declaremods]"] -[@@ocaml.deprecated "please use [Declaremods.module_signature]."] - -(** Which module inline annotations should we honor, - either None or the ones whose level is less or equal - to the given integer *) - -type inline = Declaremods.inline = - | NoInline - [@ocaml.deprecated "Use the constructor in module [Declaremods]"] - | DefaultInline - [@ocaml.deprecated "Use the constructor in module [Declaremods]"] - | InlineAt of int - [@ocaml.deprecated "Use the constructor in module [Declaremods]"] -[@@ocaml.deprecated "please use [Declaremods.inline]."] - type module_ast_inl = module_ast * Declaremods.inline type module_binder = bool option * lident list * module_ast_inl |