diff -r 4e5a7b606eab -r 08bbde090a17 Nominal/NewParser.thy --- 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;