Nominal/NewParser.thy
changeset 2299 09bbed4f21d6
parent 2298 aead2aad845c
child 2300 9fb315392493
--- a/Nominal/NewParser.thy	Mon May 24 21:11:33 2010 +0100
+++ b/Nominal/NewParser.thy	Tue May 25 00:24:41 2010 +0100
@@ -305,6 +305,8 @@
 
 setup STEPS_setup
 
+ML {* dtyp_no_of_typ *}
+
 ML {*
 fun nominal_datatype2 dts bn_funs bn_eqs bclauses lthy =
 let
@@ -327,6 +329,9 @@
   val induct_thm = #induct dtinfo;
   val exhaust_thms = map #exhaust dtinfos;
 
+  val bn_nos = map (fn (_, i, _) => i) raw_bn_info;
+  val bns = raw_bn_funs ~~ bn_nos;
+
   (* definitions of raw permutations *)
   val ((raw_perm_funs, raw_perm_defs, raw_perm_simps), lthy2) =
     if get_STEPS lthy1 > 2 
@@ -354,16 +359,12 @@
     then define_raw_alpha descr sorts raw_bn_info raw_bclauses raw_fvs lthy3a
     else raise TEST lthy3a
   
-  val dts_names = map (fn (i, (s, _, _)) => (s, i)) descr;
-  val bn_tys = map (domain_type o fastype_of) raw_bn_funs;
-  val bn_nos = map (dtyp_no_of_typ dts_names) bn_tys;
- 
-  val bns = raw_bn_funs ~~ bn_nos;
+  (* HERE *)
+  (* definition of raw_alpha_eq_iff  lemmas *)
   val rel_dists = flat (map (distinct_rel lthy4 alpha_cases) (rel_distinct ~~ alpha_ts));
   val rel_dists_bn = flat (map (distinct_rel lthy4 alpha_cases)
     ((map (fn i => nth rel_distinct i) bn_nos) ~~ alpha_bn_ts))
-  
-  (* definition of raw_alpha_eq_iff  lemmas *)
+ 
   val alpha_eq_iff = 
     if get_STEPS lthy > 5
     then build_rel_inj alpha_intros (inject_thms @ distinct_thms) alpha_cases lthy4
@@ -375,7 +376,7 @@
   val _ = warning "Proving equivariance";
   val (bv_eqvt, lthy5) = 
     if get_STEPS lthy > 6
-    then prove_eqvt all_tys induct_thm (raw_bn_eqs @ raw_perm_defs) (map fst bns) lthy4
+    then prove_eqvt all_tys induct_thm (raw_bn_eqs @ raw_perm_defs) raw_bn_funs lthy4
     else raise TEST lthy4
 
   val (fv_eqvt, lthy6) =