Nominal/Ex/SingleLet.thy
changeset 2311 4da5c5c29009
parent 2308 387fcbd33820
child 2312 ad03df7e8056
--- a/Nominal/Ex/SingleLet.thy	Thu Jun 03 15:02:52 2010 +0200
+++ b/Nominal/Ex/SingleLet.thy	Mon Jun 07 11:43:01 2010 +0200
@@ -4,15 +4,14 @@
 
 atom_decl name
 
-declare [[STEPS = 9]]
-
+declare [[STEPS = 10]]
 
 nominal_datatype trm =
   Var "name"
 | App "trm" "trm"
 | Lam x::"name" t::"trm"  bind_set x in t
 | Let a::"assg" t::"trm"  bind_set "bn a" in t
-| Foo x::"name" y::"name" t::"trm" bind_set x in y t
+| Foo x::"name" y::"name" t::"trm" t1::"trm" t2::"trm" bind_set x in y t t1 t2
 | Bar x::"name" y::"name" t::"trm" bind y x in t x y
 and assg =
   As "name" "name" "trm" "name"
@@ -21,6 +20,145 @@
 where
   "bn (As x y t z) = {atom x}"
 
+thm alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros
+thm alpha_trm_raw.cases alpha_assg_raw.cases alpha_bn_raw.cases
+
+
+lemma [eqvt]:
+ "p \<bullet> alpha_trm_raw x1 y1  = alpha_trm_raw (p \<bullet> x1) (p \<bullet> y1)"
+ "p \<bullet> alpha_assg_raw x2 y2 = alpha_assg_raw (p \<bullet> x2) (p \<bullet> y2)"
+ "p \<bullet> alpha_bn_raw x3 y3   = alpha_bn_raw (p \<bullet> x3) (p \<bullet> y3)"
+sorry
+
+lemmas ii = alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros
+lemmas cc = alpha_trm_raw.cases alpha_assg_raw.cases alpha_bn_raw.cases
+
+ML {*
+length @{thms cc}
+*}
+
+ML {*
+  val pp = ["SingleLet.alpha_trm_raw", "SingleLet.alpha_assg_raw", "SingleLet.alpha_bn_raw"]
+*}
+
+lemma exi_sum: "\<exists>(q :: perm). P q \<Longrightarrow> \<exists>q. Q q \<Longrightarrow> (\<And>p q. P p \<Longrightarrow> Q q \<Longrightarrow> R (p + q)) \<Longrightarrow> \<exists>r. R r"
+apply(erule exE)+
+apply(rule_tac x="q + qa" in exI)
+apply(simp)
+done
+
+lemma alpha_gen_compose_trans:
+  assumes b: "(as, t) \<approx>gen (\<lambda>x1 x2. R x1 x2 \<and> (\<forall>x. R x2 x \<longrightarrow> R x1 x)) f pi (bs, s)"
+  shows "(\<forall>x. R s x \<longrightarrow> R (pi \<bullet> t) x)"
+  using b
+  by (simp add: alphas)
+
+lemma test:
+  assumes b: "(as, t) \<approx>gen R f pi (bs, s)"
+  shows "R (pi \<bullet> t) s"
+  using b
+  by (simp add: alphas)
+
+lemma alpha_gen_trans_eqvt:
+  assumes a: "(bs, x) \<approx>gen R f p (cs, y)" and a1: "(cs, y) \<approx>gen R f q (ds, z)"
+  and b: "\<lbrakk>R (p \<bullet> x) y; R y (- q \<bullet> z)\<rbrakk> \<Longrightarrow> R (p \<bullet> x) (- q \<bullet> z)"
+  shows "(bs, x) \<approx>gen R f (q + p) (ds, z)"
+  sorry
+
+
+lemma
+ "alpha_trm_raw x1 y1  \<Longrightarrow> (\<And>z1. alpha_trm_raw y1 z1 \<Longrightarrow> alpha_trm_raw x1 z1)"
+ "alpha_assg_raw x2 y2 \<Longrightarrow> (\<And>z2. alpha_assg_raw y2 z2 \<Longrightarrow> alpha_assg_raw x2 z2)"
+ "alpha_bn_raw x3 y3   \<Longrightarrow> (\<And>z3. alpha_bn_raw y3 z3 \<Longrightarrow> alpha_bn_raw x3 z3)"
+apply(induct rule: alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.inducts)
+(* 8 *)
+prefer 8
+thm alpha_bn_raw.cases
+apply(rotate_tac -1)
+apply(erule alpha_bn_raw.cases)
+apply(simp_all)[6]
+
+
+apply(rotate_tac -1)
+apply(erule cc)
+apply(simp_all)[6]
+apply(rule ii) 
+apply(simp)
+(* 1 *)
+apply(rotate_tac -1)
+apply(erule cc)
+apply(simp_all)[6]
+apply(rule ii) 
+apply(simp)
+apply(simp)
+(* 2 *)
+apply(rotate_tac -1)
+apply(erule cc)
+apply(simp_all)[6]
+apply(rule ii)
+apply(erule exE)+
+apply(rule_tac x="pa + p" in exI)
+apply(rule alpha_gen_trans_eqvt)
+prefer 2
+apply(assumption)
+apply(simp add: alphas)
+apply(metis)
+apply(drule test)
+apply(simp)
+(* 3 *)
+apply(rotate_tac -1)
+apply(erule cc)
+apply(simp_all)[6]
+apply(rule ii)
+apply(erule exE)+
+apply(rule_tac x="pa + p" in exI)
+apply(rule alpha_gen_trans_eqvt)
+prefer 2
+apply(assumption)
+apply(simp add: alphas)
+apply(metis)
+apply(drule alpha_gen_compose_trans)
+apply(simp)
+apply(simp)
+(* 4 *)
+apply(rotate_tac -1)
+apply(erule cc)
+apply(simp_all)[6]
+apply(rule ii)
+apply(erule exE)+
+apply(rule_tac x="pa + p" in exI)
+apply(rule alpha_gen_trans_eqvt)
+prefer 2
+apply(assumption)
+prefer 2
+apply(drule test)
+apply(simp add: prod_alpha_def)
+apply(simp add: alphas)
+
+apply(drule alpha_gen_compose_trans)
+apply(drule_tac x="(- pa \<bullet> trm_rawaa)" in spec)
+apply(simp)
+apply(simp)
+(* 4 *)
+apply(assumption) 
+apply(simp)
+apply(simp)
+
+(* 3 *)
+
+(* 4 *)
+
+(* 5 *)
+
+(* 6 *)
+
+(* 7 *)
+
+(* 8 *)
+
+(* 9 *)
+done
+
 ML {* Inductive.the_inductive *}
 thm trm_assg.fv
 thm trm_assg.supp