diff -r 3f617d7a2691 -r 890fbfef6d6b CookBook/Package/simple_inductive_package.ML
--- a/CookBook/Package/simple_inductive_package.ML	Tue Mar 10 13:20:46 2009 +0000
+++ b/CookBook/Package/simple_inductive_package.ML	Wed Mar 11 01:43:28 2009 +0000
@@ -137,24 +137,25 @@
   end)
 (* @end *)
 
+fun introductions_tac defs rules preds i ctxt =
+  EVERY1 [ObjectLogic.rulify_tac,
+          K (rewrite_goals_tac defs),
+          REPEAT o (resolve_tac [@{thm allI},@{thm impI}]),
+          subproof1 rules preds i ctxt]
+
+
 (* @chunk intro_rules *) 
-fun INTROS rules parnames preds defs lthy1 = 
+fun introductions rules parnames preds defs lthy1 = 
 let
   val (_, lthy2) = Variable.add_fixes parnames lthy1
 
   fun prove_intro (i, goal) =
     Goal.prove lthy2 [] [] goal
-        (fn {context = ctxt, ...} => 
-           EVERY1
-           [ObjectLogic.rulify_tac,
-            K (rewrite_goals_tac defs),
-            REPEAT o (resolve_tac [@{thm allI},@{thm impI}]),
-            subproof1 rules preds i ctxt])
-        |> singleton (ProofContext.export lthy2 lthy1)
+       (fn {context, ...} => introductions_tac defs rules preds i context)
+       |> singleton (ProofContext.export lthy2 lthy1)
 in
   map_index prove_intro rules
 end
-
 (* @end *)
 
 (* @chunk add_inductive_i *)
@@ -163,7 +164,7 @@
   val params' = map (fn (p, T) => Free (Binding.name_of p, T)) params;
   val preds' = map (fn ((R, T), _) => list_comb (Free (Binding.name_of R, T), params')) preds;
   val Tss = map (binder_types o fastype_of) preds';   
-  val (ass,rules) = split_list specs;    
+  val (ass, rules) = split_list specs;  (* FIXME: ass not used? *)  
 
   val prednames = map (fst o fst) preds
   val syns = map snd preds
@@ -173,7 +174,7 @@
       
   val inducts = inductions rules defs parnames preds' Tss lthy1 	
   
-  val intros = INTROS rules parnames preds' defs lthy1
+  val intros = introductions rules parnames preds' defs lthy1
 
   val mut_name = space_implode "_" (map (Binding.name_of o fst o fst) preds);
   val case_names = map (Binding.name_of o fst o fst) specs