clarified modules;
authorwenzelm
Sun, 24 Dec 2023 11:51:59 +0100
changeset 79345 75701d767ed9
parent 79344 704aea7f5203
child 79346 f86c310327df
clarified modules;
src/Pure/Isar/generic_target.ML
src/Pure/Isar/local_theory.ML
src/Pure/global_theory.ML
src/Pure/sign.ML
--- a/src/Pure/Isar/generic_target.ML	Sun Dec 24 11:46:20 2023 +0100
+++ b/src/Pure/Isar/generic_target.ML	Sun Dec 24 11:51:59 2023 +0100
@@ -349,9 +349,6 @@
 
   in (result'', result) end;
 
-fun bind_name lthy b =
-  (Local_Theory.full_name lthy b, Binding.default_pos_of b);
-
 fun map_facts f = (map o apsnd o map o apfst o map) f;
 
 in
@@ -360,7 +357,7 @@
   let
     val facts' = facts |> map (fn (a, thms) =>
       let
-        val name_pos = bind_name lthy (fst a);
+        val name_pos = Local_Theory.bind_name lthy (fst a);
         val thms' = Global_Theory.burrow_fact (Global_Theory.name_multi name_pos) thms;
       in (a, (map o apfst o map) (import_export_proof lthy) thms') end);
     val local_facts = map_facts #1 facts';
--- a/src/Pure/Isar/local_theory.ML	Sun Dec 24 11:46:20 2023 +0100
+++ b/src/Pure/Isar/local_theory.ML	Sun Dec 24 11:51:59 2023 +0100
@@ -30,6 +30,7 @@
     local_theory -> local_theory
   val restore_background_naming: local_theory -> local_theory -> local_theory
   val full_name: local_theory -> binding -> string
+  val bind_name: local_theory -> binding -> string * Position.T
   val new_group: local_theory -> local_theory
   val reset_group: local_theory -> local_theory
   val standard_morphism: local_theory -> Proof.context -> morphism
@@ -186,6 +187,7 @@
 val restore_background_naming = map_background_naming o K o background_naming_of;
 
 val full_name = Name_Space.full_name o background_naming_of;
+fun bind_name lthy b = (full_name lthy b, Binding.default_pos_of b);
 
 val new_group = map_background_naming Name_Space.new_group;
 val reset_group = map_background_naming Name_Space.reset_group;
--- a/src/Pure/global_theory.ML	Sun Dec 24 11:46:20 2023 +0100
+++ b/src/Pure/global_theory.ML	Sun Dec 24 11:51:59 2023 +0100
@@ -267,11 +267,9 @@
 
 (* store theorems and proofs *)
 
-fun bind_name thy b = (Sign.full_name thy b, Binding.default_pos_of b);
-
 fun add_facts (b, fact) thy =
   let
-    val (full_name, pos) = bind_name thy b;
+    val (full_name, pos) = Sign.bind_name thy b;
     fun check fact =
       fact |> map_index (fn (i, thm) =>
         let
@@ -297,7 +295,7 @@
   end;
 
 fun add_thms_lazy kind (b, thms) thy =
-  let val (name, pos) = bind_name thy b in
+  let val (name, pos) = Sign.bind_name thy b in
     if name = "" then register_proofs_lazy (name, pos) thms thy |> #2
     else
       register_proofs_lazy (name, pos)
@@ -317,11 +315,11 @@
 in
 
 fun apply_facts name_flags1 name_flags2 (b, facts) thy =
-  let val (name, pos) = bind_name thy b in
+  let val (name, pos) = Sign.bind_name thy b in
     if name = "" then app_facts facts thy |-> register_proofs (name, pos)
     else
       let
-        val name_pos = bind_name thy b;
+        val name_pos = Sign.bind_name thy b;
         val (thms', thy') = thy
           |> app_facts (map (apfst (name_thms name_flags1 name_pos)) facts)
           |>> name_thms name_flags2 name_pos |-> register_proofs (name, pos);
--- a/src/Pure/sign.ML	Sun Dec 24 11:46:20 2023 +0100
+++ b/src/Pure/sign.ML	Sun Dec 24 11:51:59 2023 +0100
@@ -43,6 +43,7 @@
   val full_name_path: theory -> string -> binding -> string
   val full_bname: theory -> bstring -> string
   val full_bname_path: theory -> string -> bstring -> string
+  val bind_name: theory -> binding -> string * Position.T
   val const_monomorphic: theory -> string -> bool
   val const_typargs: theory -> string * typ -> typ list
   val const_instance: theory -> string * typ list -> typ
@@ -228,6 +229,8 @@
 fun full_bname thy = Name_Space.full_name (naming_of thy) o Binding.name;
 fun full_bname_path thy path = full_name_path thy path o Binding.name;
 
+fun bind_name thy b = (full_name thy b, Binding.default_pos_of b);
+
 
 
 (** name spaces **)