# HG changeset patch
# User wenzelm
# Date 1150565878 -7200
# Node ID 3bbb9cc5d4f177feb41383977714be493f96233a
# Parent  b08e26fb247e5335722e124d64c03e5993cdfe0e
export: simultaneous facts, refer to Variable.export;
Term.internal/skolem;

diff -r b08e26fb247e -r 3bbb9cc5d4f1 src/Pure/Isar/proof_context.ML
--- a/src/Pure/Isar/proof_context.ML	Sat Jun 17 19:37:57 2006 +0200
+++ b/src/Pure/Isar/proof_context.ML	Sat Jun 17 19:37:58 2006 +0200
@@ -66,10 +66,10 @@
   val inferred_fixes: context -> (string * typ) list * context
   val read_tyname: context -> string -> typ
   val read_const: context -> string -> term
-  val goal_exports: context -> context -> thm -> thm Seq.seq
-  val exports: context -> context -> thm -> thm Seq.seq
-  val export: context -> context -> thm -> thm
-  val export_standard: context -> context -> thm -> thm
+  val goal_exports: context -> context -> thm list -> thm list Seq.seq
+  val exports: context -> context -> thm list -> thm list Seq.seq
+  val export: context -> context -> thm list -> thm list
+  val export_standard: context -> context -> thm list -> thm list
   val add_binds: (indexname * string option) list -> context -> context
   val add_binds_i: (indexname * term option) list -> context -> context
   val auto_bind_goal: term list -> context -> context
@@ -357,9 +357,9 @@
 fun get_skolem ctxt x = the_default x (lookup_skolem ctxt x);
 
 fun no_skolem internal x =
-  if can Syntax.dest_skolem x then
+  if can Term.dest_skolem x then
     error ("Illegal reference to internal Skolem constant: " ^ quote x)
-  else if not internal andalso can Syntax.dest_internal x then
+  else if not internal andalso can Term.dest_internal x then
     error ("Illegal reference to internal variable: " ^ quote x)
   else x;
 
@@ -386,7 +386,7 @@
 fun revert_skolem ctxt x =
   (case rev_skolem ctxt x of
     SOME x' => x'
-  | NONE => perhaps (try Syntax.dest_skolem) x);
+  | NONE => perhaps (try Term.dest_skolem) x);
 
 fun extern_skolem ctxt =
   let
@@ -565,40 +565,25 @@
 
 fun common_exports is_goal inner outer =
   let
-    val gen = Variable.generalize_tfrees inner outer;
-    val fixes = subtract (op =) (Variable.fixed_names_of outer) (Variable.fixed_names_of inner);
     val asms = Library.drop (length (assumptions_of outer), assumptions_of inner);
-    val exp_asms = map (fn (cprops, exp) => exp is_goal cprops) asms;
+    val exp_asms = rev (map (fn (cprops, exp) => exp is_goal cprops) asms);
   in
-    Goal.norm_hhf_protect
-    #> Seq.EVERY (rev exp_asms)
-    #> Seq.map (fn rule =>
-      let
-        val thy = Thm.theory_of_thm rule;
-        val prop = Thm.full_prop_of rule;
-        val frees = map (Thm.cterm_of thy) (map_filter (Term.find_free prop) fixes);
-        val tfrees = gen (Term.add_term_tfree_names (prop, []));
-      in
-        rule
-        |> Drule.forall_intr_list frees
-        |> Goal.norm_hhf_protect
-        |> Drule.tvars_intr_list tfrees |> #2
-      end)
+    map Goal.norm_hhf_protect
+    #> Seq.map_list (Seq.EVERY exp_asms)
+    #> Seq.map (Variable.export inner outer)
+    #> Seq.map (map Goal.norm_hhf_protect)
   end;
 
 val goal_exports = common_exports true;
 val exports = common_exports false;
 
-fun export inner outer =
-  let val exp = common_exports false inner outer in
-    fn th =>
-      (case Seq.pull (exp th) of
-        SOME (th', _) => th'
-      | NONE => raise THM ("Failed to export theorem", 0, [th]))
-  end;
+fun export inner outer ths =
+  (case Seq.pull (common_exports false inner outer ths) of
+    SOME (ths', _) => ths'
+  | NONE => raise THM ("Failed to export theorems", 0, ths));
 
 fun export_standard inner outer =
-  export inner outer #> Drule.local_standard;
+  export inner outer #> map Drule.local_standard;
 
 
 
@@ -651,7 +636,7 @@
     val (binds, ctxt') =
       apfst flat (fold_map (prep_bind prep_pats) (map fst raw_binds ~~ ts) ctxt);
     val binds' =
-      if gen then map #1 binds ~~ Variable.generalize ctxt' ctxt (map #2 binds)
+      if gen then map #1 binds ~~ Variable.exportT_terms ctxt' ctxt (map #2 binds)
       else binds;
     val binds'' = map (apsnd SOME) binds';
     val ctxt'' =
@@ -690,7 +675,7 @@
     val propss = map (map #1) args;
 
     (*generalize result: context evaluated now, binds added later*)
-    val gen = Variable.generalize ctxt' ctxt;
+    val gen = Variable.exportT_terms ctxt' ctxt;
     fun gen_binds c = c |> add_binds_i (map #1 binds ~~ map SOME (gen (map #2 binds)));
   in (ctxt' |> add_binds_i (map (apsnd SOME) binds), (propss, gen_binds)) end;
 
@@ -915,7 +900,7 @@
 
 fun prep_mixfix (x, T, mx) =
   if mx <> NoSyn andalso mx <> Structure andalso
-      (can Syntax.dest_internal x orelse can Syntax.dest_skolem x) then
+      (can Term.dest_internal x orelse can Term.dest_skolem x) then
     error ("Illegal mixfix syntax for internal/skolem constant " ^ quote x)
   else (true, (x, T, mx));
 
@@ -1045,7 +1030,7 @@
     val asms' = asms1 @ [(view, assume_export)] @ asms2;
   in (asms', prems) end);
 
-fun export_view view inner outer = export_standard (add_view outer view inner) outer;
+fun export_view view inner outer = singleton (export_standard (add_view outer view inner) outer);
 
 
 
@@ -1224,7 +1209,7 @@
       if x = x' then Pretty.str x
       else Pretty.block [Pretty.str x, Pretty.str " =", Pretty.brk 1, prt_term (Syntax.free x')];
     val fixes =
-      rev (filter_out ((can Syntax.dest_internal orf member (op =) structs) o #1)
+      rev (filter_out ((can Term.dest_internal orf member (op =) structs) o #1)
         (Variable.fixes_of ctxt));
     val prt_fixes = if null fixes then []
       else [Pretty.block (Pretty.str "fixed variables:" :: Pretty.brk 1 ::