Nominal/NewParser.thy
changeset 2316 08bbde090a17
parent 2314 1a14c4171a51
child 2320 d835a2771608
--- a/Nominal/NewParser.thy	Thu Jun 10 14:53:45 2010 +0200
+++ b/Nominal/NewParser.thy	Fri Jun 11 03:02:42 2010 +0200
@@ -326,7 +326,7 @@
 fun nominal_datatype2 dts bn_funs bn_eqs bclauses lthy =
 let
   (* definition of the raw datatypes *)
-
+  val _ = warning "Definition of raw datatypes";
   val (dt_names, raw_dt_names, raw_dts, raw_bclauses, raw_bn_funs, raw_bn_eqs, lthy0) =
     if get_STEPS lthy > 0 
     then raw_nominal_decls dts bn_funs bn_eqs bclauses lthy
@@ -347,6 +347,7 @@
   val exhaust_thms = map #exhaust dtinfos;
 
   (* definitions of raw permutations *)
+  val _ = warning "Definition of raw permutations";
   val ((raw_perm_funs, raw_perm_defs, raw_perm_simps), lthy2) =
     if get_STEPS lthy0 > 1 
     then Local_Theory.theory_result (define_raw_perms descr sorts induct_thm (length dts)) lthy0
@@ -360,6 +361,7 @@
   val thy_name = Context.theory_name thy
 
   (* definition of raw fv_functions *)
+  val _ = warning "Definition of raw fv-functions";
   val lthy3 = Theory_Target.init NONE thy;
 
   val (raw_bn_funs, raw_bn_eqs, raw_bn_info, raw_bn_induct, lthy3a) =
@@ -367,25 +369,25 @@
     then raw_bn_decls dt_names raw_dts raw_bn_funs raw_bn_eqs constr_thms lthy3
     else raise TEST lthy3
 
-  val bn_nos = map (fn (_, i, _) => i) raw_bn_info;
-  val bns = raw_bn_funs ~~ bn_nos;
-
   val (raw_fvs, raw_fv_bns, raw_fv_defs, raw_fv_bns_induct, lthy3b) = 
     if get_STEPS lthy3a > 3 
     then define_raw_fvs descr sorts raw_bn_info raw_bclauses constr_thms lthy3a
     else raise TEST lthy3a
 
   (* definition of raw alphas *)
+  val _ = warning "Definition of alphas";
   val (alpha_trms, alpha_bn_trms, alpha_intros, alpha_cases, alpha_induct, lthy4) =
     if get_STEPS lthy3b > 4 
     then define_raw_alpha descr sorts raw_bn_info raw_bclauses raw_fvs lthy3b
     else raise TEST lthy3b
   
   (* definition of alpha-distinct lemmas *)
+  val _ = warning "Distinct theorems";
   val (alpha_distincts, alpha_bn_distincts) = 
     mk_alpha_distincts lthy4 alpha_cases raw_constrs_distinct alpha_trms alpha_bn_trms raw_bn_info
 
   (* definition of raw_alpha_eq_iff  lemmas *)
+  val _ = warning "Eq-iff theorems";
   val alpha_eq_iff = 
     if get_STEPS lthy > 5
     then mk_alpha_eq_iff lthy4 alpha_intros distinct_thms inject_thms alpha_cases
@@ -418,13 +420,18 @@
   (* proving alpha equivalence *)
   val _ = warning "Proving equivalence"
 
+  val alpha_refl_thms = 
+    if get_STEPS lthy > 9
+    then raw_prove_refl alpha_trms alpha_bn_trms alpha_intros induct_thm lthy_tmp'' 
+    else raise TEST lthy4
+
   val alpha_sym_thms = 
-    if get_STEPS lthy > 9
+    if get_STEPS lthy > 10
     then raw_prove_sym (alpha_trms @ alpha_bn_trms) alpha_intros alpha_induct lthy_tmp'' 
     else raise TEST lthy4
 
   val alpha_trans_thms = 
-    if get_STEPS lthy > 10
+    if get_STEPS lthy > 11
     then raw_prove_trans (alpha_trms @ alpha_bn_trms) (distinct_thms @ inject_thms) 
            alpha_intros alpha_induct alpha_cases lthy_tmp'' 
     else raise TEST lthy4
@@ -432,13 +439,16 @@
 
   val _ = tracing ("alphas " ^ commas (map (Syntax.string_of_term lthy4) alpha_trms))
   val _ = tracing ("alpha_bns " ^ commas (map (Syntax.string_of_term lthy4) alpha_bn_trms))
-  val _ = tracing ("alpha_trans\n" ^ 
-    cat_lines (map (Syntax.string_of_term lthy4 o prop_of) alpha_trans_thms))
+  val _ = tracing ("alpha_refl\n" ^ 
+    cat_lines (map (Syntax.string_of_term lthy4 o prop_of) alpha_refl_thms))
 
   val _ = 
-    if get_STEPS lthy > 11
+    if get_STEPS lthy > 12
     then true else raise TEST lthy4
 
+  val bn_nos = map (fn (_, i, _) => i) raw_bn_info;
+  val bns = raw_bn_funs ~~ bn_nos;
+
   val fv_alpha_all = combine_fv_alpha_bns (raw_fvs, raw_fv_bns) (alpha_trms, alpha_bn_trms) bn_nos
 
   val reflps = build_alpha_refl fv_alpha_all alpha_trms induct_thm alpha_eq_iff lthy4;