From 0d9a91113c4112eece0680e433f435fdfb39ea4b Mon Sep 17 00:00:00 2001 From: Pierre-Marie Pédrot Date: Fri, 7 Jul 2017 16:33:47 +0200 Subject: Getting rid of simple calls to AUContext.instance. This function breaks the abstraction barrier of abstract universe contexts, as it provides a way to observe the bound names of such a context. We remove all the uses that can be easily get rid of with the current API. --- kernel/cooking.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'kernel/cooking.ml') diff --git a/kernel/cooking.ml b/kernel/cooking.ml index b9e7ec1691..852f87d5e9 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') -- cgit v1.2.3 From 1309723672def9bf322a23e9c789e4a8bc2a4ac3 Mon Sep 17 00:00:00 2001 From: Pierre-Marie Pédrot Date: Mon, 10 Jul 2017 16:56:10 +0200 Subject: Asserting that monomorphic section variables have no abstracted context. --- kernel/cooking.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'kernel/cooking.ml') diff --git a/kernel/cooking.ml b/kernel/cooking.ml index 852f87d5e9..95822fac68 100644 --- a/kernel/cooking.ml +++ b/kernel/cooking.ml @@ -250,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 -- cgit v1.2.3