--- a/Nominal/Ex/PaperTest.thy Wed Jun 01 16:13:42 2011 +0900
+++ b/Nominal/Ex/PaperTest.thy Wed Jun 01 21:03:30 2011 +0100
@@ -28,7 +28,7 @@
fun
usubst :: "utrm \<Rightarrow> name \<Rightarrow> name \<Rightarrow> utrm" ("_[_:::=_]" [100,100,100] 100)
where
- "(UVar x)[y:::=p] = (if x=y then UnPermute x p else (UVar x))"
+ "(UVar x)[y:::=p] = (if x=y then UnPermute p x else (UVar x))"
| "(UApp t\<^isub>1 t\<^isub>2)[y:::=p] = UApp (t\<^isub>1[y:::=p]) (t\<^isub>2[y:::=p])"
| "(ULam [x].t)[y:::=p] = (if x=y then (ULam [x].t) else ULam [x].(t[y:::=p]))"
| "(UConst n)[y:::=p] = UConst n"
@@ -89,6 +89,29 @@
| "\<parallel>(ULam [x].t)\<parallel> = Lam [x].(\<parallel>t\<parallel>)"
| "\<parallel>(UApp t1 t2)\<parallel> = App (\<parallel>t1\<parallel>) (\<parallel>t2\<parallel>)"
+function
+ utrans :: "trm \<Rightarrow> utrm" ("\<lparr>_\<rparr>" [90] 100)
+where
+ "\<lparr>Var x\<rparr> = UVar x"
+| "\<lparr>Const x\<rparr> = UConst x"
+| "\<lparr>Lam [x].t\<rparr> = ULam [x].\<lparr>t\<rparr>"
+| "\<lparr>App (App (Const ''unpermute'') (Var p)) (Var x)\<rparr> = UnPermute p x"
+| "\<not>(\<exists>p x. t1 = App (Const ''unpermute'') (Var p) \<and> t2 = (Var x)) \<Longrightarrow> \<lparr>App t1 t2\<rparr> = UApp (\<lparr>t1\<rparr>) (\<lparr>t2\<rparr>)"
+defer
+apply(simp_all)
+apply(auto)[1]
+apply(case_tac x)
+apply(simp_all)
+apply(auto)
+apply(blast)
+done
+
+termination
+ apply(relation "measure (\<lambda>t. size t)")
+ apply(simp_all)
+ done
+
+
lemma elim1:
"ufree t \<Longrightarrow> \<parallel>t\<parallel> \<noteq>(Const ''unpermute'')"
apply(erule ufree.induct)
@@ -101,7 +124,7 @@
apply(auto dest: elim1)
done
-lemma
+lemma ss1:
"ufree t \<Longrightarrow> uss t = ss (\<parallel>t\<parallel>)"
apply(erule ufree.induct)
apply(simp_all)
@@ -111,6 +134,51 @@
apply(auto)
done
+lemma trans1:
+ shows "\<parallel>\<lparr>t\<rparr>\<parallel> = t"
+apply(induct t)
+apply(simp)
+apply(simp)
+prefer 2
+apply(simp)
+apply(case_tac "(\<exists>p x. t1 = App (Const ''unpermute'') (Var p) \<and> t2 = (Var x))")
+apply(erule exE)+
+apply(simp)
+apply(simp)
+done
+
+lemma trans_subst:
+ shows "\<lparr>t[x ::= p]\<rparr> = \<lparr>t\<rparr>[x :::= p]"
+apply(induct rule: subst.induct)
+apply(simp)
+defer
+apply(simp)
+apply(simp)
+apply(simp)
+apply(case_tac "(t1 = App (Const ''unpermute'') (Var p) \<and> t2 = (Var x))")
+apply(erule exE)+
+apply(simp only:)
+apply(subst utrans.simps)
+apply(subst usubst.simps)
+apply(case_tac "xa = x")
+apply(subst (asm) subst.simps)
+apply(simp only:)
+apply(subst (asm) utrans.simps)
+apply(simp only: usubst.simps)
+apply(simp)
+apply(auto)[1]
+apply(case_tac "pa = x")
+apply(simp)
+prefer 2
+apply(simp)
+apply(simp)
+done
+
+lemma
+ "ss (t[x ::= p]) = ss t"
+apply(subst (2) trans1[symmetric])
+apply(subst ss1[symmetric])
+
fun
fr :: "trm \<Rightarrow> name set"