Reintroduced nitpick_ind_intro attribute.
authorblanchet
Mon, 09 Feb 2009 12:31:36 +0100
changeset 29868 787349bb53e9
parent 29867 0abd89253a0f
child 29869 a7a8b90cd882
Reintroduced nitpick_ind_intro attribute. It looks like I need it nonetheless.
src/HOL/HOL.thy
src/HOL/Tools/inductive_package.ML
--- a/src/HOL/HOL.thy	Mon Feb 09 10:39:57 2009 +0100
+++ b/src/HOL/HOL.thy	Mon Feb 09 12:31:36 2009 +0100
@@ -1714,9 +1714,15 @@
   val name = "nitpick_const_psimp"
   val description = "Partial equational specification of constants as needed by Nitpick"
 )
+structure Nitpick_Ind_Intro_Thms = NamedThmsFun
+(
+  val name = "nitpick_ind_intro"
+  val description = "Introduction rules for (co)inductive predicates as needed by Nitpick"
+)
 *}
 setup {* Nitpick_Const_Simp_Thms.setup
-         #> Nitpick_Const_Psimp_Thms.setup *}
+         #> Nitpick_Const_Psimp_Thms.setup
+         #> Nitpick_Ind_Intro_Thms.setup *}
 
 subsection {* Legacy tactics and ML bindings *}
 
--- a/src/HOL/Tools/inductive_package.ML	Mon Feb 09 10:39:57 2009 +0100
+++ b/src/HOL/Tools/inductive_package.ML	Mon Feb 09 12:31:36 2009 +0100
@@ -691,7 +691,8 @@
       ctxt |>
       LocalTheory.notes kind
         (map rec_qualified intr_bindings ~~ intr_atts ~~ map (fn th => [([th],
-           [Attrib.internal (K (ContextRules.intro_query NONE))])]) intrs) |>>
+           [Attrib.internal (K (ContextRules.intro_query NONE)),
+            Attrib.internal (K Nitpick_Ind_Intro_Thms.add)])]) intrs) |>>
       map (hd o snd);
     val (((_, elims'), (_, [induct'])), ctxt2) =
       ctxt1 |>