avoid useless empty case_names;
authorwenzelm
Fri, 02 Oct 2015 19:34:12 +0200
changeset 61308 bb0596c7f921
parent 61307 be3a5fee11e3
child 61309 a2548e708f03
avoid useless empty case_names;
NEWS
src/HOL/Tools/inductive.ML
--- a/NEWS	Fri Oct 02 16:56:46 2015 +0200
+++ b/NEWS	Fri Oct 02 19:34:12 2015 +0200
@@ -197,6 +197,11 @@
 
 *** HOL ***
 
+* Commands 'inductive' and 'inductive_set' work better when names for
+intro rules are omitted: the "cases" and "induct" rules no longer
+declare empty case_names, but no case_names at all. This allows to use
+numbered cases in proofs, without requiring method "goal_cases".
+
 * The 'typedef' command has been upgraded from a partially checked
 "axiomatization", to a full definitional specification that takes the
 global collection of overloaded constant / type definitions into
--- a/src/HOL/Tools/inductive.ML	Fri Oct 02 16:56:46 2015 +0200
+++ b/src/HOL/Tools/inductive.ML	Fri Oct 02 19:34:12 2015 +0200
@@ -834,7 +834,7 @@
         (if null intr_ts then @{term False}
          else foldr1 HOLogic.mk_disj (map transform_rule intr_ts));
 
-    (* add definiton of recursive predicates to theory *)
+    (* add definition of recursive predicates to theory *)
 
     val rec_name =
       if Binding.is_empty alt_name then
@@ -887,20 +887,25 @@
     val rec_name = Binding.name_of rec_binding;
     fun rec_qualified qualified = Binding.qualify qualified rec_name;
     val intr_names = map Binding.name_of intr_bindings;
-    val ind_case_names = Rule_Cases.case_names intr_names;
+    val ind_case_names =
+      if forall (equal "") intr_names then []
+      else [Attrib.internal (K (Rule_Cases.case_names intr_names))];
     val induct =
       if coind then
         (raw_induct,
-         [Rule_Cases.case_names [rec_name],
-          Rule_Cases.case_conclusion (rec_name, intr_names),
-          Rule_Cases.consumes (1 - Thm.nprems_of raw_induct),
-          Induct.coinduct_pred (hd cnames)])
+          map (Attrib.internal o K)
+            [Rule_Cases.case_names [rec_name],
+             Rule_Cases.case_conclusion (rec_name, intr_names),
+             Rule_Cases.consumes (1 - Thm.nprems_of raw_induct),
+             Induct.coinduct_pred (hd cnames)])
       else if no_ind orelse length cnames > 1 then
         (raw_induct,
-          [ind_case_names, Rule_Cases.consumes (~ (Thm.nprems_of raw_induct))])
+          ind_case_names @
+            [Attrib.internal (K (Rule_Cases.consumes (~ (Thm.nprems_of raw_induct))))])
       else
         (raw_induct RSN (2, rev_mp),
-          [ind_case_names, Rule_Cases.consumes (~ (Thm.nprems_of raw_induct))]);
+          ind_case_names @
+            [Attrib.internal (K (Rule_Cases.consumes (~ (Thm.nprems_of raw_induct))))]);
 
     val (intrs', lthy1) =
       lthy |>
@@ -917,15 +922,16 @@
       fold_map (fn (name, (elim, cases, k)) =>
         Local_Theory.note
           ((Binding.qualify true (Long_Name.base_name name) (Binding.name "cases"),
-            [Attrib.internal (K (Rule_Cases.case_names cases)),
-             Attrib.internal (K (Rule_Cases.consumes (1 - Thm.nprems_of elim))),
-             Attrib.internal (K (Rule_Cases.constraints k)),
-             Attrib.internal (K (Induct.cases_pred name)),
-             Attrib.internal (K (Context_Rules.elim_query NONE))]), [elim]) #>
+            map (Attrib.internal o K)
+              ((if forall (equal "") cases then [] else [Rule_Cases.case_names cases]) @
+               [Rule_Cases.consumes (1 - Thm.nprems_of elim),
+                Rule_Cases.constraints k,
+                Induct.cases_pred name,
+                Context_Rules.elim_query NONE])), [elim]) #>
         apfst (hd o snd)) (if null elims then [] else cnames ~~ elims) ||>>
       Local_Theory.note
-        ((rec_qualified true (Binding.name (coind_prefix coind ^ "induct")),
-          map (Attrib.internal o K) (#2 induct)), [rulify lthy1 (#1 induct)]);
+        ((rec_qualified true (Binding.name (coind_prefix coind ^ "induct")), #2 induct),
+          [rulify lthy1 (#1 induct)]);
 
     val (eqs', lthy3) = lthy2 |>
       fold_map (fn (name, eq) => Local_Theory.note
@@ -940,9 +946,9 @@
           lthy3 |>
           Local_Theory.notes [((rec_qualified true (Binding.name "inducts"), []),
             inducts |> map (fn (name, th) => ([th],
-              [Attrib.internal (K ind_case_names),
-               Attrib.internal (K (Rule_Cases.consumes (1 - Thm.nprems_of th))),
-               Attrib.internal (K (Induct.induct_pred name))])))] |>> snd o hd
+              ind_case_names @
+                [Attrib.internal (K (Rule_Cases.consumes (1 - Thm.nprems_of th))),
+                 Attrib.internal (K (Induct.induct_pred name))])))] |>> snd o hd
         end;
   in (intrs', elims', eqs', induct', inducts, lthy4) end;