header {*
\chapter{Bytecode Verifier}\label{cha:bv}
\isaheader{Semilattices}
*}
theory Semilat
imports Main While_Combinator
begin
types 'a ord = "'a => 'a => bool"
'a binop = "'a => 'a => 'a"
'a sl = "'a set * 'a ord * 'a binop"
consts
"@lesub" :: "'a => 'a ord => 'a => bool" ("(_ /<='__ _)" [50, 1000, 51] 50)
"@lesssub" :: "'a => 'a ord => 'a => bool" ("(_ /<'__ _)" [50, 1000, 51] 50)
defs
lesub_def: "x <=_r y == r x y"
lesssub_def: "x <_r y == x <=_r y & x ~= y"
syntax (xsymbols)
"@lesub" :: "'a => 'a ord => 'a => bool" ("(_ /≤_ _)" [50, 1000, 51] 50)
consts
"@plussub" :: "'a => ('a => 'b => 'c) => 'b => 'c" ("(_ /+'__ _)" [65, 1000, 66] 65)
defs
plussub_def: "x +_f y == f x y"
syntax (xsymbols)
"@plussub" :: "'a => ('a => 'b => 'c) => 'b => 'c" ("(_ /+_ _)" [65, 1000, 66] 65)
syntax (xsymbols)
"@plussub" :: "'a => ('a => 'b => 'c) => 'b => 'c" ("(_ /\<squnion>_ _)" [65, 1000, 66] 65)
constdefs
order :: "'a ord => bool"
"order r == (!x. x <=_r x) &
(!x y. x <=_r y & y <=_r x --> x=y) &
(!x y z. x <=_r y & y <=_r z --> x <=_r z)"
acc :: "'a ord => bool"
"acc r == wfP (λy x. x <_r y)"
top :: "'a ord => 'a => bool"
"top r T == !x. x <=_r T"
closed :: "'a set => 'a binop => bool"
"closed A f == !x:A. !y:A. x +_f y : A"
semilat :: "'a sl => bool"
"semilat == %(A,r,f). order r & closed A f &
(!x:A. !y:A. x <=_r x +_f y) &
(!x:A. !y:A. y <=_r x +_f y) &
(!x:A. !y:A. !z:A. x <=_r z & y <=_r z --> x +_f y <=_r z)"
is_ub :: "'a ord => 'a => 'a => 'a => bool"
"is_ub r x y u == r x u & r y u"
is_lub :: "'a ord => 'a => 'a => 'a => bool"
"is_lub r x y u == is_ub r x y u & (!z. is_ub r x y z --> r u z)"
some_lub :: "'a ord => 'a => 'a => 'a"
"some_lub r x y == SOME z. is_lub r x y z";
locale Semilat =
fixes A :: "'a set"
and r :: "'a ord"
and f :: "'a binop"
assumes semilat: "semilat(A,r,f)"
lemma order_refl [simp, intro]:
"order r ==> x <=_r x";
by (simp add: order_def)
lemma order_antisym:
"[| order r; x <=_r y; y <=_r x |] ==> x = y"
apply (unfold order_def)
apply (simp (no_asm_simp))
done
lemma order_trans:
"[| order r; x <=_r y; y <=_r z |] ==> x <=_r z"
apply (unfold order_def)
apply blast
done
lemma order_less_irrefl [intro, simp]:
"order r ==> ~ x <_r x"
apply (unfold order_def lesssub_def)
apply blast
done
lemma order_less_trans:
"[| order r; x <_r y; y <_r z |] ==> x <_r z"
apply (unfold order_def lesssub_def)
apply blast
done
lemma topD [simp, intro]:
"top r T ==> x <=_r T"
by (simp add: top_def)
lemma top_le_conv [simp]:
"[| order r; top r T |] ==> (T <=_r x) = (x = T)"
by (blast intro: order_antisym)
lemma semilat_Def:
"semilat(A,r,f) == order r & closed A f &
(!x:A. !y:A. x <=_r x +_f y) &
(!x:A. !y:A. y <=_r x +_f y) &
(!x:A. !y:A. !z:A. x <=_r z & y <=_r z --> x +_f y <=_r z)"
apply (unfold semilat_def split_conv [THEN eq_reflection])
apply (rule refl [THEN eq_reflection])
done
lemma (in Semilat) orderI [simp, intro]:
"order r"
by (insert semilat) (simp add: semilat_Def)
lemma (in Semilat) closedI [simp, intro]:
"closed A f"
by (insert semilat) (simp add: semilat_Def)
lemma closedD:
"[| closed A f; x:A; y:A |] ==> x +_f y : A"
by (unfold closed_def) blast
lemma closed_UNIV [simp]: "closed UNIV f"
by (simp add: closed_def)
lemma (in Semilat) closed_f [simp, intro]:
"[|x:A; y:A|] ==> x +_f y : A"
by (simp add: closedD [OF closedI])
lemma (in Semilat) refl_r [intro, simp]:
"x <=_r x"
by simp
lemma (in Semilat) antisym_r [intro?]:
"[| x <=_r y; y <=_r x |] ==> x = y"
by (rule order_antisym) auto
lemma (in Semilat) trans_r [trans, intro?]:
"[|x <=_r y; y <=_r z|] ==> x <=_r z"
by (auto intro: order_trans)
lemma (in Semilat) ub1 [simp, intro?]:
"[| x:A; y:A |] ==> x <=_r x +_f y"
by (insert semilat) (unfold semilat_Def, simp)
lemma (in Semilat) ub2 [simp, intro?]:
"[| x:A; y:A |] ==> y <=_r x +_f y"
by (insert semilat) (unfold semilat_Def, simp)
lemma (in Semilat) lub [simp, intro?]:
"[| x <=_r z; y <=_r z; x:A; y:A; z:A |] ==> x +_f y <=_r z";
by (insert semilat) (unfold semilat_Def, simp)
lemma (in Semilat) plus_le_conv [simp]:
"[| x:A; y:A; z:A |] ==> (x +_f y <=_r z) = (x <=_r z & y <=_r z)"
by (blast intro: ub1 ub2 lub order_trans)
lemma (in Semilat) le_iff_plus_unchanged:
"[| x:A; y:A |] ==> (x <=_r y) = (x +_f y = y)"
apply (rule iffI)
apply (blast intro: antisym_r refl_r lub ub2)
apply (erule subst)
apply simp
done
lemma (in Semilat) le_iff_plus_unchanged2:
"[| x:A; y:A |] ==> (x <=_r y) = (y +_f x = y)"
apply (rule iffI)
apply (blast intro: order_antisym lub order_refl ub1)
apply (erule subst)
apply simp
done
lemma (in Semilat) plus_assoc [simp]:
assumes a: "a ∈ A" and b: "b ∈ A" and c: "c ∈ A"
shows "a +_f (b +_f c) = a +_f b +_f c"
proof -
from a b have ab: "a +_f b ∈ A" ..
from this c have abc: "(a +_f b) +_f c ∈ A" ..
from b c have bc: "b +_f c ∈ A" ..
from a this have abc': "a +_f (b +_f c) ∈ A" ..
show ?thesis
proof
show "a +_f (b +_f c) <=_r (a +_f b) +_f c"
proof -
from a b have "a <=_r a +_f b" ..
also from ab c have "… <=_r … +_f c" ..
finally have "a<": "a <=_r (a +_f b) +_f c" .
from a b have "b <=_r a +_f b" ..
also from ab c have "… <=_r … +_f c" ..
finally have "b<": "b <=_r (a +_f b) +_f c" .
from ab c have "c<": "c <=_r (a +_f b) +_f c" ..
from "b<" "c<" b c abc have "b +_f c <=_r (a +_f b) +_f c" ..
from "a<" this a bc abc show ?thesis ..
qed
show "(a +_f b) +_f c <=_r a +_f (b +_f c)"
proof -
from b c have "b <=_r b +_f c" ..
also from a bc have "… <=_r a +_f …" ..
finally have "b<": "b <=_r a +_f (b +_f c)" .
from b c have "c <=_r b +_f c" ..
also from a bc have "… <=_r a +_f …" ..
finally have "c<": "c <=_r a +_f (b +_f c)" .
from a bc have "a<": "a <=_r a +_f (b +_f c)" ..
from "a<" "b<" a b abc' have "a +_f b <=_r a +_f (b +_f c)" ..
from this "c<" ab c abc' show ?thesis ..
qed
qed
qed
lemma (in Semilat) plus_com_lemma:
"[|a ∈ A; b ∈ A|] ==> a +_f b <=_r b +_f a"
proof -
assume a: "a ∈ A" and b: "b ∈ A"
from b a have "a <=_r b +_f a" ..
moreover from b a have "b <=_r b +_f a" ..
moreover note a b
moreover from b a have "b +_f a ∈ A" ..
ultimately show ?thesis ..
qed
lemma (in Semilat) plus_commutative:
"[|a ∈ A; b ∈ A|] ==> a +_f b = b +_f a"
by(blast intro: order_antisym plus_com_lemma)
lemma is_lubD:
"is_lub r x y u ==> is_ub r x y u & (!z. is_ub r x y z --> r u z)"
by (simp add: is_lub_def)
lemma is_ubI:
"[| r x u; r y u |] ==> is_ub r x y u"
by (simp add: is_ub_def)
lemma is_ubD:
"is_ub r x y u ==> r x u & r y u"
by (simp add: is_ub_def)
lemma is_lub_bigger1 [iff]:
"is_lub (r^** ) x y y = r^** x y"
apply (unfold is_lub_def is_ub_def)
apply blast
done
lemma is_lub_bigger2 [iff]:
"is_lub (r^** ) x y x = r^** y x"
apply (unfold is_lub_def is_ub_def)
apply blast
done
lemma extend_lub:
"[| single_valuedP r; is_lub (r^** ) x y u; r x' x |]
==> EX v. is_lub (r^** ) x' y v"
apply (unfold is_lub_def is_ub_def)
apply (case_tac "r^** y x")
apply (case_tac "r^** y x'")
apply blast
apply (blast elim: converse_rtranclpE dest: single_valuedD)
apply (rule exI)
apply (rule conjI)
apply (blast intro: converse_rtranclp_into_rtranclp dest: single_valuedD)
apply (blast intro: rtranclp.rtrancl_into_rtrancl converse_rtranclp_into_rtranclp
elim: converse_rtranclpE dest: single_valuedD)
done
lemma single_valued_has_lubs [rule_format]:
"[| single_valuedP r; r^** x u |] ==> (!y. r^** y u -->
(EX z. is_lub (r^** ) x y z))"
apply (erule converse_rtranclp_induct)
apply clarify
apply (erule converse_rtranclp_induct)
apply blast
apply (blast intro: converse_rtranclp_into_rtranclp)
apply (blast intro: extend_lub)
done
lemma some_lub_conv:
"[| acyclicP r; is_lub (r^** ) x y u |] ==> some_lub (r^** ) x y = u"
apply (unfold some_lub_def is_lub_def)
apply (rule someI2)
apply assumption
apply (blast intro: antisymD dest!: acyclic_impl_antisym_rtrancl [to_pred])
done
lemma is_lub_some_lub:
"[| single_valuedP r; acyclicP r; r^** x u; r^** y u |]
==> is_lub (r^** ) x y (some_lub (r^** ) x y)";
by (fastsimp dest: single_valued_has_lubs simp add: some_lub_conv)
subsection{*An executable lub-finder*}
constdefs
exec_lub :: "('a => 'a => bool) => ('a => 'a) => 'a binop"
"exec_lub r f x y == while (λz. ¬ r** x z) f y"
lemma acyclic_single_valued_finite:
"[|acyclicP r; single_valuedP r; r** x y |]
==> finite ({(x, y). r x y} ∩ {a. r** x a} × {b. r** b y})"
apply(erule converse_rtranclp_induct)
apply(rule_tac B = "{}" in finite_subset)
apply(simp only:acyclic_def [to_pred])
apply(blast intro:rtranclp_into_tranclp2 rtranclp_tranclp_tranclp)
apply simp
apply(rename_tac x x')
apply(subgoal_tac "{(x, y). r x y} ∩ {a. r** x a} × {b. r** b y} =
insert (x,x') ({(x, y). r x y} ∩ {a. r** x' a} × {b. r** b y})")
apply simp
apply(blast intro:converse_rtranclp_into_rtranclp
elim:converse_rtranclpE dest:single_valuedD)
done
lemma exec_lub_conv:
"[| acyclicP r; !x y. r x y --> f x = y; is_lub (r**) x y u |] ==>
exec_lub r f x y = u";
apply(unfold exec_lub_def)
apply(rule_tac P = "λz. r** y z ∧ r** z u" and
r = "({(x, y). r x y} ∩ {(a,b). r** y a ∧ r** b u})^-1" in while_rule)
apply(blast dest: is_lubD is_ubD)
apply(erule conjE)
apply(erule_tac z = u in converse_rtranclpE)
apply(blast dest: is_lubD is_ubD)
apply(blast dest: rtranclp.rtrancl_into_rtrancl)
apply(rename_tac s)
apply(subgoal_tac "is_ub (r**) x y s")
prefer 2; apply(simp add:is_ub_def)
apply(subgoal_tac "r** u s")
prefer 2; apply(blast dest:is_lubD)
apply(erule converse_rtranclpE)
apply blast
apply(simp only:acyclic_def [to_pred])
apply(blast intro:rtranclp_into_tranclp2 rtranclp_tranclp_tranclp)
apply(rule finite_acyclic_wf)
apply simp
apply(erule acyclic_single_valued_finite)
apply(blast intro:single_valuedI)
apply(simp add:is_lub_def is_ub_def)
apply simp
apply(erule acyclic_subset)
apply blast
apply simp
apply(erule conjE)
apply(erule_tac z = u in converse_rtranclpE)
apply(blast dest: is_lubD is_ubD)
apply blast
done
lemma is_lub_exec_lub:
"[| single_valuedP r; acyclicP r; r^** x u; r^** y u; !x y. r x y --> f x = y |]
==> is_lub (r^** ) x y (exec_lub r f x y)"
by (fastsimp dest: single_valued_has_lubs simp add: exec_lub_conv)
end