theorem(_i): note assms of statement;
authorwenzelm
Tue, 21 Nov 2006 20:48:11 +0100
changeset 21450 f16c9e6401d1
parent 21449 0413b46ee5ef
child 21451 28f1181c1a48
theorem(_i): note assms of statement;
src/Pure/Isar/specification.ML
--- a/src/Pure/Isar/specification.ML	Tue Nov 21 20:48:06 2006 +0100
+++ b/src/Pure/Isar/specification.ML	Tue Nov 21 20:48:11 2006 +0100
@@ -201,14 +201,18 @@
 
 local
 
+fun subtract_prems ctxt1 ctxt2 =
+  Library.drop (length (Assumption.prems_of ctxt1), Assumption.prems_of ctxt2);
+
 fun prep_statement prep_att prep_stmt elems concl ctxt =
   (case concl of
     Element.Shows shows =>
       let
-        val (_, _, elems_ctxt, propp) = prep_stmt elems (map snd shows) ctxt;
+        val (_, loc_ctxt, elems_ctxt, propp) = prep_stmt elems (map snd shows) ctxt;
+        val prems = subtract_prems loc_ctxt elems_ctxt;
+        val stmt = Attrib.map_specs prep_att (map fst shows ~~ propp);
         val goal_ctxt = fold (fold (Variable.auto_fixes o fst)) propp elems_ctxt;
-        val stmt = Attrib.map_specs prep_att (map fst shows ~~ propp);
-      in ((stmt, []), goal_ctxt) end
+      in ((prems, stmt, []), goal_ctxt) end
   | Element.Obtains obtains =>
       let
         val case_names = obtains |> map_index
@@ -218,7 +222,7 @@
             (vars |> map_filter (fn (x, SOME T) => SOME (x, T) | _ => NONE))));
 
         val raw_propp = obtains |> map (fn (_, (_, props)) => map (rpair []) props);
-        val (_, _, elems_ctxt, propp) = prep_stmt (elems @ constraints) raw_propp ctxt;
+        val (_, loc_ctxt, elems_ctxt, propp) = prep_stmt (elems @ constraints) raw_propp ctxt;
 
         val thesis = ObjectLogic.fixed_judgment (ProofContext.theory_of ctxt) AutoBind.thesisN;
 
@@ -240,6 +244,7 @@
 
         val atts = map Attrib.internal
           [RuleCases.consumes (~ (length obtains)), RuleCases.case_names case_names];
+        val prems = subtract_prems loc_ctxt elems_ctxt;
         val stmt = [(("", atts), [(thesis, [])])];
 
         val (facts, goal_ctxt) = elems_ctxt
@@ -247,7 +252,7 @@
           |> fold_map assume_case (obtains ~~ propp)
           |-> (fn ths => ProofContext.note_thmss_i Thm.assumptionK
                 [((Obtain.thatN, []), [(ths, [])])] #> #2 #> pair ths);
-      in ((stmt, facts), goal_ctxt) end);
+      in ((prems, stmt, facts), goal_ctxt) end);
 
 fun gen_theorem prep_att prep_stmt
     kind before_qed after_qed (name, raw_atts) raw_elems raw_concl lthy0 =
@@ -266,7 +271,8 @@
 
     val elems = raw_elems |> (map o Locale.map_elem)
       (Element.map_ctxt {name = I, var = I, typ = I, term = I, fact = I, attrib = attrib});
-    val ((stmt, facts), goal_ctxt) = prep_statement attrib (prep_stmt loc) elems raw_concl ctxt;
+    val ((prems, stmt, facts), goal_ctxt) =
+      prep_statement attrib (prep_stmt loc) elems raw_concl ctxt;
 
     fun after_qed' results goal_ctxt' =
       let val results' = burrow (ProofContext.export_standard goal_ctxt' lthy) results in
@@ -280,6 +286,8 @@
       end;
   in
     goal_ctxt
+    |> ProofContext.note_thmss_i Thm.assumptionK [((AutoBind.assmsN, []), [(prems, [])])]
+    |> snd
     |> Proof.theorem_i before_qed after_qed' (map snd stmt)
     |> Proof.refine_insert facts
   end;