(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory ArchDetype_AI
imports Detype_AI
begin

context Arch begin global_naming ARM

named_theorems Detype_AI_asms

lemma valid_globals_irq_node[Detype_AI_asms]:
    "\<lbrakk> valid_global_refs s; cte_wp_at ((=) cap) ptr s \<rbrakk>
          \<Longrightarrow> interrupt_irq_node s irq \<notin> cap_range cap"
    apply (erule(1) valid_global_refsD)
    apply (simp add: global_refs_def)
    done

lemma caps_of_state_ko[Detype_AI_asms]:
  "valid_cap cap s
   \<Longrightarrow> is_untyped_cap cap \<or>
       cap_range cap = {} \<or>
       (\<forall>ptr \<in> cap_range cap. \<exists>ko. kheap s ptr = Some ko)"
  apply (case_tac cap)
    apply (clarsimp simp: cap_range_def valid_cap_def obj_at_def is_cap_simps
                   split: option.splits)+
  apply (rename_tac arch_cap ptr)
  apply (case_tac arch_cap)
    apply (fastforce simp: cap_range_def obj_at_def is_cap_simps
                    split: option.splits if_splits)+
  done

lemma mapM_x_storeWord[Detype_AI_asms]:
(* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *)
  assumes al: "is_aligned ptr word_size_bits"
  shows "mapM_x (\<lambda>x. storeWord (ptr + of_nat x * word_size) 0) [0..<n]
  = modify (underlying_memory_update
             (\<lambda>m x. if \<exists>k. x = ptr + of_nat k \<and> k < n * word_size then 0 else m x))"
proof (induct n)
  case 0
  thus ?case
    apply (rule ext)
    apply (simp add: mapM_x_mapM mapM_def sequence_def
      modify_def get_def put_def bind_def return_def)
    done
next
  case (Suc n')

  have funs_eq:
    "\<And>m x. (if \<exists>k. x = ptr + of_nat k \<and> k < 4 + n' * 4 then 0
             else (m x :: word8)) =
           ((\<lambda>xa. if \<exists>k. xa = ptr + of_nat k \<and> k < n' * 4 then 0 else m xa)
           (ptr + of_nat n' * 4 := word_rsplit (0 :: word32) ! 3,
            ptr + of_nat n' * 4 + 1 := word_rsplit (0 :: word32) ! 2,
            ptr + of_nat n' * 4 + 2 := word_rsplit (0 :: word32) ! Suc 0,
            ptr + of_nat n' * 4 + 3 := word_rsplit (0 :: word32) ! 0)) x"
  proof -
    fix m x

    have xin': "\<And>x. (x < 4 + n' * 4) = (x < n' * 4 \<or> x = n' * 4
                     \<or> x = (n' * 4) + 1 \<or> x = (n' * 4) + 2 \<or> x = (n' * 4) + 3)"
      by (safe, simp_all)

    have xin: "(EX k. x = ptr + of_nat k \<and> k < 4 + n' * 4) =
               ((\<exists>k. x = ptr + of_nat k \<and> k < n' * 4) \<or>
                x = ptr + of_nat n' * 4 \<or> x = ptr + of_nat n' * 4 + 1 \<or>
                x = ptr + of_nat n' * 4 + 2 \<or> x = ptr + of_nat n' * 4 + 3)"
      by (simp add: xin' conj_disj_distribL ex_disj_distrib field_simps)

    show "?thesis m x" by (simp add: xin word_rsplit_0 word_bits_conv cong: if_cong)
  qed

  from al have "is_aligned (ptr + of_nat n' * 4) 2"
    apply (rule aligned_add_aligned)
    apply (rule is_aligned_mult_triv2 [where n = 2, simplified])
    apply (simp add: word_bits_conv word_size_bits_def)+
    done

  thus ?case
    apply (simp add: mapM_x_append bind_assoc Suc.hyps mapM_x_singleton)
    apply (simp add: storeWord_def assert_def is_aligned_mask modify_modify
                     comp_def word_size_def)
    apply (simp only: funs_eq)
    done
qed

lemma empty_fail_freeMemory [Detype_AI_asms]: "empty_fail (freeMemory ptr bits)"
  by (fastforce simp: freeMemory_def mapM_x_mapM ef_storeWord)

lemma region_in_kernel_window_detype[simp]:
  "region_in_kernel_window S (detype S' s)
      = region_in_kernel_window S s"
  by (simp add: region_in_kernel_window_def detype_def)

lemma region_in_kernel_window_machine_state_update[simp]:
  "region_in_kernel_window S (machine_state_update f s) =
   region_in_kernel_window S s"
  by (simp add: region_in_kernel_window_def)

lemma region_in_kernel_window_delete_objects[wp]:
  "\<lbrace>region_in_kernel_window S\<rbrace>
   delete_objects ptr bits
   \<lbrace>\<lambda>_. region_in_kernel_window S\<rbrace>"
  by (wp | simp add: delete_objects_def do_machine_op_def split_def)+

lemma state_hyp_refs_of_detype:
  "state_hyp_refs_of (detype S s) = (\<lambda>x. if x \<in> S then {} else state_hyp_refs_of s x)"
  by (rule ext, simp add: state_hyp_refs_of_def detype_def)

lemma valid_ioports_detype[Detype_AI_asms]:
  "valid_ioports s \<Longrightarrow> valid_ioports (detype (untyped_range cap) s)"
  by auto

end

interpretation Detype_AI?: Detype_AI
  proof goal_cases
  interpret Arch .
  case 1 show ?case
  by (intro_locales; (unfold_locales; fact Detype_AI_asms)?)
  qed

context detype_locale_arch begin

named_theorems detype_invs_proofs

lemma state_hyp_refs: "state_hyp_refs_of (detype (untyped_range cap) s) = state_hyp_refs_of s"
  apply (rule ext, clarsimp simp add: state_hyp_refs_of_detype)
  apply (rule sym, rule equals0I, drule state_hyp_refs_of_elemD)
  apply (drule live_okE, rule hyp_refs_of_live, clarsimp)
  apply simp
  done

lemma hyp_refsym : "sym_refs (state_hyp_refs_of s)"
  using invs by (simp add: invs_def valid_state_def valid_pspace_def)

lemma hyp_refs_of: "\<And>obj p. \<lbrakk> ko_at obj p s \<rbrakk> \<Longrightarrow> hyp_refs_of obj \<subseteq> (UNIV - untyped_range cap \<times> UNIV)"
  by (fastforce intro: hyp_refs_of_live dest!: hyp_sym_refs_ko_atD[OF _ hyp_refsym] live_okE)

lemma arch_valid_obj[detype_invs_proofs]:
    "\<And>p ao. \<lbrakk>ko_at (ArchObj ao) p s; arch_valid_obj ao s\<rbrakk>
       \<Longrightarrow> arch_valid_obj ao (detype (untyped_range cap) s)"
  apply (frule hyp_refs_of)
  apply (auto simp: arch_valid_obj_def split: arch_kernel_obj.splits option.splits)
  done

lemma sym_hyp_refs_detype[detype_invs_proofs]:
  "sym_refs (state_hyp_refs_of (detype (untyped_range cap) s))"
  using hyp_refsym by (simp add: state_hyp_refs)

lemma valid_cap[detype_invs_proofs]:
    "\<And>cap'. \<lbrakk> s \<turnstile> cap'; obj_reply_refs cap' \<subseteq> (UNIV - untyped_range cap) \<rbrakk>
      \<Longrightarrow> detype (untyped_range cap) s \<turnstile> cap'"
  by (auto simp: valid_cap_def valid_untyped_def obj_reply_refs_def
          split: cap.split_asm option.splits if_splits
                 arch_cap.split_asm bool.split_asm )

lemma glob_det[detype_invs_proofs]: "\<And>r. global_refs (detype r s) = global_refs s"
    by (simp add: global_refs_def detype_def)

lemma valid_idle_detype[detype_invs_proofs]: "valid_idle (detype (untyped_range cap) s)"
    proof -
    have "valid_idle s" using invs by (simp add: invs_def valid_state_def)
    thus ?thesis using valid_global_refsD [OF globals cap]
    by (fastforce simp add: valid_idle_def state_refs idle cap_range_def
                            global_refs_def)
    qed

lemma valid_vs_lookup: "valid_vs_lookup s"
    using valid_arch_caps by (simp add: valid_arch_caps_def)

lemma hyp_live_strg:
  "hyp_live ko \<Longrightarrow> live ko"
  by (cases ko; simp add: live_def hyp_live_def)

lemma obj_at_hyp_live_strg:
  "obj_at hyp_live p s \<Longrightarrow> obj_at live p s"
  by (erule obj_at_weakenE, rule hyp_live_strg)

lemma tcb_arch_detype[detype_invs_proofs]:
  "\<lbrakk>ko_at (TCB t) p s; valid_arch_tcb (tcb_arch t) s\<rbrakk>
      \<Longrightarrow> valid_arch_tcb (tcb_arch t) (detype (untyped_range cap) s)"
  apply (clarsimp simp: valid_arch_tcb_def)
  done

lemma valid_arch_state_detype[detype_invs_proofs]:
  "valid_arch_state (detype (untyped_range cap) s)"
  using valid_vs_lookup valid_arch_state ut_mdb valid_global_refsD [OF globals cap] cap
  apply (simp add: valid_arch_state_def valid_asid_table_def
                valid_global_pts_def global_refs_def
                cap_range_def)
  apply (clarsimp simp: ran_def arch_state_det)
  apply (drule vs_lookup_atI)
  apply (drule (1) valid_vs_lookupD[OF vs_lookup_pages_vs_lookupI])
  apply (clarsimp simp: cte_wp_at_caps_of_state)
  apply (drule untyped_mdbD, rule untyped, assumption)
    apply blast
   apply assumption
  apply (drule descendants_range_inD[OF drange])
    apply (simp add: cte_wp_at_caps_of_state)
  apply (simp add: cap_range_def)
  apply blast
  done

lemma global_pts: (* ARCH SPECIFIC STATEMENT*)
  "\<And>p. \<lbrakk> p \<in> set (arm_global_pts (arch_state s)); p \<in> untyped_range cap \<rbrakk>  \<Longrightarrow> False"
  using valid_global_refsD [OF globals cap] by (simp add: cap_range_def global_refs_def)

lemma vs_lookup: (* SIMP *)
  "vs_lookup (detype (untyped_range cap) s) = vs_lookup s"
  apply (rule set_eqI)
  apply clarsimp
  apply (rule iffI)
   apply (erule vs_lookup_induct)
    apply (simp add: arch_state_det)
    apply (erule vs_lookup_atI)
   apply (erule vs_lookup_step)
   apply (clarsimp simp: vs_lookup1_def)
  apply (erule vs_lookup_induct)
   apply (rule vs_lookup_atI)
   apply (simp add: arch_state_det)
  apply (erule vs_lookup_step)
  apply (clarsimp simp: vs_lookup1_def)
  apply (drule valid_vs_lookupD[OF vs_lookup_pages_vs_lookupI], rule valid_vs_lookup)
  apply (elim conjE exE)
  apply (insert cap)
  apply (simp add: cte_wp_at_caps_of_state)
  apply (drule untyped_mdbD, rule untyped, assumption)
    apply blast
   apply (rule ut_mdb)
  apply (drule descendants_range_inD[OF drange])
    apply (simp add: cte_wp_at_caps_of_state)
  apply (simp add: cap_range_def)
  apply blast
  done

lemma vs_lookup_pages: (* SIMP *)
  "vs_lookup_pages (detype (untyped_range cap) s) = vs_lookup_pages s"
  apply (rule set_eqI)
  apply clarsimp
  apply (rule iffI)
   apply (erule vs_lookup_pages_induct)
    apply (simp add: arch_state_det)
    apply (erule vs_lookup_pages_atI)
   apply (erule vs_lookup_pages_step)
   apply (clarsimp simp: vs_lookup_pages1_def)
  apply (erule vs_lookup_pages_induct)
   apply (rule vs_lookup_pages_atI)
   apply (simp add: arch_state_det)
  apply (erule vs_lookup_pages_step)
  apply (clarsimp simp: vs_lookup_pages1_def)
  apply (drule valid_vs_lookupD, rule valid_vs_lookup)
  apply (elim conjE exE)
  apply (insert cap)
  apply (simp add: cte_wp_at_caps_of_state)
  apply (drule untyped_mdbD, rule untyped, assumption)
    apply blast
   apply (rule ut_mdb)
  apply (drule descendants_range_inD[OF drange])
    apply (simp add: cte_wp_at_caps_of_state)
  apply (simp add: cap_range_def)
  apply blast
  done

lemma vs_lookup_preserved:
  "\<And>x rf. \<lbrakk> x \<in> untyped_range cap; (rf \<rhd> x) s \<rbrakk> \<Longrightarrow> False"
  apply (drule valid_vs_lookupD[OF vs_lookup_pages_vs_lookupI valid_vs_lookup])
  apply (fastforce intro: global_pts no_obj_refs)
  done

lemma vs_lookup_pages_preserved:
  "\<And>x rf. \<lbrakk> x \<in> untyped_range cap; (rf \<unrhd> x) s \<rbrakk> \<Longrightarrow> False"
  apply (drule valid_vs_lookupD[OF _ valid_vs_lookup])
  apply (fastforce intro: global_pts no_obj_refs)
  done

context begin

private method crush for i =
  (simp add: data_at_def obj_at_def;
   elim disjE exE conjE;
   clarsimp;
   erule vs_lookup_pages_preserved;
   erule vs_lookup_pages_step;
   clarsimp simp: vs_lookup_pages1_def obj_at_def vs_refs_pages_def;
   strengthen image_eqI;
   clarsimp simp: graph_of_def pte_ref_pages_def pde_ref_pages_def;
   rule exI;
   strengthen refl;
   simp;
   rule exI[of _ i];
   fastforce)

lemma valid_vspace_obj:
  "\<And>ao p. \<lbrakk> valid_vspace_obj ao s; ko_at (ArchObj ao) p s; (\<exists>\<rhd>p) s \<rbrakk> \<Longrightarrow>
       valid_vspace_obj ao (detype (untyped_range cap) s)"
  apply (case_tac ao; simp; erule allEI ballEI; clarsimp simp: ran_def;
         drule vs_lookup_pages_vs_lookupI)
  subgoal for p t r ref i by (crush i)
  subgoal for p t i ref by (cases "t i"; crush i)
  subgoal for p t i ref by (cases "t i"; crush i)
  done

end

lemma valid_vspace_obj_detype[detype_invs_proofs]: "valid_vspace_objs (detype (untyped_range cap) s)"
  proof -
    have "valid_vspace_objs s"
    using invs by fastforce
    thus ?thesis
    unfolding valid_vspace_objs_def
    apply (simp add: vs_lookup)
    apply (auto intro: valid_vspace_obj)
    done
  qed

lemma unique_table_caps:
    "\<And>cps P. unique_table_caps cps
             \<Longrightarrow> unique_table_caps (\<lambda>x. if P x then None else cps x)"
    by (simp add: unique_table_caps_def)

end

sublocale detype_locale < detype_locale_gen_1
 proof goal_cases
  interpret detype_locale_arch ..
  case 1 show ?case
  by (intro_locales; (unfold_locales; fact detype_invs_proofs)?)
  qed

context detype_locale_arch begin

lemma valid_vs_lookup':  (* LOCAL DUP NAME *)
  "valid_vs_lookup s \<Longrightarrow> valid_vs_lookup (detype (untyped_range cap) s)"
  apply (simp add: valid_vs_lookup_def vs_lookup_pages del: split_paired_Ex)
  apply (elim allEI)
  apply (intro disjCI2 impI)
  apply (drule(1) mp)+
  apply (elim conjE)
  apply (erule exEI)
  apply clarsimp
  apply (drule non_null_caps)
   apply clarsimp+
  done

lemma valid_table_caps:
  "valid_table_caps s \<Longrightarrow> valid_table_caps (detype (untyped_range cap) s)"
  apply (simp add: valid_table_caps_def del: imp_disjL)
  apply (elim allEI | rule impI)+
  apply clarsimp
  apply (metis detype_arch_state no_obj_refs)
  done

lemma unique_table_refs:
    "\<And>cps P. unique_table_refs cps
             \<Longrightarrow> unique_table_refs (\<lambda>x. if P x then None else cps x)"
    apply (simp only: unique_table_refs_def option.simps
                      simp_thms
               split: if_split)
    apply blast
    done

lemma valid_arch_caps_detype[detype_invs_proofs]: "valid_arch_caps (detype (untyped_range cap) s)"
  using valid_arch_caps  by (simp add: valid_arch_caps_def
                                       unique_table_caps
                                       valid_vs_lookup'
                                       unique_table_refs
                                       valid_table_caps)

lemma pd_at_global_pd: "page_directory_at (arm_global_pd (arch_state s)) s"
  using valid_arch_state by (simp add: valid_arch_state_def)

lemma valid_global_objs_detype[detype_invs_proofs]: "valid_global_objs (detype (untyped_range cap) s)"
  using valid_global_objs valid_global_refsD [OF globals cap]
  apply (simp add: valid_global_objs_def valid_vso_at_def arch_state_det)
  apply (elim conjE, intro conjI)
     apply (simp add: global_refs_def cap_range_def arch_state_det)
    apply (erule exEI)
    apply (insert pd_at_global_pd)[1]
    subgoal by (clarsimp simp: obj_at_def a_type_simps empty_table_def arch_state_det)
   apply (simp add: global_refs_def cap_range_def)
  apply (clarsimp elim!: global_pts)
  done

lemma valid_kernel_mappings_detype[detype_invs_proofs]: "valid_kernel_mappings (detype (untyped_range cap) s)"
  proof -
    have "valid_kernel_mappings s"
      using invs by (simp add: invs_def valid_state_def)
    thus ?thesis by (simp add: valid_kernel_mappings_def detype_def
                  ball_ran_eq)
  qed

lemma valid_asid_map_detype[detype_invs_proofs]: "valid_asid_map (detype (untyped_range cap) s)"
proof -
  have "valid_asid_map s"
  using invs by (simp add: invs_def valid_state_def)
  thus ?thesis
  apply (clarsimp simp: valid_asid_map_def arch_state_det)
  apply (drule bspec)
  apply (blast)
  apply (clarsimp simp: vspace_at_asid_def vs_lookup)
  done
  qed

lemma equal_kernel_mappings_detype[detype_invs_proofs]:
  "equal_kernel_mappings (detype (untyped_range cap) s)"
  proof -
    have "equal_kernel_mappings s"
      using invs by (simp add: invs_def valid_state_def)
    thus ?thesis
      apply (simp add: equal_kernel_mappings_def)
      apply blast
      done
  qed

lemma valid_global_mappings_detype[detype_invs_proofs]:
  "valid_global_vspace_mappings (detype (untyped_range cap) s)"
proof -
  have "valid_global_vspace_mappings s"
    using invs by (simp add: invs_def valid_state_def)
  thus ?thesis
  using valid_global_refsD [OF globals cap] valid_global_objs
  apply -
  apply (erule valid_global_vspace_mappings_pres, simp_all)
   apply (simp add: cap_range_def global_refs_def arch_state_det)+
  done
qed

lemma pspace_in_kernel_window_detype[detype_invs_proofs]:
  "pspace_in_kernel_window (detype (untyped_range cap) s)"
proof -
  have "pspace_in_kernel_window s"
    using invs by (simp add: invs_def valid_state_def)
  thus ?thesis
    apply (simp add: pspace_in_kernel_window_def arch_state_det)
    apply fastforce
    done
qed

lemma in_user_frame_eq:
  notes [simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
                     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
                     order_class.Icc_eq_Icc
    and [simp] = p2pm1_to_mask
  shows "p \<notin> untyped_range cap \<Longrightarrow> in_user_frame p
              (trans_state (\<lambda>_. detype_ext (untyped_range cap) (exst s)) s
               \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
         = in_user_frame p s"
    using cap_is_valid untyped
    apply (cases cap; simp add: in_user_frame_def valid_untyped_def valid_cap_def obj_at_def)
    apply (rule iffI; erule exEI; elim conjE exE; simp)
    subgoal for dev ptr n f sz ko
      apply (elim allE; erule (1) impE)
      apply (drule valid_pspace_aligned[OF valid_pspace])
      apply (clarsimp simp: obj_range_def)
      apply (erule impE)
       apply (erule not_emptyI[rotated])
       apply (rule mask_in_range[THEN iffD1, simplified])
        apply (simp add: is_aligned_neg_mask)
       apply (simp add: mask_lower_twice)
      apply (cut_tac mask_in_range[THEN iffD1, simplified, OF is_aligned_neg_mask[OF le_refl] refl])
      apply fastforce
      done
    done

lemma in_device_frame_eq:
  notes blah[simp del] =  atLeastAtMost_iff
          atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
          order_class.Icc_eq_Icc
     and  p2pm1[simp] = p2pm1_to_mask
  shows "p \<notin> untyped_range cap
       \<Longrightarrow> in_device_frame p
              (trans_state (\<lambda>_. detype_ext (untyped_range cap) (exst s)) s
               \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
         = in_device_frame p s"
    using cap_is_valid untyped
    unfolding in_device_frame_def
    apply (cases cap; simp add: in_device_frame_def valid_untyped_def valid_cap_def obj_at_def)
    apply (rule iffI; erule exEI; elim conjE exE; simp)
    subgoal for dev ptr n f sz ko
      apply (elim allE; erule (1) impE)
      apply (drule valid_pspace_aligned[OF valid_pspace])
      apply (clarsimp simp: obj_range_def)
      apply (erule impE)
       apply (erule not_emptyI[rotated])
       apply (rule mask_in_range[THEN iffD1, simplified])
        apply (simp add: is_aligned_neg_mask)
       apply (simp add: mask_lower_twice)
      apply (cut_tac mask_in_range[THEN iffD1, simplified, OF is_aligned_neg_mask[OF le_refl] refl])
      apply fastforce
      done
    done

lemma pspace_respects_device_region_detype[detype_invs_proofs]:
  "pspace_respects_device_region (clear_um (untyped_range cap) (detype (untyped_range cap) s))"
  proof -
  have "pspace_respects_device_region s"
    using invs by (simp add: invs_def valid_state_def)
  thus ?thesis
    apply (intro pspace_respects_device_regionI)
    using pspace_aligned_detype valid_objs_detype invs
    apply (simp_all add: clear_um.pspace detype_def dom_def clear_um_def
                  split: if_split_asm )
       apply (drule pspace_respects_device_regionD[rotated -1],auto)+
    done
  qed

lemma cap_refs_respects_device_region_detype[detype_invs_proofs]:
  "cap_refs_respects_device_region (clear_um (untyped_range cap) (detype (untyped_range cap) s))"
  proof -
  have "cap_refs_respects_device_region s"
    using invs by (simp add: invs_def valid_state_def)
  thus ?thesis
    apply (clarsimp simp: clear_um_def cap_refs_respects_device_region_def
                simp del: split_paired_All split_paired_Ex)
    apply (drule_tac x = "(a,b)" in spec)
    apply (clarsimp simp: cte_wp_at_caps_of_state cap_range_respects_device_region_def detype_def)
    done
  qed

lemma valid_machine_state_detype[detype_invs_proofs]:
    "valid_machine_state (clear_um (untyped_range cap) (detype (untyped_range cap) s))"
  proof -
    have "valid_machine_state s" using invs by (simp add: invs_def valid_state_def)
    thus ?thesis
    using untyped cap_is_valid
    by (clarsimp simp: valid_machine_state_def clear_um_def
      detype_def in_user_frame_eq in_device_frame_eq)
  qed
end

sublocale detype_locale < detype_locale_gen_2
 proof goal_cases
  interpret detype_locale_arch ..
  case 1 show ?case
  by (intro_locales; (unfold_locales; fact detype_invs_proofs)?)
  qed

context detype_locale begin
  lemmas invariants = invariants
  lemmas non_filter_detype = non_filter_detype
  lemmas valid_cap = valid_cap
  lemmas non_null_present = non_null_present
end

interpretation Detype_AI_2
  using detype_locale.invariants[simplified detype_locale_def]
        Detype_AI_2.intro
        by blast

context begin interpretation Arch .
lemma delete_objects_invs[wp]:
  "\<lbrace>(\<lambda>s. \<exists>slot. cte_wp_at ((=) (cap.UntypedCap dev ptr bits f)) slot s
    \<and> descendants_range (cap.UntypedCap dev ptr bits f) slot s) and
    invs and ct_active\<rbrace>
    delete_objects ptr bits \<lbrace>\<lambda>_. invs\<rbrace>"
  apply (simp add: delete_objects_def)
  apply (simp add: freeMemory_def word_size_def bind_assoc
                   empty_fail_mapM_x ef_storeWord)
   apply (rule hoare_pre)
   apply (rule_tac G="is_aligned ptr bits \<and> word_size_bits \<le> bits \<and> bits \<le> word_bits"
                in hoare_grab_asm)
   apply (simp add: mapM_storeWord_clear_um[unfolded word_size_def]
                    intvl_range_conv[where 'a=machine_word_len, folded word_bits_def])
   apply wp
  apply clarsimp
  apply (frule invs_untyped_children)
  apply (frule detype_invariants, clarsimp+)
  apply (drule invs_valid_objs)
  apply (drule (1) cte_wp_valid_cap)
  apply (simp add: valid_cap_def cap_aligned_def word_size_bits_def untyped_min_bits_def)
  done
end

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_inv__57_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__57_on_rules imports n_germanSimp_lemma_on_inv__57
begin
section{*All lemmas on causal relation between inv__57*}
lemma lemma_inv__57_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__57  p__Inv3 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) 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__57) done
    }

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

end


(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory ArchAInvsPre
imports "../AInvsPre"
begin

context Arch begin

global_naming X64

definition
  "kernel_mappings \<equiv> {x. x \<ge> pptr_base}"

lemma kernel_mappings_slots_eq:
  "canonical_address p \<Longrightarrow> p \<in> kernel_mappings \<longleftrightarrow> ucast (p >> pml4_shift_bits) \<in> kernel_mapping_slots"
  apply (simp add: kernel_mappings_def kernel_mapping_slots_def word_le_nat_alt
                   get_pml4_index_def ucast_mask_drop)
  apply (fold word_le_nat_alt)
  apply (rule iffI)
   apply (simp add: bit_simps pptr_base_def pptrBase_def)
   apply (word_bitwise, simp)
  apply (simp add: pptr_base_def pptrBase_def bit_simps canonical_address_range mask_def)
  apply word_bitwise
  apply simp
  done

lemma valid_global_pml4_mappingsE:
  "\<lbrakk>valid_global_vspace_mappings s;
    \<And>pd. \<lbrakk>kheap s (x64_global_pml4 (arch_state s)) =
             Some (ArchObj (PageMapL4 pd));
           \<forall>x. valid_pml4_kernel_mappings (x64_kernel_vspace (arch_state s)) s
                 (ArchObj (PageMapL4 pd))\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
  apply (clarsimp simp add: valid_global_vspace_mappings_def obj_at_def)
  apply (case_tac ko, simp_all add: valid_pml4_kernel_mappings_def
                             split: arch_kernel_obj.splits)
  done

lemma ucast_ucast_mask9: "(ucast (x && mask 9) :: 9 word) = ucast x"
  by (rule ucast_mask_drop, simp)

(* NOTE: we could probably add "is_aligned b (pageBitsForSize sz)"
         if we assumed "valid_global_objs s", additionally. *)
(* FIXME x64: please god some automation *)
lemma some_get_page_info_kmapsD:
  "\<lbrakk>get_page_info (\<lambda>obj. get_arch_obj (kheap s obj)) pd_ref p = Some (b, a, attr, r);
    p \<in> kernel_mappings; canonical_address p; valid_global_vspace_mappings s; equal_kernel_mappings s\<rbrakk>
   \<Longrightarrow> (\<exists>sz. pageBitsForSize sz = a) \<and> r = {}"
   apply (clarsimp simp: get_pdpt_info_def get_pml4_entry_def get_arch_obj_def
                         kernel_mappings_slots_eq get_page_info_def get_pdpt_entry_def get_pd_info_def
                         get_pd_entry_def get_pt_info_def get_pt_entry_def
                  split: option.splits Structures_A.kernel_object.splits
                         arch_kernel_obj.splits)
   apply (erule valid_global_pml4_mappingsE)
   apply (clarsimp simp: equal_kernel_mappings_def obj_at_def)
   apply (drule_tac x=pd_ref in spec,
          drule_tac x="x64_global_pml4 (arch_state s)" in spec, simp)
   apply (drule bspec, assumption)
   apply (clarsimp simp: valid_pml4_kernel_mappings_def pml4e_mapping_bits_def)
   apply (drule_tac x="ucast (p >> pml4_shift_bits)" in spec)
   apply (clarsimp simp: get_page_info_def get_pml4_entry_def get_arch_obj_def
                         get_pdpt_info_def get_pdpt_entry_def get_pd_info_def get_pd_entry_def
                         get_pt_info_def get_pt_entry_def bit_simps
                         kernel_mappings_slots_eq
                  split: option.splits Structures_A.kernel_object.splits
                         arch_kernel_obj.splits
                         pml4e.splits pdpte.splits pde.splits pte.splits)
      apply (rule conjI, rule_tac x=X64SmallPage in exI, simp add: bit_simps)
      apply (simp add: valid_pml4e_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 30))" in spec)
      apply (clarsimp simp: valid_pdpte_kernel_mappings_def)
      apply (simp add: valid_pd_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 21))" in spec)
      apply (clarsimp simp: valid_pde_kernel_mappings_def)
      apply (simp add: valid_pt_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 12))" in spec)
      apply (clarsimp simp: valid_pte_kernel_mappings_def)
      apply (rule conjI, rule_tac x=X64LargePage in exI, simp add: bit_simps)
      apply (simp add: valid_pml4e_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 30))" in spec)
      apply (clarsimp simp: valid_pdpte_kernel_mappings_def)
      apply (simp add: valid_pd_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 21))" in spec)
      apply (clarsimp simp: valid_pde_kernel_mappings_def)
      apply (simp add: valid_pt_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (rule conjI, rule_tac x=X64HugePage in exI, simp add: bit_simps)
      apply (simp add: valid_pml4e_kernel_mappings_def obj_at_def ucast_ucast_mask9
                       valid_pdpt_kernel_mappings_def bit_simps pml4e_mapping_bits_def
                 split: pml4e.splits)
      apply (drule_tac x="ucast ((p >> 30))" in spec)
      apply (clarsimp simp: valid_pdpte_kernel_mappings_def)
   done

lemma get_page_info_gpd_kmaps:
  "\<lbrakk>valid_global_objs s; valid_arch_state s; canonical_address p;
    get_page_info (\<lambda>obj. get_arch_obj (kheap s obj))
                  (x64_global_pml4 (arch_state s)) p = Some (b, a, attr, r)\<rbrakk>
   \<Longrightarrow> p \<in> kernel_mappings"
  apply (clarsimp simp: valid_global_objs_def valid_arch_state_def
                        obj_at_def valid_ao_at_def
                        empty_table_def kernel_mappings_slots_eq)
  apply (drule_tac x="ucast (p >> pml4_shift_bits)" in spec; clarsimp)
  apply (rule ccontr)
  apply (clarsimp simp: get_page_info_def get_pml4_entry_def get_arch_obj_def
                        bit_simps ucast_ucast_mask9
                 split: option.splits pml4e.splits arch_kernel_obj.splits)
  done

lemma get_vspace_of_thread_reachable:
  "get_vspace_of_thread (kheap s) (arch_state s) t \<noteq> x64_global_pml4 (arch_state s)
   \<Longrightarrow> (\<exists>\<rhd> get_vspace_of_thread (kheap s) (arch_state s) t) s"
  by (auto simp: get_vspace_of_thread_vs_lookup
          split: Structures_A.kernel_object.splits if_split_asm option.splits
                 cap.splits arch_cap.splits)

lemma is_aligned_ptrFromPAddrD:
"\<lbrakk>is_aligned (ptrFromPAddr b) a; a \<le> 30\<rbrakk> \<Longrightarrow> is_aligned b a"
  apply (clarsimp simp:ptrFromPAddr_def pptrBase_def)
  apply (erule is_aligned_addD2)
  apply (rule is_aligned_weaken[where x = 30])
   apply (simp add:is_aligned_def)
  apply simp
  done

lemma some_get_page_info_umapsD:
  "\<lbrakk>get_page_info (\<lambda>obj. get_arch_obj (kheap s obj)) pml4_ref p = Some (b, a, attr, r);
    (\<exists>\<rhd> pml4_ref) s; p \<notin> kernel_mappings; valid_vspace_objs s; pspace_aligned s;
    canonical_address p;
    valid_asid_table (x64_asid_table (arch_state s)) s; valid_objs s\<rbrakk>
   \<Longrightarrow> \<exists>sz. pageBitsForSize sz = a \<and> is_aligned b a \<and> data_at sz (ptrFromPAddr b) s"
  apply (clarsimp simp: get_page_info_def get_pdpt_info_def get_pd_info_def get_pt_info_def
                        get_pml4_entry_def get_pdpt_entry_def get_pd_entry_def get_pt_entry_def
                        get_arch_obj_def valid_asid_table_def bit_simps
                        kernel_mappings_slots_eq
                 split: option.splits kernel_object.splits arch_kernel_obj.splits
                        pml4e.splits pdpte.splits pde.splits pte.splits)
    apply (all \<open>drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pml4I],
                simp add: ucast_ucast_mask9, fastforce\<close>)
    prefer 3 subgoal
      by (rule exI[where x=X64HugePage];
          frule (3) valid_vspace_objs_entryD;
          fastforce simp: bit_simps dest: data_at_aligned is_aligned_ptrFromPAddrD)
   apply (all \<open>drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pdptI], fastforce\<close>)
   prefer 2 subgoal
     by (rule exI[where x=X64LargePage];
         frule (3) valid_vspace_objs_entryD;
         fastforce simp: bit_simps dest: data_at_aligned is_aligned_ptrFromPAddrD)
  apply (drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pdI], fastforce)
  by (rule exI[where x=X64SmallPage];
      frule (3) valid_vspace_objs_entryD;
      fastforce simp: bit_simps dest: data_at_aligned is_aligned_ptrFromPAddrD)

lemma user_mem_dom_cong:
  "kheap s = kheap s' \<Longrightarrow> dom (user_mem s) = dom (user_mem s')"
  by (simp add: user_mem_def in_user_frame_def dom_def obj_at_def)

lemma device_mem_dom_cong:
  "kheap s = kheap s' \<Longrightarrow> dom (device_mem s) = dom (device_mem s')"
  by (simp add: device_mem_def in_device_frame_def dom_def obj_at_def)

lemma device_frame_in_device_region:
  "\<lbrakk>in_device_frame p s; pspace_respects_device_region s\<rbrakk>
  \<Longrightarrow> device_state (machine_state s) p \<noteq> None"
  by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def)

global_naming Arch
named_theorems AInvsPre_asms

lemma ptable_rights_imp_frame[AInvsPre_asms]:
  assumes "valid_state s"
  shows "ptable_rights t s x \<noteq> {} \<Longrightarrow>
         ptable_lift t s x = Some (addrFromPPtr y) \<Longrightarrow>
         in_user_frame y s \<or> in_device_frame y s"
  apply (rule ccontr, frule ptable_lift_Some_canonical_addressD)
  using assms
  apply (clarsimp simp: ptable_lift_def ptable_rights_def
                        in_user_frame_def in_device_frame_def
                 split: option.splits)
  apply (case_tac "x \<in> kernel_mappings")
   apply (frule (2) some_get_page_info_kmapsD; fastforce simp: valid_state_def)
  apply (frule some_get_page_info_umapsD)
        apply (rule get_vspace_of_thread_reachable)
        apply clarsimp
        apply (frule get_page_info_gpd_kmaps[rotated 2])
           apply (simp_all add: valid_state_def valid_pspace_def
                                valid_arch_state_def)
    apply (clarsimp simp: data_at_def)+
  apply (drule_tac x=sz in spec)+
  apply (rename_tac p_addr attr rghts sz)
  apply (frule is_aligned_add_helper[OF _ and_mask_less', THEN conjunct2, of _ _ x])
   apply (simp only: pbfs_less_wb'[simplified word_bits_def])
  apply (clarsimp simp: data_at_def ptrFromPAddr_def addrFromPPtr_def field_simps)
  apply (subgoal_tac "p_addr + (pptrBase + (x && mask (pageBitsForSize sz)))
                        && ~~ mask (pageBitsForSize sz) = p_addr + pptrBase")
   apply simp
  apply (subst add.assoc[symmetric])
  apply (subst is_aligned_add_helper)
    apply (erule aligned_add_aligned)
     apply (case_tac sz; simp add: is_aligned_def pptrBase_def bit_simps)
    apply simp
   apply (rule and_mask_less')
   apply (case_tac sz; simp add: bit_simps)
  apply simp
  done

end

interpretation AInvsPre?: AInvsPre
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (intro_locales; (unfold_locales; fact AInvsPre_asms)?)
  qed

requalify_facts
  X64.user_mem_dom_cong
  X64.device_mem_dom_cong
  X64.device_frame_in_device_region

end


theory Balance
  imports "EvmFacts" "../lem/Block"
begin

(*
lemma balance_env :
"instruction_sem v c inst net =
 InstructionToEnvironment act v2 x33 \<Longrightarrow>
 vctx_balance v2 = vctx_balance v"
apply (simp only: instruction_sem_def)
  apply (case_tac inst; clarsimp)
apply (case_tac x1 ;
          clarsimp simp: rw
           split:list.splits)
         apply (case_tac x2 ; clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x3 ; clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x4 ; clarsimp simp: instruction_sem_simps split:list.splits)
apply(case_tac "\<not> cctx_hash_filter c ( cut_memory x21 x21a (vctx_memory v))")
         apply (clarsimp simp: instruction_sem_simps split:list.splits)
         apply (clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x5 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
         apply (case_tac x6 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
         apply (case_tac x7 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
      apply (case_tac x8 ; clarsimp simp: instruction_sem_simps Let_def split:list.splits option.splits pc_inst.splits )
      apply (case_tac x9; clarsimp simp: instruction_sem_simps Let_def split: list.splits  pc_inst.splits option.splits)
       apply (case_tac "x2"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x21a = 0"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x2"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x21a = 0"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x2a"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
     apply (case_tac "x10"; clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits list.splits)
     apply (clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits)
     apply (case_tac "x12"; clarsimp simp: Let_def instruction_sem_simps  split: pc_inst.splits option.splits)
     apply (case_tac "x13"; clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits list.splits if_splits)
done

lemma balance_continue :
"instruction_sem v c inst net =
 InstructionContinue v2 \<Longrightarrow>
 vctx_balance v2 = vctx_balance v"
apply (simp only: instruction_sem_def)
  apply (case_tac inst; clarsimp)
apply (case_tac x1 ;
          clarsimp simp: rw
           split:list.splits)
         apply (case_tac x2 ; clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x3 ; clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x4 ; clarsimp simp: instruction_sem_simps split:list.splits)
apply(case_tac "\<not> cctx_hash_filter c ( cut_memory x21 x21a (vctx_memory v))")
         apply (clarsimp simp: instruction_sem_simps split:list.splits)
         apply (clarsimp simp: instruction_sem_simps split:list.splits)
         apply (case_tac x5 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
         apply (case_tac x6 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
         apply (case_tac x7 ; clarsimp simp: instruction_sem_simps split:list.splits option.splits)
      apply (case_tac x8 ; clarsimp simp: instruction_sem_simps Let_def split:list.splits option.splits pc_inst.splits )
      apply (case_tac x9; clarsimp simp: instruction_sem_simps Let_def split: list.splits  pc_inst.splits option.splits)
       apply (case_tac "x2"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x21a = 0"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x2"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x21a = 0"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
       apply (case_tac "x2a"; clarsimp simp: instruction_sem_simps Let_def split: pc_inst.splits option.splits)
     apply (case_tac "x10"; clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits list.splits)
     apply (clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits)
     apply (case_tac "x12"; clarsimp simp: Let_def instruction_sem_simps  split: pc_inst.splits option.splits)
     apply (case_tac "x13"; clarsimp simp: instruction_sem_simps  split: pc_inst.splits option.splits list.splits if_splits)
done

lemma balance_continue_next :
"next_state stopper c (InstructionContinue v) =
 InstructionContinue v2 \<Longrightarrow>
 vctx_balance v2 = vctx_balance v"
apply (simp add:next_state_def)
apply (cases "\<not> check_annotations v c"; auto)
apply (cases "vctx_next_instruction v c"; auto)
apply (case_tac " check_resources v c (vctx_stack v) a"; auto)
using balance_continue apply simp
done

lemma balance_env_next :
"next_state stopper c (InstructionContinue v) =
 InstructionToEnvironment args v2 zz \<Longrightarrow>
 vctx_balance v2 = vctx_balance v"
apply (simp add:next_state_def)
apply (cases "\<not> check_annotations v c"; auto)
apply (cases "vctx_next_instruction v c"; auto)
apply (case_tac " check_resources v c (vctx_stack v) a"; auto)
using balance_env apply simp
done

fun sum_aux :: "(address \<Rightarrow> w256) \<Rightarrow> nat \<Rightarrow> nat" where
"sum_aux bal 0 = 0"
| "sum_aux bal (Suc n) = unat (bal (word_of_int (int n))) + sum_aux bal n"

definition sum :: "(address \<Rightarrow> w256) \<Rightarrow> nat" where
"sum bal = sum_aux bal (2^160)"

definition total_balance :: "global0 \<Rightarrow> nat" where
"total_balance g = sum (\<lambda>a. account_balance0 (g_current g a))"
definition total_balance_nat :: "(address \<Rightarrow> account) \<Rightarrow> nat" where
"total_balance_nat g = sum (\<lambda>a. account_balance0 (g a))"

definition total_balance :: "(address \<Rightarrow> account) \<Rightarrow> int" where
"total_balance g = int (sum (\<lambda>a. account_balance0 (g a)))"
*)

definition abal :: "(address \<Rightarrow> account) \<Rightarrow> nat \<Rightarrow> int" where
"abal st = (\<lambda>i. uint (account_balance0 (st (word_of_int (int i)))))"

definition total_balance :: "(address \<Rightarrow> account) \<Rightarrow> int" where
"total_balance g = sum (abal g) {0..2^160-1}"
(*
   (\<Sum>i::nat=0..2^160-1.
     uint (account_balance0 (g (word_of_int (int i)))))"
*)
lemma balance_same1 :
"account_balance0
                 (if a = cctx_this (g_cctx st1)
                  then g_current st1
                        (cctx_this (g_cctx st1))
                       \<lparr>account_storage0 :=
                          vctx_storage v\<rparr>
                  else g_current st1 a) =
 account_balance0 (g_current st1 a)"
by auto

lemma balance_same2 :
"account_balance0
                 (if a = addr
                  then st1 addr
                       \<lparr>account_storage0 :=
                          vctx_storage v\<rparr>
                  else st1 a) =
 account_balance0 (st1 a)"
by auto

lemma total_balance_update_return :
"total_balance (update_return acc addr v) = total_balance acc"
apply (simp add: total_balance_def abal_def
 update_return_def update_world_def
 balance_same2)
done

lemma update_if :
  "(if a = b then c else update_world acc b nb a) =
   (if a = b then c else acc a)"
apply (auto simp add: update_world_def)
done

(*
lemma balance_if :
"account_balance0 (if a = addr
                  then x
                  else y) =
 (if a = addr then account_balance0 x else account_balance0 y)"
*)
lemma account_balance_double :
  "x\<lparr>account_balance0 := a, account_balance0 := b \<rparr> =
   x\<lparr>account_balance0 := b \<rparr>"
apply (auto)
done

fun balance_list_aux :: "(address \<Rightarrow> w256) \<Rightarrow> nat \<Rightarrow> w256 list" where
"balance_list_aux bal 0 = []"
| "balance_list_aux bal (Suc n) =
     bal (word_of_int (int n)) # balance_list_aux bal n"

definition balance_list :: "(address \<Rightarrow> w256) \<Rightarrow> w256 list" where
"balance_list bal = balance_list_aux bal (2^160)"

lemma balance_list_eq_aux :
  "x < n \<Longrightarrow>
   balance_list_aux bal n ! x = bal (word_of_int (int (n-x-1)))"
apply (induction n arbitrary:x rule:balance_list_aux.induct)
apply (auto)
apply (case_tac "x=n")
apply auto
oops

lemma sum_one :
  "(\<Sum>i::nat=l..l. f i) = (f l)"
  by simp

lemma sum_zero :
  "(\<Sum>i::nat=l+1..l. f i) = 0"
  by simp

lemma sum_ub_add_nat: assumes "(m::nat) \<le> n"
  shows "sum f {m..n + p} = sum f {m..n} + sum f {n + 1..n + p}"
proof-
  have "{m .. n+p} = {m..n} \<union> {n+1..n+p}" using \<open>m \<le> n\<close> by auto
  thus ?thesis by (auto simp: ivl_disj_int sum.union_disjoint
    atLeastSucAtMost_greaterThanAtMost)
qed

lemma sum_ub_add_nat2: assumes "(m::nat) \<le> n"
  shows "sum f {m..n + p} = sum f {m..<n} + sum f {n..n + p}"
proof-
  have "{m .. n+p} = {m..<n} \<union> {n..n+p}" using \<open>m \<le> n\<close> by auto
  thus ?thesis by (auto simp: ivl_disj_int sum.union_disjoint
    atLeastSucAtMost_greaterThanAtMost)
qed

lemma sum_split :
  "l \<le> k \<Longrightarrow> k \<le> n \<Longrightarrow>
   (\<Sum>i::nat=l..n. f i) =
   (\<Sum>i::nat=l..k. f i) + (\<Sum>i::nat=k+1..n. f i)"
apply (simp)
using sum_ub_add_nat [of l k f "n-k"]
apply force
done

lemma sum_split2 :
  "l \<le> k \<Longrightarrow> k \<le> n \<Longrightarrow>
   (\<Sum>i::nat=l..n. f i) =
   (\<Sum>i::nat=l..<k. f i) + (\<Sum>i::nat=k..n. f i)"
using sum_ub_add_nat2 [of l k f "n-k"]
apply force
done

lemma sum_if :
  assumes a:"k \<le> n"
  shows
   "(\<Sum>i::nat=0..n. (if i = k then (x::int) else f i)) =
    (\<Sum>i=0..<k. f i) + x + (\<Sum>i=k+1..n. f i)"
proof -
  have b1: "sum f {0..<k} = (\<Sum>i=0..<k. (if i = k then x else f i))"
    by auto
  have b2: "sum f {k+1..n} = (\<Sum>i=k+1..n. (if i = k then x else f i))"
    by auto
  have b3: "x = (\<lambda>i. if i = k then (x::int) else f i) k" by auto
  then have "sum f {0..<k} + x = (\<Sum>i=0..k. (if i = k then x else f i))"
     using b1 sum_split2 [of 0 k k "%i. (if i = k then x else f i)"]
     by force
  then show ?thesis using b2
    by (metis (no_types, lifting) assms le_add2 le_add_same_cancel2 sum_split)
qed

lemma sum_single :
  assumes a:"k \<le> n"
  shows
   "(\<Sum>i::nat=0..n. (if i = k then (x::int) else 0)) = x"
using a sum_if [of k n x "%i. 0"] by auto

lemma sum_update :
  assumes a:"k \<le> n"
  shows
   "(\<Sum>i::nat=0..n. (if i = k then (x::int) else f i)) =
    (\<Sum>i=0..n. f i) + x - f k"
proof -
  have b1:
   "(\<Sum>i::nat=0..n. (if i = k then (x::int) else f i)) =
    sum f {0..<k} + x + sum f {k+1..n}"
   using a sum_if by force
  have eq: "f = (%i. if i = k then f k else f i)" by auto
  then have b2:
    "sum (%i. if i = k then f k else f i) {0..n} =
     sum f {0..n}" by metis
  then have b3:
    "sum f {0..<k} + sum f {k+1..n} =
     sum f {0..n} - f k"
   using a sum_if [of k n "f k" f] by force
  then show ?thesis using b1 by auto
qed

lemma word_unat : "addr = word_of_int (int (unat addr))"
  by (metis uint_nat word_of_int_uint)

lemma find_mod_address :
  "uint (word_of_int x::address) = (x::int) mod 2^160"
apply (auto simp:uint_word_of_int)
done

lemma unat_mod_address [simp]:
  "unat (word_of_int (int x)::address) = x mod 2^160"
apply (simp add: find_mod_address unat_def)
  by (metis (mono_tags, hide_lams)
 Divides.transfer_int_nat_functions(2)
 nat_int.Rep_inverse' of_nat_numeral)

lemma test_eq :
"i < 2^160 \<Longrightarrow>
 (word_of_int (int i) = addr) = (i = unat (addr::address))"
apply auto
apply (metis uint_nat word_of_int_uint)
done

lemma sum_eq_small :
   "(\<forall>i\<le>n. f i = g i) \<Longrightarrow>
   sum f {0..n} = sum g {0..n}"
  by auto

lemma massage :
"uint (account_balance0 (st  addr)) =
 uint (account_balance0 (st (word_of_int (int (unat addr)))))"
by (metis uint_nat word_of_int_uint)

lemma addr_small : "unat (addr::address) \<le> 2^160-1"
apply (subst word_unat)
apply auto
done

lemma total_balance_update_world :
"total_balance (update_world st addr acc) =
 total_balance st + uint (account_balance0 acc) -
                    uint (account_balance0 (st addr))"
apply (auto simp add:update_world_def total_balance_def abal_def
  if_distrib)
apply (subst sum_eq_small [of _ _
  "%i.  if i = unat addr
        then uint (account_balance0 acc)
        else uint
              (account_balance0
                (st (word_of_int (int i))))"])
apply (auto simp:test_eq)
apply (subst massage[of st addr])
apply (rule sum_update [of "unat addr" _
  "uint (account_balance0 acc)"
  "%i. uint (account_balance0 (st (word_of_int (int i))))"])
using addr_small
by force

lemma test : "(a::address) \<ge> 0"
apply auto
done

lemma uint_sub : "b \<le> a \<Longrightarrow> uint (a-b) = uint a - uint b"
  by (simp add: uint_minus_simple_alt)

lemma uint_add :
   "a+b \<ge> a \<Longrightarrow>
   uint (a+b) = uint a + uint b"
by (auto simp:uint_plus_simple)

lemma solution :
 "d \<le> a \<Longrightarrow> r+d \<ge> r \<Longrightarrow>
  uint (a - d) + (uint (r + d) - uint r - uint a) = 0"
apply (simp add:uint_add uint_sub)
done

lemma total_balance_update :
"v \<le> account_balance0 (acc addr) \<Longrightarrow>
 account_balance0 (acc recv) \<le>
    account_balance0 (acc recv) + v \<Longrightarrow>
 total_balance (transfer_balance acc addr recv v) =
 total_balance acc"
apply (cases "addr = recv")
subgoal
apply (auto simp add: total_balance_def
 update_return_def update_world_def update_call_def
 transfer_balance_def add_balance_def sub_balance_def Let_def
 balance_same2 update_if if_distrib abal_def)
apply metis
done
apply (auto simp add:
 update_return_def update_world_def update_call_def
 transfer_balance_def Let_def
 balance_same2 update_if if_distrib add_balance_def sub_balance_def
 total_balance_update_world)
apply (rule solution)
apply auto
done

lemma total_balance_update_call :
"callarg_value args \<le> account_balance0 (acc addr) \<Longrightarrow>
 account_balance0 (acc (callarg_recipient args)) \<le>
    account_balance0 (acc (callarg_recipient args)) +
    callarg_value args \<Longrightarrow>
 total_balance (update_call acc addr args) =
 total_balance acc"
  by (simp add: total_balance_update update_call_def)

lemma total_balance_update_call2 :
"addr = callarg_recipient args \<Longrightarrow>
 total_balance (update_call acc addr args) = total_balance acc"
apply (auto simp add: total_balance_def
 update_return_def update_world_def update_call_def
 transfer_balance_def add_balance_def sub_balance_def Let_def
 balance_same2 update_if if_distrib abal_def)
apply metis
done

lemma total_balance_update_same :
"total_balance (transfer_balance acc addr addr v) =
 total_balance acc"
apply (auto simp add: total_balance_def
 update_return_def update_world_def update_call_def
 transfer_balance_def add_balance_def sub_balance_def Let_def
 balance_same2 update_if if_distrib abal_def)
apply metis
done

lemma sum_split_one :
  "l \<le> k \<Longrightarrow> k \<le> n \<Longrightarrow>
   (\<Sum>i::nat=l..n. f i) =
   (\<Sum>i::nat=l..<k. f i) + f k + (\<Sum>i::nat=k+1..n. f i)"
  by (metis add.commute sum_last_plus sum_split)

lemma abal_eq :
 "uint (account_balance0 (st a)) = abal st (unat a)"
apply (auto simp add:abal_def)
  by (metis word_unat)

lemma balance_split :
"k \<le> unat a \<Longrightarrow> unat a \<le> n \<Longrightarrow>
 sum (abal st) {k..n} =
    sum (abal st) {k..< unat a} +
    uint (account_balance0 (st a)) +
    sum (abal st) {unat a+1..n}"
apply (simp add:abal_eq)
using sum_split_one [of k "unat a" n "abal st"]
apply simp
done

lemma abal_nonneg : "abal st k \<ge> 0"
  by (simp add: abal_def)

lemma abal_sum_nonneg : "sum (abal st) {a..b} \<ge> 0"
  by (simp add: abal_nonneg sum_nonneg)

lemma overflow_one :
assumes a1:"total_balance st < 2^256"
shows
 "uint (account_balance0 (st a)) < 2^256"
proof -
  have "total_balance st = sum (abal st) {0..2 ^ 160 - 1}"
   by (simp add:total_balance_def)
  then have aux:"total_balance st =
      sum (abal st) {0..< unat a} +
      uint (account_balance0 (st a)) +
      sum (abal st) {unat a+1..2^160-1}"
    using balance_split [of 0 a "2^160-1" st]
    by (metis addr_small total_balance_def zero_le)
  have bsmall: "unat a \<le> 2 ^ 160 - 1" by (metis addr_small)
  then show ?thesis using a1 aux abal_sum_nonneg
    by (smt abal_nonneg sum_nonneg)
qed

lemma overflow_pair :
assumes a1:"total_balance st < 2^256"
and a2:"a < b"
shows
 "uint (account_balance0 (st a)) +
  uint (account_balance0 (st b)) < 2^256"
proof -
  have "total_balance st = sum (abal st) {0..2 ^ 160 - 1}"
   by (simp add:total_balance_def)
  then have aux:"total_balance st =
      sum (abal st) {0..< unat a} +
      uint (account_balance0 (st a)) +
      sum (abal st) {unat a+1..2^160-1}"
    using balance_split [of 0 a "2^160-1" st]
    by (metis addr_small total_balance_def zero_le)
  have bsmall: "unat b \<le> 2 ^ 160 - 1" by (metis addr_small)
  from a2 have "unat a + 1 \<le> unat b"
    by (metis Suc_eq_plus1 Suc_leI not_less  word_le_nat_alt)
  then have "sum (abal st) {unat a+1..2^160-1} =
    sum (abal st) {unat a+1..< unat b} +
    uint (account_balance0 (st b)) +
    sum (abal st) {unat b+1..2^160-1}"
  using bsmall balance_split [of "unat a + 1" b "2^160-1" st] by force
  then have a:"total_balance st =
    sum (abal st) {0..< unat a} +
    uint (account_balance0 (st a)) +
    sum (abal st) {unat a+1..< unat b} +
    uint (account_balance0 (st b)) +
    sum (abal st) {unat b+1..2^160-1}"
  using aux by force
  then show ?thesis using a1 abal_sum_nonneg
    by (smt abal_nonneg sum_nonneg)
qed

lemma find_mod :
  "uint (word_of_int x::w256) = (x::int) mod 2^256"
apply (auto simp:uint_word_of_int)
done

lemma uint_back : "uint (x::w256) = uint (word_of_int (uint x) :: w256)"
using word_of_int_uint [of x] by force

lemma overflow_plus :
  assumes a:"uint (a::w256) + uint b < 2^256"
  shows "uint (a + b) = uint a + uint b"
proof -
  have "uint (a + b) mod 2 ^ 256 = uint a + uint b"
    using a
    by (simp add: find_mod int_mod_eq' word_add_def)
  then show ?thesis using a
    by (metis find_mod word_of_int_uint)
qed

lemma overflow_small :
  "uint (a::w256) + uint b < 2^256 \<Longrightarrow>
  a \<le> a + b"
using overflow_plus [of a b] uint_plus_simple_iff by blast

lemma overflow :
"total_balance st < 2^256 \<Longrightarrow>
 x \<le> account_balance0 (st sender) \<Longrightarrow>
 sender \<noteq> r \<Longrightarrow>
 account_balance0 (st r) \<le>
 account_balance0 (st r) + x"
apply (cases "r < sender")
apply (rule overflow_small [of "account_balance0 (st r)" x])
using overflow_pair [of st r sender]
  apply (simp add: word_le_def)
apply (cases "sender < r")
apply (rule overflow_small [of "account_balance0 (st r)" x])
using overflow_pair [of st sender r]
  apply (simp add: word_le_def)
apply auto
done

lemma account_balance_return :
"account_balance0 (update_return st1 addr v r) =
 account_balance0 (st1 r)"
by (simp add:update_return_def update_world_def)

definition states :: "global0 \<Rightarrow> world_state list" where
"states g = (g_current g#map (%e. let (x,_,_,_) = e in x) (g_stack g))"

(* sorted lists *)
definition balance_inv :: "global0 \<Rightarrow> bool" where
"balance_inv g ==
   sorted (map total_balance (states g)) \<and>
   total_balance (last (states g)) \<le> total_balance (g_orig g)"

lemma tr_orig :
   "next0 net (Continue st1) = Continue st2 \<Longrightarrow>
    g_orig st1 = g_orig st2"
by (auto simp add:next0_def Let_def
  split:if_split_asm option.split_asm list.split_asm
   contract_action.split_asm stack_hint.split_asm
   instruction_result.splits)

lemma inv_depend :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    g_current st1 = g_current st2 \<Longrightarrow>
    g_stack st1 = g_stack st2 \<Longrightarrow>
    balance_inv st2"
by (simp add: balance_inv_def states_def)

lemma inv_current :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    total_balance (g_current st1) \<ge> total_balance (g_current st2) \<Longrightarrow>
    g_stack st1 = g_stack st2 \<Longrightarrow>
    balance_inv st2"
apply (auto simp add: balance_inv_def states_def)
  by (smt sorted_Cons)

lemma sorted_pop : "sorted (a#lst) \<Longrightarrow> sorted lst"
  by (simp add: sorted_Cons)

lemma sorted_dup : "sorted (a#lst) \<Longrightarrow> sorted (a#a#lst)"
  by simp

lemma inv_pop_states :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    states st1 = a # states st2 \<Longrightarrow>
    balance_inv st2"
apply (auto simp add: balance_inv_def)
using sorted_pop
apply force
  by (simp add: states_def)

lemma inv_pop :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    (g_current st2,e1,e2,e3) # g_stack st2 = g_stack st1 \<Longrightarrow>
    balance_inv st2"
apply (rule inv_pop_states [of st1 st2 "g_current st1"])
apply (auto simp add:states_def)
  by (metis (mono_tags, lifting) case_prod_conv list.simps(9))

lemma states_not_nil : "states st = [] \<Longrightarrow> False"
  by (simp add: states_def)

lemma inv_dup_states :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    states st2 = hd (states st1) # states st1 \<Longrightarrow>
    balance_inv st2"
apply (auto simp add: balance_inv_def)
using states_not_nil apply force
using sorted_dup
  by (metis hd_Cons_tl hd_map sorted_single)

lemma inv_dup :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    g_current st1 = g_current st2 \<Longrightarrow>
    (g_current st1,e1,e2,e3) # g_stack st1 = g_stack st2 \<Longrightarrow>
    balance_inv st2"
apply (rule inv_dup_states [of st1 st2])
apply (auto simp add:states_def)
  by (metis (mono_tags, lifting) case_prod_conv list.simps(9))

lemma inv_return :
  "balance_inv st \<Longrightarrow>
   balance_inv (st\<lparr>g_current := update_return (g_current st) addr v\<rparr>)"
using inv_current
  by (simp add: total_balance_update_return)

(* push state *)
lemma inv_push :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    total_balance (g_current st2) \<le> total_balance (g_current st1) \<Longrightarrow>
    (g_current st1,e1,e2,e3) # g_stack st1 = g_stack st2 \<Longrightarrow>
    balance_inv st2"
using inv_current [of "st2\<lparr> g_current := g_current st1\<rparr>" st2]
 and inv_dup by force

lemma inv_discard_aux :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    total_balance (g_current st2) \<le> total_balance (g_current st1) \<Longrightarrow>
    total_balance (g_current st1) \<le> total_balance disc \<Longrightarrow>
    (disc,e1,e2,e3) # g_stack st2 = g_stack st1 \<Longrightarrow>
    balance_inv st2"
using inv_current [of "st2\<lparr> g_current := disc\<rparr>" st2]
  inv_pop [of st1 "st2\<lparr> g_current := disc\<rparr>" e1 e2 e3]
 by force

lemma tb_update_nonce :
  "total_balance (update_nonce st x) = total_balance st"
by (auto simp add:update_nonce_def Let_def
  total_balance_update_world)

lemma tb_create_account :
  "total_balance (create_account st x y) = total_balance st"
by (auto simp add:create_account_def Let_def
  total_balance_update_world set_account_code_def)

lemma inv_stack_same :
  "balance_inv st \<Longrightarrow>
   total_balance a = total_balance b \<Longrightarrow>
   g_stack st = (a,x,y,z)#rest \<Longrightarrow>
   balance_inv (st\<lparr> g_stack := (b,x2,y2,z2) # rest \<rparr>)"
by (auto simp add:balance_inv_def states_def)

lemma inv_stack_same2 :
  "balance_inv st \<Longrightarrow>
   total_balance a = total_balance b \<Longrightarrow>
   g_stack st = (a,x,y,z)#rest \<Longrightarrow>
   g_stack st2 = (b,x2,y2,z2) # rest \<Longrightarrow>
   g_current st2 = g_current st \<Longrightarrow>
   g_orig st2 = g_orig st \<Longrightarrow>
   balance_inv st2"
by (auto simp add:balance_inv_def states_def)

lemma account_balance_nonce :
"account_balance0 (update_nonce st1 v r) =
 account_balance0 (st1 r)"
by (simp add:update_nonce_def update_world_def Let_def)

lemma account_balance_same :
"account_balance0 acc = account_balance0 (st1 v) \<Longrightarrow>
 account_balance0 (update_world st1 v acc r) =
 account_balance0 (st1 r)"
by (simp add:update_nonce_def update_world_def Let_def)

lemma sort_out_create :
  "total_balance (g_current st1) < 2^256 \<Longrightarrow>
   balance_inv st1 \<Longrightarrow>
   g_stack st2 = (b,x2,y2,z2)#g_stack st1 \<Longrightarrow>
   g_orig st1 = g_orig st2 \<Longrightarrow>
   b = update_nonce (g_current st1) sender \<Longrightarrow>
   account_balance0 new_acc =
     account_balance0 (g_current st1 new_addr) \<Longrightarrow>
   account_balance0 (g_current st1 sender) \<ge> v \<Longrightarrow>
   g_current st2 =
      transfer_balance
          (update_world
               (update_return
                 (update_nonce (g_current st1) sender)
                      sender vc) new_addr new_acc)
      sender new_addr v \<Longrightarrow>
   balance_inv st2"
apply (rule inv_stack_same2 [of "st2\<lparr> g_stack :=
  (g_current st1, x2, y2, z2) # g_stack st1\<rparr>" "g_current st1"
  "update_nonce (g_current st1) sender" x2 y2 z2
   "g_stack st1" st2])
apply (auto simp:tb_update_nonce)
apply (rule inv_push)
apply auto
apply (cases "new_addr = sender")
apply simp
apply (subst total_balance_update_same)
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce)
(* new_addr \<noteq> sender *)
apply (subst total_balance_update)
apply (auto simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
using overflow apply force
done

lemma inv_depend_suicide :
"balance_inv
     (st1\<lparr>g_stack := rest,
          g_current := cur\<rparr>) \<Longrightarrow>
 balance_inv
     (st1\<lparr>g_stack := rest,
          g_current := cur,
          g_cctx := ctx,
          g_vmstate := vmstate,
          g_killed := killed \<rparr>)"
using inv_depend
apply force
done

lemma inv_depend_normal :
"balance_inv
     (st1\<lparr>g_stack := rest,
          g_current := cur\<rparr>) \<Longrightarrow>
 balance_inv
     (st1\<lparr>g_stack := rest,
          g_current := cur,
          g_cctx := ctx,
          g_vmstate := vmstate \<rparr>)"
using inv_depend
apply force
done

lemma inv_head :
  "balance_inv st1 \<Longrightarrow>
   g_stack st1 = (a, aa, aaa, b) # list \<Longrightarrow>
   total_balance (g_current st1) \<le> total_balance a"
by (auto simp add:balance_inv_def states_def)

lemma inv_discard :
   "balance_inv st1 \<Longrightarrow>
    g_orig st1 = g_orig st2 \<Longrightarrow>
    total_balance (g_current st2) \<le> total_balance (g_current st1) \<Longrightarrow>
    (disc,e1,e2,e3) # g_stack st2 = g_stack st1 \<Longrightarrow>
    balance_inv st2"
using inv_discard_aux [of st1 st2 disc e1 e2 e3]
  inv_head [of st1 disc e1 e2 e3 "g_stack st2"] by force

lemma sorted_first_last :
  "sorted (a#lst) \<Longrightarrow>
   a \<le> last (a#lst)"
  by (simp add: sorted_Cons)

lemma inv_orig_current :
   "balance_inv st \<Longrightarrow>
    total_balance (g_current st) \<le> total_balance (g_orig st)"
apply (simp add: balance_inv_def states_def)
using sorted_first_last [of "total_balance (g_current st)"
  "map (total_balance \<circ> (\<lambda>(x, u1, u2, u3). x))
       (g_stack st)"]
  by (smt List.map.compositionality last.simps last_map map_is_Nil_conv)

lemma compare_uint : "x \<le> y \<Longrightarrow>  x - uint b \<le> y"
  using diff_mono by fastforce

lemma tr_balance_finished :
   "next0 net (Continue st1) = Finished st2 \<Longrightarrow>
    total_balance (g_current st1) < 2^256 \<Longrightarrow>
    balance_inv st1 \<Longrightarrow>
    total_balance (f_state st2) \<le> total_balance (g_orig st1)"
apply (simp add:next0_def Let_def)
apply (cases "g_vmstate st1"; auto simp add:Let_def)
apply (case_tac "x21"; auto  simp add:Let_def split:if_splits)
apply (case_tac "g_stack st1"; auto simp add:Let_def)
apply (case_tac "g_stack st1"; auto simp add:Let_def)
subgoal for x32 x33 dst
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)
using inv_orig_current [of st1] compare_uint apply force

apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
inv_orig_current [of st1] compare_uint
apply (simp add: uint_plus_simple_iff)
done
apply (case_tac "list = [] \<and> g_create st1"; auto)
apply (case_tac b; auto)
subgoal for x32 x33 dst a aa ab
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)

using inv_orig_current [of st1] compare_uint apply force

apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
inv_orig_current [of st1] compare_uint
apply (simp add: uint_plus_simple_iff)
done
subgoal for x32 x33 dst a aa ab
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)

using inv_orig_current [of st1] compare_uint apply force

apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
inv_orig_current [of st1] compare_uint
apply (simp add: uint_plus_simple_iff)
done
subgoal for x32 x33 dst a aa ab
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)

using inv_orig_current [of st1] compare_uint apply force

apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
inv_orig_current [of st1] compare_uint
apply (simp add: uint_plus_simple_iff)
done
apply (case_tac "g_stack st1"; auto)
  apply (simp add: inv_orig_current total_balance_update_return)
apply (case_tac b; auto)
apply (case_tac "x6 = [] \<and> list = [] \<and> g_create st1"; simp)
  apply (auto simp add: inv_orig_current total_balance_update_return)[1]
apply (case_tac "vctx_gas x22 < 200 * int (length x6) \<and>
                homestead_block
                \<le> sint (block_number (vctx_block x22))"; simp)
apply (case_tac "vctx_gas x22 < 200 * int (length x6)"; auto)
done

lemma tr_balance_continue :
   "next0 net (Continue st1) = Continue st2 \<Longrightarrow>
    total_balance (g_current st1) < 2^256 \<Longrightarrow>
    balance_inv st1 \<Longrightarrow>
    balance_inv st2"
apply (simp add:next0_def Let_def)
apply (cases "g_vmstate st1"; auto)
using inv_depend apply force
subgoal for act v zz
apply (cases act; auto simp add:Let_def)
apply (case_tac "callarg_recipient x1 <s 256";auto)
apply (auto simp add:Let_def)
apply (case_tac
   "account_balance0
               (update_return (g_current st1)
                 (cctx_this (g_cctx st1)) v
                 (cctx_this (g_cctx st1)))
              < callarg_value x1 \<or>
              1023 < length (g_stack st1)";auto)
apply (rule inv_depend[of "st1
         \<lparr>g_current := update_return (g_current st1)
             (cctx_this (g_cctx st1)) v \<rparr>"])
apply (auto)
using inv_return apply force
apply (rule inv_depend[of "st1
         \<lparr>g_current := update_return (g_current st1)
             (cctx_this (g_cctx st1)) v \<rparr>"])
apply (auto)
using inv_return apply force
apply (simp add:Let_def)
apply(rule inv_push [of st1 st2])
apply auto

subgoal for args
apply (cases "cctx_this (g_cctx st1) = callarg_recipient args")

apply (subst total_balance_update_call2)
apply (auto simp:total_balance_update_return
  account_balance_return)
apply (subst total_balance_update_call)
apply (auto simp:total_balance_update_return
  account_balance_return)
apply (rule overflow [of "g_current st1" "callarg_value args"
  "cctx_this (g_cctx st1)" "callarg_recipient args"])
apply auto
done
(* delegate call  *)
subgoal for args
apply (cases "1023 < length (g_stack st1)";auto)
apply (rule inv_depend [of "st1\<lparr> g_current :=
       update_return (g_current st1)
        (cctx_this (g_cctx st1)) v\<rparr>" _])
apply auto
using inv_depend [of "st2\<lparr> g_current :=
       update_return (g_current st1)
        (cctx_this (g_cctx st1)) v\<rparr>" st2]
using inv_return apply force
apply(rule inv_push [of st1 _])
apply (auto simp:total_balance_update_return)
done
(* contract creation *)
subgoal for args
apply (split if_splits)
using inv_depend apply force
apply (simp add:Let_def)
apply (rule sort_out_create [of st1 st2 _ _ _ _ _
"(empty_account0
         _
        \<lparr>account_balance0 := _,
           account_exists := True\<rparr>)"
"calc_address _ _"
  "createarg_value args"])
apply (auto simp add:account_balance_return
account_balance_nonce)
done
subgoal for failure
apply (cases "g_stack st1"; auto)
subgoal for a aa ab b list
apply (rule inv_depend [of "st1\<lparr>g_stack := list, g_current := a\<rparr>"])
apply auto
using   inv_pop
apply force
done done
(* suicide *)
apply (cases "g_stack st1"; auto)
subgoal for dst a aa aaa b list
apply (auto simp add:Let_def)
apply (cases "list = [] \<and> g_create st1";simp)
apply clarsimp
apply (rule inv_depend_suicide)
apply (rule inv_discard[of st1 _ a])
apply clarsimp
apply clarsimp
apply clarsimp
apply (cases b)
apply clarsimp
subgoal
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
apply (simp add: uint_plus_simple_iff)
done
subgoal
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
apply (simp add: uint_plus_simple_iff)
done
subgoal
apply (simp add:total_balance_update_world
account_balance_return
  tb_create_account
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same)
apply (cases "dst = cctx_this (g_cctx st1)")
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  tb_create_account
  account_balance_same update_world_def)
apply (simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
using overflow [of "g_current st1"
  "account_balance0
       (g_current st1 (cctx_this (g_cctx st1)))"
 "cctx_this (g_cctx st1)" dst]
apply (simp add: uint_plus_simple_iff)
done
apply force
done
apply (cases "g_stack st1"; auto)
apply (case_tac b; auto)
subgoal for x6 saved_state aa ab list x2
apply (cases "x6 = [] \<and> list = [] \<and> g_create st1"; simp)
apply (cases "vctx_gas v < 200 * int (length x6) \<and>
             homestead_block
             \<le> sint (block_number (vctx_block v))"; simp)
apply clarsimp
using inv_pop apply force
apply (cases "vctx_gas v < 200 * int (length x6)"; clarsimp)
apply (rule inv_depend_normal)
subgoal
apply(rule inv_discard[of st1 _ saved_state])
apply (auto simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def)
done
apply (rule inv_depend_normal)
apply(rule inv_discard[of st1 _ saved_state])
apply (auto simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def
  tb_create_account)
done
subgoal for x6 saved_state aa ab list x31 x32
apply (rule inv_depend_normal)
apply(rule inv_discard[of st1 _ saved_state])
apply (auto simp add:total_balance_update_world
account_balance_return
  total_balance_update_return
  tb_update_nonce account_balance_nonce
  account_balance_same update_world_def
  tb_create_account)
done
done
done

lemma uint_fact :
   "x \<le> x+y \<Longrightarrow>
   uint (x+y) - uint x- uint y = 0"
  by (simp add: uint_plus_simple_iff)

lemma prepare_create_aux :
"g_orig st = state \<Longrightarrow>
 g_stack st = [] \<Longrightarrow>
 account_balance0 (state sender) \<ge> gas_value \<Longrightarrow>
 g_current st =
         update_world state sender
          (state sender
           \<lparr>account_balance0 :=
              account_balance0 (state sender) -
              gas_value\<rparr>) \<Longrightarrow>
 balance_inv st"
apply (simp add: balance_inv_def states_def
  total_balance_update_world)
  using word_le_def word_sub_le by auto

lemma uint_minus : "x \<le> y \<Longrightarrow> uint (y - x) \<le> uint y"
  using word_le_def word_sub_le by auto

lemma uint_mul_small :
   "uint (a::w256) * uint b < 2^256 \<Longrightarrow>
    uint (a*b) = uint a * uint b"
  by (simp add: mod_pos_pos_trivial uint_word_ariths(3))

lemma uint_mul_compare :
   "uint (a::w256) * uint b \<le> uint c \<Longrightarrow>
    a*b \<le> c"
using uint_mul_small [of a b]
proof -
  assume a1: "uint a * uint b \<le> uint c"
  then have "\<exists>i. \<not> uint (word_of_int i::256 word) < uint a * uint b"
    by (metis (no_types) not_le word_of_int_uint)
    then have "\<not> 2 ^ 256 \<le> uint a * uint b"
      by (metis (no_types) Divides.pos_mod_bound find_mod not_le order_trans zless2p)
    then have "uint a * uint b < 2 ^ 256"
      by (metis not_le)
  then show ?thesis
    using a1 by (metis (no_types) \<open>uint a * uint b < 2 ^ 256 \<Longrightarrow> uint (a * b) = uint a * uint b\<close> word_le_def)
qed

lemma unat_mul_compare :
   "unat (a::w256) * unat b \<le> unat c \<Longrightarrow>
    a*b \<le> c"
using uint_mul_compare [of a b c]
  le_unat_uoi word_le_nat_alt by fastforce

lemma gas_compare :
   "unat x + unat (a::w256) * unat b \<le> unat c \<Longrightarrow>
    a*b \<le> c"
using unat_mul_compare [of a b c]
  le_add2 order_trans by blast

lemma uint_stuff_aux :
"value \<le> sender \<Longrightarrow>
 recv \<le> recv + value \<Longrightarrow>
 uint (sender - value) +
(uint (recv + value) - uint recv) \<le> uint sender"
  using solution by fastforce

lemma uint_stuff :
"value \<le> sender - gas_value \<Longrightarrow>
 value \<le> sender \<Longrightarrow>
 recv \<le> recv + value \<Longrightarrow>
 uint (sender - gas_value - value) +
(uint (recv + value) - uint recv) \<le> uint (sender - gas_value)"
apply (rule uint_stuff_aux [of "value" "sender-gas_value" recv], auto)
done

lemma prepare_normal_aux :
"g_orig st = update_world state sender
               (state sender
                \<lparr>account_nonce := nonce,
                   account_balance0 :=
                     account_balance0 (state sender) -
                     gas_value \<rparr>) \<Longrightarrow>
 g_stack st = [] \<Longrightarrow>
 value \<le> account_balance0 (state sender) - gas_value \<Longrightarrow>
 value \<le> account_balance0 (state sender) \<Longrightarrow>
 account_balance0 (state recv) \<le> account_balance0 (state recv) + value \<Longrightarrow>
 g_current st = update_world
                 (update_world state sender
                   (state sender
                    \<lparr>account_nonce := nonce,
                       account_balance0 :=
                         account_balance0 (state sender) -
                         gas_value - value\<rparr>)) recv
                    (update_world state sender
                      (state sender
                       \<lparr>account_nonce := nonce,
                          account_balance0 :=
                            account_balance0 (state sender) -
                            gas_value -
                            value\<rparr>)
                      recv
                     \<lparr>account_balance0 :=
                        account_balance0
                         (update_world state sender
                           (state sender
                            \<lparr>account_nonce := nonce,
                               account_balance0 :=
                                 account_balance0 (state sender) -
                                 gas_value -
                                 value\<rparr>)
                           recv) +
                        value\<rparr>)
 \<Longrightarrow> balance_inv st"
apply (simp add: balance_inv_def states_def
  total_balance_update_world)
apply (cases "sender = recv")
apply (simp add: balance_inv_def states_def
  total_balance_update_world update_world_def)
apply (simp add: balance_inv_def states_def
  total_balance_update_world update_world_def)
using uint_stuff [of "value" "account_balance0 (state sender)"
  gas_value "account_balance0 (state recv)"]
 apply force
done

lemma prepare_normal_same :
"g_orig st = update_world state sender
               (state sender
                \<lparr>account_nonce := nonce,
                   account_balance0 :=
                     account_balance0 (state sender) -
                     gas_value \<rparr>) \<Longrightarrow>
 g_stack st = [] \<Longrightarrow>
 g_current st = update_world
                 (update_world state sender
                   (state sender
                    \<lparr>account_nonce := nonce,
                       account_balance0 :=
                         account_balance0 (state sender) -
                         gas_value - value\<rparr>)) sender
                    (update_world state sender
                      (state sender
                       \<lparr>account_nonce := nonce,
                          account_balance0 :=
                            account_balance0 (state sender) -
                            gas_value -
                            value\<rparr>)
                      sender
                     \<lparr>account_balance0 :=
                        account_balance0
                         (update_world state sender
                           (state sender
                            \<lparr>account_nonce := nonce,
                               account_balance0 :=
                                 account_balance0 (state sender) -
                                 gas_value -
                                 value\<rparr>)
                           sender) +
                        value\<rparr>)
 \<Longrightarrow> balance_inv st"
apply (simp add: balance_inv_def states_def
  total_balance_update_world update_world_def)
done

lemma prepare_create_aux2 :
"g_orig st = g_current st \<Longrightarrow>
 g_stack st = [] \<Longrightarrow>
 balance_inv st"
by (simp add: balance_inv_def states_def
  total_balance_update_world)

lemma prepare_balance :
  "start_transaction tr state block = Continue st \<Longrightarrow>
   total_balance state < 2^256 \<Longrightarrow>
   balance_inv st"
apply (simp add:start_transaction_def Let_def
 split:option.split_asm if_split_asm)
apply (rule prepare_create_aux2, auto)
subgoal for recv
apply (cases "tr_from tr \<noteq> recv")
apply (rule prepare_normal_aux, auto)
  using linorder_not_less word_less_nat_alt apply auto[1]
apply (simp add: word_le_nat_alt)
using overflow [of state "tr_value tr" "tr_from tr" recv]
  word_le_nat_alt
apply force
apply (rule prepare_normal_same, auto)
done
done

lemma again2 :
  "uint (sender::w256) \<ge> uint price * uint limit \<Longrightarrow>
   uint (sender - price * limit) =
   uint sender - (uint price * uint limit)"
  by (metis (no_types, hide_lams) int_mod_eq' le_less_trans uint_lt uint_mul_compare uint_mult_ge0 uint_sub uint_word_ariths(3))

(*
lemma again_step1 :
  "unat (sender::w256) \<ge> x + unat price * unat limit \<Longrightarrow>
   unat (sender::w256) \<ge> unat price * unat limit"
*)

lemma again_step2 :
  "a \<ge> 0 \<Longrightarrow> b \<ge> 0 \<Longrightarrow> c \<ge> 0 \<Longrightarrow>
   nat a \<ge> nat b * nat c \<Longrightarrow>
   a \<ge> b * c"
  by (simp add: le_nat_iff)

lemma again_step3 :
  "unat (sender::w256) \<ge> unat (price::w256) * unat (limit::w256) \<Longrightarrow>
   uint sender \<ge> uint price * uint limit"
  by (simp add: unat_def le_nat_iff)

lemma again :
  "unat (sender::w256) \<ge> x + unat price * unat limit \<Longrightarrow>
   uint (sender - price * limit) - uint sender =
    - (uint price * uint limit)"
using again2 again_step3 by force

lemma prepare_total_balance :
  "start_transaction tr state block = Continue st \<Longrightarrow>
   total_balance state < 2^256 \<Longrightarrow>
   total_balance (g_orig st) =
   total_balance state -
   uint (tr_gas_price tr) * uint (tr_gas_limit tr)"
apply (auto simp add:start_transaction_def Let_def
  total_balance_update_world
 split:option.split_asm if_split_asm)
using again [of "unat (tr_value tr)"]
apply force
using again [of "unat (tr_value tr)"]
apply force
done

lemma duh : "unat v + x \<le> unat sender \<Longrightarrow> v \<le> sender"
  by (simp add: word_le_nat_alt)

lemma funext : "(\<forall>x. f x = g x) \<Longrightarrow> f = g" by auto

lemma add_balance_zero :
  "add_balance state addr 0 = state"
apply (rule funext)
apply (simp add:add_balance_def update_world_def)
done

lemma sub_add_balance :
  "add_balance (sub_balance state addr x) addr x = state"
apply (rule funext)
apply (simp add:sub_balance_def add_balance_def update_world_def Let_def)
done

lemma helper :
"word256FromNatural (nat (uint a) * unat b) = a*b"
  by (simp add: unat_def word256FromNatural_def word_arith_nat_mult word_of_nat)

lemma end_transaction_nothing :
  "end_transaction (nothing_happens state tr) tr block
   = state"
apply (auto simp: nothing_happens_def end_transaction_def Let_def
   kill_accounts.simps helper add_balance_zero )
  by (simp add: mult.commute sub_add_balance)

lemma nothing_happens_other :
 "addr \<noteq> tr_from tr \<Longrightarrow>
  account_balance0 (f_state (nothing_happens state tr) addr) =
  account_balance0 (state addr)"
by (simp add:nothing_happens_def
  sub_balance_def update_world_def Let_def)

lemma simple_transaction_other :
  "start_transaction tr state block = Finished st \<Longrightarrow>
   addr \<noteq> tr_from tr \<Longrightarrow>
   account_balance0 (f_state st addr) =
   account_balance0 (state addr)"
by (auto simp add:start_transaction_def Let_def
  total_balance_update_world nothing_happens_other
  account_balance_nonce update_world_def
 split:option.split_asm if_split_asm)

lemma nothing_happens_sender :
 "account_balance0 (f_state (nothing_happens state tr) (tr_from tr)) =
  account_balance0 (state (tr_from tr)) - tr_gas_price tr * tr_gas_limit tr"
by (simp add:nothing_happens_def
  sub_balance_def update_world_def Let_def)

lemma simple_transaction_sender :
  "start_transaction tr state block = Finished st \<Longrightarrow>
   account_balance0 (f_state st (tr_from tr)) =
   account_balance0 (state (tr_from tr)) -
   tr_gas_price tr * tr_gas_limit tr"
by (auto simp add:start_transaction_def Let_def
  total_balance_update_world nothing_happens_sender
  account_balance_nonce update_world_def
 split:option.split_asm if_split_asm)

lemma simple_transaction_overflow :
  "start_transaction tr state block = Finished st \<Longrightarrow>
   unat (tr_gas_price tr) * unat (tr_gas_limit tr) >
   unat (account_balance0 (state (tr_from tr))) \<Longrightarrow>
   st = nothing_happens state tr"
apply (auto simp add:start_transaction_def Let_def
  total_balance_update_world nothing_happens_sender
  account_balance_nonce update_world_def
 split:option.split_asm if_split_asm)
done

lemma end_transaction_zero_price :
  "tr_gas_price tr = 0 \<Longrightarrow>
   f_killed st = [] \<Longrightarrow>
   end_transaction st tr block = f_state st"
by (auto simp: nothing_happens_def end_transaction_def Let_def
   kill_accounts.simps helper add_balance_zero word256FromNatural_def)

lemma simple_calc :
 "uint a + uint b < 2^256 \<Longrightarrow>
  uint (a + b) - uint (a::w256) = uint b"
  by (simp add: overflow_plus)

lemma calc_aux :
"part \<le> totl \<Longrightarrow>
 uint (sender::w256) + uint part < 2^256 \<Longrightarrow>
 uint cb + uint (totl-part) < 2^256 \<Longrightarrow>
 uint (sender + part) +
    (uint (cb + (totl - part)) -
     uint cb -
     uint sender) =
 uint totl"
  by (simp add: uint_sub overflow_plus)

lemma overflow_le : assumes
  a1: "part \<le> totl" and
  a2: "uint sender + uint totl < 2 ^ 256"
shows "uint sender + uint part < 2 ^ 256"
proof -
  have "uint part \<le> uint totl"
    using a1 by (metis word_le_def)
  then show "uint sender + uint part < 2 ^ 256"
    using a2 by linarith
qed

lemma calc :
"part \<le> totl \<Longrightarrow>
 uint (sender::w256) + uint totl < 2^256 \<Longrightarrow>
 uint cb + uint totl < 2^256 \<Longrightarrow>
 uint (sender + part) +
    (uint (cb + (totl - part)) -
     uint cb -
     uint sender) =
 uint totl"
apply (rule calc_aux)
apply (simp add:overflow_le)
using overflow_le apply force
  using overflow_le word_sub_le by blast

lemma foo :
   "uint (tr_gas_price tr * tr_gas_limit tr) =
    uint (tr_gas_limit tr * tr_gas_price tr)"
by auto

lemma grugbr_aux1 :
  "0 \<le> gas_left \<Longrightarrow>
   gas_left \<le> uint (limit :: w256) \<Longrightarrow>
   uint limit * uint (price::w256) < 2^256 \<Longrightarrow>
   gas_left * uint price < 2^256"
  by (meson le_less_trans mult_right_mono uint_range_size)

lemma grugbr_aux2 :
  "0 \<le> gas_left \<Longrightarrow>
   gas_left \<le> uint (limit :: w256) \<Longrightarrow>
   uint limit * uint (price::w256) < 2^256 \<Longrightarrow>
   gas_left * uint price \<le> uint (limit * price)"
  by (simp add: mult_right_mono uint_mul_small)

lemma grugbr :
  "0 \<le> gas_left \<Longrightarrow>
   gas_left \<le> uint (limit :: w256) \<Longrightarrow>
   uint limit * uint price < 2^256 \<Longrightarrow>
   word_of_int (gas_left * uint price) \<le> limit * price"
using grugbr_aux1 [of gas_left limit price]
   grugbr_aux2 [of gas_left limit price]
  by (metis (no_types, hide_lams) int_mod_eq' int_word_uint le_less_trans uint_lt uint_mul_compare wi_hom_mult word_of_int_uint)

lemma grugbr2 :
  "0 \<le> gas_left \<Longrightarrow>
   gas_left \<le> uint (limit :: w256) \<Longrightarrow>
   uint limit * uint price < 2^256 \<Longrightarrow>
   word_of_int (gas_left * int (unat price)) \<le> limit * price"
by (metis grugbr uint_mul_small uint_nat)

lemma tb_end_transaction :
"gas_left \<ge> 0 \<Longrightarrow>
 gas_left \<le> uint (tr_gas_limit tr) \<Longrightarrow>
 uint (tr_gas_limit tr) * uint (tr_gas_price tr) < 2^256 \<Longrightarrow>
 uint (account_balance0 (state (tr_from tr))) +
 uint (tr_gas_limit tr * tr_gas_price tr) < 2^256 \<Longrightarrow>
 uint (account_balance0 (state (block_coinbase block))) +
 uint (tr_gas_limit tr * tr_gas_price tr) < 2^256 \<Longrightarrow>
 total_balance (end_transaction
    \<lparr>f_state = state, f_killed = [], f_gas = gas_left, f_refund = 0, f_logs = []\<rparr>
    tr block) =
 total_balance state + (uint (tr_gas_price tr * tr_gas_limit tr))"
apply (simp add: end_transaction_def Let_def kill_accounts.simps
  add_balance_def total_balance_update_world)
apply (auto simp add:update_world_def)
using simple_calc apply force
apply (simp add: foo)
apply (rule calc, auto)
apply (simp add :word256FromNatural_def)
apply (rule grugbr2, auto)
done

lemma txdatacost_nonneg : "txdatacost lst \<ge> 0"
apply (induction lst)
apply (auto simp add:txdatacost.simps)
done

lemma igas_nonneg : "calc_igas tr state block \<ge> 0"
by (auto simp add:calc_igas_def Let_def txdatacost_nonneg
  split:option.split)

lemma aux_1 :
  "unat (tr_gas_limit tr) \<ge> nat \<bar>calc_igas tr state block\<bar> \<Longrightarrow>
   int (unat (tr_gas_limit tr)) -
    calc_igas tr state block
    \<le> uint (tr_gas_limit tr)"
by (auto simp add:igas_nonneg unat_def)

lemma aux_2 :
  "sender \<ge> vl + price * limit \<Longrightarrow>
   sender < 2^256 \<Longrightarrow>
   int limit * int price < 2 ^ 256"
  by (metis add_leE le_less_trans mult.commute numeral_pow of_nat_less_iff of_nat_mult of_nat_numeral)

lemma unat_small : "unat (x::w256) < 2^256"
proof -
  { assume "\<exists>i. \<not> uint x < i \<and> 0 < i \<and> (0::int) \<noteq> numeral (Num.pow (num.Bit0 num.One) (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 num.One)))))))))"
    then have "\<not> uint x \<le> 0 \<and> (0::int) \<noteq> numeral (Num.pow (num.Bit0 num.One) (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 num.One)))))))))"
      by (meson le_less_trans)
    then have "uint x < numeral (Num.pow (num.Bit0 num.One) (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 num.One)))))))))"
      by (metis (no_types) find_mod numeral_pow word_of_int_uint zmod_trival_iff) }
  then show ?thesis
    by (metis (no_types) numeral_pow of_nat_less_iff of_nat_numeral power_not_zero uint_nat zero_less_power zero_not_eq_two zless2)
qed

lemma aux_3 :
  "unat (sender :: w256) \<ge> vl +
   unat (price) * unat (limit) \<Longrightarrow>
   uint (sender - price * limit) + uint (limit*price) < 2^256"
proof -
  assume a1: "vl + unat price * unat limit \<le> unat sender"
  have f2: "\<forall>w. int (unat (w::256 word)) < numeral (Num.pow (num.Bit0 num.One) (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 (num.Bit0 num.One)))))))))"
    by (metis (no_types) less_imp_of_nat_less numeral_pow of_nat_numeral unat_small)
  have "limit * price \<le> sender"
    using a1 by (simp add: semiring_normalization_rules(7) unat_mul_compare)
    then show ?thesis
      using f2 by (metis (no_types) add.commute diff_add_cancel numeral_pow semiring_normalization_rules(7) uint_add uint_nat)
  qed

lemma cool :
 "uint (cb::w256) +
  uint (sender::w256) < 2^256 \<Longrightarrow>
  gas_value \<le> sender \<Longrightarrow>
  uint cb +
  uint (gas_value::w256)
    < 115792089237316195423570985008687907853269984665640564039457584007913129639936"
using Balance.overflow_le by auto

lemma handle_minus :
  "b \<le> a \<Longrightarrow>
   uint a - uint b = uint (a-b)"
  by (simp add: uint_minus_simple_alt)

lemma aux_4 :
 "gas_value \<le> sender \<Longrightarrow>
  uint (sender - gas_value) +
    (uint gas_value - uint sender) = 0"
using handle_minus by force

lemma end_simple_transaction :
  "start_transaction tr state block = Finished st \<Longrightarrow>
   unat (tr_gas_price tr) * unat (tr_gas_limit tr) \<le>
   unat (account_balance0 (state (tr_from tr))) \<Longrightarrow>
   uint (account_balance0 (state (tr_from tr))) +
   uint (account_balance0 (state (block_coinbase block))) < 2^256 \<Longrightarrow>
   total_balance state = total_balance (end_transaction st tr block)"
apply (auto simp add:start_transaction_def Let_def
  total_balance_update_world nothing_happens_sender
  account_balance_nonce update_world_def end_transaction_nothing
 split:option.split_asm if_split_asm)
apply (subst end_transaction_zero_price, auto)
using tb_update_nonce apply force
apply (subst tb_end_transaction)
apply (auto simp add:igas_nonneg)[1]
apply (auto simp add:igas_nonneg unat_def)[1]
apply (subst Word.uint_nat)
apply (subst Word.uint_nat)
apply (rule aux_2[of "unat (tr_value tr)"
 _ _ "unat (account_balance0 (state (tr_from tr)))"], auto)
using unat_small apply force
apply (simp add:account_balance_nonce
  update_world_def)
using aux_3 [of "unat (tr_value tr)"
  "tr_gas_price tr" "tr_gas_limit tr"
  "account_balance0 (state (tr_from tr))"]
apply force
apply (simp add:account_balance_nonce
  update_world_def)
subgoal
apply auto
using aux_3 [of "unat (tr_value tr)"
  "tr_gas_price tr" "tr_gas_limit tr"
  "account_balance0 (state (tr_from tr))"]
apply force
apply (rule cool[of "account_balance0
       (state (block_coinbase block))"
  "account_balance0
       (state (tr_from tr))"
"tr_gas_limit tr * tr_gas_price tr"], auto)
  by (simp add: gas_compare linorder_not_less mult.commute)
apply (simp add:tb_update_nonce
  total_balance_update_world)
apply (rule aux_4)
  using gas_compare linorder_not_less by blast

end