Fix in alpha; support of the recursive Let works :)
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Wed, 17 Mar 2010 09:57:54 +0100
changeset 1472 4fa5365cd871
parent 1471 7fe643ad19e4
child 1473 b4216d0e109a
child 1474 8a03753e0e02
Fix in alpha; support of the recursive Let works :)
Nominal/Fv.thy
Nominal/Test.thy
--- a/Nominal/Fv.thy	Wed Mar 17 09:42:56 2010 +0100
+++ b/Nominal/Fv.thy	Wed Mar 17 09:57:54 2010 +0100
@@ -364,13 +364,16 @@
           val rel_has_binds = filter (fn ((NONE, _, j), _) => j = arg_no
                                        | ((SOME (_, false), _, j), _) => j = arg_no
                                        | _ => false) bind_pis;
+          val rel_has_rec_binds = filter 
+            (fn ((SOME (_, true), _, j), _) => j = arg_no | _ => false) bind_pis;
         in
-          case (rel_in_simp_binds, rel_in_comp_binds, rel_has_binds) of
-            ([], [], []) =>
+          case (rel_in_simp_binds, rel_in_comp_binds, rel_has_binds, rel_has_rec_binds) of
+            ([], [], [], []) =>
               if is_rec_type dt then (nth alpha_frees (body_index dt) $ arg $ arg2)
               else (HOLogic.mk_eq (arg, arg2))
-          | (_, [], []) => @{term True}
-          | ([], ((((SOME (bn, is_rec)), _, _), pi) :: _), []) =>
+          | (_, [], [], []) => @{term True}
+          | ([], [], [], _) => @{term True}
+          | ([], ((((SOME (bn, is_rec)), _, _), pi) :: _), [], []) =>
             if not (bns_same rel_in_comp_binds) then error "incompatible bindings for an argument" else
             if is_rec then
               let
@@ -409,7 +412,7 @@
               in
                 alpha_bn_const $ arg $ arg2
               end
-          | ([], [], relevant) =>
+          | ([], [], relevant, []) =>
             let
               val (rbinds, rpis) = split_list relevant
               val lhs_binds = fv_binds args rbinds
--- a/Nominal/Test.thy	Wed Mar 17 09:42:56 2010 +0100
+++ b/Nominal/Test.thy	Wed Mar 17 09:57:54 2010 +0100
@@ -131,7 +131,7 @@
 thm lam'_bp'_distinct
 ML {* Sign.of_sort @{theory} (@{typ lam'}, @{sort fs}) *}
 
-lemma supp_fv:
+lemma supp_fv':
   shows "supp t = fv_lam' t" 
   and "supp bp = fv_bp' bp"
 apply(induct t and bp rule: lam'_bp'_inducts)
@@ -174,9 +174,21 @@
 apply(simp only: eqvts split_def fst_conv snd_conv)
 apply(simp only: eqvts[symmetric] supp_Pair)
 apply(simp only: eqvts Pair_eq)
-oops
+apply(simp add: supp_Abs supp_Pair)
+apply blast
+apply(simp only: supp_def)
+apply(simp only: lam'_bp'_perm)
+apply(simp only: lam'_bp'_inject)
+apply(simp only: de_Morgan_conj)
+apply(simp only: Collect_disj_eq)
+apply(simp only: infinite_Un)
+apply(simp only: Collect_disj_eq)
+apply(simp only: supp_def[symmetric])
+apply(simp only: supp_at_base supp_atom)
+apply simp
+done
 
-thm lam_bp_fv[simplified supp_fv(1)[symmetric] supp_fv(2)[THEN conjunct1, symmetric]]
+thm lam'_bp'_fv[simplified supp_fv'[symmetric]]
 
 
 text {* example 2 *}