aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel
diff options
context:
space:
mode:
authorGravatar Maxime Dénès <mail@maximedenes.fr>2018-02-21 18:53:56 +0100
committerGravatar Maxime Dénès <mail@maximedenes.fr>2018-02-21 18:53:56 +0100
commit6ee9f47718fa9929de4d8e724d9df6d389ea9dc8 (patch)
tree99651982cd8f5c20ebc86a2124297af72884e97d /kernel
parentaec63ba9c8f6840d98ba731640a786138d836343 (diff)
parentd50cee3fa401246061c106248b749be03e108298 (diff)
Merge PR #6740: Adding a sanity check on inductive variance subtyping.
Diffstat (limited to 'kernel')
-rw-r--r--kernel/subtyping.ml9
-rw-r--r--kernel/univ.ml7
-rw-r--r--kernel/univ.mli3
3 files changed, 19 insertions, 0 deletions
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index d0d5cb1d5..e95d5d2b5 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -118,6 +118,15 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
let env = check_polymorphic_instance error env auctx auctx' in
env, Univ.make_abstract_instance auctx'
| Cumulative_ind cumi, Cumulative_ind cumi' ->
+ (** Currently there is no way to control variance of inductive types, but
+ just in case we require that they are in a subtyping relation. *)
+ let () =
+ let v = ACumulativityInfo.variance cumi in
+ let v' = ACumulativityInfo.variance cumi' in
+ if not (Array.for_all2 Variance.check_subtype v' v) then
+ CErrors.anomaly Pp.(str "Variance of " ++ KerName.print kn1 ++
+ str " is not compatible with the one of " ++ KerName.print kn2)
+ in
let auctx = Univ.ACumulativityInfo.univ_context cumi in
let auctx' = Univ.ACumulativityInfo.univ_context cumi' in
let env = check_polymorphic_instance error env auctx auctx' in
diff --git a/kernel/univ.ml b/kernel/univ.ml
index fbb047364..c42b66749 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -759,6 +759,13 @@ struct
| Invariant, _ | _, Invariant -> Invariant
| Covariant, Covariant -> Covariant
+ let check_subtype x y = match x, y with
+ | (Irrelevant | Covariant | Invariant), Irrelevant -> true
+ | Irrelevant, Covariant -> false
+ | (Covariant | Invariant), Covariant -> true
+ | (Irrelevant | Covariant), Invariant -> false
+ | Invariant, Invariant -> true
+
let pr = function
| Irrelevant -> str "*"
| Covariant -> str "+"
diff --git a/kernel/univ.mli b/kernel/univ.mli
index c45ebe21c..74d1bfd3a 100644
--- a/kernel/univ.mli
+++ b/kernel/univ.mli
@@ -253,6 +253,9 @@ sig
A'] as opposed to [A' <= A]. *)
type t = Irrelevant | Covariant | Invariant
+ (** [check_subtype x y] holds if variance [y] is also an instance of [x] *)
+ val check_subtype : t -> t -> bool
+
val sup : t -> t -> t
val pr : t -> Pp.t