--- a/src/Pure/Isar/generic_target.ML Fri Aug 16 10:04:47 2019 +0200
+++ b/src/Pure/Isar/generic_target.ML Fri Aug 16 10:20:41 2019 +0200
@@ -306,6 +306,8 @@
fun bind_name lthy b =
(Local_Theory.full_name lthy b, Binding.default_pos_of b);
+fun map_facts f = map (apsnd (map (apfst (map f))));
+
in
fun notes target_notes kind facts lthy =
@@ -313,9 +315,9 @@
val facts' = facts
|> map (fn (a, bs) =>
(a, Global_Theory.burrow_fact (Global_Theory.name_multi (bind_name lthy (fst a))) bs))
- |> Global_Theory.map_facts (import_export_proof lthy);
- val local_facts = Global_Theory.map_facts #1 facts';
- val global_facts = Global_Theory.map_facts #2 facts';
+ |> map_facts (import_export_proof lthy);
+ val local_facts = map_facts #1 facts';
+ val global_facts = map_facts #2 facts';
in
lthy
|> target_notes kind global_facts (Attrib.partial_evaluation lthy local_facts)
--- a/src/Pure/global_theory.ML Fri Aug 16 10:04:47 2019 +0200
+++ b/src/Pure/global_theory.ML Fri Aug 16 10:20:41 2019 +0200
@@ -16,7 +16,6 @@
val get_thm: theory -> xstring -> thm
val transfer_theories: theory -> thm -> thm
val all_thms_of: theory -> bool -> (string * thm) list
- val map_facts: ('a -> 'b) -> ('c * ('a list * 'd) list) list -> ('c * ('b list * 'd) list) list
val burrow_fact: ('a list -> 'b list) -> ('a list * 'c) list -> ('b list * 'c) list
val burrow_facts: ('a list -> 'b list) ->
('c * ('a list * 'd) list) list -> ('c * ('b list * 'd) list) list
@@ -63,15 +62,16 @@
);
val facts_of = Data.get;
+fun map_facts f = Data.map f;
fun check_fact thy = Facts.check (Context.Theory thy) (facts_of thy);
val intern_fact = Facts.intern o facts_of;
val defined_fact = Facts.defined o facts_of;
fun alias_fact binding name thy =
- Data.map (Facts.alias (Sign.naming_of thy) binding name) thy;
+ map_facts (Facts.alias (Sign.naming_of thy) binding name) thy;
-fun hide_fact fully name = Data.map (Facts.hide fully name);
+fun hide_fact fully name = map_facts (Facts.hide fully name);
(* retrieve theorems *)
@@ -106,7 +106,6 @@
(* fact specifications *)
-fun map_facts f = map (apsnd (map (apfst (map f))));
fun burrow_fact f = split_list #>> burrow f #> op ~~;
fun burrow_facts f = split_list ##> burrow (burrow_fact f) #> op ~~;
@@ -176,7 +175,7 @@
end);
val arg = (b, Lazy.map_finished (tap check) fact);
in
- thy |> Data.map (Facts.add_static (Context.Theory thy) {strict = true, index = false} arg #> #2)
+ thy |> map_facts (Facts.add_static (Context.Theory thy) {strict = true, index = false} arg #> #2)
end;
fun check_thms_lazy (thms: thm list lazy) =
@@ -231,8 +230,8 @@
(* dynamic theorems *)
fun add_thms_dynamic' context arg thy =
- let val (name, facts') = Facts.add_dynamic context arg (Data.get thy)
- in (name, Data.put facts' thy) end;
+ let val (name, facts') = Facts.add_dynamic context arg (facts_of thy)
+ in (name, map_facts (K facts') thy) end;
fun add_thms_dynamic arg thy =
add_thms_dynamic' (Context.Theory thy) arg thy |> snd;