Add explicit alpha_eqvt_cheat.
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Thu, 11 Mar 2010 10:22:24 +0100
changeset 1408 b452e11e409f
parent 1407 beeaa85c9897
child 1409 25b02cc185e2
child 1423 d59f851926c5
Add explicit alpha_eqvt_cheat.
Nominal/Parser.thy
--- a/Nominal/Parser.thy	Thu Mar 11 10:10:23 2010 +0100
+++ b/Nominal/Parser.thy	Thu Mar 11 10:22:24 2010 +0100
@@ -270,6 +270,7 @@
 *}
 
 ML {* val restricted_nominal=ref 0 *}
+ML {* val cheat_alpha_eqvt = ref true *}
 
 ML {*
 fun nominal_datatype2 dts bn_funs bn_eqs binds lthy =
@@ -317,6 +318,11 @@
   val alpha_cases = ProofContext.export lthy4 lthy3 alpha_cases_loc
   val alpha_inj_loc = build_alpha_inj alpha_intros (inject @ distinct) alpha_cases_loc lthy4
   val alpha_inj = ProofContext.export lthy4 lthy3 alpha_inj_loc
+  fun alpha_eqvt_tac' _ =
+    if !cheat_alpha_eqvt then Skip_Proof.cheat_tac thy
+    else alpha_eqvt_tac alpha_induct_loc (raw_perm_def @ alpha_inj_loc) lthy4 1
+  val alpha_eqvt_loc = build_alpha_eqvts (List.take (alpha_ts_loc, length perms)) perms alpha_eqvt_tac' lthy4;
+  val alpha_eqvt = ProofContext.export lthy4 lthy2 alpha_eqvt_loc;
 in
 if !restricted_nominal = 0 then
   ((raw_dt_names, raw_bn_funs, raw_bn_eqs, raw_binds), lthy4)
@@ -327,9 +333,6 @@
     ((flat (map snd bv_eqvts)) @ fv_def_loc @ raw_perm_def) induct lthy5;
   val raw_fv_bv_eqvt_loc = flat (map snd bv_eqvts) @ (snd fv_eqvts)
   val raw_fv_bv_eqvt = ProofContext.export lthy6 lthy3 raw_fv_bv_eqvt_loc;
-  fun alpha_eqvt_tac' _ = alpha_eqvt_tac alpha_induct_loc (raw_perm_def @ alpha_inj_loc) lthy6 1
-  val alpha_eqvt_loc = build_alpha_eqvts alpha_ts_loc perms alpha_eqvt_tac' lthy6;
-  val alpha_eqvt = ProofContext.export lthy6 lthy2 alpha_eqvt_loc;
   val alpha_equivp_loc = map (equivp_hack lthy6) alpha_ts_loc
   val alpha_equivp_loc = build_equivps alpha_ts_loc induct alpha_induct_loc
     inject alpha_inj_loc distinct alpha_cases_loc alpha_eqvt_loc lthy6;