adding Spec_Rules to definitional package inductive and inductive_set
authorbulwahn
Fri, 12 Mar 2010 12:14:31 +0100
changeset 35757 c2884bec5463
parent 35756 cfde251d03a5
child 35758 c029f85d3879
adding Spec_Rules to definitional package inductive and inductive_set
src/HOL/Tools/inductive.ML
src/HOL/Tools/inductive_set.ML
--- a/src/HOL/Tools/inductive.ML	Fri Mar 12 12:14:30 2010 +0100
+++ b/src/HOL/Tools/inductive.ML	Fri Mar 12 12:14:31 2010 +0100
@@ -71,7 +71,7 @@
     term list -> (Attrib.binding * term) list -> thm list ->
     term list -> (binding * mixfix) list ->
     local_theory -> inductive_result * local_theory
-  val declare_rules: binding -> bool -> bool -> string list ->
+  val declare_rules: binding -> bool -> bool -> string list -> term list ->
     thm list -> binding list -> Attrib.src list list -> (thm * string list * int) list ->
     thm -> local_theory -> thm list * thm list * thm * thm list * local_theory
   val add_ind_def: add_ind_def
@@ -698,7 +698,7 @@
   end;
 
 fun declare_rules rec_binding coind no_ind cnames
-    intrs intr_bindings intr_atts elims raw_induct lthy =
+    preds intrs intr_bindings intr_atts elims raw_induct lthy =
   let
     val rec_name = Binding.name_of rec_binding;
     fun rec_qualified qualified = Binding.qualify qualified rec_name;
@@ -715,6 +715,8 @@
 
     val (intrs', lthy1) =
       lthy |>
+      Spec_Rules.add
+        (if coind then Spec_Rules.Co_Inductive else Spec_Rules.Inductive) (preds, intrs) |>
       Local_Theory.notes
         (map (rec_qualified false) intr_bindings ~~ intr_atts ~~
           map (fn th => [([th],
@@ -797,7 +799,7 @@
            rec_preds_defs lthy1);
 
     val (intrs', elims', induct, inducts, lthy2) = declare_rules rec_name coind no_ind
-      cnames intrs intr_names intr_atts elims raw_induct lthy1;
+      cnames preds intrs intr_names intr_atts elims raw_induct lthy1;
 
     val result =
       {preds = preds,
--- a/src/HOL/Tools/inductive_set.ML	Fri Mar 12 12:14:30 2010 +0100
+++ b/src/HOL/Tools/inductive_set.ML	Fri Mar 12 12:14:31 2010 +0100
@@ -521,7 +521,7 @@
     val (intr_names, intr_atts) = split_list (map fst intros);
     val raw_induct' = to_set [] (Context.Proof lthy3) raw_induct;
     val (intrs', elims', induct, inducts, lthy4) =
-      Inductive.declare_rules rec_name coind no_ind cnames
+      Inductive.declare_rules rec_name coind no_ind cnames (map fst defs)
         (map (to_set [] (Context.Proof lthy3)) intrs) intr_names intr_atts
         (map (fn th => (to_set [] (Context.Proof lthy3) th,
            map fst (fst (Rule_Cases.get th)),