(* $Id: Height.thy,v 1.10 2007/06/14 21:04:37 wenzelm Exp $ *) (* Simple problem suggested by D. Wang *) theory Height imports "../Nominal" begin atom_decl name nominal_datatype lam = Var "name" | App "lam" "lam" | Lam "«name»lam" ("Lam [_]._" [100,100] 100) text {* definition of the height-function on lambda-terms *} consts height :: "lam => int" nominal_primrec "height (Var x) = 1" "height (App t1 t2) = (max (height t1) (height t2)) + 1" "height (Lam [a].t) = (height t) + 1" apply(finite_guess add: perm_int_def)+ apply(rule TrueI)+ apply(simp add: fresh_int) apply(fresh_guess add: perm_int_def)+ done text {* definition of 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; x\<sharp>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 text{* the next lemma is needed in the Var-case of the theorem *} lemma height_ge_one: shows "1 ≤ (height e)" apply (nominal_induct e rule: lam.induct) by simp_all text {* unlike the proplem suggested by Wang, however, the theorem is here formulated entirely by using functions *} theorem height_subst: shows "height (e[x::=e']) ≤ (((height e) - 1) + (height e'))" proof (nominal_induct e avoiding: x e' rule: lam.induct) case (Var y) have "1 ≤ height e'" by (rule height_ge_one) then show "height (Var y[x::=e']) ≤ height (Var y) - 1 + height e'" by simp next case (Lam y e1) hence ih: "height (e1[x::=e']) ≤ (((height e1) - 1) + (height e'))" by simp moreover have vc: "y\<sharp>x" "y\<sharp>e'" by fact+ (* usual variable convention *) ultimately show "height ((Lam [y].e1)[x::=e']) ≤ height (Lam [y].e1) - 1 + height e'" by simp next case (App e1 e2) hence ih1: "height (e1[x::=e']) ≤ (((height e1) - 1) + (height e'))" and ih2: "height (e2[x::=e']) ≤ (((height e2) - 1) + (height e'))" by simp_all then show "height ((App e1 e2)[x::=e']) ≤ height (App e1 e2) - 1 + height e'" by simp qed end
lemma height_ge_one:
1 ≤ height e
theorem height_subst:
height (e[x::=e']) ≤ height e - 1 + height e'