(*  Title:       Proving the Correctness of Disk Paxos

    Author:      Mauro J. Jaskelioff, Stephan Merz, 2005
    Maintainer:  Mauro J. Jaskelioff <mauro at fceia.unr.edu.ar>
*)

theory DiskPaxos_Chosen imports DiskPaxos_Inv5 begin

subsection {* Lemma I2f *}

text {*
  To prove the final conjunct we will use the predicate $valueChosen(v)$.
  This predicate is true if $v$ is the only possible value that can be
  chosen as output. It also asserts that, for every disk $d$ in $D$, if $q$
  has already read $disk s d p$, then it has read a block with $bal$ field
  at least $b$.
*}

definition valueChosen :: "state \<Rightarrow> InputsOrNi \<Rightarrow> bool"
where
  "valueChosen s v =
  (\<exists>b\<in> (UN p. Ballot p).
         maxBalInp s b v
      \<and> (\<exists>p. \<exists>D\<in>MajoritySet.(\<forall>d\<in>D.  b \<le> bal(disk s d p)
                                   \<and>(\<forall>q.(   phase s q = 1
                                          \<and> b \<le>mbal(dblock s q)
                                          \<and> hasRead s q d p
                                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br))
                             ))))"

lemma HEndPhase1_valueChosen_inp:
  assumes act: "HEndPhase1 s s' q"
  and inv2a: "Inv2a s"
  and asm1: "b \<in> (UN p. Ballot p)"
  and bk_blocksOf: "bk\<in>blocksOf s r"
  and bk: "bk\<in> blocksSeen s q"
  and b_bal: "b \<le> bal bk"
  and asm3: "maxBalInp s b v"
  and inv1: "Inv1 s"
  shows "inp(dblock s' q) = v"
proof -
  from bk_blocksOf inv2a
  have inv2a_bk: "Inv2a_innermost s r bk"
    by(auto simp add: Inv2a_def Inv2a_inner_def)
  from Ballot_nzero asm1
  have "0 < b " by auto
  with b_bal
  have "0< bal bk" by auto
  with inv2a_bk
  have "inp bk \<noteq> NotAnInput"
    by(auto simp add: Inv2a_innermost_def)
  with bk InputsOrNi
  have bk_noninit: "bk \<in> nonInitBlks s q"
    by(auto simp add: nonInitBlks_def blocksSeen_def
                      allBlocksRead_def allRdBlks_def)
  with maxBlk_in_nonInitBlks[OF this inv1] b_bal
  have maxBlk_b: "b \<le> bal (maxBlk s q)"
    by auto
  from maxBlk_in_nonInitBlks[OF bk_noninit inv1]
  have "\<exists>p d. maxBlk s q \<in> blocksSeen s p"
    by(auto simp add: nonInitBlks_def blocksSeen_def)
  hence "\<exists>p. maxBlk s q \<in> blocksOf s p"
    by(auto simp add: blocksOf_def blocksSeen_def
      allBlocksRead_def allRdBlks_def rdBy_def, force)
  with maxBlk_b asm3
  have "inp(maxBlk s q) = v"
    by(auto simp add: maxBalInp_def allBlocks_def)
  with bk_noninit act
  show ?thesis
    by(auto simp add: EndPhase1_def)
qed

lemma HEndPhase1_maxBalInp:
  assumes act: "HEndPhase1 s s' q"
    and asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"

  and inv1: "Inv1 s"
  and inv2a: "Inv2a s"
  and inv2b: "Inv2b s"
  shows "maxBalInp s' b v"
proof(cases "b \<le> mbal(dblock s q)")
  case True
  show ?thesis
  proof(cases "p\<noteq>q")
    assume pnq: "p\<noteq>q"
    have "\<exists>d\<in>D. hasRead s q d p"
    proof -
      from act
      have "IsMajority({d. d\<in> disksWritten s q \<and> (\<forall>r\<in>UNIV-{q}. hasRead s q d r)})" (is "IsMajority(?M)")
        by(auto simp add: EndPhase1_def)
      with majorities_intersect asm2
      have "D \<inter> ?M \<noteq> {}"
        by(auto simp add: MajoritySet_def)
      hence "\<exists>d\<in>D. (\<forall>r\<in>UNIV-{q}. hasRead s q d r)"
        by auto
      with pnq
      show ?thesis
        by auto
    qed
    then obtain d where p41: "d\<in>D \<and> hasRead s q d p" by auto
    with asm4 asm3 act True
    have p42: "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
      by(auto simp add: EndPhase1_def)
    from True act
    have thesis_L: "b\<le>bal (dblock s' q)"
      by(auto simp add: EndPhase1_def)
    from p42
    have "inp(dblock s' q) = v"
    proof auto
      fix br
      assume br: "br \<in> blocksRead s q d"
        and b_bal: " b \<le> bal (block br)"
      hence br_rdBy: "br \<in> (UN q d. rdBy s (proc br) q d)"
        by(auto simp add:  rdBy_def)
      hence br_blksof: "block br \<in> blocksOf s (proc br)"
        by(auto simp add: blocksOf_def)
      from br have br_bseen: "block br\<in> blocksSeen s q"
        by(auto simp add: blocksSeen_def allBlocksRead_def allRdBlks_def)
      from HEndPhase1_valueChosen_inp[OF act inv2a asm1 br_blksof br_bseen b_bal asm3 inv1]
      show ?thesis .
    qed
    with asm3 HEndPhase1_allBlocks[OF act]
    show ?thesis
      by(auto simp add: maxBalInp_def)
  next
    case False
    from asm4
    have p41: "\<forall>d\<in>D. b \<le> bal(disk s d p)"
      by auto
    have p42: "\<exists>d\<in>D. disk s d p = dblock s p"
    proof -
      from act
      have "IsMajority {d. d\<in>disksWritten s q \<and> (\<forall>p\<in>UNIV-{q}. hasRead s q d p)}" (is "IsMajority ?S")
        by(auto simp add: EndPhase1_def)
      with majorities_intersect asm2
      have "D \<inter> ?S \<noteq> {}"
        by(auto simp add: MajoritySet_def)
      hence "\<exists>d\<in>D. d\<in>disksWritten s q"
        by auto
      with inv2b False
      show ?thesis
        by(auto simp add: Inv2b_def Inv2b_inner_def)
    qed
    have "inp(dblock s' q) = v"
    proof -
      from p42 p41 False
      have b_bal: "b \<le> bal(dblock s q)" by auto
      have db_blksof: "(dblock s q) \<in> blocksOf s q"
        by(auto simp add: blocksOf_def)
      have db_bseen: "(dblock s q) \<in> blocksSeen s q"
        by(auto simp add: blocksSeen_def)
      from HEndPhase1_valueChosen_inp[OF act inv2a asm1 db_blksof db_bseen b_bal asm3 inv1]
      show ?thesis .
    qed
    with asm3 HEndPhase1_allBlocks[OF act]
    show ?thesis
      by(auto simp add: maxBalInp_def)
  qed
next
  case False
  have "dblock s' q \<in> allBlocks s'"
    by(auto simp add: allBlocks_def blocksOf_def)
  show ?thesis
  proof(auto simp add: maxBalInp_def)
    fix bk
    assume bk: "bk \<in> allBlocks s'"
      and b_bal: "b \<le> bal bk"
    from subsetD[OF HEndPhase1_allBlocks[OF act] bk]
    show "inp bk = v"
    proof
      assume bk: "bk \<in> allBlocks s"
      with asm3 b_bal
      show ?thesis
        by(auto simp add: maxBalInp_def)
    next
      assume bk: "bk \<in>  {dblock s' q}"
      from act False
      have " \<not> b \<le> bal (dblock s' q)"
        by(auto simp add: EndPhase1_def)
      with bk b_bal
      show ?thesis
        by(auto)
    qed
  qed
qed

lemma HEndPhase1_valueChosen2:
  assumes act: "HEndPhase1 s s' q"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: EndPhase1_def)
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
  with act
  have p31: "phase s q = 1"
    and p32: "dblock s' q = dblock s q"
    by(auto simp add: EndPhase1_def split: split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  assume hasRead: "hasRead s' q d p"
  with act
  have "hasRead s q d p"
    by(auto simp add: EndPhase1_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: EndPhase1_def InitializePhase_def hasRead_def)
qed

theorem HEndPhase1_valueChosen:
  assumes act: "HEndPhase1 s s' q"
  and vc: "valueChosen s v"
  and inv1: "Inv1 s"
  and inv2a: "Inv2a s"
  and inv2b: "Inv2b s"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HEndPhase1_maxBalInp[OF act asm1 asm2 asm3 asm4 inv1 inv2a inv2b]
  have "maxBalInp s' b v" .
  with HEndPhase1_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HStartBallot_maxBalInp:
  assumes act: "HStartBallot s s' q"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HStartBallot_allBlocks[OF act] bk]
  show "inp bk = v"
  proof
    assume bk: "bk\<in>allBlocks s"
    with asm3 b_bal
    show ?thesis
      by(auto simp add: maxBalInp_def)
  next
    assume bk: "bk\<in>{dblock s' q}"
    from asm3
    have "b\<le> bal(dblock s q) \<Longrightarrow> inp(dblock s q) = v"
      by(auto simp add: maxBalInp_def allBlocks_def blocksOf_def)
    with act bk b_bal
    show ?thesis
      by(auto simp add: StartBallot_def)
  qed
qed

lemma HStartBallot_valueChosen2:
  assumes act: "HStartBallot s s' q"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: StartBallot_def)
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act hasRead
  have p31: "phase s q = 1"
   and p32: "dblock s' q = dblock s q"
    by(auto simp add: StartBallot_def InitializePhase_def
                 hasRead_def split : split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  from act hasRead
  have "hasRead s q d p"
    by(auto simp add: StartBallot_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: StartBallot_def InitializePhase_def
                      hasRead_def)
qed

theorem HStartBallot_valueChosen:
  assumes act: "HStartBallot s s' q"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HStartBallot_maxBalInp[OF act asm3]
  have "maxBalInp s' b v" .
  with HStartBallot_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HPhase1or2Write_maxBalInp:
  assumes act: "HPhase1or2Write s s' q d"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HPhase1or2Write_allBlocks[OF act] bk] asm3 b_bal
  show "inp bk = v"
    by(auto simp add: maxBalInp_def)
qed

lemma HPhase1or2Write_valueChosen2:
  assumes act: "HPhase1or2Write s s' pp d"
    and asm2: "D\<in>MajoritySet"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
    and inv4: "HInv4a s pp"
  shows "?P s'"
proof(auto)
  fix d1
  assume d: "d1\<in>D"
  show "b \<le> bal (disk s' d1 p)"
  proof(cases "d1=d\<and>pp=p")
    case True
    with inv4 act
    have "HInv4a2 s p"
      by(auto simp add: Phase1or2Write_def HInv4a_def)
    with asm2 majorities_intersect
    have "\<exists>dd\<in>D. bal(disk s dd p)\<le>bal(dblock s p)"
      by(auto simp add: HInv4a2_def MajoritySet_def)
    then obtain dd where p41: "dd\<in>D \<and> bal(disk s dd p)\<le>bal(dblock s p)"
      by auto
    from asm4 p41
    have "b\<le> bal(disk s dd p)"
      by auto
    with p41
    have p42: "b \<le> bal(dblock s p)"
      by auto
    from act True
    have "dblock s p = disk s' d p"
      by(auto simp add: Phase1or2Write_def)
    with p42 True
    show ?thesis
      by auto
  next
    case False
    with act asm4 d
    show ?thesis
      by(auto simp add: Phase1or2Write_def)
  qed
next
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act hasRead
  have p31: "phase s q = 1"
   and p32: "dblock s' q = dblock s q"
    by(auto simp add: Phase1or2Write_def InitializePhase_def
                      hasRead_def split : split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  from act hasRead
  have "hasRead s q d p"
    by(auto simp add: Phase1or2Write_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: Phase1or2Write_def InitializePhase_def
                      hasRead_def)
qed

theorem HPhase1or2Write_valueChosen:
  assumes act: "HPhase1or2Write s s' q d"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  and inv4: "HInv4a s q"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HPhase1or2Write_maxBalInp[OF act asm3]
  have "maxBalInp s' b v" .
  with HPhase1or2Write_valueChosen2[OF act asm2 asm4 inv4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HPhase1or2ReadThen_maxBalInp:
  assumes act: "HPhase1or2ReadThen s s' q d p"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HPhase1or2ReadThen_allBlocks[OF act] bk] asm3 b_bal
  show "inp bk = v"
    by(auto simp add: maxBalInp_def)
qed

theorem HPhase1or2ReadThen_valueChosen:
  assumes act: "HPhase1or2ReadThen s s' q d p"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HPhase1or2ReadThen_maxBalInp[OF act asm3]
  have "maxBalInp s' b v" .
  with HPhase1or2ReadThen_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

theorem HPhase1or2ReadElse_valueChosen:
  "\<lbrakk> HPhase1or2ReadElse s s' p d r; valueChosen s v; v\<in> Inputs  \<rbrakk>
     \<Longrightarrow> valueChosen s' v"
  using HStartBallot_valueChosen
  by(auto simp add: Phase1or2ReadElse_def)

lemma HEndPhase2_maxBalInp:
  assumes act: "HEndPhase2 s s' q"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HEndPhase2_allBlocks[OF act] bk] asm3 b_bal
  show "inp bk = v"
    by(auto simp add: maxBalInp_def)
qed

lemma HEndPhase2_valueChosen2:
  assumes act: "HEndPhase2 s s' q"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: EndPhase2_def)
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act hasRead
  have p31: "phase s q = 1"
   and p32: "dblock s' q = dblock s q"
    by(auto simp add: EndPhase2_def InitializePhase_def
                      hasRead_def split : split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  from act hasRead
  have "hasRead s q d p"
    by(auto simp add: EndPhase2_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: EndPhase2_def InitializePhase_def
                      hasRead_def)
qed

theorem HEndPhase2_valueChosen:
  assumes act: "HEndPhase2 s s' q"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HEndPhase2_maxBalInp[OF act asm3]
  have "maxBalInp s' b v" .
  with HEndPhase2_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HFail_maxBalInp:
  assumes act: "HFail s s' q"
    and asm1: "b \<in> (UN p. Ballot p)"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HFail_allBlocks[OF act] bk]
  show "inp bk = v"
  proof
    assume bk: "bk\<in>allBlocks s"
    with asm3 b_bal
    show ?thesis
      by(auto simp add: maxBalInp_def)
  next
    assume bk: "bk\<in>{dblock s' q}"
    with act
    have "bal bk = 0"
      by(auto simp add: Fail_def InitDB_def)
    moreover
    from Ballot_nzero asm1
    have "0 < b"
      by auto
    ultimately
    show ?thesis
      using b_bal
      by auto
  qed
qed

lemma HFail_valueChosen2:
  assumes act: "HFail s s' q"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: Fail_def)
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act hasRead
  have p31: "phase s q = 1"
   and p32: "dblock s' q = dblock s q"
    by(auto simp add: Fail_def InitializePhase_def
                  hasRead_def split : split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  from act hasRead
  have "hasRead s q d p"
    by(auto simp add: Fail_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: Fail_def InitializePhase_def hasRead_def)
qed

theorem HFail_valueChosen:
  assumes act: "HFail s s' q"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HFail_maxBalInp[OF act asm1 asm3]
  have "maxBalInp s' b v" .
  with HFail_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HPhase0Read_maxBalInp:
  assumes act: "HPhase0Read s s' q d"
    and asm3: "maxBalInp s b v"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HPhase0Read_allBlocks[OF act] bk] asm3 b_bal
  show "inp bk = v"
    by(auto simp add: maxBalInp_def)
qed

lemma HPhase0Read_valueChosen2:
  assumes act: "HPhase0Read s s' qq dd"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: Phase0Read_def)
next
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act
  have qqnq: "qq\<noteq>q"
    by(auto simp add: Phase0Read_def)
  show "\<exists>br\<in>blocksRead s' q d. b \<le> bal (block br)"
  proof -
    from phase' act hasRead
    have p31: "phase s q = 1"
      and p32: "dblock s' q = dblock s q"
      by(auto simp add: Phase0Read_def hasRead_def)
    with dblk_mbal
    have "b\<le>mbal(dblock s q)" by auto
    moreover
    from act hasRead qqnq
    have "hasRead s q d p"
      by(auto simp add: Phase0Read_def hasRead_def
                 split: split_if_asm)
    ultimately
    have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
      using p31 asm4 d
      by blast
    with act hasRead
    show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
      by(auto simp add: Phase0Read_def InitializePhase_def
                        hasRead_def)
  qed
qed

theorem HPhase0Read_valueChosen:
  assumes act: "HPhase0Read s s' q d"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HPhase0Read_maxBalInp[OF act asm3]
  have "maxBalInp s' b v" .
  with HPhase0Read_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

lemma HEndPhase0_maxBalInp:
  assumes act: "HEndPhase0 s s' q"
    and asm3: "maxBalInp s b v"
    and inv1: "Inv1 s"
  shows "maxBalInp s' b v"
proof(auto simp add: maxBalInp_def)
  fix bk
  assume bk: "bk \<in> allBlocks s'"
    and b_bal: "b\<le> bal bk"
  from subsetD[OF HEndPhase0_allBlocks[OF act] bk]
  show "inp bk = v"
  proof
    assume bk: "bk\<in>allBlocks s"
    with asm3 b_bal
    show ?thesis
      by(auto simp add: maxBalInp_def)
  next
    assume bk: "bk\<in>{dblock s' q}"
    with HEndPhase0_some[OF act inv1] act
    have "\<exists>ba\<in>allBlocksRead s q. bal ba = bal (dblock s' q) \<and> inp ba = inp (dblock s' q)"
      by(auto simp add: EndPhase0_def)
    then obtain ba
      where ba_blksread: "ba\<in>allBlocksRead s q"
      and ba_balinp: "bal ba = bal (dblock s' q) \<and> inp ba = inp (dblock s' q)"
      by auto
    have "allBlocksRead s q \<subseteq> allBlocks s"
      by(auto simp add: allBlocksRead_def allRdBlks_def
                        allBlocks_def blocksOf_def rdBy_def)
    from subsetD[OF this ba_blksread] ba_balinp bk b_bal asm3
    show ?thesis
      by(auto simp add: maxBalInp_def)
  qed
qed

lemma HEndPhase0_valueChosen2:
  assumes act: "HEndPhase0 s s' q"
    and asm4: "\<forall>d\<in>D.   b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))" (is "?P s")
  shows "?P s'"
proof(auto)
  fix d
  assume d: "d\<in>D"
  with act asm4
  show "b \<le> bal (disk s' d p)"
    by(auto simp add: EndPhase0_def)
  fix d q
  assume d: "d\<in>D"
    and phase': "phase s' q = Suc 0"
    and dblk_mbal: "b \<le> mbal (dblock s' q)"
    and hasRead: "hasRead s' q d p"
  from phase' act hasRead
  have p31: "phase s q = 1"
   and p32: "dblock s' q = dblock s q"
    by(auto simp add: EndPhase0_def InitializePhase_def
                       hasRead_def split : split_if_asm)
  with dblk_mbal
  have "b\<le>mbal(dblock s q)" by auto
  moreover
  from act hasRead
  have "hasRead s q d p"
    by(auto simp add: EndPhase0_def InitializePhase_def
      hasRead_def split: split_if_asm)
  ultimately
  have "\<exists>br\<in>blocksRead s q d. b\<le> bal(block br)"
    using p31 asm4 d
    by blast
  with act hasRead
  show "\<exists>br\<in>blocksRead s' q d. b\<le> bal(block br)"
    by(auto simp add: EndPhase0_def InitializePhase_def
                      hasRead_def)
qed

theorem HEndPhase0_valueChosen:
  assumes act: "HEndPhase0 s s' q"
  and vc: "valueChosen s v"
  and v_input: "v \<in> Inputs"
  and inv1: "Inv1 s"
  shows "valueChosen s' v"
proof -
  from vc
  obtain b p D where
        asm1: "b \<in> (UN p. Ballot p)"
    and asm2: "D\<in>MajoritySet"
    and asm3: "maxBalInp s b v"
    and asm4: "\<forall>d\<in>D.  b \<le> bal(disk s d p)
                   \<and>(\<forall>q.(   phase s q = 1
                          \<and> b \<le>mbal(dblock s q)
                          \<and> hasRead s q d p
                         ) \<longrightarrow> (\<exists>br\<in>blocksRead s q d. b \<le> bal(block br)))"
    by(auto simp add: valueChosen_def)
  from HEndPhase0_maxBalInp[OF act asm3 inv1]
  have "maxBalInp s' b v" .
  with HEndPhase0_valueChosen2[OF act asm4] asm1 asm2
  show ?thesis
    by(auto simp add: valueChosen_def)
qed

end


theory flash66Bra  imports flash66Rev

  begin
lemma onInv66:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv66 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv66 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv66 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv66 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


theory Refine_Default
  imports
    Enclosure_Operations
    Weak_Set
begin

consts i_default::"interface \<Rightarrow> interface"

definition default_rel_internal: "default_rel d X = insert (None, d) ((\<lambda>(x, y). (Some x, y)) ` X)"
lemma default_rel_def: "\<langle>X\<rangle>default_rel d = insert (None, d) ((\<lambda>(x, y). (Some x, y)) ` X)"
  by (auto simp: relAPP_def default_rel_internal)
lemmas [autoref_rel_intf] = REL_INTFI[of "default_rel d" i_default for d]

lemma single_valued_default_rel[relator_props]:
  "single_valued R \<Longrightarrow> single_valued (\<langle>R\<rangle>default_rel d)"
  by (auto simp: default_rel_def intro!: relator_props) (auto simp: single_valued_def)

lemma
  mem_default_relI:
  assumes "a = None \<Longrightarrow> b = d"
  assumes "\<And>x. a = Some x \<Longrightarrow> (x, b) \<in> R"
  shows "(a, b) \<in> \<langle>R\<rangle>default_rel d"
  using assms image_iff
  by (force simp: default_rel_def)

lemma Some_mem_default_rel: "(Some x, y) \<in> \<langle>X\<rangle>default_rel d\<longleftrightarrow> (x, y) \<in> X"
  by (auto simp: default_rel_def)

lemma option_rel_inverse[simp]: "(\<langle>R\<rangle>option_rel)\<inverse> = \<langle>R\<inverse>\<rangle>option_rel"
  by (auto simp: option_rel_def)

lemma default_rel_split[autoref_rules]:
  assumes split_impl: "(split_impl, split_spec) \<in> A \<rightarrow> \<langle>B \<times>\<^sub>r A\<rangle>nres_rel"
  shows "(\<lambda>xs.
    case xs of None \<Rightarrow> SUCCEED
    | Some x \<Rightarrow> do {(r, s) \<leftarrow> split_impl x; RETURN (r, Some s)},
    split_spec) \<in>
    \<langle>A\<rangle>default_rel d \<rightarrow> \<langle>B \<times>\<^sub>r \<langle>A\<rangle>default_rel d\<rangle>nres_rel"
proof -
  have "split_impl a \<bind> (\<lambda>(r, s). RETURN (r, Some s))
    \<le> \<Down> (B \<times>\<^sub>r insert (None, d) ((\<lambda>(x, y). (Some x, y)) ` A)) (SPEC (\<lambda>(A, B). b \<subseteq> A \<union> B))"
    if "(a, b) \<in> A"
    for a b
  proof -
    have split_inresD:
      "\<exists>a. (c, a) \<in> B \<and> (\<exists>bb. (Some d, bb) \<in> (\<lambda>(x, y). (Some x, y)) ` A \<and> b \<subseteq> a \<union> bb)"
      if "inres (split_impl a) (c, d)"
      for c d
    proof -
      have "RETURN (c, d) \<le> \<Down> (B \<times>\<^sub>r A) (split_spec b)"
        using \<open>(a, b) \<in> A\<close> that split_impl
        by (auto simp: inres_def nres_rel_def dest!: fun_relD)
      then show ?thesis
        using \<open>(a, b) \<in> A\<close> that split_impl
        by (fastforce simp: split_spec_def elim!: RETURN_ref_SPECD)
    qed
    have "nofail (split_impl a)"
      using split_impl[param_fo, OF \<open>(a, b) \<in> A\<close>] le_RES_nofailI
      by (auto simp: split_spec_def nres_rel_def conc_fun_def)
    then show ?thesis
      using that split_impl
      by (fastforce simp: refine_pw_simps dest!: split_inresD intro!: pw_leI)
  qed
  then show ?thesis
    by (auto simp: split_spec_def default_rel_def
        intro!: nres_relI)
qed

lemma br_Some_O_default_rel_eq: "br Some top O \<langle>A\<rangle>default_rel d = A"
  by (auto simp: br_def default_rel_def)

definition [simp]: "op_Union_default = Union"

context includes autoref_syntax begin

lemma default_rel_Union[autoref_rules]:
  assumes sv: "PREFER single_valued A"
  assumes safe: "SIDE_PRECOND (\<forall>x \<in> X. x \<subseteq> d)"
  assumes xs: "(xs, X) \<in> \<langle>\<langle>A\<rangle>default_rel d\<rangle>list_wset_rel"
  assumes Union_A: "(concat, Union) \<in> \<langle>A\<rangle>list_wset_rel \<rightarrow> A"
  shows "(map_option concat (those xs), op_Union_default $ X) \<in> \<langle>A\<rangle>default_rel d"
  using xs
  apply (safe dest!: list_wset_relD intro!: mem_default_relI)
  subgoal using safe by (auto simp: default_rel_def)
  subgoal by (auto simp: default_rel_def those_eq_None_set_iff dest!: set_relD)[]
  subgoal
    by (auto simp: those_eq_Some_map_Some_iff image_mem_set_rel_iff br_Some_O_default_rel_eq list_wset_rel_def
        intro!: relcompI brI Union_A[param_fo])
  done

definition [simp]: "op_empty_default = {}"
lemma default_rel_empty[autoref_rules]:
  assumes "GEN_OP ei {} A"
  shows "(Some ei, op_empty_default) \<in> \<langle>A\<rangle>default_rel d"
  using assms by (auto simp: default_rel_def)

definition mk_default::"'a set \<Rightarrow> 'a set" where [refine_vcg_def, simp]: "mk_default x = x"

lemma mk_default[autoref_rules]:
  "(Some, mk_default) \<in> R \<rightarrow> \<langle>R\<rangle>default_rel d"
  by (auto simp: default_rel_def)

definition [refine_vcg_def]: "default_rep d X = SPEC (\<lambda>x. case x of None \<Rightarrow> X = d | Some r \<Rightarrow> X = r)"

lemma default_rep_op_pat[autoref_op_pat_def]: "default_rep d \<equiv> OP (default_rep d)"
  by (auto simp: )

lemma default_rep[autoref_rules]:
  "(\<lambda>x. RETURN x, default_rep d) \<in> (\<langle>R\<rangle>(default_rel d)) \<rightarrow> \<langle>\<langle>R\<rangle>option_rel\<rangle>nres_rel"
  by (force simp: default_rep_def nres_rel_def default_rel_def
      split: option.splits intro!: RETURN_SPEC_refine )

end

end


(*  Title:       Isabelle Collections Library
    Author:      Peter Lammich <peter dot lammich at uni-muenster.de>
                 Philipp Meyer <meyerphi@in.tum.de>
*)
section \<open>\isaheader {The hashable Typeclass}\<close>
theory HashCode
imports
  "../../Native_Word/Uint32"
begin

text_raw \<open>\label{thy:HashCode}\<close>

text \<open>
  In this theory a typeclass of hashable types is established.
  For hashable types, there is a function \<open>hashcode\<close>, that
  maps any entity of this type to an unsigned 32 bit word value.

  This theory defines the hashable typeclass and provides instantiations
  for a couple of standard types.
\<close>

type_synonym
  hashcode = "uint32"

definition "nat_of_hashcode \<equiv> nat_of_uint32"
definition "int_of_hashcode \<equiv> int_of_uint32"
definition "integer_of_hashcode \<equiv> integer_of_uint32"

class hashable =
  fixes hashcode :: "'a \<Rightarrow> hashcode"
  and def_hashmap_size :: "'a itself \<Rightarrow> nat"
  assumes def_hashmap_size: "1 < def_hashmap_size TYPE('a)"
begin
  definition bounded_hashcode :: "uint32 \<Rightarrow> 'a \<Rightarrow> uint32" where
    "bounded_hashcode n x = (hashcode x) mod n"

  lemma bounded_hashcode_bounds: "1 < n \<Longrightarrow> bounded_hashcode n a < n"
    unfolding bounded_hashcode_def
    by (transfer, simp add: word_less_def uint_mod)

  definition bounded_hashcode_nat :: "nat \<Rightarrow> 'a \<Rightarrow> nat" where
    "bounded_hashcode_nat n x = nat_of_hashcode (hashcode x) mod n"

  lemma bounded_hashcode_nat_bounds: "1 < n \<Longrightarrow> bounded_hashcode_nat n a < n"
    unfolding bounded_hashcode_nat_def
    by transfer simp
end

instantiation unit :: hashable
begin
  definition [simp]: "hashcode (u :: unit) = 0"
  definition "def_hashmap_size = (\<lambda>_ :: unit itself. 2)"
  instance
    by (intro_classes)(simp_all add: def_hashmap_size_unit_def)
end

instantiation bool :: hashable
begin
  definition [simp]: "hashcode (b :: bool) = (if b then 1 else 0)"
  definition "def_hashmap_size = (\<lambda>_ :: bool itself. 2)"
  instance by (intro_classes)(simp_all add: def_hashmap_size_bool_def)
end

instantiation "int" :: hashable
begin
  definition [simp]: "hashcode (i :: int) = uint32_of_int i"
  definition "def_hashmap_size = (\<lambda>_ :: int itself. 16)"
  instance by(intro_classes)(simp_all add: def_hashmap_size_int_def)
end

instantiation "integer" :: hashable
begin
  definition [simp]: "hashcode (i :: integer) = Uint32 i"
  definition "def_hashmap_size = (\<lambda>_ :: integer itself. 16)"
  instance by(intro_classes)(simp_all add: def_hashmap_size_integer_def)
end

instantiation "nat" :: hashable
begin
  definition [simp]: "hashcode (n :: nat) = uint32_of_int (int n)"
  definition "def_hashmap_size = (\<lambda>_ :: nat itself. 16)"
  instance by(intro_classes)(simp_all add: def_hashmap_size_nat_def)
end

instantiation char :: hashable
begin
  definition [simp]: "hashcode (c :: char) == uint32_of_int (of_char c)"
  definition "def_hashmap_size = (\<lambda>_ :: char itself. 32)"
  instance by(intro_classes)(simp_all add: def_hashmap_size_char_def)
end

instantiation prod :: (hashable, hashable) hashable
begin
  definition "hashcode x == (hashcode (fst x) * 33 + hashcode (snd x))"
  definition "def_hashmap_size = (\<lambda>_ :: ('a \<times> 'b) itself. def_hashmap_size TYPE('a) + def_hashmap_size TYPE('b))"
  instance using def_hashmap_size[where ?'a="'a"] def_hashmap_size[where ?'a="'b"]
    by(intro_classes)(simp_all add: def_hashmap_size_prod_def)
end

instantiation sum :: (hashable, hashable) hashable
begin
  definition "hashcode x == (case x of Inl a \<Rightarrow> 2 * hashcode a | Inr b \<Rightarrow> 2 * hashcode b + 1)"
  definition "def_hashmap_size = (\<lambda>_ :: ('a + 'b) itself. def_hashmap_size TYPE('a) + def_hashmap_size TYPE('b))"
  instance using def_hashmap_size[where ?'a="'a"] def_hashmap_size[where ?'a="'b"]
    by(intro_classes)(simp_all add: bounded_hashcode_bounds def_hashmap_size_sum_def split: sum.split)
end

instantiation list :: (hashable) hashable
begin
  definition "hashcode = foldl (\<lambda>h x. h * 33 + hashcode x) 5381"
  definition "def_hashmap_size = (\<lambda>_ :: 'a list itself. 2 * def_hashmap_size TYPE('a))"
  instance
  proof
    from def_hashmap_size[where ?'a = "'a"]
    show "1 < def_hashmap_size TYPE('a list)"
      by(simp add: def_hashmap_size_list_def)
  qed
end

instantiation option :: (hashable) hashable
begin
  definition "hashcode opt = (case opt of None \<Rightarrow> 0 | Some a \<Rightarrow> hashcode a + 1)"
  definition "def_hashmap_size = (\<lambda>_ :: 'a option itself. def_hashmap_size TYPE('a) + 1)"
  instance using def_hashmap_size[where ?'a = "'a"]
    by(intro_classes)(simp_all add: def_hashmap_size_option_def split: option.split)
end

lemma hashcode_option_simps [simp]:
  "hashcode None = 0"
  "hashcode (Some a) = 1 + hashcode a"
  by(simp_all add: hashcode_option_def)

lemma bounded_hashcode_option_simps [simp]:
  "bounded_hashcode n None = 0"
  "bounded_hashcode n (Some a) = (hashcode a + 1) mod n"
  by (simp_all add: bounded_hashcode_def ac_simps)

(*
lemma bounded_hashcode_option_simps [simp]:
  "bounded_hashcode n None = 0"
  "bounded_hashcode n (Some a) = (bounded_hashcode n a + 1) mod n"
  apply (simp_all add: bounded_hashcode_def, transfer, simp_all add: word_mod_def)
  apply (simp_all add: algebra_simps mod_add_right_eq)
*)

instantiation String.literal :: hashable
begin

definition hashcode_literal :: "String.literal \<Rightarrow> uint32"
  where "hashcode_literal s = hashcode (String.explode s)"

definition def_hashmap_size_literal  :: "String.literal itself \<Rightarrow> nat"
  where "def_hashmap_size_literal _ = 10"

instance
  by standard (simp_all only: def_hashmap_size_literal_def)

end

hide_type (open) word

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

(* License: BSD, terms see file ./LICENSE *)

(*
  Structures supporting CTypes.
  Primarily sets up types, defines pointers and the raw heap view.
*)

theory CTypesBase
imports
  "./$L4V_ARCH/Addr_Type"
  "HOL-Library.Prefix_Order"
  "Word_Lib.Signed_Words"
begin

section "Type setup"

type_synonym byte = "8 word"

class unit_class =
  assumes there_is_only_one: "x = y"

instantiation unit :: unit_class
begin
instance by (intro_classes, simp)
end

subsection "Pointers"

datatype 'a ptr = Ptr addr

abbreviation
  NULL :: "'a ptr" where
  "NULL \<equiv> Ptr 0"

ML \<open>
structure Ptr_Syntax =
struct

  val show_ptr_types = Attrib.setup_config_bool @{binding show_ptr_types} (K true)

  fun ptr_tr' cnst ctxt typ ts = if Config.get ctxt show_ptr_types then
      case Term.strip_type typ of
        ([@{typ addr}], Type (@{type_name "ptr"}, [T])) =>
          list_comb
            (Syntax.const cnst $ Syntax_Phases.term_of_typ ctxt T
            , ts)
        | _ => raise Match
  else raise Match

  fun ptr_coerce_tr' cnst ctxt typ ts = if Config.get ctxt show_ptr_types then
      case Term.strip_type typ of
        ([Type (@{type_name ptr}, [S])], Type (@{type_name "ptr"}, [T])) =>
          list_comb
            (Syntax.const cnst $ Syntax_Phases.term_of_typ ctxt S
                               $ Syntax_Phases.term_of_typ ctxt T
            , ts)
        | _ => raise Match
  else raise Match
end
\<close>

syntax
  "_Ptr" :: "type \<Rightarrow> logic" ("(1PTR/(1'(_')))")
translations
  "PTR('a)" => "CONST Ptr :: (addr \<Rightarrow> 'a ptr)"
typed_print_translation
  \<open> [(@{const_syntax Ptr}, Ptr_Syntax.ptr_tr' @{syntax_const "_Ptr"})] \<close>

primrec
  ptr_val :: "'a ptr \<Rightarrow> addr"
where
  ptr_val_def: "ptr_val (Ptr a) = a"

primrec
  ptr_coerce :: "'a ptr \<Rightarrow> 'b ptr" where
  "ptr_coerce (Ptr a) = Ptr a"

syntax
  "_Ptr_coerce" :: "type \<Rightarrow> type \<Rightarrow> logic" ("(1PTR'_COERCE/(1'(_ \<rightarrow> _')))")
translations
  "PTR_COERCE('a \<rightarrow> 'b)" => "CONST ptr_coerce :: ('a ptr \<Rightarrow> 'b ptr)"
typed_print_translation
  \<open> [(@{const_syntax ptr_coerce}, Ptr_Syntax.ptr_coerce_tr' @{syntax_const "_Ptr_coerce"})] \<close>

definition
  (* no ctype/memtype-class constraints on these so as to allow comparison of
     void * pointers, which are represented as Isabelle type unit ptr *)
  ptr_less :: "'a ptr \<Rightarrow> 'a ptr \<Rightarrow> bool" (infixl "<\<^sub>p" 50) where
  "p <\<^sub>p q \<equiv> ptr_val p < ptr_val q"

definition
  ptr_le :: "'a ptr \<Rightarrow> 'a ptr \<Rightarrow> bool" (infixl "\<le>\<^sub>p" 50) where
  "p \<le>\<^sub>p q \<equiv> ptr_val p \<le> ptr_val q"

instantiation ptr :: (type) ord
begin

definition
  ptr_less_def': "p < q \<equiv> p <\<^sub>p q"
definition
  ptr_le_def': "p \<le> q \<equiv> p \<le>\<^sub>p q"

instance ..

end

lemma ptr_val_case: "ptr_val p = (case p of Ptr v \<Rightarrow> v)"
  by (cases p) simp

instantiation ptr :: (type) linorder
begin
instance
  by (intro_classes)
     (unfold ptr_le_def' ptr_le_def ptr_less_def' ptr_less_def ptr_val_case,
      auto split: ptr.splits)
end

subsection "Raw heap"

text \<open>A raw map from addresses to bytes\<close>

type_synonym heap_mem = "addr \<Rightarrow> byte"

text \<open>For heap h, pointer p and nat n, (heap_list h n p) returns the list
        of bytes in the heap taken from addresses {p..+n}\<close>

primrec
  heap_list :: "heap_mem \<Rightarrow> nat \<Rightarrow> addr \<Rightarrow> byte list"
where
  heap_list_base: "heap_list h 0 p = []"
| heap_list_rec:  "heap_list h (Suc n) p = h p # heap_list h n (p + 1)"

section "Intervals"

text \<open>
  For word a and nat b, {a..+b} is the set of words x,
  with unat (x - a) < b.\<close>

definition
  intvl :: "'a::len word \<times> nat \<Rightarrow> 'a::len word set" where
  "intvl x \<equiv> {z. \<exists>k. z = fst x + of_nat k \<and> k < snd x}"

abbreviation
  "intvl_abbr" :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word set" ("{_..+_}") where
  "{a..+b} \<equiv> intvl (a,b)"

section "dt_pair: a reimplementation of 2 item tuples"

datatype
    ('a,'b) dt_pair = DTPair 'a 'b

primrec
  dt_fst :: "('a,'b) dt_pair \<Rightarrow> 'a"
where
  "dt_fst (DTPair a b) = a"

primrec
  dt_snd :: "('a,'b) dt_pair \<Rightarrow> 'b"
where
  "dt_snd (DTPair a b) = b"

lemma split_DTPair_All:
  "(\<forall>x. P x) = (\<forall>a b. P (DTPair a b))"
  by (rule iffI; clarsimp) (case_tac x, simp)

lemma surjective_dt_pair:
  "p = DTPair (dt_fst p) (dt_snd p)"
  by (cases p) simp

lemmas dt_pair_collapse [simp] = surjective_dt_pair[symmetric]

lemma split_DTPair_all[no_atp]: "(\<And>x. PROP P x) \<equiv> (\<And>a b. PROP P (DTPair a b))"
proof
  fix a b
  assume "\<And>x. PROP P x"
  then show "PROP P (DTPair a b)" .
next
  fix x
  assume "\<And>a b. PROP P (DTPair a b)"
  from \<open>PROP P (DTPair (dt_fst x) (dt_snd x))\<close> show "PROP P x" by simp
qed

type_synonym normalisor = "byte list \<Rightarrow> byte list"

section "Properties of pointers"

lemma Ptr_ptr_val [simp]:
  "Ptr (ptr_val p) = p"
  by (case_tac p) simp

lemma ptr_val_ptr_coerce [simp]:
  "ptr_val (ptr_coerce p) = ptr_val p"
  by (case_tac p) simp

lemma Ptr_ptr_coerce [simp]:
  "Ptr (ptr_val p) = ptr_coerce p"
  by (case_tac p) simp

lemma ptr_coerce_id [simp]:
  "ptr_coerce p = p"
  by (case_tac p) simp

lemma ptr_coerce_idem [simp]:
  "ptr_coerce (ptr_coerce p) = ptr_coerce p"
  by (case_tac p) simp

lemma ptr_val_inj [simp]:
  "(ptr_val p = ptr_val q) = (p = q)"
  by (case_tac p, case_tac q) auto

lemma ptr_coerce_NULL [simp]:
  "(ptr_coerce p = NULL) = (p = NULL)"
  by (case_tac p) simp

lemma NULL_ptr_val:
  "(p = NULL) = (ptr_val p = 0)"
  by (case_tac p) simp

instantiation ptr :: (type) finite
begin
instance
  by (intro_classes)
     (auto intro!: finite_code finite_imageD [where f=ptr_val] injI)
end

section "Properties of the raw heap"

lemma heap_list_length [simp]:
  "length (heap_list h n p) = n"
  by (induct n arbitrary: p) auto

lemma heap_list_split:
  shows "k \<le> n \<Longrightarrow> heap_list h n x = heap_list h k x @ heap_list h (n - k) (x + of_nat k)"
proof (induct n arbitrary: k x)
  case 0 thus ?case by simp
next
  case (Suc n) thus ?case
    by (cases k, auto simp: ac_simps)
qed

lemma heap_list_split2:
  "heap_list h (x + y) p = heap_list h x p @ heap_list h y (p + of_nat x)"
  by (subst heap_list_split [where k=x], auto)

section "Properties of intervals"

lemma intvlI:
  "x < n \<Longrightarrow> p + of_nat x \<in> {p..+n}"
  by (force simp: intvl_def)

lemma intvlD:
  "q \<in> {p..+n} \<Longrightarrow> \<exists>k. q = p + of_nat k \<and> k < n"
  by (force simp: intvl_def)

lemma intvl_empty [simp]:
  "{p..+0} = {}"
  by (fast dest: intvlD)

lemma intvl_Suc:
  "q \<in> {p..+Suc 0} \<Longrightarrow> p = q"
  by (force dest: intvlD)

lemma intvl_self:
  "0 < n \<Longrightarrow> x \<in> {x..+n}"
  by (force simp: intvl_def)

lemma intvl_start_inter:
  "\<lbrakk> 0 < m; 0 < n \<rbrakk> \<Longrightarrow> {p..+m} \<inter> {p..+n} \<noteq> {}"
  by (force simp: disjoint_iff_not_equal dest: intvl_self)

lemma intvl_overflow:
  assumes "2^len_of TYPE('a) \<le> n"
  shows "{(p::'a::len word)..+n} = UNIV"
proof -
  have witness:
    "\<And>x. x = p + of_nat (unat (x - p)) \<and> unat (x - p) < n"
    using assms by simp unat_arith
  show ?thesis unfolding intvl_def by (auto intro!: witness)
qed

declare of_nat_diff [simp]

lemma intvl_self_offset:
  fixes p::"'a::len word"
  assumes a: "2^len_of TYPE('a) - n < x" and b: "x < 2^len_of TYPE('a)" and
      c: "(p::'a::len word) \<notin> {p + of_nat x..+n}"
  shows False
proof -
  let ?j = "2^len_of TYPE('a) - x"
  from b have b': "of_nat x + of_nat ?j  = (0::'a::len word)" using of_nat_2p by auto
  moreover from a b have "?j < n" by arith
  with b b' c show  ?thesis by (force simp: intvl_def)
qed

lemma intvl_mem_offset:
  "\<lbrakk> q \<in> {p..+unat x}; q \<notin> {p..+unat y}; unat y \<le> unat x \<rbrakk> \<Longrightarrow>
      q \<in> {p + y..+unat x - unat y}"
  by (clarsimp simp: intvl_def) (rule_tac x="k - unat y" in exI, auto)

lemma intvl_plus_sub_offset:
  "x \<in> {p + y..+q - unat y} \<Longrightarrow> x \<in> {p..+q}"
  by (clarsimp simp: intvl_def) (rule_tac x="k + unat y" in exI, auto)

lemma intvl_plus_sub_Suc:
  "x \<in> {p + 1..+q - Suc 0} \<Longrightarrow> x \<in> {p..+q}"
  by (rule intvl_plus_sub_offset [where y=1], simp)

lemma intvl_neq_start:
  "\<lbrakk> (q::'a::len word) \<in> {p..+n}; p \<noteq> q \<rbrakk> \<Longrightarrow> q \<in> {p + 1..+n - Suc 0}"
  by (clarsimp simp: intvl_def)
     (metis (no_types) Suc_diff_1 add.commute add_Suc_right diff_diff_left neq0_conv
                       of_nat_Suc semiring_1_class.of_nat_0 zero_less_diff)

lemmas unat_simps' =
  word_arith_nat_defs word_unat.eq_norm len_of_addr_card mod_less

lemma intvl_offset_nmem:
  "\<lbrakk> q \<in> {(p::'a::len word)..+unat x}; y \<le>  2^len_of TYPE('a) - unat x \<rbrakk> \<Longrightarrow>
      q \<notin> {p + x..+y}"
  apply (clarsimp simp: intvl_def)
  apply (simp only: unat_simps')
  apply (subst (asm) word_unat.Abs_inject)
    apply (auto simp: unats_def)
  done

lemma intvl_Suc_nmem' [simp]:
  "n < 2^len_of TYPE('a) \<Longrightarrow> (p::'a::len word) \<notin> {p + 1..+n - Suc 0}"
  by (clarsimp simp: intvl_def)
     (unat_arith, simp only: unat_simps')

lemma intvl_start_le:
  "x \<le> y \<Longrightarrow> {p..+x} \<subseteq> {p..+y}"
  by (force simp: intvl_def)

lemma intvl_sub_eq:
  assumes "x \<le> y"
  shows "{p + x..+unat (y - x)} = {p..+unat y} - {p..+unat x}"
proof -
  have "unat y - unat x \<le> 2 ^ len_of TYPE('a) - unat x"
    by (insert unat_lt2p [of y], arith)
  moreover have "x \<le> y" by fact
  moreover hence "unat (y - x) = unat y - unat x"
    by (simp add: word_le_nat_alt, unat_arith)
  ultimately show ?thesis
    by (force dest: intvl_offset_nmem intvl_mem_offset elim: intvl_plus_sub_offset
              simp: word_le_nat_alt)

qed

end


section\<open>Collapsing the levels\<close>
theory Level_Collapse
imports Conc_Impl
begin
text\<open>
The theory up to this point is implemented in a way that separated the different aspects into different levels.
This is highly beneficial for us, since it allows us to tackle the difficulties arising in small chunks.
However, exporting this to the user would be highly impractical.
Thus, this theory collapses all the different levels (i.e. refinement steps) and relates the computations in the heap monad to
@{type boolfunc}.
\<close>

definition "bddmi_rel cs \<equiv> {(a,c)|a b c. (a,b) \<in> bf_ifex_rel \<and> (c,b) \<in> Rmi cs}"
definition bdd_relator :: "(nat boolfunc \<times> nat) set \<Rightarrow> bddi \<Rightarrow> assn" where
"bdd_relator p s \<equiv> \<exists>\<^sub>Acs. is_bdd_impl cs s * \<up>(p \<subseteq> (bddmi_rel cs) \<and> bdd_sane cs) * true"

text\<open>
The @{type assn} predicate @{term bdd_relator} is the interface that is exposed to the user.
(The contents of the definition are not exposed.)
\<close>

lemma bdd_relator_mono[intro!]: "q \<subseteq> p \<Longrightarrow> bdd_relator p s \<Longrightarrow>\<^sub>A bdd_relator q s" unfolding bdd_relator_def by sep_auto

lemma bdd_relator_absorb_true[simp]: "bdd_relator p s * true = bdd_relator p s" unfolding bdd_relator_def by simp

thm bdd_relator_def[unfolded bddmi_rel_def, simplified]
lemma join_hlp1: "is_bdd_impl a s * is_bdd_impl b s \<Longrightarrow>\<^sub>A is_bdd_impl a s * is_bdd_impl b s * \<up>(a = b)"
  apply clarsimp
  apply(rule preciseD[where p=s and R="is_bdd_impl" and F="is_bdd_impl b s" and F'="is_bdd_impl a s"])
   apply(rule is_bdd_impl_prec)
  apply(unfold mod_and_dist)
  apply(rule conjI)
   apply assumption
  apply(simp add: star_aci(2))
done

lemma join_hlp: "is_bdd_impl a s * is_bdd_impl b s = is_bdd_impl b s * is_bdd_impl a s * \<up>(a = b)"
  apply(rule ent_iffI[rotated])
   apply(simp; fail)
  apply(rule ent_trans)
   apply(rule join_hlp1)
  apply(simp; fail)
  done

lemma add_true_asm:
  assumes "<b * true> p <a>\<^sub>t"
  shows "<b> p <a>\<^sub>t"
  apply(rule cons_pre_rule)
   prefer 2
   apply(rule assms)
  apply(simp add: ent_true_drop)
  done

lemma add_anything:
  assumes "<b> p <a>"
  shows "<b * x> p <\<lambda>r. a r * x>\<^sub>t"
proof -
  note [sep_heap_rules] = assms
  show ?thesis by sep_auto
qed

lemma add_true:
  assumes "<b> p <a>\<^sub>t"
  shows "<b * true> p <a>\<^sub>t"
  using assms add_anything[where x=true] by force

definition node_relator where "node_relator x y \<longleftrightarrow> x \<in> y"
text \<open>\<open>sep_auto\<close> behaves sub-optimal when having @{term "(bf,bdd) \<in> computed_pointer_relation"} as assumption in our cases. Using @{const node_relator} instead fixes this behavior with a custom solver for \<open>simp\<close>.\<close>

lemma node_relatorI: "x \<in> y \<Longrightarrow> node_relator x y" unfolding node_relator_def .
lemma node_relatorD: "node_relator x y \<Longrightarrow> x \<in> y" unfolding node_relator_def .

ML\<open>fun TRY' tac = tac ORELSE' K all_tac\<close>

setup \<open>map_theory_simpset (fn ctxt =>
  ctxt addSolver (Simplifier.mk_solver "node_relator"
    (fn ctxt => fn n =>
      let
        val tac =
          resolve_tac ctxt @{thms node_relatorI} THEN'
          REPEAT_ALL_NEW (resolve_tac ctxt @{thms Set.insertI1 Set.insertI2}) THEN'
          TRY' (dresolve_tac ctxt @{thms node_relatorD} THEN' assume_tac ctxt)
      in
        SOLVED' tac n
      end))
)\<close>

text\<open>
This is the general form one wants to work with:
if a function on the bdd is called with a set of already existing and valid pointers, the arguments to the function have to be in that set.
The result is that one more pointer is the set of existing and valid pointers.
\<close>

thm iteci_rule[THEN mp] mi.ite_impl_R ifex_ite_rel_bf

lemma iteci_rule[sep_heap_rules]: "
\<lbrakk>node_relator (ib, ic)  rp; node_relator (tb, tc) rp; node_relator (eb, ec) rp\<rbrakk> \<Longrightarrow>
<bdd_relator rp s>
  iteci_lu ic tc ec s
<\<lambda>(r,s'). bdd_relator (insert (bf_ite ib tb eb,r) rp) s'>"
  apply(unfold bdd_relator_def node_relator_def)
  apply(intro norm_pre_ex_rule)
  apply(clarsimp)
  apply(unfold bddmi_rel_def)
  apply(drule (1) rev_subsetD)+
  apply(clarsimp)
  apply(drule (3) mi.ite_impl_lu_R[where ii=ic and ti=tc and ei=ec, unfolded in_rel_def])
  apply(drule ospecD2)
  apply(clarsimp simp del: ifex_ite.simps)
  apply(rule cons_post_rule)
   apply(rule cons_pre_rule[rotated])
    apply(rule iteci_lu_rule[THEN mp, THEN add_true])
    apply(assumption)
   apply(sep_auto; fail)
  apply(clarsimp simp del: ifex_ite.simps)
  apply(rule ent_ex_postI)
  apply(subst ent_pure_post_iff)
  apply(rule conjI[rotated])
   apply(sep_auto; fail)
  apply(clarsimp simp del: ifex_ite.simps)
  apply(rule conjI[rotated])
   apply(force simp add: mi.les_def)
  apply(rule exI)
  apply(rule conjI)
   apply(erule (2) ifex_ite_opt_rel_bf[unfolded in_rel_def])
  apply assumption
done

lemma tci_rule[sep_heap_rules]:
"<bdd_relator rp s>
  tci s
<\<lambda>(r,s'). bdd_relator (insert (bf_True,r) rp) s'>"
  apply(unfold bdd_relator_def)
  apply(intro norm_pre_ex_rule)
  apply(clarsimp)
  apply(frule mi.Timpl_rule)
  apply(drule ospecD2)
  apply(clarify)
  apply(sep_auto)
   apply(unfold bddmi_rel_def)
   apply(clarsimp)
  apply(force simp add: mi.les_def)
done

lemma fci_rule[sep_heap_rules]:
"<bdd_relator rp s>
  fci s
<\<lambda>(r,s'). bdd_relator (insert (bf_False,r) rp) s'>"
  apply(unfold bdd_relator_def)
  apply(intro norm_pre_ex_rule)
  apply(clarsimp)
  apply(frule mi.Fimpl_rule)
  apply(drule ospecD2)
  apply(clarify)
  apply(sep_auto)
   apply(unfold bddmi_rel_def)
   apply(clarsimp)
  apply(force simp add: mi.les_def)
done

text\<open>IFC/ifmi/ifci require that the variable order is ensured by the user.
Instead of using ifci, a combination of litci and iteci has to be used.\<close>
lemma [sep_heap_rules]:
"\<lbrakk>(tb, tc) \<in> rp; (eb, ec) \<in> rp\<rbrakk> \<Longrightarrow>
<bdd_relator rp s>
  ifci v tc ec s
<\<lambda>(r,s'). bdd_relator (insert (bf_if v tb eb,r) rp) s'>"
text\<open>This probably doesn't hold.\<close>
oops

lemma notci_rule[sep_heap_rules]:
  assumes "node_relator (tb, tc) rp"
  shows "<bdd_relator rp s> notci tc s <\<lambda>(r,s'). bdd_relator (insert (bf_not tb,r) rp) s'>"
using assms
by(sep_auto simp: notci_def)

lemma cirules1[sep_heap_rules]:
  assumes "node_relator (tb, tc) rp" "node_relator (eb, ec) rp"
  shows
    "<bdd_relator rp s> andci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_and tb eb,r) rp) s'>"
    "<bdd_relator rp s> orci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_or tb eb,r) rp) s'>"
    "<bdd_relator rp s> biimpci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_biimp tb eb,r) rp) s'>"
    "<bdd_relator rp s> xorci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_xor tb eb,r) rp) s'>"
(* actually, these functions would allow for more insert. I think that would be inconvenient though. *)
using assms
by (sep_auto simp: andci_def orci_def biimpci_def xorci_def)+

lemma cirules2[sep_heap_rules]:
  assumes "node_relator (tb, tc) rp" "node_relator (eb, ec) rp"
  shows
    "<bdd_relator rp s> nandci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_nand tb eb,r) rp) s'>"
    "<bdd_relator rp s> norci tc ec s <\<lambda>(r,s'). bdd_relator (insert (bf_nor tb eb,r) rp) s'>"
  using assms
  by(sep_auto simp: nandci_def norci_def)+

lemma litci_rule[sep_heap_rules]:
  "<bdd_relator rp s> litci v s <\<lambda>(r,s'). bdd_relator (insert (bf_lit v,r) rp) s'>"
  apply(unfold litci_def)
  apply(subgoal_tac \<open>\<And>t ab bb. \<comment> \<open>introducing some vars \dots\<close>
         <bdd_relator (insert (bf_False, ab) (insert (bf_True, t) rp)) bb * true>
           ifci v t ab bb
         <\<lambda>r. case r of (r, x) \<Rightarrow> bdd_relator (insert (bf_lit v, r) rp) x>\<close>)
   apply(sep_auto; fail)
  apply(rename_tac tc fc sc)
  apply(unfold bdd_relator_def[abs_def])
  apply(clarsimp)
  apply(intro norm_pre_ex_rule)
  apply(clarsimp)
  apply(unfold bddmi_rel_def)
  apply(clarsimp simp only: bf_ifex_rel_consts_ensured)
  apply(frule mi.IFimpl_rule)
    apply(rename_tac tc fc sc sm a aa b ba fm tm)
    apply(thin_tac "(fm, Falseif) \<in> Rmi sm")
    apply(assumption) (* hack: instantiate the first premise of mi.IFimpl_rule with the second assumption that matches. The other way around would be fine, too. *)
   apply(assumption)
  apply(clarsimp)
  apply(drule ospecD2)
  apply(clarify)
  apply(sep_auto)
  apply(force simp add: mi.les_def)
done

lemma tautci_rule[sep_heap_rules]:
  shows "node_relator (tb, tc) rp \<Longrightarrow> <bdd_relator rp s> tautci tc s <\<lambda>r. bdd_relator rp s * \<up>(r \<longleftrightarrow> tb = bf_True)>"
  apply(unfold node_relator_def)
  apply(unfold tautci_def)
  apply(unfold bdd_relator_def)
  apply(intro norm_pre_ex_rule; clarsimp)
  apply(unfold bddmi_rel_def)
  apply(drule (1) rev_subsetD)
  apply(clarsimp)
  apply(rename_tac sm ti)
  apply(frule (1) mi.DESTRimpl_rule; drule ospecD2; clarify)
  apply(sep_auto split: ifex.splits)
done

lemma emptyci_rule[sep_heap_rules]:
  shows "<emp> emptyci <\<lambda>r. bdd_relator {} r>"
by(sep_auto simp: bdd_relator_def)

(* TODO: make sure that emptyci_rule and firends don't appear duplicate, once concrete-impl style, once level-collapsed. *)

lemmas [simp] = bf_ite_def

text\<open>Efficient comparison of two nodes.\<close>

definition "eqci a b \<equiv> return (a = b)" (* wrapping definition so sep_auto does not run into nowhere *)

lemma iteeq_rule[sep_heap_rules]: "
\<lbrakk>node_relator (xb, xc)  rp; node_relator (yb, yc) rp\<rbrakk> \<Longrightarrow>
<bdd_relator rp s>
  eqci xc yc
<\<lambda>r. \<up>(r \<longleftrightarrow> xb = yb)>\<^sub>t"
  apply(unfold bdd_relator_def node_relator_def eqci_def)
  apply(intro norm_pre_ex_rule)
  apply(clarsimp)
  apply(unfold bddmi_rel_def)
  apply(drule (1) rev_subsetD)+
  apply(rule return_cons_rule)
  apply(clarsimp)
  apply(rule iffI)
   using bf_ifex_eq mi.cmp_rule_eq apply(blast)
  using bf_ifex_eq mi.cmp_rule_eq apply(blast)
done

end