provide projections of induct_weak, induct_unsafe;
authorwenzelm
Thu, 05 Jan 2006 17:16:38 +0100
changeset 18582 4f4cc426b440
parent 18581 6538fdcc98dc
child 18583 96e1ef2f806f
provide projections of induct_weak, induct_unsafe;
src/HOL/Nominal/nominal_package.ML
--- a/src/HOL/Nominal/nominal_package.ML	Thu Jan 05 17:14:08 2006 +0100
+++ b/src/HOL/Nominal/nominal_package.ML	Thu Jan 05 17:16:38 2006 +0100
@@ -75,6 +75,10 @@
     rtac indrule' i st
   end;
 
+fun projections rule =
+  ProjectRule.projections rule
+  |> map (standard #> RuleCases.save rule);
+
 fun gen_add_nominal_datatype prep_typ err flat_names new_type_names dts thy =
   let
     (* this theory is used just for parsing *)
@@ -1066,10 +1070,11 @@
 
     val simp_atts = replicate (length new_type_names) [Simplifier.simp_add_global];
 
-    val (_, thy9) = (thy8:Context.theory) |>
+    val ((_, [induct_rule]), thy9) = thy8 |>
       Theory.add_path big_name |>
       PureThy.add_thms [(("induct_weak", dt_induct), [case_names_induct])] ||>
-      Theory.parent_path ||>>
+      (PureThy.add_thmss [(("inducts_weak", projections dt_induct), [case_names_induct])] #> snd)
+      ||> Theory.parent_path ||>>
       DatatypeAux.store_thmss_atts "distinct" new_type_names simp_atts distinct_thms ||>>
       DatatypeAux.store_thmss "constr_rep" new_type_names constr_rep_thmss ||>>
       DatatypeAux.store_thmss_atts "perm" new_type_names simp_atts perm_simps' ||>>
@@ -1084,11 +1089,13 @@
             (AxClass.intro_classes_tac [] THEN resolve_tac ths 1)) newTs thy
         end) (atoms ~~ finite_supp_thms) ||>
       Theory.add_path big_name ||>>
-      PureThy.add_axioms_i [(("induct_unsafe", induct), [case_names_induct])] ||>
-      Theory.parent_path;
-
+      PureThy.add_axioms_i [(("induct_unsafe", induct), [case_names_induct])]
+    val thy10 = thy9
+      |> PureThy.add_thmss [(("inducts_unsafe", projections induct_rule), [case_names_induct])]
+      |> snd
+      |> Theory.parent_path;
   in
-    thy9
+    thy10
   end;
 
 val add_nominal_datatype = gen_add_nominal_datatype read_typ true;