diff options
| author | Enrico Tassi | 2018-10-08 10:29:58 +0200 |
|---|---|---|
| committer | Enrico Tassi | 2018-10-08 10:29:58 +0200 |
| commit | 39248aecd9211dde66d80b312b5b66c8fd45cfa4 (patch) | |
| tree | c00056e19b05bffb4243b81cdcf61b0e3132ae6b | |
| parent | cbbd19eb3d9740063e900463f6406ba0a144c96a (diff) | |
| parent | d19372209eca556bb07116b518d8740ff6385035 (diff) | |
Merge PR #8630: Some cleaning in the test suite
1277 files changed, 18730 insertions, 18436 deletions
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/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/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/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" +*) |
