theory Live imports Natural begin text{* Which variables/locations does an expression depend on? Any set of variables that completely determine the value of the expression, in the worst case all locations: *} consts Dep :: "((loc => 'a) => 'b) => loc set" specification (Dep) dep_on: "(∀x∈Dep e. s x = t x) ==> e s = e t" by(rule_tac x="%x. UNIV" in exI)(simp add: expand_fun_eq[symmetric]) text{* The following definition of @{const Dep} looks very tempting @{prop"Dep e = {a. EX s t. (ALL x. x≠a --> s x = t x) ∧ e s ≠ e t}"} but does not work in case @{text e} depends on an infinite set of variables. For example, if @{term"e s"} tests if @{text s} is 0 at infinitely many locations. Then @{term"Dep e"} incorrectly yields the empty set! If we had a concrete representation of expressions, we would simply write a recursive free-variables function. *} primrec L :: "com => loc set => loc set" where "L SKIP A = A" | "L (x :== e) A = A-{x} ∪ Dep e" | "L (c1; c2) A = (L c1 o L c2) A" | "L (IF b THEN c1 ELSE c2) A = Dep b ∪ L c1 A ∪ L c2 A" | "L (WHILE b DO c) A = Dep b ∪ A ∪ L c A" primrec "kill" :: "com => loc set" where "kill SKIP = {}" | "kill (x :== e) = {x}" | "kill (c1; c2) = kill c1 ∪ kill c2" | "kill (IF b THEN c1 ELSE c2) = Dep b ∪ kill c1 ∩ kill c2" | "kill (WHILE b DO c) = {}" primrec gen :: "com => loc set" where "gen SKIP = {}" | "gen (x :== e) = Dep e" | "gen (c1; c2) = gen c1 ∪ (gen c2-kill c1)" | "gen (IF b THEN c1 ELSE c2) = Dep b ∪ gen c1 ∪ gen c2" | "gen (WHILE b DO c) = Dep b ∪ gen c" lemma L_gen_kill: "L c A = gen c ∪ (A - kill c)" by(induct c arbitrary:A) auto lemma L_idemp: "L c (L c A) ⊆ L c A" by(fastsimp simp add:L_gen_kill) theorem L_sound: "∀ x ∈ L c A. s x = t x ==> 〈c,s〉 -->c s' ==> 〈c,t〉 -->c t' ==> ∀x∈A. s' x = t' x" proof (induct c arbitrary: A s t s' t') case SKIP then show ?case by auto next case (Assign x e) then show ?case by (auto simp:update_def ball_Un dest!: dep_on) next case (Semi c1 c2) from Semi(4) obtain s'' where s1: "〈c1,s〉 -->c s''" and s2: "〈c2,s''〉 -->c s'" by auto from Semi(5) obtain t'' where t1: "〈c1,t〉 -->c t''" and t2: "〈c2,t''〉 -->c t'" by auto show ?case using Semi(1)[OF _ s1 t1] Semi(2)[OF _ s2 t2] Semi(3) by fastsimp next case (Cond b c1 c2) show ?case proof cases assume "b s" hence s: "〈c1,s〉 -->c s'" using Cond(4) by simp have "b t" using `b s` Cond(3) by (simp add: ball_Un)(blast dest: dep_on) hence t: "〈c1,t〉 -->c t'" using Cond(5) by auto show ?thesis using Cond(1)[OF _ s t] Cond(3) by fastsimp next assume "¬ b s" hence s: "〈c2,s〉 -->c s'" using Cond(4) by auto have "¬ b t" using `¬ b s` Cond(3) by (simp add: ball_Un)(blast dest: dep_on) hence t: "〈c2,t〉 -->c t'" using Cond(5) by auto show ?thesis using Cond(2)[OF _ s t] Cond(3) by fastsimp qed next case (While b c) note IH = this { fix cw have "〈cw,s〉 -->c s' ==> cw = (While b c) ==> 〈cw,t〉 -->c t' ==> ∀ x ∈ L cw A. s x = t x ==> ∀x∈A. s' x = t' x" proof (induct arbitrary: t A pred:evalc) case WhileFalse have "¬ b t" using WhileFalse by (simp add: ball_Un)(blast dest:dep_on) then have "t' = t" using WhileFalse by auto then show ?case using WhileFalse by auto next case (WhileTrue _ s _ s'' s') have "〈c,s〉 -->c s''" using WhileTrue(2,6) by simp have "b t" using WhileTrue by (simp add: ball_Un)(blast dest:dep_on) then obtain t'' where "〈c,t〉 -->c t''" and "〈While b c,t''〉 -->c t'" using WhileTrue(6,7) by auto have "∀x∈Dep b ∪ A ∪ L c A. s'' x = t'' x" using IH(1)[OF _ `〈c,s〉 -->c s''` `〈c,t〉 -->c t''`] WhileTrue(6,8) by (auto simp:L_gen_kill) moreover then have "∀x∈L (While b c) A. s'' x = t'' x" by auto ultimately show ?case using WhileTrue(5,6) `〈While b c,t''〉 -->c t'` by metis qed auto } from this[OF IH(3) _ IH(4,2)] show ?case by metis qed primrec bury :: "com => loc set => com" where "bury SKIP _ = SKIP" | "bury (x :== e) A = (if x:A then x:== e else SKIP)" | "bury (c1; c2) A = (bury c1 (L c2 A); bury c2 A)" | "bury (IF b THEN c1 ELSE c2) A = (IF b THEN bury c1 A ELSE bury c2 A)" | "bury (WHILE b DO c) A = (WHILE b DO bury c (Dep b ∪ A ∪ L c A))" theorem bury_sound: "∀ x ∈ L c A. s x = t x ==> 〈c,s〉 -->c s' ==> 〈bury c A,t〉 -->c t' ==> ∀x∈A. s' x = t' x" proof (induct c arbitrary: A s t s' t') case SKIP then show ?case by auto next case (Assign x e) then show ?case by (auto simp:update_def ball_Un split:split_if_asm dest!: dep_on) next case (Semi c1 c2) from Semi(4) obtain s'' where s1: "〈c1,s〉 -->c s''" and s2: "〈c2,s''〉 -->c s'" by auto from Semi(5) obtain t'' where t1: "〈bury c1 (L c2 A),t〉 -->c t''" and t2: "〈bury c2 A,t''〉 -->c t'" by auto show ?case using Semi(1)[OF _ s1 t1] Semi(2)[OF _ s2 t2] Semi(3) by fastsimp next case (Cond b c1 c2) show ?case proof cases assume "b s" hence s: "〈c1,s〉 -->c s'" using Cond(4) by simp have "b t" using `b s` Cond(3) by (simp add: ball_Un)(blast dest: dep_on) hence t: "〈bury c1 A,t〉 -->c t'" using Cond(5) by auto show ?thesis using Cond(1)[OF _ s t] Cond(3) by fastsimp next assume "¬ b s" hence s: "〈c2,s〉 -->c s'" using Cond(4) by auto have "¬ b t" using `¬ b s` Cond(3) by (simp add: ball_Un)(blast dest: dep_on) hence t: "〈bury c2 A,t〉 -->c t'" using Cond(5) by auto show ?thesis using Cond(2)[OF _ s t] Cond(3) by fastsimp qed next case (While b c) note IH = this { fix cw have "〈cw,s〉 -->c s' ==> cw = (While b c) ==> 〈bury cw A,t〉 -->c t' ==> ∀ x ∈ L cw A. s x = t x ==> ∀x∈A. s' x = t' x" proof (induct arbitrary: t A pred:evalc) case WhileFalse have "¬ b t" using WhileFalse by (simp add: ball_Un)(blast dest:dep_on) then have "t' = t" using WhileFalse by auto then show ?case using WhileFalse by auto next case (WhileTrue _ s _ s'' s') have "〈c,s〉 -->c s''" using WhileTrue(2,6) by simp have "b t" using WhileTrue by (simp add: ball_Un)(blast dest:dep_on) then obtain t'' where tt'': "〈bury c (Dep b ∪ A ∪ L c A),t〉 -->c t''" and "〈bury (While b c) A,t''〉 -->c t'" using WhileTrue(6,7) by auto have "∀x∈Dep b ∪ A ∪ L c A. s'' x = t'' x" using IH(1)[OF _ `〈c,s〉 -->c s''` tt''] WhileTrue(6,8) by (auto simp:L_gen_kill) moreover then have "∀x∈L (While b c) A. s'' x = t'' x" by auto ultimately show ?case using WhileTrue(5,6) `〈bury (While b c) A,t''〉 -->c t'` by metis qed auto } from this[OF IH(3) _ IH(4,2)] show ?case by metis qed end