--- 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 **)