diff options
| author |  Maxime Dénès <mail@maximedenes.fr> | 2018-02-21 18:53:56 +0100 |
|---|---|---|
| committer | Maxime Dénès <mail@maximedenes.fr> | 2018-02-21 18:53:56 +0100 |
| commit | 6ee9f47718fa9929de4d8e724d9df6d389ea9dc8 (patch) | |
| tree | 99651982cd8f5c20ebc86a2124297af72884e97d /kernel | |
| parent | aec63ba9c8f6840d98ba731640a786138d836343 (diff) | |
| parent | d50cee3fa401246061c106248b749be03e108298 (diff) | |
Merge PR #6740: Adding a sanity check on inductive variance subtyping.
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/subtyping.ml | 9 | ||||
| -rw-r--r-- | kernel/univ.ml | 7 | ||||
| -rw-r--r-- | kernel/univ.mli | 3 |
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 |