CookBook/Package/simple_inductive_package.ML
changeset 118 5f003fdf2653
parent 116 c9ff326e3ce5
child 120 c39f83d8daeb
--- a/CookBook/Package/simple_inductive_package.ML	Sat Feb 14 00:24:05 2009 +0000
+++ b/CookBook/Package/simple_inductive_package.ML	Sat Feb 14 13:20:21 2009 +0000
@@ -20,17 +20,21 @@
 
 fun mk_all x P = HOLogic.all_const (fastype_of x) $ lambda x P 
 
-(* @chunk definitions *) 
-fun define_aux s ((binding, syn), (attr, trm)) lthy =
+(* @chunk definitions_aux *) 
+fun definitions_aux s ((binding, syn), (attr, trm)) lthy =
 let 
-  val ((_, (_ , thm)), lthy) = LocalTheory.define s ((binding, syn), (attr, trm)) lthy
+  val ((_, (_, thm)), lthy) = 
+                LocalTheory.define s ((binding, syn), (attr, trm)) lthy
 in 
   (thm, lthy) 
 end
+(* @end *)
 
-fun DEFINITION params' rules preds preds' Tss lthy =
+(* @chunk definitions *) 
+fun definitions params rules preds preds' Tss lthy =
 let
-  val rules' = map (ObjectLogic.atomize_term (ProofContext.theory_of lthy)) rules
+  val thy = ProofContext.theory_of lthy
+  val rules' = map (ObjectLogic.atomize_term thy) rules
 in
   fold_map (fn ((((R, _), syn), pred), Ts) =>
     let 
@@ -39,9 +43,9 @@
       val t0 = list_comb (pred, zs);
       val t1 = fold_rev (curry HOLogic.mk_imp) rules' t0;
       val t2 = fold_rev mk_all preds' t1;      
-      val t3 = fold_rev lambda (params' @ zs) t2;
+      val t3 = fold_rev lambda (params @ zs) t2;
     in
-      define_aux Thm.internalK ((R, syn), (Attrib.empty_binding, t3))
+      definitions_aux Thm.internalK ((R, syn), (Attrib.empty_binding, t3))
     end) (preds ~~ preds' ~~ Tss) lthy
 end
 (* @end *)
@@ -125,7 +129,7 @@
     val Tss = map (binder_types o fastype_of) preds';   
     val (ass,rules) = split_list specs;    
 
-    val (defs, lthy1) = DEFINITION params' rules preds preds' Tss lthy
+    val (defs, lthy1) = definitions params' rules preds preds' Tss lthy
     val (_, lthy2) = Variable.add_fixes (map (Binding.base_name o fst) params) lthy1;
       
     val inducts = INDUCTION rules preds' Tss defs lthy1 lthy2
@@ -190,7 +194,7 @@
       Toplevel.local_theory loc (add_inductive preds params specs))
 
 val _ = OuterSyntax.command "simple_inductive" "define inductive predicates"
-  OuterKeyword.thy_decl ind_decl;
+          OuterKeyword.thy_decl ind_decl
 (* @end *)
 
 end;