trim context of persistent data;
authorwenzelm
Sat, 17 Feb 2018 18:42:26 +0100
changeset 67646 85582dded912
parent 67645 5e0c81750441
child 67647 27f3dceb5a70
trim context of persistent data;
src/Pure/Isar/code.ML
--- a/src/Pure/Isar/code.ML	Sat Feb 17 17:34:31 2018 +0100
+++ b/src/Pure/Isar/code.ML	Sat Feb 17 18:42:26 2018 +0100
@@ -90,6 +90,11 @@
 
 (** auxiliary **)
 
+(* close theorem for storage *)
+
+val close = Thm.trim_context o Thm.close_derivation;
+
+
 (* printing *)
 
 fun string_of_typ thy =
@@ -391,11 +396,11 @@
 local
 
 type data = Any.T Datatab.table;
-fun empty_dataref () = Synchronized.var "code data" (NONE : (data * theory) option);
+fun empty_dataref () = Synchronized.var "code data" (NONE : (data * Context.theory_id) option);
 
 structure Code_Data = Theory_Data
 (
-  type T = specs * (data * theory) option Synchronized.var;
+  type T = specs * (data * Context.theory_id) option Synchronized.var;
   val empty = (empty_specs, empty_dataref ());
   val extend : T -> T = apsnd (K (empty_dataref ()));
   fun merge ((specs1, _), (specs2, _)) =
@@ -417,18 +422,18 @@
 fun change_yield_data (kind, mk, dest) theory f =
   let
     val dataref = (snd o Code_Data.get) theory;
-    val (datatab, thy) = case Synchronized.value dataref
-     of SOME (datatab, thy) =>
-        if Context.eq_thy (theory, thy)
-          then (datatab, thy)
-          else (Datatab.empty, theory)
-      | NONE => (Datatab.empty, theory)
+    val (datatab, thy_id) = case Synchronized.value dataref
+     of SOME (datatab, thy_id) =>
+        if Context.eq_thy_id (Context.theory_id theory, thy_id)
+          then (datatab, thy_id)
+          else (Datatab.empty, Context.theory_id theory)
+      | NONE => (Datatab.empty, Context.theory_id theory)
     val data = case Datatab.lookup datatab kind
      of SOME data => data
       | NONE => invoke_init kind;
     val result as (_, data') = f (dest data);
     val _ = Synchronized.change dataref
-      ((K o SOME) (Datatab.update (kind, mk data') datatab, thy));
+      ((K o SOME) (Datatab.update (kind, mk data') datatab, thy_id));
   in result end;
 
 end; (*local*)
@@ -1381,7 +1386,8 @@
 fun subsumptive_add thy verbose (thm, proper) eqns =
   let
     val args_of = drop_prefix is_Var o rev o snd o strip_comb
-      o Term.map_types Type.strip_sorts o fst o Logic.dest_equals o Thm.plain_prop_of;
+      o Term.map_types Type.strip_sorts o fst o Logic.dest_equals o Thm.plain_prop_of
+      o Thm.transfer thy;
     val args = args_of thm;
     val incr_idx = Logic.incr_indexes ([], [], Thm.maxidx_of thm + 1);
     fun matches_args args' =
@@ -1396,11 +1402,10 @@
         (if verbose then warning ("Code generator: dropping subsumed code equation\n" ^
             Thm.string_of_thm_global thy thm') else (); true)
       else false;
-  in (thm, proper) :: filter_out drop eqns end;
+  in (close thm, proper) :: filter_out drop eqns end;
 
 fun add_eqn_for (c, eqn) thy =
-  thy |> modify_specs (modify_pending_eqns c
-    (subsumptive_add thy true (apfst Thm.close_derivation eqn)));
+  thy |> modify_specs (modify_pending_eqns c (subsumptive_add thy true eqn));
 
 fun add_eqns_for default (c, proto_eqns) thy =
   thy |> modify_specs (fn specs =>
@@ -1408,8 +1413,7 @@
     then
       let
         val eqns = []
-          |> fold_rev (subsumptive_add thy (not default)) proto_eqns
-          |> (map o apfst) Thm.close_derivation;
+          |> fold_rev (subsumptive_add thy (not default)) proto_eqns;
       in specs |> register_fun_spec c (Eqns (default, eqns)) end
     else specs);