aboutsummaryrefslogtreecommitdiff
path: root/engine/uState.ml
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-06-22 12:55:47 +0200
committerGaëtan Gilbert2020-06-25 14:14:11 +0200
commit50361dc784c8967e7c4b254102e2cb21cb7e9f9e (patch)
tree425cbfb89a7c1336b8bdf6fdffd404e1add68cf9 /engine/uState.ml
parentba355fb8eb41cd25cf7bd1ece860c93d32e5793c (diff)
Make compute_instance_binders internal to UState
Diffstat (limited to 'engine/uState.ml')
-rw-r--r--engine/uState.ml17
1 files changed, 15 insertions, 2 deletions
diff --git a/engine/uState.ml b/engine/uState.ml
index 25d7638686..ff60a5f9d4 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -114,12 +114,25 @@ let constraints ctx = snd ctx.local
let context ctx = ContextSet.to_context ctx.local
+let name_universe lvl =
+ (* Best-effort naming from the string representation of the level. This is
+ completely hackish and should be solved in upper layers instead. *)
+ Id.of_string_soft (Level.to_string lvl)
+
+let compute_instance_binders inst ubinders =
+ let revmap = Id.Map.fold (fun id lvl accu -> LMap.add lvl id accu) ubinders LMap.empty in
+ let map lvl =
+ try Name (LMap.find lvl revmap)
+ with Not_found -> Name (name_universe lvl)
+ in
+ Array.map map (Instance.to_array inst)
+
let univ_entry ~poly uctx =
let open Entries in
if poly then
let (binders, _) = uctx.names in
let uctx = context uctx in
- let nas = UnivNames.compute_instance_binders (UContext.instance uctx) binders in
+ let nas = compute_instance_binders (UContext.instance uctx) binders in
Polymorphic_entry (nas, uctx)
else Monomorphic_entry (context_set uctx)
@@ -433,7 +446,7 @@ let check_univ_decl ~poly uctx decl =
if poly then
let (binders, _) = uctx.names in
let uctx = universe_context ~names ~extensible uctx in
- let nas = UnivNames.compute_instance_binders (UContext.instance uctx) binders in
+ let nas = compute_instance_binders (UContext.instance uctx) binders in
Entries.Polymorphic_entry (nas, uctx)
else
let () = check_universe_context_set ~names ~extensible uctx in