add_cases_induct: induct_method setup;
authorwenzelm
Sun, 27 Feb 2000 15:32:10 +0100
changeset 8307 6600c6e53111
parent 8306 9855f1801d2b
child 8308 45e11d3ccbe4
add_cases_induct: induct_method setup; removed cases_of, all_cases, all_inducts;
src/HOL/Tools/inductive_package.ML
--- a/src/HOL/Tools/inductive_package.ML	Sun Feb 27 15:31:40 2000 +0100
+++ b/src/HOL/Tools/inductive_package.ML	Sun Feb 27 15:32:10 2000 +0100
@@ -36,9 +36,6 @@
     {names: string list, coind: bool} * {defs: thm list, elims: thm list, raw_induct: thm,
       induct: thm, intrs: thm list, mk_cases: string -> thm, mono: thm, unfold: thm}
   val print_inductives: theory -> unit
-  val cases_of: Sign.sg -> string -> thm
-  val all_cases: Sign.sg -> thm list
-  val all_inducts: Sign.sg -> thm list
   val mono_add_global: theory attribute
   val mono_del_global: theory attribute
   val get_monos: theory -> thm list
@@ -106,24 +103,6 @@
   in InductiveData.put tab_monos thy end;
 
 
-(* cases and induct rules *)
-
-fun cases_of sg name =
-  let
-    fun find (None, (_, ({names, ...}, {elims, ...}): inductive_info)) =
-          assoc (names ~~ elims, name)
-      | find (some, _) = some;
-    val (tab, _) = InductiveData.get_sg sg;
-  in
-    (case Symtab.foldl find (None, tab) of
-      None => error ("Unknown (co)inductive set " ^ quote name)
-    | Some thm => thm)
-  end;
-
-fun all_cases sg = flat (map (#elims o #2 o #2) (Symtab.dest (#1 (InductiveData.get_sg sg))));
-fun all_inducts sg = map (#induct o #2 o #2) (Symtab.dest (#1 (InductiveData.get_sg sg)));
-      
-
 
 (** monotonicity rules **)
 
@@ -765,6 +744,12 @@
 
 (** introduction of (co)inductive sets **)
 
+fun add_cases_induct names elims induct =
+  PureThy.add_thms
+    (map (fn name => (("", induct), [InductMethod.induct_set_global name])) names @
+     map2 (fn (name, elim) => (("", elim), [InductMethod.cases_set_global name])) (names, elims));
+
+
 fun add_inductive_i verbose declare_consts alt_name coind no_elim no_ind cs
     atts intros monos con_defs thy =
   let
@@ -789,7 +774,9 @@
       (if ! quick_and_dirty then add_ind_axm else add_ind_def)
         verbose declare_consts alt_name coind no_elim no_ind cs atts intros monos
         con_defs thy params paramTs cTs cnames;
-    val thy2 = thy1 |> put_inductives full_cnames ({names = full_cnames, coind = coind}, result);
+    val thy2 = thy1
+      |> put_inductives full_cnames ({names = full_cnames, coind = coind}, result)
+      |> add_cases_induct full_cnames (#elims result) (#induct result);
   in (thy2, result) end;