diff options
| author | Gaëtan Gilbert | 2020-03-31 15:10:32 +0200 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-06-25 14:17:21 +0200 |
| commit | ae1acfefe52937ea7e3a098137df032363051361 (patch) | |
| tree | e9286129872296964cce1b59ab6171c4afb6647d /engine | |
| parent | 50361dc784c8967e7c4b254102e2cb21cb7e9f9e (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.ml | 7 | ||||
| -rw-r--r-- | engine/univNames.ml | 25 | ||||
| -rw-r--r-- | engine/univNames.mli | 9 |
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 |
