Up to index of Isabelle/HOL/HOL-Nominal/Examples
theory Lam_Funs(* $Id: Lam_Funs.thy,v 1.9 2007/05/03 17:00:28 urbanc Exp $ *) theory Lam_Funs imports "../Nominal" begin atom_decl name nominal_datatype lam = Var "name" | App "lam" "lam" | Lam "«name»lam" ("Lam [_]._" [100,100] 100) text {* depth of a lambda-term *} consts depth :: "lam => nat" nominal_primrec "depth (Var x) = (1::nat)" "depth (App t1 t2) = (max (depth t1) (depth t2)) + 1" "depth (Lam [a].t) = (depth t) + (1::nat)" apply(finite_guess)+ apply(rule TrueI)+ apply(simp add: fresh_nat) apply(fresh_guess)+ done text {* free variables of a lambda-term *} consts frees :: "lam => name set" nominal_primrec (invariant: "λs::name set. finite s") "frees (Var a) = {a}" "frees (App t1 t2) = (frees t1) ∪ (frees t2)" "frees (Lam [a].t) = (frees t) - {a}" apply(finite_guess)+ apply(simp)+ apply(simp add: fresh_def) apply(simp add: supp_of_fin_sets[OF pt_name_inst, OF at_name_inst, OF fs_at_inst[OF at_name_inst]]) apply(simp add: supp_atm) apply(force) apply(fresh_guess)+ done lemma frees_equals_support: shows "frees t = supp t" by (nominal_induct t rule: lam.induct) (simp_all add: lam.supp supp_atm abs_supp) text {* capture-avoiding substitution *} consts subst :: "lam => name => lam => lam" ("_[_::=_]" [100,100,100] 100) nominal_primrec "(Var x)[y::=t'] = (if x=y then t' else (Var x))" "(App t1 t2)[y::=t'] = App (t1[y::=t']) (t2[y::=t'])" "x\<sharp>(y,t') ==> (Lam [x].t)[y::=t'] = Lam [x].(t[y::=t'])" apply(finite_guess)+ apply(rule TrueI)+ apply(simp add: abs_fresh) apply(fresh_guess)+ done lemma subst_eqvt[eqvt]: fixes pi:: "name prm" shows "pi•(t1[b::=t2]) = (pi•t1)[(pi•b)::=(pi•t2)]" apply(nominal_induct t1 avoiding: b t2 rule: lam.induct) apply(auto simp add: perm_bij fresh_prod fresh_atm fresh_bij) done lemma subst_supp: shows "supp(t1[a::=t2]) ⊆ (((supp(t1)-{a})∪supp(t2))::name set)" apply(nominal_induct t1 avoiding: a t2 rule: lam.induct) apply(auto simp add: lam.supp supp_atm fresh_prod abs_supp) apply(blast)+ done text{* parallel substitution *} consts psubst :: "(name×lam) list => lam => lam" ("_<_>" [100,100] 900) fun lookup :: "(name×lam) list => name => lam" where "lookup [] x = Var x" | "lookup ((y,T)#ϑ) x = (if x=y then T else lookup ϑ x)" lemma lookup_eqvt[eqvt]: fixes pi::"name prm" shows "pi•(lookup ϑ x) = lookup (pi•ϑ) (pi•x)" by (induct ϑ) (auto simp add: perm_bij) lemma lookup_fresh: fixes z::"name" assumes "z\<sharp>ϑ" "z\<sharp>x" shows "z\<sharp> lookup ϑ x" using assms by (induct rule: lookup.induct) (auto simp add: fresh_list_cons) lemma lookup_fresh': assumes "z\<sharp>ϑ" shows "lookup ϑ z = Var z" using assms by (induct rule: lookup.induct) (auto simp add: fresh_list_cons fresh_prod fresh_atm) nominal_primrec "ϑ<(Var x)> = (lookup ϑ x)" "ϑ<(App t1 t2)> = App (ϑ<t1>) (ϑ<t2>)" "x\<sharp>ϑ==>ϑ<(Lam [x].t)> = Lam [x].(ϑ<t>)" apply(finite_guess)+ apply(rule TrueI)+ apply(simp add: abs_fresh) apply(fresh_guess)+ done end
lemma frees_equals_support:
frees t = supp t
lemma subst_eqvt:
pi • t1.0[b::=t2.0] = (pi • t1.0)[(pi • b)::=(pi • t2.0)]
lemma subst_supp:
supp (t1.0[a::=t2.0]) ⊆ supp t1.0 - {a} ∪ supp t2.0
lemma lookup_eqvt:
pi • lookup ϑ x = lookup (pi • ϑ) (pi • x)
lemma lookup_fresh:
[| z \<sharp> ϑ; z \<sharp> x |] ==> z \<sharp> lookup ϑ x
lemma lookup_fresh':
z \<sharp> ϑ ==> lookup ϑ z = Var z