# HG changeset patch
# User wenzelm
# Date 1176504381 -7200
# Node ID 3c62305fbee6b3f5d21e3a22641e0599f29e4cce
# Parent  c803b2696ada4c893d7a656672a0af9395d4f9e9
tuned signature;
export: precomputed closure, no reference to contexts;

diff -r c803b2696ada -r 3c62305fbee6 src/Pure/Isar/local_defs.ML
--- a/src/Pure/Isar/local_defs.ML	Sat Apr 14 00:46:20 2007 +0200
+++ b/src/Pure/Isar/local_defs.ML	Sat Apr 14 00:46:21 2007 +0200
@@ -100,17 +100,22 @@
   end;
 
 
-(* specific export -- result based on educated guessing *)
+(* specific export -- result based on educated guessing (beware of closure sizes) *)
 
-fun export inner outer th =
+fun export inner outer =
   let
-    val th' = Assumption.export false inner outer th;
-    val still_fixed = map #1 (Drule.fold_terms Term.add_frees th' []);
-    val defs = Assumption.prems_of inner |> filter_out (fn prem =>
-      (case try (head_of_def o Thm.prop_of) prem of
-        SOME x => member (op =) still_fixed x
-      | NONE => true));
-  in (map Drule.abs_def defs, th') end;
+    val exp = Assumption.export false inner outer;
+    val prems = Assumption.prems_of inner;
+  in fn th =>
+    let
+      val th' = exp th;
+      val still_fixed = map #1 (Drule.fold_terms Term.add_frees th' []);
+      val defs = prems |> filter_out (fn prem =>
+        (case try (head_of_def o Thm.prop_of) prem of
+          SOME x => member (op =) still_fixed x
+        | NONE => true));
+    in (map Drule.abs_def defs, th') end
+  end;
 
 
 (* basic transitivity reasoning -- modulo beta-eta *)
diff -r c803b2696ada -r 3c62305fbee6 src/Pure/variable.ML
--- a/src/Pure/variable.ML	Sat Apr 14 00:46:20 2007 +0200
+++ b/src/Pure/variable.ML	Sat Apr 14 00:46:21 2007 +0200
@@ -35,8 +35,6 @@
   val auto_fixes: term -> Proof.context -> Proof.context
   val variant_fixes: string list -> Proof.context -> string list * Proof.context
   val invent_types: sort list -> Proof.context -> (string * sort) list * Proof.context
-  val export_inst: Proof.context -> Proof.context -> string list * string list
-  val exportT_inst: Proof.context -> Proof.context -> string list
   val export_terms: Proof.context -> Proof.context -> term list -> term list
   val exportT_terms: Proof.context -> Proof.context -> term list -> term list
   val exportT: Proof.context -> Proof.context -> thm list -> thm list
@@ -161,10 +159,12 @@
 
 (* type occurrences *)
 
-val declare_type_occs = map_type_occs o fold_term_types
+val decl_type_occs = fold_term_types
   (fn Free (x, _) => fold_atyps (fn TFree (a, _) => Symtab.insert_list (op =) (a, x) | _ => I)
     | _ => fold_atyps (fn TFree (a, _) => Symtab.default (a, []) | _ => I));
 
+val declare_type_occs = map_type_occs o decl_type_occs;
+
 
 (* constraints *)
 
@@ -302,7 +302,7 @@
 
 
 
-(** export -- generalize type/term variables **)
+(** export -- generalize type/term variables (beware of closure sizes) **)
 
 fun export_inst inner outer =
   let
@@ -312,37 +312,48 @@
 
     val gen_fixes = map #2 (Library.take (length fixes_inner - length fixes_outer, fixes_inner));
     val still_fixed = not o member (op =) gen_fixes;
-    val gen_fixesT =
+
+    val type_occs_inner = type_occs_of inner;
+    fun gen_fixesT ts =
       Symtab.fold (fn (a, xs) =>
         if declared_outer a orelse exists still_fixed xs
-        then I else cons a) (type_occs_of inner) [];
+        then I else cons a) (fold decl_type_occs ts type_occs_inner) [];
   in (gen_fixesT, gen_fixes) end;
 
 fun exportT_inst inner outer = #1 (export_inst inner outer);
 
-fun exportT_terms inner outer ts =
-  map (TermSubst.generalize (exportT_inst (fold declare_type_occs ts inner) outer, [])
-    (fold (Term.fold_types Term.maxidx_typ) ts ~1 + 1)) ts;
+fun exportT_terms inner outer =
+  let val mk_tfrees = exportT_inst inner outer in
+    fn ts => ts |> map
+      (TermSubst.generalize (mk_tfrees ts, [])
+        (fold (Term.fold_types Term.maxidx_typ) ts ~1 + 1))
+  end;
 
-fun export_terms inner outer ts =
-  map (TermSubst.generalize (export_inst (fold declare_type_occs ts inner) outer)
-    (fold Term.maxidx_term ts ~1 + 1)) ts;
+fun export_terms inner outer =
+  let val (mk_tfrees, tfrees) = export_inst inner outer in
+    fn ts => ts |> map
+      (TermSubst.generalize (mk_tfrees ts, tfrees)
+        (fold Term.maxidx_term ts ~1 + 1))
+  end;
 
 fun export_prf inner outer prf =
   let
-    val insts = export_inst (declare_prf prf inner) outer;
+    val (mk_tfrees, frees) = export_inst (declare_prf prf inner) outer;
+    val tfrees = mk_tfrees [];
     val idx = Proofterm.maxidx_proof prf ~1 + 1;
-    val gen_term = TermSubst.generalize_option insts idx;
-    val gen_typ = TermSubst.generalizeT_option (#1 insts) idx;
+    val gen_term = TermSubst.generalize_option (tfrees, frees) idx;
+    val gen_typ = TermSubst.generalizeT_option tfrees idx;
   in Proofterm.map_proof_terms_option gen_term gen_typ prf end;
 
-fun gen_export inst inner outer ths =
+
+fun gen_export (mk_tfrees, frees) ths =
   let
-    val inner' = fold (declare_type_occs o Thm.full_prop_of) ths inner;
-  in map (Thm.generalize (inst inner' outer) (fold Thm.maxidx_thm ths ~1 + 1)) ths end;
+    val tfrees = mk_tfrees (map Thm.full_prop_of ths);
+    val maxidx = fold Thm.maxidx_thm ths ~1;
+  in map (Thm.generalize (tfrees, frees) (maxidx + 1)) ths end;
 
-val exportT = gen_export (rpair [] oo exportT_inst);
-val export = gen_export export_inst;
+fun exportT inner outer = gen_export (exportT_inst inner outer, []);
+fun export inner outer = gen_export (export_inst inner outer);
 
 fun export_morphism inner outer =
   let