aboutsummaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/success/intros.v26
-rw-r--r--test-suite/success/vm_univ_poly.v (renamed from test-suite/kernel/vm-univ.v)50
-rw-r--r--test-suite/success/vm_univ_poly_match.v28
3 files changed, 67 insertions, 37 deletions
diff --git a/test-suite/success/intros.v b/test-suite/success/intros.v
index 741f372ff2..11156aa0ee 100644
--- a/test-suite/success/intros.v
+++ b/test-suite/success/intros.v
@@ -34,47 +34,53 @@ intros _ ?.
exact H.
Qed.
-(* A short test about introduction pattern pat/c *)
+(* A short test about introduction pattern pat%c *)
Goal (True -> 0=0) -> True /\ False -> 0=0.
-intros H (H1/H,_).
+intros H (H1%H,_).
exact H1.
Qed.
(* A test about bugs in 8.5beta2 *)
Goal (True -> 0=0) -> True /\ False -> False -> 0=0.
intros H H0 H1.
-destruct H0 as (a/H,_).
+destruct H0 as (a%H,_).
(* Check that H0 is removed (was bugged in 8.5beta2) *)
Fail clear H0.
-(* Check position of newly created hypotheses when using pat/c (was
+(* Check position of newly created hypotheses when using pat%c (was
left at top in 8.5beta2) *)
match goal with H:_ |- _ => clear H end. (* clear H1:False *)
match goal with H:_ |- _ => exact H end. (* check that next hyp shows 0=0 *)
Qed.
Goal (True -> 0=0) -> True -> 0=0.
-intros H H1/H.
+intros H H1%H.
exact H1.
Qed.
Goal forall n, n = S n -> 0=0.
-intros n H/n_Sn.
+intros n H%n_Sn.
destruct H.
Qed.
(* Another check about generated names and cleared hypotheses with
- pat/c patterns *)
+ pat%c patterns *)
Goal (True -> 0=0 /\ 1=1) -> True -> 0=0.
-intros H (H1,?)/H.
+intros H (H1,?)%H.
change (1=1) in H0.
exact H1.
Qed.
-(* Checking iterated pat/c1.../cn introduction patterns and side conditions *)
+(* Checking iterated pat%c1...%cn introduction patterns and side conditions *)
Goal forall A B C D:Prop, (A -> B -> C) -> (C -> D) -> B -> A -> D.
intros * H H0 H1.
-intros H2/H/H0.
+intros H2%H%H0.
- exact H2.
- exact H1.
Qed.
+
+(* Bug found by Enrico *)
+
+Goal forall x : nat, True.
+intros y%(fun x => x).
+Abort.
diff --git a/test-suite/kernel/vm-univ.v b/test-suite/success/vm_univ_poly.v
index 1bdba3c68d..58fa39743d 100644
--- a/test-suite/kernel/vm-univ.v
+++ b/test-suite/success/vm_univ_poly.v
@@ -37,32 +37,30 @@ Definition _4 : sumbool_copy x = x :=
@eq_refl _ x <: sumbool_copy x = x.
(* Polymorphic Inductive Types *)
-Polymorphic Inductive poption (T : Type@{i}) : Type@{i} :=
+Polymorphic Inductive poption@{i} (T : Type@{i}) : Type@{i} :=
| PSome : T -> poption@{i} T
| PNone : poption@{i} T.
-Polymorphic Definition poption_default {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
+Polymorphic Definition poption_default@{i} {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
match p with
| @PSome _ y => y
| @PNone _ => x
end.
-Polymorphic Inductive plist (T : Type@{i}) : Type@{i} :=
+Polymorphic Inductive plist@{i} (T : Type@{i}) : Type@{i} :=
| pnil
| pcons : T -> plist@{i} T -> plist@{i} T.
Arguments pnil {_}.
Arguments pcons {_} _ _.
-Section pmap.
- Context {T : Type@{i}} {U : Type@{j}} (f : T -> U).
-
- Polymorphic Fixpoint pmap (ls : plist@{i} T) : plist@{j} U :=
+Polymorphic Definition pmap@{i j}
+ {T : Type@{i}} {U : Type@{j}} (f : T -> U) :=
+ fix pmap (ls : plist@{i} T) : plist@{j} U :=
match ls with
| @pnil _ => @pnil _
| @pcons _ l ls => @pcons@{j} U (f l) (pmap@{i j} ls)
end.
-End pmap.
Universe Ubool.
Inductive tbool : Type@{Ubool} := ttrue | tfalse.
@@ -75,59 +73,57 @@ Eval vm_compute in pmap (fun x => match x with
end) (pcons pnil (pcons (pcons false pnil) pnil)).
Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) pnil)).
-Polymorphic Inductive Tree (T : Type@{i}) : Type@{i} :=
+Polymorphic Inductive Tree@{i} (T : Type@{i}) : Type@{i} :=
| Empty
| Branch : plist@{i} (Tree@{i} T) -> Tree@{i} T.
-Section pfold.
- Context {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U).
-
- Polymorphic Fixpoint pfold (acc : U) (ls : plist@{i} T) : U :=
+Polymorphic Definition pfold@{i u}
+ {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U) :=
+ fix pfold (acc : U) (ls : plist@{i} T) : U :=
match ls with
| pnil => acc
| pcons a b => pfold (f a acc) b
end.
-End pfold.
-Polymorphic Inductive nat : Type@{i} :=
+Polymorphic Inductive nat@{i} : Type@{i} :=
| O
| S : nat -> nat.
-Fixpoint nat_max (a b : nat) : nat :=
+Polymorphic Fixpoint nat_max@{i} (a b : nat@{i}) : nat@{i} :=
match a , b with
| O , b => b
| a , O => a
| S a , S b => S (nat_max a b)
end.
-Polymorphic Fixpoint height {T : Type@{i}} (t : Tree@{i} T) : nat :=
- match t with
+Polymorphic Fixpoint height@{i} {T : Type@{i}} (t : Tree@{i} T) : nat@{i} :=
+ match t return nat@{i} with
| Empty _ => O
- | Branch _ ls => S (pfold nat_max O (pmap height ls))
+ | Branch _ ls => S@{i} (pfold@{i i} nat_max O (pmap height ls))
end.
-Polymorphic Fixpoint repeat {T : Type@{i}} (n : nat) (v : T) : plist@{i} T :=
- match n with
+Polymorphic Fixpoint repeat@{i} {T : Type@{i}} (n : nat@{i}) (v : T) : plist@{i} T :=
+ match n return plist@{i} T with
| O => pnil
- | S n => pcons v (repeat n v)
+ | S n => pcons@{i} v (repeat n v)
end.
-Polymorphic Fixpoint big_tree (n : nat) : Tree@{i} nat :=
+Polymorphic Fixpoint big_tree@{i} (n : nat@{i}) : Tree@{i} nat@{i} :=
match n with
- | O => @Empty nat
- | S n' => Branch _ (repeat n' (big_tree n'))
+ | O => @Empty nat@{i}
+ | S n' => Branch@{i} nat@{i} (repeat@{i} n' (big_tree@{i} n'))
end.
Eval compute in height (big_tree (S (S (S O)))).
Let big := S (S (S (S (S O)))).
-Polymorphic Definition really_big := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))).
+Polymorphic Definition really_big@{i} := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))).
Time Definition _5 : height (@Empty nat) = O :=
@eq_refl nat O <: height (@Empty nat) = O.
Time Definition _6 : height@{Set} (@Branch nat pnil) = S O :=
- @eq_refl nat@{Set} (S@{Set} O@{Set}) <: height@{Set} (@Branch nat pnil) = S O.
+ @eq_refl nat@{Set} (S@{Set} O@{Set}) <: @eq nat@{Set} (height@{Set} (@Branch@{Set} nat@{Set} (@pnil@{Set} (Tree@{Set} nat@{Set})))) (S@{Set} O@{Set}).
Time Definition _7 : height (big_tree big) = big :=
@eq_refl nat big <: height (big_tree big) = big.
diff --git a/test-suite/success/vm_univ_poly_match.v b/test-suite/success/vm_univ_poly_match.v
new file mode 100644
index 0000000000..abe6d0fe07
--- /dev/null
+++ b/test-suite/success/vm_univ_poly_match.v
@@ -0,0 +1,28 @@
+Set Dump Bytecode.
+Set Printing Universes.
+Set Printing All.
+
+Polymorphic Class Applicative@{d c} (T : Type@{d} -> Type@{c}) :=
+{ pure : forall {A : Type@{d}}, A -> T A
+ ; ap : forall {A B : Type@{d}}, T (A -> B) -> T A -> T B
+}.
+
+Universes Uo Ua.
+
+Eval compute in @pure@{Uo Ua}.
+
+Global Instance Applicative_option : Applicative@{Uo Ua} option :=
+{| pure := @Some
+ ; ap := fun _ _ f x =>
+ match f , x with
+ | Some f , Some x => Some (f x)
+ | _ , _ => None
+ end
+|}.
+
+Definition foo := ap (ap (pure plus) (pure 1)) (pure 1).
+
+Print foo.
+
+
+Eval vm_compute in foo.