theory K_L_Spark_Obligation
imports K_L_Spark_User

begin

lemma goal6'1:
  assumes R1:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes R2:
  " K_L_Spark_Declaration.interfaces__unsigned_32__first'' = (0 :: int)
  "
  assumes R3:
  " K_L_Spark_Declaration.interfaces__unsigned_32__last''
    = (4294967295 :: int)
  "
  assumes R4:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__first''
    = (0 :: int)
  "
  assumes R5:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__last''
    = (4294967295 :: int)
  "
  assumes R6:
  " K_L_Spark_Declaration.interfaces__unsigned_32__modulus''
    = (4294967296 :: int)
  "
  assumes R7: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes R8: " K_L_Spark_Declaration.word__first'' = (0 :: int) "
  assumes R9:
  " K_L_Spark_Declaration.word__last'' = (4294967295 :: int)
  "
  assumes R10:
  " K_L_Spark_Declaration.word__base__first'' = (0 :: int)
  "
  assumes R11:
  " K_L_Spark_Declaration.word__base__last'' = (4294967295 :: int)
  "
  assumes R12:
  " K_L_Spark_Declaration.word__modulus'' = (4294967296 :: int)
  "
  assumes R13:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes R14:
  " K_L_Spark_Declaration.round_index__first'' = (0 :: int)
  "
  assumes R15:
  " K_L_Spark_Declaration.round_index__last'' = (79 :: int)
  "
  assumes R16:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes R17:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__first''
  "
  assumes R18:
  " K_L_Spark_Declaration.round_index__last''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H1: " (0 :: int) <= K_L_Spark_Declaration.j'' "
  assumes H2: " K_L_Spark_Declaration.j'' <= (15 :: int) "
  assumes H3:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes H4: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes H5:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes H6:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H7:
  " K_L_Spark_Declaration.round_index__base__first'' <= (0 :: int)
  "
  assumes H8:
  " (79 :: int) <= K_L_Spark_Declaration.round_index__base__last''
  "
  shows " (0 :: int) = K_L_Spark_Specification.k_l' K_L_Spark_Declaration.j''
        " (is "?C1")
apply (insert assms) by (rule userlemmas)

lemma goal7'1:
  assumes R1:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes R2:
  " K_L_Spark_Declaration.interfaces__unsigned_32__first'' = (0 :: int)
  "
  assumes R3:
  " K_L_Spark_Declaration.interfaces__unsigned_32__last''
    = (4294967295 :: int)
  "
  assumes R4:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__first''
    = (0 :: int)
  "
  assumes R5:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__last''
    = (4294967295 :: int)
  "
  assumes R6:
  " K_L_Spark_Declaration.interfaces__unsigned_32__modulus''
    = (4294967296 :: int)
  "
  assumes R7: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes R8: " K_L_Spark_Declaration.word__first'' = (0 :: int) "
  assumes R9:
  " K_L_Spark_Declaration.word__last'' = (4294967295 :: int)
  "
  assumes R10:
  " K_L_Spark_Declaration.word__base__first'' = (0 :: int)
  "
  assumes R11:
  " K_L_Spark_Declaration.word__base__last'' = (4294967295 :: int)
  "
  assumes R12:
  " K_L_Spark_Declaration.word__modulus'' = (4294967296 :: int)
  "
  assumes R13:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes R14:
  " K_L_Spark_Declaration.round_index__first'' = (0 :: int)
  "
  assumes R15:
  " K_L_Spark_Declaration.round_index__last'' = (79 :: int)
  "
  assumes R16:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes R17:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__first''
  "
  assumes R18:
  " K_L_Spark_Declaration.round_index__last''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H1: " (16 :: int) <= K_L_Spark_Declaration.j'' "
  assumes H2: " K_L_Spark_Declaration.j'' <= (31 :: int) "
  assumes H3:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes H4: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes H5:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes H6:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H7:
  " K_L_Spark_Declaration.round_index__base__first'' <= (0 :: int)
  "
  assumes H8:
  " (79 :: int) <= K_L_Spark_Declaration.round_index__base__last''
  "
  shows " (1518500249 :: int) = K_L_Spark_Specification.k_l' K_L_Spark_Declaration.j''
        " (is "?C1")
apply (insert assms) by (rule userlemmas)

lemma goal8'1:
  assumes R1:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes R2:
  " K_L_Spark_Declaration.interfaces__unsigned_32__first'' = (0 :: int)
  "
  assumes R3:
  " K_L_Spark_Declaration.interfaces__unsigned_32__last''
    = (4294967295 :: int)
  "
  assumes R4:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__first''
    = (0 :: int)
  "
  assumes R5:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__last''
    = (4294967295 :: int)
  "
  assumes R6:
  " K_L_Spark_Declaration.interfaces__unsigned_32__modulus''
    = (4294967296 :: int)
  "
  assumes R7: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes R8: " K_L_Spark_Declaration.word__first'' = (0 :: int) "
  assumes R9:
  " K_L_Spark_Declaration.word__last'' = (4294967295 :: int)
  "
  assumes R10:
  " K_L_Spark_Declaration.word__base__first'' = (0 :: int)
  "
  assumes R11:
  " K_L_Spark_Declaration.word__base__last'' = (4294967295 :: int)
  "
  assumes R12:
  " K_L_Spark_Declaration.word__modulus'' = (4294967296 :: int)
  "
  assumes R13:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes R14:
  " K_L_Spark_Declaration.round_index__first'' = (0 :: int)
  "
  assumes R15:
  " K_L_Spark_Declaration.round_index__last'' = (79 :: int)
  "
  assumes R16:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes R17:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__first''
  "
  assumes R18:
  " K_L_Spark_Declaration.round_index__last''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H1: " (32 :: int) <= K_L_Spark_Declaration.j'' "
  assumes H2: " K_L_Spark_Declaration.j'' <= (47 :: int) "
  assumes H3:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes H4: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes H5:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes H6:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H7:
  " K_L_Spark_Declaration.round_index__base__first'' <= (0 :: int)
  "
  assumes H8:
  " (79 :: int) <= K_L_Spark_Declaration.round_index__base__last''
  "
  shows " (1859775393 :: int) = K_L_Spark_Specification.k_l' K_L_Spark_Declaration.j''
        " (is "?C1")
apply (insert assms) by (rule userlemmas)

lemma goal9'1:
  assumes R1:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes R2:
  " K_L_Spark_Declaration.interfaces__unsigned_32__first'' = (0 :: int)
  "
  assumes R3:
  " K_L_Spark_Declaration.interfaces__unsigned_32__last''
    = (4294967295 :: int)
  "
  assumes R4:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__first''
    = (0 :: int)
  "
  assumes R5:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__last''
    = (4294967295 :: int)
  "
  assumes R6:
  " K_L_Spark_Declaration.interfaces__unsigned_32__modulus''
    = (4294967296 :: int)
  "
  assumes R7: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes R8: " K_L_Spark_Declaration.word__first'' = (0 :: int) "
  assumes R9:
  " K_L_Spark_Declaration.word__last'' = (4294967295 :: int)
  "
  assumes R10:
  " K_L_Spark_Declaration.word__base__first'' = (0 :: int)
  "
  assumes R11:
  " K_L_Spark_Declaration.word__base__last'' = (4294967295 :: int)
  "
  assumes R12:
  " K_L_Spark_Declaration.word__modulus'' = (4294967296 :: int)
  "
  assumes R13:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes R14:
  " K_L_Spark_Declaration.round_index__first'' = (0 :: int)
  "
  assumes R15:
  " K_L_Spark_Declaration.round_index__last'' = (79 :: int)
  "
  assumes R16:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes R17:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__first''
  "
  assumes R18:
  " K_L_Spark_Declaration.round_index__last''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H1: " (48 :: int) <= K_L_Spark_Declaration.j'' "
  assumes H2: " K_L_Spark_Declaration.j'' <= (63 :: int) "
  assumes H3:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes H4: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes H5:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes H6:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H7:
  " K_L_Spark_Declaration.round_index__base__first'' <= (0 :: int)
  "
  assumes H8:
  " (79 :: int) <= K_L_Spark_Declaration.round_index__base__last''
  "
  shows " (2400959708 :: int) = K_L_Spark_Specification.k_l' K_L_Spark_Declaration.j''
        " (is "?C1")
apply (insert assms) by (rule userlemmas)

lemma goal10'1:
  assumes R1:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes R2:
  " K_L_Spark_Declaration.interfaces__unsigned_32__first'' = (0 :: int)
  "
  assumes R3:
  " K_L_Spark_Declaration.interfaces__unsigned_32__last''
    = (4294967295 :: int)
  "
  assumes R4:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__first''
    = (0 :: int)
  "
  assumes R5:
  " K_L_Spark_Declaration.interfaces__unsigned_32__base__last''
    = (4294967295 :: int)
  "
  assumes R6:
  " K_L_Spark_Declaration.interfaces__unsigned_32__modulus''
    = (4294967296 :: int)
  "
  assumes R7: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes R8: " K_L_Spark_Declaration.word__first'' = (0 :: int) "
  assumes R9:
  " K_L_Spark_Declaration.word__last'' = (4294967295 :: int)
  "
  assumes R10:
  " K_L_Spark_Declaration.word__base__first'' = (0 :: int)
  "
  assumes R11:
  " K_L_Spark_Declaration.word__base__last'' = (4294967295 :: int)
  "
  assumes R12:
  " K_L_Spark_Declaration.word__modulus'' = (4294967296 :: int)
  "
  assumes R13:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes R14:
  " K_L_Spark_Declaration.round_index__first'' = (0 :: int)
  "
  assumes R15:
  " K_L_Spark_Declaration.round_index__last'' = (79 :: int)
  "
  assumes R16:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes R17:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__first''
  "
  assumes R18:
  " K_L_Spark_Declaration.round_index__last''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H1: " (0 :: int) <= K_L_Spark_Declaration.j'' "
  assumes H2: " K_L_Spark_Declaration.j'' <= (79 :: int) "
  assumes H3: " (15 :: int) < K_L_Spark_Declaration.j'' "
  assumes H4: " (31 :: int) < K_L_Spark_Declaration.j'' "
  assumes H5: " (47 :: int) < K_L_Spark_Declaration.j'' "
  assumes H6: " (63 :: int) < K_L_Spark_Declaration.j'' "
  assumes H7:
  " (0 :: int) <= K_L_Spark_Declaration.interfaces__unsigned_32__size''
  "
  assumes H8: " (0 :: int) <= K_L_Spark_Declaration.word__size'' "
  assumes H9:
  " (0 :: int) <= K_L_Spark_Declaration.round_index__size''
  "
  assumes H10:
  " K_L_Spark_Declaration.round_index__base__first''
    <= K_L_Spark_Declaration.round_index__base__last''
  "
  assumes H11:
  " K_L_Spark_Declaration.round_index__base__first'' <= (0 :: int)
  "
  assumes H12:
  " (79 :: int) <= K_L_Spark_Declaration.round_index__base__last''
  "
  shows " (2840853838 :: int) = K_L_Spark_Specification.k_l' K_L_Spark_Declaration.j''
        " (is "?C1")
apply (insert assms) by (rule userlemmas)
end


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

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

theory SepFrame
imports SepTactic
begin

class heap_state_type'

instance heap_state_type' \<subseteq> type ..

consts
  hst_mem :: "'a::heap_state_type' \<Rightarrow> heap_mem"
  hst_mem_update :: "(heap_mem \<Rightarrow> heap_mem) \<Rightarrow> 'a::heap_state_type' \<Rightarrow> 'a"
  hst_htd :: "'a::heap_state_type' \<Rightarrow> heap_typ_desc"
  hst_htd_update :: "(heap_typ_desc \<Rightarrow> heap_typ_desc) \<Rightarrow> 'a::heap_state_type' \<Rightarrow> 'a"

class heap_state_type = heap_state_type' +
  assumes hst_htd_htd_update [simp]: "hst_htd (hst_htd_update d s) = d (hst_htd s)"
  assumes hst_mem_mem_update [simp]: "hst_mem (hst_mem_update h s) = h (hst_mem s)"
  assumes hst_htd_mem_update [simp]: "hst_htd (hst_mem_update h s) = hst_htd s"
  assumes hst_mem_htd_update [simp]: "hst_mem (hst_htd_update d s) = hst_mem s"

translations
  "s\<lparr> hst_mem := x\<rparr>" <= "CONST hst_mem_update (K_record x) s"
  "s\<lparr> hst_htd := x\<rparr>" <= "CONST hst_htd_update (K_record x) s"

definition lift_hst :: "'a::heap_state_type' \<Rightarrow> heap_state" where
  "lift_hst s \<equiv> lift_state (hst_mem s,hst_htd s)"

definition
  point_eq_mod :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> bool"
where
  "point_eq_mod f g X \<equiv> \<forall>x. x \<notin> X \<longrightarrow> f x = g x"

definition
  exec_fatal :: "('s,'b,'c) com \<Rightarrow> ('s,'b,'c) body \<Rightarrow> 's \<Rightarrow> bool"
where
  "exec_fatal C \<Gamma> s \<equiv> (\<exists>f. \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Fault f) \<or>
      (\<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Stuck)"

definition
  restrict_htd :: "'s::heap_state_type' \<Rightarrow> s_addr set \<Rightarrow> 's"
where
  "restrict_htd s X \<equiv> s\<lparr> hst_htd := restrict_s (hst_htd s) X \<rparr>"

definition
  restrict_safe_OK :: "'s \<Rightarrow> 's \<Rightarrow> ('s \<Rightarrow> ('s,'c) xstate) \<Rightarrow>
       s_addr set \<Rightarrow> ('s::heap_state_type','b,'c) com \<Rightarrow> ('s,'b,'c) body \<Rightarrow> bool"
where
  "restrict_safe_OK s t f X C \<Gamma> \<equiv>
      \<Gamma> \<turnstile> \<langle>C,(Normal (restrict_htd s X))\<rangle> \<Rightarrow> f (restrict_htd t X) \<and>
      point_eq_mod (lift_state (hst_mem t,hst_htd t))
          (lift_state (hst_mem s,hst_htd s)) X"

definition
  restrict_safe :: "'s \<Rightarrow> ('s,'c) xstate \<Rightarrow>
       ('s::heap_state_type','b,'c) com \<Rightarrow> ('s,'b,'c) body \<Rightarrow> bool"
where
  "restrict_safe s t C \<Gamma> \<equiv> \<forall>X. (case t of
      Normal t' \<Rightarrow> restrict_safe_OK s t' Normal X C \<Gamma> |
      Abrupt t' \<Rightarrow> restrict_safe_OK s t' Abrupt X C \<Gamma> |
      _ \<Rightarrow> False) \<or>
      exec_fatal C \<Gamma> (restrict_htd s X)"

definition
  mem_safe :: "('s::{heap_state_type',type},'b,'c) com \<Rightarrow>
               ('s,'b,'c) body \<Rightarrow> bool"
where
  "mem_safe C \<Gamma> \<equiv> \<forall>s t. \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> t \<longrightarrow>
      restrict_safe s t C \<Gamma>"

definition
  point_eq_mod_safe :: "'s::{heap_state_type',type} set \<Rightarrow>
     ('s \<Rightarrow> 's) \<Rightarrow> ('s \<Rightarrow> s_addr \<Rightarrow> 'c) \<Rightarrow> bool"
where
  "point_eq_mod_safe P f g \<equiv> \<forall>s X. restrict_htd s X \<in> P \<longrightarrow>
      point_eq_mod (g (f s)) (g s) X"

definition
  comm_restrict :: "('s::{heap_state_type',type} \<Rightarrow> 's) \<Rightarrow> 's \<Rightarrow> s_addr set \<Rightarrow> bool"
where
  "comm_restrict f s X \<equiv> f (restrict_htd s X) = restrict_htd (f s) X"

definition
  comm_restrict_safe :: "'s set \<Rightarrow> ('s::{heap_state_type',type} \<Rightarrow> 's) \<Rightarrow> bool"
where
  "comm_restrict_safe P f \<equiv> \<forall>s X. restrict_htd s X \<in> P \<longrightarrow>
      comm_restrict f s X"

definition htd_ind :: "('a::{heap_state_type',type} \<Rightarrow> 'b) \<Rightarrow> bool" where
  "htd_ind f \<equiv> \<forall>x s. f s = f (hst_htd_update x s)"

definition mono_guard :: "'s::{heap_state_type',type} set \<Rightarrow> bool" where
  "mono_guard P \<equiv> \<forall>s X. restrict_htd s X \<in> P \<longrightarrow> s \<in> P"

definition expr_htd_ind :: "'s::{heap_state_type',type} set \<Rightarrow> bool" where
  "expr_htd_ind P \<equiv> \<forall>d s. s\<lparr> hst_htd := d \<rparr> \<in> P = (s \<in> P)"

primrec intra_safe :: "('s::heap_state_type','b,'c) com \<Rightarrow>  bool"
where
  "intra_safe Skip = True"
| "intra_safe (Basic f) = (comm_restrict_safe UNIV f \<and>
      point_eq_mod_safe UNIV f (\<lambda>s. lift_state (hst_mem s,hst_htd s)))"
| "intra_safe (Spec r) = (\<forall>\<Gamma>. mem_safe (Spec r) (\<Gamma> :: ('s,'b,'c) body))"
| "intra_safe (Seq C D) = (intra_safe C \<and> intra_safe D)"
| "intra_safe (Cond P C D) = (expr_htd_ind P \<and> intra_safe C \<and> intra_safe D)"
| "intra_safe (While P C) = (expr_htd_ind P \<and> intra_safe C)"
| "intra_safe (Call p) = True"
| "intra_safe (DynCom f) = (htd_ind f \<and> (\<forall>s. intra_safe (f s)))"
| "intra_safe (Guard f P C) = (mono_guard P \<and> (case C of
      Basic g \<Rightarrow> comm_restrict_safe P g \<and> (*point_eq_mod_safe P g hst_mem \<and> *)

                     point_eq_mod_safe P g (\<lambda>s. lift_state (hst_mem s,hst_htd s))
      | _ \<Rightarrow> intra_safe C))"
| "intra_safe Throw = True"
| "intra_safe (Catch C D) = (intra_safe C \<and> intra_safe D)"

instance state_ext :: (heap_state_type',type) heap_state_type' ..

defs (overloaded)
  hs_mem_state [simp]: "hst_mem \<equiv> hst_mem \<circ> globals"
  hs_mem_update_state [simp]: "hst_mem_update \<equiv> globals_update \<circ> hst_mem_update"
  hs_htd_state[simp]: "hst_htd \<equiv> hst_htd \<circ> globals"
  hs_htd_update_state [simp]: "hst_htd_update \<equiv> globals_update \<circ> hst_htd_update"

instance state_ext :: (heap_state_type,type) heap_state_type
  apply intro_classes
  apply auto
  done

primrec
  intra_deps :: "('s','b,'c) com \<Rightarrow> 'b set"
where
  "intra_deps Skip = {}"
| "intra_deps (Basic f) = {}"
| "intra_deps (Spec r) = {}"
| "intra_deps (Seq C D) = (intra_deps C \<union> intra_deps D)"
| "intra_deps (Cond P C D) = (intra_deps C \<union> intra_deps D)"
| "intra_deps (While P C) = intra_deps C"
| "intra_deps (Call p) = {p}"
| "intra_deps (DynCom f) = \<Union>{intra_deps (f s) | s. True}"
| "intra_deps (Guard f P C) = intra_deps C"
| "intra_deps Throw = {}"
| "intra_deps (Catch C D) = (intra_deps C \<union> intra_deps D)"

inductive_set
  proc_deps :: "('s','b,'c) com \<Rightarrow> ('s,'b,'c) body \<Rightarrow> 'b set"
  for "C" :: "('s','b,'c) com"
  and "\<Gamma>" :: "('s,'b,'c) body"
where
  "x \<in> intra_deps C \<Longrightarrow> x \<in> proc_deps C \<Gamma>"
| "\<lbrakk> x \<in> proc_deps C \<Gamma>; \<Gamma> x = Some D; y \<in> intra_deps D \<rbrakk> \<Longrightarrow> y \<in> proc_deps C \<Gamma>"

text {* ---- *}

lemma point_eq_mod_refl [simp]:
  "point_eq_mod f f X"
  by (simp add: point_eq_mod_def)

lemma point_eq_mod_subs:
  "\<lbrakk> point_eq_mod f g Y; Y \<subseteq> X \<rbrakk> \<Longrightarrow> point_eq_mod f g X"
  by (force simp: point_eq_mod_def)

lemma point_eq_mod_trans:
  "\<lbrakk> point_eq_mod x y X; point_eq_mod y z X \<rbrakk> \<Longrightarrow> point_eq_mod x z X"
  by (force simp: point_eq_mod_def)

lemma mem_safe_NormalD:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Normal t; mem_safe C \<Gamma>;
      \<not> exec_fatal C \<Gamma> (restrict_htd s X) \<rbrakk> \<Longrightarrow>
      (\<Gamma> \<turnstile> \<langle>C,(Normal (restrict_htd s X))\<rangle> \<Rightarrow> Normal (restrict_htd t X) \<and>
       point_eq_mod (lift_state (hst_mem t,hst_htd t))
          (lift_state (hst_mem s,hst_htd s)) X)"
  by (force simp: mem_safe_def restrict_safe_def restrict_safe_OK_def)

lemma mem_safe_AbruptD:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Abrupt t; mem_safe C \<Gamma>;
      \<not> exec_fatal C \<Gamma> (restrict_htd s X) \<rbrakk> \<Longrightarrow>
      (\<Gamma> \<turnstile> \<langle>C,(Normal (restrict_htd s X))\<rangle> \<Rightarrow> Abrupt (restrict_htd t X) \<and>
       point_eq_mod (lift_state (hst_mem t,hst_htd t))
          (lift_state (hst_mem s,hst_htd s)) X)"
  by (force simp: mem_safe_def restrict_safe_def restrict_safe_OK_def)

lemma mem_safe_FaultD:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Fault f; mem_safe C \<Gamma> \<rbrakk> \<Longrightarrow>
      exec_fatal C \<Gamma> (restrict_htd s X)"
  by (force simp: mem_safe_def restrict_safe_def)

lemma mem_safe_StuckD:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Stuck; mem_safe C \<Gamma> \<rbrakk> \<Longrightarrow>
      exec_fatal C \<Gamma> (restrict_htd s X)"
  by (force simp: mem_safe_def restrict_safe_def)

lemma lift_state_d_restrict [simp]:
  "lift_state (h,(restrict_s d X)) = lift_state (h,d) |` X"
  by (auto simp: lift_state_def restrict_map_def restrict_s_def intro!: ext split: s_heap_index.splits)

lemma dom_merge_restrict [simp]:
  "(x ++ y) |` dom y = y"
  by (force simp: restrict_map_def None_com intro: ext)

lemma dom_compl_restrict [simp]:
  "x |` (UNIV - dom x) = empty"
  by (force simp: restrict_map_def intro: ext)

lemma lift_state_point_eq_mod:
  "\<lbrakk> point_eq_mod (lift_state (h,d)) (lift_state (h',d')) X \<rbrakk> \<Longrightarrow>
      lift_state (h,d) |` (UNIV - X) =
          lift_state (h',d') |` (UNIV - X)"
  by (auto simp: point_eq_mod_def restrict_map_def intro: ext)

lemma htd_'_update_ind [simp]:
  "htd_ind f \<Longrightarrow> f (hst_htd_update x s) = f s"
  by (simp add: htd_ind_def)

lemma sep_frame':
  assumes orig_spec:  "\<forall>s. \<Gamma> \<turnstile> \<lbrace>s. P (f \<acute>(\<lambda>x. x)) (lift_hst \<acute>(\<lambda>x. x))\<rbrace>
                               C
                               \<lbrace>Q (g s \<acute>(\<lambda>x. x)) (lift_hst \<acute>(\<lambda>x. x))\<rbrace>"
      and hi_f: "htd_ind f" and hi_g: "htd_ind g"
      and hi_g': "\<forall>s. htd_ind (g s)"
      and safe: "mem_safe (C::('s::heap_state_type,'b,'c) com) \<Gamma>"
  shows "\<forall>s. \<Gamma> \<turnstile> \<lbrace>s. (P (f \<acute>(\<lambda>x. x)) \<and>\<^sup>* R (h \<acute>(\<lambda>x. x))) (lift_hst \<acute>(\<lambda>x. x))\<rbrace>
                 C
                 \<lbrace>(Q (g s \<acute>(\<lambda>x. x)) \<and>\<^sup>* R (h s)) (lift_hst \<acute>(\<lambda>x. x))\<rbrace>"
proof (rule, rule hoare_complete, simp only: valid_def, clarify)
  fix ta x
  assume ev: "\<Gamma>\<turnstile> \<langle>C,Normal x\<rangle> \<Rightarrow> ta" and
      pre: "(P (f x) \<and>\<^sup>* R (h x)) (lift_hst x)"
  then obtain s\<^sub>0 and s\<^sub>1 where pre_P: "P (f x) s\<^sub>0" and pre_R: "R (h x) s\<^sub>1" and
      disj: "s\<^sub>0 \<bottom> s\<^sub>1" and m: "lift_hst x = s\<^sub>1 ++ s\<^sub>0"
    by (clarsimp simp: sep_conj_def map_ac_simps)
  with orig_spec hi_f have nofault: "\<not> exec_fatal C \<Gamma>
      (restrict_htd x (dom s\<^sub>0))"
    by (force simp: exec_fatal_def image_def lift_hst_def cvalid_def valid_def
                    restrict_htd_def
              dest: hoare_sound)
  show "ta \<in> Normal ` {t. (Q (g x t) \<and>\<^sup>* R (h x)) (lift_hst t)}"
  proof (cases ta)
    case (Normal s)
    moreover with ev safe nofault have ev': "\<Gamma> \<turnstile>
        \<langle>C,Normal (x\<lparr> hst_htd := (restrict_s (hst_htd x) (dom s\<^sub>0)) \<rparr>)\<rangle> \<Rightarrow>
           Normal (s\<lparr> hst_htd := (restrict_s (hst_htd s) (dom s\<^sub>0)) \<rparr>)" and
        "point_eq_mod (lift_state (hst_mem s,hst_htd s))
            (lift_state (hst_mem x,hst_htd x)) (dom s\<^sub>0)"
      by (auto simp: restrict_htd_def dest: mem_safe_NormalD)
    moreover with m disj have "s\<^sub>1 = lift_hst s |` (UNIV - dom s\<^sub>0)"
apply -
apply(clarsimp simp: lift_hst_def)
apply(subst lift_state_point_eq_mod)
 apply(drule sym)
 apply clarsimp
 apply fast
apply(simp add: lift_hst_def lift_state_point_eq_mod map_add_restrict)
apply(subst restrict_map_subdom, auto dest: map_disjD)
done
    ultimately show ?thesis using orig_spec hi_f hi_g hi_g' pre_P pre_R m
      by (force simp: cvalid_def valid_def image_def lift_hst_def
                      map_disj_def
                intro: sep_conjI dest: hoare_sound)
  next
    case (Abrupt s) with ev safe nofault orig_spec pre_P hi_f m show ?thesis
      by - (simp, drule spec, drule hoare_sound, drule_tac X="dom s\<^sub>0" in
            mem_safe_AbruptD, assumption+,
            force simp: valid_def cvalid_def lift_hst_def restrict_htd_def)
  next
    case (Fault f) with ev safe nofault show ?thesis
      by (force dest: mem_safe_FaultD)
  next
    case Stuck with ev safe nofault show ?thesis
      by (force dest: mem_safe_StuckD)
  qed
qed

lemma sep_frame:
  "\<lbrakk> k = (\<lambda>s. (hst_mem s,hst_htd s));
      \<forall>s. \<Gamma> \<turnstile> \<lbrace>s. P (f \<acute>(\<lambda>x. x)) (lift_state (k \<acute>(\<lambda>x. x)))\<rbrace>
              C
              \<lbrace>Q (g s \<acute>(\<lambda>x. x)) (lift_state (k \<acute>(\<lambda>x. x)))\<rbrace>;
      htd_ind f; htd_ind g; \<forall>s. htd_ind (g s);
      mem_safe (C::('s::heap_state_type,'b,'c) com) \<Gamma> \<rbrakk> \<Longrightarrow>
      \<forall>s. \<Gamma> \<turnstile> \<lbrace>s. (P (f \<acute>(\<lambda>x. x)) \<and>\<^sup>* R (h \<acute>(\<lambda>x. x))) (lift_state (k \<acute>(\<lambda>x. x)))\<rbrace>
               C
               \<lbrace>(Q (g s \<acute>(\<lambda>x. x)) \<and>\<^sup>* R (h s)) (lift_state (k \<acute>(\<lambda>x. x)))\<rbrace>"
apply(simp only:)
apply(fold lift_hst_def)
apply(erule (4) sep_frame')
done

lemma point_eq_mod_safe [simp]:
  "\<lbrakk> point_eq_mod_safe P f g; restrict_htd s X \<in> P; x \<notin> X \<rbrakk> \<Longrightarrow>
      g (f s) x = (g s) x"
apply (simp add: point_eq_mod_safe_def point_eq_mod_def)
apply(case_tac x, force)
done

lemma comm_restrict_safe [simp]:
  "\<lbrakk> comm_restrict_safe P f; restrict_htd s X \<in> P \<rbrakk> \<Longrightarrow>
      restrict_htd (f s ) X = f (restrict_htd s X)"
  by (simp add: comm_restrict_safe_def comm_restrict_def)

lemma mono_guardD:
  "\<lbrakk> mono_guard P; restrict_htd s X \<in> P \<rbrakk> \<Longrightarrow> s \<in> P"
  by (unfold mono_guard_def, fast)

lemma expr_htd_ind:
  "expr_htd_ind P \<Longrightarrow> restrict_htd s X \<in> P = (s \<in> P)"
  by (simp add: expr_htd_ind_def restrict_htd_def)

lemma exec_fatal_Seq:
  "exec_fatal C \<Gamma> s \<Longrightarrow> exec_fatal (C;;D) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma exec_fatal_Seq2:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Normal t; exec_fatal D \<Gamma> t \<rbrakk> \<Longrightarrow> exec_fatal (C;;D) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma exec_fatal_Cond:
  "exec_fatal (Cond P C D) \<Gamma> s = (if s \<in> P then exec_fatal C \<Gamma> s else
      exec_fatal D \<Gamma> s)"
  by (force simp: exec_fatal_def intro: exec.intros
            elim: exec_Normal_elim_cases)

lemma exec_fatal_While:
  "\<lbrakk> exec_fatal C \<Gamma> s; s \<in> P \<rbrakk> \<Longrightarrow> exec_fatal (While P C) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros
            elim: exec_Normal_elim_cases)

lemma exec_fatal_While2:
  "\<lbrakk> exec_fatal (While P C) \<Gamma> t; \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Normal t; s \<in> P \<rbrakk> \<Longrightarrow>
      exec_fatal (While P C) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros
            elim: exec_Normal_elim_cases)

lemma exec_fatal_Call:
  "\<lbrakk> \<Gamma> p = Some C; exec_fatal C \<Gamma> s \<rbrakk> \<Longrightarrow> exec_fatal (Call p) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma exec_fatal_DynCom:
  "exec_fatal (f s) \<Gamma> s \<Longrightarrow> exec_fatal (DynCom f) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma exec_fatal_Guard:
  "exec_fatal (Guard f P C) \<Gamma> s = (s \<in> P \<longrightarrow> exec_fatal C \<Gamma> s)"
proof (cases "s \<in> P")
  case True thus ?thesis
    by (force simp: exec_fatal_def intro: exec.intros
              elim: exec_Normal_elim_cases)
next
  case False thus ?thesis
    by (force simp: exec_fatal_def intro: exec.intros)
qed

lemma restrict_safe_Guard:
  assumes restrict: "restrict_safe s t C \<Gamma>"
  shows "restrict_safe s t (Guard f P C) \<Gamma>"
proof (cases t)
  case (Normal s) with restrict show ?thesis
    by (force simp: restrict_safe_def restrict_safe_OK_def exec_fatal_Guard
              intro: exec.intros)
next
  case (Abrupt s) with restrict show ?thesis
    by (force simp: restrict_safe_def restrict_safe_OK_def exec_fatal_Guard
              intro: exec.intros)
next
  case (Fault f) with restrict show ?thesis
    by (force simp: restrict_safe_def exec_fatal_Guard)
next
  case Stuck with restrict show ?thesis
    by (force simp: restrict_safe_def exec_fatal_Guard)
qed

lemma restrict_safe_Guard2:
  "\<lbrakk> s \<notin> P; mono_guard P \<rbrakk> \<Longrightarrow> restrict_safe s (Fault f) (Guard f P C) \<Gamma>"
  by (force simp: restrict_safe_def exec_fatal_def intro: exec.intros
            dest: mono_guardD)

lemma exec_fatal_Catch:
  "exec_fatal C \<Gamma> s \<Longrightarrow> exec_fatal (TRY C CATCH D END) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma exec_fatal_Catch2:
  "\<lbrakk> \<Gamma> \<turnstile> \<langle>C,Normal s\<rangle> \<Rightarrow> Abrupt t; exec_fatal D \<Gamma> t \<rbrakk> \<Longrightarrow>
      exec_fatal (TRY C CATCH D END) \<Gamma> s"
  by (force simp: exec_fatal_def intro: exec.intros)

lemma intra_safe_restrict [rule_format]:
  assumes safe_env: "\<And>n C. \<Gamma> n = Some C \<Longrightarrow> intra_safe C" and
      exec: "\<Gamma> \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
  shows "\<forall>s'. s = Normal s' \<longrightarrow> intra_safe C \<longrightarrow> restrict_safe s' t C \<Gamma>"
using exec
proof induct
  case (Skip s) thus ?case
    by (force simp: restrict_safe_def restrict_safe_OK_def intro: exec.intros)
next
  case (Guard s' P C t f) show ?case
  proof (cases "\<exists>g. C = Basic g")
    case False with Guard show ?thesis
      by - (clarsimp, split com.splits, auto dest: restrict_safe_Guard)
  next
    case True with Guard show ?thesis
      by (cases t) (force simp: restrict_safe_def restrict_safe_OK_def
                                point_eq_mod_safe_def exec_fatal_Guard
                          intro: exec.intros
                          elim: exec_Normal_elim_cases,
                    (fast elim: exec_Normal_elim_cases)+)
  qed
next
  case (GuardFault C f P s) thus ?case
    by (force dest: restrict_safe_Guard2)
next
  case (FaultProp C f) thus ?case by simp
next
  case (Basic f s) thus ?case
    by (force simp: restrict_safe_def restrict_safe_OK_def point_eq_mod_safe_def
              intro: exec.intros)
next
  case (Spec r s t) thus ?case
    apply (clarsimp simp: mem_safe_def)
    apply (fastforce intro: exec.Spec)
    done
next
  case (SpecStuck r s) thus ?case
    apply clarsimp
    apply (erule_tac x=\<Gamma> in allE)
    apply (simp add: mem_safe_def)
    apply (erule allE, erule allE, erule impE, erule exec.SpecStuck)
    apply assumption
    done
next
  case (Seq C s sa D ta) show ?case
  proof (cases sa)
    case (Normal s') with Seq show ?thesis
      by (cases ta)
         (clarsimp simp: restrict_safe_def restrict_safe_OK_def,
          (drule_tac x=X in spec)+, auto intro: exec.intros point_eq_mod_trans
                                               exec_fatal_Seq exec_fatal_Seq2)+
  next
    case (Abrupt s') with Seq show ?thesis
      by (force simp: restrict_safe_def restrict_safe_OK_def
                intro: exec.intros dest: exec_fatal_Seq
                elim: exec_Normal_elim_cases)
  next
    case (Fault f) with Seq show ?thesis
      by (force simp: restrict_safe_def dest: exec_fatal_Seq
                elim: exec_Normal_elim_cases)
  next
    case Stuck with Seq show ?thesis
      by (force simp: restrict_safe_def dest: exec_fatal_Seq
                elim: exec_Normal_elim_cases)
  qed
next
  case (CondTrue s P C t D) thus ?case
    by (cases t)
       (auto simp: restrict_safe_def restrict_safe_OK_def exec_fatal_Cond
             intro: exec.intros dest: expr_htd_ind split: split_if_asm)
next
  case (CondFalse s P C t D) thus ?case
    by (cases t)
       (auto simp: restrict_safe_def restrict_safe_OK_def exec_fatal_Cond
             intro: exec.intros dest: expr_htd_ind split: split_if_asm)
next
  case (WhileTrue P C s s' t) show ?case
  proof (cases s')
    case (Normal sa) with WhileTrue show ?thesis
      by (cases t)
         (clarsimp simp: restrict_safe_def restrict_safe_OK_def,
          (drule_tac x=X in spec)+, auto simp: expr_htd_ind intro: exec.intros
               point_eq_mod_trans exec_fatal_While exec_fatal_While2)+
  next
    case (Abrupt sa) with WhileTrue show ?thesis
      by (force simp: restrict_safe_def restrict_safe_OK_def expr_htd_ind
                intro: exec.intros exec_fatal_While
                elim: exec_Normal_elim_cases)
  next
    case (Fault f) with WhileTrue show ?thesis
      by (force simp: restrict_safe_def expr_htd_ind intro: exec_fatal_While)
  next
    case Stuck with WhileTrue show ?thesis
      by (force simp: restrict_safe_def expr_htd_ind intro: exec_fatal_While)
  qed
next
  case (WhileFalse P C s) thus ?case
    by (force simp: restrict_safe_def restrict_safe_OK_def expr_htd_ind
              intro: exec.intros)
next
  case (Call C p s t) with safe_env show ?case
    by (cases t)
       (auto simp: restrict_safe_def restrict_safe_OK_def
             intro: exec_fatal_Call exec.intros)
next
  case (CallUndefined p s) thus ?case
    by (force simp: restrict_safe_def exec_fatal_def intro: exec.intros)

next
  case (StuckProp C) thus ?case by simp
next
  case (DynCom f s t) thus ?case
    by (cases t)
       (auto simp: restrict_safe_def restrict_safe_OK_def
                   restrict_htd_def
             intro!: exec.intros exec_fatal_DynCom)
next
  case (Throw s) thus ?case
    by (force simp: restrict_safe_def restrict_safe_OK_def intro: exec.intros)
next
  case (AbruptProp C s) thus ?case by simp
next
  case (CatchMatch C D s s' t) thus ?case
    by (cases t)
       (clarsimp simp: restrict_safe_def, drule_tac x=X in spec,
        auto simp: restrict_safe_OK_def intro: exec.intros point_eq_mod_trans
             dest: exec_fatal_Catch exec_fatal_Catch2)+
next
  case (CatchMiss C s t D) thus ?case
    by (cases t)
       (clarsimp simp: restrict_safe_def, drule_tac x=X in spec,
        auto simp: restrict_safe_OK_def intro: exec.intros
             dest: exec_fatal_Catch)+
qed

lemma intra_mem_safe:
  "\<lbrakk> \<And>n C. \<Gamma> n = Some C \<Longrightarrow> intra_safe C; intra_safe C \<rbrakk> \<Longrightarrow> mem_safe C \<Gamma>"
  by (force  simp: mem_safe_def intro: intra_safe_restrict)

lemma point_eq_mod_safe_triv:
  "(\<And>s. g (f s) = g s) \<Longrightarrow> point_eq_mod_safe P f g"
  by (simp add: point_eq_mod_safe_def point_eq_mod_def)

lemma comm_restrict_safe_triv:
  "(\<And>s X. f (s\<lparr> hst_htd := restrict_s (hst_htd s) X \<rparr>) =
      (f s)\<lparr> hst_htd := restrict_s (hst_htd (f s)) X \<rparr>) \<Longrightarrow> comm_restrict_safe P f"
  by (force simp: comm_restrict_safe_def comm_restrict_def restrict_htd_def)

lemma mono_guard_UNIV [simp]:
  "mono_guard UNIV"
  by (force simp: mono_guard_def)

lemma mono_guard_triv:
  "(\<And>s X. s\<lparr> hst_htd := X \<rparr> \<in> g \<Longrightarrow> s \<in> g) \<Longrightarrow> mono_guard g"
  by (unfold mono_guard_def, unfold restrict_htd_def, fast)

lemma mono_guard_triv2:
  "(\<And>s X. s\<lparr> hst_htd := X \<rparr> \<in> g = ((s::'a::heap_state_type') \<in> g)) \<Longrightarrow>
      mono_guard g"
  by (unfold mono_guard_def, unfold restrict_htd_def, fast)

lemma dom_restrict_s:
  "x \<in> dom_s (restrict_s d X) \<Longrightarrow> x \<in> dom_s d \<and> x \<in> X"
apply(auto simp: restrict_s_def dom_s_def split: split_if_asm)
done

lemma mono_guard_ptr_safe:
  "\<lbrakk> \<And>s. d s = hst_htd (s::'a::heap_state_type); htd_ind p \<rbrakk> \<Longrightarrow>
      mono_guard {s. ptr_safe (p s) (d s)}"
  apply (auto simp: mono_guard_def ptr_safe_def restrict_htd_def )
apply(drule (1) subsetD)
apply(drule dom_restrict_s)
apply simp
done

lemma point_eq_mod_safe_ptr_safe_update:
  "\<lbrakk> d = (hst_htd::'a::heap_state_type \<Rightarrow> heap_typ_desc);
      m = (\<lambda>s. hst_mem_update (heap_update (p s) ((v s)::'b::mem_type)) s);
      h = hst_mem; k = (\<lambda>s. lift_state (h s,d s)); htd_ind p \<rbrakk> \<Longrightarrow>
      point_eq_mod_safe {s. ptr_safe (p s) (d s)} m k"
  apply (auto simp: point_eq_mod_safe_def point_eq_mod_def ptr_safe_def heap_update_def
                 restrict_htd_def  lift_state_def
           intro!: heap_update_nmem_same split: s_heap_index.splits)
apply(subgoal_tac "(a,SIndexVal) \<in> s_footprint (p s)")
 apply(drule (1) subsetD)
 apply(drule dom_restrict_s, clarsimp)
apply(drule intvlD, clarsimp)
apply(erule s_footprintI2)
done

lemma field_ti_s_sub_typ:
  "field_lookup (export_uinfo (typ_info_t TYPE('b::mem_type))) f 0 = Some (typ_uinfo_t TYPE('a),b) \<Longrightarrow>
      s_footprint ((Ptr &(p\<rightarrow>f))::'a::mem_type ptr) \<subseteq> s_footprint (p::'b ptr)"
apply(drule field_ti_s_sub)
apply(simp add: s_footprint_def)
done

lemma ptr_safe_mono:
  "\<lbrakk> ptr_safe (p::'a::mem_type ptr) d; field_lookup (typ_info_t TYPE('a)) f 0
      = Some (t,n); export_uinfo t = typ_uinfo_t TYPE('b) \<rbrakk> \<Longrightarrow>
      ptr_safe ((Ptr &(p\<rightarrow>f))::'b::mem_type ptr) d"
apply(simp add: ptr_safe_def)
apply(drule field_lookup_export_uinfo_Some)
apply simp
apply(drule field_ti_s_sub_typ)
apply(erule (1) subset_trans)
done

lemma point_eq_mod_safe_ptr_safe_update_fl:
  "\<lbrakk> d = (hst_htd::'a::heap_state_type \<Rightarrow> heap_typ_desc);
      m = (\<lambda>s. hst_mem_update (heap_update (Ptr &((p s)\<rightarrow>f)) ((v s)::'b::mem_type)) s);
      h = hst_mem; k = (\<lambda>s. lift_state (h s,d s)); htd_ind p;
      field_lookup (typ_info_t TYPE('c)) f 0 = Some (t,n);
      export_uinfo t = typ_uinfo_t TYPE('b) \<rbrakk> \<Longrightarrow>
      point_eq_mod_safe {s. ptr_safe ((p::'a \<Rightarrow> 'c::mem_type ptr) s) (d s)} m k"
apply(drule (3) point_eq_mod_safe_ptr_safe_update)
 apply(simp only: htd_ind_def)
 apply clarify
apply(clarsimp simp: point_eq_mod_safe_def)
apply(drule_tac x=s in spec)
apply(drule_tac x=X in spec)
apply(erule impE)
 apply(erule (2) ptr_safe_mono)
apply simp
done

lemma point_eq_mod_safe_ptr_safe_tag:
  "\<lbrakk> d = (hst_htd::'a::heap_state_type \<Rightarrow> heap_typ_desc); h = hst_mem;
      m = (\<lambda>s. hst_htd_update (ptr_retyp (p s)) s);
      k = (\<lambda>s. lift_state (h s,d s));
      htd_ind p \<rbrakk> \<Longrightarrow>
      point_eq_mod_safe {s. ptr_safe ((p s)::'b::mem_type ptr) (d s)} m k"
apply(auto simp: point_eq_mod_safe_def point_eq_mod_def ptr_safe_def)
apply(subgoal_tac "(a,b) \<notin> s_footprint (p (restrict_htd s X))")
 prefer 2
 apply clarsimp
 apply(drule (1) subsetD)
 apply(clarsimp simp: restrict_htd_def)
 apply(drule dom_restrict_s, clarsimp)
 apply(thin_tac "P \<notin> Q" for P Q)
apply(auto simp: restrict_htd_def  lift_state_def split_def split: s_heap_index.splits split: option.splits)
     apply(subst (asm) ptr_retyp_d_eq_fst)
     apply(clarsimp split: split_if_asm)
     apply(erule notE)
     apply(drule intvlD, clarsimp)
     apply(erule s_footprintI2)
    apply(subst (asm) ptr_retyp_d_eq_fst)
    apply(clarsimp split: split_if_asm)
   apply(subst (asm) ptr_retyp_d_eq_snd)
   apply(clarsimp split: split_if_asm)
  apply(subst (asm) ptr_retyp_d_eq_snd)
  apply(clarsimp split: split_if_asm)
  apply(erule notE)
  apply(frule intvlD, clarsimp)
  apply(rule s_footprintI)
   apply(subst (asm) ptr_retyp_footprint)
    apply simp
   apply clarsimp
   apply(clarsimp simp: list_map_eq split: split_if_asm)
   apply(subst (asm) unat_of_nat)
   apply(subst (asm) mod_less)
    apply(subst len_of_addr_card)
    apply(erule less_trans)
    apply simp
   apply fast
  apply assumption
 apply(simp add: ptr_retyp_d_eq_snd)
 apply(clarsimp split: split_if_asm)
 apply(simp add: ptr_retyp_footprint)
 apply(clarsimp simp: list_map_eq split: split_if_asm)
 apply(erule notE)
 apply(drule intvlD, clarsimp)
 apply(rule s_footprintI)
  apply(subst (asm) unat_of_nat)
  apply(subst (asm) mod_less)
   apply(subst len_of_addr_card)
   apply(erule less_trans)
   apply simp
  apply assumption+
apply(simp add: ptr_retyp_d_eq_snd)
apply(clarsimp split: split_if_asm)
apply(simp add: ptr_retyp_footprint)
apply(clarsimp simp: list_map_eq split: split_if_asm)
apply(erule notE)
apply(drule intvlD, clarsimp)
apply(rule s_footprintI)
 apply(subst (asm) unat_of_nat)
 apply(subst (asm) mod_less)
  apply(subst len_of_addr_card)
  apply(erule less_trans)
  apply simp
 apply assumption+
apply(simp add: ptr_retyp_d_eq_snd)
apply(clarsimp split: split_if_asm)
apply(simp add: ptr_retyp_footprint)
apply(clarsimp simp: list_map_eq split: split_if_asm)
apply(erule notE)
apply(drule intvlD, clarsimp)
apply(rule s_footprintI)
 apply(subst (asm) unat_of_nat)
 apply(subst (asm) mod_less)
  apply(subst len_of_addr_card)
  apply(erule less_trans)
  apply simp
 apply assumption+
done

lemma comm_restrict_safe_ptr_safe_tag:
  fixes d::"'a::heap_state_type \<Rightarrow> heap_typ_desc"
  assumes fun_d: "d = hst_htd" and fun_upd:
      "m = (\<lambda>s. hst_htd_update (ptr_retyp (p s)) s)" and ind: "htd_ind p" and
      upd: "\<And>d d' (s::'a). hst_htd_update (d s) (hst_htd_update (d' s) s) =
                hst_htd_update ((d s) \<circ> (d' s)) s"
  shows "comm_restrict_safe {s. ptr_safe ((p s)::'b::mem_type ptr) (d s)}
          m"
proof (simp only: comm_restrict_safe_def comm_restrict_def, auto)
  fix s X
  assume "ptr_safe (p (restrict_htd s X)) (d (restrict_htd s X))"
  moreover from ind have p: "p (restrict_htd s X) = p s"
    by (simp add:  restrict_htd_def)
  ultimately have "ptr_retyp (p s) (restrict_s (hst_htd s) X) =
      restrict_s (ptr_retyp (p s) (hst_htd s))  X" using fun_d
apply -
apply(rule ext)
apply(auto simp: point_eq_mod_safe_def point_eq_mod_def ptr_safe_def)
apply(auto simp: restrict_htd_def )
apply(case_tac "x \<notin> {ptr_val (p s)..+size_of TYPE('b)}")
 apply(subst ptr_retyp_d)
  apply clarsimp
 apply(clarsimp simp: restrict_map_def restrict_s_def)
 apply(subst ptr_retyp_d)
  apply clarsimp
 apply simp
 apply(subst ptr_retyp_d)
  apply clarsimp
 apply simp
apply clarsimp
apply(subst ptr_retyp_footprint)
 apply fast
apply(clarsimp simp: restrict_map_def restrict_s_def)
apply(subst ptr_retyp_footprint)
 apply fast
apply simp
apply(subst ptr_retyp_footprint)
 apply fast
apply(rule)
 apply(subgoal_tac "(x,SIndexVal) \<in> s_footprint (p s)")
  apply(drule (1) subsetD)
  apply(clarsimp simp: dom_s_def)
 apply(drule intvlD, clarsimp)
 apply(erule s_footprintI2)
apply(rule ext)
apply(clarsimp simp: map_add_def list_map_eq)
apply(subgoal_tac "(x,SIndexTyp y) \<in> s_footprint (p s)")
 apply(drule (1) subsetD)
 apply(clarsimp simp: dom_s_def split: split_if_asm)
apply(drule intvlD, clarsimp)
apply(rule s_footprintI)
 apply(subst (asm) unat_simps)
 apply(subst (asm) mod_less)
  apply(subst len_of_addr_card)
  apply(erule less_trans)
  apply simp
 apply assumption+
done
  hence "((ptr_retyp (p s) \<circ> (%x _. x) (restrict_s (hst_htd s) X)::heap_typ_desc \<Rightarrow> heap_typ_desc) =
              (%x _. x) (restrict_s (ptr_retyp (p s) (hst_htd s)) X))"
    by - (rule ext, simp)
  moreover from upd have "hst_htd_update (ptr_retyp (p s))
        (hst_htd_update ((%x _. x) (restrict_s (hst_htd s) X)) s) =
         hst_htd_update (((ptr_retyp (p s)) \<circ> ((%x _. x) (restrict_s (hst_htd s) X)))) s" .
  moreover from upd have "hst_htd_update ((%x _. x) (restrict_s (ptr_retyp (p s) (hst_htd s)) X))
        (hst_htd_update (ptr_retyp (p s)) s) =
        hst_htd_update (((%x _. x) (restrict_s ((ptr_retyp (p s) (hst_htd s))) X)) \<circ> (ptr_retyp (p s)))
            s" .
  ultimately show "m (restrict_htd s X) =
          restrict_htd (m s) X" using fun_d fun_upd upd p
    by (simp add: restrict_htd_def o_def)
qed

lemmas intra_sc = hrs_comm comp_def hrs_htd_update_htd_update
  point_eq_mod_safe_triv comm_restrict_safe_triv mono_guard_triv2
  mono_guard_ptr_safe point_eq_mod_safe_ptr_safe_update
  point_eq_mod_safe_ptr_safe_tag comm_restrict_safe_ptr_safe_tag
  point_eq_mod_safe_ptr_safe_update_fl

declare expr_htd_ind_def [iff]
declare htd_ind_def [iff]

lemma proc_deps_Skip [simp]:
  "proc_deps Skip \<Gamma> = {}"
  by (force elim: proc_deps.induct)

lemma proc_deps_Basic [simp]:
  "proc_deps (Basic f) \<Gamma> = {}"
  by (force elim: proc_deps.induct)

lemma proc_deps_Spec [simp]:
  "proc_deps (Spec r) \<Gamma> = {}"
  by (force elim: proc_deps.induct)

lemma proc_deps_Seq [simp]:
  "proc_deps (Seq C D) \<Gamma> = proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
proof
  show "proc_deps (C;; D) \<Gamma> \<subseteq> proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
    by - (rule, erule proc_deps.induct, auto intro: proc_deps.intros)
next
  show "proc_deps C \<Gamma> \<union> proc_deps D \<Gamma> \<subseteq> proc_deps (C;; D) \<Gamma>"
    by auto (erule proc_deps.induct, auto intro: proc_deps.intros)+
qed

lemma proc_deps_Cond [simp]:
  "proc_deps (Cond P C D) \<Gamma> = proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
proof
  show "proc_deps (Cond P C D) \<Gamma> \<subseteq> proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
    by - (rule, erule proc_deps.induct, auto intro: proc_deps.intros)
next
  show "proc_deps C \<Gamma> \<union> proc_deps D \<Gamma> \<subseteq> proc_deps (Cond P C D) \<Gamma>"
    by auto (erule proc_deps.induct, auto intro: proc_deps.intros)+
qed

lemma proc_deps_While [simp]:
  "proc_deps (While P C) \<Gamma> = proc_deps C \<Gamma>"
  by auto (erule proc_deps.induct, auto intro: proc_deps.intros)+

lemma proc_deps_Guard [simp]:
  "proc_deps (Guard f P C) \<Gamma> = proc_deps C \<Gamma>"
  by auto (erule proc_deps.induct, auto intro: proc_deps.intros)+

lemma proc_deps_Throw [simp]:
  "proc_deps Throw \<Gamma> = {}"
  by (force elim: proc_deps.induct)

lemma proc_deps_Catch [simp]:
  "proc_deps (Catch  C D) \<Gamma> = proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
proof
  show "proc_deps (Catch C D) \<Gamma> \<subseteq> proc_deps C \<Gamma> \<union> proc_deps D \<Gamma>"
    by - (rule, erule proc_deps.induct, auto intro: proc_deps.intros)
next
  show "proc_deps C \<Gamma> \<union> proc_deps D \<Gamma> \<subseteq> proc_deps (Catch C D) \<Gamma>"
    by auto (erule proc_deps.induct, auto intro: proc_deps.intros)+
qed

lemma proc_deps_Call [simp]:
  "proc_deps (Call p) \<Gamma> = {p} \<union> (case \<Gamma> p of Some C \<Rightarrow>
      proc_deps C (\<Gamma>(p := None)) | _ \<Rightarrow> {})" (is "?X = ?Y \<union> ?Z")
proof
  show "?X \<subseteq> ?Y \<union> ?Z"
    by - (rule, erule proc_deps.induct,
          auto intro: proc_deps.intros,
          case_tac "xa = p", auto intro: proc_deps.intros split: option.splits)
next
  show "?Y \<union> ?Z \<subseteq> ?X"
  proof (clarsimp, rule)
    show "p \<in> ?X" by (force intro: proc_deps.intros)
  next
    show "?Z \<subseteq> ?X"
      by (split option.splits, rule, force intro: proc_deps.intros)
         (clarify, erule proc_deps.induct, (force intro: proc_deps.intros
          split: split_if_asm)+)
  qed
qed

lemma proc_deps_DynCom [simp]:
  "proc_deps (DynCom f) \<Gamma> = \<Union>{proc_deps (f s) \<Gamma> | s. True}"
  by auto (erule proc_deps.induct, force intro: proc_deps.intros,
           force intro: proc_deps.intros)+

lemma proc_deps_restrict:
  "proc_deps C \<Gamma> \<subseteq> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>"
proof rule
  fix xa
  assume mem: "xa \<in> proc_deps C \<Gamma>"
  hence "\<forall>p. xa \<in> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>" (is "?X")
  using mem
  proof induct
    fix x
    assume "x \<in> intra_deps C"
    thus "\<forall>p. x \<in> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>"
      by (force intro: proc_deps.intros)
  next
    fix D x y
    assume x:
      "x \<in> proc_deps C \<Gamma>"
      "x \<in> proc_deps C \<Gamma> \<Longrightarrow> \<forall>p. x \<in> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>"
      "\<Gamma> x = Some D"
      "y \<in> intra_deps D"
      "y \<in> proc_deps C \<Gamma>"
    show "\<forall>p. y \<in> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>"
    proof clarify
      fix p
      assume y: "y \<notin> proc_deps (Call p) \<Gamma>"
      show "y \<in> proc_deps C (\<Gamma>(p := None))"
      proof (cases "x=p")
        case True with x y show ?thesis
          by (force intro: proc_deps.intros)
      next
        case False with x y show ?thesis
          by (clarsimp, drule_tac x=p in spec)
             (auto intro: proc_deps.intros split: option.splits)
      qed
    qed
  qed
  thus "xa \<in> proc_deps C (\<Gamma>(p := None)) \<union> proc_deps (Call p) \<Gamma>" by simp
qed

lemma exec_restrict:
  assumes exec: "\<Gamma>' \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
  shows "\<And>\<Gamma> X. \<lbrakk> \<Gamma>' = \<Gamma> |` X; proc_deps C \<Gamma> \<subseteq> X \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
using exec
proof induct
  case Skip thus ?case by (fast intro: exec.intros)
next
  case (Guard C f P s' t) thus ?case by (force intro: exec.intros)
next
  case (GuardFault C f P s) thus ?case by (fast intro: exec.intros)
next
  case (FaultProp C f) thus ?case by simp
next
  case (Basic f s) thus ?case by (fast intro: exec.intros)
next
  case (Spec r s t) thus ?case by (fast intro: exec.intros)
next
  case (SpecStuck r s) thus ?case by (fast intro: exec.intros)
next
  case (Seq C D s sa ta) thus ?case by (force intro: exec.intros)
next
  case (CondTrue P C D s t) thus ?case by (force intro: exec.intros)
next
  case (CondFalse P C D s t) thus ?case by (force intro: exec.intros)
next
  case (WhileTrue P C s s' t) thus ?case by (force intro: exec.intros)
next
  case (WhileFalse P C s) thus ?case by (force intro: exec.intros)
next
  case (Call p C s t) thus ?case
    by - (insert proc_deps_restrict [of C \<Gamma> p], force intro: exec.intros)
next
  case (CallUndefined p s) thus ?case by (force intro: exec.intros)
next
  case (StuckProp C) thus ?case by simp
next
  case (DynCom f s t) thus ?case by (force intro: exec.intros)
next
  case (Throw s) thus ?case by (force intro: exec.intros)
next
  case (AbruptProp C s) thus ?case by simp
next
  case (CatchMatch C D s s' t) thus ?case by (force intro: exec.intros)
next
  case (CatchMiss C D s t) thus ?case by (force intro: exec.intros)
qed

lemma exec_restrict2:
  assumes exec: "\<Gamma> \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
  shows "\<And>X. proc_deps C \<Gamma> \<subseteq> X \<Longrightarrow> \<Gamma> |` X \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
using exec
proof induct
  case Skip thus ?case by (fast intro: exec.intros)
next
  case (Guard C f P s' t) thus ?case by (force intro: exec.intros)
next
  case (GuardFault C f P s) thus ?case by (fast intro: exec.intros)
next
  case (FaultProp C f) thus ?case by simp
next
  case (Basic f s) thus ?case by (fast intro: exec.intros)
next
  case (Spec r s t) thus ?case by (fast intro: exec.intros)
next
  case (SpecStuck r s) thus ?case by (fast intro: exec.intros)
next
  case (Seq C D s sa ta) thus ?case by (auto intro: exec.intros)
next
  case (CondTrue P C D s t) thus ?case
    by (force intro: exec.intros)
next
  case (CondFalse P C D s t) thus ?case
    by (force intro: exec.intros)
next
  case (WhileTrue P C s s' t) thus ?case by (auto intro: exec.intros)
next
  case (WhileFalse P C s) thus ?case by (force intro: exec.intros)
next
  case (Call p C s t) thus ?case
    by - (insert proc_deps_restrict [of C \<Gamma> p],
          auto intro!: exec.intros split: option.splits)
next
  case (CallUndefined p s) thus ?case by (force intro: exec.intros)
next
  case (StuckProp C) thus ?case by simp
next
  case (DynCom f s t) thus ?case
    by - (rule exec.intros, simp, blast)
next
  case (Throw s) thus ?case by (force intro: exec.intros)
next
  case (AbruptProp C s) thus ?case by simp
next
  case (CatchMatch C D s s' t) thus ?case by (auto intro: exec.intros)
next
  case (CatchMiss C D s t) thus ?case by (force intro: exec.intros)
qed

lemma exec_restrict_eq:
  "\<Gamma> |` proc_deps C \<Gamma> \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t = \<Gamma> \<turnstile> \<langle>C,s\<rangle> \<Rightarrow> t"
  by (fast intro: exec_restrict exec_restrict2)

lemma mem_safe_restrict:
  "mem_safe C \<Gamma> = mem_safe C (\<Gamma> |` proc_deps C \<Gamma>)"
  by (auto simp: mem_safe_def restrict_safe_def restrict_safe_OK_def
                 exec_restrict_eq exec_fatal_def
           split: xstate.splits)

end


section \<open>Array-Lists\<close>
theory LLVM_DS_Array_List
imports LLVM_DS_NArray
begin
  type_synonym ('a,'l) array_list = "'l word \<times> 'l word \<times> 'a narray"

  subsection \<open>Auxiliary Functions\<close>

  definition [llvm_inline]: "arl_initial_size \<equiv> return ((signed_nat (8::_::len word)))"

  definition arl_push_back' :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> 'a \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_inline]: "arl_push_back' al x \<equiv> doM {
      let (l,c,a) = al;
      array_upd a l x;
      l \<leftarrow> ll_add l (signed_nat 1);
      return (l,c,a)
    }"

  definition arl_aux_compute_size :: "'l::len2 word \<Rightarrow> 'l word \<Rightarrow> 'l word llM"
  where [llvm_inline]:
    "arl_aux_compute_size c c' \<equiv> doM {
      max::'l word \<leftarrow> ll_max_snat;
      max \<leftarrow> ll_udiv max (signed_nat 2);
      b \<leftarrow> ll_icmp_ule c max;
      llc_if b (doM {
          c \<leftarrow> ll_mul c (signed_nat 2);
          cok \<leftarrow> ll_icmp_sle c' c;
          llc_if cok (return c) (return c')
        })
        (return c')
    }"

  definition arl_resize :: "'l word \<Rightarrow> ('a::llvm_rep,'l::len2) array_list \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_code]: "arl_resize c' al \<equiv> doM {
      let (l,c,a) = al;
      c \<leftarrow> arl_aux_compute_size c c';
      a' \<leftarrow> narray_new TYPE('a) c;
      arraycpy a' a l;
      narray_free a;
      return (l,c,a')
    }"

  definition arl_ensure_capacity :: "'l word \<Rightarrow> ('a::llvm_rep,'l::len2) array_list \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_inline]: "arl_ensure_capacity c' al \<equiv> doM {
      let (l,c,a) = al;
      cok \<leftarrow> ll_icmp_sle c' c;
      llc_if cok (return (l,c,a)) (arl_resize c' (l,c,a))
    }"

  subsection \<open>Interface Functions\<close>

  definition arl_new_raw :: "('a::llvm_rep,'l::len2) array_list llM"
  where [llvm_code,llvm_inline]: "arl_new_raw \<equiv> doM {
    c \<leftarrow> arl_initial_size;
    a \<leftarrow> narray_new TYPE('a) c;
    return (signed_nat 0,c,a)
  }"

  definition arl_new :: "'a::llvm_rep itself \<Rightarrow> 'l::len2 itself \<Rightarrow> ('a,'l) array_list llM"
  where [llvm_inline]: "arl_new TYPE('a::llvm_rep) TYPE('l::len2) \<equiv> arl_new_raw"

  definition arl_new_sz_raw :: "'l::len2 word \<Rightarrow> ('a::llvm_rep,'l) array_list llM"
  where [llvm_code,llvm_inline]: "arl_new_sz_raw n \<equiv> doM {
    a \<leftarrow> narray_new TYPE('a) n;
    return (n,n,a)
  }"

  definition arl_new_sz :: "'a::llvm_rep itself \<Rightarrow> 'l::len2 word \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_inline]: "arl_new_sz TYPE('a) n \<equiv> arl_new_sz_raw n"

  definition arl_new_repl :: "'l::len2 word \<Rightarrow> 'a::llvm_rep \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_inline]: "arl_new_repl n x \<equiv> doM {
      a \<leftarrow> narray_new_init n x;
      return (n,n,a)
    }"

  definition arl_clear :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> ('a::llvm_rep,'l) array_list llM"
    where [llvm_code,llvm_inline]: "arl_clear al \<equiv> doM {
      let (l,c,a) = al;
      return (signed_nat 0,c,a)
    }"

  definition arl_free :: "('a::llvm_rep,'l::len) array_list \<Rightarrow> unit llM"
  where [llvm_code,llvm_inline]: "arl_free al \<equiv> doM {
    let (_,_,a) = al;
    narray_free a
  }"

  definition arl_nth :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> 'll::len2 word \<Rightarrow> 'a llM"
    where [llvm_code,llvm_inline]: "arl_nth al i \<equiv> doM {
      let (l,c,a) = al;
      array_nth a i
    }"

  definition arl_upd :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> 'll::len2 word \<Rightarrow> 'a \<Rightarrow> ('a,'l) array_list llM"
    where [llvm_code,llvm_inline]: "arl_upd al i x \<equiv> doM {
      let (l,c,a) = al;
      array_upd a i x;
      return (l,c,a)
    }"

  definition arl_len :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> 'l word llM"
    where [llvm_code,llvm_inline]: "arl_len al \<equiv> let (l,c,a) = al in return l"

  definition [llvm_code,llvm_inline]: "arl_push_back al x \<equiv> doM {
    l \<leftarrow> arl_len al;
    l \<leftarrow> ll_add l (signed_nat 1);
    al \<leftarrow> arl_ensure_capacity l al;
    arl_push_back' al x
  }"

  definition [llvm_code,llvm_inline]: "arl_pop_back al \<equiv> doM {
    let (l,c,a) = al;
    l \<leftarrow> ll_sub l (signed_nat 1);
    r \<leftarrow> array_nth a l;
    return (r,(l,c,a))
  }"

  definition [llvm_code,llvm_inline]: "arl_take l' al \<equiv> doM {
    let (l,c,a) = al;
    return (l',c,a)
  }"

  definition [llvm_code,llvm_inline]: "arl_last al \<equiv> doM {
    let (l,c,a) = al;
    l \<leftarrow> ll_sub l (signed_nat 1);
    r \<leftarrow> array_nth a l;
    return r
  }"

  definition [llvm_code,llvm_inline]: "arl_butlast al \<equiv> doM {
    let (l,c,a) = al;
    l \<leftarrow> ll_sub l (signed_nat 1);
    return (l,c,a)
  }"

  text \<open>Direct access to array underlying array-list \<close>
  definition array_of_arl :: "('a::llvm_rep,'l::len2) array_list \<Rightarrow> 'a ptr" where
    [llvm_inline]: "array_of_arl \<equiv> \<lambda>(l,c,a). a"

  export_llvm (debug) (no_header)
    "arl_new_raw :: (64 word,64) array_list llM" is "arl_new"
    "arl_new_sz_raw :: 64 word \<Rightarrow> (64 word,64) array_list llM"
    "arl_clear :: (64 word,64) array_list \<Rightarrow> (64 word,64) array_list llM"
    "arl_free :: (64 word,64) array_list \<Rightarrow> unit llM" is "arl_free"
    "arl_nth :: (64 word,64) array_list \<Rightarrow> 64 word \<Rightarrow> 64 word llM" is "arl_nth"
    "arl_upd :: (64 word,64) array_list \<Rightarrow> 64 word \<Rightarrow> 64 word \<Rightarrow> (64 word,64) array_list llM" is "arl_upd"
    "arl_len :: (64 word,64) array_list \<Rightarrow> 64 word llM" is "arl_len"
    "arl_push_back :: (64 word,64) array_list \<Rightarrow> 64 word \<Rightarrow> (64 word,64) array_list llM" is "arl_push_back"
    "arl_pop_back :: (64 word,64) array_list \<Rightarrow> (64 word \<times> (64 word,64) array_list) llM" is "arl_pop_back"
    "arl_take :: 64 word \<Rightarrow> (64 word,64) array_list \<Rightarrow> (64 word,64) array_list llM" is "arl_take"
    "arl_last :: (64 word,64) array_list \<Rightarrow> 64 word llM" is "arl_last"
    "arl_butlast :: (64 word,64) array_list \<Rightarrow> ((64 word,64) array_list) llM" is "arl_butlast"

  subsection \<open>Reasoning Setup\<close>

  definition arl_assn' :: "('a::llvm_rep list \<times> nat, 'l::len2 word \<times> 'l word \<times> 'a ptr) dr_assn"
    where "arl_assn' \<equiv> mk_assn (\<lambda>(xs,c) (li,ci,ai).
      EXS l a. \<upharpoonleft>snat.assn l li ** \<upharpoonleft>snat.assn c ci ** \<upharpoonleft>narray_assn a ai
        ** \<up>(LENGTH('l)>4 \<and> l\<le>c \<and> c=length a \<and> xs = take l a))"

  definition arl_assn :: "('a::llvm_rep list, 'l::len2 word \<times> 'l word \<times> 'a ptr) dr_assn"
    where "arl_assn \<equiv> mk_assn (\<lambda>xs ali. EXS c. \<upharpoonleft>arl_assn' (xs,c) ali)"

  subsubsection \<open>Auxiliary Rules\<close>

  lemma arl_aux_compute_size_rule[vcg_rules]:
    "llvm_htriple
      (\<up>\<^sub>d(LENGTH('a)>2) ** \<upharpoonleft>snat.assn c ci ** \<upharpoonleft>snat.assn c' ci' ** \<up>\<^sub>d(c\<le>c'))
      (arl_aux_compute_size ci (ci'::'a::len2 word))
      (\<lambda>ri. EXS r. \<upharpoonleft>snat.assn r ri ** \<up>(max c c' \<le> r))"
    unfolding arl_aux_compute_size_def
    apply (vcg_monadify)
    by vcg

  lemma arl_resize_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>snat.assn l li ** \<upharpoonleft>snat.assn c (ci::'l::len2 word) ** \<upharpoonleft>narray_assn a ai ** \<upharpoonleft>snat.assn c\<^sub>n ci\<^sub>n
        ** \<up>\<^sub>d(LENGTH('l)>2 \<and> c\<^sub>n>c \<and> l\<le>c \<and> c=length a)
      )
      (arl_resize ci\<^sub>n (li,ci,ai))
      (\<lambda>(li,ci,ai). EXS c' a'. \<upharpoonleft>snat.assn l li ** \<upharpoonleft>snat.assn c' ci ** \<upharpoonleft>narray_assn a' ai
        ** \<up>(c'\<ge>c\<^sub>n \<and> c'=length a' \<and> take l a' = take l a)
      )"
    unfolding arl_resize_def
    by vcg'

  lemma arl_ensure_capacity_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn' (al,oc) ali ** \<upharpoonleft>snat.assn c ci) (arl_ensure_capacity ci ali)
      (\<lambda>ali. EXS c'. \<upharpoonleft>arl_assn' (al,c') ali ** \<up>(c'\<ge>c))
    "
    unfolding arl_assn'_def arl_ensure_capacity_def
    by vcg

  lemma arl_push_back'_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn' (al,c) ali ** \<up>\<^sub>d(length al < c))
      (arl_push_back' ali x)
      (\<lambda>ali. EXS c. \<upharpoonleft>arl_assn' (al@[x],c) ali)"
    unfolding arl_assn'_def arl_push_back'_def
    apply (vcg_monadify)
    apply vcg'
    apply (auto simp: take_update_last)
    done

  lemma arl_len_rule_internal:
    "llvm_htriple (\<upharpoonleft>arl_assn' (al,c) ali) (arl_len ali) (\<lambda>li. \<upharpoonleft>arl_assn' (al,c) ali ** \<upharpoonleft>snat.assn (length al) li)"
    unfolding arl_assn'_def arl_len_def
    by vcg

  subsubsection \<open>Interface Rules\<close>

  lemma arl_new_raw_rule[vcg_rules]:
    "llvm_htriple (\<up>(LENGTH('l)>4)) (arl_new_raw) (\<lambda>ali. \<upharpoonleft>arl_assn [] (ali::(_,'l::len2)array_list))"
    unfolding arl_new_def arl_new_raw_def arl_initial_size_def arl_assn_def arl_assn'_def
    apply (vcg_monadify)
    by vcg'

  lemma arl_new_rule[vcg_rules]:
    "llvm_htriple (\<up>(LENGTH('c)>4)) (arl_new TYPE('a::llvm_rep) TYPE('c::len2)) (\<lambda>ali. \<upharpoonleft>arl_assn [] ali)"
    unfolding arl_new_def arl_new_raw_def arl_initial_size_def arl_assn_def arl_assn'_def
    apply (vcg_monadify)
    by vcg'

  lemma arl_new_sz_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>snat.assn n ni ** \<up>(LENGTH('c::len2)>4))
      (arl_new_sz TYPE('a::llvm_rep) (ni::'c word))
      (\<lambda>ali. \<upharpoonleft>arl_assn (replicate n init) ali)"
    unfolding arl_new_sz_def arl_new_sz_raw_def arl_initial_size_def arl_assn_def arl_assn'_def
    apply (vcg_monadify)
    by vcg'

  lemma arl_new_repl_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>snat.assn n ni ** \<up>(LENGTH('c::len2)>4))
      (arl_new_repl (ni::'c word) x)
      (\<lambda>ali. \<upharpoonleft>arl_assn (replicate n x) ali)"
    unfolding arl_new_repl_def arl_initial_size_def arl_assn_def arl_assn'_def
    apply (vcg_monadify)
    by vcg'

  lemma arl_assn_init_pure:
    "PRECOND (SOLVE_AUTO (4 < LENGTH('l))) \<Longrightarrow> \<box> \<turnstile> \<upharpoonleft>arl_assn [] (init::(_,'l::len2)array_list)"
    unfolding arl_assn_def arl_assn'_def vcg_tag_defs
    unfolding snat.assn_def snat_invar_def
    supply [fri_rules] = narray_assn_init_pure
    apply simp
    apply (rule ENTAILSD)
    by vcg

  lemma arl_clear_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn al ali)
      (arl_clear ali)
      (\<lambda>ali. \<upharpoonleft>arl_assn [] ali)"
    unfolding arl_clear_def arl_assn_def arl_assn'_def
    by (vcg_monadify) vcg'

  lemma arl_free_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al ali) (arl_free ali) (\<lambda>_. \<box>)"
    unfolding arl_assn_def arl_assn'_def arl_free_def
    by vcg

  lemma arl_nth_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn al ali ** \<upharpoonleft>snat.assn i ii ** \<up>\<^sub>d(i<length al))
      (arl_nth ali ii)
      (\<lambda>x. \<upharpoonleft>arl_assn al ali ** \<up>(x = al!i))"
    unfolding arl_assn_def arl_assn'_def arl_nth_def
    by vcg

  lemma array_of_arl_nth_rule[vcg_rules]: "llvm_htriple
    (\<upharpoonleft>arl_assn xs a ** \<upharpoonleft>snat.assn i ii ** \<up>(i < length xs))
    (array_nth (array_of_arl a) ii)
    (\<lambda>x. \<upharpoonleft>arl_assn xs a ** \<up>(x = xs!i))"
    unfolding arl_assn_def arl_assn'_def array_of_arl_def by vcg

  lemma arl_upd_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn al ali ** \<upharpoonleft>snat.assn i ii ** \<up>\<^sub>d(i<length al))
      (arl_upd ali ii x)
      (\<lambda>ali'. \<upharpoonleft>arl_assn (al[i:=x]) ali' ** \<up>(ali' = ali))"
    unfolding arl_assn_def arl_assn'_def arl_upd_def
    by vcg

  lemma arl_len_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al ali) (arl_len ali) (\<lambda>li. \<upharpoonleft>arl_assn al ali ** \<upharpoonleft>snat.assn (length al) li)"
    unfolding arl_assn_def
    supply arl_len_rule_internal[vcg_rules]
    by vcg

  lemma arl_push_back_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al (ali::(_,'l::len2)array_list) ** \<up>\<^sub>d(length al + 1 < max_snat LENGTH('l))) (arl_push_back ali x) (\<lambda>ali. \<upharpoonleft>arl_assn (al@[x]) ali)"
    unfolding arl_assn_def arl_push_back_def
    supply arl_len_rule_internal[vcg_rules]
    apply (vcg_monadify)
    by vcg'

  lemma arl_pop_back_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al (ali::(_,'l::len2)array_list) ** \<up>\<^sub>d(al\<noteq>[])) (arl_pop_back ali) (\<lambda>(x,ali). \<upharpoonleft>arl_assn (butlast al) ali ** \<up>(x=last al))"
    unfolding arl_assn_def arl_assn'_def arl_pop_back_def
    supply arl_len_rule_internal[vcg_rules]
    apply (vcg_monadify)
    apply vcg'
    by (auto simp: take_minus_one_conv_butlast last_take_nth_conv)

  lemma arl_take_rule[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>arl_assn al (ali::(_,'l::len2)array_list) ** \<upharpoonleft>snat.assn l li ** \<up>\<^sub>d(l \<le> length al))
      (arl_take li ali)
      (\<lambda>ali. \<upharpoonleft>arl_assn (take l al) ali)"
    unfolding arl_assn_def arl_assn'_def arl_take_def
    by vcg

  lemma arl_last_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al (ali::(_,'l::len2)array_list) ** \<up>\<^sub>d(al\<noteq>[])) (arl_last ali) (\<lambda>x. \<upharpoonleft>arl_assn al ali ** \<up>(x=last al))"
    unfolding arl_assn_def arl_assn'_def arl_last_def
    supply arl_len_rule_internal[vcg_rules]
    apply (vcg_monadify)
    apply vcg'
    by (auto simp: last_take_nth_conv)

  lemma arl_butlast_rule[vcg_rules]:
    "llvm_htriple (\<upharpoonleft>arl_assn al (ali::(_,'l::len2)array_list) ** \<up>\<^sub>d(al\<noteq>[])) (arl_butlast ali) (\<lambda>ali. \<upharpoonleft>arl_assn (butlast al) ali)"
    unfolding arl_assn_def arl_assn'_def arl_butlast_def
    supply arl_len_rule_internal[vcg_rules]
    apply (vcg_monadify)
    apply vcg'
    by (auto simp: take_minus_one_conv_butlast)

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_inv__29_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_germanSimp Protocol Case Study*}

theory n_germanSimp_lemma_inv__29_on_rules imports n_germanSimp_lemma_on_inv__29
begin
section{*All lemmas on causal relation between inv__29*}
lemma lemma_inv__29_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__29  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__0Vsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__1Vsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__29) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__29) done
    }

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

end


theory Eg1RefinementTrivial
imports Eg1
        "../CompositionalRefinement"
        Dependent_SIFUM_Type_Systems.TypeSystem
begin

sublocale sifum_example \<subseteq>
    sifum_refinement_same_mem dma \<C>_vars \<C> eval\<^sub>w eval\<^sub>w
      by(unfold_locales)

context sifum_example begin

text \<open>This predicate can be used to express arbitrary relational invariants for
  compiler-specific features, but for this trivial case the vacuous one is fine.
\<close>
definition P_true :: "('a \<times> 'a) set"
where
  "P_true  \<equiv> UNIV"

lemma Id_secure_refinement:
  "secure_refinement R Id P_true"
  unfolding secure_refinement_def
  proof(safe)
    show "closed_others Id"
    unfolding closed_others_def Id_def by blast
  next
    show "preserves_modes_mem Id"
    unfolding preserves_modes_mem_def Id_def by blast
  next
    fix c\<^sub>1\<^sub>A mds mem\<^sub>1 c\<^sub>1\<^sub>C c\<^sub>1\<^sub>C' mds' mem\<^sub>1'
    assume step: "(\<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C, \<langle>c\<^sub>1\<^sub>C', mds', mem\<^sub>1'\<rangle>\<^sub>C) \<in> eval\<^sub>w"
    show
      "\<exists>n c\<^sub>1\<^sub>A'.
          neval \<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C n \<langle>c\<^sub>1\<^sub>A', mds', mem\<^sub>1'\<rangle>\<^sub>C \<and>
          (\<langle>c\<^sub>1\<^sub>A', mds', mem\<^sub>1'\<rangle>\<^sub>C, \<langle>c\<^sub>1\<^sub>C', mds', mem\<^sub>1'\<rangle>\<^sub>C) \<in> Id \<and>
          (\<forall>c\<^sub>2\<^sub>A mem\<^sub>2 c\<^sub>2\<^sub>C c\<^sub>2\<^sub>A' mem\<^sub>2'.
              (\<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> R \<and>
              (\<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> Id \<and>
              (\<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> P_true \<and>
              neval \<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C n \<langle>c\<^sub>2\<^sub>A', mds', mem\<^sub>2'\<rangle>\<^sub>C \<longrightarrow>
              (\<exists>c\<^sub>2\<^sub>C'.
                  (\<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C)
                  \<in> eval\<^sub>w \<and>
                  (\<langle>c\<^sub>2\<^sub>A', mds', mem\<^sub>2'\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C) \<in> Id \<and>
                  (\<langle>c\<^sub>1\<^sub>C', mds', mem\<^sub>1'\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C) \<in> P_true))"
    proof -
      let ?n = "Suc 0"
      let ?c\<^sub>1\<^sub>A' = c\<^sub>1\<^sub>C'
      from step have "neval \<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C ?n \<langle>?c\<^sub>1\<^sub>A', mds', mem\<^sub>1'\<rangle>\<^sub>C"
        by simp
      moreover have "(\<langle>?c\<^sub>1\<^sub>A', mds', mem\<^sub>1'\<rangle>\<^sub>C, \<langle>c\<^sub>1\<^sub>C', mds', mem\<^sub>1'\<rangle>\<^sub>C) \<in> Id"
        by simp
      moreover have "(\<forall>c\<^sub>2\<^sub>A mem\<^sub>2 c\<^sub>2\<^sub>C c\<^sub>2\<^sub>A' mem\<^sub>2'.
              (\<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> R \<and>
              (\<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> Id \<and>
              (\<langle>c\<^sub>1\<^sub>C, mds, mem\<^sub>1\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C) \<in> P_true \<and>
              neval \<langle>c\<^sub>2\<^sub>A, mds, mem\<^sub>2\<rangle>\<^sub>C ?n \<langle>c\<^sub>2\<^sub>A', mds', mem\<^sub>2'\<rangle>\<^sub>C \<longrightarrow>
              (\<exists>c\<^sub>2\<^sub>C'.
                  (\<langle>c\<^sub>2\<^sub>C, mds, mem\<^sub>2\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C)
                  \<in> eval\<^sub>w \<and>
                  (\<langle>c\<^sub>2\<^sub>A', mds', mem\<^sub>2'\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C) \<in> Id \<and>
                  (\<langle>c\<^sub>1\<^sub>C', mds', mem\<^sub>1'\<rangle>\<^sub>C, \<langle>c\<^sub>2\<^sub>C', mds', mem\<^sub>2'\<rangle>\<^sub>C) \<in> P_true))"
        using step
        unfolding P_true_def
        by clarsimp
      ultimately show ?thesis by blast
    qed
  next
    show "closed_glob_consistent P_true"
      by(auto simp: closed_glob_consistent_def P_true_def)
  qed

text \<open>
  This doesn't really mean much, but shows the lemmas in action.
  (I suspect that @{term "R\<^sub>C_of R Id"} is equivalent to @{term R}. But who cares?)
\<close>
lemma "strong_low_bisim_mm (gen_refine.R\<^sub>C_of (\<R> \<Gamma> \<S> P) Id P_true)"
  apply(rule R\<^sub>C_of_strong_low_bisim_mm)
   apply(rule \<R>_bisim)
  apply(rule Id_secure_refinement)
  unfolding P_true_def sym_def apply blast
  done

end

end