Nominal/Parser.thy
changeset 1495 219e3ff68de8
parent 1494 923413256cbb
child 1496 fd483d8f486b
--- a/Nominal/Parser.thy	Thu Mar 18 07:26:36 2010 +0100
+++ b/Nominal/Parser.thy	Thu Mar 18 07:35:44 2010 +0100
@@ -324,7 +324,7 @@
   val dts_names = map (fn (i, (s, _, _)) => (s, i)) (#descr dtinfo);
   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;
+  val bns = raw_bn_funs ~~ bn_nos; (* Are exported *)
   val alpha_intros_loc = #intrs alpha;
   val alpha_cases_loc = #elims alpha
   val alpha_intros = ProofContext.export lthy4 lthy3 alpha_intros_loc
@@ -335,30 +335,28 @@
   val (bv_eqvts, lthy5) = fold_map (build_bv_eqvt (raw_bn_eqs @ raw_perm_def) inducts) bns lthy4;
   val fv_eqvt_tac =
     if !cheat_fv_eqvt then (fn _ => fn _ => Skip_Proof.cheat_tac thy)
-    else build_eqvts_tac induct ((flat (map snd bv_eqvts)) @ fv_def_loc @ raw_perm_def) lthy5
-  val (fv_eqvts, lthy6) = build_eqvts Binding.empty fv_ts_loc_nobn fv_eqvt_tac lthy5;
-  val (fv_bn_eqvts, lthy6a) = 
-    if fv_ts_loc_bn = [] then ([], lthy6) else
-    fold_map (build_bv_eqvt ((flat (map snd bv_eqvts)) @ fv_def_loc @ raw_perm_def) inducts) 
-      (fv_ts_loc_bn ~~ (map snd bns)) lthy6;
-  val lthy6 = lthy6a;
-  val raw_fv_bv_eqvt_loc = flat (map snd bv_eqvts) @ (snd fv_eqvts)
-  val raw_fv_bv_eqvt = ProofContext.export lthy6 lthy2 raw_fv_bv_eqvt_loc;
+    else build_eqvts_tac induct ((flat (map snd bv_eqvts)) @ fv_def @ raw_perm_def) lthy5
+  val (fv_eqvts, lthy6) = build_eqvts Binding.empty fv_ts_nobn fv_eqvt_tac lthy5;
+  val (fv_bn_eqvts, lthy6a) =
+    if fv_ts_bn = [] then ([], lthy6) else
+    fold_map (build_bv_eqvt ((flat (map snd bv_eqvts)) @ fv_def @ raw_perm_def) inducts)
+      (fv_ts_bn ~~ (map snd bns)) lthy6;
+  val raw_fv_bv_eqvt = flat (map snd bv_eqvts) @ (snd fv_eqvts) @ flat (map snd fv_bn_eqvts)
   fun alpha_eqvt_tac' _ =
     if !cheat_alpha_eqvt then Skip_Proof.cheat_tac thy
-    else alpha_eqvt_tac alpha_induct (raw_perm_def @ alpha_inj @ raw_fv_bv_eqvt) lthy6 1
-  val alpha_eqvt = build_alpha_eqvts alpha_ts alpha_eqvt_tac' lthy6;
+    else alpha_eqvt_tac alpha_induct (raw_perm_def @ alpha_inj @ raw_fv_bv_eqvt) lthy6a 1
+  val alpha_eqvt = build_alpha_eqvts alpha_ts alpha_eqvt_tac' lthy6a;
   val _ = tracing "Proving equivalence";
   val alpha_equivp =
-    if !cheat_equivp then map (equivp_hack lthy6) alpha_ts_nobn
+    if !cheat_equivp then map (equivp_hack lthy6a) alpha_ts_nobn
     else build_equivps alpha_ts induct alpha_induct
-      inject alpha_inj distincts alpha_cases alpha_eqvt lthy6;
+      inject alpha_inj distincts alpha_cases alpha_eqvt lthy6a;
   val qty_binds = map (fn (_, b, _, _) => b) dts;
   val qty_names = map Name.of_binding qty_binds;
   val qty_full_names = map (Long_Name.qualify thy_name) qty_names
   val lthy7 = define_quotient_type
     (map (fn ((b, t), alpha) => (([], b, NoSyn), (t, alpha))) ((qty_binds ~~ all_typs) ~~ alpha_ts_nobn))
-    (ALLGOALS (resolve_tac alpha_equivp)) lthy6;
+    (ALLGOALS (resolve_tac alpha_equivp)) lthy6a;
   val const_names = map Name.of_binding (flat (map (fn (_, _, _, t) => map (fn (b, _, _) => b) t) dts));
   val raw_consts =
     flat (map (fn (i, (_, _, l)) =>