*.inducts holds all projected rules;
authorwenzelm
Thu, 22 Dec 2005 00:28:46 +0100
changeset 18462 b67d423b5234
parent 18461 9125d278fdc8
child 18463 56414918dbbd
*.inducts holds all projected rules;
src/HOL/Tools/datatype_package.ML
--- a/src/HOL/Tools/datatype_package.ML	Thu Dec 22 00:28:44 2005 +0100
+++ b/src/HOL/Tools/datatype_package.ML	Thu Dec 22 00:28:46 2005 +0100
@@ -305,20 +305,20 @@
 fun add_cases_induct infos induction =
   let
     val n = length (HOLogic.dest_concls (Thm.concl_of induction));
-    fun proj i thm =
-      if n = 1 then thm
-      else (if i + 1 < n then (fn th => th RS conjunct1) else I)
-        (Library.funpow i (fn th => th RS conjunct2) thm)
-        |> Drule.zero_var_indexes
-        |> RuleCases.save thm;
+    fun proj i = ProjectRule.project induction (i + 1);
 
     fun named_rules (name, {index, exhaustion, ...}: datatype_info) =
-      [(("", proj index induction), [InductAttrib.induct_type_global name]),
+      [(("", proj index), [InductAttrib.induct_type_global name]),
        (("", exhaustion), [InductAttrib.cases_type_global name])];
     fun unnamed_rule i =
-      (("", proj i induction), [InductAttrib.induct_type_global ""]);
-    val rules = List.concat (map named_rules infos) @ map unnamed_rule (length infos upto n - 1);
-  in snd o PureThy.add_thms rules end;
+      (("", proj i), [Drule.kind_internal, InductAttrib.induct_type_global ""]);
+  in
+    PureThy.add_thms
+      (List.concat (map named_rules infos) @
+        map unnamed_rule (length infos upto n - 1)) #> snd #>
+    PureThy.add_thmss [(("inducts",
+      map (proj #> standard #> RuleCases.save induction) (0 upto n - 1)), [])] #> snd
+  end;