aboutsummaryrefslogtreecommitdiff
path: root/kernel/cooking.ml
diff options
context:
space:
mode:
authorMaxime Dénès2017-07-13 15:05:48 +0200
committerMaxime Dénès2017-07-13 15:05:48 +0200
commite3eb17a728d7b6874e67462e8a83fac436441872 (patch)
treec7932e27be16f4d2c20da8d61c3a61b101be7f70 /kernel/cooking.ml
parent9427b99b167842bc4a831def815c4824030d518f (diff)
parent95d65ae4ec8c01f0b8381dfa7029bb32a552bcb0 (diff)
Merge PR #870: Prepare De Bruijn universe abstractions, Episode I: Kernel
Diffstat (limited to 'kernel/cooking.ml')
-rw-r--r--kernel/cooking.ml13
1 files changed, 7 insertions, 6 deletions
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index b9e7ec1691..95822fac68 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -184,13 +184,14 @@ let lift_univs cb subst =
if (Univ.LMap.is_empty subst) then
subst, (Polymorphic_const auctx)
else
- let inst = Univ.AUContext.instance auctx in
let len = Univ.LMap.cardinal subst in
- let subst =
- Array.fold_left_i
- (fun i acc v -> Univ.LMap.add (Level.var i) (Level.var (i + len)) acc)
- subst (Univ.Instance.to_array inst)
+ let rec gen_subst i acc =
+ if i < 0 then acc
+ else
+ let acc = Univ.LMap.add (Level.var i) (Level.var (i + len)) acc in
+ gen_subst (pred i) acc
in
+ let subst = gen_subst (Univ.AUContext.size auctx - 1) subst in
let auctx' = Univ.subst_univs_level_abstract_universe_context subst auctx in
subst, (Polymorphic_const auctx')
@@ -249,7 +250,7 @@ let cook_constant ~hcons env { from = cb; info } =
let univs =
match univs with
| Monomorphic_const ctx ->
- Monomorphic_const (UContext.union (instantiate_univ_context abs_ctx) ctx)
+ assert (AUContext.is_empty abs_ctx); univs
| Polymorphic_const auctx ->
Polymorphic_const (AUContext.union abs_ctx auctx)
in