diff options
| author | Gaëtan Gilbert | 2020-06-22 12:55:47 +0200 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-06-25 14:14:11 +0200 |
| commit | 50361dc784c8967e7c4b254102e2cb21cb7e9f9e (patch) | |
| tree | 425cbfb89a7c1336b8bdf6fdffd404e1add68cf9 /engine | |
| parent | ba355fb8eb41cd25cf7bd1ece860c93d32e5793c (diff) | |
Make compute_instance_binders internal to UState
Diffstat (limited to 'engine')
| -rw-r--r-- | engine/uState.ml | 17 | ||||
| -rw-r--r-- | engine/univNames.ml | 13 | ||||
| -rw-r--r-- | engine/univNames.mli | 2 |
3 files changed, 15 insertions, 17 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 diff --git a/engine/univNames.ml b/engine/univNames.ml index 6d9095680c..9a66386a21 100644 --- a/engine/univNames.ml +++ b/engine/univNames.ml @@ -34,19 +34,6 @@ type universe_binders = Univ.Level.t Names.Id.Map.t let empty_binders = Id.Map.empty -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) - type univ_name_list = Names.lname list let universe_binders_with_opt_names orig names = diff --git a/engine/univNames.mli b/engine/univNames.mli index 34a18d6b6e..da9ffc3564 100644 --- a/engine/univNames.mli +++ b/engine/univNames.mli @@ -19,8 +19,6 @@ type universe_binders = Univ.Level.t Names.Id.Map.t val empty_binders : universe_binders -val compute_instance_binders : Instance.t -> universe_binders -> Names.Name.t array - type univ_name_list = Names.lname list (** [universe_binders_with_opt_names ref l] |
