section\<open>Network Security Policy Verification\<close>
theory Network_Security_Policy_Verification
imports
  TopoS_Interface
  TopoS_Interface_impl
  TopoS_Library
  TopoS_Composition_Theory
  TopoS_Stateful_Policy
  TopoS_Composition_Theory_impl
  TopoS_Stateful_Policy_Algorithm
  TopoS_Stateful_Policy_impl
  TopoS_Impl
begin

section\<open>A small Tutorial\<close>

text\<open>We demonstrate usage of the executable theory.\<close>
text\<open>Everything that is indented and starts with `Interlude:' summarizes the main correctness proofs and can be skipped if only the implementation is concerned\<close>

subsection\<open>Policy\<close>
text\<open>The secuity policy is a directed graph.\<close>
definition policy :: "nat list_graph" where
    "policy \<equiv> \<lparr> nodesL = [1,2,3],
                edgesL = [(1,2), (2,2), (2,3)] \<rparr>"

text\<open>It is syntactically well-formed\<close>
lemma wf_list_graph_policy: "wf_list_graph policy" by eval

text\<open>In contrast, this is not a syntactically well-formed graph.\<close>
lemma "\<not> wf_list_graph \<lparr> nodesL = [1,2]::nat list, edgesL = [(1,2), (2,2), (2,3)] \<rparr>" by eval

text\<open>Our @{const policy} has three rules.\<close>
lemma "length (edgesL policy) = 3" by eval

subsection\<open>Security Invariants\<close>
text\<open>We construct a security invariant. Node @{term "2::nat"} has confidential data\<close>

definition BLP_security_levels :: "nat \<rightharpoonup> SINVAR_BLPtrusted.node_config"where
  "BLP_security_levels \<equiv> [2 \<mapsto> \<lparr> security_level = 1, trusted = False \<rparr>]"

definition BLP_m::"(nat SecurityInvariant)" where
    "BLP_m \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_BLPtrusted \<lparr>
          node_properties = BLP_security_levels
          \<rparr> ''Two has confidential information''"

  text\<open>Interlude: @{const BLP_m} is a valid implementation of a SecurityInvariant\<close>
  definition BLP_m_spec :: "nat SecurityInvariant_configured option"where
    "BLP_m_spec \<equiv> new_configured_SecurityInvariant (
        SINVAR_BLPtrusted.sinvar,
        SINVAR_BLPtrusted.default_node_properties,
        SINVAR_BLPtrusted.receiver_violation,
        SecurityInvariant.node_props SINVAR_BLPtrusted.default_node_properties \<lparr>
          node_properties = BLP_security_levels
        \<rparr>)"
  text\<open>Fist, we need to show that the formal definition obeys all requirements, @{const new_configured_SecurityInvariant} verifies this. To double check, we manually give the configuration.\<close>
  lemma BLP_m_spec: assumes "nP = (\<lambda> v. (case BLP_security_levels v of Some c \<Rightarrow> c | None \<Rightarrow> SINVAR_BLPtrusted.default_node_properties))"
      shows "BLP_m_spec = Some \<lparr>
              c_sinvar = (\<lambda>G. SINVAR_BLPtrusted.sinvar G nP),
              c_offending_flows = (\<lambda>G. SecurityInvariant_withOffendingFlows.set_offending_flows SINVAR_BLPtrusted.sinvar G nP),
              c_isIFS = SINVAR_BLPtrusted.receiver_violation
            \<rparr>" (is "BLP_m_spec = Some ?Spec")
  proof -
    have NetModelLib: "TopoS_modelLibrary SINVAR_LIB_BLPtrusted SINVAR_BLPtrusted.sinvar"
    by(unfold_locales)
    from assms have nP: "nP = nm_node_props SINVAR_LIB_BLPtrusted \<lparr>
              node_properties = BLP_security_levels
            \<rparr>" by(simp add: fun_eq_iff SINVAR_LIB_BLPtrusted_def SINVAR_BLPtrusted_impl.NetModel_node_props_def)

    have "BLP_m_spec = new_configured_SecurityInvariant (SINVAR_BLPtrusted.sinvar, SINVAR_BLPtrusted.default_node_properties, SINVAR_BLPtrusted.receiver_violation, nP)"
    unfolding BLP_m_spec_def nP by(simp add: SINVAR_BLPtrusted_impl.NetModel_node_props_def SINVAR_LIB_BLPtrusted_def)
    also with TopoS_modelLibrary_yields_new_configured_SecurityInvariant[OF NetModelLib nP]
    have "\<dots> = Some ?Spec" by (simp add: SINVAR_LIB_BLPtrusted_def)
    finally show ?thesis by blast
  qed
  lemma valid_reqs_BLP: "valid_reqs [the BLP_m_spec]"
    by(simp add: valid_reqs_def)(metis BLP_m_spec_def BLPtrusted_impl.spec new_configured_SecurityInvariant.simps new_configured_SecurityInvariant_sound option.distinct(1) option.exhaust_sel)

  text\<open>Interlude: While @{const BLP_m} is executable code, we will now show that this executable code complies with its formal definition.\<close>
  lemma complies_BLP: "SecurityInvariant_complies_formal_def BLP_m (the BLP_m_spec)"
    unfolding BLP_m_def
    apply(rule new_configured_list_SecurityInvariant_complies)
       apply(simp_all add: BLP_m_spec_def)
     apply(unfold_locales)
    by(simp add: fun_eq_iff SINVAR_LIB_BLPtrusted_def SINVAR_BLPtrusted_impl.NetModel_node_props_def)

text\<open>We define the list of all security invariants of type @{typ "nat SecurityInvariant list"}.
     The type @{typ nat} is because the policy's nodes are of type @{typ nat}.\<close>
definition "security_invariants = [BLP_m]"

text\<open>We can see that the policy does not fulfill the security invariants.\<close>
lemma "\<not> all_security_requirements_fulfilled security_invariants policy" by eval

text\<open>We ask why. Obviously, node 2 leaks confidential data to node 3.\<close>
value "implc_get_offending_flows security_invariants policy"
lemma "implc_get_offending_flows security_invariants policy = [[(2, 3)]]" by eval

  text\<open>Interlude: the implementation @{const implc_get_offending_flows} corresponds to the formal definition @{const get_offending_flows}\<close>
  lemma "set ` set (implc_get_offending_flows (get_impl [(BLP_m, the BLP_m_spec)]) policy) = get_offending_flows (get_spec [(BLP_m, the BLP_m_spec)]) (list_graph_to_graph policy)"
  apply(rule implc_get_offending_flows_complies)
   by(simp_all add: complies_BLP wf_list_graph_policy)

text\<open>
Visualization of the violation (only in interactive mode)
\<close>
ML_val\<open>
visualize_graph @{context} @{term "security_invariants"} @{term "policy"};
\<close>

text\<open>Experimental: the config (only one) can be added to the end.\<close>
ML_val\<open>
visualize_graph_header @{context} @{term "security_invariants"} @{term "policy"} @{term "BLP_security_levels"};
\<close>

text\<open>
The policy has a flaw. We throw it away and generate a new one which fulfills the invariants.
\<close>
definition "max_policy = generate_valid_topology security_invariants \<lparr>nodesL = nodesL policy, edgesL = List.product (nodesL policy) (nodesL policy) \<rparr>"

  text\<open>Interlude: the implementation @{const implc_get_offending_flows} corresponds to the formal definition @{const get_offending_flows}\<close>
  thm generate_valid_topology_complies

  text\<open>Interlude: the formal definition is sound\<close>
  thm generate_valid_topology_sound

  text\<open>Here, it is also complete\<close>
  lemma "wf_graph G \<Longrightarrow> max_topo [the BLP_m_spec] (TopoS_Composition_Theory.generate_valid_topology [the BLP_m_spec] (fully_connected G))"
  apply(rule generate_valid_topology_max_topo[OF valid_reqs_BLP])
   apply(assumption)
  apply(simp add: BLP_m_spec)
  by blast

text\<open>Calculating the maximum policy\<close>
value "max_policy"
lemma "max_policy = \<lparr>nodesL = [1, 2, 3], edgesL = [(1, 1), (1, 2), (1, 3), (2, 2), (3, 1), (3, 2), (3, 3)]\<rparr>" by eval

text\<open>
Visualizing the maximum policy (only in interactive mode)
\<close>
ML\<open>
visualize_graph @{context} @{term "security_invariants"} @{term "max_policy"};
\<close>

text\<open>Of course, all security invariants hold for the maximum policy.\<close>
lemma "all_security_requirements_fulfilled security_invariants max_policy" by eval

subsection\<open>A stateful implementation\<close>
text\<open>We generate a stateful policy\<close>
definition "stateful_policy = generate_valid_stateful_policy_IFSACS_2 policy security_invariants"

text\<open>When thinking about it carefully, no flow can be stateful without introducing an information leakage here!\<close>
value "stateful_policy"
lemma "stateful_policy = \<lparr>hostsL = [1, 2, 3], flows_fixL = [(1, 2), (2, 2), (2, 3)], flows_stateL = []\<rparr>" by eval

  text\<open>Interlude: the stateful policy we are computing fulfills all the necessary properties\<close>
  thm generate_valid_stateful_policy_IFSACS_2_complies

  (*the individual algorithms fir IFS/ACS return a maximum policy*)
  thm filter_compliant_stateful_ACS_correct filter_compliant_stateful_ACS_maximal
  thm filter_IFS_no_violations_correct filter_IFS_no_violations_maximal

text\<open>
Visualizing the stateful policy (only in interactive mode)
\<close>
ML_val\<open>
visualize_edges @{context} @{term "flows_fixL stateful_policy"}
    [("edge [dir=\"arrow\", style=dashed, color=\"#FF8822\", constraint=false]", @{term "flows_stateL stateful_policy"})] "";
\<close>

text\<open>This is how it would look like if @{term "(3,1)"} were a stateful flow\<close>
ML_val\<open>
visualize_edges @{context} @{term "flows_fixL stateful_policy"}
    [("edge [dir=\"arrow\", style=dashed, color=\"#FF8822\", constraint=false]", @{term "[(3::nat,1::nat)]"})] "";
\<close>

hide_const policy security_invariants max_policy stateful_policy

end


section \<open>Instantiate CFG locale with While CFG\<close>

theory Interpretation imports
  WCFG
  "../Basic/CFGExit"
begin

subsection \<open>Instatiation of the \<open>CFG\<close> locale\<close>

abbreviation sourcenode :: "w_edge \<Rightarrow> w_node"
  where "sourcenode e \<equiv> fst e"

abbreviation targetnode :: "w_edge \<Rightarrow> w_node"
  where "targetnode e \<equiv> snd(snd e)"

abbreviation kind :: "w_edge \<Rightarrow> state edge_kind"
  where "kind e \<equiv> fst(snd e)"

definition valid_edge :: "cmd \<Rightarrow> w_edge \<Rightarrow> bool"
  where "valid_edge prog a \<equiv> prog \<turnstile> sourcenode a -kind a\<rightarrow> targetnode a"

definition valid_node ::"cmd \<Rightarrow> w_node \<Rightarrow> bool"
  where "valid_node prog n \<equiv>
    (\<exists>a. valid_edge prog a \<and> (n = sourcenode a \<or> n = targetnode a))"

lemma While_CFG_aux:
  "CFG sourcenode targetnode (valid_edge prog) Entry"
proof(unfold_locales)
  fix a assume "valid_edge prog a" and "targetnode a = (_Entry_)"
  obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
  with \<open>valid_edge prog a\<close> \<open>targetnode a = (_Entry_)\<close>
  have "prog \<turnstile> nx -et\<rightarrow> (_Entry_)" by(simp add:valid_edge_def)
  thus False by fastforce
next
  fix a a'
  assume assms:"valid_edge prog a" "valid_edge prog a'"
    "sourcenode a = sourcenode a'" "targetnode a = targetnode a'"
  obtain x et y where [simp]:"a = (x,et,y)" by (cases a) auto
  obtain x' et' y' where [simp]:"a' = (x',et',y')" by (cases a') auto
  from assms have "et = et'"
    by(fastforce intro:WCFG_edge_det simp:valid_edge_def)
  with \<open>sourcenode a = sourcenode a'\<close> \<open>targetnode a = targetnode a'\<close>
  show "a = a'" by simp
qed

interpretation While_CFG:
  CFG sourcenode targetnode kind "valid_edge prog" Entry
  for prog
  by(rule While_CFG_aux)

lemma While_CFGExit_aux:
  "CFGExit sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
  fix a assume "valid_edge prog a" and "sourcenode a = (_Exit_)"
  obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
  with \<open>valid_edge prog a\<close> \<open>sourcenode a = (_Exit_)\<close>
  have "prog \<turnstile> (_Exit_) -et\<rightarrow> nx'" by(simp add:valid_edge_def)
  thus False by fastforce
next
  have "prog \<turnstile> (_Entry_) -(\<lambda>s. False)\<^sub>\<surd>\<rightarrow> (_Exit_)" by(rule WCFG_Entry_Exit)
  thus "\<exists>a. valid_edge prog a \<and> sourcenode a = (_Entry_) \<and>
            targetnode a = (_Exit_) \<and> kind a = (\<lambda>s. False)\<^sub>\<surd>"
    by(fastforce simp:valid_edge_def)
qed

interpretation While_CFGExit:
  CFGExit sourcenode targetnode kind "valid_edge prog" Entry Exit
  for prog
by(rule While_CFGExit_aux)

end


(*
  This file contains the update semantics to C correspondence lemmas for word array functions
*)
theory SumRandom_UpdCCorres
  imports SumRandom_UAbsFun
begin

context SumRandom begin

section "Correspondence Lemmas Between Update Semantics and C"

subsection "random_seed"
thm update_sem_init.abs_rel_def
thm afun_corres abs_rel_def

thm \<Xi>_def
lemma  (in update_sem_init) abs_rel_def':
  "abs_rel \<Xi>' srel afun_name \<xi>' afun_mon
    = (\<forall>\<sigma> st x x' r' w'. (\<sigma>, st) \<in> srel \<and> val_rel x x'
        \<and> \<Xi>', \<sigma> \<turnstile> x :u fst (snd (\<Xi>' afun_name)) \<langle>r', w'\<rangle>
        \<longrightarrow> \<lbrace>\<lambda>s0. s0 = st\<rbrace>
              afun_mon x'
            \<lbrace>\<lambda>y' s'. \<exists>\<sigma>' y. \<xi>' afun_name (\<sigma>, x) (\<sigma>', y) \<and> (\<sigma>',s') \<in> srel \<and> val_rel y y'\<rbrace>!)"
  by (fastforce  simp: abs_rel_def validNF_def valid_def no_fail_def)
find_theorems name:"rand'_"
thm random_aux_Seed_C_def
term rand'
thm rand_with_seed'_def

lemma "\<lbrace> \<lambda>s. True \<rbrace> rand' \<lbrace>\<lambda>r s. True\<rbrace>!" oops
lemma rand_with_seed_C_spec:
  "\<lbrace>\<lambda>h. True \<rbrace>
    rand_with_seed' x'
   \<lbrace>\<lambda>r h'. True \<rbrace>!"
  unfolding rand_with_seed'_def
  apply wp
  sorry

lemma rand_with_seed_abs_rel_0 :
  "abs_rel \<Xi> state_rel ''rand_with_seed'' \<xi>u0 rand_with_seed'"
  apply (clarsimp simp add: abs_rel_def'  )

  apply wpsimp
  sorry
lemma rand_with_seed_corres_i:
"(\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
        i < length \<gamma> \<Longrightarrow>
        val_rel (\<gamma> ! i) v' \<Longrightarrow>
        \<Gamma>' ! i = Some (fst (snd Random_seed_master_TypeProof.rand_with_seed_type)) \<Longrightarrow>
        update_sem_init.corres seed_abs_typing_u seed_abs_repr state_rel
         (App (AFun ''rand_with_seed'' []) (Var i))
         (do x <- rand_with_seed' v';
               gets (\<lambda>s. x)
         od)
         \<xi>ui \<gamma>
         \<Xi>
         \<Gamma>' \<sigma> st)"
  apply (rule afun_corres)
     apply (simp add: abs_rel_def \<Xi>_def)
     apply clarsimp
     apply safe

lemma rand_with_seed_corres:
  "\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
      \<lbrakk> i < length \<gamma>;
        val_rel (\<gamma> ! i) v';
        \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''random_with_seed'')));
        \<xi>u ''random_with_seed''= rand_with_seed_u\<rbrakk> \<Longrightarrow>
       update_sem_init.corres
          seed_abs_typing_u
          seed_abs_repr
          state_rel
          (App (AFun ''random_with_seed'' []) (Var i))
          (do x <- random_seed_master_pp_inferred.rand_with_seed' v';
             gets (\<lambda>s. x)
           od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st
          "
  apply (rule afun_corres)

lemma upd_C_wordarray_put2_corres_gen:
  "\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v'; \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''wordarray_put2_0'')));
     \<xi>0' ''wordarray_put2_0'' = upd_wa_put2_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_put2_0'' []) (Var i))
         (do x <- main_pp_inferred.wordarray_put2_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_put2_0_type_def abbreviated_type_defs)
  apply (erule upd.u_t_recE)
  apply (erule upd.u_t_r_consE; clarsimp)+
  apply (erule upd.u_t_primE)+
  apply (subst (asm) lit_type.simps)+
  apply clarsimp
  apply (erule upd.u_t_r_emptyE)
  apply (erule upd.u_t_p_absE; simp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_put2_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = "t2_C.arr_C v'" in allE)
   apply (erule_tac x = "values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (t2_C.idx_C v')" in allE)
   apply (clarsimp simp: heap_rel_ptr_def heap_rel_ptr_w32_def wa_abs_repr_def is_valid_simp type_rel_simp)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t2_C.idx_C v'" in allE)+
   apply (clarsimp simp: val_rel_simp heap_simp type_rel_simp)
  apply clarsimp
  apply (monad_eq simp: upd_wa_put2_0_def)
  apply (case_tac "idx_C v' < len"; clarsimp)
  apply (rule conjI)
    apply (monad_eq simp: wordarray_put2_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta heap_rel_ptr_w32_meta)
   apply (monad_eq simp: wordarray_put2_0'_def)
   apply (frule_tac p = "t2_C.arr_C v'" in all_heap_rel_ptrD; simp?)
    apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
   apply (clarsimp simp: val_rel_simp heap_simp is_valid_simp)
   apply (drule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t2_C.idx_C v'" in allE; clarsimp)
   apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x. x(values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (idx_C v') := val_C v')) st)" and
      x = "(values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v')" and
      uv' = "UPrim (LU32 (val_C v'))" and uv = "UPrim x"
      in all_heap_rel_updE; simp?; clarsimp?)
    apply (clarsimp simp: type_rel_simp)
   apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x. x(values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (idx_C v') := val_C v')) st)" and
      x = "(values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v')" and
      uv' = "UPrim (LU32 (val_C v'))" and uv = "UPrim x"
      in all_heap_rel_updE; simp?; clarsimp?)
   apply (rule conjI, clarsimp simp: val_rel_simp)
   apply clarsimp
   apply (rule FalseE)
   apply (cut_tac p = p and q = "((values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v'))" in ptr_val_inj)
   apply (clarsimp simp: ptr_add_def)
  apply (monad_eq simp: wordarray_put2_0'_def)
  apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t2_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: val_rel_simp heap_simp is_valid_simp)
  done

lemmas upd_C_wordarray_put2_corres = upd_C_wordarray_put2_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

subsection "wordarray_length"

lemma upd_C_wordarray_length_corres_gen:
"\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v'; \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''wordarray_length_0'')));
     \<xi>0' ''wordarray_length_0''= upd_wa_length_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_length_0'' []) (Var i))
         (do x <- main_pp_inferred.wordarray_length_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_length_0_type_def)
  apply (erule upd.u_t_p_absE; simp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_length_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = v' in allE)
   apply (clarsimp simp: heap_rel_ptr_def type_rel_simp wa_abs_repr_def is_valid_simp)
  apply clarsimp
  apply (rule_tac x = \<sigma> in exI)
  apply (rule conjI)
   apply (clarsimp simp: upd_wa_length_0_def)
   apply (monad_eq simp: wordarray_length_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = v' in allE)
   apply (clarsimp simp: heap_rel_ptr_def type_rel_simp wa_abs_repr_def heap_simp val_rel_simp)
  apply (monad_eq simp: wordarray_length_0'_def)
  done

lemmas upd_C_wordarray_length_corres = upd_C_wordarray_length_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

subsection "wordarray_get"

lemma upd_C_wordarray_get_corres_gen:
"\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v'; \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''wordarray_get_0'')));
     \<xi>0' ''wordarray_get_0'' = upd_wa_get_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_get_0'' []) (Var i))
         (do x <- main_pp_inferred.wordarray_get_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_get_0_type_def abbreviated_type_defs)
  apply (erule upd.u_t_recE)
  apply (erule upd.u_t_r_consE; clarsimp)+
  apply (erule upd.u_t_r_emptyE)
  apply (erule upd.u_t_primE; subst (asm) lit_type.simps; clarsimp)
  apply (erule upd.u_t_p_absE; simp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_get_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta heap_rel_ptr_w32_meta)
   apply (drule_tac p = "t1_C.p1_C v'" and uv = "UAbstract (UWA (TPrim (Num U32)) len arr)" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp wa_abs_repr_def val_rel_simp is_valid_simp heap_simp)
   apply (drule not_le_imp_less)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t1_C.p2_C v'" in allE; clarsimp)
   apply (drule_tac p = "values_C (heap_WordArray_u32_C st (t1_C.p1_C v')) +\<^sub>p uint (t1_C.p2_C v')" and
                   uv = "UPrim x" in all_heap_rel_ptrD; simp add: type_rel_simp)
  apply clarsimp
  apply (rule_tac x = \<sigma> in exI)
  apply (rule conjI)
   apply (clarsimp simp: upd_wa_get_0_def)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t1_C.p2_C v'" in allE)
   apply (monad_eq simp: wordarray_get_0'_def word_less_nat_alt word_le_nat_alt)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta heap_rel_ptr_w32_meta)
   apply (drule_tac p = "t1_C.p1_C v'" and uv = "UAbstract (UWA (TPrim (Num U32)) len arr)" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp wa_abs_repr_def val_rel_simp is_valid_simp heap_simp)
   apply (drule_tac p = "values_C (heap_WordArray_u32_C st (t1_C.p1_C v')) +\<^sub>p uint (t1_C.p2_C v')" and
                   uv = "UPrim x" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp val_rel_simp)
  apply (monad_eq simp: wordarray_get_0'_def)
  apply blast
  done

lemmas upd_C_wordarray_get_corres = upd_C_wordarray_get_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

subsection "Helper lemmas, definitions and abbreviations for second order abstract functions"

abbreviation "elem_type x \<equiv> (present_type \<circ> (\<lambda>xs. xs ! 0) \<circ> rec_type_list) x"
abbreviation "mk_urecord xs \<equiv> URecord (map (\<lambda>x. (x, upd.uval_repr x)) xs)"

definition "foldmap_measure i end \<equiv> unat end - unat i"
definition "foldmap_bounds frm to len i e
  \<equiv> frm \<le> i \<and> e = min to len \<and> (frm < e \<longrightarrow> i \<le> e) \<and> ((\<not>(frm < e)) \<longrightarrow> frm = i)"
definition "foldmap_inv foldmap \<xi>' \<sigma> p frm i f acc obsv r \<sigma>' res s' res'
  \<equiv> foldmap \<xi>' \<sigma> p frm i f acc obsv r (\<sigma>', res) \<and> val_rel res res' \<and> (\<sigma>', s') \<in> state_rel"
definition "foldmap_inv_stat obsv obsv' \<equiv> val_rel obsv obsv'"

lemma whileLoop_add_invI:
  assumes "\<lbrace> P \<rbrace> whileLoop_inv c b init I (measure M) \<lbrace> Q \<rbrace>!"
  shows "\<lbrace> P \<rbrace> whileLoop c b init \<lbrace> Q \<rbrace>!"
  by (metis assms whileLoop_inv_def)

lemma validNF_select_UNIV:
  "\<lbrace>\<lambda>s. \<forall>x. Q x s\<rbrace> select UNIV \<lbrace>Q\<rbrace>!"
  apply (subst select_UNIV_unknown)
  apply (rule validNF_unknown)
  done

subsection "wordarray_fold_no_break"

lemma \<Xi>_wordarray_fold_no_break_0:
  "\<Xi> ''wordarray_fold_no_break_0'' = wordarray_fold_no_break_0_type"
  by (clarsimp simp: \<Xi>_def)

lemma fold_dispatch_wp:
  "\<lbrakk>proc_ctx_wellformed \<Xi>; upd.proc_env_matches_ptrs \<xi>0' \<Xi>;
    wa_abs_typing_u (UWA (TPrim (Num num)) len arr) ''WordArray'' [TPrim (Num num)] (Boxed ReadOnly ptrl) r w \<sigma>;
    \<sigma> p = option.Some (UAbstract (UWA (TPrim (Num num)) len arr));
    upd.uval_typing \<Xi> \<sigma> acc (foldmap_acc_type ''wordarray_fold_no_break_0'') ra wa;
    upd.uval_typing \<Xi> \<sigma> obsv (foldmap_obsv_type ''wordarray_fold_no_break_0'') ro {};
    wa \<inter> r = {}; wa \<inter> ro = {}; p \<notin> wa;
    (\<Xi>, [], [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<turnstile>
    (App f (Var 0)) : (foldmap_funret_type ''wordarray_fold_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow>
      update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
        (App f (Var 0)) (do ret <- dispatch f_num x'; gets (\<lambda>s. ret) od)
        \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<sigma> s;
    elem_type (foldmap_funarg_type ''wordarray_fold_no_break_0'') = TPrim (Num num)\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>sa. (a', n') = (a, n) \<and> n < e \<and>
      (\<exists>\<sigma>' res x v. args = t3_C.elem_C_update (\<lambda>_. v) a \<and>
        \<sigma>' (arr + size_of_num_type num * n) = option.Some x \<and> val_rel x v \<and>
      foldmap_inv upd_wa_foldnb_bod \<xi>0' \<sigma> p frm n f acc obsv (ra \<union> ro) \<sigma>' res sa (t3_C.acc_C args)) \<and>
      foldmap_bounds frm to len n e \<and> foldmap_inv_stat obsv (t3_C.obsv_C args)\<rbrace>
      dispatch f_num args
    \<lbrace>\<lambda>ret sb. (\<exists>\<sigma>' res.
        foldmap_inv upd_wa_foldnb_bod \<xi>0' \<sigma> p frm (n + 1) f acc obsv (ra \<union> ro) \<sigma>' res sb ret) \<and>
      foldmap_inv_stat obsv (t3_C.obsv_C args) \<and> foldmap_bounds frm to len (n + 1) e \<and>
      foldmap_measure (n + 1) to < foldmap_measure n' to\<rbrace>!"
  apply (subst validNF_def)
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (subst valid_def)
  apply (subst no_fail_def)
  apply clarsimp
  apply (subst all_imp_conj_distrib[symmetric])
  apply (clarsimp simp: foldmap_inv_def)
  apply (rename_tac sa \<sigma>' res x v)
  apply (erule_tac x = "mk_urecord [x, res, obsv]" in allE)
  apply (erule_tac x = args in allE)
  apply (erule impE)
   apply (subst val_rel_simp; simp add: foldmap_inv_stat_def)
  apply (erule_tac x = \<sigma>' in allE)
  apply (erule_tac x = sa in allE)
  apply (clarsimp simp: corres_def)
  apply (frule_tac t = "TPrim (Num num)" in upd_wa_foldnb_bod_preservation[rotated 2]; simp?; clarsimp?)
  apply (rename_tac r' w')
  apply (subgoal_tac "upd.matches_ptrs \<Xi> \<sigma>' [(mk_urecord [x, res, obsv])]
      [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] (r' \<union> ro) w'")
   apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
    apply (erule impE, blast)
   apply clarsimp
   apply (rename_tac ret sb)
   apply (erule_tac x = ret in allE)
   apply (erule_tac x = sb in allE)
   apply clarsimp
   apply (drule upd.preservation[where \<tau>s = "[]" and K = "[]", simplified]; simp?)
   apply clarsimp
   apply (rename_tac \<sigma>'' res' rb wb)
   apply (clarsimp simp: foldmap_bounds_def)
   apply (case_tac "frm < to \<and> frm < len"; clarsimp)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = n in allE; clarsimp)
   apply (frule_tac p = "arr + (size_of_num_type num) * n" in valid_ptr_not_in_frame_same; simp?)
    apply (drule_tac x = "arr + 4 * n" and S' = r in orthD2; simp?)
    apply (drule_tac wa_abs_typing_u_elims(2)[where \<tau>s = "[_]", simplified]; simp)
    apply blast
   apply clarsimp
   apply (drule_tac t = num and arr = arr and len = len and r' = res'
      in upd_wa_foldnb_bod_step; simp?; clarsimp?)
    apply (rule conjI)
     apply (drule_tac p = p in readonly_not_in_frame; simp?)
    apply (subst Int_Un_distrib2)+
    apply clarsimp
    apply (rule conjI)
     apply (rule disjointI)
     apply (frule_tac p = x and r = ra and w = wa in upd.uval_typing_valid(1)[rotated 1]; simp?)
     apply clarsimp
     apply (drule_tac p = y in readonly_not_in_frame; simp?)
     apply (drule upd.uval_typing_pointers_noalias; blast)
    apply (rule conjI)
     apply (rule disjointI)
     apply (frule_tac p = x and r = ro and w = "{}" in upd.uval_typing_valid(1)[rotated 1]; simp?)
     apply clarsimp
     apply (drule_tac p = y in readonly_not_in_frame; simp?)
     apply blast
    apply (rule disjointI)
    apply (frule wa_abs_typing_u_elims(5))
    apply clarsimp
    apply (erule_tac x = i in allE; clarsimp)
    apply (drule_tac p = "arr + (size_of_num_type num) * i" in readonly_not_in_frame; simp?)
    apply (drule wa_abs_typing_u_elims(2); clarsimp)
    apply blast
   apply (rule conjI)
    apply (rule_tac x = \<sigma>'' in exI)
    apply (rule_tac x = res' in exI; simp)
   apply (frule_tac a = n and k = to in less_is_non_zero_p1)
   apply (drule unatSuc2; clarsimp simp: word_less_nat_alt word_le_nat_alt foldmap_measure_def)
   apply linarith
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (rule upd.matches_ptrs_some[where r' = "{}" and w' = "{}", simplified])
   apply (rule upd.u_t_struct; simp?)
   apply (rule upd.u_t_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
     apply (subst (asm) val_rel_word; clarsimp)
     apply (rule upd.u_t_prim'; clarsimp)
    apply (rule upd.u_t_r_cons1[where r' = ro and w' = "{}", simplified]; simp?)
      apply (drule_tac u = obsv in upd.uval_typing_frame(1); simp?)
       apply blast
      apply (rule upd.u_t_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
       apply (rule upd.u_t_r_empty)
      apply (drule_tac v = obsv in upd.type_repr_uval_repr(1); simp)
     apply (rule disjointI)
     apply (frule_tac p = y and r = ro in upd.uval_typing_valid(1)[where w = "{}", simplified]; simp?)
     apply clarsimp
     apply (drule_tac p = y in readonly_not_in_frame; simp?)
     apply (drule_tac x = y and S' = ro in orthD2; simp?)
    apply (drule_tac v = res in upd.type_repr_uval_repr(1); simp)
  apply (subst (asm) val_rel_word; clarsimp)
  apply (rule upd.matches_ptrs_empty[where \<tau>s = "[]", simplified])
  done

lemma upd_C_wordarray_fold_no_break_corres_gen:
  "\<lbrakk>upd.proc_env_matches_ptrs \<xi>0' \<Xi>; i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''wordarray_fold_no_break_0'')));
    D \<in> k \<or> S \<in> k; K' \<turnstile> (foldmap_obsv_type ''wordarray_fold_no_break_0'') :\<kappa> k;
    \<gamma> ! i = URecord fs; f = prod.fst (fs ! 3);
    (\<Xi>, [], [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<turnstile>
    (App (uvalfun_to_exprfun f) (Var 0)) : (foldmap_funret_type ''wordarray_fold_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
      (App (uvalfun_to_exprfun f) (Var 0)) (do ret <- dispatch_t4' (t5_C.f_C v') x'; gets (\<lambda>s. ret) od)
      \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<sigma> s;
    \<xi>1' ''wordarray_fold_no_break_0'' = upd_wa_foldnb \<Xi> \<xi>0' (foldmap_funarg_type ''wordarray_fold_no_break_0'');
    elem_type (foldmap_funarg_type ''wordarray_fold_no_break_0'') = TPrim (Num num)\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
         (App (AFun ''wordarray_fold_no_break_0'' []) (Var i)) (do x <- main_pp_inferred.wordarray_fold_no_break_0' v';
gets (\<lambda>s. x)
                                                                od)
         \<xi>1' \<gamma> \<Xi>  \<Gamma>' \<sigma> s"
  apply (rule absfun_corres; simp)
  apply (clarsimp simp: abs_fun_rel_def'; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (subst (asm) val_rel_simp; clarsimp)
  apply (subst (asm) val_rel_ptr_def; clarsimp)
  apply (subst (asm) val_rel_fun_tag)
  apply (subst (asm) val_rel_word)
  apply (subst (asm) val_rel_word)
  apply (clarsimp simp: upd_wa_foldnb_def wordarray_fold_no_break_0'_def)
  apply (rename_tac pwa_rep frm_rep to_rep f_rep acc a_rep obsv o_rep wa_rep)
  apply (erule upd.u_t_recE; clarsimp)
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (erule upd.u_t_p_absE; clarsimp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp)
  apply (rename_tac r len arr)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule upd.u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule upd.u_t_r_consE; clarsimp)+
  apply (erule upd.u_t_r_emptyE; clarsimp)
  apply (frule upd.tfun_no_pointers(1))
  apply (frule upd.tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac acc ra wa obsv ro wo)
  apply (drule upd.discardable_or_shareable_not_writeable; simp?)
  apply clarsimp
  apply (subst unknown_bind_ignore)+
  apply (clarsimp simp: join_guards)
  apply wp
      apply (clarsimp simp: unknown_bind_ignore split: prod.split)
      apply (rename_tac var e)
      apply (rule_tac M = "\<lambda>((_, i), _). foldmap_measure i (t5_C.to_C v')" and
      I = "\<lambda>(a, b) s. (\<exists>\<sigma>' res. foldmap_inv upd_wa_foldnb_bod \<xi>0' \<sigma> (ptr_val (t5_C.arr_C v'))
          (t5_C.frm_C v') b (uvalfun_to_exprfun f) acc obsv (ra \<union> ro) \<sigma>' res s (t3_C.acc_C a)) \<and>
          foldmap_inv_stat obsv (t3_C.obsv_C a) \<and>
          foldmap_bounds (t5_C.frm_C v') (t5_C.to_C v') len b e" in whileLoop_add_invI; simp?)
      apply (wp; clarsimp simp: unknown_bind_ignore split: prod.splits)
          apply (rename_tac sa a n args a' n')
          apply (rule_tac a = a and wa = wa and ra = ra and ro = ro and w = "{}" and r = r and
            ptrl = undefined in fold_dispatch_wp[rotated 2]; simp?)
             apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)+
         apply wp
        apply wp
       apply clarsimp
       apply (rename_tac args j \<sigma>' res)
       apply (clarsimp simp: foldmap_bounds_def foldmap_inv_def)
       apply (frule wa_abs_typing_u_elims(5))
       apply (erule_tac x = j in allE; clarsimp)
       apply (drule_tac acc = acc and obsv = obsv and rb = ra and wb = wa and rc = ro
          in upd_wa_foldnb_bod_preservation; simp?; clarsimp?)
       apply (frule_tac p = "ptr_val (t5_C.arr_C v')" in valid_ptr_not_in_frame_same; simp?)
       apply (drule_tac p = "arr + (size_of_num_type num) * j" in valid_ptr_not_in_frame_same; simp?)
        apply (drule_tac x = "arr + (size_of_num_type num) * j" and S = wa and S' = r in orthD2; simp?)
        apply (drule wa_abs_typing_u_elims(2); clarsimp)
        apply blast
       apply (thin_tac "_ \<in> state_rel")
       apply (rule conjI)
        apply (rule_tac x = \<sigma>' in exI)
        apply (rule_tac x = res in exI)
        apply (rule_tac x = "UPrim x" in exI)
        apply clarsimp
        apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_w32_meta heap_rel_ptr_meta)
        apply (rotate_tac -1)
        apply (drule_tac p = "Ptr(arr + (size_of_num_type num) * j)" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp)
        apply (rule_tac x = "heap_w32 s (PTR(32 word) (arr + (size_of_num_type num) * j))" in exI)
        apply (drule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
        apply (clarsimp simp: val_rel_WordArray_u32_C_def ptr_add_def heap_simp mult.commute)
       apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_w32_meta heap_rel_ptr_meta)
       apply (rotate_tac -1)
       apply (drule_tac p = "Ptr(arr + (size_of_num_type num) * j)" in all_heap_rel_ptrD; simp?)
        apply (clarsimp simp: type_rel_simp)
       apply (drule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
        apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
       apply (clarsimp simp: is_valid_simp heap_simp val_rel_WordArray_u32_C_def ptr_add_def mult.commute)
      apply (rule conjI)
       apply (erule u_t_primtE; clarsimp)
      apply (rule conjI)
       apply (drule_tac v = obsv in upd.type_repr_uval_repr(1); simp?)
      apply (rule conjI)
       apply (drule wa_abs_typing_u_elims(5); simp)
      apply (rule conjI)
       apply (erule u_t_funafuntE; clarsimp)
      apply (rename_tac x' j \<sigma>' res)
      apply (rule_tac x = \<sigma>' in exI)
      apply (rule_tac x = res in exI)
      apply (clarsimp simp: foldmap_inv_def)
      apply (rule_tac x = "foldmap_acc_type ''wordarray_fold_no_break_0''" in exI)
      apply (rule_tac x = "foldmap_obsv_type ''wordarray_fold_no_break_0''" in exI)
      apply (rule_tac x = "''elem''" in exI)
      apply (rule_tac x = "''acc''" in exI)
      apply (rule_tac x = "''obsv''" in exI)
      apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
      apply (rule_tac x = ra in exI)
      apply (rule conjI)
       apply (intro exI, assumption)
      apply (rule_tac x = ro in exI)
      apply (rule conjI, simp)
      apply (unfold foldmap_bounds_def)
      apply (erule conjE)+
      apply (case_tac "t5_C.frm_C v' < e")
       apply (erule impE, assumption)
       apply (thin_tac "_ \<longrightarrow> _")
       apply clarsimp
       apply (case_tac "j < t5_C.to_C v'"; clarsimp)
       apply (rule upd_wa_foldnb_bod_to_geq_len; simp?)
      apply (erule impE, assumption)
      apply (thin_tac "_ \<longrightarrow> _")
      apply clarsimp
      apply (erule upd_wa_foldnb_bod.elims; clarsimp)
      apply (case_tac "t5_C.frm_C v' < t5_C.to_C v'"; subst upd_wa_foldnb_bod.simps; clarsimp)
     apply wp
    apply wp
   apply (rule validNF_select_UNIV)
  apply (clarsimp simp: foldmap_inv_stat_def)
  apply (clarsimp simp: order.strict_implies_order)
  apply (clarsimp simp: foldmap_inv_def state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: is_valid_simp val_rel_WordArray_u32_C_def heap_simp)
  apply (rule conjI; clarsimp)
   apply (rule conjI)
    apply (rule_tac x = \<sigma> in exI)
    apply (rule_tac x = acc in exI)
    apply clarsimp
    apply (drule wa_abs_typing_u_elims(5))
    apply (subst upd_wa_foldnb_bod.simps; clarsimp)
    apply (rule conjI; clarsimp)
    apply (rename_tac j)
    apply (erule_tac x = j in allE; clarsimp)
   apply (subst min_def)
   apply (subst (asm) not_le[symmetric])+
   apply (subst if_not_P; simp?)
  apply (rule conjI)
   apply (rule_tac x = \<sigma> in exI)
   apply (rule_tac x = acc in exI)
   apply clarsimp
   apply (drule wa_abs_typing_u_elims(5))
   apply (subst upd_wa_foldnb_bod.simps; clarsimp)
   apply (rule conjI; clarsimp)
   apply (rename_tac j)
   apply (erule_tac x = j in allE; clarsimp)
  apply (subst min_def)
  apply (clarsimp simp: not_le)
  done

subsection "wordarray_map_no_break"

lemma \<Xi>_wordarray_map_no_break_0:
  "\<Xi> ''wordarray_map_no_break_0'' = wordarray_map_no_break_0_type"
  by (clarsimp simp: \<Xi>_def)

lemma map_dispatch_wp:
  "\<lbrakk>proc_ctx_wellformed \<Xi>; upd.proc_env_matches_ptrs \<xi>0' \<Xi>;
    wa_abs_typing_u (UWA (TPrim (Num num)) len arr) ''WordArray'' [TPrim (Num num)] (Boxed Writable ptrl) r w \<sigma>;
    \<sigma> p = option.Some (UAbstract (UWA (TPrim (Num num)) len arr));
    upd.uval_typing \<Xi> \<sigma> acc (foldmap_acc_type ''wordarray_map_no_break_0'') ra wa;
    upd.uval_typing \<Xi> \<sigma> obsv (foldmap_obsv_type ''wordarray_map_no_break_0'') ro {}; wa \<inter> r = {}; p \<notin> w;
    p \<notin> r; w \<inter> wa = {}; w \<inter> (ra \<union> ro) = {}; wa \<inter> ro = {}; p \<notin> wa; p \<notin> ra; p \<notin> ro; p = ptr_val p';
    (\<Xi>, [], [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<turnstile>
    (App f (Var 0)) : (foldmap_funret_type ''wordarray_map_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow>
      update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
        (App f (Var 0)) (do ret <- dispatch f_num x'; gets (\<lambda>s. ret) od)
        \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<sigma> s;
     elem_type (foldmap_funarg_type ''wordarray_map_no_break_0'') = TPrim (Num num)\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>sa. (a', n') = (a, n) \<and> n < e \<and>
      (\<exists>\<sigma>' res x v. args = t6_C.elem_C_update (\<lambda>_. v) a \<and>
        \<sigma>' (arr + size_of_num_type U32 * n) = option.Some x \<and> val_rel x v \<and>
      foldmap_inv upd_wa_mapAccumnb_bod \<xi>0' \<sigma> p frm n f acc obsv (ra \<union> ro) \<sigma>' res sa (t10_C p' (t6_C.acc_C args))) \<and>
      foldmap_bounds frm to len n e \<and> foldmap_inv_stat obsv (t6_C.obsv_C args)\<rbrace>
      dispatch f_num args
     \<lbrace>\<lambda>ret sb. (\<exists>\<sigma>' res.
        foldmap_inv upd_wa_mapAccumnb_bod \<xi>0' \<sigma> p frm (n + 1) f acc obsv (ra \<union> ro) \<sigma>' res
          (heap_w32_update (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n
            then t7_C.p1_C ret else x a) sb) (t10_C p' (t7_C.p2_C ret))) \<and>
        foldmap_inv_stat obsv (t6_C.obsv_C args) \<and>
        foldmap_bounds frm to len (n + 1) e \<and>
        foldmap_measure (n + 1) to < foldmap_measure n' to \<and>
        is_valid_WordArray_u32_C sb p' \<and>
        is_valid_w32 sb (values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n)\<rbrace>!"
  apply (subst validNF_def)
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (subst valid_def)
  apply (subst no_fail_def)
  apply clarsimp
  apply (subst all_imp_conj_distrib[symmetric])
  apply (clarsimp simp: foldmap_inv_def)
  apply (rename_tac sa \<sigma>' res x v)
  apply (frule upd_wa_mapAccumnb_bod_preservation'; simp?)
  apply clarsimp
  apply (rename_tac racc)
  apply (erule_tac x = "mk_urecord [x, racc, obsv]" in allE)
  apply (erule_tac x = args in allE)
  apply clarsimp
  apply (erule impE)
   apply (clarsimp simp: val_rel_simp foldmap_inv_stat_def)
  apply (erule_tac x = \<sigma>' in allE)
  apply (erule_tac x = sa in allE)
  apply (clarsimp simp: corres_def)
  apply (frule_tac t = "TPrim (Num num)" in upd_wa_mapAccumnb_bod_preservation; simp?; clarsimp?)
    apply (subst Int_Un_distrib2; clarsimp)
    apply (subst (asm) Int_Un_distrib; clarsimp)
   apply (subst (asm) Int_Un_distrib; clarsimp)
  apply (rename_tac r' w')
  apply (erule upd.u_t_recE; clarsimp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (erule upd.u_t_r_emptyE; clarsimp)
  apply (rename_tac w' rb wb racc rc wc)
  apply (erule upd.u_t_p_con_wrE)
  apply (drule_tac t = "RCon _ _" in sym; clarsimp)
  apply (frule_tac p = p in valid_ptr_not_in_frame_same; simp?)
  apply clarsimp
  apply (frule_tac p = p in readonly_not_in_frame; simp?)
  apply (subst (asm) insert_ident; clarsimp)
  apply (rename_tac wb)
  apply (subgoal_tac "upd.matches_ptrs \<Xi> \<sigma>' [(mk_urecord [x, racc, obsv])]
      [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] (rc \<union> ro) wc")
   apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
   apply (erule impE, blast)
   apply clarsimp
   apply (rename_tac ret sb)
   apply (erule_tac x = ret in allE)
   apply (erule_tac x = sb in allE)
   apply clarsimp
   apply (drule upd.preservation[where \<tau>s = "[]" and K = "[]", simplified]; simp?)
   apply clarsimp
   apply (rename_tac \<sigma>'' res' r' w')
   apply (erule u_t_rectE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (rename_tac x' rd wd racc' r' w')
   apply (frule_tac v = x' in upd.tprim_no_pointers(1); clarsimp)
   apply (frule_tac v = x' in upd.tprim_no_pointers(2); clarsimp)
   apply (clarsimp simp: foldmap_bounds_def)
   apply (case_tac "frm < to \<and> frm < len"; clarsimp)
   apply (thin_tac "wa_abs_typing_u _ _ _ _ _ _ _")
   apply (drule_tac t = num and arr = arr and len = len and v' = x' and r' = racc'
      in upd_wa_mapAccumnb_bod_step; simp?; clarsimp?)
      apply (drule wa_abs_typing_u_elims(6); simp?)
     apply (subst Int_Un_distrib2)+
     apply clarsimp
     apply (rule conjI)
      apply (rule disjointI)
      apply (rename_tac y y')
      apply (frule_tac p = y and r = ra and w = wa in upd.uval_typing_valid(1)[rotated 1]; simp?)
      apply clarsimp
      apply (drule_tac p = y' in readonly_not_in_frame; simp?)
      apply (drule_tac x = y' and S' = "ra \<union> ro" in orthD2; simp?)
      apply (drule upd.uval_typing_pointers_noalias)
      apply (drule_tac x = y' and S = ra and S' = wa in orthD1; simp?)
     apply (rule conjI)
      apply (rule disjointI)
      apply (rename_tac y y')
      apply (frule_tac p = y and r = ro and w = "{}" in upd.uval_typing_valid(1)[rotated 1]; simp?)
      apply clarsimp
      apply (drule_tac p = y' in readonly_not_in_frame; simp?)
      apply blast
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (drule_tac v = x' in upd.type_repr_uval_repr(1); simp)
    apply (drule_tac v = racc' in upd.type_repr_uval_repr(1); simp)
   apply (thin_tac "_ \<in> state_rel")
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta heap_rel_ptr_w32_meta)
   apply (frule_tac p = p and \<sigma> = \<sigma>' in valid_ptr_not_in_frame_same; simp?)
   apply (drule_tac p = "arr + (size_of_num_type num) * n" and \<sigma> = \<sigma>' in valid_ptr_not_in_frame_same; simp?)
    apply (drule_tac x = "arr + (size_of_num_type num) * n" and S' = wc in orthD1; simp?)
    apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (rule_tac x = n in exI; clarsimp)
   apply (frule_tac p = p' in all_heap_rel_ptrD; simp?)
    apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
   apply (frule_tac p = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n" and uv = x in all_heap_rel_ptrD; simp?)
     apply (clarsimp simp: val_rel_simp heap_simp)
    apply (clarsimp simp: type_rel_simp val_rel_simp)
   apply (rule conjI)
    apply (rule_tac x = "\<sigma>''(arr + (size_of_num_type num) * n \<mapsto> x')" in exI)
    apply (rule_tac x = "mk_urecord [UPtr (ptr_val p') (RCon ''WordArray'' [RPrim (Num U32)]), racc']" in exI)
    apply clarsimp
    apply (rule conjI)
     apply (clarsimp simp: val_rel_simp)
    apply (clarsimp simp: heap_simp is_valid_simp)
    apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n then t7_C.p1_C ret else x a) sb)" and
      uv = x and uv' = x' and x = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n"
      in all_heap_rel_updE; simp?; clarsimp?)
       apply (clarsimp simp: val_rel_simp)
      apply (drule_tac v = x' in upd.type_repr_uval_repr(1); simp add: val_rel_simp)
     apply (clarsimp simp: val_rel_simp type_rel_simp)
    apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n then t7_C.p1_C ret else x a) sb)" and
      uv = x and uv' = x' and x = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n"
      in all_heap_rel_updE; simp?; clarsimp?)
       apply (clarsimp simp: val_rel_simp)
      apply (drule_tac v = x' in upd.type_repr_uval_repr(1); simp add: val_rel_simp)
     apply (rule conjI)
      apply (clarsimp simp: val_rel_simp)
     apply (cut_tac p = pa and q = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n" in ptr_val_inj)
     apply clarsimp
    apply (clarsimp simp: ptr_add_def mult.commute val_rel_simp)
   apply (clarsimp simp: is_valid_simp)
   apply (frule_tac a = n and k = to in less_is_non_zero_p1)
   apply (drule unatSuc2; clarsimp simp: word_less_nat_alt word_le_nat_alt foldmap_measure_def)
   apply linarith
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (rule upd.matches_ptrs_some[where r' = "{}" and w' = "{}", simplified])
   apply (rule upd.u_t_struct; simp?)
   apply (rule upd.u_t_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
     apply (subst (asm) val_rel_word; clarsimp)
     apply (rule upd.u_t_prim'; clarsimp)
    apply (rule upd.u_t_r_cons1[where r' = ro and w' = "{}", simplified]; simp?)
     apply (drule_tac u = obsv in upd.uval_typing_frame(1); simp?)
      apply blast
     apply (rule upd.u_t_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
      apply (rule upd.u_t_r_empty)
     apply (drule_tac v = obsv in upd.type_repr_uval_repr(1); simp)
    apply (rule disjointI)
    apply (frule_tac p = y and r = ro in upd.uval_typing_valid(1)[where w = "{}", simplified]; simp?)
    apply clarsimp
    apply (drule_tac p = y in readonly_not_in_frame; simp?)
    apply (drule_tac x = y and S' = ro in orthD2; simp?)
    apply (drule_tac x = y and S' = "ra \<union> ro" in orthD2; simp?)
   apply (subst (asm) val_rel_word; clarsimp)
  apply (rule upd.matches_ptrs_empty[where \<tau>s = "[]", simplified])
  done

lemma upd_C_wordarray_map_no_break_corres_gen:
  "\<lbrakk>upd.proc_env_matches_ptrs \<xi>0' \<Xi>; i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0'')));
     D \<in> k \<or> S \<in> k; K' \<turnstile> (foldmap_obsv_type ''wordarray_map_no_break_0'') :\<kappa> k;
    \<gamma> ! i = URecord fs; f = prod.fst (fs ! 3);
    (\<Xi>, [], [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<turnstile>
    (App (uvalfun_to_exprfun f) (Var 0)) : (foldmap_funret_type ''wordarray_map_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
      (App (uvalfun_to_exprfun f) (Var 0)) (do ret <- dispatch_t8' (t9_C.f_C v') x'; gets (\<lambda>s. ret) od)
      \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<sigma> s;
    \<xi>1' ''wordarray_map_no_break_0'' = upd_wa_mapAccumnb \<Xi> \<xi>0'
      (foldmap_funarg_type ''wordarray_map_no_break_0'') (foldmap_funret_type ''wordarray_map_no_break_0'');
    elem_type (foldmap_funarg_type ''wordarray_map_no_break_0'') = TPrim (Num num)\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
         (App (AFun ''wordarray_map_no_break_0'' []) (Var i)) (do x <- main_pp_inferred.wordarray_map_no_break_0' v';
gets (\<lambda>s. x)
                                                                od)
         \<xi>1' \<gamma> \<Xi>  \<Gamma>' \<sigma> s"
  apply (rule absfun_corres; simp)
  apply (clarsimp simp: abs_fun_rel_def'; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (subst (asm) val_rel_simp; clarsimp)
  apply (subst (asm) val_rel_ptr_def; clarsimp)
  apply (subst (asm) val_rel_fun_tag)
  apply (subst (asm) val_rel_word)
  apply (subst (asm) val_rel_word)
  apply (clarsimp simp: upd_wa_mapAccumnb_def wordarray_map_no_break_0'_def)
  apply (rename_tac pwa_rep frm_rep to_rep f_rep acc a_rep o_rep wa_rep)
  apply (erule upd.u_t_recE; clarsimp)
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (rename_tac r w r' w')
  apply (erule upd.u_t_p_absE; clarsimp)
  apply (rename_tac w)
  apply (frule wa_abs_typing_u_elims(1); clarsimp)
  apply (rename_tac len arr)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule upd.u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule upd.u_t_r_consE; clarsimp)+
  apply (erule upd.u_t_r_emptyE; clarsimp)
  apply (frule upd.tfun_no_pointers(1))
  apply (frule upd.tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac acc ra wa obsv ro wo)
  apply (drule_tac v = obsv in upd.discardable_or_shareable_not_writeable(1); simp?)
  apply (subst unknown_bind_ignore)+
  apply (clarsimp simp: join_guards)
  apply wp
      apply (clarsimp simp: unknown_bind_ignore split: prod.split)
       apply (rename_tac var e)
       apply (rule_tac M = "\<lambda>((_, i), _). foldmap_measure i (t9_C.to_C v')" and
      I = "\<lambda>(a, b) s. (\<exists>\<sigma>' res. foldmap_inv upd_wa_mapAccumnb_bod \<xi>0' \<sigma> (ptr_val (t9_C.arr_C v'))
          (t9_C.frm_C v') b (uvalfun_to_exprfun f) acc obsv (ra \<union> ro) \<sigma>' res s (t10_C (t9_C.arr_C v') (t6_C.acc_C a))) \<and>
          foldmap_inv_stat obsv (t6_C.obsv_C a) \<and>
          foldmap_bounds (t9_C.frm_C v') (t9_C.to_C v') len b e" in whileLoop_add_invI; simp?)
       apply (wp; clarsimp simp: unknown_bind_ignore split: prod.splits)
           apply (rename_tac sa a n args a' n')
           apply (clarsimp simp: conj_left_commute[of "is_valid_w32 _ _", simplified])
           apply (clarsimp simp: conj_commute[of "is_valid_w32 _ _", simplified])
           apply (rule_tac a = a and wa = wa and ra = ra and ro = ro and w = w and r = r and
              ptrl = undefined in map_dispatch_wp; simp?)
              apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)+
          apply wp
         apply wp
        apply clarsimp
        apply (rename_tac args j \<sigma>' res)
        apply (clarsimp simp: foldmap_inv_def foldmap_bounds_def)
        apply (drule upd_wa_mapAccumnb_bod_preservation; simp?; clarsimp?)
          apply (subst Int_Un_distrib2; clarsimp)
          apply (cut_tac A = w and B = ra and C = ro in Int_Un_distrib; clarsimp)
         apply (cut_tac A = w and B = ra and C = ro in Int_Un_distrib; clarsimp)
        apply (frule_tac p = "ptr_val (t9_C.arr_C v')" in valid_ptr_not_in_frame_same; simp?)
        apply (thin_tac "_ \<in> state_rel")
        apply (frule_tac upd_wa_mapAccumnb_bod_preservation'; simp?)
        apply clarsimp
        apply (erule upd.u_t_recE; clarsimp)
        apply (erule upd.u_t_r_consE; simp)
        apply (erule conjE)+
        apply (drule_tac t = "type_repr _" in sym; clarsimp)
        apply (erule upd.u_t_p_con_wrE)
        apply (drule_tac t = "RCon _ _" in sym; clarsimp)
        apply (thin_tac "wa_abs_typing_u _ _ _ _ _ _ _")
        apply (drule wa_abs_typing_u_elims(5))
        apply (erule_tac x = j in allE; clarsimp)
        apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta heap_rel_ptr_w32_meta)
        apply (frule_tac p = "t9_C.arr_C v'" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
        apply (rotate_tac -2)
         apply (frule_tac p = "Ptr(arr + (size_of_num_type num) * j)" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp)
        apply (rule conjI)
         apply (rule_tac x = \<sigma>' in exI)
         apply (rule_tac x = "mk_urecord [UPtr (ptr_val (t9_C.arr_C v'))
          (RCon ''WordArray'' [RPrim (Num num)]), racc]" in exI)
         apply (rule_tac x = "UPrim x" in exI)
         apply (rule_tac x = "heap_w32 s (PTR(32 word) (arr + (size_of_num_type num) * j))" in exI)
         apply (clarsimp simp: val_rel_WordArray_u32_C_def ptr_add_def heap_simp mult.commute)
        apply (clarsimp simp: val_rel_WordArray_u32_C_def ptr_add_def is_valid_simp heap_simp mult.commute)
       apply (rule conjI)
        apply (drule_tac v = acc in upd.type_repr_uval_repr(1); simp)
       apply (rule conjI)
        apply (drule_tac v = obsv in upd.type_repr_uval_repr(1); simp)
       apply (rule conjI)
        apply (drule wa_abs_typing_u_elims(5); simp)
       apply (rule conjI)
        apply (erule u_t_funafuntE; clarsimp)
       apply (rule_tac x = \<sigma>' in exI)
       apply (rule_tac x = res in exI)
       apply (clarsimp simp: foldmap_inv_def)
       apply (rule conjI)
        apply (rule_tac x = "foldmap_acc_type ''wordarray_map_no_break_0''" in exI)
        apply (rule_tac x = "foldmap_obsv_type ''wordarray_map_no_break_0''" in exI)
        apply (rule_tac x = "''elem''" in exI)
        apply (rule_tac x = "''acc''" in exI)
        apply (rule_tac x = "''obsv''" in exI)
        apply (rule_tac x = "''p1''" in exI)
        apply (rule_tac x = "''p2''" in exI)
        apply (rule_tac x = ra in exI)
        apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
        apply (rule conjI)
         apply (intro exI, assumption)
        apply (rule_tac x = ro in exI)
        apply clarsimp
        apply (rename_tac j \<sigma>' res)
        apply (unfold foldmap_bounds_def)
        apply (erule conjE)+
        apply (case_tac "t9_C.frm_C v' < e")
         apply (erule impE, assumption)
         apply (thin_tac "_ \<longrightarrow> _")
         apply clarsimp
         apply (case_tac "j < t9_C.to_C v'"; clarsimp)
         apply (rule upd_wa_mapAccumnb_bod_to_geq_len; simp?)
        apply (erule impE, assumption)
        apply (thin_tac "_ \<longrightarrow> _")
        apply clarsimp
        apply (erule upd_wa_mapAccumnb_bod.elims; clarsimp)
        apply (case_tac "t9_C.frm_C v' < t9_C.to_C v'"; subst upd_wa_mapAccumnb_bod.simps; clarsimp)
       apply (clarsimp simp: val_rel_simp)
      apply wp
     apply wp
    apply (rule validNF_select_UNIV)
   apply (rule validNF_select_UNIV)
  apply (clarsimp simp: foldmap_inv_stat_def)
  apply (clarsimp simp: order.strict_implies_order)
  apply (clarsimp simp: foldmap_inv_def state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t9_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: is_valid_simp val_rel_WordArray_u32_C_def heap_simp)
  apply (rule conjI; clarsimp)
   apply (rule conjI)
    apply (rule_tac x = \<sigma> in exI)
    apply (rule_tac x = "mk_urecord [UPtr (ptr_val (t9_C.arr_C v'))
      (RCon ''WordArray'' [RPrim (Num num)]), acc]" in exI)
    apply (subst upd_wa_mapAccumnb_bod.simps; clarsimp)
    apply (rule conjI)
     apply (drule wa_abs_typing_u_elims(5); clarsimp)
     apply (rename_tac j)
     apply (erule_tac x = j in allE; clarsimp)
    apply (rule conjI)
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (rule conjI)
     apply (clarsimp simp: val_rel_simp)
    apply (rule conjI; clarsimp)
   apply (subst min_def)
   apply (subst (asm) not_le[symmetric])+
   apply (subst if_not_P; simp?)
  apply (rule conjI)
   apply (rule_tac x = \<sigma> in exI)
   apply (rule_tac x = "mk_urecord [UPtr (ptr_val (t9_C.arr_C v'))
      (RCon ''WordArray'' [RPrim (Num num)]), acc]" in exI)
   apply (subst upd_wa_mapAccumnb_bod.simps; clarsimp)
   apply (rule conjI)
    apply (drule wa_abs_typing_u_elims(5); clarsimp)
    apply (rename_tac j)
    apply (erule_tac x = j in allE; clarsimp)
   apply (rule conjI)
    apply (drule wa_abs_typing_u_elims(3); clarsimp)
   apply (rule conjI)
    apply (clarsimp simp: val_rel_simp)
   apply (rule conjI; clarsimp)
  apply (subst min_def)
  apply (clarsimp simp: not_le)
  done

end (* of context *)
end


theory InferRange
  imports InferDef
begin

    (* ##### random mechnical lemmas *)

lemma trip_convert: "as_aff (as_perm a) = a"
  apply (case_tac a)
    apply (auto)
  done

lemma infer_x_subset_ih: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds'; x \<in> ds \<rbrakk> \<Longrightarrow> x \<in> ds'"
  apply (induct e arbitrary: env_v ds tau_v r_sv r_xv r_mv c_list ds')
        apply (auto)
  apply (case_tac xa)
              apply (auto)
  done

lemma infer_x_subset: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds' \<rbrakk> \<Longrightarrow> ds \<subseteq> ds'"
  apply (auto)
  apply (rule_tac infer_x_subset_ih)
   apply (auto)
  done

    (*  ##### direct type substitution composition *)

definition dir_add_env where
  "dir_add_env t_sub a tau = (\<lambda> a'. if a' = a then Some tau else t_sub a')"

fun dir_list_add_env where
  "dir_list_add_env t_sub [] = t_sub"
| "dir_list_add_env t_sub ((a, tau) # a_t) = dir_add_env (dir_list_add_env t_sub a_t) a tau"

    (* #### domain / range based lemmas *)

definition sub_range where
  "sub_range env_v ds = (\<forall> x. case env_v x of
    None \<Rightarrow> True
    | Some a \<Rightarrow> a \<in> ds
  )"

definition tsub_dom where
  "tsub_dom t_sub ds = (\<forall> a. t_sub a \<noteq> None \<longrightarrow> a \<in> ds)"

definition psub_dom where
  "psub_dom p_sub ds = (\<forall> a. p_sub a \<noteq> NoPerm \<longrightarrow> a \<in> ds)"

definition set_diff :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" where
  "set_diff s1 s2 = s1 - s2"

fun dom_list where
  "dom_list [] = []"
| "dom_list ((x, v) # t) = x # (dom_list t)"

fun dom_list_set where
  "dom_list_set [] = {}"
| "dom_list_set ((x, v) # t) = ({x} \<union> dom_list_set t)"

lemma dir_add_eq_env: "\<lbrakk> dir_subst_tenv t_sub env_v = env; sub_range env_v ds; a \<notin> ds \<rbrakk> \<Longrightarrow>
  dir_subst_tenv (dir_add_env t_sub a tau) env_v = env"
  apply (auto)
  apply (case_tac "\<forall> x. dir_subst_tenv (dir_add_env t_sub a tau) env_v x = env x")
   apply (auto)
  apply (simp add: dir_subst_tenv_def)
  apply (simp add: sub_range_def)
  apply (erule_tac x="x" in allE)
  apply (case_tac "env_v x")
   apply (auto)
  apply (simp add: dir_add_env_def)
  apply (case_tac "a = aa")
   apply (auto)
  done

lemma dir_list_append_eq_env_ih: "dir_subst_tenv (dir_list_add_env t_sub (l @ la)) env_v x = dir_subst_tenv (dir_list_add_env (dir_list_add_env t_sub la) l) env_v x"
  apply (induct l)
   apply (auto)
  apply (simp add: dir_subst_tenv_def)
  apply (case_tac "env_v x")
   apply (auto)
  apply (simp add: dir_add_env_def)
  done

lemma dir_list_append_eq_env: "dir_subst_tenv (dir_list_add_env t_sub (l @ la)) env_v = dir_subst_tenv (dir_list_add_env (dir_list_add_env t_sub la) l) env_v"
  apply (case_tac "\<forall> x. dir_subst_tenv (dir_list_add_env t_sub (l @ la)) env_v x = dir_subst_tenv (dir_list_add_env (dir_list_add_env t_sub la) l) env_v x")
   apply (auto)
  apply (cut_tac t_sub="t_sub" and x="x" in dir_list_append_eq_env_ih)
  apply (auto)
  done

lemma dir_list_dist_add_eq_env_ih: "\<lbrakk> dir_subst_tenv t_sub env_v x = dir_subst_tenv t_sub' env_v x \<rbrakk> \<Longrightarrow>
  dir_subst_tenv (dir_list_add_env t_sub l) env_v x = dir_subst_tenv (dir_list_add_env t_sub' l) env_v x"
  apply (induct l)
   apply (auto)
  apply (simp add: dir_subst_tenv_def)
  apply (case_tac "env_v x")
   apply (auto)
  apply (simp add: dir_add_env_def)
  done

lemma dir_list_dist_add_eq_env: "\<lbrakk> dir_subst_tenv t_sub env_v = dir_subst_tenv t_sub' env_v \<rbrakk> \<Longrightarrow>
  dir_subst_tenv (dir_list_add_env t_sub l) env_v = dir_subst_tenv (dir_list_add_env t_sub' l) env_v"
  apply (case_tac "\<forall> x. dir_subst_tenv (dir_list_add_env t_sub l) env_v x = dir_subst_tenv (dir_list_add_env t_sub' l) env_v x")
   apply (auto)
  apply (cut_tac t_sub="t_sub" and x="x" and t_sub'="t_sub'" in dir_list_dist_add_eq_env_ih)
   apply (auto)
  done

lemma dir_list_cancel_add_eq_env_ih: "\<lbrakk> sub_range env_v ds; fresh_list ds (dom_list l) \<rbrakk> \<Longrightarrow>
  dir_subst_tenv (dir_list_add_env t_sub l) env_v x = dir_subst_tenv t_sub env_v x"
  apply (induct l)
   apply (auto)
  apply (simp add: dir_subst_tenv_def)
  apply (case_tac "env_v x")
   apply (auto)
  apply (simp add: dir_add_env_def)
  apply (auto)
   apply (simp add: sub_range_def)
   apply (erule_tac x="x" in allE)
   apply (auto)
   apply (simp add: fresh_list_def)
   apply (auto)
  apply (case_tac "\<not> fresh_list ds (dom_list l)")
   apply (auto)
  apply (simp add: fresh_list_def)
  done

lemma dir_list_cancel_add_eq_env: "\<lbrakk> sub_range env_v ds; fresh_list ds (dom_list l) \<rbrakk> \<Longrightarrow>
  dir_subst_tenv (dir_list_add_env t_sub l) env_v = dir_subst_tenv t_sub env_v"
  apply (case_tac "\<forall> x. dir_subst_tenv (dir_list_add_env t_sub l) env_v x = dir_subst_tenv t_sub env_v x")
   apply (auto)
  apply (cut_tac t_sub="t_sub" and x="x" in dir_list_cancel_add_eq_env_ih)
    apply (auto)
  done

lemma subset_tsub_dom: "\<lbrakk> tsub_dom t_sub ds; ds \<subseteq> ds' \<rbrakk> \<Longrightarrow> tsub_dom t_sub ds'"
  apply (simp add: tsub_dom_def)
  apply (auto)
  done

lemma add_tsub_dom: "\<lbrakk> tsub_dom t_sub ds; x \<in> ds \<rbrakk> \<Longrightarrow> tsub_dom (dir_add_env t_sub x tau) ds"
  apply (simp add: tsub_dom_def)
  apply (simp add: dir_add_env_def)
  done

lemma add_tsub_dom_rev: "\<lbrakk> tsub_dom (dir_add_env t_sub x tau) ds \<rbrakk> \<Longrightarrow> tsub_dom t_sub ds"
  apply (simp add: tsub_dom_def)
  apply (simp add: dir_add_env_def)
  done

lemma list_add_tsub_dom: "\<lbrakk> tsub_dom t_sub ds; ds \<subseteq> ds'; dom_list_set l \<subseteq> ds' \<rbrakk> \<Longrightarrow> tsub_dom (dir_list_add_env t_sub l) ds'"
  apply (induct l)
   apply (auto)
   apply (simp add: subset_tsub_dom)
  apply (rule_tac add_tsub_dom)
   apply (auto)
  done

lemma list_add_tsub_dom_rev: "\<lbrakk> tsub_dom (dir_list_add_env t_sub l) ds \<rbrakk> \<Longrightarrow> tsub_dom t_sub ds"
  apply (induct l)
   apply (auto)
  apply (cut_tac t_sub="dir_list_add_env t_sub l" and x="a" in add_tsub_dom_rev)
   apply (auto)
  done

lemma append_tsub_dom: "\<lbrakk> tsub_dom (dir_list_add_env t_sub l2) ds; dom_list_set l1 \<subseteq> ds \<rbrakk> \<Longrightarrow> tsub_dom (dir_list_add_env t_sub (l1 @ l2)) ds"
  apply (induct l1)
   apply (auto)
  apply (rule_tac add_tsub_dom)
   apply (auto)
  done

lemma subset_psub_dom: "\<lbrakk> psub_dom p_sub ds; ds \<subseteq> ds' \<rbrakk> \<Longrightarrow> psub_dom p_sub ds'"
  apply (simp add: psub_dom_def)
  apply (auto)
  done

lemma empty_psub_dom: "psub_dom empty_use_env ds"
  apply (simp add: psub_dom_def)
  apply (simp add: empty_use_env_def)
  done

lemma add_psub_dom: "\<lbrakk> psub_dom p_sub ds; x \<in> ds \<rbrakk> \<Longrightarrow> psub_dom (add_use_env p_sub x p) ds"
  apply (simp add: psub_dom_def)
  apply (simp add: add_use_env_def)
  done

lemma comp_psub_dom: "\<lbrakk> psub_dom p_sub1 ds; psub_dom p_sub2 ds \<rbrakk> \<Longrightarrow> psub_dom (comp_use_env p_sub1 p_sub2) ds"
  apply (simp add: psub_dom_def)
  apply (auto)
  apply (simp add: comp_use_env_def)
  apply (case_tac "p_sub1 a = NoPerm")
   apply (auto)
  apply (case_tac "p_sub2 a = NoPerm")
   apply (auto)
  done

lemma subset_sub_range: "\<lbrakk> sub_range env_v ds; ds \<subseteq> ds' \<rbrakk> \<Longrightarrow> sub_range env_v ds'"
  apply (simp add: sub_range_def)
  apply (auto)
  apply (case_tac "env_v x")
   apply (auto)
  apply (erule_tac x="x" in allE)
  apply (auto)
  done

lemma list_add_dls: "\<lbrakk> tsub_dom (dir_list_add_env t_sub l) ds \<rbrakk> \<Longrightarrow> dom_list_set l \<subseteq> ds"
  apply (induct l)
   apply (auto)
   apply (simp add: tsub_dom_def)
   apply (simp add: dir_add_env_def)
  apply (cut_tac t_sub="dir_list_add_env t_sub l" and x="a" in add_tsub_dom_rev)
   apply (auto)
  done

    (* #### p_exp range *)

fun pvar_set_perm where
  "pvar_set_perm (SPerm p) = {}"
| "pvar_set_perm (SVar x) = {x}"

fun pvar_set where
  "pvar_set (XPerm p) = pvar_set_perm p"
| "pvar_set (XType a) = {}"
| "pvar_set (XComp px qx) = (pvar_set px \<union> pvar_set qx)"
| "pvar_set (XLift px q) = (pvar_set px \<union> pvar_set_perm q)"
| "pvar_set (XIfZero px qx) = (pvar_set px \<union> pvar_set qx)"

definition pvar_range where
  "pvar_range r_sv ds = (\<forall> a. pvar_set (r_sv a) \<subseteq> ds)"

lemma empty_pvar_range: "pvar_range empty_var_env ds"
  apply (simp add: pvar_range_def)
  apply (simp add: empty_var_env_def)
  done

lemma comp_pvar_range: "\<lbrakk> pvar_range r_sv ds; pvar_range r_xv ds \<rbrakk> \<Longrightarrow> pvar_range (comp_var_env r_sv r_xv) ds"
  apply (simp add: pvar_range_def)
  apply (simp add: comp_var_env_def)
  done

lemma lift_pvar_range: "\<lbrakk> pvar_range r_sv ds; pvar_set_perm p \<subseteq> ds \<rbrakk> \<Longrightarrow> pvar_range (lift_var_env r_sv p) ds"
  apply (simp add: pvar_range_def)
  apply (simp add: lift_var_env_def)
  done

fun tvar_set where
  "tvar_set (XPerm p) = {}"
| "tvar_set (XType a) = {a}"
| "tvar_set (XComp px qx) = (tvar_set px \<union> tvar_set qx)"
| "tvar_set (XLift px q) = (tvar_set px)"
| "tvar_set (XIfZero px qx) = (tvar_set px \<union> tvar_set qx)"

definition tvar_range where
  "tvar_range r_sv ds = (\<forall> a. tvar_set (r_sv a) \<subseteq> ds)"

lemma empty_tvar_range: "tvar_range empty_var_env ds"
  apply (simp add: tvar_range_def)
  apply (simp add: empty_var_env_def)
  done

lemma comp_tvar_range: "\<lbrakk> tvar_range r_sv ds; tvar_range r_xv ds \<rbrakk> \<Longrightarrow> tvar_range (comp_var_env r_sv r_xv) ds"
  apply (simp add: tvar_range_def)
  apply (simp add: comp_var_env_def)
  done

lemma lift_tvar_range: "\<lbrakk> tvar_range r_sv ds; tvar_set_perm p \<subseteq> ds \<rbrakk> \<Longrightarrow> tvar_range (lift_var_env r_sv p) ds"
  apply (simp add: tvar_range_def)
  apply (simp add: lift_var_env_def)
  done

lemma subset_pvar_range: "\<lbrakk> pvar_range p_sub ds; ds \<subseteq> ds' \<rbrakk> \<Longrightarrow> pvar_range p_sub ds'"
  apply (simp add: pvar_range_def)
  apply (auto)
  done

lemma set_diff_subset: "\<lbrakk> ds3 \<subseteq> ds4; ds \<subseteq> ds2 \<rbrakk> \<Longrightarrow> set_diff ds3 ds2 \<subseteq> set_diff ds4 ds"
  apply (simp add: set_diff_def)
  apply (auto)
  done

lemma ifz_pvar_range: "\<lbrakk> pvar_range r_sv ds; pvar_set px \<subseteq> ds \<rbrakk> \<Longrightarrow> pvar_range (ifz_var_env px r_sv) ds"
  apply (simp add: pvar_range_def)
  apply (simp add: ifz_var_env_def)
  done

lemma rem_pvar_range: "\<lbrakk> pvar_range r_sv ds \<rbrakk> \<Longrightarrow> pvar_range (rem_var_env r_sv x) ds"
  apply (simp add: pvar_range_def)
  apply (simp add: rem_var_env_def)
  done

lemma comp_pvar_range_rev1: "\<lbrakk> pvar_range (comp_var_env r_sv r_xv) ds \<rbrakk> \<Longrightarrow> pvar_range r_sv ds"
  apply (simp add: pvar_range_def)
  apply (simp add: comp_var_env_def)
  apply (auto)
  apply (erule_tac x="a" in allE)
  apply (case_tac "r_sv a = XPerm (SPerm NoPerm) \<and> r_xv a = XPerm (SPerm NoPerm)")
   apply (auto)
  done

lemma comp_pvar_range_rev2: "\<lbrakk> pvar_range (comp_var_env r_sv r_xv) ds \<rbrakk> \<Longrightarrow> pvar_range r_xv ds"
  apply (simp add: pvar_range_def)
  apply (simp add: comp_var_env_def)
  apply (auto)
  apply (erule_tac x="a" in allE)
  apply (case_tac "r_sv a = XPerm (SPerm NoPerm) \<and> r_xv a = XPerm (SPerm NoPerm)")
   apply (auto)
  done

lemma dir_add_eq_permx: "\<lbrakk> tvar_set px \<subseteq> ds; a \<notin> ds \<rbrakk> \<Longrightarrow>
  dir_subst_permx (dir_add_env t_sub a tau) p_sub px = dir_subst_permx t_sub p_sub px"
  apply (induct px)
      apply (auto)
  apply (case_tac "t_sub x")
   apply (auto)
   apply (simp_all add: dir_add_env_def)
   apply (auto)
  done

lemma dir_add_cancel_use_env_ih: "\<lbrakk> tvar_range r_sv ds; a \<notin> ds \<rbrakk> \<Longrightarrow>
  dir_subst_penv (dir_add_env t_sub a tau) p_sub r_sv x = dir_subst_penv t_sub p_sub r_sv x"
  apply (simp add: dir_subst_penv_def)
  apply (cut_tac t_sub="t_sub" and a="a" and ds="ds" and px="r_sv x" in dir_add_eq_permx)
    apply (simp add: tvar_range_def)
   apply (simp_all)
  done

lemma dir_list_add_cancel_use_env_ih: "\<lbrakk> tvar_range r_sv ds; fresh_list ds (dom_list l) \<rbrakk> \<Longrightarrow>
  dir_subst_penv (dir_list_add_env t_sub l) p_sub r_sv x = dir_subst_penv t_sub p_sub r_sv x"
  apply (induct l)
   apply (auto)
  apply (simp add: dir_subst_penv_def)
  apply (cut_tac t_sub="dir_list_add_env t_sub l" and p_sub="p_sub" and a="a" and tau="b" and x="x" and ds="ds" in dir_add_cancel_use_env_ih)
    apply (auto)
   apply (simp add: fresh_list_def)
   apply (auto)
  apply (simp add: dir_subst_penv_def)
  apply (simp add: fresh_list_def)
  done

lemma dir_list_add_cancel_use_env: "\<lbrakk> tvar_range r_sv ds; fresh_list ds (dom_list l) \<rbrakk> \<Longrightarrow>
  dir_subst_penv (dir_list_add_env t_sub l) p_sub r_sv = dir_subst_penv t_sub p_sub r_sv"
  apply (case_tac "\<forall> x. dir_subst_penv (dir_list_add_env t_sub l) p_sub r_sv x = dir_subst_penv t_sub p_sub r_sv x")
   apply (auto)
  apply (cut_tac t_sub="t_sub" and x="x" in dir_list_add_cancel_use_env_ih)
    apply (auto)
  done

lemma ifz_tvar_range: "\<lbrakk> tvar_range r_sv ds; tvar_set px \<subseteq> ds \<rbrakk> \<Longrightarrow> tvar_range (ifz_var_env px r_sv) ds"
  apply (simp add: tvar_range_def)
  apply (simp add: ifz_var_env_def)
  done

lemma infer_s_sub_range: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds' \<rbrakk> \<Longrightarrow> pvar_range r_sv (set_diff ds' ds) \<and> pvar_range r_xv (set_diff ds' ds)"
  apply (induct e arbitrary: env_v ds tau_v r_sv r_xv r_mv c_list ds')
        apply (auto)
    (* const + op + var cases *)
             apply (rule_tac empty_pvar_range)
            apply (rule_tac empty_pvar_range)
           apply (simp add: pvar_range_def)
           apply (simp add: one_var_env_def)
          apply (simp add: pvar_range_def)
          apply (simp add: one_var_env_def)
    (* pair case *)
         apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
          apply (auto)
         apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
          apply (auto)
         apply (rule_tac comp_pvar_range)
          apply (rule_tac comp_pvar_range)
           apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
            apply (simp)
           apply (simp add: set_diff_def)
           apply (auto)
          apply (rule_tac lift_pvar_range)
           apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
            apply (simp)
           apply (simp add: set_diff_def)
           apply (auto)
          apply (simp add: set_diff_def)
          apply (auto)
          apply (rule_tac comp_pvar_range)
          apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
           apply (simp)
          apply (simp add: set_diff_def)
          apply (auto)
         apply (rule_tac lift_pvar_range)
          apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
           apply (simp)
          apply (simp add: set_diff_def)
          apply (auto)
         apply (simp add: set_diff_def)
         apply (auto)
        apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
         apply (auto)
        apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
         apply (auto)
        apply (rule_tac ifz_pvar_range)
         apply (rule_tac comp_pvar_range)
          apply (rule_tac lift_pvar_range)
           apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
            apply (auto)
           apply (simp add: set_diff_def)
           apply (auto)
          apply (simp add: set_diff_def)
          apply (auto)
         apply (rule_tac lift_pvar_range)
          apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
           apply (auto)
          apply (simp add: set_diff_def)
          apply (auto)
         apply (simp add: set_diff_def)
         apply (auto)
        apply (simp add: set_diff_def)
        apply (auto)
    (* if case *)
       apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
        apply (auto)
       apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
        apply (auto)
       apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
        apply (auto)
       apply (rule_tac comp_pvar_range)
        apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
         apply (simp)
        apply (simp add: set_diff_def)
        apply (auto)
       apply (rule_tac comp_pvar_range)
        apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
         apply (simp)
        apply (simp add: set_diff_def)
        apply (auto)
       apply (rule_tac ds="set_diff ds' ds3" in subset_pvar_range)
        apply (simp)
       apply (simp add: set_diff_def)
       apply (auto)
      apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
       apply (auto)
      apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
       apply (auto)
      apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
       apply (auto)
      apply (rule_tac comp_pvar_range)
       apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
        apply (auto)
       apply (simp add: set_diff_def)
       apply (auto)
      apply (rule_tac ds="set_diff ds' ds3" in subset_pvar_range)
       apply (auto)
      apply (simp add: set_diff_def)
      apply (auto)
    (* lam case *)
     apply (cut_tac ds="insert a ds" and ds'="ds2" in infer_x_subset)
      apply (auto)
     apply (rule_tac rem_pvar_range)
     apply (rule_tac ds="set_diff ds2 (insert a ds)" in subset_pvar_range)
      apply (simp)
     apply (simp add: set_diff_def)
    apply (auto)
    apply (cut_tac ds="insert a ds" and ds'="ds2" in infer_x_subset)
     apply (auto)
    apply (rule_tac rem_pvar_range)
    apply (rule_tac ds="set_diff ds2 (insert a ds)" in subset_pvar_range)
     apply (simp)
    apply (simp add: set_diff_def)
    apply (auto)
    (* app case *)
   apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
    apply (auto)
   apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
    apply (auto)
   apply (rule_tac comp_pvar_range)
    apply (rule_tac comp_pvar_range)
     apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
      apply (simp)
     apply (simp add: set_diff_def)
     apply (auto)
    apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
     apply (simp)
    apply (simp add: set_diff_def)
    apply (auto)
   apply (rule_tac comp_pvar_range)
    apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
     apply (simp)
    apply (simp add: set_diff_def)
    apply (auto)
   apply (rule_tac lift_pvar_range)
    apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
     apply (simp)
    apply (simp add: set_diff_def)
    apply (auto)
   apply (simp add: set_diff_def)
   apply (auto)
   apply (case_tac "p \<in> ds3")
    apply (simp add: fresh_list_def)
    apply (auto)
  apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
   apply (auto)
  apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
   apply (auto)
  apply (rule_tac ifz_pvar_range)
   apply (rule_tac comp_pvar_range)
    apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
     apply (auto)
    apply (simp add: set_diff_def)
    apply (auto)
   apply (rule_tac lift_pvar_range)
    apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
     apply (auto)
    apply (simp add: set_diff_def)
    apply (auto)
   apply (simp add: set_diff_def)
   apply (auto)
   apply (case_tac "p \<in> ds3")
    apply (simp add: fresh_list_def)
    apply (auto)(*
  apply (simp add: set_diff_def)
  apply (case_tac "p_a \<in> ds3")
   apply (simp add: fresh_list_def)
   apply (auto)*)
  done

lemma add_sub_range: "\<lbrakk> sub_range env_v ds \<rbrakk> \<Longrightarrow> sub_range (add_env env_v x a) (insert a ds)"
  apply (simp add: sub_range_def)
  apply (simp add: add_env_def)
  apply (auto)
  apply (erule_tac x="xa" in allE)
  apply (case_tac "env_v xa")
   apply (auto)
  done

lemma infer_m_sub_range: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds' \<rbrakk> \<Longrightarrow> pvar_range r_mv (set_diff ds' ds)"
  apply (induct e arbitrary: env_v ds tau_v r_sv r_xv r_mv c_list ds')
        apply (auto)
    (* const + op + var cases *)
        apply (rule_tac empty_pvar_range)
       apply (rule_tac empty_pvar_range)
      apply (simp add: pvar_range_def)
      apply (simp add: one_var_env_def)
    (* pair case *)
     apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
      apply (auto)
     apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
      apply (auto)
     apply (rule_tac comp_pvar_range)
      apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
       apply (simp)
      apply (simp add: set_diff_def)
      apply (auto)
     apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
      apply (simp)
     apply (simp add: set_diff_def)
     apply (auto)
    (* if case *)
    apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
     apply (auto)
    apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
     apply (auto)
    apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
     apply (auto)
    apply (rule_tac comp_pvar_range)
     apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
      apply (auto)
     apply (simp add: set_diff_def)
     apply (auto)
    apply (rule_tac comp_pvar_range)
     apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
      apply (auto)
     apply (simp add: set_diff_def)
     apply (auto)
    apply (rule_tac ds="set_diff ds' ds3" in subset_pvar_range)
     apply (auto)
    apply (simp add: set_diff_def)
    apply (auto)
    (* lam case *)
   apply (rule_tac empty_pvar_range)
    (* app case *)
  apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
   apply (auto)
  apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
   apply (auto)
  apply (rule_tac comp_pvar_range)
   apply (rule_tac ds="set_diff ds2 ds" in subset_pvar_range)
    apply (rule_tac comp_pvar_range)
     apply (auto)
    apply (cut_tac env_v="env_v" and r_xv="r_x1" and ds'="ds2" in infer_s_sub_range)
     apply (auto)
   apply (simp add: set_diff_def)
   apply (auto)
  apply (rule_tac comp_pvar_range)
   apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
    apply (auto)
   apply (simp add: set_diff_def)
   apply (auto)
  apply (rule_tac lift_pvar_range)
   apply (rule_tac ds="set_diff ds3 ds2" in subset_pvar_range)
    apply (auto)
    apply (cut_tac env_v="env_v" and r_xv="r_x2" and ds'="ds3" in infer_s_sub_range)
     apply (auto)
   apply (simp add: set_diff_def)
   apply (auto)
  apply (case_tac "p \<in> ds3")
   apply (simp add: fresh_list_def)
   apply (auto)
  apply (simp add: set_diff_def)
  apply (auto)
  done

lemma rem_tvar_range: "\<lbrakk> tvar_range r_sv ds \<rbrakk> \<Longrightarrow> tvar_range (rem_var_env r_sv x) ds"
  apply (simp add: tvar_range_def)
  apply (simp add: rem_var_env_def)
  done

lemma subset_tvar_range: "\<lbrakk> tvar_range r_sv ds; ds \<subseteq> ds' \<rbrakk> \<Longrightarrow> tvar_range r_sv ds'"
  apply (simp add: tvar_range_def)
  apply (auto)
  done

lemma infer_tvar_range: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds'; sub_range env_v ds \<rbrakk> \<Longrightarrow>
    tvar_range r_sv ds' \<and> tvar_range r_xv ds'"
  apply (induct e arbitrary: env_v ds tau_v r_sv r_xv r_mv c_list ds')
        apply (auto)
    (* const + op + var cases *)
             apply (rule_tac empty_tvar_range)
            apply (rule_tac empty_tvar_range)
           apply (simp add: tvar_range_def)
           apply (simp add: one_var_env_def)
           apply (simp add: sub_range_def)
           apply (erule_tac x="owner_name x" in allE)
           apply (auto)
          apply (simp add: tvar_range_def)
          apply (simp add: one_var_env_def)
          apply (simp add: sub_range_def)
          apply (erule_tac x="owner_name x" in allE)
          apply (auto)
    (* pair case *)
         apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
          apply (auto)
         apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
          apply (auto)
         apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
           apply (auto)
         apply (rule_tac comp_tvar_range)
          apply (rule_tac ds="ds2" in subset_tvar_range)
           apply (auto)
          apply (rule_tac comp_tvar_range)
           apply (simp)
          apply (rule_tac lift_tvar_range)
           apply (auto)
         apply (rule_tac ds="ds3" in subset_tvar_range)
          apply (auto)
         apply (rule_tac comp_tvar_range)
          apply (simp)
         apply (rule_tac lift_tvar_range)
          apply (auto)
        apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
         apply (auto)
        apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
         apply (auto)
        apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
          apply (auto)
        apply (rule_tac ifz_tvar_range)
         apply (rule_tac comp_tvar_range)
          apply (rule_tac lift_tvar_range)
           apply (rule_tac ds="ds2" in subset_tvar_range)
            apply (auto)
        apply (rule_tac lift_tvar_range)
         apply (auto)
        apply (rule_tac ds="ds3" in subset_tvar_range)
         apply (auto)
    (* if case *)
       apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
        apply (auto)
       apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
        apply (auto)
       apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
        apply (auto)
       apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
         apply (auto)
       apply (cut_tac env_v="env_v" and ds="ds2" and ds'="ds3" in subset_sub_range)
         apply (auto)
       apply (rule_tac comp_tvar_range)
        apply (rule_tac ds="ds2" in subset_tvar_range)
         apply (auto)
       apply (rule_tac comp_tvar_range)
        apply (auto)
       apply (rule_tac ds="ds3" in subset_tvar_range)
        apply (auto)
      apply (rule_tac ds="ds'" in subset_tvar_range)
       apply (auto)
      apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
       apply (auto)
      apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
       apply (auto)
      apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
       apply (auto)
      apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
        apply (auto)
      apply (cut_tac env_v="env_v" and ds="ds2" and ds'="ds3" in subset_sub_range)
        apply (auto)
      apply (rule_tac comp_tvar_range)
       apply (auto)
      apply (rule_tac ds="ds3" in subset_tvar_range)
       apply (auto)
    (* lam case *)
     apply (cut_tac env_v="env_v" and ds="ds" and x="Var x1a" and a="a" in add_sub_range)
      apply (auto)
     apply (rule_tac rem_tvar_range)
     apply (rule_tac ds="ds2" in subset_tvar_range)
      apply (auto)
    apply (cut_tac env_v="env_v" and ds="ds" and x="Var x1a" and a="a" in add_sub_range)
     apply (auto)
    apply (rule_tac rem_tvar_range)
    apply (rule_tac ds="ds2" in subset_tvar_range)
     apply (auto)
    (* app case *)
   apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
    apply (auto)
   apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
    apply (auto)
   apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
     apply (auto)
   apply (rule_tac comp_tvar_range)
    apply (rule_tac ds="ds2" in subset_tvar_range)
     apply (auto)
    apply (rule_tac comp_tvar_range)
     apply (auto)
   apply (rule_tac ds="ds3" in subset_tvar_range)
    apply (auto)
   apply (rule_tac comp_tvar_range)
    apply (auto)
   apply (rule_tac lift_tvar_range)
    apply (auto)
  apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
   apply (auto)
  apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
   apply (auto)
  apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
    apply (auto)
  apply (rule_tac ifz_tvar_range)
   apply (rule_tac comp_tvar_range)
    apply (rule_tac ds="ds2" in subset_tvar_range)
     apply (auto)
  apply (rule_tac lift_tvar_range)
   apply (rule_tac ds="ds3" in subset_tvar_range)
    apply (auto)
  done

lemma infer_m_tvar_range: "\<lbrakk> infer_type env_v ds e tau_v r_sv r_xv r_mv c_list ds'; sub_range env_v ds \<rbrakk> \<Longrightarrow> tvar_range r_mv ds'"
  apply (induct e arbitrary: env_v ds tau_v r_sv r_xv r_mv c_list ds')
        apply (auto)
    (* const + op + var cases *)
        apply (rule_tac empty_tvar_range)
       apply (rule_tac empty_tvar_range)
      apply (simp add: tvar_range_def)
      apply (simp add: one_var_env_def)
      apply (simp add: sub_range_def)
      apply (erule_tac x="owner_name x" in allE)
      apply (auto)
    (* pair case *)
     apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
      apply (auto)
     apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
      apply (auto)
     apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
       apply (auto)
     apply (rule_tac comp_tvar_range)
      apply (rule_tac ds="ds2" in subset_tvar_range)
       apply (auto)
     apply (rule_tac ds="ds3" in subset_tvar_range)
      apply (auto)
    (* if case *)
    apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
     apply (auto)
    apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
     apply (auto)
    apply (cut_tac ds="ds3" and ds'="ds'" in infer_x_subset)
     apply (auto)
    apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
      apply (auto)
    apply (cut_tac env_v="env_v" and ds="ds2" and ds'="ds3" in subset_sub_range)
      apply (auto)
    apply (rule_tac comp_tvar_range)
     apply (rule_tac ds="ds2" in subset_tvar_range)
      apply (auto)
    apply (rule_tac comp_tvar_range)
     apply (rule_tac ds="ds3" in subset_tvar_range)
      apply (auto)
    (* lam case *)
  apply (rule_tac empty_tvar_range)
    (* app case *)
  apply (cut_tac ds="ds" and ds'="ds2" in infer_x_subset)
   apply (auto)
  apply (cut_tac ds="ds2" and ds'="ds3" in infer_x_subset)
   apply (auto)
  apply (cut_tac env_v="env_v" and ds="ds" and ds'="ds2" in subset_sub_range)
    apply (auto)
  apply (rule_tac comp_tvar_range)
   apply (rule_tac ds="ds2" in subset_tvar_range)
    apply (rule_tac comp_tvar_range)
     apply (auto)
   apply (cut_tac env_v="env_v" and r_xv="r_x1" and ds'="ds2" in infer_tvar_range)
     apply (auto)
  apply (rule_tac comp_tvar_range)
   apply (rule_tac ds="ds3" in subset_tvar_range)
    apply (auto)
  apply (rule_tac lift_tvar_range)
   apply (rule_tac ds="ds3" in subset_tvar_range)
    apply (auto)
  apply (cut_tac env_v="env_v" and ds="ds2" and r_xv="r_x2" and ds'="ds3" in infer_tvar_range)
    apply (auto)
  done

fun tvar_type where
  "tvar_type IntScheme = {}"
  | "tvar_type BoolScheme = {}"
  | "tvar_type UnitScheme = {}"
  | "tvar_type (VarScheme a) = {a}"
  | "tvar_type (ArrayScheme tau) = tvar_type tau"
  | "tvar_type (PairScheme t1 t2 p) = tvar_type t1 \<union> tvar_type t2"
  | "tvar_type (FunScheme t1 t2 p a) = tvar_type t1 \<union> tvar_type t2"
  | "tvar_type (ChanScheme tau c_end) = tvar_type tau"

end