(*
Copyright 2018

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
*)
theory BitVector_Rewriting
  imports
    reassembly_rewriting.Take_Bits_Rewriting
    reassembly_manual_execution.BitVectors
begin

subsection \<open>Logical Operators\<close>

lemma bv_to_bool_bool_to_bv:
  shows "bv_to_bool (bool_to_bv b) = b"
  by (cases b,auto simp add: bv_to_bool_def)

lemma snd_bool_to_bv:
  shows "snd (bool_to_bv b) = 1"
  by (cases b,auto)

lemma bv_to_bool_True:
  shows "bv_to_bool (1, 1) = True"
  by (auto simp add: bv_to_bool_def)

lemma bv_to_bool_True_Suc0:
  shows "bv_to_bool (1, Suc 0) = True"
  by (auto simp add: bv_to_bool_def)

lemma bv_to_bool_False:
  shows "bv_to_bool (0, 1) = False"
  by (auto simp add: bv_to_bool_def)

lemma bv_to_bool_False_Suc0:
  shows "bv_to_bool (0, Suc 0) = False"
  by (auto simp add: bv_to_bool_def)

subsection \<open>Concatenation and slicing\<close>

lemmas bv_slice_simps[simp] =
  bv_slice.simps[of "numeral h" "numeral l" "numeral w" "numeral s"]
  bv_slice.simps[of "numeral h" "numeral l" "numeral w" 0]
  bv_slice.simps[of "numeral h" "numeral l" "numeral w" 1]
  bv_slice.simps[of "numeral h" "numeral l" 0            "numeral s"]
  bv_slice.simps[of "numeral h" "numeral l" 0            0]
  bv_slice.simps[of "numeral h" "numeral l" 0            1]
  bv_slice.simps[of "numeral h" "numeral l" 1            "numeral s"]
  bv_slice.simps[of "numeral h" "numeral l" 1            0]
  bv_slice.simps[of "numeral h" "numeral l" 1            1]
  bv_slice.simps[of "numeral h" 0            "numeral w" "numeral s"]
  bv_slice.simps[of "numeral h" 0            "numeral w" 0]
  bv_slice.simps[of "numeral h" 0            "numeral w" 1]
  bv_slice.simps[of "numeral h" 0            0            "numeral s"]
  bv_slice.simps[of "numeral h" 0            0            0]
  bv_slice.simps[of "numeral h" 0            0            1]
  bv_slice.simps[of "numeral h" 0            1            "numeral s"]
  bv_slice.simps[of "numeral h" 0            1            0]
  bv_slice.simps[of "numeral h" 0            1            1]
  bv_slice.simps[of "numeral h" 1            "numeral w" "numeral s"]
  bv_slice.simps[of "numeral h" 1            "numeral w" 0]
  bv_slice.simps[of "numeral h" 1            "numeral w" 1]
  bv_slice.simps[of "numeral h" 1            0            "numeral s"]
  bv_slice.simps[of "numeral h" 1            0            0]
  bv_slice.simps[of "numeral h" 1            0            1]
  bv_slice.simps[of "numeral h" 1            1            "numeral s"]
  bv_slice.simps[of "numeral h" 1            1            0]
  bv_slice.simps[of "numeral h" 1            1            1]
  bv_slice.simps[of 0           "numeral l" "numeral w" "numeral s"]
  bv_slice.simps[of 0           "numeral l" "numeral w" 0]
  bv_slice.simps[of 0           "numeral l" "numeral w" 1]
  bv_slice.simps[of 0           "numeral l" 0            "numeral s"]
  bv_slice.simps[of 0           "numeral l" 0            0]
  bv_slice.simps[of 0           "numeral l" 0            1]
  bv_slice.simps[of 0           "numeral l" 1            "numeral s"]
  bv_slice.simps[of 0           "numeral l" 1            0]
  bv_slice.simps[of 0           "numeral l" 1            1]
  bv_slice.simps[of 0           0            "numeral w" "numeral s"]
  bv_slice.simps[of 0           0            "numeral w" 0]
  bv_slice.simps[of 0           0            "numeral w" 1]
  bv_slice.simps[of 0           0            0            "numeral s"]
  bv_slice.simps[of 0           0            0            0]
  bv_slice.simps[of 0           0            0            1]
  bv_slice.simps[of 0           0            1            "numeral s"]
  bv_slice.simps[of 0           0            1            0]
  bv_slice.simps[of 0           0            1            1]
  bv_slice.simps[of 0           1            "numeral w" "numeral s"]
  bv_slice.simps[of 0           1            "numeral w" 0]
  bv_slice.simps[of 0           1            "numeral w" 1]
  bv_slice.simps[of 0           1            0            "numeral s"]
  bv_slice.simps[of 0           1            0            0]
  bv_slice.simps[of 0           1            0            1]
  bv_slice.simps[of 0           1            1            "numeral s"]
  bv_slice.simps[of 0           1            1            0]
  bv_slice.simps[of 0           1            1            1]
  bv_slice.simps[of 1           "numeral l" "numeral w" "numeral s"]
  bv_slice.simps[of 1           "numeral l" "numeral w" 0]
  bv_slice.simps[of 1           "numeral l" "numeral w" 1]
  bv_slice.simps[of 1           "numeral l" 0            "numeral s"]
  bv_slice.simps[of 1           "numeral l" 0            0]
  bv_slice.simps[of 1           "numeral l" 0            1]
  bv_slice.simps[of 1           "numeral l" 1            "numeral s"]
  bv_slice.simps[of 1           "numeral l" 1            0]
  bv_slice.simps[of 1           "numeral l" 1            1]
  bv_slice.simps[of 1           0            "numeral w" "numeral s"]
  bv_slice.simps[of 1           0            "numeral w" 0]
  bv_slice.simps[of 1           0            "numeral w" 1]
  bv_slice.simps[of 1           0            0            "numeral s"]
  bv_slice.simps[of 1           0            0            0]
  bv_slice.simps[of 1           0            0            1]
  bv_slice.simps[of 1           0            1            "numeral s"]
  bv_slice.simps[of 1           0            1            0]
  bv_slice.simps[of 1           0            1            1]
  bv_slice.simps[of 1           1            "numeral w" "numeral s"]
  bv_slice.simps[of 1           1            "numeral w" 0]
  bv_slice.simps[of 1           1            "numeral w" 1]
  bv_slice.simps[of 1           1            0            "numeral s"]
  bv_slice.simps[of 1           1            0            0]
  bv_slice.simps[of 1           1            0            1]
  bv_slice.simps[of 1           1            1            "numeral s"]
  bv_slice.simps[of 1           1            1            0]
  bv_slice.simps[of 1           1            1            1]
  for h l w s

lemmas bv_cat_simps[simp] =
  bv_cat.simps[of "numeral w0" "numeral s0" "numeral w1" "numeral s1"]
  bv_cat.simps[of "numeral w0" "numeral s0" "numeral w1" 0]
  bv_cat.simps[of "numeral w0" "numeral s0" "numeral w1" 1]
  bv_cat.simps[of "numeral w0" "numeral s0" 0            "numeral s1"]
  bv_cat.simps[of "numeral w0" "numeral s0" 0            0]
  bv_cat.simps[of "numeral w0" "numeral s0" 0            1]
  bv_cat.simps[of "numeral w0" "numeral s0" 1            "numeral s1"]
  bv_cat.simps[of "numeral w0" "numeral s0" 1            0]
  bv_cat.simps[of "numeral w0" "numeral s0" 1            1]
  bv_cat.simps[of "numeral w0" 0            "numeral w1" "numeral s1"]
  bv_cat.simps[of "numeral w0" 0            "numeral w1" 0]
  bv_cat.simps[of "numeral w0" 0            "numeral w1" 1]
  bv_cat.simps[of "numeral w0" 0            0            "numeral s1"]
  bv_cat.simps[of "numeral w0" 0            0            0]
  bv_cat.simps[of "numeral w0" 0            0            1]
  bv_cat.simps[of "numeral w0" 0            1            "numeral s1"]
  bv_cat.simps[of "numeral w0" 0            1            0]
  bv_cat.simps[of "numeral w0" 0            1            1]
  bv_cat.simps[of "numeral w0" 1            "numeral w1" "numeral s1"]
  bv_cat.simps[of "numeral w0" 1            "numeral w1" 0]
  bv_cat.simps[of "numeral w0" 1            "numeral w1" 1]
  bv_cat.simps[of "numeral w0" 1            0            "numeral s1"]
  bv_cat.simps[of "numeral w0" 1            0            0]
  bv_cat.simps[of "numeral w0" 1            0            1]
  bv_cat.simps[of "numeral w0" 1            1            "numeral s1"]
  bv_cat.simps[of "numeral w0" 1            1            0]
  bv_cat.simps[of "numeral w0" 1            1            1]
  bv_cat.simps[of 0           "numeral s0" "numeral w1" "numeral s1"]
  bv_cat.simps[of 0           "numeral s0" "numeral w1" 0]
  bv_cat.simps[of 0           "numeral s0" "numeral w1" 1]
  bv_cat.simps[of 0           "numeral s0" 0            "numeral s1"]
  bv_cat.simps[of 0           "numeral s0" 0            0]
  bv_cat.simps[of 0           "numeral s0" 0            1]
  bv_cat.simps[of 0           "numeral s0" 1            "numeral s1"]
  bv_cat.simps[of 0           "numeral s0" 1            0]
  bv_cat.simps[of 0           "numeral s0" 1            1]
  bv_cat.simps[of 0           0            "numeral w1" "numeral s1"]
  bv_cat.simps[of 0           0            "numeral w1" 0]
  bv_cat.simps[of 0           0            "numeral w1" 1]
  bv_cat.simps[of 0           0            0            "numeral s1"]
  bv_cat.simps[of 0           0            0            0]
  bv_cat.simps[of 0           0            0            1]
  bv_cat.simps[of 0           0            1            "numeral s1"]
  bv_cat.simps[of 0           0            1            0]
  bv_cat.simps[of 0           0            1            1]
  bv_cat.simps[of 0           1            "numeral w1" "numeral s1"]
  bv_cat.simps[of 0           1            "numeral w1" 0]
  bv_cat.simps[of 0           1            "numeral w1" 1]
  bv_cat.simps[of 0           1            0            "numeral s1"]
  bv_cat.simps[of 0           1            0            0]
  bv_cat.simps[of 0           1            0            1]
  bv_cat.simps[of 0           1            1            "numeral s1"]
  bv_cat.simps[of 0           1            1            0]
  bv_cat.simps[of 0           1            1            1]
  bv_cat.simps[of 1           "numeral s0" "numeral w1" "numeral s1"]
  bv_cat.simps[of 1           "numeral s0" "numeral w1" 0]
  bv_cat.simps[of 1           "numeral s0" "numeral w1" 1]
  bv_cat.simps[of 1           "numeral s0" 0            "numeral s1"]
  bv_cat.simps[of 1           "numeral s0" 0            0]
  bv_cat.simps[of 1           "numeral s0" 0            1]
  bv_cat.simps[of 1           "numeral s0" 1            "numeral s1"]
  bv_cat.simps[of 1           "numeral s0" 1            0]
  bv_cat.simps[of 1           "numeral s0" 1            1]
  bv_cat.simps[of 1           0            "numeral w1" "numeral s1"]
  bv_cat.simps[of 1           0            "numeral w1" 0]
  bv_cat.simps[of 1           0            "numeral w1" 1]
  bv_cat.simps[of 1           0            0            "numeral s1"]
  bv_cat.simps[of 1           0            0            0]
  bv_cat.simps[of 1           0            0            1]
  bv_cat.simps[of 1           0            1            "numeral s1"]
  bv_cat.simps[of 1           0            1            0]
  bv_cat.simps[of 1           0            1            1]
  bv_cat.simps[of 1           1            "numeral w1" "numeral s1"]
  bv_cat.simps[of 1           1            "numeral w1" 0]
  bv_cat.simps[of 1           1            "numeral w1" 1]
  bv_cat.simps[of 1           1            0            "numeral s1"]
  bv_cat.simps[of 1           1            0            0]
  bv_cat.simps[of 1           1            0            1]
  bv_cat.simps[of 1           1            1            "numeral s1"]
  bv_cat.simps[of 1           1            1            0]
  bv_cat.simps[of 1           1            1            1]
  for w0 s0 w1 s1

lemma size_bv_cat:
  shows "snd (bv_cat a b) = snd a + snd b"
  by (cases a,cases b,auto simp add: bv_cat.simps)

lemma size_bv_slice:
  shows "snd (bv_slice h l a) = h + 1 - l"
  by (cases a,auto simp add: bv_slice.simps)

lemma bv_cat_prepend_0:
  fixes a :: "'a::len word"
  assumes "s < LENGTH('a)"
  shows "bv_cat (0, s') (a,s) = (if s = 0 then 0 else \<langle>s-1,0\<rangle>a,s + s')"
proof(cases "s = 0")
  case True
  thus ?thesis
    by (auto simp add: bv_cat.simps)
next
  case False
  {
    fix b :: "'a::len word"
    assume b: "b=0"
    {
      fix n::nat
      assume n: "n < LENGTH('a)"
      {
        fix x h l :: nat
        {
          fix m :: nat
          assume m: "m < LENGTH('a)"
          hence "\<not> b !! (LENGTH('a) - 1 - m)"
            using b
            by auto
          hence "\<not> to_bl b ! m"
            using m
            by (auto simp add: unfold_test_bit split: if_split_asm)
        }
        hence "\<not>((\<langle>h,l\<rangle>b)::'a::len word) !! x"
          apply (cases "x < LENGTH('a)";cases "h < LENGTH('a)")
          apply (auto simp add: test_bit_of_take_bits)[1]
          using b apply simp
          by (auto simp add: take_bits_def test_bit_bl word_size rev_nth word_rep_drop min_def nth_append)
      }
      note 1 = this
      have "(fst (bv_cat (b, s') (a,s))) !! n= ((\<langle>s-1,0\<rangle>a):: 'a::len word)!!n"
        using assms n 1 False
        apply (auto split: if_split_asm simp add: test_bit_of_take_bits bv_cat.simps word_ao_nth nth_shiftl)
        using b nth_0 by blast
    }
    hence "(fst (bv_cat (b, s') (a,s))) = ((\<langle>s-1,0\<rangle>a):: 'a::len word)"
      and "(snd (bv_cat (b, s') (a,s))) = (s+s')"
      apply (intro word_eqI)
      by (auto simp add: word_size bv_cat.simps)+
  }
  thus ?thesis
    using False
    apply auto
    by (metis prod.exhaust_sel)
qed

lemma test_bit_of_bv_cat:
  fixes a b :: "'a ::len0 word \<times> nat"
  assumes "snd a \<le> LENGTH('a)"
      and "snd b \<le> LENGTH('a)"
      and "i < LENGTH('a)"
    shows "fst (bv_cat a b) !! i = (if i \<ge> snd b then (fst a) !! (i - snd b) else (fst b) !! i)"
  using assms
  by (cases a, cases b,auto simp add: bv_cat.simps test_bit_of_take_bits word_ao_nth nth_shiftl word_size split: if_split_asm)

lemma test_bit_of_bv_slice:
  assumes "h < \<M>"
  shows "fst (bv_slice h l a) !! n = (if n < Suc h - l then fst a!!(l+n) else False)"
  using assms
  apply (cases a, cases "n < \<M>",auto simp add: bv_slice.simps test_bit_of_take_bits)
  by (simp add: word_size test_bit_bin')

lemma bv_slice_bv_cat:
assumes "h < \<M>"
    and "snd a \<le> \<M>"
    and "snd b \<le> \<M>"
  shows "bv_slice h l (bv_cat a b) =
        (if h \<ge> snd b then
          (if l \<ge> snd b then
            bv_slice (h - snd b) (l - snd b) a
           else
            bv_cat (bv_slice (h - snd b) 0 a) (bv_slice (snd b - 1) l b))
        else
          (if l \<ge> snd b then
               (0,0)
           else
              bv_slice h l b))"
proof(cases "h \<ge> snd b")
  case True
  note h = this
  show ?thesis
  proof(cases "l \<ge> snd b")
    case True
    {
      fix i :: nat
      assume "i < \<M>"
      hence "fst (bv_slice h l (bv_cat a b)) !! i = fst (bv_slice (h - snd b) (l - snd b) a) !! i"
        using h True assms
        by (auto simp add: bv_cat.simps test_bit_of_bv_slice nth_ucast test_bit_of_bv_cat split: if_split_asm)
    }
    hence "fst (bv_slice h l (bv_cat a b)) = fst (bv_slice (h - snd b) (l - snd b) a)"
      apply (intro word_eqI)
      by (auto simp add: word_size)
    moreover
    have "snd (bv_slice h l (bv_cat a b)) = snd (bv_slice (h - snd b) (l - snd b) a)"
      using True h
      by (cases a, cases b,auto simp add: size_bv_slice)
    ultimately
    show ?thesis
      using True h
      apply (auto)
      by (metis prod.exhaust_sel)
  next
    case False
    {
      fix i :: nat
      assume "i < \<M>"
      hence "fst (bv_slice h l (bv_cat a b)) !! i = fst (bv_cat (bv_slice (h - snd b) 0 a) (bv_slice (snd b - 1) l b)) !! i"
        using h False assms
        apply (auto simp add: bv_cat.simps nth_ucast test_bit_of_bv_slice test_bit_of_bv_cat word_ao_nth nth_shiftl size_bv_slice split: if_split_asm)
        by (simp add: Groups.add_ac(2))+
    }
    hence "fst (bv_slice h l (bv_cat a b)) = fst (bv_cat (bv_slice (h - snd b) 0 a) (bv_slice (snd b - 1) l b))"
      apply (intro word_eqI)
      by (auto simp add: word_size)
    moreover
    have "snd (bv_slice h l (bv_cat a b)) = snd (bv_cat (bv_slice (h - snd b) 0 a) (bv_slice (snd b - 1) l b))"
      using False h
      by (cases a, cases b,auto simp add: size_bv_slice size_bv_cat)
    ultimately
    show ?thesis
      using False h
      apply (auto)
      by (metis prod.exhaust_sel)
  qed
next
  case False
  note h = this
  show ?thesis
  proof(cases "l \<ge> snd b")
    case True
    {
      fix i :: nat
      assume "i < \<M>"
      hence "fst (bv_slice h l (bv_cat a b)) !! i = (0::longword) !! i"
        using h True assms
        by (auto simp add: bv_cat.simps nth_ucast test_bit_of_bv_slice test_bit_of_bv_cat split: if_split_asm)
    }
    hence "fst (bv_slice h l (bv_cat a b)) = 0"
      apply (intro word_eqI)
      by (auto simp add: word_size)
    moreover
    have "snd (bv_slice h l (bv_cat a b)) = 0"
      using True h
      by (cases a, cases b,auto simp add: size_bv_slice size_bv_cat)
    ultimately
    show ?thesis
      using True h
      apply (auto)
      by (metis prod.exhaust_sel)
  next
    case False
    {
      fix i :: nat
      assume "i < \<M>"
      hence "fst (bv_slice h l (bv_cat a b)) !! i = fst (bv_slice h l b) !! i"
        using h False assms
        by (auto simp add: bv_cat.simps nth_ucast test_bit_of_bv_slice test_bit_of_bv_cat split: if_split_asm)
    }
    hence "fst (bv_slice h l (bv_cat a b)) = fst (bv_slice h l b)"
      apply (intro word_eqI)
      by (auto simp add: word_size)
    moreover
    have "snd (bv_slice h l (bv_cat a b)) = snd (bv_slice h l b)"
      using False h
      by (cases a, cases b,auto simp add: size_bv_slice size_bv_cat)
    ultimately
    show ?thesis
      using False h
      apply (auto)
      by (metis prod.exhaust_sel)
  qed
qed

definition "bv_cat' \<equiv> bv_cat"
lemma take_bits_bv_cat:
  fixes a b :: "'b ::len0 word \<times> nat"
  assumes "h < LENGTH('b)"
      and "snd a \<le> LENGTH('b)"
      and "snd b \<le> LENGTH('b)"
    shows "((\<langle>h,l\<rangle> (fst (bv_cat a b)))::'a::len0 word) =
        (if h \<ge> snd b then
          (if l \<ge> snd b then
            \<langle>h - snd b,l - snd b\<rangle>fst a
           else
            ((\<langle>h,l\<rangle> (fst (bv_cat' a b)))::'a::len0 word))
        else
          (if l \<ge> snd b then
               0
           else
              \<langle>h,l\<rangle> (fst b)))"
proof(cases "h \<ge> snd b")
  case True
  note h = this
  show ?thesis
  proof(cases "l \<ge> snd b")
    case True
    {
      fix i :: nat
      assume "i < LENGTH('a)"
      hence "((\<langle>h,l\<rangle> (fst (bv_cat a b)))::'a::len0 word) !! i = ((\<langle>h - snd b,l - snd b\<rangle>fst a)::'a::len0 word) !! i"
        using h True assms
        by (auto simp add: bv_cat.simps test_bit_of_take_bits nth_ucast test_bit_of_bv_cat split: if_split_asm)
    }
    hence "((\<langle>h,l\<rangle> (fst (bv_cat a b)))::'a::len0 word) = ((\<langle>h - snd b,l - snd b\<rangle>fst a)::'a::len0 word)"
      apply (intro word_eqI)
      by (auto simp add: word_size)
    thus ?thesis
      using True h
      by auto
  next
    case False
    thus ?thesis
      using h
      by (auto simp add: bv_cat'_def)
  qed
next
  case False
  note h = this
  show ?thesis
  proof(cases "l \<ge> snd b")
    case True
    {
      fix i :: nat
      assume "i < LENGTH('a)"
      hence "((\<langle>h,l\<rangle> (fst (bv_cat a b)))::'a::len0 word) !! i = (0::'a::len0 word) !! i"
        using h True assms
        by (auto simp add: bv_cat.simps nth_ucast test_bit_of_take_bits test_bit_of_bv_cat split: if_split_asm)
    }
    thus ?thesis
      using True h
      apply (auto)
      apply (intro word_eqI)
      by (auto simp add: word_size)
  next
    case False
    {
      fix i :: nat
      assume "i < LENGTH('a)"
      hence "((\<langle>h,l\<rangle> (fst (bv_cat a b)))::'a::len0 word) !! i = (\<langle>h,l\<rangle> (fst b)::'a::len0 word) !! i"
        using h False assms
        by (auto simp add: bv_cat.simps nth_ucast test_bit_of_take_bits test_bit_of_bv_cat split: if_split_asm)

    }
    thus ?thesis
      using False h
      apply (auto)
      apply (intro word_eqI)
      by (auto simp add: word_size)
  qed
qed

lemma take_bits_bv_slice:
  assumes "h < \<M>"
      and "h' < \<M>"
  shows "\<langle>h,l\<rangle>fst (bv_slice h' l' a) =  \<langle>(if Suc h - l < Suc h' - (l + l') then h + l' else h'),l + l'\<rangle>fst a"
  using assms
  by (cases a,auto simp add: bv_slice.simps)

lemma bv_slice_take_bits:
  assumes "h < \<M>"
      and "h' < LENGTH('a)"
  fixes a ::"'a::len0 word"
  shows "bv_slice h l (\<langle>h',l'\<rangle>a, s) = (\<langle>(if Suc h - l < Suc h' - (l + l') then h + l' else h'),l + l'\<rangle>a, h + 1 - l)"
  using assms
  by (auto simp add: bv_slice.simps)

lemma bv_slice_bit32:
  fixes a :: longword
  assumes "s \<ge> 32"
  shows "bv_slice 31 0 (a,s) = (ucast ((\<langle>31,0\<rangle>a)::32 word), 32)"
  using assms
  by (auto simp add: bv_slice.simps)

lemma bv_slice_bit16:
  fixes a :: longword
  assumes "s \<ge> 16"
  shows "bv_slice 15 0 (a,s) = (ucast ((\<langle>15,0\<rangle>a)::16 word), 16)"
  using assms
  by (auto simp add: bv_slice.simps)

lemma bv_slice_bit8:
  fixes a :: longword
  assumes "s \<ge> 8"
  shows "bv_slice 7 0 (a,s) = (ucast ((\<langle>7,0\<rangle>a)::8 word), 8)"
  using assms
  by (auto simp add: bv_slice.simps)

subsection \<open>Arithmetic\<close>

lemma BV_Add_bit64:
  fixes a b :: longword
    shows "(a,64) +\<^sup>b\<^sup>v (b,64) = (ucast (((\<langle>63,0\<rangle>a)::64 word) + \<langle>63,0\<rangle>b), 64)"
proof-
  have "(a,64) +\<^sup>b\<^sup>v (b,64) = (\<langle>63,0\<rangle>(a + b), 64)"
    by (cases a;cases b;auto simp add: exec_BV_Plus_def case_prod_unfold)
  also have "... = (ucast ((\<langle>63,0\<rangle>(a + b))::64 word), 64)"
    by (subst ucast_take_bits,simp,simp,simp)
  also have "... = (ucast (((\<langle>63,0\<rangle>a)::64 word) + \<langle>63,0\<rangle>b), 64)"
    by (subst take_bits_plus,simp,simp,simp)
  finally
  show ?thesis
    by auto
qed

lemma BV_Add_bit33:
  fixes a b :: longword
    shows "(a,33) +\<^sup>b\<^sup>v (b,33) = (ucast (((\<langle>32,0\<rangle>a)::33 word) + \<langle>32,0\<rangle>b), 33)"
proof-
  have "(a,33) +\<^sup>b\<^sup>v (b,33) = (\<langle>32,0\<rangle>(a + b), 33)"
    by (cases a;cases b;auto simp add: exec_BV_Plus_def case_prod_unfold)
  also have "... = (ucast ((\<langle>32,0\<rangle>(a + b))::33 word), 33)"
    by (subst ucast_take_bits,simp,simp,simp)
  also have "... = (ucast (((\<langle>32,0\<rangle>a)::33 word) + \<langle>32,0\<rangle>b), 33)"
    by (subst take_bits_plus,simp,simp,simp)
  finally
  show ?thesis
    by auto
qed

lemma BV_Add_bit65:
  fixes a b :: longword
    shows "(a,65) +\<^sup>b\<^sup>v (b,65) = (ucast (((\<langle>64,0\<rangle>a)::65 word) + \<langle>64,0\<rangle>b), 65)"
proof-
  have "(a,65) +\<^sup>b\<^sup>v (b,65) = (\<langle>64,0\<rangle>(a + b), 65)"
    by (cases a;cases b;auto simp add: exec_BV_Plus_def case_prod_unfold)
  also have "... = (ucast ((\<langle>64,0\<rangle>(a + b))::65 word), 65)"
    by (subst ucast_take_bits,simp,simp,simp)
  also have "... = (ucast (((\<langle>64,0\<rangle>a)::65 word) + \<langle>64,0\<rangle>b), 65)"
    by (subst take_bits_plus,simp,simp,simp)
  finally
  show ?thesis
    by auto
qed

lemma BV_Add_bit17:
  fixes a b :: longword
    shows "(a,17) +\<^sup>b\<^sup>v (b,17) = (ucast (((\<langle>16,0\<rangle>a)::17 word) + \<langle>16,0\<rangle>b), 17)"
proof-
  have "(a,17) +\<^sup>b\<^sup>v (b,17) = (\<langle>16,0\<rangle>(a + b), 17)"
    by (cases a;cases b;auto simp add: exec_BV_Plus_def case_prod_unfold)
  also have "... = (ucast ((\<langle>16,0\<rangle>(a + b))::17 word), 17)"
    by (subst ucast_take_bits,simp,simp,simp)
  also have "... = (ucast (((\<langle>16,0\<rangle>a)::17 word) + \<langle>16,0\<rangle>b), 17)"
    by (subst take_bits_plus,simp,simp,simp)
  finally
  show ?thesis
    by auto
qed

lemma BV_Add_bit9:
  fixes a b :: longword
    shows "(a,9) +\<^sup>b\<^sup>v (b,9) = (ucast (((\<langle>8,0\<rangle>a)::9 word) + \<langle>8,0\<rangle>b), 9)"
proof-
  have "(a,9) +\<^sup>b\<^sup>v (b,9) = (\<langle>8,0\<rangle>(a + b), 9)"
    by (cases a;cases b;auto simp add: exec_BV_Plus_def case_prod_unfold)
  also have "... = (ucast ((\<langle>8,0\<rangle>(a + b))::9 word), 9)"
    by (subst ucast_take_bits,simp,simp,simp)
  also have "... = (ucast (((\<langle>8,0\<rangle>a)::9 word) + \<langle>8,0\<rangle>b), 9)"
    by (subst take_bits_plus,simp,simp,simp)
  finally
  show ?thesis
    by auto
qed

subsection \<open>Floating Point operations\<close>

context abstract_float
begin

lemma BV_Plus_bit64:
  fixes a b :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fplus\<^sup>b\<^sup>v (\<langle>63,0\<rangle>b, 64) = (\<langle>63,0\<rangle>(a +\<^sup>f b), 64)"
  by (auto simp add: exec_BV_Plus_Double_def)

lemma BV_Plus_bit64_numeral:
  fixes a :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fplus\<^sup>b\<^sup>v (numeral n, 64) = (\<langle>63,0\<rangle>(a +\<^sup>f \<langle>63,0\<rangle>((numeral n)::longword)), 64)"
  by (auto simp add: exec_BV_Plus_Double_def)

lemma BV_Sub_bit64:
  fixes a b :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fsub\<^sup>b\<^sup>v (\<langle>63,0\<rangle>b, 64) = (\<langle>63,0\<rangle>(a -\<^sup>f b), 64)"
  by (auto simp add: exec_BV_Sub_Double_def)

lemma BV_Sub_bit64_numeral:
  fixes a :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fsub\<^sup>b\<^sup>v (numeral n, 64) = (\<langle>63,0\<rangle>(a -\<^sup>f \<langle>63,0\<rangle>((numeral n)::longword)), 64)"
  by (auto simp add: exec_BV_Sub_Double_def)

lemma BV_Mult_bit64:
  fixes a b :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fmult\<^sup>b\<^sup>v (\<langle>63,0\<rangle>b, 64) = (\<langle>63,0\<rangle>(a *\<^sup>f b), 64)"
  by (auto simp add: exec_BV_Mul_Double_def)

lemma BV_Mult_bit64_numeral_r:
  fixes a :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fmult\<^sup>b\<^sup>v (numeral n, 64) = (\<langle>63,0\<rangle>(a *\<^sup>f \<langle>63,0\<rangle>((numeral n)::longword)), 64)"
  by (auto simp add: exec_BV_Mul_Double_def)
lemma BV_Mult_bit64_numeral_l:
  fixes a :: "64 word"
  shows "(numeral n, 64) fmult\<^sup>b\<^sup>v (\<langle>63,0\<rangle>a, 64) = (\<langle>63,0\<rangle>(\<langle>63,0\<rangle>((numeral n)::longword) *\<^sup>f a), 64)"
  by (auto simp add: exec_BV_Mul_Double_def)
lemma BV_Mult_bit64_0_l:
  fixes a :: "64 word"
  shows "(0, 64) fmult\<^sup>b\<^sup>v (\<langle>63,0\<rangle>a, 64) = (\<langle>63,0\<rangle>(0\<^sup>+ *\<^sup>f a), 64)"
  by (auto simp add: exec_BV_Mul_Double_def plus_zero_def)
lemma BV_Mult_bit64_0_r:
  fixes a :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fmult\<^sup>b\<^sup>v (0, 64) = (\<langle>63,0\<rangle>(a *\<^sup>f 0\<^sup>+), 64)"
  by (auto simp add: exec_BV_Mul_Double_def plus_zero_def)

lemma BV_Div_bit64:
  fixes a b :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fdiv\<^sup>b\<^sup>v (\<langle>63,0\<rangle>b, 64) = (\<langle>63,0\<rangle>(a div\<^sup>f b), 64)"
  by (auto simp add: exec_BV_Div_Double_def)

lemma BV_Div_bit64_numeral:
  fixes a :: "64 word"
  shows "(\<langle>63,0\<rangle>a, 64) fdiv\<^sup>b\<^sup>v (numeral n, 64) = (\<langle>63,0\<rangle>(a div\<^sup>f \<langle>63,0\<rangle>((numeral n)::longword)), 64)"
  by (auto simp add: exec_BV_Div_Double_def)

end

subsection \<open>Simplification rules\<close>

lemmas (in abstract_float) bit_vector_simps =
    bv_slice_bv_cat take_bits_bv_slice bv_slice_take_bits take_bits_bv_cat bv_slice_bit32
    bv_cat_prepend_0 size_bv_cat size_bv_slice
    bv_to_bool_bool_to_bv snd_bool_to_bv
    bv_to_bool_True bv_to_bool_True_Suc0
    bv_to_bool_False bv_to_bool_False_Suc0
    BV_Add_bit65 BV_Add_bit64 BV_Add_bit33
    bv_slice_bit16 bv_slice_bit8 BV_Add_bit17 BV_Add_bit9
    BV_Plus_bit64 BV_Plus_bit64_numeral
    BV_Sub_bit64 BV_Sub_bit64_numeral
    BV_Mult_bit64 BV_Mult_bit64_numeral_r BV_Mult_bit64_numeral_l BV_Mult_bit64_0_l BV_Mult_bit64_0_r
    BV_Div_bit64 BV_Div_bit64_numeral

end


theory HeapLang
imports
  Main
  Locations
begin

section \<open> HeapLang Definition \<close>
text \<open> The basic language definition \<close>
text \<open> Based on \<^url>\<open>https://gitlab.mpi-sws.org/iris/iris/-/blob/master/iris_heap_lang/lang.v\<close> \<close>

type_synonym proph_id = nat

(*
  Binder type for anonymous and named binders,
  cf. https://gitlab.mpi-sws.org/iris/stdpp/-/blob/master/theories/binders.v
*)
type_synonym binder_t = "string option"

(* Literals *)
datatype base_lit =
  LitInt int | LitBool bool | LitUnit | LitPoison | LitLoc loc | LitProphecy proph_id

(* Unary operator symbols*)
datatype un_op =
  NegOp | MinusUnOp

(* Binary Operator Symbols *)
datatype bin_op =
  PlusOp | MinusOp | MultOp | QuotOp | RemOp | AndOp | OrOp | XorOp | ShiftLOp
  | ShiftROp | LeOp | LtOp | EqOp | OffsetOp

(* Expressions and values *)
datatype expr =
  (* Values *)
  Val val
  (* Base lambda calculus *)
  | Var string
  | Rec binder_t binder_t expr
  | App expr expr
  (* Base types and their operations *)
  | UnOp un_op expr
  | BinOp bin_op expr expr
  | If expr expr expr
  (* Products *)
  | Pair expr expr
  | Fst expr
  | Snd expr
  (* Sums *)
  | InjL expr
  | InjR expr
  | Case expr expr expr
  (* Concurrency *)
  | Fork expr
  (* Heap *)
  | AllocN expr expr (* array length (positive number), initial value *)
  | Free expr
  | Load expr
  | Store expr expr
  | CmpXchg expr expr expr (* Compare-exchange *)
  | Xchg expr expr (* exchange *)
  | FAA expr expr (* Fetch-and-add *)
  (* Prophecy *)
  | NewProph
  | Resolve expr expr expr (* wrapped expr, proph, val *)
and val =
  LitV base_lit
  | RecV binder_t binder_t expr
  | PairV val val
  | InjLV val
  | InjRV val

declare [[coercion Val]]

(* An observation associates a prophecy variable (identifier) to a pair of values. *)
type_synonym observation = "proph_id * val * val"

abbreviation "of_val \<equiv> Val"

fun to_val :: "expr \<Rightarrow> val option" where
  "to_val (Val v) = Some v"
| "to_val _ = None"

lemma to_val_cases: "to_val x = Some v \<Longrightarrow> x = Val v"
by (induction x, auto)

fun lit_is_unboxed :: "base_lit \<Rightarrow> bool" where
  "lit_is_unboxed (LitProphecy _) = False"
| "lit_is_unboxed LitPoison = False"
| "lit_is_unboxed _ = True"

fun val_is_unboxed :: "val \<Rightarrow> bool" where
  "val_is_unboxed (LitV l) = lit_is_unboxed l"
| "val_is_unboxed (InjLV (LitV l)) = lit_is_unboxed l"
| "val_is_unboxed (InjRV (LitV l)) = lit_is_unboxed l"
| "val_is_unboxed _ = False"

definition vals_compare_safe :: "val \<Rightarrow> val \<Rightarrow> bool" where
  "vals_compare_safe v1 v2 = (val_is_unboxed v1 \<or> val_is_unboxed v2)"

(** Evaluation contexts *)
datatype ectx_item =
  AppLCtx val
  | AppRCtx expr
  | UnOpCtx un_op
  | BinOpLCtx bin_op val
  | BinOpRCtx bin_op expr
  | IfCtx expr expr
  | PairLCtx val
  | PairRCtx expr
  | FstCtx
  | SndCtx
  | InjLCtx
  | InjRCtx
  | CaseCtx expr expr
  | AllocNLCtx val
  | AllocNRCtx expr
  | FreeCtx
  | LoadCtx
  | StoreLCtx val
  | StoreRCtx expr
  | XchgLCtx val
  | XchgRCtx expr
  | CmpXchgLCtx val val
  | CmpXchgMCtx expr val
  | CmpXchgRCtx expr expr
  | FaaLCtx val
  | FaaRCtx expr
  | ResolveLCtx ectx_item val val
  | ResolveMCtx expr val
  | ResolveRCtx expr expr

fun fill_item :: "ectx_item \<Rightarrow> expr \<Rightarrow> expr" where
  "fill_item (AppLCtx v2) e = App e (of_val v2)"
| "fill_item (AppRCtx e1) e = App e1 e"
| "fill_item (UnOpCtx op) e = UnOp op e"
| "fill_item (BinOpLCtx op v2) e = BinOp op e (Val v2)"
| "fill_item (BinOpRCtx op e1) e = BinOp op e1 e"
| "fill_item (IfCtx e1 e2) e = If e e1 e2"
| "fill_item (PairLCtx v2) e = Pair e (Val v2)"
| "fill_item (PairRCtx e1) e = Pair e1 e"
| "fill_item FstCtx e = Fst e"
| "fill_item SndCtx e = Snd e"
| "fill_item InjLCtx e = InjL e"
| "fill_item InjRCtx e = InjR e"
| "fill_item (CaseCtx e1 e2) e = Case e e1 e2"
| "fill_item (AllocNLCtx v2) e = AllocN e (Val v2)"
| "fill_item (AllocNRCtx e1) e = AllocN e1 e"
| "fill_item FreeCtx e = Free e"
| "fill_item LoadCtx e = Load e"
| "fill_item (StoreLCtx v2) e = Store e (Val v2)"
| "fill_item (StoreRCtx e1) e = Store e1 e"
| "fill_item (XchgLCtx v2) e = Xchg e (Val v2)"
| "fill_item (XchgRCtx e1) e = Xchg e1 e"
| "fill_item (CmpXchgLCtx v1 v2) e = CmpXchg e (Val v1) (Val v2)"
| "fill_item (CmpXchgMCtx e0 v2) e = CmpXchg e0 e (Val v2)"
| "fill_item (CmpXchgRCtx e0 e1) e = CmpXchg e0 e1 e"
| "fill_item (FaaLCtx v2) e = FAA e (Val v2)"
| "fill_item (FaaRCtx e1) e = FAA e1 e"
| "fill_item (ResolveLCtx K v1 v2) e = Resolve (fill_item K e) (Val v1) (Val v2)"
| "fill_item (ResolveMCtx ex v2) e = Resolve ex e (Val v2)"
| "fill_item (ResolveRCtx ex e1) e = Resolve ex e1 e"

fun subst :: "string \<Rightarrow> val \<Rightarrow> expr \<Rightarrow> expr" where
  "subst _ _ (Val v) = Val v"
| "subst x v (Var y) = (if x=y then Val v else Var y)"
| "subst x v (Rec f y e) = Rec f y (if (Some x \<noteq> f \<and> Some x \<noteq> y) then subst x v e else e)"
| "subst x v (App e1 e2) = App (subst x v e1) (subst x v e2)"
| "subst x v (UnOp op e) = UnOp op (subst x v e)"
| "subst x v (BinOp op e1 e2) = BinOp op (subst x v e1) (subst x v e2)"
| "subst x v (If e0 e1 e2) = If (subst x v e0) (subst x v e1) (subst x v e2)"
| "subst x v (Pair e1 e2) = Pair (subst x v e1) (subst x v e2)"
| "subst x v (Fst e) = Fst (subst x v e)"
| "subst x v (Snd e) = Snd (subst x v e)"
| "subst x v (InjL e) = InjL (subst x v e)"
| "subst x v (InjR e) = InjR (subst x v e)"
| "subst x v (Case e0 e1 e2) = Case (subst x v e0) (subst x v e1) (subst x v e2)"
| "subst x v (Fork e) = Fork (subst x v e)"
| "subst x v (AllocN e1 e2) = AllocN (subst x v e1) (subst x v e2)"
| "subst x v (Free e) = Free (subst x v e)"
| "subst x v (Load e) = Load (subst x v e)"
| "subst x v (Xchg e1 e2) = Xchg (subst x v e1) (subst x v e2)"
| "subst x v (Store e1 e2) = Store (subst x v e1) (subst x v e2)"
| "subst x v (CmpXchg e0 e1 e2) = CmpXchg (subst x v e0) (subst x v e1) (subst x v e2)"
| "subst x v (FAA e1 e2) = FAA (subst x v e1) (subst x v e2)"
| "subst _ _ NewProph = NewProph"
| "subst x v (Resolve ex e1 e2) = Resolve (subst x v ex) (subst x v e1) (subst x v e2)"

definition subst' :: "binder_t \<Rightarrow> val \<Rightarrow> expr \<Rightarrow> expr" where
  "subst' mx v = (case mx of Some x \<Rightarrow> subst x v | None \<Rightarrow> (\<lambda>x. x))"

(* The stepping relation *)
fun un_op_eval :: "un_op \<Rightarrow> val \<Rightarrow> val option" where
  "un_op_eval NegOp (LitV (LitBool b)) = Some (LitV (LitBool (\<not> b)))"
| "un_op_eval NegOp (LitV (LitInt n)) = Some (LitV (LitInt (not n)))"
| "un_op_eval MinusUnOp (LitV (LitInt n)) = Some (LitV (LitInt (- n)))"
| "un_op_eval _ _ = None"

fun bin_op_eval_int :: "bin_op \<Rightarrow> int \<Rightarrow> int \<Rightarrow> base_lit option" where
  "bin_op_eval_int PlusOp n1 n2 = Some (LitInt (n1 + n2))"
| "bin_op_eval_int MinusOp n1 n2 = Some (LitInt (n1 - n2))"
| "bin_op_eval_int MultOp n1 n2 = Some (LitInt (n1 * n2))"
| "bin_op_eval_int QuotOp n1 n2 = Some (LitInt (n1 div n2))"
| "bin_op_eval_int RemOp n1 n2 = Some (LitInt (n1 mod n2))"
| "bin_op_eval_int AndOp n1 n2 = Some (LitInt (and n1 n2))"
| "bin_op_eval_int OrOp n1 n2 = Some (LitInt (or n1 n2))"
| "bin_op_eval_int XorOp n1 n2 = Some (LitInt (xor n1 n2))"
| "bin_op_eval_int ShiftLOp n1 n2 = Some (LitInt (push_bit (nat n1) n2))"
| "bin_op_eval_int ShiftROp n1 n2 = Some (LitInt (drop_bit (nat n1) n2))"
| "bin_op_eval_int LeOp n1 n2 = Some (LitBool (n1 \<le> n2))"
| "bin_op_eval_int LtOp n1 n2 = Some (LitBool (n1 < n2))"
| "bin_op_eval_int EqOp n1 n2 = Some (LitBool (n1 = n2))"
| "bin_op_eval_int OffsetOp _ _ = None" (* Pointer arithmetic *)

fun bin_op_eval_bool :: "bin_op \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> base_lit option" where
  "bin_op_eval_bool AndOp b1 b2 = Some (LitBool (b1 \<and> b2))"
| "bin_op_eval_bool OrOp b1 b2 = Some (LitBool (b1 \<or> b2))"
| "bin_op_eval_bool XorOp b1 b2 = Some (LitBool ((\<not>b1\<and>b2)\<or>(b1\<and>\<not>b2)))"
| "bin_op_eval_bool EqOp b1 b2 = Some (LitBool (b1 = b2))"
| "bin_op_eval_bool _ _ _ = None"

fun bin_op_eval_loc :: "bin_op \<Rightarrow> loc \<Rightarrow> base_lit \<Rightarrow> base_lit option" where
  "bin_op_eval_loc OffsetOp l (LitInt off) = Some (LitLoc (l+\<^sub>\<iota>off))"
| "bin_op_eval_loc _ _ _ = None"

definition bin_op_eval :: "bin_op \<Rightarrow> val \<Rightarrow> val \<Rightarrow> val option" where
  "bin_op_eval op v1 v2 =
  (if (op = EqOp) then
      if (vals_compare_safe v1 v2) then
        Some (LitV (LitBool (v1 = v2)))
      else
        None
   else (case (v1, v2) of
      (LitV (LitInt n1), LitV (LitInt n2)) \<Rightarrow> map_option LitV (bin_op_eval_int op n1 n2)
      | (LitV (LitBool b1), LitV (LitBool b2)) \<Rightarrow> map_option LitV (bin_op_eval_bool op b1 b2)
      | (LitV (LitLoc l1), LitV v2) \<Rightarrow> map_option LitV (bin_op_eval_loc op l1 v2)
      | (_, _) \<Rightarrow> None)
    )"
end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory AbstractArrays
imports
  "CParser.TypHeapLib"
  "Word_Lib.WordSetup"
begin

(*
 * Return a list of addresses that contain an element for an array at location
 * "p" of length "n".
 *)
primrec
  array_addrs :: "('a::mem_type) ptr \<Rightarrow> nat \<Rightarrow> 'a ptr list"
where
  "array_addrs _ 0 = []"
| "array_addrs p (Suc n) = p # (array_addrs (p +\<^sub>p 1) n)"

declare array_addrs.simps(2) [simp del]

(* The first element is in the array if the array has non-zero length. *)
lemma hd_in_array_addrs [simp]:
  "(x \<in> set (array_addrs x n)) = (n > 0)"
  by (case_tac n, auto simp: array_addrs.simps(2))

lemma array_addrs_1 [simp]:
  "array_addrs p (Suc 0) = [p]"
  "array_addrs p 1 = [p]"
  by (auto simp: array_addrs.simps(2))

(* All array elements are aligned if the array itself is aligned. *)
lemma array_addrs_ptr_aligned:
     "\<lbrakk> x \<in> set (array_addrs p n); ptr_aligned p \<rbrakk> \<Longrightarrow> ptr_aligned x"
  apply (induct n arbitrary: x p)
   apply clarsimp
  apply (clarsimp simp: array_addrs.simps(2))
  apply (erule disjE)
   apply clarsimp
  apply atomize
  apply (drule_tac x=x in spec)
  apply (drule_tac x="p +\<^sub>p 1" in spec)
  apply (clarsimp simp: ptr_aligned_plus)
  done

(* Split off the last element in an array. *)
lemma set_array_addrs_unfold_last:
  shows "set (array_addrs a (Suc n)) = set (array_addrs a n) \<union> {(a :: ('a::mem_type) ptr) +\<^sub>p int n}"
    (is "?LHS a n = ?RHS a n")
proof (induct n arbitrary: a)
  fix a
  show "?LHS a 0 = ?RHS a 0"
    by clarsimp
next
  fix a n
  assume induct: "\<And>a. ?LHS a n = ?RHS a n"
  show "?LHS a (Suc n) = ?RHS a (Suc n)"
  apply (subst array_addrs.simps(2))
  apply (subst set_simps)
  apply (subst induct [where a="a +\<^sub>p 1"])
  apply (subst array_addrs.simps(2))
  apply (subst set_simps)
  apply (clarsimp simp: CTypesDefs.ptr_add_def field_simps insert_commute)
  done
qed

(* Alternative representation of the set of array elements. *)
lemma set_array_addrs:
  "set (array_addrs (p :: ('a::mem_type) ptr) n)
           = {x. \<exists>k. x = p +\<^sub>p int k \<and> k < n }"
  apply (induct n arbitrary: p)
   apply (clarsimp simp: not_less)
  apply (subst set_array_addrs_unfold_last)
  apply atomize
  apply (drule_tac x=p in spec)
  apply (erule ssubst)
  apply (rule set_eqI)
  apply (rule iffI)
   apply clarsimp
   apply (erule disjE)
    apply clarsimp
    apply force
   apply force
  apply clarsimp
  apply (drule_tac x=k in spec)
  apply (clarsimp simp: not_less)
  apply (subgoal_tac "k = n")
   apply clarsimp
  apply clarsimp
  done

end


theory Sep_Algebra_Add
  imports "Separation_Algebra.Separation_Algebra" "Separation_Algebra.Sep_Heap_Instance"
    Product_Separation_Algebra
begin

definition puree :: "bool \<Rightarrow> 'h::sep_algebra \<Rightarrow> bool" ("\<up>") where "puree P \<equiv> \<lambda>h. h=0 \<and> P"

lemma puree_alt: "\<up>\<Phi> = (\<langle>\<Phi>\<rangle> and \<box>)"
  by (auto simp: puree_def sep_empty_def)

lemma pure_alt: "\<langle>\<Phi>\<rangle> = (\<up>\<Phi> ** sep_true)"
  apply (clarsimp simp: puree_def)
proof -
  { fix aa :: 'a
    obtain aaa :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a" where
      ff1: "\<And>p pa a pb pc aa. (\<not> (p \<and>* pa) a \<or> p (aaa p pb) \<or> (pb \<and>*
pa) a) \<and> (\<not> pb (aaa p pb) \<or> \<not> (p \<and>* pc) aa \<or> (pb \<and>* pc) aa)"
      by (metis (no_types) sep_globalise)
    then have "\<exists>p. ((\<lambda>a. a = 0) \<and>* p) aa"
      by (metis (full_types) sep_conj_commuteI sep_conj_sep_emptyE
sep_empty_def)
    then have "\<not> \<Phi> \<or> \<Phi> \<and> ((\<lambda>a. a = 0) \<and>* (\<lambda>a. True)) aa"
      using ff1 by (metis (no_types) sep_conj_commuteI) }
  then show "(\<lambda>a. \<Phi>) = (\<lambda>a. \<Phi> \<and> ((\<lambda>a. (a::'a) = 0) \<and>* (\<lambda>a. True)) a)"
    by blast
qed

abbreviation NO_PURE :: "bool \<Rightarrow> ('h::sep_algebra \<Rightarrow> bool) \<Rightarrow> bool"
  where "NO_PURE X Q \<equiv> (NO_MATCH (\<langle>X\<rangle>::'h\<Rightarrow>bool) Q \<and> NO_MATCH ((\<up>X)::'h\<Rightarrow>bool) Q)"

named_theorems sep_simplify \<open>Assertion simplifications\<close>

lemma sep_reorder[sep_simplify]:
  "((a \<and>* b) \<and>* c) = (a \<and>* b \<and>* c)"
  "(NO_PURE X a) \<Longrightarrow> (a ** b) = (b ** a)"
  "(NO_PURE X b) \<Longrightarrow> (b \<and>* a \<and>* c) = (a \<and>* b \<and>* c)"
  "(Q ** \<langle>P\<rangle>) = (\<langle>P\<rangle> ** Q)"
  "(Q ** \<up>P) = (\<up>P ** Q)"
  "NO_PURE X Q \<Longrightarrow> (Q ** \<langle>P\<rangle> ** F) = (\<langle>P\<rangle> ** Q ** F)"
  "NO_PURE X Q \<Longrightarrow> (Q ** \<up>P ** F) = (\<up>P ** Q ** F)"
  by (simp_all add: sep.add_ac)

lemma sep_combine1[simp]:
  "(\<up>P ** \<up>Q) = \<up>(P\<and>Q)"
  "(\<langle>P\<rangle> ** \<langle>Q\<rangle>) = \<langle>P\<and>Q\<rangle>"
  "(\<up>P ** \<langle>Q\<rangle>) = \<langle>P\<and>Q\<rangle>"
  "(\<langle>P\<rangle> ** \<up>Q) = \<langle>P\<and>Q\<rangle>"
  apply (auto simp add: sep_conj_def puree_def intro!: ext)
  apply (rule_tac x=0 in exI)
  apply simp
  done

lemma sep_combine2[simp]:
  "(\<up>P ** \<up>Q ** F) = (\<up>(P\<and>Q) ** F)"
  "(\<langle>P\<rangle> ** \<langle>Q\<rangle> ** F) = (\<langle>P\<and>Q\<rangle> ** F)"
  "(\<up>P ** \<langle>Q\<rangle> ** F) = (\<langle>P\<and>Q\<rangle> ** F)"
  "(\<langle>P\<rangle> ** \<up>Q ** F) = (\<langle>P\<and>Q\<rangle> ** F)"
  apply (subst sep.add_assoc[symmetric]; simp)+
  done

lemma sep_extract_pure[simp]:
  "NO_MATCH True P \<Longrightarrow> (\<langle>P\<rangle> ** Q) h = (P \<and> (sep_true ** Q) h)"
  "(\<up>P ** Q) h = (P \<and> Q h)"
  "\<up>True = \<box>"
  "\<up>False = sep_false"
  using sep_conj_sep_true_right apply fastforce
  by (auto simp: puree_def sep_empty_def[symmetric])

lemma sep_pure_front2[simp]:
  "(\<up>P ** A ** \<up>Q ** F) = (\<up>(P \<and> Q) ** F ** A)"
  apply (simp add: sep_reorder)
  done

lemma ex_h_simps[simp]:
  "Ex (\<up>\<Phi>) \<longleftrightarrow> \<Phi>"
  "Ex (\<up>\<Phi> ** P) \<longleftrightarrow> (\<Phi> \<and> Ex P)"
  apply (cases \<Phi>; auto)
  apply auto
  done

lemma
  fixes h :: "('a \<Rightarrow> 'b option) * nat"
  shows "(P ** Q ** H) h = (Q ** H ** P) h"
  by (simp add: sep_conj_ac)

(* map_le *)
lemma map_le_substate_conv: "map_le = sep_substate"
  unfolding map_le_def sep_substate_def sep_disj_fun_def plus_fun_def domain_def dom_def none_def apply (auto intro!: ext)
  subgoal for m1 m2 apply(rule exI[where x="%x. if (\<exists>y. m1 x = Some y) then None else m2 x"])
    by auto
  by blast

end


theory Proof_5_589
  imports Proofs5
begin

theorem proof_5_590: "VC590 inv5 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC590_def)
  apply simp
  apply(unfold inv5_def R5_def)
  apply(rule impI)
  apply(rule conjI)
   apply(rule conjI)
    apply simp
   apply(unfold extraInv_def)[1]
   apply(drule conjE)
    prefer 2
    apply assumption
  apply(drule conjE)
   prefer 2
    apply assumption
  subgoal premises vc_prems
    apply((rule allI)+)
    apply(rule impI)
    apply(simp split: if_splits del: One_nat_def)
    subgoal for s1 s2
      apply(rule impE[OF isOpened_R5[of s1 s2 s0 s0]])
       apply(insert vc_prems substate_refl)[1]
      subgoal
        apply((drule conjE[of _ _ ?thesis])+)
                            defer
                            apply assumption+
        by blast
      by blast
    using vc_prems(2)  by blast


(*  Title:      HOL/Auth/n_mutualExFsm_lemma_inv__5_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExFsm Protocol Case Study*}

theory n_mutualExFsm_lemma_inv__5_on_rules imports n_mutualExFsm_lemma_on_inv__5
begin
section{*All lemmas on causal relation between inv__5*}
lemma lemma_inv__5_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__5  p__Inv0 p__Inv1)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_fsm  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_fsm  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_fsmVsinv__5) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


(*  Title:      HOL/HOLCF/IOA/Traces.thy
    Author:     Olaf Müller
*)

section \<open>Executions and Traces of I/O automata in HOLCF\<close>

theory Traces
imports Sequence Automata
begin

default_sort type

type_synonym ('a, 's) pairs = "('a \<times> 's) Seq"
type_synonym ('a, 's) execution = "'s \<times> ('a, 's) pairs"
type_synonym 'a trace = "'a Seq"
type_synonym ('a, 's) execution_module = "('a, 's) execution set \<times> 'a signature"
type_synonym 'a schedule_module = "'a trace set \<times> 'a signature"
type_synonym 'a trace_module = "'a trace set \<times> 'a signature"

subsection \<open>Executions\<close>

definition is_exec_fragC :: "('a, 's) ioa \<Rightarrow> ('a, 's) pairs \<rightarrow> 's \<Rightarrow> tr"
  where "is_exec_fragC A =
    (fix \<cdot>
      (LAM h ex.
        (\<lambda>s.
          case ex of
            nil \<Rightarrow> TT
          | x ## xs \<Rightarrow> flift1 (\<lambda>p. Def ((s, p) \<in> trans_of A) andalso (h \<cdot> xs) (snd p)) \<cdot> x)))"

definition is_exec_frag :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "is_exec_frag A ex \<longleftrightarrow> (is_exec_fragC A \<cdot> (snd ex)) (fst ex) \<noteq> FF"

definition executions :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution set"
  where "executions ioa = {e. fst e \<in> starts_of ioa \<and> is_exec_frag ioa e}"

subsection \<open>Schedules\<close>

definition filter_act :: "('a, 's) pairs \<rightarrow> 'a trace"
  where "filter_act = Map fst"

definition has_schedule :: "('a, 's) ioa \<Rightarrow> 'a trace \<Rightarrow> bool"
  where "has_schedule ioa sch \<longleftrightarrow> (\<exists>ex \<in> executions ioa. sch = filter_act \<cdot> (snd ex))"

definition schedules :: "('a, 's) ioa \<Rightarrow> 'a trace set"
  where "schedules ioa = {sch. has_schedule ioa sch}"

subsection \<open>Traces\<close>

definition has_trace :: "('a, 's) ioa \<Rightarrow> 'a trace \<Rightarrow> bool"
  where "has_trace ioa tr \<longleftrightarrow> (\<exists>sch \<in> schedules ioa. tr = Filter (\<lambda>a. a \<in> ext ioa) \<cdot> sch)"

definition traces :: "('a, 's) ioa \<Rightarrow> 'a trace set"
  where "traces ioa \<equiv> {tr. has_trace ioa tr}"

definition mk_trace :: "('a, 's) ioa \<Rightarrow> ('a, 's) pairs \<rightarrow> 'a trace"
  where "mk_trace ioa = (LAM tr. Filter (\<lambda>a. a \<in> ext ioa) \<cdot> (filter_act \<cdot> tr))"

subsection \<open>Fair Traces\<close>

definition laststate :: "('a, 's) execution \<Rightarrow> 's"
  where "laststate ex =
    (case Last \<cdot> (snd ex) of
      UU \<Rightarrow> fst ex
    | Def at \<Rightarrow> snd at)"

text \<open>A predicate holds infinitely (finitely) often in a sequence.\<close>
definition inf_often :: "('a \<Rightarrow> bool) \<Rightarrow> 'a Seq \<Rightarrow> bool"
  where "inf_often P s \<longleftrightarrow> Infinite (Filter P \<cdot> s)"

text \<open>Filtering \<open>P\<close> yields a finite or partial sequence.\<close>
definition fin_often :: "('a \<Rightarrow> bool) \<Rightarrow> 'a Seq \<Rightarrow> bool"
  where "fin_often P s \<longleftrightarrow> \<not> inf_often P s"

subsection \<open>Fairness of executions\<close>

text \<open>
  Note that partial execs cannot be \<open>wfair\<close> as the inf_often predicate in the
  else branch prohibits it. However they can be \<open>sfair\<close> in the case when all
  \<open>W\<close> are only finitely often enabled: Is this the right model?

  See \<^file>\<open>LiveIOA.thy\<close> for solution conforming with the literature and
  superseding this one.
\<close>

definition is_wfair :: "('a, 's) ioa \<Rightarrow> 'a set \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "is_wfair A W ex \<longleftrightarrow>
    (inf_often (\<lambda>x. fst x \<in> W) (snd ex) \<or>
      inf_often (\<lambda>x. \<not> Enabled A W (snd x)) (snd ex))"

definition wfair_ex :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "wfair_ex A ex \<longleftrightarrow>
    (\<forall>W \<in> wfair_of A.
      if Finite (snd ex)
      then \<not> Enabled A W (laststate ex)
      else is_wfair A W ex)"

definition is_sfair :: "('a, 's) ioa \<Rightarrow> 'a set \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "is_sfair A W ex \<longleftrightarrow>
    (inf_often (\<lambda>x. fst x \<in> W) (snd ex) \<or>
      fin_often (\<lambda>x. Enabled A W (snd x)) (snd ex))"

definition sfair_ex :: "('a, 's)ioa \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "sfair_ex A ex \<longleftrightarrow>
    (\<forall>W \<in> sfair_of A.
      if Finite (snd ex)
      then \<not> Enabled A W (laststate ex)
      else is_sfair A W ex)"

definition fair_ex :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution \<Rightarrow> bool"
  where "fair_ex A ex \<longleftrightarrow> wfair_ex A ex \<and> sfair_ex A ex"

text \<open>Fair behavior sets.\<close>

definition fairexecutions :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution set"
  where "fairexecutions A = {ex. ex \<in> executions A \<and> fair_ex A ex}"

definition fairtraces :: "('a, 's) ioa \<Rightarrow> 'a trace set"
  where "fairtraces A = {mk_trace A \<cdot> (snd ex) | ex. ex \<in> fairexecutions A}"

subsection \<open>Implementation\<close>

subsubsection \<open>Notions of implementation\<close>

definition ioa_implements :: "('a, 's1) ioa \<Rightarrow> ('a, 's2) ioa \<Rightarrow> bool"  (infixr "=<|" 12)
  where "(ioa1 =<| ioa2) \<longleftrightarrow>
    (inputs (asig_of ioa1) = inputs (asig_of ioa2) \<and>
     outputs (asig_of ioa1) = outputs (asig_of ioa2)) \<and>
    traces ioa1 \<subseteq> traces ioa2"

definition fair_implements :: "('a, 's1) ioa \<Rightarrow> ('a, 's2) ioa \<Rightarrow> bool"
  where "fair_implements C A \<longleftrightarrow>
    inp C = inp A \<and> out C = out A \<and> fairtraces C \<subseteq> fairtraces A"

lemma implements_trans: "A =<| B \<Longrightarrow> B =<| C \<Longrightarrow> A =<| C"
  by (auto simp add: ioa_implements_def)

subsection \<open>Modules\<close>

subsubsection \<open>Execution, schedule and trace modules\<close>

definition Execs :: "('a, 's) ioa \<Rightarrow> ('a, 's) execution_module"
  where "Execs A = (executions A, asig_of A)"

definition Scheds :: "('a, 's) ioa \<Rightarrow> 'a schedule_module"
  where "Scheds A = (schedules A, asig_of A)"

definition Traces :: "('a, 's) ioa \<Rightarrow> 'a trace_module"
  where "Traces A = (traces A, asig_of A)"

lemmas [simp del] = HOL.ex_simps HOL.all_simps split_paired_Ex
declare Let_def [simp]
setup \<open>map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac")\<close>

lemmas exec_rws = executions_def is_exec_frag_def

subsection \<open>Recursive equations of operators\<close>

subsubsection \<open>\<open>filter_act\<close>\<close>

lemma filter_act_UU: "filter_act \<cdot> UU = UU"
  by (simp add: filter_act_def)

lemma filter_act_nil: "filter_act \<cdot> nil = nil"
  by (simp add: filter_act_def)

lemma filter_act_cons: "filter_act \<cdot> (x \<leadsto> xs) = fst x \<leadsto> filter_act \<cdot> xs"
  by (simp add: filter_act_def)

declare filter_act_UU [simp] filter_act_nil [simp] filter_act_cons [simp]

subsubsection \<open>\<open>mk_trace\<close>\<close>

lemma mk_trace_UU: "mk_trace A \<cdot> UU = UU"
  by (simp add: mk_trace_def)

lemma mk_trace_nil: "mk_trace A \<cdot> nil = nil"
  by (simp add: mk_trace_def)

lemma mk_trace_cons:
  "mk_trace A \<cdot> (at \<leadsto> xs) =
    (if fst at \<in> ext A
     then fst at \<leadsto> mk_trace A \<cdot> xs
     else mk_trace A \<cdot> xs)"
  by (simp add: mk_trace_def)

declare mk_trace_UU [simp] mk_trace_nil [simp] mk_trace_cons [simp]

subsubsection \<open>\<open>is_exec_fragC\<close>\<close>

lemma is_exec_fragC_unfold:
  "is_exec_fragC A =
    (LAM ex.
      (\<lambda>s.
        case ex of
          nil \<Rightarrow> TT
        | x ## xs \<Rightarrow>
            (flift1 (\<lambda>p. Def ((s, p) \<in> trans_of A) andalso (is_exec_fragC A\<cdot>xs) (snd p)) \<cdot> x)))"
  apply (rule trans)
  apply (rule fix_eq4)
  apply (rule is_exec_fragC_def)
  apply (rule beta_cfun)
  apply (simp add: flift1_def)
  done

lemma is_exec_fragC_UU: "(is_exec_fragC A \<cdot> UU) s = UU"
  apply (subst is_exec_fragC_unfold)
  apply simp
  done

lemma is_exec_fragC_nil: "(is_exec_fragC A \<cdot> nil) s = TT"
  apply (subst is_exec_fragC_unfold)
  apply simp
  done

lemma is_exec_fragC_cons:
  "(is_exec_fragC A \<cdot> (pr \<leadsto> xs)) s =
    (Def ((s, pr) \<in> trans_of A) andalso (is_exec_fragC A \<cdot> xs) (snd pr))"
  apply (rule trans)
  apply (subst is_exec_fragC_unfold)
  apply (simp add: Consq_def flift1_def)
  apply simp
  done

declare is_exec_fragC_UU [simp] is_exec_fragC_nil [simp] is_exec_fragC_cons [simp]

subsubsection \<open>\<open>is_exec_frag\<close>\<close>

lemma is_exec_frag_UU: "is_exec_frag A (s, UU)"
  by (simp add: is_exec_frag_def)

lemma is_exec_frag_nil: "is_exec_frag A (s, nil)"
  by (simp add: is_exec_frag_def)

lemma is_exec_frag_cons:
  "is_exec_frag A (s, (a, t) \<leadsto> ex) \<longleftrightarrow> (s, a, t) \<in> trans_of A \<and> is_exec_frag A (t, ex)"
  by (simp add: is_exec_frag_def)

declare is_exec_frag_UU [simp] is_exec_frag_nil [simp] is_exec_frag_cons [simp]

subsubsection \<open>\<open>laststate\<close>\<close>

lemma laststate_UU: "laststate (s, UU) = s"
  by (simp add: laststate_def)

lemma laststate_nil: "laststate (s, nil) = s"
  by (simp add: laststate_def)

lemma laststate_cons: "Finite ex \<Longrightarrow> laststate (s, at \<leadsto> ex) = laststate (snd at, ex)"
  apply (simp add: laststate_def)
  apply (cases "ex = nil")
  apply simp
  apply simp
  apply (drule Finite_Last1 [THEN mp])
  apply assumption
  apply defined
  done

declare laststate_UU [simp] laststate_nil [simp] laststate_cons [simp]

lemma exists_laststate: "Finite ex \<Longrightarrow> \<forall>s. \<exists>u. laststate (s, ex) = u"
  by Seq_Finite_induct

subsection \<open>\<open>has_trace\<close> \<open>mk_trace\<close>\<close>

(*alternative definition of has_trace tailored for the refinement proof, as it does not
  take the detour of schedules*)
lemma has_trace_def2: "has_trace A b \<longleftrightarrow> (\<exists>ex \<in> executions A. b = mk_trace A \<cdot> (snd ex))"
  apply (unfold executions_def mk_trace_def has_trace_def schedules_def has_schedule_def [abs_def])
  apply auto
  done

subsection \<open>Signatures and executions, schedules\<close>

text \<open>
  All executions of \<open>A\<close> have only actions of \<open>A\<close>. This is only true because of
  the predicate \<open>state_trans\<close> (part of the predicate \<open>IOA\<close>): We have no
  dependent types. For executions of parallel automata this assumption is not
  needed, as in \<open>par_def\<close> this condition is included once more. (See Lemmas
  1.1.1c in CompoExecs for example.)
\<close>

lemma execfrag_in_sig:
  "is_trans_of A \<Longrightarrow> \<forall>s. is_exec_frag A (s, xs) \<longrightarrow> Forall (\<lambda>a. a \<in> act A) (filter_act \<cdot> xs)"
  apply (pair_induct xs simp: is_exec_frag_def Forall_def sforall_def)
  text \<open>main case\<close>
  apply (auto simp add: is_trans_of_def)
  done

lemma exec_in_sig:
  "is_trans_of A \<Longrightarrow> x \<in> executions A \<Longrightarrow> Forall (\<lambda>a. a \<in> act A) (filter_act \<cdot> (snd x))"
  apply (simp add: executions_def)
  apply (pair x)
  apply (rule execfrag_in_sig [THEN spec, THEN mp])
  apply auto
  done

lemma scheds_in_sig: "is_trans_of A \<Longrightarrow> x \<in> schedules A \<Longrightarrow> Forall (\<lambda>a. a \<in> act A) x"
  apply (unfold schedules_def has_schedule_def [abs_def])
  apply (fast intro!: exec_in_sig)
  done

subsection \<open>Executions are prefix closed\<close>

(*only admissible in y, not if done in x!*)
lemma execfrag_prefixclosed: "\<forall>x s. is_exec_frag A (s, x) \<and> y \<sqsubseteq> x \<longrightarrow> is_exec_frag A (s, y)"
  apply (pair_induct y simp: is_exec_frag_def)
  apply (intro strip)
  apply (Seq_case_simp x)
  apply (pair a)
  apply auto
  done

lemmas exec_prefixclosed =
  conjI [THEN execfrag_prefixclosed [THEN spec, THEN spec, THEN mp]]

(*second prefix notion for Finite x*)
lemma exec_prefix2closed [rule_format]:
  "\<forall>y s. is_exec_frag A (s, x @@ y) \<longrightarrow> is_exec_frag A (s, x)"
  apply (pair_induct x simp: is_exec_frag_def)
  apply (intro strip)
  apply (Seq_case_simp s)
  apply (pair a)
  apply auto
  done

end


theory Example_NetModel
imports "../TopoS_Interface" "../TopoS_Helper"
begin

text{* A toy example that defines a valid network security requirement model *}

definition default_node_properties :: "bool"
  where  "default_node_properties \<equiv> False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> bool) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> (edges G). (nP e1) \<and> (nP e2))"

(* we will not define receiver_violation!! Works for both! *)

-- "The preliminaries: mostly, sinvar is monotonic"
interpretation SecurityInvariant_preliminaries
where sinvar = sinvar
  apply unfold_locales
    apply(frule_tac finite_distinct_list[OF wf_graph.finiteE])
    apply(erule_tac exE)
    apply(rename_tac list_edges)
    apply(rule_tac ff="list_edges" in SecurityInvariant_withOffendingFlows.mono_imp_set_offending_flows_not_empty[OF sinvar_mono])
       apply(auto)[6]
  apply(auto simp add: SecurityInvariant_withOffendingFlows.is_offending_flows_def graph_ops)[2]
  apply(fact SecurityInvariant_withOffendingFlows.sinvar_mono_imp_is_offending_flows_mono[OF sinvar_mono])
done

-- "With generic target focus"
interpretation Example_NetModel: SecurityInvariant
where default_node_properties = default_node_properties
and sinvar = sinvar
and receiver_violation = receiver_violation (*yep, that's a variable*)
  unfolding default_node_properties_def
  apply unfold_locales

   -- "Secure bydefault"
   apply(simp)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
       SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
       SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add: graph_ops)
   apply (simp split: prod.split_asm prod.split)
   apply blast

 -- "Uniqueness"
 apply(simp add:default_node_properties_def)
 apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
     SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
     SecurityInvariant_withOffendingFlows.is_offending_flows_def)
 apply (simp add: graph_ops)
 apply (simp split: prod.split_asm prod.split)
 -- "proof by counter example: assume False is not the unique default parameter"
 apply(rule_tac x="\<lparr> nodes={vertex_1}, edges = {(vertex_1,vertex_1)} \<rparr>" in exI, simp)
 apply(rule conjI)
  apply(simp add: wf_graph_def; fail)
 apply(rule_tac x="(\<lambda> x. default_node_properties)(vertex_1 := False)" in exI, simp add:default_node_properties_def)
 apply(case_tac receiver_violation)
  apply(simp_all)
  apply(rule_tac x="{(vertex_1,vertex_1)}" in exI, simp)+
done

text{*And we end up with a totally useless network security requirement model. I hope this was instructive.*}

end