# HG changeset patch
# User wenzelm
# Date 1165436343 -3600
# Node ID 4f5f6c685ab41adb7549fef42b4ea7eefcb4b85a
# Parent  8f3c07f4152d8ce93ef13f1508337d21db2871e6
export: added explicit term operation;

diff -r 8f3c07f4152d -r 4f5f6c685ab4 src/Pure/Isar/locale.ML
--- a/src/Pure/Isar/locale.ML	Wed Dec 06 21:19:02 2006 +0100
+++ b/src/Pure/Isar/locale.ML	Wed Dec 06 21:19:03 2006 +0100
@@ -873,9 +873,8 @@
 
 local
 
-fun axioms_export axs _ hyps =
-  Element.satisfy_thm axs
-  #> Drule.implies_intr_list (Library.drop (length axs, hyps));
+fun axioms_export axs _ As =
+  (Element.satisfy_thm axs #> Drule.implies_intr_list (Library.drop (length axs, As)), fn t => t);
 
 
 (* NB: derived ids contain only facts at this stage *)
diff -r 8f3c07f4152d -r 4f5f6c685ab4 src/Pure/Isar/obtain.ML
--- a/src/Pure/Isar/obtain.ML	Wed Dec 06 21:19:02 2006 +0100
+++ b/src/Pure/Isar/obtain.ML	Wed Dec 06 21:19:03 2006 +0100
@@ -64,16 +64,21 @@
   --------
      B
 *)
-fun obtain_export fix_ctxt rule xs _ As thm =
+fun eliminate_term ctxt xs tm =
+  let
+    val vs = map (dest_Free o Thm.term_of) xs;
+    val bads = Term.fold_aterms (fn t as Free v =>
+      if member (op =) vs v then insert (op aconv) t else I | _ => I) tm [];
+    val _ = null bads orelse
+      error ("Result contains obtained parameters: " ^
+        space_implode " " (map (ProofContext.string_of_term ctxt) bads));
+  in tm end;
+
+fun eliminate fix_ctxt rule xs As thm =
   let
     val thy = ProofContext.theory_of fix_ctxt;
 
-    val vs = map (dest_Free o Thm.term_of) xs;
-    val bads = Term.fold_aterms (fn t as Free v =>
-      if member (op =) vs v then insert (op aconv) t else I | _ => I) (Thm.prop_of thm) [];
-    val _ = null bads orelse
-      error ("Result contains obtained parameters: " ^
-        space_implode " " (map (ProofContext.string_of_term fix_ctxt) bads));
+    val _ = eliminate_term fix_ctxt xs (Thm.full_prop_of thm);
     val _ = ObjectLogic.is_judgment thy (Thm.concl_of thm) orelse
       error "Conclusion in obtained context must be object-logic judgment";
 
@@ -88,6 +93,9 @@
     |> singleton (Variable.export ctxt' fix_ctxt)
   end;
 
+fun obtain_export ctxt rule xs _ As =
+  (eliminate ctxt rule xs As, eliminate_term ctxt xs);
+
 
 
 (** obtain **)