aboutsummaryrefslogtreecommitdiffhomepage
path: root/checker/univ.ml
diff options
context:
space:
mode:
authorGravatar Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net>2017-11-09 17:27:58 +0100
committerGravatar Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net>2018-02-10 01:34:19 +0100
commit35fba70509d9fb219b2a88f8e7bd246b2671b39b (patch)
tree21cdb9aa905ef8f6375aa6cd119254794233d0ac /checker/univ.ml
parent10d3d803e6b57024dd15df7d61670ce42260948a (diff)
Simplification: cumulativity information is variance information.
Since cumulativity of an inductive type is the universe constraints which make a term convertible with its universe-renamed copy, the only constraints we can get are between a universe and its copy. As such we do not need to be able to represent arbitrary constraints between universes and copied universes in a double-sized ucontext, instead we can just keep around an array describing whether a bound universe is covariant, invariant or irrelevant (CIC has no contravariant conversion rule). Printing is fairly obtuse and should be improved: when we print the CumulativityInfo we add marks to the universes of the instance: = for invariant, + for covariant and * for irrelevant. ie Record Foo@{i j k} := { foo : Type@{i} -> Type@{j} }. Print Foo. gives Cumulative Record Foo : Type@{max(i+1, j+1)} := Build_Foo { foo : Type@{i} -> Type@{j} } (* =i +j *k |= *)
Diffstat (limited to 'checker/univ.ml')
-rw-r--r--checker/univ.ml34
1 files changed, 32 insertions, 2 deletions
diff --git a/checker/univ.ml b/checker/univ.ml
index 7d01657df..46b3ce680 100644
--- a/checker/univ.ml
+++ b/checker/univ.ml
@@ -1003,12 +1003,42 @@ end
type abstract_universe_context = AUContext.t
+module Variance =
+struct
+ (** A universe position in the instance given to a cumulative
+ inductive can be the following. Note there is no Contravariant
+ case because [forall x : A, B <= forall x : A', B'] requires [A =
+ A'] as opposed to [A' <= A]. *)
+ type t = Irrelevant | Covariant | Invariant
+
+ let leq_constraint csts variance u u' =
+ match variance with
+ | Irrelevant -> csts
+ | Covariant -> Constraint.add (u, Le, u') csts
+ | Invariant -> Constraint.add (u, Eq, u') csts
+
+ let eq_constraint csts variance u u' =
+ match variance with
+ | Irrelevant -> csts
+ | Covariant | Invariant -> Constraint.add (u, Eq, u') csts
+
+ let leq_constraints variance u u' csts =
+ let len = Array.length u in
+ assert (len = Array.length u' && len = Array.length variance);
+ Array.fold_left3 leq_constraint csts variance u u'
+
+ let eq_constraints variance u u' csts =
+ let len = Array.length u in
+ assert (len = Array.length u' && len = Array.length variance);
+ Array.fold_left3 eq_constraint csts variance u u'
+end
+
module CumulativityInfo =
struct
- type t = universe_context * universe_context
+ type t = universe_context * Variance.t array
let univ_context (univcst, subtypcst) = univcst
- let subtyp_context (univcst, subtypcst) = subtypcst
+ let variance (univs, variance) = variance
end