aboutsummaryrefslogtreecommitdiff
path: root/engine
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-03-31 15:10:32 +0200
committerGaëtan Gilbert2020-06-25 14:17:21 +0200
commitae1acfefe52937ea7e3a098137df032363051361 (patch)
treee9286129872296964cce1b59ab6171c4afb6647d /engine
parent50361dc784c8967e7c4b254102e2cb21cb7e9f9e (diff)
Generate names for anonymous polymorphic universes
This should make the univbinders output test less fragile as it depends less on the global counter (still used for universes from section variables).
Diffstat (limited to 'engine')
-rw-r--r--engine/uState.ml7
-rw-r--r--engine/univNames.ml25
-rw-r--r--engine/univNames.mli9
3 files changed, 2 insertions, 39 deletions
diff --git a/engine/uState.ml b/engine/uState.ml
index ff60a5f9d4..d4cb59da26 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -114,16 +114,11 @@ 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)
+ with Not_found -> Anonymous
in
Array.map map (Instance.to_array inst)
diff --git a/engine/univNames.ml b/engine/univNames.ml
index 9a66386a21..2e15558db2 100644
--- a/engine/univNames.ml
+++ b/engine/univNames.ml
@@ -8,7 +8,6 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Util
open Names
open Univ
@@ -30,30 +29,8 @@ let pr_with_global_universes l =
(** Local universe names of polymorphic references *)
-type universe_binders = Univ.Level.t Names.Id.Map.t
+type universe_binders = Level.t Names.Id.Map.t
let empty_binders = Id.Map.empty
type univ_name_list = Names.lname list
-
-let universe_binders_with_opt_names orig names =
- let orig = AUContext.names orig in
- let orig = Array.to_list orig in
- let udecl = match names with
- | None -> orig
- | Some udecl ->
- try
- List.map2 (fun orig {CAst.v = na} ->
- match na with
- | Anonymous -> orig
- | Name id -> Name id) orig udecl
- with Invalid_argument _ ->
- let len = List.length orig in
- CErrors.user_err ~hdr:"universe_binders_with_opt_names"
- Pp.(str "Universe instance should have length " ++ int len)
- in
- let fold i acc na = match na with
- | Name id -> Names.Id.Map.add id (Level.var i) acc
- | Anonymous -> acc
- in
- List.fold_left_i fold 0 empty_binders udecl
diff --git a/engine/univNames.mli b/engine/univNames.mli
index da9ffc3564..5f69d199b3 100644
--- a/engine/univNames.mli
+++ b/engine/univNames.mli
@@ -20,12 +20,3 @@ type universe_binders = Univ.Level.t Names.Id.Map.t
val empty_binders : universe_binders
type univ_name_list = Names.lname list
-
-(** [universe_binders_with_opt_names ref l]
-
- If [l] is [Some univs] return the universe binders naming the bound levels
- of [ref] by [univs] (skipping Anonymous). May error if the lengths mismatch.
-
- Otherwise return the bound universe names registered for [ref]. *)
-val universe_binders_with_opt_names : AUContext.t ->
- univ_name_list option -> universe_binders