'inductive_cases': support 'and' form;
authorwenzelm
Sat, 29 Dec 2001 18:35:27 +0100
changeset 12609 fb073a34b537
parent 12608 2df381faa787
child 12610 8b9845807f77
'inductive_cases': support 'and' form;
src/HOL/Tools/inductive_package.ML
src/ZF/Tools/ind_cases.ML
--- a/src/HOL/Tools/inductive_package.ML	Sat Dec 29 18:34:42 2001 +0100
+++ b/src/HOL/Tools/inductive_package.ML	Sat Dec 29 18:35:27 2001 +0100
@@ -44,9 +44,9 @@
   val inductive_forall_name: string
   val inductive_forall_def: thm
   val rulify: thm -> thm
-  val inductive_cases: ((bstring * Args.src list) * string list) * Comment.text
+  val inductive_cases: (((bstring * Args.src list) * string list) * Comment.text) list
     -> theory -> theory
-  val inductive_cases_i: ((bstring * theory attribute list) * term list) * Comment.text
+  val inductive_cases_i: (((bstring * theory attribute list) * term list) * Comment.text) list
     -> theory -> theory
   val add_inductive_i: bool -> bool -> bstring -> bool -> bool -> bool -> term list ->
     ((bstring * term) * theory attribute list) list -> thm list -> theory -> theory *
@@ -582,17 +582,14 @@
 
 (* inductive_cases(_i) *)
 
-fun gen_inductive_cases prep_att prep_prop (((name, raw_atts), raw_props), comment) thy =
+fun gen_inductive_cases prep_att prep_prop args thy =
   let
-    val ss = Simplifier.simpset_of thy;
-    val sign = Theory.sign_of thy;
-    val cprops = map (Thm.cterm_of sign o prep_prop (ProofContext.init thy)) raw_props;
-    val atts = map (prep_att thy) raw_atts;
-    val thms = map (smart_mk_cases thy ss) cprops;
-  in
-    thy |>
-    IsarThy.have_theorems_i Drule.lemmaK [(((name, atts), map Thm.no_attributes thms), comment)]
-  end;
+    val cert_prop = Thm.cterm_of (Theory.sign_of thy) o prep_prop (ProofContext.init thy);
+    val mk_cases = smart_mk_cases thy (Simplifier.simpset_of thy) o cert_prop;
+
+    val facts = args |> map (fn (((name, atts), props), comment) =>
+      (((name, map (prep_att thy) atts), map (Thm.no_attributes o mk_cases) props), comment));
+  in thy |> IsarThy.have_theorems_i Drule.lemmaK facts end;
 
 val inductive_cases = gen_inductive_cases Attrib.global_attribute ProofContext.read_prop;
 val inductive_cases_i = gen_inductive_cases (K I) ProofContext.cert_prop;
@@ -891,7 +888,7 @@
 
 
 val ind_cases =
-  P.opt_thm_name ":" -- Scan.repeat1 P.prop -- P.marg_comment
+  P.and_list1 (P.opt_thm_name ":" -- Scan.repeat1 P.prop -- P.marg_comment)
   >> (Toplevel.theory o inductive_cases);
 
 val inductive_casesP =
--- a/src/ZF/Tools/ind_cases.ML	Sat Dec 29 18:34:42 2001 +0100
+++ b/src/ZF/Tools/ind_cases.ML	Sat Dec 29 18:35:27 2001 +0100
@@ -9,7 +9,7 @@
 signature IND_CASES =
 sig
   val declare: string -> (simpset -> cterm -> thm) -> theory -> theory
-  val inductive_cases: ((bstring * Args.src list) * string list) -> theory -> theory
+  val inductive_cases: ((bstring * Args.src list) * string list) list -> theory -> theory
   val setup: (theory -> theory) list
 end;
 
@@ -50,15 +50,14 @@
 
 (* inductive_cases command *)
 
-fun inductive_cases ((name, srcs), props) thy =
+fun inductive_cases args thy =
   let
     val read_prop = ProofContext.read_prop (ProofContext.init thy);
-    val ths = map (smart_cases thy (Simplifier.simpset_of thy) read_prop) props;
-    val atts = map (Attrib.global_attribute thy) srcs;
-  in
-    thy |> IsarThy.have_theorems_i Drule.lemmaK
-      [(((name, atts), map Thm.no_attributes ths), Comment.none)]
-  end;
+    val mk_cases = smart_cases thy (Simplifier.simpset_of thy) read_prop;
+    val facts = args |> map (fn ((name, srcs), props) =>
+      (((name, map (Attrib.global_attribute thy) srcs), map (Thm.no_attributes o mk_cases) props),
+        Comment.none));
+  in thy |> IsarThy.have_theorems_i Drule.lemmaK facts end;
 
 
 (* ind_cases method *)
@@ -85,7 +84,7 @@
 local structure P = OuterParse and K = OuterSyntax.Keyword in
 
 val ind_cases =
-  P.opt_thm_name ":" -- Scan.repeat1 P.prop --| P.marg_comment
+  P.and_list1 (P.opt_thm_name ":" -- Scan.repeat1 P.prop --| P.marg_comment)
   >> (Toplevel.theory o inductive_cases);
 
 val inductive_casesP =