diff options
author | Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> | 2018-02-16 15:44:44 +0100 |
---|---|---|
committer | Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> | 2018-03-09 16:29:06 +0100 |
commit | 17a0dccfe91d6f837ce285e62b8d843720f8c1a1 (patch) | |
tree | 605a2dae6692cec6503ab5fcdce7c90421db26f0 /test-suite/success | |
parent | 3d86afb36517c9ba4200289e169239f7fa54fca1 (diff) |
Allow using cumulativity without forcing strict constraints.
Previously [fun x : Ind@{i} => x : Ind@{j}] with Ind some cumulative
inductive would try to generate a constraint [i = j] and use
cumulativity only if this resulted in an inconsistency. This is
confusingly different from the behaviour with [Type] and means
cumulativity can only be used to lift between universes related by
strict inequalities. (This isn't a kernel restriction so there might
be some workaround to send the kernel the right constraints, but
not in a nice way.)
See modified test for more details of what is now possible.
Technical notes:
When universe constraints were inferred by comparing the shape of
terms without reduction, cumulativity was not used and so too-strict
equality constraints were generated. Then in order to use cumulativity
we had to make this comparison fail to fall back to full conversion.
When unifiying 2 instances of a cumulative inductive type, if there
are any Irrelevant universes we try to unify them if they are
flexible.
Diffstat (limited to 'test-suite/success')
-rw-r--r-- | test-suite/success/cumulativity.v | 56 |
1 files changed, 8 insertions, 48 deletions
diff --git a/test-suite/success/cumulativity.v b/test-suite/success/cumulativity.v index 4dda36042..0394ea340 100644 --- a/test-suite/success/cumulativity.v +++ b/test-suite/success/cumulativity.v @@ -10,40 +10,16 @@ Set Printing Universes. Inductive List (A: Type) := nil | cons : A -> List A -> List A. -Section ListLift. - Universe i j. - - Constraint i < j. - - Definition LiftL {A} : List@{i} A -> List@{j} A := fun x => x. - -End ListLift. +Definition LiftL@{k i j|k <= i, k <= j} {A:Type@{k}} : List@{i} A -> List@{j} A := fun x => x. Lemma LiftL_Lem A (l : List A) : l = LiftL l. Proof. reflexivity. Qed. -Section ListLower. - Universe i j. - - Constraint i < j. - - Definition LowerL {A : Type@{i}} : List@{j} A -> List@{i} A := fun x => x. - -End ListLower. - -Lemma LowerL_Lem@{i j} (A : Type@{j}) (l : List@{i} A) : l = LowerL l. -Proof. reflexivity. Qed. - Inductive Tp := tp : Type -> Tp. -Section TpLift. - Universe i j. +Definition LiftTp@{i j|i <= j} : Tp@{i} -> Tp@{j} := fun x => x. - Constraint i < j. - - Definition LiftTp : Tp@{i} -> Tp@{j} := fun x => x. - -End TpLift. +Fail Definition LowerTp@{i j|j < i} : Tp@{i} -> Tp@{j} := fun x => x. Record Tp' := { tp' : Tp }. @@ -51,22 +27,12 @@ Definition CTp := Tp. (* here we have to reduce a constant to infer the correct subtyping. *) Record Tp'' := { tp'' : CTp }. -Definition LiftTp'@{i j|i < j} : Tp'@{i} -> Tp'@{j} := fun x => x. -Definition LiftTp''@{i j|i < j} : Tp''@{i} -> Tp''@{j} := fun x => x. +Definition LiftTp'@{i j|i <= j} : Tp'@{i} -> Tp'@{j} := fun x => x. +Definition LiftTp''@{i j|i <= j} : Tp''@{i} -> Tp''@{j} := fun x => x. Lemma LiftC_Lem (t : Tp) : LiftTp t = t. Proof. reflexivity. Qed. -Section TpLower. - Universe i j. - - Constraint i < j. - - Fail Definition LowerTp : Tp@{j} -> Tp@{i} := fun x => x. - -End TpLower. - - Section subtyping_test. Universe i j. Constraint i < j. @@ -82,14 +48,8 @@ Record B (X : A) : Type := { b : X; }. NonCumulative Inductive NCList (A: Type) := ncnil | nccons : A -> NCList A -> NCList A. -Section NCListLift. - Universe i j. - - Constraint i < j. - - Fail Definition LiftNCL {A} : NCList@{i} A -> NCList@{j} A := fun x => x. - -End NCListLift. +Fail Definition LiftNCL@{k i j|k <= i, k <= j} {A:Type@{k}} + : NCList@{i} A -> NCList@{j} A := fun x => x. Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x. @@ -114,7 +74,7 @@ Fail Definition arrow_lift@{i i' j j' | i' < i, j < j'} : Arrow@{i j} -> Arrow@{i' j'} := fun x => x. -Definition arrow_lift@{i i' j j' | i' = i, j < j'} +Definition arrow_lift@{i i' j j' | i' = i, j <= j'} : Arrow@{i j} -> Arrow@{i' j'} := fun x => x. |