theory Machines imports Natural begin
lemma rtrancl_eq: "R^* = Id ∪ (R O R^*)"
by (fast intro: rtrancl_into_rtrancl elim: rtranclE)
lemma converse_rtrancl_eq: "R^* = Id ∪ (R^* O R)"
by (subst r_comp_rtrancl_eq[symmetric], rule rtrancl_eq)
lemmas converse_rel_powE = rel_pow_E2
lemma R_O_Rn_commute: "R O R^n = R^n O R"
by (induct n) (simp, simp add: O_assoc [symmetric])
lemma converse_in_rel_pow_eq:
"((x,z) ∈ R^n) = (n=0 ∧ z=x ∨ (∃m y. n = Suc m ∧ (x,y) ∈ R ∧ (y,z) ∈ R^m))"
apply(rule iffI)
apply(blast elim:converse_rel_powE)
apply (fastsimp simp add:gr0_conv_Suc R_O_Rn_commute)
done
lemma rel_pow_plus: "R^(m+n) = R^n O R^m"
by (induct n) (simp, simp add: O_assoc)
lemma rel_pow_plusI: "[| (x,y) ∈ R^m; (y,z) ∈ R^n |] ==> (x,z) ∈ R^(m+n)"
by (simp add: rel_pow_plus rel_compI)
subsection "Instructions"
text {* There are only three instructions: *}
datatype instr = SET loc aexp | JMPF bexp nat | JMPB nat
types instrs = "instr list"
subsection "M0 with PC"
inductive_set
exec01 :: "instr list => ((nat×state) × (nat×state))set"
and exec01' :: "[instrs, nat,state, nat,state] => bool"
("(_/ \<turnstile> (1〈_,/_〉)/ -1-> (1〈_,/_〉))" [50,0,0,0,0] 50)
for P :: "instr list"
where
"p \<turnstile> 〈i,s〉 -1-> 〈j,t〉 == ((i,s),j,t) : (exec01 p)"
| SET: "[| n<size P; P!n = SET x a |] ==> P \<turnstile> 〈n,s〉 -1-> 〈Suc n,s[x\<mapsto> a s]〉"
| JMPFT: "[| n<size P; P!n = JMPF b i; b s |] ==> P \<turnstile> 〈n,s〉 -1-> 〈Suc n,s〉"
| JMPFF: "[| n<size P; P!n = JMPF b i; ¬b s; m=n+i+1; m ≤ size P |]
==> P \<turnstile> 〈n,s〉 -1-> 〈m,s〉"
| JMPB: "[| n<size P; P!n = JMPB i; i ≤ n; j = n-i |] ==> P \<turnstile> 〈n,s〉 -1-> 〈j,s〉"
abbreviation
exec0s :: "[instrs, nat,state, nat,state] => bool"
("(_/ \<turnstile> (1〈_,/_〉)/ -*-> (1〈_,/_〉))" [50,0,0,0,0] 50) where
"p \<turnstile> 〈i,s〉 -*-> 〈j,t〉 == ((i,s),j,t) : (exec01 p)^*"
abbreviation
exec0n :: "[instrs, nat,state, nat, nat,state] => bool"
("(_/ \<turnstile> (1〈_,/_〉)/ -_-> (1〈_,/_〉))" [50,0,0,0,0] 50) where
"p \<turnstile> 〈i,s〉 -n-> 〈j,t〉 == ((i,s),j,t) : (exec01 p)^n"
subsection "M0 with lists"
text {* We describe execution of programs in the machine by
an operational (small step) semantics:
*}
types config = "instrs × instrs × state"
inductive_set
stepa1 :: "(config × config)set"
and stepa1' :: "[instrs,instrs,state, instrs,instrs,state] => bool"
("((1〈_,/_,/_〉)/ -1-> (1〈_,/_,/_〉))" 50)
where
"〈p,q,s〉 -1-> 〈p',q',t〉 == ((p,q,s),p',q',t) : stepa1"
| "〈SET x a#p,q,s〉 -1-> 〈p,SET x a#q,s[x\<mapsto> a s]〉"
| "b s ==> 〈JMPF b i#p,q,s〉 -1-> 〈p,JMPF b i#q,s〉"
| "[| ¬ b s; i ≤ size p |]
==> 〈JMPF b i # p, q, s〉 -1-> 〈drop i p, rev(take i p) @ JMPF b i # q, s〉"
| "i ≤ size q
==> 〈JMPB i # p, q, s〉 -1-> 〈rev(take i q) @ JMPB i # p, drop i q, s〉"
abbreviation
stepa :: "[instrs,instrs,state, instrs,instrs,state] => bool"
("((1〈_,/_,/_〉)/ -*-> (1〈_,/_,/_〉))" 50) where
"〈p,q,s〉 -*-> 〈p',q',t〉 == ((p,q,s),p',q',t) : (stepa1^*)"
abbreviation
stepan :: "[instrs,instrs,state, nat, instrs,instrs,state] => bool"
("((1〈_,/_,/_〉)/ -_-> (1〈_,/_,/_〉))" 50) where
"〈p,q,s〉 -i-> 〈p',q',t〉 == ((p,q,s),p',q',t) : (stepa1^i)"
inductive_cases execE: "((i#is,p,s), (is',p',s')) : stepa1"
lemma exec_simp[simp]:
"(〈i#p,q,s〉 -1-> 〈p',q',t〉) = (case i of
SET x a => t = s[x\<mapsto> a s] ∧ p' = p ∧ q' = i#q |
JMPF b n => t=s ∧ (if b s then p' = p ∧ q' = i#q
else n ≤ size p ∧ p' = drop n p ∧ q' = rev(take n p) @ i # q) |
JMPB n => n ≤ size q ∧ t=s ∧ p' = rev(take n q) @ i # p ∧ q' = drop n q)"
apply(rule iffI)
defer
apply(clarsimp simp add: stepa1.intros split: instr.split_asm split_if_asm)
apply(erule execE)
apply(simp_all)
done
lemma execn_simp[simp]:
"(〈i#p,q,s〉 -n-> 〈p'',q'',u〉) =
(n=0 ∧ p'' = i#p ∧ q'' = q ∧ u = s ∨
((∃m p' q' t. n = Suc m ∧
〈i#p,q,s〉 -1-> 〈p',q',t〉 ∧ 〈p',q',t〉 -m-> 〈p'',q'',u〉)))"
by(subst converse_in_rel_pow_eq, simp)
lemma exec_star_simp[simp]: "(〈i#p,q,s〉 -*-> 〈p'',q'',u〉) =
(p'' = i#p & q''=q & u=s |
(∃p' q' t. 〈i#p,q,s〉 -1-> 〈p',q',t〉 ∧ 〈p',q',t〉 -*-> 〈p'',q'',u〉))"
apply(simp add: rtrancl_is_UN_rel_pow del:exec_simp)
apply(blast)
done
declare nth_append[simp]
lemma rev_revD: "rev xs = rev ys ==> xs = ys"
by simp
lemma [simp]: "(rev xs @ rev ys = rev zs) = (ys @ xs = zs)"
apply(rule iffI)
apply(rule rev_revD, simp)
apply fastsimp
done
lemma direction1:
"〈q,p,s〉 -1-> 〈q',p',t〉 ==>
rev p' @ q' = rev p @ q ∧ rev p @ q \<turnstile> 〈size p,s〉 -1-> 〈size p',t〉"
apply(induct set: stepa1)
apply(simp add:exec01.SET)
apply(fastsimp intro:exec01.JMPFT)
apply simp
apply(rule exec01.JMPFF)
apply simp
apply fastsimp
apply simp
apply simp
apply simp
apply(fastsimp simp add:exec01.JMPB)
done
lemma direction2:
"rpq \<turnstile> 〈sp,s〉 -1-> 〈sp',t〉 ==>
rpq = rev p @ q & sp = size p & sp' = size p' -->
rev p' @ q' = rev p @ q --> 〈q,p,s〉 -1-> 〈q',p',t〉"
apply(induct arbitrary: p q p' q' set: exec01)
apply(clarsimp simp add: neq_Nil_conv append_eq_conv_conj)
apply(drule sym)
apply simp
apply(rule rev_revD)
apply simp
apply(clarsimp simp add: neq_Nil_conv append_eq_conv_conj)
apply(drule sym)
apply simp
apply(rule rev_revD)
apply simp
apply(simp (no_asm_use) add: neq_Nil_conv append_eq_conv_conj, clarify)+
apply(drule sym)
apply simp
apply(rule rev_revD)
apply simp
apply(clarsimp simp add: neq_Nil_conv append_eq_conv_conj)
apply(drule sym)
apply(simp add:rev_take)
apply(rule rev_revD)
apply(simp add:rev_drop)
done
theorem M_eqiv:
"(〈q,p,s〉 -1-> 〈q',p',t〉) =
(rev p' @ q' = rev p @ q ∧ rev p @ q \<turnstile> 〈size p,s〉 -1-> 〈size p',t〉)"
by (blast dest: direction1 direction2)
end