aboutsummaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2016-07-20 22:42:23 +0200
committerPierre-Marie Pédrot2016-07-20 22:42:23 +0200
commit139204928e55f92f02d3b3dd1d6746e34fdcdb88 (patch)
tree0f4824042031fa67499d758a4bc281d86cbf0712 /test-suite
parent9f003b933c2a3504683a84ed817021659e80bc8f (diff)
parent3f08b7e490a9a9b6091f097d1440d3ba042a47c1 (diff)
Merge branch 'v8.6'
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/bugs/closed/2839.v2
-rw-r--r--test-suite/bugs/closed/3383.v6
-rw-r--r--test-suite/bugs/closed/3563.v6
-rw-r--r--test-suite/bugs/closed/4198.v2
-rw-r--r--test-suite/bugs/closed/4780.v106
-rw-r--r--test-suite/bugs/closed/4932.v44
-rw-r--r--test-suite/bugs/closed/HoTT_coq_020.v4
-rw-r--r--test-suite/bugs/closed/HoTT_coq_058.v10
-rw-r--r--test-suite/bugs/opened/3383.v7
-rw-r--r--test-suite/output/Notations2.out2
-rw-r--r--test-suite/output/Notations3.out100
-rw-r--r--test-suite/output/Notations3.v141
-rw-r--r--test-suite/output/PatternsInBinders.out28
-rw-r--r--test-suite/output/PatternsInBinders.v32
-rw-r--r--test-suite/success/Notations.v3
15 files changed, 452 insertions, 41 deletions
diff --git a/test-suite/bugs/closed/2839.v b/test-suite/bugs/closed/2839.v
index e396fe06e5..e727e26061 100644
--- a/test-suite/bugs/closed/2839.v
+++ b/test-suite/bugs/closed/2839.v
@@ -5,6 +5,6 @@ intro.
Fail
let H :=
match goal with
- | [ H : appcontext G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H'
+ | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H'
end
in pose H.
diff --git a/test-suite/bugs/closed/3383.v b/test-suite/bugs/closed/3383.v
new file mode 100644
index 0000000000..25257644a6
--- /dev/null
+++ b/test-suite/bugs/closed/3383.v
@@ -0,0 +1,6 @@
+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/3563.v b/test-suite/bugs/closed/3563.v
index 679721667a..961563ed4a 100644
--- a/test-suite/bugs/closed/3563.v
+++ b/test-suite/bugs/closed/3563.v
@@ -16,11 +16,11 @@ Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0)
transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7.
intros.
match goal with
- | [ |- appcontext ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ]
+ | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ]
=> set(foo:=h); idtac
end.
match goal with
- | [ |- appcontext ctx [transport (fun y => (?g (fst (y H2))))] ]
+ | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ]
=> idtac
end.
Abort.
@@ -30,7 +30,7 @@ Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0)
transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7.
intros.
match goal with
- | [ |- appcontext ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ]
+ | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ]
=> set(foo:=X)
end.
(* Anomaly: Uncaught exception Not_found(_). Please report. *)
diff --git a/test-suite/bugs/closed/4198.v b/test-suite/bugs/closed/4198.v
index f85a60264d..eb37141bcf 100644
--- a/test-suite/bugs/closed/4198.v
+++ b/test-suite/bugs/closed/4198.v
@@ -11,7 +11,7 @@ Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'),
simpl.
intros.
match goal with
- | [ |- appcontext G[@hd] ] => idtac
+ | [ |- context G[@hd] ] => idtac
end.
(* This second example comes from CFGV where inspecting subterms of a
diff --git a/test-suite/bugs/closed/4780.v b/test-suite/bugs/closed/4780.v
new file mode 100644
index 0000000000..4cec43184c
--- /dev/null
+++ b/test-suite/bugs/closed/4780.v
@@ -0,0 +1,106 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-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/4932.v b/test-suite/bugs/closed/4932.v
new file mode 100644
index 0000000000..219d532ac6
--- /dev/null
+++ b/test-suite/bugs/closed/4932.v
@@ -0,0 +1,44 @@
+(* Testing recursive notations with binders seen as terms *)
+
+Inductive ftele : Type :=
+| fb {T:Type} : T -> ftele
+| fr {T} : (T -> ftele) -> ftele.
+
+Fixpoint args ftele : Type :=
+ match ftele with
+ | fb _ => unit
+ | fr f => sigT (fun t => args (f t))
+ end.
+
+Definition fpack := sigT args.
+Definition pack fp fa : fpack := existT _ fp fa.
+
+Notation "'tele' x .. z := b" :=
+ (
+ (fun x => ..
+ (fun z =>
+ pack
+ (fr (fun x => .. ( fr (fun z => fb b) ) .. ) )
+ (existT _ x .. (existT _ z tt) .. )
+ ) ..
+ )
+ ) (at level 85, x binder, z binder).
+
+Check fun '((y,z):nat*nat) => pack (fr (fun '((y,z):nat*nat) => fb tt))
+ (existT _ (y,z) tt).
+
+Example test := tele (t : Type) := tt.
+Example test' := test nat.
+Print test.
+
+Example test2 := tele (t : Type) (x:t) := tt.
+Example test2' := test2 nat 0.
+Print test2.
+
+Example test3 := tele (t : Type) (y:=0) (x:t) := tt.
+Example test3' := test3 nat 0.
+Print test3.
+
+Example test4 := tele (t : Type) '((y,z):nat*nat) (x:t) := tt.
+Example test4' := test4 nat (1,2) 3.
+Print test4.
diff --git a/test-suite/bugs/closed/HoTT_coq_020.v b/test-suite/bugs/closed/HoTT_coq_020.v
index 008fb72c4e..73da464bbe 100644
--- a/test-suite/bugs/closed/HoTT_coq_020.v
+++ b/test-suite/bugs/closed/HoTT_coq_020.v
@@ -22,8 +22,8 @@ Polymorphic Record NaturalTransformation objC C objD D (F G : Functor (objC := o
Ltac present_obj from to :=
match goal with
- | [ _ : appcontext[from ?obj ?C] |- _ ] => progress change (from obj C) with (to obj C) in *
- | [ |- appcontext[from ?obj ?C] ] => progress change (from obj C) with (to obj C) in *
+ | [ _ : context[from ?obj ?C] |- _ ] => progress change (from obj C) with (to obj C) in *
+ | [ |- context[from ?obj ?C] ] => progress change (from obj C) with (to obj C) in *
end.
Section NaturalTransformationComposition.
diff --git a/test-suite/bugs/closed/HoTT_coq_058.v b/test-suite/bugs/closed/HoTT_coq_058.v
index 5e5d5ab3e7..3d16e7ac0d 100644
--- a/test-suite/bugs/closed/HoTT_coq_058.v
+++ b/test-suite/bugs/closed/HoTT_coq_058.v
@@ -95,10 +95,10 @@ Goal forall (T : Type) (T0 : T -> T -> Type)
| tt => idpath
end)) (x1; p) = (x1; p).
intros.
-let F := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(F) end in
-let H := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(H) end in
-let X := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(X) end in
-let T := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(T) end in
+let F := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(F) end in
+let H := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(H) end in
+let X := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(X) end in
+let T := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(T) end in
let t0 := fresh "t0" in
let t1 := fresh "t1" in
let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in
@@ -116,7 +116,7 @@ let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in
let GL1' := fresh in
set (GL0' := GL0);
- let arg := match GL0 with appcontext[x0 ?arg] => constr:(arg) end in
+ let arg := match GL0 with context[x0 ?arg] => constr:(arg) end in
assert (t1 = arg) by (subst t1; reflexivity); subst t1;
pattern (x0 arg) in GL0';
match goal with
diff --git a/test-suite/bugs/opened/3383.v b/test-suite/bugs/opened/3383.v
deleted file mode 100644
index 9a14641a57..0000000000
--- a/test-suite/bugs/opened/3383.v
+++ /dev/null
@@ -1,7 +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.
-Fail lazymatch goal with
-| [ |- appcontext[match ?b as b' return @?P b' with true => ?t | false => ?f end] ]
- => change (match b as b' return P b with true => t | false => f end) with (@bool_rect P t f)
-end. (* Toplevel input, characters 153-154:
-Error: The reference P was not found in the current environment. *)
diff --git a/test-suite/output/Notations2.out b/test-suite/output/Notations2.out
index d9ce42c606..20101f48e5 100644
--- a/test-suite/output/Notations2.out
+++ b/test-suite/output/Notations2.out
@@ -12,7 +12,7 @@ let '(a, _, _) := (2, 3, 4) in a
: nat
exists myx y : bool, myx = y
: Prop
-fun (P : nat -> nat -> Prop) (x : nat) => exists x0, P x x0
+fun (P : nat -> nat -> Prop) (x : nat) => exists y, P x y
: (nat -> nat -> Prop) -> nat -> Prop
∃ n p : nat, n + p = 0
: Prop
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
new file mode 100644
index 0000000000..360f379676
--- /dev/null
+++ b/test-suite/output/Notations3.out
@@ -0,0 +1,100 @@
+[<0, 2 >]
+ : nat * nat * (nat * nat)
+[<0, 2 >]
+ : nat * nat * (nat * nat)
+(0, 2, (2, 2))
+ : nat * nat * (nat * nat)
+pair (pair O (S (S O))) (pair (S (S O)) O)
+ : prod (prod nat nat) (prod nat nat)
+<< 0, 2, 4 >>
+ : nat * nat * nat * (nat * (nat * nat))
+<< 0, 2, 4 >>
+ : nat * nat * nat * (nat * (nat * nat))
+(0, 2, 4, (2, (2, 0)))
+ : nat * nat * nat * (nat * (nat * nat))
+(0, 2, 4, (0, (2, 4)))
+ : nat * nat * nat * (nat * (nat * nat))
+pair (pair (pair O (S (S O))) (S (S (S (S O)))))
+ (pair (S (S (S (S O)))) (pair (S (S O)) O))
+ : prod (prod (prod nat nat) nat) (prod nat (prod nat nat))
+ETA x y : nat, Nat.add
+ : nat -> nat -> nat
+ETA x y : nat, Nat.add
+ : nat -> nat -> nat
+ETA x y : nat, Nat.add
+ : nat -> nat -> nat
+fun x y : nat => Nat.add x y
+ : forall (_ : nat) (_ : nat), nat
+ETA x y : nat, le_S
+ : forall x y : nat, x <= y -> x <= S y
+fun f : forall x : nat * (bool * unit), ?T => CURRY (x : nat) (y : bool), f
+ : (forall x : nat * (bool * unit), ?T) ->
+ forall (x : nat) (y : bool), ?T@{x:=(x, (y, tt))}
+where
+?T : [x : nat * (bool * unit) |- Type]
+fun f : forall x : bool * (nat * unit), ?T =>
+CURRYINV (x : nat) (y : bool), f
+ : (forall x : bool * (nat * unit), ?T) ->
+ forall (x : nat) (y : bool), ?T@{x:=(y, (x, tt))}
+where
+?T : [x : bool * (nat * unit) |- Type]
+fun f : forall x : unit * nat * bool, ?T => CURRYLEFT (x : nat) (y : bool), f
+ : (forall x : unit * nat * bool, ?T) ->
+ forall (x : nat) (y : bool), ?T@{x:=(tt, x, y)}
+where
+?T : [x : unit * nat * bool |- Type]
+fun f : forall x : unit * bool * nat, ?T =>
+CURRYINVLEFT (x : nat) (y : bool), f
+ : (forall x : unit * bool * nat, ?T) ->
+ forall (x : nat) (y : bool), ?T@{x:=(tt, y, x)}
+where
+?T : [x : unit * bool * nat |- Type]
+forall n : nat, {#n | 1 > n}
+ : Prop
+forall x : nat, {|x | x > 0|}
+ : Prop
+exists2 x : nat, x = 1 & x = 2
+ : Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + z = 0) z y x)
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun a b c : nat => (fun _ _ _ : nat => a + b + c = 0) c b a)
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun n0 y z : nat => (fun _ _ _ : nat => n0 + y + z = 0) z y n0)
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun x n0 z : nat => (fun _ _ _ : nat => x + n0 + z = 0) z n0 x)
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y n0 : nat => (fun _ _ _ : nat => x + y + n0 = 0) n0 y x)
+ : nat -> Prop
+fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2
+ : nat -> Prop
+fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2
+ : nat -> Prop
+fun n : nat => {|n, n0 | fun _ _ _ : nat => n + n0 = 0 |}_2
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x)
+ : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x)
+ : nat -> Prop
+fun n : nat => {|n, fun _ : nat => 0 = 0 |}_3
+ : nat -> Prop
+fun n : nat => {|n, fun _ : nat => n = 0 |}_3
+ : nat -> Prop
+fun n : nat => foo3 n (fun x _ : nat => ETA z : nat, (fun _ : nat => x = 0))
+ : nat -> Prop
+fun n : nat => {|n, fun _ : nat => 0 = 0 |}_4
+ : nat -> Prop
+fun n : nat => {|n, fun _ : nat => n = 0 |}_4
+ : nat -> Prop
+fun n : nat => foo4 n (fun _ _ : nat => ETA z : nat, (fun _ : nat => z = 0))
+ : nat -> Prop
+fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, (fun _ : nat => y = 0))
+ : nat -> Prop
+tele (t : Type) '(y, z) (x : t0) := tt
+ : forall t : Type, nat * nat -> t -> fpack
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
new file mode 100644
index 0000000000..4b8bfe3124
--- /dev/null
+++ b/test-suite/output/Notations3.v
@@ -0,0 +1,141 @@
+(**********************************************************************)
+(* Check printing of notations with several instances of a recursive pattern *)
+(* Was wrong but I could not trigger a problem due to the collision between *)
+(* different instances of ".." *)
+
+Notation "[< x , y , .. , z >]" := (pair (.. (pair x y) ..) z,pair y ( .. (pair z x) ..)).
+Check [<0,2>].
+Check ((0,2),(2,0)).
+Check ((0,2),(2,2)).
+Unset Printing Notations.
+Check [<0,2>].
+Set Printing Notations.
+
+Notation "<< x , y , .. , z >>" := ((.. (x,y) .., z),(z, .. (y,x) ..)).
+Check <<0,2,4>>.
+Check (((0,2),4),(4,(2,0))).
+Check (((0,2),4),(2,(2,0))).
+Check (((0,2),4),(0,(2,4))).
+Unset Printing Notations.
+Check <<0,2,4>>.
+Set Printing Notations.
+
+(**********************************************************************)
+(* Check notations with recursive notations both in binders and terms *)
+
+Notation "'ETA' x .. y , f" :=
+ (fun x => .. (fun y => (.. (f x) ..) y ) ..)
+ (at level 200, x binder, y binder).
+Check ETA (x:nat) (y:nat), Nat.add.
+Check ETA (x y:nat), Nat.add.
+Check ETA x y, Nat.add.
+Unset Printing Notations.
+Check ETA (x:nat) (y:nat), Nat.add.
+Set Printing Notations.
+Check ETA x y, le_S.
+
+Notation "'CURRY' x .. y , f" := (fun x => .. (fun y => f (x, .. (y,tt) ..)) ..)
+ (at level 200, x binder, y binder).
+Check fun f => CURRY (x:nat) (y:bool), f.
+
+Notation "'CURRYINV' x .. y , f" := (fun x => .. (fun y => f (y, .. (x,tt) ..)) ..)
+ (at level 200, x binder, y binder).
+Check fun f => CURRYINV (x:nat) (y:bool), f.
+
+Notation "'CURRYLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,x) .., y)) ..)
+ (at level 200, x binder, y binder).
+Check fun f => CURRYLEFT (x:nat) (y:bool), f.
+
+Notation "'CURRYINVLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,y) .., x)) ..)
+ (at level 200, x binder, y binder).
+Check fun f => CURRYINVLEFT (x:nat) (y:bool), f.
+
+(**********************************************************************)
+(* Notations with variables bound both as a term and as a binder *)
+(* This is #4592 *)
+
+Notation "{# x | P }" := (ex2 (fun y => x = y) (fun x => P)).
+Check forall n:nat, {# n | 1 > n}.
+
+Parameter foo : forall {T}(x : T)(P : T -> Prop), Prop.
+Notation "{| x | P |}" := (foo x (fun x => P)).
+Check forall x:nat, {| x | x > 0 |}.
+
+Check ex2 (fun x => x=1) (fun x0 => x0=2).
+
+(* Other tests about alpha-conversions: the following notation
+ contains all three kinds of bindings:
+
+ - x is bound in the lhs as a term and a binder: its name is forced
+ by its position as a term; it can bind variables in P
+ - y is bound in the lhs as a binder only: its name is given by its
+ name as a binder in the term to display; it can bind variables in P
+ - z is a binder local to the rhs; it cannot bind a variable in P
+*)
+
+Parameter foo2 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , y | P |}_2" := (foo2 x (fun x y z => P z y x)).
+
+(* Not printable: z (resp c, n) occurs in P *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+z=0) z y x).
+Check fun n => foo2 n (fun a b c => (fun _ _ _ => a+b+c=0) c b a).
+Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y+z=0) z y n).
+Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n+z=0) z n x).
+Check fun n => foo2 n (fun x y n => (fun _ _ _ => x+y+n=0) n y x).
+
+(* Printable *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y=0) z y x).
+Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y=0) z y n).
+Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n=0) z n x).
+
+(* Not printable: renaming x into n would bind the 2nd occurrence of n *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x).
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x).
+
+(* Other tests *)
+Parameter foo3 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , P |}_3" := (foo3 x (fun x x x => P x)).
+
+(* Printable *)
+Check fun n : nat => foo3 n (fun x y z => (fun _ => 0=0) z).
+Check fun n => foo3 n (fun x y z => (fun _ => z=0) z).
+
+(* Not printable: renaming z in n would hide the renaming of x into n *)
+Check fun n => foo3 n (fun x y z => (fun _ => x=0) z).
+
+(* Other tests *)
+Parameter foo4 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , P |}_4" := (foo4 x (fun x _ z => P z)).
+
+(* Printable *)
+Check fun n : nat => foo4 n (fun x y z => (fun _ => 0=0) z).
+Check fun n => foo4 n (fun x y z => (fun _ => x=0) z).
+
+(* Not printable: y, z not allowed to occur in P *)
+Check fun n => foo4 n (fun x y z => (fun _ => z=0) z).
+Check fun n => foo4 n (fun x y z => (fun _ => y=0) z).
+
+(**********************************************************************)
+(* Test printing of #4932 *)
+
+Inductive ftele : Type :=
+| fb {T:Type} : T -> ftele
+| fr {T} : (T -> ftele) -> ftele.
+
+Fixpoint args ftele : Type :=
+ match ftele with
+ | fb _ => unit
+ | fr f => sigT (fun t => args (f t))
+ end.
+
+Definition fpack := sigT args.
+Definition pack fp fa : fpack := existT _ fp fa.
+
+Notation "'tele' x .. z := b" :=
+ (fun x => .. (fun z =>
+ pack (fr (fun x => .. ( fr (fun z => fb b) ) .. ) )
+ (existT _ x .. (existT _ z tt) .. )
+ ) ..)
+ (at level 85, x binder, z binder).
+
+Check tele (t:Type) '((y,z):nat*nat) (x:t) := tt.
diff --git a/test-suite/output/PatternsInBinders.out b/test-suite/output/PatternsInBinders.out
index 6a28475d7b..c012a86b01 100644
--- a/test-suite/output/PatternsInBinders.out
+++ b/test-suite/output/PatternsInBinders.out
@@ -4,28 +4,36 @@ fun '(x, y) => (y, x)
: A * B -> B * A
forall '(x, y), swap (x, y) = (y, x)
: Prop
-proj_informative = fun 'exist _ x _ => x : A
+proj_informative = fun '(exist _ x _) => x : A
: {x : A | P x} -> A
-foo = fun 'Bar n b tt p => if b then n + p else n - p
+foo = fun '(Bar n b tt p) => if b then n + p else n - p
: Foo -> nat
baz =
-fun 'Bar n1 _ tt p1 => fun 'Bar _ _ tt _ => n1 + p1
+fun '(Bar n1 _ tt p1) '(Bar _ _ tt _) => n1 + p1
: Foo -> Foo -> nat
-λ '(x, y), (y, x)
- : A * B → B * A
-∀ '(x, y), swap (x, y) = (y, x)
- : Prop
swap =
-fun (A B : Type) (pat : A * B) => let '(x, y) := pat in (y, x)
+fun (A B : Type) '(x, y) => (y, x)
: forall A B : Type, A * B -> B * A
Arguments A, B are implicit and maximally inserted
Argument scopes are [type_scope type_scope _]
-forall (A B : Type) (pat : A * B), let '(x, y) := pat in swap (x, y) = (y, x)
+fun (A B : Type) '(x, y) => swap (x, y) = (y, x)
+ : forall A B : Type, A * B -> Prop
+forall (A B : Type) '(x, y), swap (x, y) = (y, x)
+ : Prop
+exists '(x, y), swap (x, y) = (y, x)
: Prop
-exists pat : A * A, let '(x, y) := pat in swap (x, y) = (y, x)
+exists '(x, y) '(z, w), swap (x, y) = (z, w)
+ : Prop
+λ '(x, y), (y, x)
+ : A * B → B * A
+∀ '(x, y), swap (x, y) = (y, x)
: Prop
both_z =
fun pat : nat * nat =>
let '(n, p) as pat0 := pat return (F pat0) in (Z n, Z p) : F (n, p)
: forall pat : nat * nat, F pat
+fun '(x, y) '(z, t) => swap (x, y) = (z, t)
+ : A * B -> B * A -> Prop
+forall '(x, y) '(z, t), swap (x, y) = (z, t)
+ : Prop
diff --git a/test-suite/output/PatternsInBinders.v b/test-suite/output/PatternsInBinders.v
index 8911909abc..b5c91e347b 100644
--- a/test-suite/output/PatternsInBinders.v
+++ b/test-suite/output/PatternsInBinders.v
@@ -21,7 +21,20 @@ Print foo.
Definition baz '(Bar n1 b1 tt p1) '(Bar n2 b2 tt p2) := n1+p1.
Print baz.
-(** Some test involving unicode noations. *)
+Module WithParameters.
+
+Definition swap {A B} '((x,y) : A*B) := (y,x).
+Print swap.
+
+Check fun (A B:Type) '((x,y) : A*B) => swap (x,y) = (y,x).
+Check forall (A B:Type) '((x,y) : A*B), swap (x,y) = (y,x).
+
+Check exists '((x,y):A*A), swap (x,y) = (y,x).
+Check exists '((x,y):A*A) '(z,w), swap (x,y) = (z,w).
+
+End WithParameters.
+
+(** Some test involving unicode notations. *)
Module WithUnicode.
Require Import Coq.Unicode.Utf8.
@@ -31,24 +44,21 @@ Module WithUnicode.
End WithUnicode.
-
(** * Suboptimal printing *)
-(** These tests show examples which expose the [let] introduced by
- the pattern notation in binders. *)
-
Module Suboptimal.
-Definition swap {A B} '((x,y) : A*B) := (y,x).
-Print swap.
-
-Check forall (A B:Type) '((x,y) : A*B), swap (x,y) = (y,x).
-
-Check exists '((x,y):A*A), swap (x,y) = (y,x).
+(** This test shows an example which exposes the [let] introduced by
+ the pattern notation in binders. *)
Inductive Fin (n:nat) := Z : Fin n.
Definition F '(n,p) : Type := (Fin n * Fin p)%type.
Definition both_z '(n,p) : F (n,p) := (Z _,Z _).
Print both_z.
+(** These tests show examples which do not factorize binders *)
+
+Check fun '((x,y) : A*B) '(z,t) => swap (x,y) = (z,t).
+Check forall '(x,y) '((z,t) : B*A), swap (x,y) = (z,t).
+
End Suboptimal.
diff --git a/test-suite/success/Notations.v b/test-suite/success/Notations.v
index b72a067407..2f7c62972a 100644
--- a/test-suite/success/Notations.v
+++ b/test-suite/success/Notations.v
@@ -107,3 +107,6 @@ Notation traverse_var f l := (traverse (fun l => f l) l).
Notation "'intros' x" := (S x) (at level 0).
Goal True -> True. intros H. exact H. Qed.
+
+(* Check absence of collision on ".." in nested notations with ".." *)
+Notation "[ a , .. , b ]" := (a, (.. (b,tt) ..)).