(*
    Authors:      Jose Divasón
                  Sebastiaan Joosten
                  René Thiemann
                  Akihisa Yamada
*)
subsection \<open>Iteration of Subsets of Factors\<close>
theory Sublist_Iteration
imports
  Polynomial_Factorization.Missing_Multiset
  Polynomial_Factorization.Missing_List
  "HOL-Library.IArray"
begin

paragraph \<open>Misc lemmas\<close>

lemma mem_snd_map: "(\<exists>x. (x, y) \<in> S) \<longleftrightarrow> y \<in> snd ` S" by force

lemma filter_upt: assumes "l \<le> m" "m < n" shows "filter ((\<le>) m) [l..<n] = [m..<n]"
proof(insert assms, induct n)
  case 0 then show ?case by auto
next
  case (Suc n) then show ?case by (cases "m = n", auto)
qed

lemma upt_append: "i < j \<Longrightarrow> j < k \<Longrightarrow> [i..<j]@[j..<k] = [i..<k]"
proof(induct k arbitrary: j)
  case 0 then show ?case by auto
next
  case (Suc k) then show ?case by (cases "j = k", auto)
qed

lemma IArray_sub[simp]: "(!!) as = (!) (IArray.list_of as)" by auto
declare IArray.sub_def[simp del]

text \<open>Following lemmas in this section are for @{const subseqs}\<close>

lemma subseqs_Cons[simp]: "subseqs (x#xs) = map (Cons x) (subseqs xs) @ subseqs xs"
  by (simp add: Let_def)

declare subseqs.simps(2) [simp del]

lemma singleton_mem_set_subseqs [simp]: "[x] \<in> set (subseqs xs) \<longleftrightarrow> x \<in> set xs" by (induct xs, auto)

lemma Cons_mem_set_subseqsD: "y#ys \<in> set (subseqs xs) \<Longrightarrow> y \<in> set xs" by (induct xs, auto)

lemma subseqs_subset: "ys \<in> set (subseqs xs) \<Longrightarrow> set ys \<subseteq> set xs"
  by (metis Pow_iff image_eqI subseqs_powset)

lemma Cons_mem_set_subseqs_Cons:
  "y#ys \<in> set (subseqs (x#xs)) \<longleftrightarrow> (y = x \<and> ys \<in> set (subseqs xs)) \<or> y#ys \<in> set (subseqs xs)"
  by auto

lemma sorted_subseqs_sorted:
  "sorted xs \<Longrightarrow> ys \<in> set (subseqs xs) \<Longrightarrow> sorted ys"
proof(induct xs arbitrary: ys)
  case Nil thus ?case by simp
next
  case Cons thus ?case using subseqs_subset by fastforce
qed

lemma subseqs_of_subseq: "ys \<in> set (subseqs xs) \<Longrightarrow> set (subseqs ys) \<subseteq> set (subseqs xs)"
proof(induct xs arbitrary: ys)
  case Nil then show ?case by auto
next
  case IHx: (Cons x xs)
  from IHx.prems show ?case
  proof(induct ys)
    case Nil then show ?case by auto
  next
    case IHy: (Cons y ys)
    from IHy.prems[unfolded subseqs_Cons]
    consider "y = x" "ys \<in> set (subseqs xs)" | "y # ys \<in> set (subseqs xs)" by auto
    then show ?case
    proof(cases)
      case 1 with IHx.hyps show ?thesis by auto
    next
      case 2 from IHx.hyps[OF this] show ?thesis by auto
    qed
  qed
qed

lemma mem_set_subseqs_append: "xs \<in> set (subseqs ys) \<Longrightarrow> xs \<in> set (subseqs (zs @ ys))"
  by (induct zs, auto)

lemma Cons_mem_set_subseqs_append:
  "x \<in> set ys \<Longrightarrow> xs \<in> set (subseqs zs) \<Longrightarrow> x#xs \<in> set (subseqs (ys@zs))"
proof(induct ys)
  case Nil then show ?case by auto
next
  case IH: (Cons y ys)
  then consider "x = y" | "x \<in> set ys" by auto
  then show ?case
  proof(cases)
    case 1 with IH show ?thesis by (auto intro: mem_set_subseqs_append)
  next
    case 2 from IH.hyps[OF this IH.prems(2)] show ?thesis by auto
  qed
qed

lemma Cons_mem_set_subseqs_sorted:
  "sorted xs \<Longrightarrow> y#ys \<in> set (subseqs xs) \<Longrightarrow> y#ys \<in> set (subseqs (filter (\<lambda>x. y \<le> x) xs))"
by (induct xs) (auto simp: Let_def)

lemma subseqs_map[simp]: "subseqs (map f xs) = map (map f) (subseqs xs)" by (induct xs, auto)

lemma subseqs_of_indices: "map (map (nth xs)) (subseqs [0..<length xs]) = subseqs xs"
proof (induct xs)
  case Nil then show ?case by auto
next
  case (Cons x xs)
  from this[symmetric]
  have "subseqs xs = map (map ((!) (x#xs))) (subseqs [Suc 0..<Suc (length xs)])"
    by (fold map_Suc_upt, simp)
  then show ?case by (unfold length_Cons upt_conv_Cons[OF zero_less_Suc], simp)
qed

paragraph \<open>Specification\<close>

definition "subseq_of_length n xs ys \<equiv> ys \<in> set (subseqs xs) \<and> length ys = n"

lemma subseq_of_lengthI[intro]:
  assumes "ys \<in> set (subseqs xs)" "length ys = n"
  shows "subseq_of_length n xs ys"
by (insert assms, unfold subseq_of_length_def, auto)

lemma subseq_of_lengthD[dest]:
  assumes "subseq_of_length n xs ys"
  shows "ys \<in> set (subseqs xs)" "length ys = n"
  by (insert assms, unfold subseq_of_length_def, auto)

lemma subseq_of_length0[simp]: "subseq_of_length 0 xs ys \<longleftrightarrow> ys = []" by auto

lemma subseq_of_length_Nil[simp]: "subseq_of_length n [] ys \<longleftrightarrow> n = 0 \<and> ys = []"
  by (auto simp: subseq_of_length_def)

lemma subseq_of_length_Suc_upt:
  "subseq_of_length (Suc n) [0..<m] xs \<longleftrightarrow>
   (if n = 0 then length xs = Suc 0 \<and> hd xs < m
    else hd xs < hd (tl xs) \<and> subseq_of_length n [0..<m] (tl xs))" (is "?l \<longleftrightarrow> ?r")
proof(cases "n")
  case 0
  show ?thesis
  proof(intro iffI)
    assume l: "?l"
    with 0 have 1: "length xs = Suc 0" by auto
    then have xs: "xs = [hd xs]" by (metis length_0_conv length_Suc_conv list.sel(1))
    with l have "[hd xs] \<in> set (subseqs [0..<m])" by auto
    with 1 show "?r" by (unfold 0, auto)
  next
    assume ?r
    with 0 have 1: "length xs = Suc 0" and 2: "hd xs < m" by auto
    then have xs: "xs = [hd xs]" by (metis length_0_conv length_Suc_conv list.sel(1))
    from 2 show "?l" by (subst xs, auto simp: 0)
  qed
next
  case n: (Suc n')
  show ?thesis
  proof (intro iffI)
    assume "?l"
    with n have 1: "length xs = Suc (Suc n')" and 2: "xs \<in> set (subseqs [0..<m])" by auto
    from 1[unfolded length_Suc_conv]
    obtain x y ys where xs: "xs = x#y#ys" and n': "length ys = n'" by auto
    have "sorted xs" by(rule sorted_subseqs_sorted[OF _ 2], auto)
    from this[unfolded xs] have "x \<le> y" by auto
    moreover
      from 2 have "distinct xs" by (rule subseqs_distinctD, auto)
      from this[unfolded xs] have "x \<noteq> y" by auto
    ultimately have "x < y" by auto
    moreover
      from 2 have "y#ys \<in> set (subseqs [0..<m])" by (unfold xs, auto dest: Cons_in_subseqsD)
      with n n' have "subseq_of_length n [0..<m] (y#ys)" by auto
    ultimately show ?r by (auto simp: xs)
  next
    assume r: "?r"
    with n have len: "length xs = Suc (Suc n')"
     and *: "hd xs < hd (tl xs)" "tl xs \<in> set (subseqs [0..<m])" by auto
    from len[unfolded length_Suc_conv] obtain x y ys
    where xs: "xs = x#y#ys" and n': "length ys = n'" by auto
    with * have xy: "x < y" and yys: "y#ys \<in> set (subseqs [0..<m])" by auto
    from Cons_mem_set_subseqs_sorted[OF _ yys]
    have "y#ys \<in> set (subseqs (filter ((\<le>) y) [0..<m]))" by auto
    also from Cons_mem_set_subseqsD[OF yys] have ym: "y < m" by auto
      then have "filter ((\<le>) y) [0..<m] = [y..<m]" by (auto intro: filter_upt)
    finally have "y#ys \<in> set (subseqs [y..<m])" by auto
    with xy have "x#y#ys \<in> set (subseqs (x#[y..<m]))" by auto
    also from xy have "... \<subseteq> set (subseqs ([0..<y] @ [y..<m]))"
      by (intro subseqs_of_subseq Cons_mem_set_subseqs_append, auto intro: subseqs_refl)
    also from xy ym have "[0..<y] @ [y..<m] = [0..<m]" by (auto intro: upt_append)
    finally have "xs \<in> set (subseqs [0..<m])" by (unfold xs)
    with len[folded n] show ?l by auto
  qed
qed

lemma subseqs_of_length_of_indices:
  "{ ys. subseq_of_length n xs ys } = { map (nth xs) is | is. subseq_of_length n [0..<length xs] is }"
  by(unfold subseq_of_length_def, subst subseqs_of_indices[symmetric], auto)

lemma subseqs_of_length_Suc_Cons:
  "{ ys. subseq_of_length (Suc n) (x#xs) ys } =
   Cons x ` { ys. subseq_of_length n xs ys } \<union> { ys. subseq_of_length (Suc n) xs ys }"
  by (unfold subseq_of_length_def, auto)

datatype ('a,'b,'state)subseqs_impl = Sublists_Impl
  (create_subseqs: "'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> ('b \<times> 'a list)list \<times> 'state")
  (next_subseqs: "'state \<Rightarrow> ('b \<times> 'a list)list \<times> 'state")

locale subseqs_impl =
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
  and sl_impl :: "('a,'b,'state)subseqs_impl"
begin

definition S :: "'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> ('b \<times> 'a list)set" where
  "S base elements n = { (foldr f ys base, ys) | ys. subseq_of_length n elements ys }"

end

locale correct_subseqs_impl = subseqs_impl f sl_impl
  for f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
  and sl_impl :: "('a,'b,'state)subseqs_impl" +
  fixes invariant :: "'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'state \<Rightarrow> bool"
  assumes create_subseqs: "create_subseqs sl_impl base elements n = (out, state) \<Longrightarrow> invariant base elements n state \<and> set out = S base elements n"
  and next_subseqs:
    "invariant base elements n state \<Longrightarrow>
     next_subseqs sl_impl state = (out, state') \<Longrightarrow>
     invariant base elements (Suc n) state' \<and> set out = S base elements (Suc n)"

(* **** old implementation *********** *)
paragraph \<open>Basic Implementation\<close>
fun subseqs_i_n_main :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ('b \<times> 'a list) list" where
  "subseqs_i_n_main f b xs i n = (if i = 0 then [(b,[])] else if i = n then [(foldr f xs b, xs)]
    else case xs of
      (y # ys) \<Rightarrow> map (\<lambda> (c,zs) \<Rightarrow> (c,y # zs)) (subseqs_i_n_main f (f y b) ys (i - 1) (n - 1))
        @ subseqs_i_n_main f b ys i (n - 1))"
declare subseqs_i_n_main.simps[simp del]

definition subseqs_length :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('b \<times> 'a list) list" where
  "subseqs_length f b i xs = (
    let n = length xs in if i > n then [] else subseqs_i_n_main f b xs i n)"

lemma subseqs_length: assumes f_ac: "\<And> x y z. f x (f y z) = f y (f x z)"
  shows "set (subseqs_length f a n xs) =
  { (foldr f ys a, ys) | ys. ys \<in> set (subseqs xs) \<and> length ys = n}"
proof -
  show ?thesis
  proof (cases "length xs < n")
    case True
    thus ?thesis unfolding subseqs_length_def Let_def
      using length_subseqs[of xs] subseqs_length_simple_False by auto
  next
    case False
    hence id: "(length xs < n) = False" and "n \<le> length xs" by auto
    from this(2) show ?thesis unfolding subseqs_length_def Let_def id if_False
    proof (induct xs arbitrary: n a rule: length_induct[rule_format])
      case (1 xs n a)
      note n = 1(2)
      note IH = 1(1)
      note simp[simp] = subseqs_i_n_main.simps[of f _ xs n]
      show ?case
      proof (cases "n = 0")
        case True
        thus ?thesis unfolding simp by simp
      next
        case False note 0 = this
        show ?thesis
        proof (cases "n = length xs")
          case True
          have "?thesis = ({(foldr f xs a, xs)} = (\<lambda> ys. (foldr f ys a, ys)) ` {ys. ys \<in> set (subseqs xs) \<and> length ys = length xs})"
            unfolding simp using 0 True by auto
          from this[unfolded full_list_subseqs] show ?thesis by auto
        next
          case False
          with n have n: "n < length xs" by auto
          from 0 obtain m where m: "n = Suc m" by (cases n, auto)
          from n 0 obtain y ys where xs: "xs = y # ys" by (cases xs, auto)
          from n m xs have le: "m \<le> length ys" "n \<le> length ys" by auto
          from xs have lt: "length ys < length xs" by auto
          have sub: "set (subseqs_i_n_main f a xs n (length xs)) =
            (\<lambda>(c, zs). (c, y # zs)) ` set (subseqs_i_n_main f (f y a) ys m (length ys)) \<union>
            set (subseqs_i_n_main f a ys n (length ys))"
            unfolding simp using 0 False by (simp add: xs m)
          have fold: "\<And> ys. foldr f ys (f y a) = f y (foldr f ys a)"
            by (induct_tac ys, auto simp: f_ac)
          show ?thesis unfolding sub IH[OF lt le(1)] IH[OF lt le(2)]
            unfolding m xs by (auto simp: Let_def fold)
        qed
      qed
    qed
  qed
qed

definition basic_subseqs_impl :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a, 'b, 'b \<times> 'a list \<times> nat)subseqs_impl" where
  "basic_subseqs_impl f = Sublists_Impl
    (\<lambda> a xs n. (subseqs_length f a n xs, (a,xs,n)))
    (\<lambda> (a,xs,n). (subseqs_length f a (Suc n) xs, (a,xs,Suc n)))"

lemma basic_subseqs_impl: assumes f_ac: "\<And> x y z. f x (f y z) = f y (f x z)"
  shows "correct_subseqs_impl f (basic_subseqs_impl f)
    (\<lambda> a xs n triple. (a,xs,n) = triple)"
  by (unfold_locales; unfold subseqs_impl.S_def basic_subseqs_impl_def subseq_of_length_def,
      insert subseqs_length[of f, OF f_ac], auto)

(******** new implementation ********)
paragraph \<open>Improved Implementation\<close>

datatype ('a,'b,'state) subseqs_foldr_impl = Sublists_Foldr_Impl
  (subseqs_foldr: "'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'b list \<times> 'state")
  (next_subseqs_foldr: "'state \<Rightarrow> 'b list \<times> 'state")

locale subseqs_foldr_impl =
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
  and impl :: "('a,'b,'state) subseqs_foldr_impl"
begin
definition S where "S base elements n \<equiv> { foldr f ys base | ys. subseq_of_length n elements ys }"
end

locale correct_subseqs_foldr_impl = subseqs_foldr_impl f impl
  for f and impl :: "('a,'b,'state) subseqs_foldr_impl" +
  fixes invariant :: "'b \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'state \<Rightarrow> bool"
  assumes subseqs_foldr:
    "subseqs_foldr impl base elements n = (out, state) \<Longrightarrow>
     invariant base elements n state \<and> set out = S base elements n"
  and next_subseqs_foldr:
    "next_subseqs_foldr impl state = (out, state') \<Longrightarrow> invariant base elements n state \<Longrightarrow>
     invariant base elements (Suc n) state' \<and> set out = S base elements (Suc n)"

locale my_subseqs =
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
begin

context fixes head :: "'a" and tail :: "'a iarray"
begin

fun next_subseqs1 and next_subseqs2
where "next_subseqs1 ret0 ret1 [] = (ret0, (head, tail, ret1))"
  |   "next_subseqs1 ret0 ret1 ((i,v)#prevs) = next_subseqs2 (f head v # ret0) ret1 prevs v [0..<i]"
  |   "next_subseqs2 ret0 ret1 prevs v [] = next_subseqs1 ret0 ret1 prevs"
  |   "next_subseqs2 ret0 ret1 prevs v (j#js) =
       (let v' = f (tail !! j) v in next_subseqs2 (v' # ret0) ((j,v') # ret1) prevs v js)"

definition "next_subseqs2_set v js \<equiv> { (j, f (tail !! j) v) | j. j \<in> set js }"

definition "out_subseqs2_set v js \<equiv> { f (tail !! j) v | j. j \<in> set js }"

definition "next_subseqs1_set prevs \<equiv> \<Union> { next_subseqs2_set v [0..<i] | v i. (i,v) \<in> set prevs }"

definition "out_subseqs1_set prevs \<equiv>
  (f head \<circ> snd) ` set prevs \<union> (\<Union> { out_subseqs2_set v [0..<i] | v i. (i,v) \<in> set prevs })"

fun next_subseqs1_spec where
  "next_subseqs1_spec out nexts prevs (out', (head',tail',nexts')) \<longleftrightarrow>
   set nexts' = set nexts \<union> next_subseqs1_set prevs \<and>
   set out' = set out \<union> out_subseqs1_set prevs"

fun next_subseqs2_spec where
  "next_subseqs2_spec out nexts prevs v js (out', (head',tail',nexts')) \<longleftrightarrow>
   set nexts' = set nexts \<union> next_subseqs1_set prevs \<union> next_subseqs2_set v js \<and>
   set out' = set out \<union> out_subseqs1_set prevs \<union> out_subseqs2_set v js"

lemma next_subseqs2_Cons:
  "next_subseqs2_set v (j#js) = insert (j, f (tail!!j) v) (next_subseqs2_set v js)"
  by (auto simp: next_subseqs2_set_def)

lemma out_subseqs2_Cons:
  "out_subseqs2_set v (j#js) = insert (f (tail!!j) v) (out_subseqs2_set v js)"
  by (auto simp: out_subseqs2_set_def)

lemma next_subseqs1_set_as_next_subseqs2_set:
  "next_subseqs1_set ((i,v) # prevs) = next_subseqs1_set prevs \<union> next_subseqs2_set v [0..<i]"
  by (auto simp: next_subseqs1_set_def)

lemma out_subseqs1_set_as_out_subseqs2_set:
  "out_subseqs1_set ((i,v) # prevs) =
   { f head v } \<union> out_subseqs1_set prevs \<union> out_subseqs2_set v [0..<i]"
  by (auto simp: out_subseqs1_set_def)

lemma next_subseqs1_spec:
  shows "\<And>out nexts. next_subseqs1_spec out nexts prevs (next_subseqs1 out nexts prevs)"
    and "\<And>out nexts. next_subseqs2_spec out nexts prevs v js (next_subseqs2 out nexts prevs v js)"
proof(induct rule: next_subseqs1_next_subseqs2.induct)
  case (1 ret0 ret1)
  then show ?case by (simp add: next_subseqs1_set_def out_subseqs1_set_def)
next
  case (2 ret0 ret1 i v prevs)
  show ?case
  proof(cases "next_subseqs1 out nexts ((i, v) # prevs)")
    case split: (fields out' head' tail' nexts')
    have "next_subseqs2_spec (f head v # out) nexts prevs v [0..<i] (out', (head',tail',nexts'))"
      by (fold split, unfold next_subseqs1.simps, rule 2)
    then show ?thesis
      apply (unfold next_subseqs2_spec.simps split)
      by (auto simp: next_subseqs1_set_as_next_subseqs2_set out_subseqs1_set_as_out_subseqs2_set)
  qed
next
  case (3 ret0 ret1 prevs v)
  show ?case
  proof (cases "next_subseqs1 out nexts prevs")
    case split: (fields out' head' tail' nexts')
    from 3[of out nexts] show ?thesis by(simp add: split next_subseqs2_set_def out_subseqs2_set_def)
  qed
next
  case (4 ret0 ret1 prevs v j js)
  define tj where "tj = tail !! j"
  define nexts'' where "nexts'' = (j, f tj v) # nexts"
  define out'' where "out'' = (f tj v) # out"
  let ?n = "next_subseqs2 out'' nexts'' prevs v js"
  show ?case
  proof (cases ?n)
    case split: (fields out' head' tail' nexts')
    show ?thesis
      apply (unfold next_subseqs2.simps Let_def)
      apply (fold tj_def)
      apply (fold out''_def nexts''_def)
      apply (unfold split next_subseqs2_spec.simps next_subseqs2_Cons out_subseqs2_Cons)
      using 4[OF refl, of out'' nexts'', unfolded split]
      apply (auto simp: tj_def nexts''_def out''_def)
      done
  qed
qed

end

fun next_subseqs where "next_subseqs (head,tail,prevs) = next_subseqs1 head tail [] [] prevs"

fun create_subseqs
where "create_subseqs base elements 0 = (
       if elements = [] then ([base],(undefined, IArray [], []))
       else let head = hd elements; tail = IArray (tl elements) in
         ([base], (head, tail, [(IArray.length tail, base)])))"
  |   "create_subseqs base elements (Suc n) =
       next_subseqs (snd (create_subseqs base elements n))"

definition impl where "impl = Sublists_Foldr_Impl create_subseqs next_subseqs"

sublocale subseqs_foldr_impl f impl .

definition set_prevs where "set_prevs base tail n \<equiv>
  { (i, foldr f (map ((!) tail) is) base) | i is.
   subseq_of_length n [0..<length tail] is \<and> i = (if n = 0 then length tail else hd is) }"

lemma snd_set_prevs:
  "snd ` (set_prevs base tail n) = (\<lambda>as. foldr f as base) ` { as. subseq_of_length n tail as }"
  by (subst subseqs_of_length_of_indices, auto simp: set_prevs_def image_Collect)

fun invariant where "invariant base elements n (head,tail,prevs) =
  (if elements = [] then prevs = []
   else head = hd elements \<and> tail = IArray (tl elements) \<and> set prevs = set_prevs base (tl elements) n)"

lemma next_subseq_preserve:
  assumes "next_subseqs (head,tail,prevs) = (out, (head',tail',prevs'))"
  shows "head' = head" "tail' = tail"
proof-
  define P :: "'b list \<times> _ \<times> _ \<times> (nat \<times> 'b) list \<Rightarrow> bool"
  where "P \<equiv> \<lambda> (out, (head',tail',prevs')). head' = head \<and> tail' = tail"
  { fix ret0 ret1 v js
    have *: "P (next_subseqs1 head tail ret0 ret1 prevs)"
     and  "P (next_subseqs2 head tail ret0 ret1 prevs v js)"
    by(induct rule: next_subseqs1_next_subseqs2.induct, simp add: P_def, auto simp: Let_def)
  }
  from this(1)[unfolded P_def, of "[]" "[]", folded next_subseqs.simps] assms
  show "head' = head" "tail' = tail" by auto
qed

lemma next_subseqs_spec:
  assumes nxt: "next_subseqs (head,tail,prevs) = (out, (head',tail',prevs'))"
  shows "set prevs' = { (j, f (tail !! j) v) | v i j. (i,v) \<in> set prevs \<and> j < i }" (is "?g1")
    and "set out = (f head \<circ> snd) ` set prevs \<union> snd ` set prevs'" (is "?g2")
proof-
  note next_subseqs1_spec(1)[of head tail Nil Nil prevs]
  note this[unfolded nxt[simplified]]
  note this[unfolded next_subseqs1_spec.simps]
  note this[unfolded next_subseqs1_set_def out_subseqs1_set_def]
  note * = this[unfolded next_subseqs2_set_def out_subseqs2_set_def]
  then show g1: ?g1 by auto
  also have "snd ` ... =  (\<Union> {{(f (tail !! j) v) | j. j < i} | v i. (i, v) \<in> set prevs})"
     by (unfold image_Collect, auto)
  finally have **: "snd ` set prevs' = ...".
  with conjunct2[OF *] show ?g2 by simp
qed

lemma next_subseq_prevs:
  assumes nxt: "next_subseqs (head,tail,prevs) = (out, (head',tail',prevs'))"
      and inv_prevs: "set prevs = set_prevs base (IArray.list_of tail) n"
  shows "set prevs' = set_prevs base (IArray.list_of tail) (Suc n)" (is "?l = ?r")
proof(intro equalityI subsetI)
  fix t
  assume r: "t \<in> ?r"
  from this[unfolded set_prevs_def] obtain iis
  where t: "t = (hd iis, foldr f (map ((!!) tail) iis) base)"
    and sl: "subseq_of_length (Suc n) [0..<IArray.length tail] iis" by auto
  from sl have "length iis > 0" by auto
  then obtain i "is" where iis: "iis = i#is" by (meson list.set_cases nth_mem)
  define v where "v = foldr f (map ((!!) tail) is) base"
  note sl[unfolded subseq_of_length_Suc_upt]
  note nxt = next_subseqs_spec[OF nxt]
  show "t \<in> ?l"
  proof(cases "n = 0")
    case True
    from sl[unfolded subseq_of_length_Suc_upt] t
    show ?thesis by (unfold nxt[unfolded inv_prevs] True set_prevs_def length_Suc_conv, auto)
  next
    case [simp]: False
    from sl[unfolded subseq_of_length_Suc_upt iis,simplified]
    have i: "i < hd is" and "is": "subseq_of_length n [0..<IArray.length tail] is" by auto
    then have *: "(hd is, v) \<in> set_prevs base (IArray.list_of tail) n"
      by (unfold set_prevs_def, auto intro!: exI[of _ "is"] simp: v_def)
    with i have "(i, f (tail !! i) v) \<in> {(j, f (tail !! j) v) | j. j < hd is}" by auto
    with t[unfolded iis] have "t \<in> ..." by (auto simp: v_def)
    with * show ?thesis by (unfold nxt[unfolded inv_prevs], auto)
  qed
next
  fix t
  assume l: "t \<in> ?l"
  from l[unfolded next_subseqs_spec(1)[OF nxt]]
  obtain j v i
  where t: "t = (j, f (tail!!j) v)"
    and j: "j < i"
    and iv: "(i,v) \<in> set prevs" by auto
  from iv[unfolded inv_prevs set_prevs_def, simplified]
  obtain "is"
  where v: "v = foldr f (map ((!!) tail) is) base"
    and "is": "subseq_of_length n [0..<IArray.length tail] is"
    and i: "if n = 0 then i = IArray.length tail else i = hd is" by auto
  from "is" j i have jis: "subseq_of_length (Suc n) [0..<IArray.length tail] (j#is)"
    by (unfold subseq_of_length_Suc_upt, auto)
  then show "t \<in> ?r" by (auto intro!: exI[of _ "j#is"] simp: set_prevs_def t v)
qed

lemma invariant_next_subseqs:
  assumes inv: "invariant base elements n state"
      and nxt: "next_subseqs state = (out, state')"
  shows "invariant base elements (Suc n) state'"
proof(cases "elements = []")
  case True with inv nxt show ?thesis by(cases state, auto)
next
  case False with inv nxt show ?thesis
  proof (cases state)
    case state: (fields head tail prevs)
    note inv = inv[unfolded state]
    show ?thesis
    proof (cases state')
      case state': (fields head' tail' prevs')
      note nxt = nxt[unfolded state state']
      note [simp] = next_subseq_preserve[OF nxt]
      from False inv
      have "set prevs = set_prevs base (IArray.list_of tail) n" by auto
      from False next_subseq_prevs[OF nxt this] inv
      show ?thesis by(auto simp: state')
    qed
  qed
qed

lemma out_next_subseqs:
  assumes inv: "invariant base elements n state"
      and nxt: "next_subseqs state = (out, state')"
  shows "set out = S base elements (Suc n)"
proof (cases state)
  case state: (fields head tail prevs)
  show ?thesis
  proof(cases "elements = []")
    case True
    with inv nxt show ?thesis by (auto simp: state S_def)
  next
    case elements: False
    show ?thesis
    proof(cases state')
      case state': (fields head' tail' prevs')
      from elements inv[unfolded state,simplified]
      have "head = hd elements"
       and "tail = IArray (tl elements)"
       and prevs: "set prevs = set_prevs base (tl elements) n" by auto
      with elements have elements2: "elements = head # IArray.list_of tail"  by auto
      let ?f = "\<lambda>as. (foldr f as base)"
      have "set out = ?f ` {ys. subseq_of_length (Suc n) elements ys}"
      proof-
        from invariant_next_subseqs[OF inv nxt, unfolded state' invariant.simps if_not_P[OF elements]]
        have tail': "tail' = IArray (tl elements)"
         and prevs': "set prevs' = set_prevs base (tl elements) (Suc n)" by auto
        note next_subseqs_spec(2)[OF nxt[unfolded state state'], unfolded this]
        note this[folded image_comp, unfolded snd_set_prevs]
        also note prevs
        also note snd_set_prevs
        also have "f head ` ?f ` { as. subseq_of_length n (tl elements) as } =
          ?f ` Cons head ` { as. subseq_of_length n (tl elements) as }" by (auto simp: image_def)
        also note image_Un[symmetric]
        also have
          "((#) head ` {as. subseq_of_length n (tl elements) as} \<union>
           {as. subseq_of_length (Suc n) (tl elements) as}) =
           {as. subseq_of_length (Suc n) elements as}"
        by (unfold subseqs_of_length_Suc_Cons elements2, auto)
        finally show ?thesis.
      qed
      then show ?thesis by (auto simp: S_def)
    qed
  qed
qed

lemma create_subseqs:
  "create_subseqs base elements n = (out, state) \<Longrightarrow>
   invariant base elements n state \<and> set out = S base elements n"
proof(induct n arbitrary: out state)
  case 0 then show ?case by (cases "elements", cases state, auto simp: S_def Let_def set_prevs_def)
next
  case (Suc n) show ?case
  proof (cases "create_subseqs base elements n")
    case 1: (fields out'' head tail prevs)
    show ?thesis
    proof (cases "next_subseqs (head, tail, prevs)")
      case (fields out' head' tail' prevs')
      note 2 = this[unfolded next_subseq_preserve[OF this]]
      from Suc(2)[unfolded create_subseqs.simps 1 snd_conv 2]
      have 3: "out' = out" "state = (head,tail,prevs')" by auto
      from Suc(1)[OF 1]
      have inv: "invariant base elements n (head, tail, prevs)" by auto
      from out_next_subseqs[OF inv 2] invariant_next_subseqs[OF inv 2]
      show ?thesis by (auto simp: 3)
    qed
  qed
qed

sublocale correct_subseqs_foldr_impl f impl invariant
  by (unfold_locales; auto simp: impl_def invariant_next_subseqs out_next_subseqs create_subseqs)

lemma impl_correct: "correct_subseqs_foldr_impl f impl invariant" ..
end

lemmas [code] =
  my_subseqs.next_subseqs.simps
  my_subseqs.next_subseqs1.simps
  my_subseqs.next_subseqs2.simps
  my_subseqs.create_subseqs.simps
  my_subseqs.impl_def

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)
 *)

section "32-Bit Machine Word Setup"

theory Word_Setup_32
imports Word_Enum
begin

text \<open>This theory defines standard platform-specific word size and alignment.\<close>

definition
  word_bits :: nat where
  "word_bits \<equiv> len_of TYPE(32)"

definition
  word_size :: "'a :: numeral" where
  "word_size \<equiv> 4"

lemma word_bits_conv:
  "word_bits = 32" unfolding word_bits_def by simp

lemma word_bits_word_size_conv:
  "word_bits = word_size * 8"
  unfolding word_bits_def word_size_def by simp

end


(*  Title:        Notions of Communication for C2KA
    Author:       Maxime Buyse <maxime.buyse at polytechnique.edu>, 2019
    Maintainers:  Maxime Buyse <maxime.buyse at polytechnique.edu> and Jason Jaskolka <jason.jaskolka at carleton.ca>
*)

section \<open>Notions of Communication for \CCKAabbrv \label{sec:communication}\<close>

text \<open>
Distributed systems contain a significant number of interactions among their constituent agents. Any interaction,
direct or indirect, of an agent with its neighbouring agents can be understood as a \emph{communication}~\cite{Milner1989aa}.
Therefore, any potential for communication between two system agents can be characterized by the existence of a communication
path allowing for the transfer of data or control from one agent to another. Potential for communication allows system
agents to have an \emph{influence} over each other. The study of agent influence allows for the
determination of the overall structure of the distributed system of which the agents comprise. A full treatment of the potential
for communication within distributed systems specified using \CCKAabbrv has been given in~\cite{Jaskolka2015ab}
and~\cite{Jaskolka2014ac} and is highlighted below.

Consider a distributed system with~$\Agent{A}, \Agent{B} \in \A$ such that~$\Agent{A} \neq \Agent{B}$. We write~$\agent{A}{a}$
where~$\Agent{A}$ is the name given to the agent and~$a \in \CKAset$ is the agent behaviour. For~$\agent{A}{a}$ and~$\agent{B}{b}$,
we write~$\Agent{A+B}$ to denote the agent~$\bigA{a+b}$. In a sense, we extend the operators on behaviours of~$\CKAset$ to their
corresponding agents.

Communication via stimuli from agent~$\Agent{A}$ to agent~$\Agent{B}$ is said to have taken place only when
a stimulus generated by~$\Agent{A}$ \emph{influences} (i.e., causes an observable change in, directly or indirectly) the behaviour
of~$\Agent{B}$. Note that it is possible that more than one agent is influenced by the generation of the same stimulus by another
agent in the system. Formally, we say that agent~$\agent{A}{a}$ has the \emph{potential for direct communication via stimuli} with
agent~$\agent{B}{b}$ (denoted by~$\STIMcommD{\Agent{A}}{\Agent{B}}$) if and only
if~$\biglnotation{\exists}{s,t}{s,t \in \STIMbasic \nAnd t \STIMle \lOut{a}{s} }{\lAct{b}{t} \neq b}$ where~$\STIMbasic$ is the
set of all basic stimuli. A stimulus is called \emph{basic} if it is indivisible with regard to the sequential composition
operator~$\STIMdot$ of a stimulus structure. Similarly, we say that agent~$\Agent{A}$ has the \emph{potential for communication
via stimuli with agent~$\Agent{B}$ using at most~$n$ basic stimuli} (denoted by~$\STIMcommN{\Agent{A}}{\Agent{B}}{n}$) if and only
if~$\biglnotation{\exists}{\Agent{C}}{\Agent{C} \in \A \nAnd \Agent{C} \neq \Agent{A} \nAnd \Agent{C} \neq \Agent{B}}{\STIMcommN{\Agent{A}}{\Agent{C}}{(n-1)} \nAnd \STIMcommD{\Agent{C}}{\Agent{B}}}$.
More generally, we say that agent~$\Agent{A}$ has the \emph{potential for communication via stimuli} with agent~$\Agent{B}$
(denoted by~$\STIMcomm{\Agent{A}}{\Agent{B}}$) if and only if~$\biglnotation{\exists}{n}{n \ge 1}{\STIMcommN{\Agent{A}}{\Agent{B}}{n}}$.
When~$\STIMcomm{\Agent{A}}{\Agent{B}}$, there is a sequence of stimuli of arbitrary length which allows for the transfer of data or
control from agent~$\Agent{A}$ to agent~$\Agent{B}$ in the system. To simplify the Isabelle theory, we do not implement
the potential for communication using at most~$n$ basic stimuli. Instead, we give the definition of potential for direct communication
via stimuli and the fact that~$\STIMcommD{\Agent{A}}{\Agent{B}} \Longrightarrow \STIMcomm{\Agent{A}}{\Agent{B}}$ as axioms because
these are the only properties that we use about potential for communication via stimuli.

Communication via shared environments from agent~$\Agent{A}$ to agent~$\Agent{B}$ (denoted by~$\ENVcomm{\Agent{A}}{\Agent{B}}$) is
said to have taken place only when~$\Agent{A}$ has the ability to alter an element of the environment that it shares with~$\Agent{B}$
such that~$\Agent{B}$ is able to observe the alteration that was made. Formally, we say that agent~$\agent{A}{a}$ has the
\emph{potential for direct communication via shared environments} with agent~$\agent{B}{b}$ (denoted by~$\ENVcommD{\Agent{A}}{\Agent{B}}$)
if and only if~$\dep{b}{a}$ where~$\depOp$ is a given dependence relation. More generally, agent~$\Agent{A}$ has the
\emph{potential for communication via shared environments} with agent~$\Agent{B}$ (denoted by~$\ENVcomm{\Agent{A}}{\Agent{B}}$) if and
only if~$\depTC{b}{a}$ where~$\depOpTC$ is the transitive closure of the given dependence relation. This means that if two agents respect
the given dependence relation, then there is a potential for communication via shared environments.
\<close>

theory Communication_C2KA
  imports Topology_C2KA
begin

text \<open>
The locale \emph{communication-c2ka} extends \emph{topology-c2ka} to include aspects of potential for communication
among distributed system agents.
\<close>

locale communication_c2ka = topology_c2ka +
  fixes dcs :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>\<S>" 50)
  and pcs :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>\<S>\<^sup>+" 50)
  and dce :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>\<E>" 50)
  and pce :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>\<E>\<^sup>+" 50)
  and pdc :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<leadsto>" 50)
  and pfc :: "'a::cka \<Rightarrow> 'a::cka \<Rightarrow> bool" (infix "\<leadsto>\<^sup>+" 50)
  and stimuli_connected :: "'a set \<Rightarrow> bool"
  and universally_influential :: "'a::cka \<times> 'a set \<Rightarrow> bool"
  assumes dcs_def: "a \<rightarrow>\<^sub>\<S> b \<longleftrightarrow>
  (\<exists> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,a) \<and> t \<circ> b \<noteq> b)"
  and pdc_def: "a \<leadsto> b \<longleftrightarrow> (a \<rightarrow>\<^sub>\<S> b \<or> a \<rightarrow>\<^sub>\<E> b)"
  and zero_dce: "\<not>(0 \<rightarrow>\<^sub>\<E> a)"
  and one_dce: "\<not>(1 \<rightarrow>\<^sub>\<E> a)"
  and dce_zero: "\<not>(a \<rightarrow>\<^sub>\<E> 0)"
  and dce_one: "\<not>(a \<rightarrow>\<^sub>\<E> 1)"
  and sum_dce: "(A + B \<rightarrow>\<^sub>\<E> C) \<longleftrightarrow> (A \<rightarrow>\<^sub>\<E> C \<or> B \<rightarrow>\<^sub>\<E> C)"
  and dce_sum: "(A \<rightarrow>\<^sub>\<E> B + C) \<longleftrightarrow> (A \<rightarrow>\<^sub>\<E> B \<or> A \<rightarrow>\<^sub>\<E> C)"
  and dcs_pcs: "A \<rightarrow>\<^sub>\<S> B \<Longrightarrow> A \<rightarrow>\<^sub>\<S>\<^sup>+ B"
  and stimuli_connected_def: "stimuli_connected(\<C>) \<longleftrightarrow>
(\<forall> X\<^sub>1 X\<^sub>2. X\<^sub>1 \<inter> X\<^sub>2 = {} \<and> X\<^sub>1 \<union> X\<^sub>2 = \<C> \<and> X\<^sub>1 \<noteq> {} \<and> X\<^sub>2 \<noteq> {} \<longrightarrow>
(\<exists> A B. A \<in> X\<^sub>1 \<and> B \<in> X\<^sub>2 \<and> (A \<rightarrow>\<^sub>\<S>\<^sup>+ B \<or> B \<rightarrow>\<^sub>\<S>\<^sup>+ A)))"
  and universally_influential_def: "universally_influential(A,\<C>) \<longleftrightarrow>
A \<in> \<C> \<and> (\<forall> B. B \<in> \<C> \<and> B \<noteq> A \<longrightarrow> A \<rightarrow>\<^sub>\<S>\<^sup>+ B)"
begin

subsection \<open>Stimuli-Connected Systems \& Universally Influential Agents \label{sub:stimuli_connected_universally_influential}\<close>

text \<open>
Two subsets~$X_1$ and~$X_2$ of~$\A$ form a partition of~$\A$ if and only if~$X_1 \cap X_2 = \STbot$ and~$X_1 \cup X_2 = \A$. A distributed system
of agents~$\A$ is called \emph{stimuli-connected} if and only if for every~$X_1$ and~$X_2$ nonempty that form a partition of~$\A$, we
have~$\lnotation{\exists}{\Agent{A},\Agent{B}}{\Agent{A} \in X_1 \nAnd \Agent{B} \in X_2}{\STIMcomm{\Agent{A}}{\Agent{B}} \Ors \STIMcomm{\Agent{B}}{\Agent{A}}}$.
Otherwise,~$\A$ is called \emph{stimuli-disconnected}. In a stimuli-connected system, every agent is a participant, either as the source or sink,
of at least one direct communication via stimuli.
\<close>

text \<open>
An agent~$\Agent{A} \in \A$ is called \emph{universally influential} if and only
if~$\biglnotation{\forall}{\Agent{B}}{\Agent{B} \in \A \STdiff \set{\Agent{A}}}{\STIMcomm{\Agent{A}}{\Agent{B}}}$.
A universally influential agent is able to generate some stimuli that influences the behaviour, either directly or
indirectly, of each other agent in the system.
\<close>

text \<open>
Lemma \emph{universally-influential-stimuli-connected} shows that the existence of a universally influential agent yields a stimuli-connected system.
\<close>

lemma universally_influential_stimuli_connected:
"(\<exists> A. universally_influential(A,\<C>)) \<longrightarrow> stimuli_connected(\<C>)"
  unfolding universally_influential_def stimuli_connected_def
proof (intro allI impI)
  fix X\<^sub>1 X\<^sub>2
  show "(\<exists>A. A \<in> \<C> \<and> (\<forall>B. B \<in> \<C> \<and> B \<noteq> A \<longrightarrow> A \<rightarrow>\<^sub>\<S>\<^sup>+ B)) \<Longrightarrow>
X\<^sub>1 \<inter> X\<^sub>2 = {} \<and> X\<^sub>1 \<union> X\<^sub>2 = \<C> \<and> X\<^sub>1 \<noteq> {} \<and> X\<^sub>2 \<noteq> {} \<Longrightarrow>
(\<exists> A B. A \<in> X\<^sub>1 \<and> B \<in> X\<^sub>2 \<and> (A \<rightarrow>\<^sub>\<S>\<^sup>+ B \<or> B \<rightarrow>\<^sub>\<S>\<^sup>+ A))"
  proof -
    assume "(\<exists>A. A \<in> \<C> \<and> (\<forall>B. B \<in> \<C> \<and> B \<noteq> A \<longrightarrow> A \<rightarrow>\<^sub>\<S>\<^sup>+ B))"
    from this obtain A where Aui: "A \<in> \<C> \<and> (\<forall>B. B \<in> \<C> \<and> B \<noteq> A \<longrightarrow>
A \<rightarrow>\<^sub>\<S>\<^sup>+ B)" by auto
    show "X\<^sub>1 \<inter> X\<^sub>2 = {} \<and> X\<^sub>1 \<union> X\<^sub>2 = \<C> \<and> X\<^sub>1 \<noteq> {} \<and> X\<^sub>2 \<noteq> {} \<Longrightarrow>
(\<exists>A B. A \<in> X\<^sub>1 \<and> B \<in> X\<^sub>2 \<and> (A \<rightarrow>\<^sub>\<S>\<^sup>+ B \<or> B \<rightarrow>\<^sub>\<S>\<^sup>+ A))"
    proof -
      assume partition:"X\<^sub>1 \<inter> X\<^sub>2 = {} \<and> X\<^sub>1 \<union> X\<^sub>2 = \<C> \<and> X\<^sub>1 \<noteq> {} \<and> X\<^sub>2 \<noteq> {}"
      show "(\<exists>A B. A \<in> X\<^sub>1 \<and> B \<in> X\<^sub>2 \<and> (A \<rightarrow>\<^sub>\<S>\<^sup>+ B \<or> B \<rightarrow>\<^sub>\<S>\<^sup>+ A))"
      proof cases
        assume in1: "A \<in> X\<^sub>1"
        from partition obtain B where in2: "B \<in> X\<^sub>2" by auto
        have "A = B \<Longrightarrow> False"
        proof -
          assume "A = B"
          hence "A \<in> X\<^sub>2" by (simp add: in2)
          moreover have "A \<in> X\<^sub>1" by (rule in1)
          ultimately have "A \<in> X\<^sub>1 \<inter> X\<^sub>2" by simp
          hence "A \<in> {}" by (simp add: partition)
          thus "False" by simp
        qed
        hence "A \<noteq> B" by auto
        moreover have "B \<in> \<C>"
        proof -
          from partition have "\<C> = X\<^sub>1 \<union> X\<^sub>2" by auto
          hence "X\<^sub>2 \<subseteq> \<C>" by simp
          thus ?thesis by (auto simp add: in2)
        qed
        ultimately have "A \<rightarrow>\<^sub>\<S>\<^sup>+ B" by (auto simp add: Aui in2)
        thus ?thesis
          by (rule_tac x="A" in exI, rule_tac x="B" in exI, simp add: in1 in2)
      next
        assume notin1: "A \<notin> X\<^sub>1"
        moreover have "A \<in> \<C>" by (simp add: Aui)
        moreover have "X\<^sub>1 \<union> X\<^sub>2 = \<C>" by (simp add: partition)
        ultimately have in2: "A \<in> X\<^sub>2" by auto
        from partition obtain B where in1: "B \<in> X\<^sub>1" by auto
        have "B = A \<Longrightarrow> False"
        proof -
          assume "B = A"
          hence "B \<in> X\<^sub>2" by (simp add: in2)
          moreover have "B \<in> X\<^sub>1" by (rule in1)
          ultimately have "B \<in> X\<^sub>1 \<inter> X\<^sub>2" by simp
          hence "B \<in> {}" by (simp add: partition)
          thus "False" by simp
        qed
        hence "B \<noteq> A" by auto
        moreover have "B \<in> \<C>"
        proof -
          from partition have "\<C> = X\<^sub>1 \<union> X\<^sub>2" by auto
          hence "X\<^sub>1 \<subseteq> \<C>" by simp
          thus ?thesis by (auto simp add: in1)
        qed
        ultimately have "A \<rightarrow>\<^sub>\<S>\<^sup>+ B" by (auto simp add: Aui in2)
        thus ?thesis
          by (rule_tac x="B" in exI, rule_tac x="A" in exI, simp add: in1 in2)
      qed
    qed
  qed
qed

text \<open>
Lemma \emph{fixed-no-stimcomm} shows that no agent has the potential for communication via stimuli with an agent that has a fixed point behaviour.
\<close>

lemma fixed_no_stimcomm: "fixed(A) \<longrightarrow> (\<forall> B. \<not>(B \<rightarrow>\<^sub>\<S> A))"
  unfolding fixed_def
proof (rule impI)
  assume hyp: "\<forall>s. s \<noteq> \<dd> \<longrightarrow> s \<circ> A = A"
  have "\<exists> B. B \<rightarrow>\<^sub>\<S> A \<Longrightarrow> False"
  proof -
    assume "\<exists> B. B \<rightarrow>\<^sub>\<S> A"
    then obtain B where "B \<rightarrow>\<^sub>\<S> A" by auto
    hence "\<exists> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,B) \<and> t \<circ> A \<noteq> A"
      by (simp only: dcs_def)
    then obtain s t where st: "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,B) \<and> t \<circ> A \<noteq> A"
      by auto
    hence "t \<noteq> \<dd>" by (auto simp only: zero_not_basic)
    hence "t \<circ> A = A" by (simp add: hyp)
    thus False by (auto simp add: st)
  qed
  thus "(\<forall> B. \<not>(B \<rightarrow>\<^sub>\<S> A))" by auto
qed

subsection \<open>Preserving the Potential for Communication under Non-Determinism \label{sub:non_determinism}\<close>

subsubsection \<open>Potential for Communication via Stimuli \label{ssub:pfc_stim}\<close>

text \<open>
The following results show how the potential for communication via stimuli can be preserved when non-determinism is introduced among agents.
Specifically, Lemma \emph{source-nondet-stimcomm} states that when non-determinism is added at the source of a potential communication path via stimuli, the potential
for communication via stimuli is always preserved. On the other hand, Lemma \emph{sink-nondet-stimcomm} states that when non-determinism is added at the sink of a
potential communication path via stimuli, the potential for communication is preserved only if there does not exist any basic stimulus that is
generated by the source that influences agent~$\Agent{B}$ and agent~$\Agent{C}$ to behave as a sub-behaviour of agent~$\Agent{B + C}$. This
condition ensures that agent~$\Agent{B + C}$ cannot have a fixed point behaviour.
\<close>

lemma source_nondet_stimcomm: "(B \<rightarrow>\<^sub>\<S> C) \<Longrightarrow> ((A + B) \<rightarrow>\<^sub>\<S> C)"
proof -
  assume "B \<rightarrow>\<^sub>\<S> C"
  then obtain s t where st: "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,B) \<and> t \<circ> C \<noteq> C"
    by (auto simp only: dcs_def)
  show "(A + B) \<rightarrow>\<^sub>\<S> C"
    unfolding dcs_def
    by (rule_tac x="s" in exI, rule_tac x="t" in exI, auto simp add: st inf_add_S_left)
qed

lemma comm_source_nondet_stimcomm: "(B \<rightarrow>\<^sub>\<S> C) \<Longrightarrow> ((B + A) \<rightarrow>\<^sub>\<S> C)"
  by (simp add: source_nondet_stimcomm algebra_simps)

lemma sink_sum_stimcomm: "(\<exists> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)) \<Longrightarrow> (A \<rightarrow>\<^sub>\<S> B + C)"
proof -
  assume "\<exists> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)"
  then obtain s t where st: "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)" by auto
  have "t \<circ> (B + C) = B + C \<Longrightarrow> False"
  proof -
    assume fixbc: "t \<circ> (B + C) = B + C"
    have "t \<circ> B  \<le>\<^sub>\<K> t \<circ> (B + C)"
      by (simp, rule inf_add_K_right)
    moreover have "t \<circ> C  \<le>\<^sub>\<K> t \<circ> (B + C)"
      by (simp, rule inf_add_K_left)
    ultimately have "t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C"
      by (simp only: fixbc)
    thus False by (simp only: st)
  qed
  thus "A \<rightarrow>\<^sub>\<S> B + C"
    unfolding dcs_def
    by (rule_tac x="s" in exI, rule_tac x="t" in exI, auto simp only: st)
qed

lemma sink_nondet_stimcomm: "A \<rightarrow>\<^sub>\<S> B \<Longrightarrow> (\<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A)
\<longrightarrow> \<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)) \<Longrightarrow> (A \<rightarrow>\<^sub>\<S> B + C)"
proof (rule sink_sum_stimcomm)
  assume h1: "A \<rightarrow>\<^sub>\<S> B"
  assume h2: "(\<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<longrightarrow>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C))"
  show "\<exists> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)"
  proof -
    from h1 obtain s t where "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and> t \<circ> B \<noteq> B"
      by (auto simp only: dcs_def)
    from this h2 have "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and>
\<not>(t \<circ> B \<le>\<^sub>\<K> B + C \<and> t \<circ> C \<le>\<^sub>\<K> B + C)" by auto
    thus ?thesis
      by (rule_tac x="s" in exI, rule_tac x="t" in exI, auto)
  qed
qed

subsubsection \<open>Potential for Communication via Shared Environments \label{ssub:pfc_env}\<close>

text \<open>
Lemmas \emph{source-nondet-envcomm} and \emph{sink-nondet-envcomm} show how the potential for communication via shared environments is preserved when non-determinism is
introduced at the source or the sink of a potential communication path via shared environments.
\<close>

lemma source_nondet_envcomm: "B \<rightarrow>\<^sub>\<E> C \<Longrightarrow> (A + B) \<rightarrow>\<^sub>\<E> C"
  by (simp add: sum_dce)

lemma sink_nondet_envcomm: "A \<rightarrow>\<^sub>\<E> B \<Longrightarrow> A \<rightarrow>\<^sub>\<E> (B + C)"
  by (simp add: dce_sum)

subsection \<open>Preserving the Potential for Communication with Agent Behaviour Modifications\label{sub:preservation}\<close>

text \<open>
The following results identify the conditions constraining the modifications that can be made to the source or sink agent involved in a direct potential for communication to
preserve the communication in a distributed system. In this way, it demonstrates the conditions under which a modification to an agent behaviour can be made while maintaining
the communicating behaviour of the agents in the system.

Specifically, Lemma \emph{sink-seq-stimcomm} shows how the sequential composition of an additional behaviour on the left of a sink agent will not affect the potential for communication
provided that every stimulus that is generated by the source agent either does not fix the behaviour of the first component of the sequential composition, or causes the
first component of the sequential composition to generate a stimulus that does not fix the behaviour of the second component of the sequential composition. Alternatively,
Lemma \emph{nondet-right-source-communication} shows how non-determinism added on the right of a source agent will not affect the potential for communication provided that
the non-deterministic behaviours can be influenced by the source agent to stop being a sub-behaviour of the non-deterministic behaviour.
\<close>

lemma sink_seq_stimcomm: "A \<rightarrow>\<^sub>\<S> B
\<Longrightarrow> \<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<longrightarrow> \<lambda>(t,C) = t \<Longrightarrow> A;C \<rightarrow>\<^sub>\<S> B"
proof -
  assume "A \<rightarrow>\<^sub>\<S> B"
  then obtain s t where st: "s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<and> t \<circ> B \<noteq> B"
    unfolding dcs_def by auto
  assume "\<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A) \<longrightarrow> \<lambda>(t,C) = t"
  from this st have tfix: "\<lambda>(t,C) = t" by auto
  have "\<lambda>(t,C) \<le>\<^sub>\<S>  \<lambda>(\<lambda>(s,A),C)" by (simp add: inf_S_next_stimulus st)
  hence "t \<le>\<^sub>\<S> \<lambda> (\<lambda> (s, A), C)" by (simp add: tfix)
  thus "A;C \<rightarrow>\<^sub>\<S> B"
    unfolding dcs_def
    by (rule_tac x="s" in exI, rule_tac x="t" in exI, simp add: st)
qed

lemma nondet_right_source_communication: "A \<leadsto> C \<and> C \<leadsto> B \<Longrightarrow> (\<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A)
\<longrightarrow> \<not>(t \<circ> C \<le>\<^sub>\<K> C + D \<and> t \<circ> D \<le>\<^sub>\<K> C + D)) \<Longrightarrow> A \<leadsto> C+D \<and> C+D \<leadsto> B"
proof -
  assume h1:"A \<leadsto> C \<and> C \<leadsto> B"
  assume h2:"(\<forall> s t. s \<in> \<S>\<^sub>a \<and> t \<in> \<S>\<^sub>a \<and> t \<le>\<^sub>\<S> \<lambda>(s,A)
\<longrightarrow> \<not>(t \<circ> C \<le>\<^sub>\<K> C + D \<and> t \<circ> D \<le>\<^sub>\<K> C + D))"
  from h2 have hs: "A \<rightarrow>\<^sub>\<S> C \<Longrightarrow> A \<rightarrow>\<^sub>\<S> C+D"
    by (auto simp add: sink_nondet_stimcomm)
  have "A \<leadsto> C \<Longrightarrow> A \<leadsto> C+D"
    unfolding pdc_def
    using dce_sum hs by blast
  moreover have "C \<leadsto> B \<Longrightarrow> C + D \<leadsto> B"
    unfolding pdc_def
    using comm_source_nondet_stimcomm sum_dce by blast
  ultimately show "A \<leadsto> C+D \<and> C+D \<leadsto> B"
    by (simp add: h1)
qed

end

end


(*  Title:      HOL/Library/Code_Abstract_Nat.thy
    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
*)

section \<open>Avoidance of pattern matching on natural numbers\<close>

theory Code_Abstract_Nat
imports Main
begin

text \<open>
  When natural numbers are implemented in another than the
  conventional inductive @{term "0::nat"}/@{term Suc} representation,
  it is necessary to avoid all pattern matching on natural numbers
  altogether.  This is accomplished by this theory (up to a certain
  extent).
\<close>

subsection \<open>Case analysis\<close>

text \<open>
  Case analysis on natural numbers is rephrased using a conditional
  expression:
\<close>

lemma [code, code_unfold]:
  "case_nat = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)

subsection \<open>Preprocessors\<close>

text \<open>
  The term @{term "Suc n"} is no longer a valid pattern.  Therefore,
  all occurrences of this term in a position where a pattern is
  expected (i.e.~on the left-hand side of a code equation) must be
  eliminated.  This can be accomplished -- as far as possible -- by
  applying the following transformation rule:
\<close>

lemma Suc_if_eq:
  assumes "\<And>n. f (Suc n) \<equiv> h n"
  assumes "f 0 \<equiv> g"
  shows "f n \<equiv> if n = 0 then g else h (n - 1)"
  by (rule eq_reflection) (cases n, insert assms, simp_all)

text \<open>
  The rule above is built into a preprocessor that is plugged into
  the code generator.
\<close>

setup \<open>
let

val Suc_if_eq = Thm.incr_indexes 1 @{thm Suc_if_eq};

fun remove_suc ctxt thms =
  let
    val vname = singleton (Name.variant_list (map fst
      (fold (Term.add_var_names o Thm.full_prop_of) thms []))) "n";
    val cv = Thm.cterm_of ctxt (Var ((vname, 0), HOLogic.natT));
    val lhs_of = snd o Thm.dest_comb o fst o Thm.dest_comb o Thm.cprop_of;
    val rhs_of = snd o Thm.dest_comb o Thm.cprop_of;
    fun find_vars ct = (case Thm.term_of ct of
        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
      | _ $ _ =>
        let val (ct1, ct2) = Thm.dest_comb ct
        in
          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
          map (apfst (Thm.apply ct1)) (find_vars ct2)
        end
      | _ => []);
    val eqs = maps
      (fn thm => map (pair thm) (find_vars (lhs_of thm))) thms;
    fun mk_thms (thm, (ct, cv')) =
      let
        val thm' =
          Thm.implies_elim
           (Conv.fconv_rule (Thm.beta_conversion true)
             (Thm.instantiate'
               [SOME (Thm.ctyp_of_cterm ct)] [SOME (Thm.lambda cv ct),
                 SOME (Thm.lambda cv' (rhs_of thm)), NONE, SOME cv']
               Suc_if_eq)) (Thm.forall_intr cv' thm)
      in
        case map_filter (fn thm'' =>
            SOME (thm'', singleton
              (Variable.trade (K (fn [thm'''] => [thm''' RS thm']))
                (Variable.declare_thm thm'' ctxt)) thm'')
          handle THM _ => NONE) thms of
            [] => NONE
          | thmps =>
              let val (thms1, thms2) = split_list thmps
              in SOME (subtract Thm.eq_thm (thm :: thms1) thms @ thms2) end
      end
  in get_first mk_thms eqs end;

fun eqn_suc_base_preproc ctxt thms =
  let
    val dest = fst o Logic.dest_equals o Thm.prop_of;
    val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
  in
    if forall (can dest) thms andalso exists (contains_suc o dest) thms
      then thms |> perhaps_loop (remove_suc ctxt) |> (Option.map o map) Drule.zero_var_indexes
       else NONE
  end;

val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;

in

  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)

end;
\<close>

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)
 *)

theory Plus
imports
  "AutoCorres.AutoCorres"
begin

external_file "plus.c"
install_C_file "plus.c"

autocorres [ ts_force nondet = plus2 ] "plus.c"

context plus begin

(* 3 + 2 should be 5 *)
lemma "plus' 3 2 = 5"
  unfolding plus'_def
  by eval

(* plus does what it says on the box *)
lemma plus_correct: "plus' a b = a + b"
  unfolding plus'_def
  apply (rule refl)
  done

(* Compare pre-lifting to post-lifting *)
thm plus_global_addresses.plus2_body_def
thm plus2'_def

(* plus2 does what it says on the box *)
lemma plus2_correct: "\<lbrace>\<lambda>s. True\<rbrace> plus2' a b \<lbrace> \<lambda>r s. r = a + b\<rbrace>"
  unfolding plus2'_def
  apply (subst whileLoop_add_inv
   [where I="\<lambda>(a', b') s. a' + b' = a + b"
      and M="\<lambda>((a', b'), s). b'"])
  apply (wp, auto simp: not_less)
  done

(* plus2 does what it says on plus's box *)
lemma plus2_is_plus: "\<lbrace> \<lambda>s. True \<rbrace> plus2' a b \<lbrace> \<lambda>r s. r = plus' a b \<rbrace>"
  unfolding plus'_def
  apply (simp add:plus2_correct)
  done

(* Prove plus2 with no failure *)
lemma plus2_valid:"\<lbrace> \<lambda>s. True \<rbrace> plus2' a b \<lbrace> \<lambda>r s. r = a + b \<rbrace>!"
  unfolding plus2'_def
  apply (subst whileLoop_add_inv
   [where I="\<lambda>(a', b') s. a' + b' = a + b"
      and M="\<lambda>((a', b'), s). b'"])
  apply wp
    apply clarsimp
    apply unat_arith
   apply clarsimp
   apply unat_arith
  apply clarsimp
  done

end

end


theory flash44Bra  imports flash44Rev

  begin
lemma onInv44:

   assumes  a1:"iInv1 \<le> N" and  a2:"iInv2 \<le> N" and  a3:"iInv1~=iInv2  " and

     b1:"r \<in> rules N" and b2:"invf=inv44  iInv1  iInv2 "
   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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_GetXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ShWbVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX7VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX5VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Wb ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_WbVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_GetVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_ReplaceVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceShrVldVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_ReplaceVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_HomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX11VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX6VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_PutVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1_HomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10_homeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak3VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis StoreVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_FAck ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_FAckVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX3VsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8_homeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (StoreHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis StoreHomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_NakVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_PutXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX4VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_NakVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak1VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_ClearVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_PutXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak3VsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_Nak_HomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_GetVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX9VsInv44 )
          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 (inv44  iInv1  iInv2 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetXVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutX_HomeVsInv44 )
          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 (inv44  iInv1  iInv2 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put3VsInv44 )
          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 CoCallAnalysisBinds
imports CoCallAnalysisSig AEnv  "AList-Utils-HOLCF" "Arity-Nominal" "CoCallGraph-Nominal"
begin

context CoCallAnalysis
begin
definition ccBind :: "var \<Rightarrow> exp \<Rightarrow> ((AEnv \<times> CoCalls) \<rightarrow> CoCalls)"
  where "ccBind v e = (\<Lambda> (ae, G).  if (v--v\<notin>G) \<or> \<not> isVal e then cc_restr (fv e) (fup\<cdot>(ccExp e)\<cdot>(ae v)) else ccSquare (fv e))"
(* paper has:  \<or> ae v = up\<cdot>0, but that is not monotone! But should give the same result. *)

lemma ccBind_eq:
  "ccBind v e\<cdot>(ae, G) = (if v--v\<notin>G \<or> \<not> isVal e then \<G>\<^sup>\<bottom>\<^bsub>ae v\<^esub> e G|` fv e else (fv e)²)"
  unfolding ccBind_def
  apply (rule cfun_beta_Pair)
  apply (rule cont_if_else_above)
  apply simp
  apply simp
  apply (auto dest: set_mp[OF ccField_cc_restr])[1]
  (* Abstraction broken! Fix this. *)
  apply (case_tac p, auto, transfer, auto)[1]
  apply (rule adm_subst[OF cont_snd])
  apply (rule admI, thin_tac "chain _", transfer, auto)
  done

lemma ccBind_strict[simp]: "ccBind v e \<cdot> \<bottom> = \<bottom>"
  by (auto simp add: inst_prod_pcpo ccBind_eq simp del: Pair_strict)

lemma ccField_ccBind: "ccField (ccBind v e\<cdot>(ae,G)) \<subseteq> fv e"
  by (auto simp add: ccBind_eq dest: set_mp[OF ccField_cc_restr])

definition ccBinds :: "heap \<Rightarrow> ((AEnv \<times> CoCalls) \<rightarrow> CoCalls)"
  where "ccBinds \<Gamma> = (\<Lambda> i. (\<Squnion>v\<mapsto>e\<in>map_of \<Gamma>. ccBind v e\<cdot>i))"

lemma ccBinds_eq:
  "ccBinds \<Gamma>\<cdot>i = (\<Squnion>v\<mapsto>e\<in>map_of \<Gamma>. ccBind v e\<cdot>i)"
  unfolding ccBinds_def
  by simp

lemma ccBinds_strict[simp]: "ccBinds \<Gamma>\<cdot>\<bottom>=\<bottom>"
  unfolding ccBinds_eq
  by (cases "\<Gamma> = []") simp_all

lemma ccBinds_strict'[simp]: "ccBinds \<Gamma>\<cdot>(\<bottom>,\<bottom>)=\<bottom>"
  by (metis CoCallAnalysis.ccBinds_strict Pair_bottom_iff)

lemma ccBinds_reorder1:
  assumes "map_of \<Gamma> v = Some e"
  shows "ccBinds \<Gamma> = ccBind v e \<squnion> ccBinds (delete v \<Gamma>)"
proof-
  from assms
  have "map_of \<Gamma> = map_of ((v,e) # delete v \<Gamma>)" by (metis map_of_delete_insert)
  thus ?thesis
    by (auto intro: cfun_eqI simp add: ccBinds_eq delete_set_none)
qed

lemma ccBinds_Nil[simp]:
  "ccBinds [] = \<bottom>"
  unfolding ccBinds_def by simp

lemma ccBinds_Cons[simp]:
   "ccBinds ((x,e)#\<Gamma>) = ccBind x e \<squnion> ccBinds (delete x \<Gamma>)"
   by (subst ccBinds_reorder1[where v = x and e = e]) auto

lemma ccBind_below_ccBinds: "map_of \<Gamma> x = Some e \<Longrightarrow> ccBind x e\<cdot>ae \<sqsubseteq> (ccBinds \<Gamma>\<cdot>ae)"
  by (auto simp add: ccBinds_eq)

lemma ccField_ccBinds: "ccField (ccBinds \<Gamma>\<cdot>(ae,G)) \<subseteq> fv \<Gamma>"
  by (auto simp add: ccBinds_eq dest: set_mp[OF ccField_ccBind] intro: set_mp[OF map_of_Some_fv_subset])

definition ccBindsExtra :: "heap \<Rightarrow> ((AEnv \<times> CoCalls) \<rightarrow> CoCalls)"
  where "ccBindsExtra \<Gamma> = (\<Lambda> i.  snd i \<squnion> ccBinds \<Gamma> \<cdot> i  \<squnion> (\<Squnion>x\<mapsto>e\<in>map_of \<Gamma>. ccProd (fv e) (ccNeighbors x (snd i))))"

lemma ccBindsExtra_simp: "ccBindsExtra \<Gamma> \<cdot> i =snd i \<squnion> ccBinds \<Gamma> \<cdot> i \<squnion> (\<Squnion>x\<mapsto>e\<in>map_of \<Gamma>. ccProd (fv e) (ccNeighbors x (snd i)))"
  unfolding ccBindsExtra_def by simp

lemma ccBindsExtra_eq: "ccBindsExtra \<Gamma>\<cdot>(ae,G) =
  G \<squnion> ccBinds \<Gamma>\<cdot>(ae,G) \<squnion> (\<Squnion>x\<mapsto>e\<in>map_of \<Gamma>. fv e G\<times> ccNeighbors x G)"
  unfolding ccBindsExtra_def by simp

lemma ccBindsExtra_strict[simp]: "ccBindsExtra \<Gamma> \<cdot> \<bottom> = \<bottom>"
  by (auto simp add: ccBindsExtra_simp inst_prod_pcpo simp del: Pair_strict)

lemma ccField_ccBindsExtra:
  "ccField (ccBindsExtra \<Gamma>\<cdot>(ae,G)) \<subseteq> fv \<Gamma> \<union> ccField G"
  by (auto simp add: ccBindsExtra_simp elem_to_ccField
      dest!:  set_mp[OF ccField_ccBinds]  set_mp[OF ccField_ccProd_subset] map_of_Some_fv_subset)

end

lemma ccBind_eqvt[eqvt]: "\<pi> \<bullet> (CoCallAnalysis.ccBind cccExp x e) = CoCallAnalysis.ccBind (\<pi> \<bullet> cccExp) (\<pi> \<bullet> x) (\<pi> \<bullet> e)"
proof-
  {
  fix \<pi> ae G
  have "\<pi> \<bullet> ((CoCallAnalysis.ccBind cccExp x e) \<cdot> (ae,G)) = CoCallAnalysis.ccBind (\<pi> \<bullet> cccExp) (\<pi> \<bullet> x) (\<pi> \<bullet> e) \<cdot> (\<pi> \<bullet> ae, \<pi> \<bullet> G)"
    unfolding CoCallAnalysis.ccBind_eq
    by perm_simp (simp add: Abs_cfun_eqvt)
  }
  thus ?thesis by (auto intro: cfun_eqvtI)
qed

lemma ccBinds_eqvt[eqvt]: "\<pi> \<bullet> (CoCallAnalysis.ccBinds cccExp \<Gamma>) = CoCallAnalysis.ccBinds (\<pi> \<bullet> cccExp) (\<pi> \<bullet> \<Gamma>)"
  apply (rule cfun_eqvtI)
  unfolding CoCallAnalysis.ccBinds_eq
  apply (perm_simp)
  apply rule
  done

lemma ccBindsExtra_eqvt[eqvt]: "\<pi> \<bullet> (CoCallAnalysis.ccBindsExtra cccExp \<Gamma>) = CoCallAnalysis.ccBindsExtra (\<pi> \<bullet> cccExp) (\<pi> \<bullet> \<Gamma>)"
  by (rule cfun_eqvtI) (simp add: CoCallAnalysis.ccBindsExtra_def)

lemma ccBind_cong[fundef_cong]:
  "cccexp1 e = cccexp2 e \<Longrightarrow> CoCallAnalysis.ccBind cccexp1 x e = CoCallAnalysis.ccBind cccexp2 x e "
  apply (rule cfun_eqI)
  apply (case_tac xa)
  apply (auto simp add: CoCallAnalysis.ccBind_eq)
  done

lemma ccBinds_cong[fundef_cong]:
  "\<lbrakk> (\<And> e. e \<in> snd ` set heap2 \<Longrightarrow> cccexp1 e = cccexp2 e); heap1 = heap2 \<rbrakk>
      \<Longrightarrow> CoCallAnalysis.ccBinds cccexp1 heap1 = CoCallAnalysis.ccBinds cccexp2 heap2"
  apply (rule cfun_eqI)
  unfolding CoCallAnalysis.ccBinds_eq
  apply (rule arg_cong[OF mapCollect_cong])
  apply (rule arg_cong[OF ccBind_cong])
  apply auto
  by (metis imageI map_of_SomeD snd_conv)

lemma ccBindsExtra_cong[fundef_cong]:
  "\<lbrakk> (\<And> e. e \<in> snd ` set heap2 \<Longrightarrow> cccexp1 e = cccexp2 e); heap1 = heap2 \<rbrakk>
      \<Longrightarrow> CoCallAnalysis.ccBindsExtra cccexp1 heap1 = CoCallAnalysis.ccBindsExtra cccexp2 heap2"
  apply (rule cfun_eqI)
  unfolding CoCallAnalysis.ccBindsExtra_simp
  apply (rule arg_cong2[OF ccBinds_cong mapCollect_cong])
  apply simp+
  done

end