clarified signature;
authorwenzelm
Thu, 13 Apr 2023 23:08:39 +0200
changeset 77841 de97fcc2c624
parent 77840 33d366e66061
child 77842 0eb54e7004eb
clarified signature;
src/Pure/General/binding.ML
src/Pure/General/name_space.ML
--- 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);