--- a/src/Pure/General/binding.ML Wed Apr 12 15:22:52 2023 +0200
+++ b/src/Pure/General/binding.ML Thu Apr 13 23:08:39 2023 +0200
@@ -43,7 +43,7 @@
val bad: binding -> string
val check: binding -> unit
val name_spec: scope list -> (string * bool) list -> binding ->
- {restriction: bool option, concealed: bool, spec: (string * bool) list}
+ {restriction: bool option, concealed: bool, spec: (string * bool) list, full_name: string}
end;
structure Binding: BINDING =
@@ -211,8 +211,10 @@
val _ =
exists (fn (a, _) => member (op =) bad_specs a orelse exists_string (fn s => s = "\"") a) spec
andalso error (bad binding);
- in {restriction = restriction, concealed = concealed, spec = if null spec2 then [] else spec} end;
+ val spec' = if null spec2 then [] else spec;
+ val full_name = Long_Name.implode (map #1 spec');
+ in {restriction = restriction, concealed = concealed, spec = spec', full_name = full_name} end;
end;
--- a/src/Pure/General/name_space.ML Wed Apr 12 15:22:52 2023 +0200
+++ b/src/Pure/General/name_space.ML Thu Apr 13 23:08:39 2023 +0200
@@ -428,10 +428,8 @@
fun name_spec naming binding =
Binding.name_spec (get_scopes naming) (get_path naming) (transform_binding naming binding);
-fun full_name naming =
- name_spec naming #> #spec #> map #1 #> Long_Name.implode;
-
-val base_name = full_name global_naming #> Long_Name.base_name;
+val full_name = #full_name oo name_spec;
+val base_name = Long_Name.base_name o full_name global_naming;
(* accesses *)
@@ -450,14 +448,17 @@
in
fun make_accesses naming binding =
- (case name_spec naming binding of
- {restriction = SOME true, ...} => ([], [])
- | {restriction, spec, ...} =>
- let
- val restrict = is_some restriction ? filter (fn [_] => false | _ => true);
- val sfxs = restrict (mandatory_suffixes spec);
- val pfxs = restrict (mandatory_prefixes spec);
- in apply2 (map Long_Name.implode o distinct op =) (sfxs @ pfxs, sfxs) end);
+ let
+ val args as {restriction, spec, ...} = name_spec naming binding;
+ val accesses =
+ if restriction = SOME true then ([], [])
+ else
+ let
+ val restrict = is_some restriction ? filter (fn [_] => false | _ => true);
+ val sfxs = restrict (mandatory_suffixes spec);
+ val pfxs = restrict (mandatory_prefixes spec);
+ in apply2 (map Long_Name.implode o distinct op =) (sfxs @ pfxs, sfxs) end;
+ in (accesses, args) end;
end;
@@ -487,7 +488,7 @@
space |> map_name_space (fn (kind, internals, externals) =>
let
val _ = the_entry space name;
- val (more_accs, more_accs') = make_accesses naming binding;
+ val (more_accs, more_accs') = #1 (make_accesses naming binding);
val internals' = internals |> fold (add_name name) more_accs;
val externals' = externals
|> Change_Table.map_entry name (fn {accesses, accesses', entry} =>
@@ -529,10 +530,7 @@
let
val naming = naming_of context;
val Naming {group, theory_long_name, ...} = naming;
- val {concealed, spec, ...} = name_spec naming binding;
- val (accesses, accesses') = make_accesses naming binding;
-
- val name = Long_Name.implode (map fst spec);
+ val ((accesses, accesses'), {concealed, full_name = name, ...}) = make_accesses naming binding;
val _ = name = "" andalso error (Binding.bad binding);
val (proper_pos, pos) = Position.default (Binding.pos_of binding);