Theory Lam_Funs

Up to index of Isabelle/HOL/HOL-Nominal/Examples

theory Lam_Funs
imports Nominal
begin

(* $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:

  pit1.0[b::=t2.0] = (pit1.0)[(pib)::=(pit2.0)]

lemma subst_supp:

  supp (t1.0[a::=t2.0])  supp t1.0 - {a} ∪ supp t2.0

lemma lookup_eqvt:

  pilookup ϑ x = lookup (piϑ) (pix)

lemma lookup_fresh:

  [| z \<sharp> ϑ; z \<sharp> x |] ==> z \<sharp> lookup ϑ x

lemma lookup_fresh':

  z \<sharp> ϑ ==> lookup ϑ z = Var z