From 35fba70509d9fb219b2a88f8e7bd246b2671b39b Mon Sep 17 00:00:00 2001
From: Gaëtan Gilbert
Date: Thu, 9 Nov 2017 17:27:58 +0100
Subject: 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 |=  *)
---
 checker/indtypes.ml | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

(limited to 'checker/indtypes.ml')

diff --git a/checker/indtypes.ml b/checker/indtypes.ml
index 4de5977666..1807ae0ecd 100644
--- a/checker/indtypes.ml
+++ b/checker/indtypes.ml
@@ -564,14 +564,23 @@ let check_subtyping cumi paramsctxt env inds =
       We must produce the substitution σ : [ Var(i) -> Var (i + n) | 0 <= i < n]
       and push the constraints [ Var(n) ... Var(2n - 1) |- cst{σ} ], together
       with the cumulativity constraints [ cumul_cst ]. *)
-  let len = AUContext.size (ACumulativityInfo.univ_context cumi) in
-  let inst = Instance.of_array (Array.init len (fun i -> Level.var (i + len))) in
+  let uctx = ACumulativityInfo.univ_context cumi in
+  let len = AUContext.size uctx in
+  let inst = Instance.of_array @@ Array.init len (fun i -> Level.var (i + len)) in
+
   let other_context = ACumulativityInfo.univ_context cumi in
   let uctx_other = UContext.make (inst, AUContext.instantiate inst other_context) in
-  let cumul_context = AUContext.repr (ACumulativityInfo.subtyp_context cumi) in
-  let cumul_cst = UContext.constraints cumul_context in
+  let cumul_cst =
+    Array.fold_left_i (fun i csts var ->
+        match var with
+        | Variance.Irrelevant -> csts
+        | Variance.Covariant -> Constraint.add (Level.var i,Le,Level.var (i+len)) csts
+        | Variance.Invariant -> Constraint.add (Level.var i,Eq,Level.var (i+len)) csts)
+      Constraint.empty (ACumulativityInfo.variance cumi)
+  in
   let env = Environ.push_context uctx_other env in
   let env = Environ.add_constraints cumul_cst env in
+
   (* process individual inductive types: *)
   Array.iter (fun { mind_user_lc = lc; mind_arity = arity } ->
       match arity with
-- 
cgit v1.2.3