Theory Live

Up to index of Isabelle/HOL/IMP

theory Live
imports Natural

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