diff --git a/thys/IEEE_Floating_Point/Conversion_IEEE_Float.thy b/thys/IEEE_Floating_Point/Conversion_IEEE_Float.thy
--- a/thys/IEEE_Floating_Point/Conversion_IEEE_Float.thy
+++ b/thys/IEEE_Floating_Point/Conversion_IEEE_Float.thy
@@ -1,346 +1,348 @@
 (* Author: Fabian Hellauer
            Fabian Immler
 *)
 theory Conversion_IEEE_Float
   imports
     "HOL-Library.Float"
     IEEE_Properties
     "HOL-Library.Code_Target_Numeral"
 begin
 
 definition "of_finite (x::('e, 'f)float) =
   (if is_normal x then (Float (normal_mantissa x) (normal_exponent x))
     else if is_denormal x then (Float (denormal_mantissa x) (denormal_exponent TYPE(('e, 'f)float)))
     else 0)"
 
 lemma float_val_of_finite: "is_finite x \<Longrightarrow> of_finite x = valof x"
   by (induction x) (auto simp: normal_imp_not_denormal of_finite_def)
 
 definition is_normal_Float::"('e, 'f)float itself \<Rightarrow> Float.float \<Rightarrow> bool" where
   "is_normal_Float x f \<longleftrightarrow>
     mantissa f \<noteq> 0 \<and>
     bitlen \<bar>mantissa f\<bar> \<le> fracwidth x + 1 \<and>
     - int (bias x) - bitlen \<bar>mantissa f\<bar> + 1 < Float.exponent f \<and>
     Float.exponent f < 2^(LENGTH('e)) - bitlen \<bar>mantissa f\<bar> - bias x"
 
 definition is_denormal_Float::"('e, 'f)float itself \<Rightarrow> Float.float \<Rightarrow> bool" where
   "is_denormal_Float x f \<longleftrightarrow>
     mantissa f \<noteq> 0 \<and>
     bitlen \<bar>mantissa f\<bar> \<le> 1 - Float.exponent f - int (bias x) \<and>
     1 - 2^(LENGTH('e) - 1) - int LENGTH('f) < Float.exponent f"
 
 lemmas is_denormal_FloatD =
   is_denormal_Float_def[THEN iffD1, THEN conjunct1]
   is_denormal_Float_def[THEN iffD1, THEN conjunct2]
 
 definition is_finite_Float::"('e, 'f)float itself \<Rightarrow> Float.float \<Rightarrow> bool" where
   "is_finite_Float x f \<longleftrightarrow> is_normal_Float x f \<or> is_denormal_Float x f \<or> f = 0"
 
 lemma is_finite_Float_eq:
   "is_finite_Float TYPE(('e, 'f)float) f \<longleftrightarrow>
     (let e = Float.exponent f; bm = bitlen (abs (mantissa f))
     in bm \<le> Suc LENGTH('f) \<and>
      bm \<le> 2 ^ (LENGTH('e) - 1) - e \<and>
      1 - 2 ^ (LENGTH('e) - 1) - int LENGTH('f) < e)"
 proof -
   have *: "(2::int) ^ (LENGTH('e) - Suc 0) - 1 < 2 ^ LENGTH('e)"
     by (metis Suc_1 diff_le_self lessI linorder_not_less one_less_numeral_iff
         power_strict_increasing_iff zle_diff1_eq)
   have **: "1 - 2 ^ (LENGTH('e) - Suc 0) < int LENGTH('f)"
     by (smt len_gt_0 of_nat_0_less_iff zero_less_power)
   have ***: "2 ^ (LENGTH('e) - 1) + 1 =
     2 ^ LENGTH('e) - int (bias TYPE(('e, 'f) IEEE.float))"
     by (simp add: bias_def power_Suc[symmetric])
   have rewr: "x \<le> 2 ^ n - e \<longleftrightarrow> x + e < 2 ^ n + 1" for x::int and n e
     by auto
   show ?thesis
     unfolding *** rewr
     using * **
     unfolding is_finite_Float_def is_normal_Float_def is_denormal_Float_def
     by (auto simp: Let_def bias_def mantissa_eq_zero_iff
         intro: le_less_trans[OF add_right_mono])
 qed
 
 lift_definition normal_of_Float :: "Float.float \<Rightarrow> ('e, 'f)float"
   is "\<lambda>x. let m = mantissa x; e = Float.exponent x in
     (if m > 0 then 0 else 1,
       word_of_int (e + int (bias TYPE(('e, 'f)float)) + bitlen \<bar>m\<bar> - 1),
       word_of_int (\<bar>m\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>m\<bar>)) - 2 ^ (LENGTH('f))))"
   .
 
 lemma sign_normal_of_Float:"sign (normal_of_Float x) = (if x > 0 then 0 else 1)"
   by transfer (auto simp: Let_def mantissa_pos_iff)
 
 lemma uints_bitlen_eq: "uints n = {i. 0 \<le> i \<and> bitlen i \<le> n}"
   by (auto simp: uints_num bitlen_le_iff_power)
 
 lemma uint_word_of_int_bitlen_eq:
   "uint (word_of_int x::'a::len word) = x" if "bitlen x \<le> LENGTH('a)" "x \<ge> 0"
   by (subst word_uint.Abs_inverse) (simp_all add: uints_bitlen_eq that)
 
 lemma fraction_normal_of_Float:"fraction (normal_of_Float x::('e, 'f)float) =
   (nat \<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>)) - 2 ^ LENGTH('f))"
   if "is_normal_Float TYPE(('e, 'f)float) x"
 proof -
   from that have bmp: "bitlen \<bar>mantissa x\<bar> > 0"
     by (metis abs_of_nonneg bitlen_bounds bitlen_def is_normal_Float_def nat_code(2) of_nat_0_le_iff
         power.simps(1) zabs_less_one_iff zero_less_abs_iff)
   have mless: "\<bar>mantissa x\<bar> < 2 ^ nat (bitlen \<bar>mantissa x\<bar>)"
     using bitlen_bounds by force
   have lem: "2 ^ nat (bitlen \<bar>mantissa x\<bar> - 1) \<le> \<bar>mantissa x\<bar>"
     using bitlen_bounds is_normal_Float_def that zero_less_abs_iff by blast
   from that have nble: "nat (bitlen \<bar>mantissa x\<bar>) \<le> Suc LENGTH('f)"
     using bitlen_bounds by (auto simp: is_normal_Float_def)
   have nn: "0 \<le> \<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>)) - 2 ^ LENGTH('f)"
     apply (rule add_le_imp_le_diff)
     apply (rule order_trans[rotated])
      apply (rule mult_right_mono)
       apply (rule lem, force)
     unfolding power_add[symmetric]
     using nble bmp
     by (auto)
   have "\<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>)) < 2 * 2 ^ LENGTH('f)"
     apply (rule less_le_trans)
      apply (rule mult_strict_right_mono)
       apply (rule mless)
      apply force
     unfolding power_add[symmetric] power_Suc[symmetric]
     apply (rule power_increasing)
     using nble
     by auto
   then have "bitlen (\<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>)) - 2 ^ LENGTH('f))
     \<le> int LENGTH('f)"
     unfolding bitlen_le_iff_power
     by simp
   then show ?thesis
     apply (transfer fixing: x)
-    unfolding Let_def split_beta' fst_conv snd_conv uint_nat[symmetric] unat_def
+    unfolding Let_def split_beta' fst_conv snd_conv uint_nat [symmetric] nat_uint_eq [symmetric]
     using nn
-    by (subst uint_word_of_int_bitlen_eq)
-      (auto simp: nat_mult_distrib nat_diff_distrib nat_power_eq)
+    apply (subst uint_word_of_int_bitlen_eq)
+      apply (auto simp: nat_mult_distrib nat_diff_distrib nat_power_eq)
+    done
 qed
 
 lemma exponent_normal_of_Float:"exponent (normal_of_Float x::('e, 'f)float) =
   nat (Float.exponent x + (bias TYPE(('e, 'f)float)) + bitlen \<bar>mantissa x\<bar> - 1)"
   if "is_normal_Float TYPE(('e, 'f)float) x"
   using that
-  by (transfer fixing: x)
-    (auto simp: is_normal_Float_def bitlen_le_iff_power uint_word_of_int_bitlen_eq Let_def
-      uint_nat[symmetric] unat_def)
+  apply (transfer fixing: x)
+  apply (simp flip: uint_nat nat_uint_eq add: Let_def)
+  apply (subst uint_word_of_int_bitlen_eq)
+    apply (auto simp: is_normal_Float_def bitlen_le_iff_power uint_word_of_int_bitlen_eq Let_def)
+  done
 
 lift_definition denormal_of_Float :: "Float.float \<Rightarrow> ('e, 'f)float"
   is "\<lambda>x. let m = mantissa x; e = Float.exponent x in
   (if m \<ge> 0 then 0 else 1, 0,
     word_of_int (\<bar>m\<bar> * 2 ^ nat (e + bias TYPE(('e, 'f)float) + fracwidth TYPE(('e, 'f)float) - 1)))"
   .
 
 lemma sign_denormal_of_Float:"sign (denormal_of_Float x) = (if x \<ge> 0 then 0 else 1)"
   by transfer (auto simp: Let_def mantissa_nonneg_iff)
 
 lemma exponent_denormal_of_Float:"exponent (denormal_of_Float x::('e, 'f)float) = 0"
   by (transfer fixing: x) (auto simp: Let_def)
 
 lemma fraction_denormal_of_Float:"fraction (denormal_of_Float x::('e, 'f)float) =
   (nat \<bar>mantissa x\<bar> * 2 ^ nat (Float.exponent x + bias TYPE(('e, 'f)float) + LENGTH('f) - 1))"
   if "is_denormal_Float TYPE(('e, 'f)float) x"
 proof -
   have mless: "\<bar>mantissa x\<bar> < 2 ^ nat (bitlen \<bar>mantissa x\<bar>)"
     using bitlen_bounds by force
   have *: "nat (bitlen \<bar>mantissa x\<bar>) +
     nat (Float.exponent x + (2 ^ (LENGTH('e) - Suc 0) + int LENGTH('f)) - 2)
     \<le> LENGTH('f)"
     using that
     by (auto simp: is_denormal_Float_def nat_diff_distrib' le_diff_conv
         bitlen_nonneg nat_le_iff bias_def nat_add_distrib[symmetric])
   have "\<bar>mantissa x\<bar> *  2 ^ nat (Float.exponent x + int (bias TYPE(('e, 'f)float)) +
     LENGTH('f) - 1) < 2 ^ LENGTH('f)"
     apply (rule less_le_trans)
      apply (rule mult_strict_right_mono)
       apply (rule mless, force)
     unfolding power_add[symmetric] power_Suc[symmetric]
     apply (rule power_increasing)
      apply (auto simp: bias_def)
     using that *
     by (auto simp: is_denormal_Float_def algebra_simps)
   then show ?thesis
     apply (transfer fixing: x)
-    unfolding Let_def split_beta' fst_conv snd_conv uint_nat[symmetric] unat_def
-    apply (subst uint_word_of_int_bitlen_eq)
-    unfolding bitlen_le_iff_power
-    by (auto simp: nat_mult_distrib)
+    apply transfer
+    apply (simp add: Let_def nat_eq_iff take_bit_eq_mod)
+    done
 qed
 
 definition of_finite_Float :: "Float.float \<Rightarrow> ('e, 'f) float" where
   "of_finite_Float x = (if is_normal_Float TYPE(('e, 'f)float) x then normal_of_Float x
     else if is_denormal_Float TYPE(('e, 'f)float) x then denormal_of_Float x
     else 0)"
 
 lemma valof_normal_of_Float: "valof (normal_of_Float x::('e, 'f)float) = x"
   if "is_normal_Float TYPE(('e, 'f)float) x"
 proof -
   have "valof (normal_of_Float x::('e, 'f)float) =
     (- 1) ^ sign (normal_of_Float x::('e, 'f)float) *
     ((1 + real (nat \<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>)) - 2 ^ LENGTH('f)) / 2 ^ LENGTH('f)) *
       2 powr (bitlen \<bar>mantissa x\<bar> - 1)) *
     2 powr Float.exponent x"
     (is "_ = ?s * ?m * ?e")
     using that
     by (auto simp: is_normal_Float_def valof_eq fraction_normal_of_Float
         powr_realpow[symmetric] exponent_normal_of_Float powr_diff powr_add)
   also
   have "\<bar>mantissa x\<bar> > 0"
     using that
     by (auto simp: is_normal_Float_def)
   have bound: "2 ^ LENGTH('f) \<le> nat \<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>))"
   proof -
     have "(2::nat) ^ LENGTH('f) \<le> 2 ^ nat (bitlen \<bar>mantissa x\<bar> - 1) * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>))"
       by (simp add: power_add[symmetric])
     also have "\<dots> \<le> nat \<bar>mantissa x\<bar> * 2 ^ (Suc LENGTH('f) - nat (bitlen \<bar>mantissa x\<bar>))"
       using bitlen_bounds[of "\<bar>mantissa x\<bar>"] that
       by (auto simp: is_normal_Float_def)
     finally show ?thesis .
   qed
   have "?m = abs (mantissa x)"
     apply (subst of_nat_diff)
     subgoal using bound by auto
     subgoal
       using that
       by (auto simp: powr_realpow[symmetric] powr_add[symmetric]
           is_normal_Float_def bitlen_nonneg of_nat_diff divide_simps)
     done
   finally show ?thesis
     by (auto simp: mantissa_exponent sign_normal_of_Float abs_real_def zero_less_mult_iff)
 qed
 
 lemma valof_denormal_of_Float: "valof (denormal_of_Float x::('e, 'f)float) = x"
   if "is_denormal_Float TYPE(('e, 'f)float) x"
 proof -
   have less: "0 < Float.exponent x + (int (bias TYPE(('e, 'f) IEEE.float)) + int LENGTH('f))"
     using that
     by (auto simp: is_denormal_Float_def bias_def)
   have "valof (denormal_of_Float x::('e, 'f)float) =
     ((- 1) ^ sign (denormal_of_Float x::('e, 'f)float) * \<bar>real_of_int (mantissa x)\<bar>) *
     (2 powr real (nat (Float.exponent x + int (bias TYPE(('e, 'f) IEEE.float)) + int LENGTH('f) - 1)) /
       (2 powr real (bias TYPE(('e, 'f) IEEE.float)) * 2 powr LENGTH('f)) * 2)"
     (is "_ = ?m * ?e")
     by (auto simp: valof_eq exponent_denormal_of_Float fraction_denormal_of_Float that
         mantissa_exponent powr_realpow[symmetric])
   also have "?m = mantissa x"
     by (auto simp: sign_denormal_of_Float abs_real_def mantissa_neg_iff)
   also have "?e = 2 powr Float.exponent x"
     by (auto simp: powr_add[symmetric] divide_simps powr_mult_base less ac_simps)
   finally show ?thesis by (simp add: mantissa_exponent)
 qed
 
 lemma valof_of_finite_Float:
   "is_finite_Float (TYPE(('e, 'f) IEEE.float)) x \<Longrightarrow> valof (of_finite_Float x::('e, 'f)float) = x"
   by (auto simp: of_finite_Float_def is_finite_Float_def valof_denormal_of_Float valof_normal_of_Float)
 
 lemma is_normal_normal_of_Float:
   "is_normal (normal_of_Float x::('e, 'f)float)" if "is_normal_Float TYPE(('e, 'f)float) x"
   using that
   by (auto simp: is_normal_def exponent_normal_of_Float that is_normal_Float_def
       emax_eq nat_less_iff)
 
 lemma is_denormal_denormal_of_Float: "is_denormal (denormal_of_Float x::('e, 'f)float)"
   if "is_denormal_Float TYPE(('e, 'f)float) x"
   using that
   by (auto simp: is_denormal_def exponent_denormal_of_Float that is_denormal_Float_def
       emax_eq fraction_denormal_of_Float le_nat_iff bias_def)
 
 lemma is_finite_of_finite_Float: "is_finite (of_finite_Float x)"
   by (auto simp: is_finite_def of_finite_Float_def is_normal_normal_of_Float
       is_denormal_denormal_of_Float)
 
 lemma Float_eq_zero_iff: "Float m e = 0 \<longleftrightarrow> m = 0"
   by (metis Float.compute_is_float_zero Float_0_eq_0)
 
 lemma bitlen_mantissa_Float:
   shows "bitlen \<bar>mantissa (Float m e)\<bar> = (if m = 0 then 0 else bitlen \<bar>m\<bar> + e) - Float.exponent (Float m e)"
   using bitlen_Float[of m e] by auto
 
 lemma exponent_Float:
   shows "Float.exponent (Float m e) = (if m = 0 then 0 else bitlen \<bar>m\<bar> + e) - bitlen \<bar>mantissa (Float m e)\<bar> "
   using bitlen_Float[of m e] by auto
 
 lemma is_normal_Float_normal:
   "is_normal_Float TYPE(('e, 'f)float) (Float (normal_mantissa x) (normal_exponent x))"
   if "is_normal x" for x::"('e, 'f)float"
 proof -
   define f where "f = Float (normal_mantissa x) (normal_exponent x)"
   from that have "f \<noteq> 0"
     by (auto simp: f_def is_normal_def zero_float_def[symmetric]
         Float_eq_zero_iff normal_mantissa_def add_nonneg_eq_0_iff)
   from denormalize_shift[OF f_def this] obtain i where
     i: "normal_mantissa x = mantissa f * 2 ^ i" "normal_exponent x = Float.exponent f - int i"
     by auto
   have "mantissa f \<noteq> 0"
     by (auto simp: \<open>f \<noteq> 0\<close> i mantissa_eq_zero_iff Float_eq_zero_iff)
   moreover
   have "normal_exponent x \<le> Float.exponent f" unfolding i by simp
   then have " bitlen \<bar>mantissa f\<bar> \<le> 1 + int LENGTH('f)"
     unfolding bitlen_mantissa_Float bitlen_normal_mantissa f_def
     by auto
   moreover
   have "- int (bias TYPE(('e, 'f)float)) - bitlen \<bar>mantissa f\<bar> + 1 < Float.exponent f"
     unfolding bitlen_mantissa_Float bitlen_normal_mantissa f_def
     using that
     by (auto simp: mantissa_eq_zero_iff abs_mult bias_def normal_mantissa_def normal_exponent_def
         is_normal_def emax_eq less_diff_conv add_nonneg_eq_0_iff)
   moreover
   have "2 ^ (LENGTH('e) - Suc 0) + - (1::int) * 2 ^ LENGTH('e) \<le> 0"
     by simp
   then have "(2::int) ^ (LENGTH('e) - Suc 0) < 1 + 2 ^ LENGTH('e)" by arith
   then have "Float.exponent f <
       2 ^ LENGTH('e) - bitlen \<bar>mantissa f\<bar> - int (bias TYPE(('e, 'f)float))"
     using normal_exponent_bounds_int[OF that]
     unfolding bitlen_mantissa_Float bitlen_normal_mantissa f_def
     by (auto simp: bias_def algebra_simps power_Suc[symmetric]
         intro: le_less_trans[OF add_right_mono] normal_exponent_bounds_int[OF that])
   ultimately
   show ?thesis
     by (auto simp: is_normal_Float_def f_def)
 qed
 
 
 lemma is_denormal_Float_denormal:
   "is_denormal_Float TYPE(('e, 'f)float)
     (Float (denormal_mantissa x) (denormal_exponent TYPE(('e, 'f)float)))"
   if "is_denormal x" for x::"('e, 'f)float"
 proof -
   define f where "f = Float (denormal_mantissa x) (denormal_exponent TYPE(('e, 'f)float))"
   from that have "f \<noteq> 0"
     by (auto simp: f_def is_denormal_def zero_float_def[symmetric]
         Float_eq_zero_iff denormal_mantissa_def add_nonneg_eq_0_iff)
   from denormalize_shift[OF f_def this] obtain i where
     i: "denormal_mantissa x = mantissa f * 2 ^ i" "denormal_exponent TYPE(('e, 'f)float) = Float.exponent f - int i"
     by auto
   have "mantissa f \<noteq> 0"
     by (auto simp: \<open>f \<noteq> 0\<close> i mantissa_eq_zero_iff Float_eq_zero_iff)
   moreover
   have "bitlen \<bar>mantissa f\<bar> \<le> 1 - Float.exponent f - int (bias TYPE(('e, 'f) IEEE.float))"
     using \<open>mantissa f \<noteq> 0\<close>
     unfolding f_def bitlen_mantissa_Float
     using bitlen_denormal_mantissa[of x]
     by (auto simp: denormal_exponent_def)
   moreover
   have "2 - 2 ^ (LENGTH('e) - Suc 0) - int LENGTH('f) \<le> Float.exponent f"
     (is "?l \<le> _")
   proof -
     have "?l \<le> denormal_exponent TYPE(('e, 'f)float) + i"
       using that
       by (auto simp: is_denormal_def bias_def denormal_exponent_def)
     also have "\<dots> = Float.exponent f" unfolding i by auto
     finally show ?thesis .
   qed
   ultimately
   show ?thesis
     unfolding is_denormal_Float_def exponent_Float f_def[symmetric]
     by auto
 qed
 
 lemma is_finite_Float_of_finite: "is_finite_Float TYPE(('e, 'f)float) (of_finite x)" for x::"('e, 'f)float"
   by (auto simp: is_finite_Float_def of_finite_def is_normal_Float_normal
       is_denormal_Float_denormal)
 
 end
diff --git a/thys/IP_Addresses/IP_Address.thy b/thys/IP_Addresses/IP_Address.thy
--- a/thys/IP_Addresses/IP_Address.thy
+++ b/thys/IP_Addresses/IP_Address.thy
@@ -1,412 +1,412 @@
 (*  Title:      IP_Address.thy
     Authors:    Cornelius Diekmann
 *)
 theory IP_Address
 imports "Word_Lib.Word_Lemmas"
         Hs_Compat
         WordInterval
 begin
 
 section \<open>Modelling IP Adresses\<close>
   text\<open>An IP address is basically an unsigned integer.
     We model IP addresses of arbitrary lengths.
 
     We will write @{typ "'i::len word"} for IP addresses of length @{term "LENGTH('i::len)"}.
     We use the convention to write @{typ 'i} whenever we mean IP addresses instead of generic words.
     When we will later have theorems with several polymorphic types in it (e.g. arbitrarily
     extensible packets), this notation makes it easier to spot that type @{typ 'i} is for
     IP addresses.
 
     The files @{file \<open>IPv4.thy\<close>} @{file \<open>IPv6.thy\<close>} concrete this for IPv4 and IPv6.\<close>
 
   text\<open>The maximum IP address\<close>
   definition max_ip_addr :: "'i::len word" where
     "max_ip_addr \<equiv> of_nat ((2^(len_of(TYPE('i)))) - 1)"
 
   lemma max_ip_addr_max_word: "max_ip_addr = max_word"
     by(simp add: max_ip_addr_def word_of_int_minus)
 
   lemma max_ip_addr_max: "\<forall>a. a \<le> max_ip_addr"
     by(simp add: max_ip_addr_max_word)
   lemma range_0_max_UNIV: "UNIV = {0 .. max_ip_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ip_addr_max_word) fastforce
 
   lemma "size (x::'i::len word) = len_of(TYPE('i))" by(simp add:word_size)
 
 subsection\<open>Sets of IP Addresses\<close>
   (*Warning, not executable!*)
   text\<open>Specifying sets with network masks: 192.168.0.0 255.255.255.0\<close>
   definition ipset_from_netmask::"'i::len word \<Rightarrow> 'i::len word \<Rightarrow> 'i::len word set" where
     "ipset_from_netmask addr netmask \<equiv>
       let
         network_prefix = (addr AND netmask)
       in
         {network_prefix .. network_prefix OR (NOT netmask)}"
 
   text\<open>Example (pseudo syntax):
     @{const ipset_from_netmask} \<open>192.168.1.129  255.255.255.0\<close> =
         \<open>{192.168.1.0 .. 192.168.1.255}\<close>\<close>
 
   text\<open>A network mask of all ones (i.e. @{term "(- 1)::'i::len word"}).\<close>
   lemma ipset_from_netmask_minusone:
     "ipset_from_netmask ip (- 1) = {ip}" by (simp add: ipset_from_netmask_def)
   lemma ipset_from_netmask_maxword:
     "ipset_from_netmask ip max_word = {ip}" by (simp add: ipset_from_netmask_def)
 
   lemma ipset_from_netmask_zero:
     "ipset_from_netmask ip 0 = UNIV" by (auto simp add: ipset_from_netmask_def)
 
 
   text\<open>Specifying sets in Classless Inter-domain Routing (CIDR) notation: 192.168.0.0/24\<close>
   definition ipset_from_cidr ::"'i::len word \<Rightarrow> nat \<Rightarrow> 'i::len word set" where
     "ipset_from_cidr addr pflength \<equiv>
        ipset_from_netmask addr ((mask pflength) << (len_of(TYPE('i)) - pflength))"
 
   text\<open>Example (pseudo syntax):
     @{const ipset_from_cidr} \<open>192.168.1.129 24\<close> = \<open>{192.168.1.0 .. 192.168.1.255}\<close>\<close>
 
   (*does this simplify stuff?*)
   lemma "(case ipcidr of (base, len) \<Rightarrow> ipset_from_cidr base len) = uncurry ipset_from_cidr ipcidr"
     by(simp add: uncurry_case_stmt)
 
   lemma ipset_from_cidr_0: "ipset_from_cidr ip 0 = UNIV"
     by(auto simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def)
 
   text\<open>A prefix length of word size gives back the singleton set with the IP address.
        Example: \<open>192.168.1.2/32 = {192.168.1.2}\<close>\<close>
   lemma ipset_from_cidr_wordlength:
     fixes ip :: "'i::len word"
     shows "ipset_from_cidr ip (LENGTH('i)) = {ip}"
-    by(simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def mask_def)
+    by (simp add: ipset_from_cidr_def ipset_from_netmask_def)
 
   text\<open>Alternative definition: Considering words as bit lists:\<close>
   lemma ipset_from_cidr_bl:
     fixes addr :: "'i::len word"
     shows "ipset_from_cidr addr pflength \<equiv>
             ipset_from_netmask addr (of_bl ((replicate pflength True) @
                                             (replicate ((len_of(TYPE('i))) - pflength)) False))"
     by(simp add: ipset_from_cidr_def mask_bl Word.shiftl_of_bl)
 
   lemma ipset_from_cidr_alt:
     fixes pre :: "'i::len word"
     shows "ipset_from_cidr pre len =
             {pre AND (mask len << LENGTH('i) - len)
              ..
              pre OR mask (LENGTH('i) - len)}"
     apply(simp add: ipset_from_cidr_def ipset_from_netmask_def Let_def)
     apply(simp add: Word.word_oa_dist)
     apply(simp add: NOT_mask_shifted_lenword)
     done
 
   lemma ipset_from_cidr_alt2:
     fixes base ::"'i::len word"
     shows "ipset_from_cidr base len =
            ipset_from_netmask base (NOT (mask (LENGTH('i) - len)))"
     apply(simp add: ipset_from_cidr_def)
     using NOT_mask_shifted_lenword by(metis word_not_not)
 
   text\<open>In CIDR notation, we cannot express the empty set.\<close>
   lemma ipset_from_cidr_not_empty: "ipset_from_cidr base len \<noteq> {}"
     by(simp add: ipset_from_cidr_alt bitmagic_zeroLast_leq_or1Last)
 
   text\<open>Though we can write 192.168.1.2/24, we say that 192.168.0.0/24 is well-formed.\<close>
   lemma ipset_from_cidr_base_wellforemd: fixes base:: "'i::len word"
     assumes "mask (LENGTH('i) - l) AND base = 0"
       shows "ipset_from_cidr base l = {base .. base OR mask (LENGTH('i) - l)}"
   proof -
     have maskshift_eq_not_mask_generic:
       "((mask l << LENGTH('i) - l) :: 'i::len word) = NOT (mask (LENGTH('i) - l))"
       using NOT_mask_shifted_lenword by (metis word_not_not)
     have *: "base AND NOT (mask (LENGTH('i) - l)) = base"
       unfolding mask_eq_0_eq_x[symmetric] using assms word_bw_comms(1)[of base] by simp
     hence **: "base AND NOT (mask (LENGTH('i) - l)) OR mask (LENGTH('i) - l) =
                 base OR mask (LENGTH('i) - l)" by simp
     have "ipset_from_netmask base (NOT (mask (LENGTH('i) - l))) =
             {base .. base || mask (LENGTH('i) - l)}"
       by(simp add: ipset_from_netmask_def Let_def ** *)
     thus ?thesis by(simp add: ipset_from_cidr_def maskshift_eq_not_mask_generic)
   qed
 
 
   lemma ipset_from_cidr_large_pfxlen:
     fixes ip:: "'i::len word"
     assumes "n \<ge> LENGTH('i)"
     shows "ipset_from_cidr ip n = {ip}"
   proof -
     have obviously: "mask (LENGTH('i) - n) = 0" by (simp add: assms)
     show ?thesis
       apply(subst ipset_from_cidr_base_wellforemd)
        subgoal using assms by simp
       by (simp add: obviously)
   qed
 
   lemma ipset_from_netmask_base_mask_consume:
     fixes base :: "'i::len word"
     shows "ipset_from_netmask (base AND NOT (mask (LENGTH('i) - m)))
                               (NOT (mask (LENGTH('i) - m)))
             =
              ipset_from_netmask base (NOT (mask (LENGTH('i) - m)))"
     unfolding ipset_from_netmask_def by(simp)
 
 
   text\<open>Another definition of CIDR notation:
        All IP address which are equal on the first @{term "len - n"} bits\<close>
   definition ip_cidr_set :: "'i::len word \<Rightarrow> nat \<Rightarrow> 'i word set" where
     "ip_cidr_set i r \<equiv>
       {j . i AND NOT (mask (LENGTH('i) - r)) = j AND NOT (mask (LENGTH('i) - r))}"
 
   text\<open>The definitions are equal\<close>
   lemma ipset_from_cidr_eq_ip_cidr_set:
     fixes base::"'i::len word"
     shows "ipset_from_cidr base len = ip_cidr_set base len"
   proof -
     have maskshift_eq_not_mask_generic:
       "((mask len << LENGTH('a) - len) :: 'a::len word) = NOT (mask (LENGTH('a) - len))"
       using NOT_mask_shifted_lenword by (metis word_not_not)
     have 1: "mask (len - m) AND base AND NOT (mask (len - m)) = 0"
       for len m and base::"'i::len word"
       by(simp add: word_bw_lcs)
     have 2: "mask (LENGTH('i) - len) AND pfxm_p = 0 \<Longrightarrow>
            (a \<in> ipset_from_netmask pfxm_p (NOT (mask (LENGTH('i) - len)))) \<longleftrightarrow>
            (pfxm_p = NOT (mask (LENGTH('i) - len)) AND a)" for a::"'i::len word" and pfxm_p
     apply(subst ipset_from_cidr_alt2[symmetric])
     apply(subst zero_base_lsb_imp_set_eq_as_bit_operation)
      apply(simp; fail)
     apply(subst ipset_from_cidr_base_wellforemd)
      apply(simp; fail)
     apply(simp)
     done
     from 2[OF 1, of _ base] have
       "(x \<in> ipset_from_netmask base (~~ (mask (LENGTH('i) - len)))) \<longleftrightarrow>
        (base && ~~ (mask (LENGTH('i) - len)) = x && ~~ (mask (LENGTH('i) - len)))" for x
     apply(simp add: ipset_from_netmask_base_mask_consume)
     unfolding word_bw_comms(1)[of _ " ~~ (mask (LENGTH('i) - len))"] by simp
     then show ?thesis
       unfolding ip_cidr_set_def ipset_from_cidr_def
       by(auto simp add:  maskshift_eq_not_mask_generic)
   qed
 
   lemma ip_cidr_set_change_base: "j \<in> ip_cidr_set i r \<Longrightarrow> ip_cidr_set j r = ip_cidr_set i r"
     by (auto simp: ip_cidr_set_def)
 
 
 
 subsection\<open>IP Addresses as WordIntervals\<close>
   text\<open>The nice thing is: @{typ "'i wordinterval"}s are executable.\<close>
 
   definition iprange_single :: "'i::len word \<Rightarrow> 'i wordinterval" where
     "iprange_single ip \<equiv> WordInterval ip ip"
 
   fun iprange_interval :: "('i::len word \<times> 'i::len word) \<Rightarrow> 'i wordinterval" where
     "iprange_interval (ip_start, ip_end) = WordInterval ip_start ip_end"
   declare iprange_interval.simps[simp del]
 
   lemma iprange_interval_uncurry: "iprange_interval ipcidr = uncurry WordInterval ipcidr"
     by(cases ipcidr) (simp add: iprange_interval.simps)
 
   lemma "wordinterval_to_set (iprange_single ip) = {ip}"
     by(simp add: iprange_single_def)
   lemma "wordinterval_to_set (iprange_interval (ip1, ip2)) = {ip1 .. ip2}"
     by(simp add: iprange_interval.simps)
 
   text\<open>Now we can use the set operations on @{typ "'i::len wordinterval"}s\<close>
   term wordinterval_to_set
   term wordinterval_element
   term wordinterval_union
   term wordinterval_empty
   term wordinterval_setminus
   term wordinterval_UNIV
   term wordinterval_invert
   term wordinterval_intersection
   term wordinterval_subset
   term wordinterval_eq
 
 
 subsection\<open>IP Addresses in CIDR Notation\<close>
   text\<open>We want to convert IP addresses in CIDR notation to intervals.
     We already have @{const ipset_from_cidr}, which gives back a non-executable set.
     We want to convert to something we can store in an @{typ "'i wordinterval"}.\<close>
 
   fun ipcidr_to_interval_start :: "('i::len word \<times> nat) \<Rightarrow> 'i::len word" where
     "ipcidr_to_interval_start (pre, len) = (
       let netmask = (mask len) << (LENGTH('i) - len);
           network_prefix = (pre AND netmask)
       in network_prefix)"
   fun ipcidr_to_interval_end :: "('i::len word \<times> nat) \<Rightarrow> 'i::len word" where
     "ipcidr_to_interval_end (pre, len) = (
       let netmask = (mask len) << (LENGTH('i) - len);
           network_prefix = (pre AND netmask)
       in network_prefix OR (NOT netmask))"
   definition ipcidr_to_interval :: "('i::len word \<times> nat) \<Rightarrow> ('i word \<times> 'i word)" where
     "ipcidr_to_interval cidr \<equiv> (ipcidr_to_interval_start cidr, ipcidr_to_interval_end cidr)"
 
 
   lemma ipset_from_cidr_ipcidr_to_interval:
     "ipset_from_cidr base len =
       {ipcidr_to_interval_start (base,len) .. ipcidr_to_interval_end (base,len)}"
     by(simp add: Let_def ipcidr_to_interval_def ipset_from_cidr_def ipset_from_netmask_def)
   declare ipcidr_to_interval_start.simps[simp del] ipcidr_to_interval_end.simps[simp del]
 
   lemma ipcidr_to_interval:
     "ipcidr_to_interval (base, len) = (s,e) \<Longrightarrow> ipset_from_cidr base len = {s .. e}"
     by (simp add: ipcidr_to_interval_def ipset_from_cidr_ipcidr_to_interval)
 
   definition ipcidr_tuple_to_wordinterval :: "('i::len word \<times> nat) \<Rightarrow> 'i wordinterval" where
     "ipcidr_tuple_to_wordinterval iprng \<equiv> iprange_interval (ipcidr_to_interval iprng)"
 
   lemma wordinterval_to_set_ipcidr_tuple_to_wordinterval:
     "wordinterval_to_set (ipcidr_tuple_to_wordinterval (b, m)) = ipset_from_cidr b m"
     unfolding ipcidr_tuple_to_wordinterval_def ipset_from_cidr_ipcidr_to_interval
               ipcidr_to_interval_def
     by(simp add: iprange_interval.simps)
 
   lemma wordinterval_to_set_ipcidr_tuple_to_wordinterval_uncurry:
     "wordinterval_to_set (ipcidr_tuple_to_wordinterval ipcidr) = uncurry ipset_from_cidr ipcidr"
     by(cases ipcidr, simp add: wordinterval_to_set_ipcidr_tuple_to_wordinterval)
 
   definition ipcidr_union_set :: "('i::len word \<times> nat) set \<Rightarrow> ('i word) set" where
     "ipcidr_union_set ips \<equiv> \<Union>(base, len) \<in> ips. ipset_from_cidr base len"
 
   lemma ipcidr_union_set_uncurry:
     "ipcidr_union_set ips = (\<Union> ipcidr \<in> ips. uncurry ipset_from_cidr ipcidr)"
     by(simp add: ipcidr_union_set_def uncurry_case_stmt)
 
 
 subsection\<open>Clever Operations on IP Addresses in CIDR Notation\<close>
   text\<open>Intersecting two intervals may result in a new interval.
     Example: \<open>{1..10} \<inter> {5..20} = {5..10}\<close>
 
     Intersecting two IP address ranges represented as CIDR ranges results either in the empty set
     or the smaller of the two ranges. It will never create a new range.
     \<close>
   context
   begin
     (*contributed by Lars Noschinski*)
     private lemma less_and_not_mask_eq:
       fixes i :: "('a :: len) word"
       assumes "r2 \<le> r1" "i && ~~ (mask r2) = x && ~~ (mask r2)"
       shows "i && ~~ (mask r1) = x && ~~ (mask r1)"
     proof -
       have "i AND NOT (mask r1) = (i && ~~ (mask r2)) && ~~ (mask r1)" (is "_ = ?w && _")
         using \<open>r2 \<le> r1\<close> by (simp add: and_not_mask_twice max_def)
       also have "?w = x && ~~ (mask r2)" by fact
       also have "\<dots> && ~~ (mask r1) = x && ~~ (mask r1)"
         using \<open>r2 \<le> r1\<close> by (simp add: and_not_mask_twice max_def)
       finally show ?thesis .
     qed
 
     lemma ip_cidr_set_less:
       fixes i :: "'i::len word"
       shows "r1 \<le> r2 \<Longrightarrow> ip_cidr_set i r2 \<subseteq> ip_cidr_set i r1"
       unfolding ip_cidr_set_def
       apply auto
       apply (rule less_and_not_mask_eq[where ?r2.0="LENGTH('i) - r2"])
       apply auto
       done
 
     private lemma ip_cidr_set_intersect_subset_helper:
       fixes i1 r1 i2 r2
       assumes disj: "ip_cidr_set i1 r1 \<inter> ip_cidr_set i2 r2 \<noteq> {}" and  "r1 \<le> r2"
       shows "ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1"
       proof -
       from disj obtain j where "j \<in> ip_cidr_set i1 r1" "j \<in> ip_cidr_set i2 r2" by auto
       with \<open>r1 \<le> r2\<close> have "j \<in> ip_cidr_set j r1" "j \<in> ip_cidr_set j r1"
         using ip_cidr_set_change_base ip_cidr_set_less by blast+
 
       show "ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1"
       proof
         fix i assume "i \<in> ip_cidr_set i2 r2"
         with \<open>j \<in> ip_cidr_set i2 r2\<close> have "i \<in> ip_cidr_set j r2" using ip_cidr_set_change_base by auto
         also have "ip_cidr_set j r2 \<subseteq> ip_cidr_set j r1" using \<open>r1 \<le> r2\<close> ip_cidr_set_less by blast
         also have "\<dots> = ip_cidr_set i1 r1" using \<open>j \<in> ip_cidr_set i1 r1\<close> ip_cidr_set_change_base by blast
         finally show "i \<in> ip_cidr_set i1 r1" .
       qed
     qed
 
     lemma ip_cidr_set_notsubset_empty_inter:
       "\<not> ip_cidr_set i1 r1 \<subseteq> ip_cidr_set i2 r2 \<Longrightarrow>
        \<not> ip_cidr_set i2 r2 \<subseteq> ip_cidr_set i1 r1 \<Longrightarrow>
        ip_cidr_set i1 r1 \<inter> ip_cidr_set i2 r2 = {}"
       apply(cases "r1 \<le> r2")
        subgoal using ip_cidr_set_intersect_subset_helper by blast
       apply(cases "r2 \<le> r1")
        subgoal using ip_cidr_set_intersect_subset_helper by blast
       by(simp)
   end
 
 
   lemma ip_cidr_intersect:
      "\<not> ipset_from_cidr b2 m2 \<subseteq> ipset_from_cidr b1 m1 \<Longrightarrow>
       \<not> ipset_from_cidr b1 m1 \<subseteq> ipset_from_cidr b2 m2 \<Longrightarrow>
       ipset_from_cidr b1 m1 \<inter> ipset_from_cidr b2 m2 = {}"
     apply(simp add: ipset_from_cidr_eq_ip_cidr_set)
     using ip_cidr_set_notsubset_empty_inter by blast
 
   text\<open>Computing the intersection of two IP address ranges in CIDR notation\<close>
   fun ipcidr_conjunct :: "('i::len word \<times> nat) \<Rightarrow> ('i word \<times> nat) \<Rightarrow> ('i word \<times> nat) option" where
     "ipcidr_conjunct (base1, m1) (base2, m2) = (
        if
          ipset_from_cidr base1 m1 \<inter> ipset_from_cidr base2 m2 = {}
        then
          None
        else if
          ipset_from_cidr base1 m1 \<subseteq> ipset_from_cidr base2 m2
        then
          Some (base1, m1)
        else
          Some (base2, m2)
       )"
 
   text\<open>Intersecting with an address with prefix length zero always yields a non-empty result.\<close>
   lemma ipcidr_conjunct_any: "ipcidr_conjunct a (x,0) \<noteq> None" "ipcidr_conjunct (y,0) b \<noteq> None"
      apply(cases a, simp add: ipset_from_cidr_0 ipset_from_cidr_not_empty)
     by(cases b, simp add: ipset_from_cidr_0 ipset_from_cidr_not_empty)
 
   lemma ipcidr_conjunct_correct: "(case ipcidr_conjunct (b1, m1) (b2, m2)
                                           of Some (bx, mx) \<Rightarrow> ipset_from_cidr bx mx
                                           |  None \<Rightarrow> {}) =
                                    (ipset_from_cidr b1 m1) \<inter> (ipset_from_cidr b2 m2)"
     apply(simp split: if_split_asm)
     using ip_cidr_intersect by fast
   declare ipcidr_conjunct.simps[simp del]
 
 
 subsection\<open>Code Equations\<close>
   text\<open>Executable definition using word intervals\<close>
   lemma ipcidr_conjunct_word[code_unfold]:
   "ipcidr_conjunct ips1 ips2 = (
      if
       wordinterval_empty (wordinterval_intersection
                             (ipcidr_tuple_to_wordinterval ips1) (ipcidr_tuple_to_wordinterval ips2))
      then
        None
      else if
        wordinterval_subset (ipcidr_tuple_to_wordinterval ips1) (ipcidr_tuple_to_wordinterval ips2)
      then
        Some ips1
      else
        Some ips2
      )"
   apply(simp)
   apply(cases ips1, cases ips2, rename_tac b1 m1 b2 m2, simp)
   apply(auto simp add: wordinterval_to_set_ipcidr_tuple_to_wordinterval ipcidr_conjunct.simps
              split: if_split_asm)
   done
 
   (*with the code_unfold lemma before, this works!*)
   lemma "ipcidr_conjunct (0::32 word,0) (8,1) = Some (8, 1)" by eval
   export_code ipcidr_conjunct checking SML
 
   text\<open>making element check executable\<close>
   lemma addr_in_ipset_from_netmask_code[code_unfold]:
     "addr \<in> (ipset_from_netmask base netmask) \<longleftrightarrow>
       (base AND netmask) \<le> addr \<and> addr \<le> (base AND netmask) OR (NOT netmask)"
     by(simp add: ipset_from_netmask_def Let_def)
   lemma addr_in_ipset_from_cidr_code[code_unfold]:
     "(addr::'i::len word) \<in> (ipset_from_cidr pre len) \<longleftrightarrow>
        (pre AND ((mask len) << (LENGTH('i) - len))) \<le> addr \<and>
         addr \<le> pre OR (mask (LENGTH('i) - len))"
   unfolding ipset_from_cidr_alt by simp
 
 
 end
diff --git a/thys/IP_Addresses/IPv4.thy b/thys/IP_Addresses/IPv4.thy
--- a/thys/IP_Addresses/IPv4.thy
+++ b/thys/IP_Addresses/IPv4.thy
@@ -1,269 +1,257 @@
 (*  Title:      IPv4.thy
     Authors:    Cornelius Diekmann, Julius Michaelis
 *)
 theory IPv4
 imports IP_Address
         NumberWang_IPv4
         (* include "HOL-Library.Code_Target_Nat" if you need to work with actual numbers.*)
 begin
 
 
 section \<open>IPv4 Adresses\<close>
   text\<open>An IPv4 address is basically a 32 bit unsigned integer.\<close>
   type_synonym ipv4addr = "32 word"
 
   text\<open>Conversion between natural numbers and IPv4 adresses\<close>
   definition nat_of_ipv4addr :: "ipv4addr \<Rightarrow> nat" where
     "nat_of_ipv4addr a = unat a"
   definition ipv4addr_of_nat :: "nat \<Rightarrow> ipv4addr" where
     "ipv4addr_of_nat n =  of_nat n"
 
   text\<open>The maximum IPv4 addres\<close>
   definition max_ipv4_addr :: "ipv4addr" where
     "max_ipv4_addr \<equiv> ipv4addr_of_nat ((2^32) - 1)"
 
   lemma max_ipv4_addr_number: "max_ipv4_addr = 4294967295"
     unfolding max_ipv4_addr_def ipv4addr_of_nat_def by(simp)
   lemma "max_ipv4_addr = 0b11111111111111111111111111111111"
     by(fact max_ipv4_addr_number)
   lemma max_ipv4_addr_max_word: "max_ipv4_addr = max_word"
     by(simp add: max_ipv4_addr_number)
   lemma max_ipv4_addr_max[simp]: "\<forall>a. a \<le> max_ipv4_addr"
     by(simp add: max_ipv4_addr_max_word)
   lemma UNIV_ipv4addrset: "UNIV = {0 .. max_ipv4_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ipv4_addr_max_word) fastforce
 
   text\<open>identity functions\<close>
   lemma nat_of_ipv4addr_ipv4addr_of_nat:
     "\<lbrakk> n \<le> nat_of_ipv4addr max_ipv4_addr \<rbrakk> \<Longrightarrow> nat_of_ipv4addr (ipv4addr_of_nat n) = n"
     by (simp add: ipv4addr_of_nat_def le_unat_uoi nat_of_ipv4addr_def)
   lemma nat_of_ipv4addr_ipv4addr_of_nat_mod: "nat_of_ipv4addr (ipv4addr_of_nat n) = n mod 2^32"
     by(simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def unat_of_nat)
   lemma ipv4addr_of_nat_nat_of_ipv4addr: "ipv4addr_of_nat (nat_of_ipv4addr addr) = addr"
     by(simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
 
 subsection\<open>Representing IPv4 Adresses (Syntax)\<close>
   fun ipv4addr_of_dotdecimal :: "nat \<times> nat \<times> nat \<times> nat \<Rightarrow> ipv4addr" where
     "ipv4addr_of_dotdecimal (a,b,c,d) = ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a )"
 
   fun dotdecimal_of_ipv4addr :: "ipv4addr \<Rightarrow> nat \<times> nat \<times> nat \<times> nat" where
     "dotdecimal_of_ipv4addr a = (nat_of_ipv4addr ((a >> 24) AND 0xFF),
                                     nat_of_ipv4addr ((a >> 16) AND 0xFF),
                                     nat_of_ipv4addr ((a >> 8) AND 0xFF),
                                     nat_of_ipv4addr (a AND 0xff))"
 
   declare ipv4addr_of_dotdecimal.simps[simp del]
   declare dotdecimal_of_ipv4addr.simps[simp del]
 
   text\<open>Examples:\<close>
   lemma "ipv4addr_of_dotdecimal (192, 168, 0, 1) = 3232235521"
     by(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
     (*could be solved by eval, but needs "HOL-Library.Code_Target_Nat"*)
   lemma "dotdecimal_of_ipv4addr 3232235521 = (192, 168, 0, 1)"
     by(simp add: dotdecimal_of_ipv4addr.simps nat_of_ipv4addr_def)
 
   text\<open>a different notation for @{term ipv4addr_of_dotdecimal}\<close>
   lemma ipv4addr_of_dotdecimal_bit:
     "ipv4addr_of_dotdecimal (a,b,c,d) =
       (ipv4addr_of_nat a << 24) + (ipv4addr_of_nat b << 16) +
        (ipv4addr_of_nat c << 8) + ipv4addr_of_nat d"
   proof -
     have a: "(ipv4addr_of_nat a) << 24 = ipv4addr_of_nat (a * 16777216)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have b: "(ipv4addr_of_nat b) << 16 = ipv4addr_of_nat (b * 65536)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have c: "(ipv4addr_of_nat c) << 8 = ipv4addr_of_nat (c * 256)"
       by(simp add: ipv4addr_of_nat_def shiftl_t2n)
     have ipv4addr_of_nat_suc: "\<And>x. ipv4addr_of_nat (Suc x) = word_succ (ipv4addr_of_nat (x))"
       by(simp add: ipv4addr_of_nat_def, metis Abs_fnat_hom_Suc of_nat_Suc)
     { fix x y
       have "ipv4addr_of_nat x + ipv4addr_of_nat y = ipv4addr_of_nat (x+y)"
         apply(induction x arbitrary: y)
          apply(simp add: ipv4addr_of_nat_def; fail)
         by(simp add: ipv4addr_of_nat_suc word_succ_p1)
     } from this a b c
     show ?thesis
       apply(simp add: ipv4addr_of_dotdecimal.simps)
       apply(rule arg_cong[where f=ipv4addr_of_nat])
       apply(thin_tac _)+
       by presburger
   qed
 
   lemma size_ipv4addr: "size (x::ipv4addr) = 32" by(simp add:word_size)
 
   lemma dotdecimal_of_ipv4addr_ipv4addr_of_dotdecimal:
   "\<lbrakk> a < 256; b < 256; c < 256; d < 256 \<rbrakk> \<Longrightarrow>
     dotdecimal_of_ipv4addr (ipv4addr_of_dotdecimal (a,b,c,d)) = (a,b,c,d)"
   proof -
     assume  "a < 256" and "b < 256" and "c < 256" and "d < 256"
     note assms= \<open>a < 256\<close> \<open>b < 256\<close> \<open>c < 256\<close> \<open>d < 256\<close>
     hence a:  "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 24) AND mask 8) = a"
-      apply(simp add: ipv4addr_of_nat_def word_of_nat)
-      apply(simp add: nat_of_ipv4addr_def unat_def)
-      apply(simp add: and_mask_mod_2p)
-      apply(simp add: shiftr_div_2n)
-      apply(simp add: uint_word_of_int)
+      apply (simp add: ipv4addr_of_nat_def word_of_nat nat_of_ipv4addr_def)
+      apply transfer
+      apply (simp add: drop_bit_take_bit flip: take_bit_eq_mask)
+      apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
     have ipv4addr_of_nat_AND_mask8: "(ipv4addr_of_nat a) AND mask 8 = (ipv4addr_of_nat (a mod 256))"
       for a
-      apply(simp add: ipv4addr_of_nat_def and_mask_mod_2p)
-      apply(simp add: word_of_nat) (*use this to get rid of of_nat. All thm are with word_of_int*)
-      apply(simp add: uint_word_of_int)
-      apply(subst mod_mod_cancel)
-       apply(simp; fail)
-      apply(simp add: zmod_int)
+      apply (simp add: ipv4addr_of_nat_def)
+      apply transfer
+      apply (simp flip: take_bit_eq_mask)
+      apply (simp add: take_bit_eq_mod of_nat_mod)
       done
     from assms have b:
       "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 16) AND mask 8) = b"
-      apply(simp add: ipv4addr_of_nat_def word_of_nat)
-      apply(simp add: nat_of_ipv4addr_def unat_def)
-      apply(simp add: and_mask_mod_2p)
-      apply(simp add: shiftr_div_2n)
-      apply(simp add: uint_word_of_int)
-      apply(simp add: NumberWang_IPv4.div65536[simplified])
-      (*The [simplified] is needed because Word_Lib adds some additional simp rules*)
+      apply (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
+      apply transfer
+      apply (simp add: drop_bit_take_bit flip: take_bit_eq_mask)
+      using div65536
+      apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
-      \<comment> \<open>When @{file \<open>../Word_Lib/Word_Lemmas.thy\<close>} is imported,
-         some @{file \<open>NumberWang_IPv4.thy\<close>} lemmas need the
-         [simplified] attribute because @{text Word_Lib} adds some simp rules.
-         This theory should also work without @{file \<open>../Word_Lib/Word_Lemmas.thy\<close>}\<close>
     from assms have c:
       "nat_of_ipv4addr ((ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) >> 8) AND mask 8) = c"
-      apply(simp add: ipv4addr_of_nat_def word_of_nat)
-      apply(simp add: nat_of_ipv4addr_def unat_def)
-      apply(simp add: and_mask_mod_2p)
-      apply(simp add: shiftr_div_2n)
-      apply(simp add: uint_word_of_int)
-      apply(simp add: NumberWang_IPv4.div256[simplified])
+      apply (simp add: ipv4addr_of_nat_def nat_of_ipv4addr_def)
+      apply transfer
+      apply (simp add: drop_bit_take_bit flip: take_bit_eq_mask)
+      using div256
+      apply (simp add: drop_bit_eq_div take_bit_eq_mod)
       done
     from \<open>d < 256\<close> have d: "nat_of_ipv4addr (ipv4addr_of_nat (d + 256 * c + 65536 * b + 16777216 * a) AND mask 8) = d"
-      apply(simp add: ipv4addr_of_nat_AND_mask8)
-      apply(simp add: ipv4addr_of_nat_def word_of_nat)
-      apply(simp add: nat_of_ipv4addr_def)
-      apply(subgoal_tac "(d + 256 * c + 65536 * b + 16777216 * a) mod 256 = d")
-       apply(simp add: unat_def uint_word_of_int; fail)
-      apply(simp add: NumberWang_IPv4.mod256)
+      apply (simp add: ipv4addr_of_nat_AND_mask8 ipv4addr_of_nat_def nat_of_ipv4addr_def)
+      apply transfer
+      apply (simp flip: take_bit_eq_mask)
+      apply (simp add: take_bit_eq_mod nat_mod_distrib nat_add_distrib nat_mult_distrib mod256)
       done
     from a b c d show ?thesis
-      apply(simp add: ipv4addr_of_dotdecimal.simps dotdecimal_of_ipv4addr.simps)
-      apply(simp add: mask_def)
+      apply (simp add: ipv4addr_of_dotdecimal.simps dotdecimal_of_ipv4addr.simps)
+      apply (simp add: mask_eq)
       done
   qed
 
   lemma ipv4addr_of_dotdecimal_dotdecimal_of_ipv4addr:
     "(ipv4addr_of_dotdecimal (dotdecimal_of_ipv4addr ip)) = ip"
   proof -
     have ip_and_mask8_bl_drop24: "(ip::ipv4addr) AND mask 8 = of_bl (drop 24 (to_bl ip))"
       by(simp add: Word_Lemmas.of_drop_to_bl size_ipv4addr)
     have List_rev_drop_geqn: "length x \<ge> n \<Longrightarrow> (take n (rev x)) = rev (drop (length x - n) x)"
       for x :: "'a list" and n by(simp add: List.rev_drop)
     have and_mask_bl_take: "length x \<ge> n \<Longrightarrow> ((of_bl x) AND mask n) = (of_bl (rev (take n (rev (x)))))"
       for x n by(simp add: List_rev_drop_geqn of_bl_drop)
     have ipv4addr_and_255: "x AND 255 = x AND mask 8" for x :: ipv4addr
-      by(simp add: mask_def)
+      by(simp add: mask_eq)
     have bit_equality:
       "((ip >> 24) AND 0xFF << 24) + ((ip >> 16) AND 0xFF << 16) + ((ip >> 8) AND 0xFF << 8) + (ip AND 0xFF) =
        of_bl (take 8 (to_bl ip) @ take 8 (drop 8 (to_bl ip)) @ take 8 (drop 16 (to_bl ip)) @ drop 24 (to_bl ip))"
       apply(simp add: ipv4addr_and_255)
       apply(simp add: shiftr_slice)
       apply(simp add: Word.slice_take' size_ipv4addr)
       apply(simp add: and_mask_bl_take)
       apply(simp add: List_rev_drop_geqn)
       apply(simp add: drop_take)
       apply(simp add: Word.shiftl_of_bl)
       apply(simp add: of_bl_append)
       apply(simp add: ip_and_mask8_bl_drop24)
       done
     have blip_split: "\<And> blip. length blip = 32 \<Longrightarrow>
       blip = (take 8 blip) @ (take 8 (drop 8 blip)) @ (take 8 (drop 16 blip)) @ (take 8 (drop 24 blip))"
       by(rename_tac blip,case_tac blip,simp_all)+ (*I'm so sorry for this ...*)
     have "ipv4addr_of_dotdecimal (dotdecimal_of_ipv4addr ip) = of_bl (to_bl ip)"
       apply(subst blip_split)
        apply(simp; fail)
       apply(simp add: ipv4addr_of_dotdecimal_bit dotdecimal_of_ipv4addr.simps)
       apply(simp add: ipv4addr_of_nat_nat_of_ipv4addr)
       apply(simp add: bit_equality)
       done
     thus ?thesis using Word.word_bl.Rep_inverse[symmetric] by simp
   qed
 
   lemma ipv4addr_of_dotdecimal_eqE:
     "\<lbrakk> ipv4addr_of_dotdecimal (a,b,c,d) = ipv4addr_of_dotdecimal (e,f,g,h);
        a < 256; b < 256; c < 256; d < 256; e < 256; f < 256; g < 256; h < 256 \<rbrakk> \<Longrightarrow>
          a = e \<and> b = f \<and> c = g \<and> d = h"
      by (metis Pair_inject dotdecimal_of_ipv4addr_ipv4addr_of_dotdecimal)
 
 subsection\<open>IP Ranges: Examples\<close>
   lemma "(UNIV :: ipv4addr set) = {0 .. max_ipv4_addr}" by(simp add: UNIV_ipv4addrset)
   lemma "(42::ipv4addr) \<in> UNIV" by(simp)
 
   (*Warning, not executable!*)
 
   lemma "ipset_from_netmask (ipv4addr_of_dotdecimal (192,168,0,42)) (ipv4addr_of_dotdecimal (255,255,0,0)) =
           {ipv4addr_of_dotdecimal (192,168,0,0) .. ipv4addr_of_dotdecimal (192,168,255,255)}"
    by(simp add: ipset_from_netmask_def ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
 
   lemma "ipset_from_netmask (ipv4addr_of_dotdecimal (192,168,0,42)) (ipv4addr_of_dotdecimal (0,0,0,0)) = UNIV"
     by(simp add: UNIV_ipv4addrset ipset_from_netmask_def ipv4addr_of_dotdecimal.simps
                  ipv4addr_of_nat_def max_ipv4_addr_max_word)
 
   text\<open>192.168.0.0/24\<close>
 
   lemma fixes addr :: ipv4addr
     shows "ipset_from_cidr addr pflength =
             ipset_from_netmask addr ((mask pflength) << (32 - pflength))"
     by(simp add: ipset_from_cidr_def)
 
   lemma "ipset_from_cidr (ipv4addr_of_dotdecimal (192,168,0,42)) 16 =
           {ipv4addr_of_dotdecimal (192,168,0,0) .. ipv4addr_of_dotdecimal (192,168,255,255)}"
-   by(simp add: ipset_from_cidr_alt mask_def  ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
+   by(simp add: ipset_from_cidr_alt mask_eq ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def)
 
   lemma "ip \<in> (ipset_from_cidr (ipv4addr_of_dotdecimal (0, 0, 0, 0)) 0)"
     by(simp add: ipset_from_cidr_0)
 
   lemma ipv4set_from_cidr_32: fixes addr :: ipv4addr
     shows "ipset_from_cidr addr 32 = {addr}"
-    by(simp add: ipset_from_cidr_alt mask_def)
+    by(simp add: ipset_from_cidr_alt mask_eq)
 
   lemma  fixes pre :: ipv4addr
     shows "ipset_from_cidr pre len = {(pre AND ((mask len) << (32 - len))) .. pre OR (mask (32 - len))}"
     by (simp add: ipset_from_cidr_alt ipset_from_cidr_def)
 
   text\<open>making element check executable\<close>
   lemma addr_in_ipv4set_from_netmask_code[code_unfold]:
     fixes addr :: ipv4addr
     shows "addr \<in> (ipset_from_netmask base netmask) \<longleftrightarrow>
             (base AND netmask) \<le> addr \<and> addr \<le> (base AND netmask) OR (NOT netmask)"
     by (simp add: addr_in_ipset_from_netmask_code)
   lemma addr_in_ipv4set_from_cidr_code[code_unfold]:
     fixes addr :: ipv4addr
     shows "addr \<in> (ipset_from_cidr pre len) \<longleftrightarrow>
               (pre AND ((mask len) << (32 - len))) \<le> addr \<and> addr \<le> pre OR (mask (32 - len))"
     by(simp add: addr_in_ipset_from_cidr_code)
 
   (*small numbers because we didn't load Code_Target_Nat. Should work by eval*)
   lemma "ipv4addr_of_dotdecimal (192,168,42,8) \<in> (ipset_from_cidr (ipv4addr_of_dotdecimal (192,168,0,0)) 16)"
     by(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def ipset_from_cidr_def
-                    ipset_from_netmask_def mask_def)
+                    ipset_from_netmask_def mask_eq)
 
   definition ipv4range_UNIV :: "32 wordinterval" where "ipv4range_UNIV \<equiv> wordinterval_UNIV"
 
   lemma ipv4range_UNIV_set_eq: "wordinterval_to_set ipv4range_UNIV = UNIV"
     by(simp only: ipv4range_UNIV_def wordinterval_UNIV_set_eq)
 
 
   thm iffD1[OF wordinterval_eq_set_eq]
   (*TODO: probably the following is a good idea?*)
   (*
   declare iffD1[OF wordinterval_eq_set_eq, cong]
   *)
 
 
   text\<open>This \<open>LENGTH('a)\<close> is 32 for IPv4 addresses.\<close>
   lemma ipv4cidr_to_interval_simps[code_unfold]: "ipcidr_to_interval ((pre::ipv4addr), len) = (
       let netmask = (mask len) << (32 - len);
           network_prefix = (pre AND netmask)
       in (network_prefix, network_prefix OR (NOT netmask)))"
   by(simp add: ipcidr_to_interval_def Let_def ipcidr_to_interval_start.simps ipcidr_to_interval_end.simps)
 
 end
diff --git a/thys/IP_Addresses/IPv6.thy b/thys/IP_Addresses/IPv6.thy
--- a/thys/IP_Addresses/IPv6.thy
+++ b/thys/IP_Addresses/IPv6.thy
@@ -1,945 +1,945 @@
 (*  Title:      IPv6.thy
     Authors:    Cornelius Diekmann
 *)
 theory IPv6
 imports IP_Address
         NumberWang_IPv6
         (* include "HOL-Library.Code_Target_Nat" if you need to work with actual numbers.*)
 begin
 
 
 section \<open>IPv6 Addresses\<close>
   text\<open>An IPv6 address is basically a 128 bit unsigned integer. RFC 4291, Section 2.\<close>
   type_synonym ipv6addr = "128 word"
  
   text\<open>Conversion between natural numbers and IPv6 adresses\<close>
   definition nat_of_ipv6addr :: "ipv6addr \<Rightarrow> nat" where
     "nat_of_ipv6addr a = unat a"
   definition ipv6addr_of_nat :: "nat \<Rightarrow> ipv6addr" where
     "ipv6addr_of_nat n =  of_nat n"
 
   lemma "ipv6addr_of_nat n = word_of_int (int n)"
     by(simp add: ipv6addr_of_nat_def word_of_nat)
 
   text\<open>The maximum IPv6 address\<close>
   definition max_ipv6_addr :: "ipv6addr" where 
     "max_ipv6_addr \<equiv> ipv6addr_of_nat ((2^128) - 1)"
 
   lemma max_ipv6_addr_number: "max_ipv6_addr = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
     unfolding max_ipv6_addr_def ipv6addr_of_nat_def by(simp)
   lemma "max_ipv6_addr = 340282366920938463463374607431768211455"
     by(fact max_ipv6_addr_number)
   lemma max_ipv6_addr_max_word: "max_ipv6_addr = max_word"
     by(simp add: max_ipv6_addr_number)
   lemma max_ipv6_addr_max: "\<forall>a. a \<le> max_ipv6_addr"
     by(simp add: max_ipv6_addr_max_word)
   lemma UNIV_ipv6addrset: "UNIV = {0 .. max_ipv6_addr}" (*not in the simp set, for a reason*)
     by(simp add: max_ipv6_addr_max_word) fastforce
 
   text\<open>identity functions\<close>
   lemma nat_of_ipv6addr_ipv6addr_of_nat:
     "n \<le> nat_of_ipv6addr max_ipv6_addr \<Longrightarrow> nat_of_ipv6addr (ipv6addr_of_nat n) = n"
     by(simp add: nat_of_ipv6addr_def ipv6addr_of_nat_def le_unat_uoi)
   lemma nat_of_ipv6addr_ipv6addr_of_nat_mod: "nat_of_ipv6addr (ipv6addr_of_nat n) = n mod 2^128"
     by(simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def unat_of_nat)
   lemma ipv6addr_of_nat_nat_of_ipv6addr: "ipv6addr_of_nat (nat_of_ipv6addr addr) = addr"
     by(simp add: ipv6addr_of_nat_def nat_of_ipv6addr_def)
 
 subsection\<open>Syntax of IPv6 Adresses\<close>
   text\<open>RFC 4291, Section 2.2.: Text Representation of Addresses\<close>
 
   text\<open>Quoting the RFC (note: errata exists):\<close>
   text_raw\<open>
   \begin{verbatim}
    1. The preferred form is x:x:x:x:x:x:x:x, where the 'x's are one to
       four hexadecimal digits of the eight 16-bit pieces of the address.
       Examples:
          ABCD:EF01:2345:6789:ABCD:EF01:2345:6789
          2001:DB8:0:0:8:800:200C:417A
   \end{verbatim}
 \<close>
   datatype ipv6addr_syntax = 
     IPv6AddrPreferred "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   text_raw\<open>
   \begin{verbatim}
    2. [...] In order to make writing addresses containing zero
       bits easier, a special syntax is available to compress the zeros.
       The use of "::" indicates one or more groups of 16 bits of zeros.
       The "::" can only appear once in an address.  The "::" can also be
       used to compress leading or trailing zeros in an address.
 
       For example, the following addresses
          2001:DB8:0:0:8:800:200C:417A   a unicast address
          FF01:0:0:0:0:0:0:101           a multicast address
          0:0:0:0:0:0:0:1                the loopback address
          0:0:0:0:0:0:0:0                the unspecified address
 
       may be represented as
          2001:DB8::8:800:200C:417A      a unicast address
          FF01::101                      a multicast address
          ::1                            the loopback address
          ::                             the unspecified address
   \end{verbatim}
 \<close>
   (*datatype may take some minutes to load*)
   datatype ipv6addr_syntax_compressed =
   \<comment> \<open>using @{typ unit} for the omission @{text "::"}. 
 
      Naming convention of the datatype: 
       The first number is the position where the omission occurs.
       The second number is the length of the specified address pieces.
         I.e. `8 minus the second number' pieces are omitted.\<close>
     IPv6AddrCompressed1_0 unit
   | IPv6AddrCompressed1_1 unit "16 word"
   | IPv6AddrCompressed1_2 unit "16 word" "16 word"
   | IPv6AddrCompressed1_3 unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_4 unit "16 word" "16 word" "16 word" "16 word" 
   | IPv6AddrCompressed1_5 unit "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_6 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed1_7 unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed2_1 "16 word" unit
   | IPv6AddrCompressed2_2 "16 word" unit "16 word"
   | IPv6AddrCompressed2_3 "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed2_4 "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_5 "16 word" unit "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_6 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed2_7 "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed3_2 "16 word" "16 word" unit
   | IPv6AddrCompressed3_3 "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed3_4 "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed3_5 "16 word" "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed3_6 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"
   | IPv6AddrCompressed3_7 "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed4_3 "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed4_4 "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed4_5 "16 word" "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed4_6 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"
   | IPv6AddrCompressed4_7 "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed5_4 "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed5_5 "16 word" "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed5_6 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"
   | IPv6AddrCompressed5_7 "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word" "16 word"
 
   | IPv6AddrCompressed6_5 "16 word" "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed6_6 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"
   | IPv6AddrCompressed6_7 "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word" "16 word"
 
   | IPv6AddrCompressed7_6 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit
   | IPv6AddrCompressed7_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit "16 word"
 
   | IPv6AddrCompressed8_7 "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" "16 word" unit
 
   (*RFC 5952:
     """
     4.  A Recommendation for IPv6 Text Representation
     4.2.2.  Handling One 16-Bit 0 Field
        The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
        For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
        2001:db8::1:1:1:1:1 is not correct.
     """
 
     So we could remove all IPv6AddrCompressed*_7 constructors.
     But these are `recommendations', we might still see these non-recommended definitions.
     "[...] all implementations must accept and be able to handle any legitimate RFC 4291 format."
   *)
 
   (*More convenient parser helper function for compressed IPv6 addresses:
     Input list (from parser):
       Some 16word \<longrightarrow> address piece
       None \<longrightarrow> omission '::'
     
   
    Basically, the parser must only do the following (python syntax):
      split the string which is an ipv6 address at ':'
      map empty string to None
      map everything else to Some (string_to_16word str)
      sanitize empty strings at the start and the end (see toString and parser theories)
    Example:
      "1:2:3".split(":")  = ['1', '2', '3']
      ":2:3:4".split(":") = ['', '2', '3', '4']
      ":2::3".split(":")  = ['', '2', '', '3']
      "1:2:3:".split(":") = ['1', '2', '3', '']
   *)
   definition parse_ipv6_address_compressed :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax_compressed option" where
     "parse_ipv6_address_compressed as = (case as of 
       [None] \<Rightarrow> Some (IPv6AddrCompressed1_0 ())
     | [None, Some a] \<Rightarrow> Some (IPv6AddrCompressed1_1 () a)
     | [None, Some a, Some b] \<Rightarrow> Some (IPv6AddrCompressed1_2 () a b)
     | [None, Some a, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed1_3 () a b c)
     | [None, Some a, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed1_4 () a b c d)
     | [None, Some a, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed1_5 () a b c d e)
     | [None, Some a, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed1_6 () a b c d e f)
     | [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed1_7 () a b c d e f g)
   
     | [Some a, None] \<Rightarrow> Some (IPv6AddrCompressed2_1 a ())
     | [Some a, None, Some b] \<Rightarrow> Some (IPv6AddrCompressed2_2 a () b)
     | [Some a, None, Some b, Some c] \<Rightarrow> Some (IPv6AddrCompressed2_3 a () b c)
     | [Some a, None, Some b, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed2_4 a () b c d)
     | [Some a, None, Some b, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed2_5 a () b c d e)
     | [Some a, None, Some b, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed2_6 a () b c d e f)
     | [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed2_7 a () b c d e f g)
   
     | [Some a, Some b, None] \<Rightarrow> Some (IPv6AddrCompressed3_2 a b ())
     | [Some a, Some b, None, Some c] \<Rightarrow> Some (IPv6AddrCompressed3_3 a b () c)
     | [Some a, Some b, None, Some c, Some d] \<Rightarrow> Some (IPv6AddrCompressed3_4 a b () c d)
     | [Some a, Some b, None, Some c, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed3_5 a b () c d e)
     | [Some a, Some b, None, Some c, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed3_6 a b () c d e f)
     | [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed3_7 a b () c d e f g)
   
     | [Some a, Some b, Some c, None] \<Rightarrow> Some (IPv6AddrCompressed4_3 a b c ())
     | [Some a, Some b, Some c, None, Some d] \<Rightarrow> Some (IPv6AddrCompressed4_4 a b c () d)
     | [Some a, Some b, Some c, None, Some d, Some e] \<Rightarrow> Some (IPv6AddrCompressed4_5 a b c () d e)
     | [Some a, Some b, Some c, None, Some d, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed4_6 a b c () d e f)
     | [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed4_7 a b c () d e f g)
   
     | [Some a, Some b, Some c, Some d, None] \<Rightarrow> Some (IPv6AddrCompressed5_4 a b c d ())
     | [Some a, Some b, Some c, Some d, None, Some e] \<Rightarrow> Some (IPv6AddrCompressed5_5 a b c d () e)
     | [Some a, Some b, Some c, Some d, None, Some e, Some f] \<Rightarrow> Some (IPv6AddrCompressed5_6 a b c d () e f)
     | [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed5_7 a b c d () e f g)
   
     | [Some a, Some b, Some c, Some d, Some e, None] \<Rightarrow> Some (IPv6AddrCompressed6_5 a b c d e ())
     | [Some a, Some b, Some c, Some d, Some e, None, Some f] \<Rightarrow> Some (IPv6AddrCompressed6_6 a b c d e () f)
     | [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g] \<Rightarrow> Some (IPv6AddrCompressed6_7 a b c d e () f g)
   
     | [Some a, Some b, Some c, Some d, Some e, Some f, None] \<Rightarrow> Some (IPv6AddrCompressed7_6 a b c d e f ())
     | [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g] \<Rightarrow> Some (IPv6AddrCompressed7_7 a b c d e f () g)
 
     | [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None] \<Rightarrow> Some (IPv6AddrCompressed8_7 a b c d e f g ())
     | _ \<Rightarrow> None \<comment> \<open>invalid ipv6 copressed address.\<close>
 )"
 
   fun ipv6addr_syntax_compressed_to_list :: "ipv6addr_syntax_compressed \<Rightarrow> ((16 word) option) list"
     where 
       "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_0 _) =
                                      [None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_1 () a) =
                                      [None, Some a]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_2 () a b) =
                                      [None, Some a, Some b]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_3 () a b c) =
                                      [None, Some a, Some b, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_4 () a b c d) =
                                      [None, Some a, Some b, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_5 () a b c d e) =
                                      [None, Some a, Some b, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_6 () a b c d e f) =
                                      [None, Some a, Some b, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed1_7 () a b c d e f g) =
                                      [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_1 a ()) =
                                      [Some a, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_2 a () b) =
                                      [Some a, None, Some b]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_3 a () b c) =
                                      [Some a, None, Some b, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_4 a () b c d) =
                                      [Some a, None, Some b, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_5 a () b c d e) =
                                      [Some a, None, Some b, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_6 a () b c d e f) =
                                      [Some a, None, Some b, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed2_7 a () b c d e f g) =
                                      [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_2 a b ()) = [Some a, Some b, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_3 a b () c) =
                                      [Some a, Some b, None, Some c]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_4 a b () c d) =
                                      [Some a, Some b, None, Some c, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_5 a b () c d e) =
                                      [Some a, Some b, None, Some c, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_6 a b () c d e f) =
                                      [Some a, Some b, None, Some c, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed3_7 a b () c d e f g) =
                                      [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_3 a b c ()) =
                                      [Some a, Some b, Some c, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_4 a b c () d) =
                                      [Some a, Some b, Some c, None, Some d]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_5 a b c () d e) =
                                      [Some a, Some b, Some c, None, Some d, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_6 a b c () d e f) =
                                      [Some a, Some b, Some c, None, Some d, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed4_7 a b c () d e f g) =
                                      [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_4 a b c d ()) =
                                      [Some a, Some b, Some c, Some d, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_5 a b c d () e) =
                                      [Some a, Some b, Some c, Some d, None, Some e]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_6 a b c d () e f) =
                                      [Some a, Some b, Some c, Some d, None, Some e, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed5_7 a b c d () e f g) =
                                      [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_5 a b c d e ()) =
                                      [Some a, Some b, Some c, Some d, Some e, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_6 a b c d e () f) =
                                      [Some a, Some b, Some c, Some d, Some e, None, Some f]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed6_7 a b c d e () f g) =
                                      [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]"
   
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_6 a b c d e f ()) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, None]"
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed7_7 a b c d e f () g) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]"
 
     | "ipv6addr_syntax_compressed_to_list (IPv6AddrCompressed8_7 a b c d e f g ()) =
                                      [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]"
 
 
 (*for all ipv6_syntax, there is a corresponding list representation*)
 lemma parse_ipv6_address_compressed_exists:
   obtains ss where "parse_ipv6_address_compressed ss = Some ipv6_syntax"
 proof
   define ss where "ss = ipv6addr_syntax_compressed_to_list ipv6_syntax"
   thus "parse_ipv6_address_compressed ss = Some ipv6_syntax"
     by (cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)
 qed
 
 lemma parse_ipv6_address_compressed_identity:
       "parse_ipv6_address_compressed (ipv6addr_syntax_compressed_to_list (ipv6_syntax)) = Some ipv6_syntax"
   by(cases ipv6_syntax; simp add: parse_ipv6_address_compressed_def)
 
 
 lemma parse_ipv6_address_compressed_someE:
   assumes "parse_ipv6_address_compressed as = Some ipv6"
   obtains
     "as = [None]" "ipv6 = (IPv6AddrCompressed1_0 ())"  |
     a where "as = [None, Some a]" "ipv6 = (IPv6AddrCompressed1_1 () a)"  |
     a b where "as = [None, Some a, Some b]" "ipv6 = (IPv6AddrCompressed1_2 () a b)"  |
     a b c where "as = [None, Some a, Some b, Some c]" "ipv6 = (IPv6AddrCompressed1_3 () a b c)" |
     a b c d where "as = [None, Some a, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed1_4 () a b c d)" |
     a b c d e where "as = [None, Some a, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed1_5 () a b c d e)" |
     a b c d e f where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed1_6 () a b c d e f)" |
     a b c d e f g where "as = [None, Some a, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed1_7 () a b c d e f g)" |
   
     a where "as = [Some a, None]" "ipv6 = (IPv6AddrCompressed2_1 a ())" |
     a b where "as = [Some a, None, Some b]" "ipv6 = (IPv6AddrCompressed2_2 a () b)" |
     a b c where "as = [Some a, None, Some b, Some c]" "ipv6 = (IPv6AddrCompressed2_3 a () b c)" |
     a b c d where "as = [Some a, None, Some b, Some c, Some d]" "ipv6 = (IPv6AddrCompressed2_4 a () b c d)" |
     a b c d e where "as = [Some a, None, Some b, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed2_5 a () b c d e)" |
     a b c d e f where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed2_6 a () b c d e f)" |
     a b c d e f g where "as = [Some a, None, Some b, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed2_7 a () b c d e f g)" |
   
     a b where "as = [Some a, Some b, None]" "ipv6 = (IPv6AddrCompressed3_2 a b ())" |
     a b c where "as = [Some a, Some b, None, Some c]" "ipv6 = (IPv6AddrCompressed3_3 a b () c)" |
     a b c d where "as = [Some a, Some b, None, Some c, Some d]" "ipv6 = (IPv6AddrCompressed3_4 a b () c d)" |
     a b c d e where "as = [Some a, Some b, None, Some c, Some d, Some e]" "ipv6 = (IPv6AddrCompressed3_5 a b () c d e)" |
     a b c d e f where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed3_6 a b () c d e f)" |
     a b c d e f g where "as = [Some a, Some b, None, Some c, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed3_7 a b () c d e f g)" |
   
     a b c where "as = [Some a, Some b, Some c, None]" "ipv6 = (IPv6AddrCompressed4_3 a b c ())" |
     a b c d where "as = [Some a, Some b, Some c, None, Some d]" "ipv6 = (IPv6AddrCompressed4_4 a b c () d)" |
     a b c d e where "as = [Some a, Some b, Some c, None, Some d, Some e]" "ipv6 = (IPv6AddrCompressed4_5 a b c () d e)" |
     a b c d e f where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f]" "ipv6 = (IPv6AddrCompressed4_6 a b c () d e f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, None, Some d, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed4_7 a b c () d e f g)" |
   
     a b c d where "as = [Some a, Some b, Some c, Some d, None]" "ipv6 = (IPv6AddrCompressed5_4 a b c d ())" |
     a b c d e where "as = [Some a, Some b, Some c, Some d, None, Some e]" "ipv6 = (IPv6AddrCompressed5_5 a b c d () e)" |
     a b c d e f where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f]" "ipv6 = (IPv6AddrCompressed5_6 a b c d () e f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, None, Some e, Some f, Some g]" "ipv6 = (IPv6AddrCompressed5_7 a b c d () e f g)" |
   
     a b c d e where "as = [Some a, Some b, Some c, Some d, Some e, None]" "ipv6 = (IPv6AddrCompressed6_5 a b c d e ())" |
     a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f]" "ipv6 = (IPv6AddrCompressed6_6 a b c d e () f)" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, None, Some f, Some g]" "ipv6 = (IPv6AddrCompressed6_7 a b c d e () f g)" |
   
     a b c d e f where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None]" "ipv6 = (IPv6AddrCompressed7_6 a b c d e f ())" |
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, None, Some g]" "ipv6 = (IPv6AddrCompressed7_7 a b c d e f () g)" |
 
     a b c d e f g where "as = [Some a, Some b, Some c, Some d, Some e, Some f, Some g, None]" "ipv6 = (IPv6AddrCompressed8_7 a b c d e f g ())"
 using assms
 unfolding parse_ipv6_address_compressed_def
 by (auto split: list.split_asm option.split_asm) (* takes a minute *)
 
 lemma parse_ipv6_address_compressed_identity2:
       "ipv6addr_syntax_compressed_to_list ipv6_syntax = ls \<longleftrightarrow>
         (parse_ipv6_address_compressed ls) = Some ipv6_syntax"
       (is "?lhs = ?rhs")
 proof
   assume ?rhs
   thus ?lhs
     by (auto elim: parse_ipv6_address_compressed_someE)
 next
   assume ?lhs
   thus ?rhs
     by (cases ipv6_syntax) (auto simp: parse_ipv6_address_compressed_def)
 qed
 
 text\<open>Valid IPv6 compressed notation:
   \<^item> at most one omission
   \<^item> at most 7 pieces
 \<close>
 lemma RFC_4291_format: "parse_ipv6_address_compressed as \<noteq> None \<longleftrightarrow>
        length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
        (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain addr where "parse_ipv6_address_compressed as = Some addr"
     by blast
   thus ?rhs
     by (elim parse_ipv6_address_compressed_someE; simp)
 next
   assume ?rhs
   thus ?lhs
     unfolding parse_ipv6_address_compressed_def
     by (auto split: option.split list.split if_split_asm)
 qed
 
   text_raw\<open>
   \begin{verbatim}
   3. An alternative form that is sometimes more convenient when dealing
       with a mixed environment of IPv4 and IPv6 nodes is
       x:x:x:x:x:x:d.d.d.d, where the 'x's are the hexadecimal values of
       the six high-order 16-bit pieces of the address, and the 'd's are
       the decimal values of the four low-order 8-bit pieces of the
       address (standard IPv4 representation).  Examples:
 
          0:0:0:0:0:0:13.1.68.3
          0:0:0:0:0:FFFF:129.144.52.38
 
       or in compressed form:
 
          ::13.1.68.3
          ::FFFF:129.144.52.38
   \end{verbatim}
 
   This is currently not supported by our library!
 \<close>
   (*TODO*)
   (*TODO: oh boy, they can also be compressed*)
 
 subsection\<open>Semantics\<close>
   fun ipv6preferred_to_int :: "ipv6addr_syntax \<Rightarrow> ipv6addr" where
     "ipv6preferred_to_int (IPv6AddrPreferred a b c d e f g h) = (ucast a << (16 * 7)) OR
                                                                 (ucast b << (16 * 6)) OR
                                                                 (ucast c << (16 * 5)) OR
                                                                 (ucast d << (16 * 4)) OR
                                                                 (ucast e << (16 * 3)) OR
                                                                 (ucast f << (16 * 2)) OR
                                                                 (ucast g << (16 * 1)) OR
                                                                 (ucast h << (16 * 0))"
 
   lemma "ipv6preferred_to_int (IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A) = 
           42540766411282592856906245548098208122" by eval
 
   lemma "ipv6preferred_to_int (IPv6AddrPreferred 0xFF01 0x0 0x0 0x0 0x0 0x0 0x0 0x101) = 
           338958331222012082418099330867817087233" by eval
 
   declare ipv6preferred_to_int.simps[simp del]
 
 
   definition int_to_ipv6preferred :: "ipv6addr \<Rightarrow> ipv6addr_syntax" where
     "int_to_ipv6preferred i = IPv6AddrPreferred (ucast ((i AND 0xFFFF0000000000000000000000000000) >> 16*7))
                                                 (ucast ((i AND 0xFFFF000000000000000000000000) >> 16*6))
                                                 (ucast ((i AND 0xFFFF00000000000000000000) >> 16*5))
                                                 (ucast ((i AND 0xFFFF0000000000000000) >> 16*4))
                                                 (ucast ((i AND 0xFFFF000000000000) >> 16*3))
                                                 (ucast ((i AND 0xFFFF00000000) >> 16*2))
                                                 (ucast ((i AND 0xFFFF0000) >> 16*1))
                                                 (ucast ((i AND 0xFFFF)))"
 
   lemma "int_to_ipv6preferred 42540766411282592856906245548098208122 =
          IPv6AddrPreferred 0x2001 0xDB8 0x0 0x0 0x8 0x800 0x200C 0x417A" by eval
 
   lemma word128_masks_ipv6pieces:
     "(0xFFFF0000000000000000000000000000::ipv6addr) = (mask 16) << 112"
     "(0xFFFF000000000000000000000000::ipv6addr) = (mask 16) << 96"
     "(0xFFFF00000000000000000000::ipv6addr) = (mask 16) << 80"
     "(0xFFFF0000000000000000::ipv6addr) = (mask 16) << 64"
     "(0xFFFF000000000000::ipv6addr) = (mask 16) << 48"
     "(0xFFFF00000000::ipv6addr) = (mask 16) << 32"
     "(0xFFFF0000::ipv6addr) = (mask 16) << 16"
     "(0xFFFF::ipv6addr) = (mask 16)"
-    by(simp add: mask_def)+
+    by(simp add: mask_eq)+
 
 
   text\<open>Correctness: round trip property one\<close>
   lemma ipv6preferred_to_int_int_to_ipv6preferred:
     "ipv6preferred_to_int (int_to_ipv6preferred ip) = ip"
   proof -
     have and_mask_shift_helper: "w AND (mask m << n) >> n << n = w AND (mask m << n)"
       for m n::nat and w::ipv6addr
       by (metis is_aligned_shift is_aligned_shiftr_shiftl shiftr_and_eq_shiftl)
     have ucast_ipv6_piece_rule:
       "length (dropWhile Not (to_bl w)) \<le> 16 \<Longrightarrow> (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) w) = w"
       for w::ipv6addr 
       by(rule ucast_short_ucast_long_ingoreLeadingZero) (simp_all)
     have ucast_ipv6_piece: "16 \<le> 128 - n \<Longrightarrow> 
       (ucast::16 word \<Rightarrow> 128 word) ((ucast::128 word \<Rightarrow> 16 word) (w AND (mask 16 << n) >> n)) << n = w AND (mask 16 << n)"
       for w::ipv6addr and n::nat
       apply(subst ucast_ipv6_piece_rule)
        apply(rule length_drop_mask_inner)
        apply(simp; fail)
       apply(subst and_mask_shift_helper)
       apply simp
       done
 
     have ucast16_ucast128_masks_highest_bits:
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000000000000000 >> 112)) << 112) = 
              (ip AND 0xFFFF0000000000000000000000000000)"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000000000000000 >> 96)) << 96) =
            ip AND 0xFFFF000000000000000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000000000000000 >> 80)) << 80) =
            ip AND 0xFFFF00000000000000000000" 
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000000000000000 >> 64)) << 64) =
            ip AND 0xFFFF0000000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF000000000000 >> 48)) << 48) =
            ip AND 0xFFFF000000000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF00000000 >> 32)) << 32) =
            ip AND 0xFFFF00000000"
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF0000 >> 16)) << 16) =
            ip AND 0xFFFF0000"
       by((subst word128_masks_ipv6pieces)+, subst ucast_ipv6_piece, simp_all)+
 
     have ucast16_ucast128_masks_highest_bits0: 
       "(ucast ((ucast::ipv6addr \<Rightarrow> 16 word) (ip AND 0xFFFF))) = ip AND 0xFFFF"
       apply(subst word128_masks_ipv6pieces)+
       apply(subst ucast_short_ucast_long_ingoreLeadingZero)
         apply simp_all
       by (simp add: length_drop_mask)
 
     have mask_len_word:"n = (LENGTH('a)) \<Longrightarrow> w AND mask n = w"
       for n and w::"'a::len word" by (simp add: mask_eq_iff) 
 
     have ipv6addr_16word_pieces_compose_or:
             "ip && (mask 16 << 112) ||
              ip && (mask 16 << 96) ||
              ip && (mask 16 << 80) ||
              ip && (mask 16 << 64) ||
              ip && (mask 16 << 48) ||
              ip && (mask 16 << 32) ||
              ip && (mask 16 << 16) ||
              ip && mask 16 =
              ip"
       apply(subst word_ao_dist2[symmetric])+
-      apply(simp add: mask_def)
+      apply(simp add: mask_eq)
       apply(subst mask128)
       apply(rule mask_len_word)
       apply simp
       done
 
     show ?thesis
       apply(simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def)
       apply(simp add: ucast16_ucast128_masks_highest_bits ucast16_ucast128_masks_highest_bits0)
       apply(simp add: word128_masks_ipv6pieces)
       apply(rule ipv6addr_16word_pieces_compose_or)
       done
   qed
 
 
   text\<open>Correctness: round trip property two\<close>
   lemma int_to_ipv6preferred_ipv6preferred_to_int: "int_to_ipv6preferred (ipv6preferred_to_int ip) = ip"
   proof -
     note ucast_shift_simps=helper_masked_ucast_generic helper_masked_ucast_reverse_generic
                            helper_masked_ucast_generic[where n=0, simplified]
                            helper_masked_ucast_equal_generic 
     note ucast_simps=helper_masked_ucast_reverse_generic[where m=0, simplified]
                      helper_masked_ucast_equal_generic[where n=0, simplified]
     show ?thesis
     apply(cases ip, rename_tac a b c d e f g h)
     apply(simp add: ipv6preferred_to_int.simps int_to_ipv6preferred_def)
     apply(simp add: word128_masks_ipv6pieces)
     apply(simp add: word_ao_dist ucast_shift_simps ucast_simps)
     done
   qed
 
 
 
 text\<open>compressed to preferred format\<close>
 fun ipv6addr_c2p :: "ipv6addr_syntax_compressed \<Rightarrow> ipv6addr_syntax" where
     "ipv6addr_c2p (IPv6AddrCompressed1_0 ()) = IPv6AddrPreferred 0 0 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed1_1 () h) = IPv6AddrPreferred 0 0 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_2 () g h) = IPv6AddrPreferred 0 0 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_3 () f g h) = IPv6AddrPreferred 0 0 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_4 () e f g h) = IPv6AddrPreferred 0 0 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_5 () d e f g h) = IPv6AddrPreferred 0 0 0 d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_6 () c d e f g h) = IPv6AddrPreferred 0 0 c d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed1_7 () b c d e f g h) = IPv6AddrPreferred 0 b c d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed2_1 a ()) = IPv6AddrPreferred a 0 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed2_2 a () h) = IPv6AddrPreferred a 0 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_3 a () g h) = IPv6AddrPreferred a 0 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_4 a () f g h) = IPv6AddrPreferred a 0 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_5 a () e f g h) = IPv6AddrPreferred a 0 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_6 a () d e f g h) = IPv6AddrPreferred a 0 0 d e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed2_7 a () c d e f g h) = IPv6AddrPreferred a 0 c d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed3_2 a b ()) = IPv6AddrPreferred a b 0 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed3_3 a b () h) = IPv6AddrPreferred a b 0 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_4 a b () g h) = IPv6AddrPreferred a b 0 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_5 a b () f g h) = IPv6AddrPreferred a b 0 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_6 a b () e f g h) = IPv6AddrPreferred a b 0 0 e f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed3_7 a b () d e f g h) = IPv6AddrPreferred a b 0 d e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed4_3 a b c ()) = IPv6AddrPreferred a b c 0 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed4_4 a b c () h) = IPv6AddrPreferred a b c 0 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_5 a b c () g h) = IPv6AddrPreferred a b c 0 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_6 a b c () f g h) = IPv6AddrPreferred a b c 0 0 f g h"
   | "ipv6addr_c2p (IPv6AddrCompressed4_7 a b c () e f g h) = IPv6AddrPreferred a b c 0 e f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed5_4 a b c d ()) = IPv6AddrPreferred a b c d 0 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed5_5 a b c d () h) = IPv6AddrPreferred a b c d 0 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed5_6 a b c d () g h) = IPv6AddrPreferred a b c d 0 0 g h"
   | "ipv6addr_c2p (IPv6AddrCompressed5_7 a b c d () f g h) = IPv6AddrPreferred a b c d 0 f g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed6_5 a b c d e ()) = IPv6AddrPreferred a b c d e 0 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed6_6 a b c d e () h) = IPv6AddrPreferred a b c d e 0 0 h"
   | "ipv6addr_c2p (IPv6AddrCompressed6_7 a b c d e () g h) = IPv6AddrPreferred a b c d e 0 g h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed7_6 a b c d e f ()) = IPv6AddrPreferred a b c d e f 0 0"
   | "ipv6addr_c2p (IPv6AddrCompressed7_7 a b c d e f () h) = IPv6AddrPreferred a b c d e f 0 h"
 
   | "ipv6addr_c2p (IPv6AddrCompressed8_7 a b c d e f g ()) = IPv6AddrPreferred a b c d e f g 0"
 
 
 definition ipv6_unparsed_compressed_to_preferred :: "((16 word) option) list \<Rightarrow> ipv6addr_syntax option" where
   "ipv6_unparsed_compressed_to_preferred ls = (
     if
       length (filter (\<lambda>p. p = None) ls) \<noteq> 1 \<or> length (filter (\<lambda>p. p \<noteq> None) ls) > 7
     then
       None
     else
       let
         before_omission = map the (takeWhile (\<lambda>x. x \<noteq> None) ls);
         after_omission = map the (drop 1 (dropWhile (\<lambda>x. x \<noteq> None) ls));
         num_omissions = 8 - (length before_omission + length after_omission);
         expanded = before_omission @ (replicate num_omissions 0) @ after_omission
       in
         case expanded of [a,b,c,d,e,f,g,h] \<Rightarrow> Some (IPv6AddrPreferred a b c d e f g h)
                          | _               \<Rightarrow> None
       )"
 
   lemma "ipv6_unparsed_compressed_to_preferred
     [Some 0x2001, Some 0xDB8, None, Some 0x8, Some 0x800, Some 0x200C, Some 0x417A]
       = Some (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A)" by eval
 
   lemma "ipv6_unparsed_compressed_to_preferred [None] = Some (IPv6AddrPreferred 0 0 0 0 0 0 0 0)" by eval
 
   lemma "ipv6_unparsed_compressed_to_preferred [] = None" by eval
 
 
   lemma ipv6_unparsed_compressed_to_preferred_identity1:
    "ipv6_unparsed_compressed_to_preferred (ipv6addr_syntax_compressed_to_list ipv6compressed) = Some ipv6prferred
     \<longleftrightarrow> ipv6addr_c2p ipv6compressed = ipv6prferred"
   by(cases ipv6compressed) (simp_all add: ipv6_unparsed_compressed_to_preferred_def) (*1s*)
  
   lemma ipv6_unparsed_compressed_to_preferred_identity2: 
     "ipv6_unparsed_compressed_to_preferred ls = Some ipv6prferred
      \<longleftrightarrow> (\<exists>ipv6compressed. parse_ipv6_address_compressed ls = Some ipv6compressed \<and>
                            ipv6addr_c2p ipv6compressed = ipv6prferred)"
   apply(rule iffI)
    apply(subgoal_tac "parse_ipv6_address_compressed ls \<noteq> None")
     prefer 2
     apply(subst RFC_4291_format)
     apply(simp add: ipv6_unparsed_compressed_to_preferred_def split: if_split_asm; fail)
    apply(simp)
    apply(erule exE, rename_tac ipv6compressed)
    apply(rule_tac x="ipv6compressed" in exI)
    apply(simp)
    apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
     prefer 2
     using parse_ipv6_address_compressed_identity2 apply presburger
    using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
   apply(erule exE, rename_tac ipv6compressed)
   apply(subgoal_tac "(ipv6addr_syntax_compressed_to_list ipv6compressed = ls)")
    prefer 2
    using parse_ipv6_address_compressed_identity2 apply presburger
   using ipv6_unparsed_compressed_to_preferred_identity1 apply blast
   done
   
 
 subsection\<open>IPv6 Pretty Printing (converting to compressed format)\<close>
 text_raw\<open>
 RFC5952:
 \begin{verbatim}
 4.  A Recommendation for IPv6 Text Representation
 
    A recommendation for a canonical text representation format of IPv6
    addresses is presented in this section.  The recommendation in this
    document is one that complies fully with [RFC4291], is implemented by
    various operating systems, and is human friendly.  The recommendation
    in this section SHOULD be followed by systems when generating an
    address to be represented as text, but all implementations MUST
    accept and be able to handle any legitimate [RFC4291] format.  It is
    advised that humans also follow these recommendations when spelling
    an address.
 
 4.1.  Handling Leading Zeros in a 16-Bit Field
 
    Leading zeros MUST be suppressed.  For example, 2001:0db8::0001 is
    not acceptable and must be represented as 2001:db8::1.  A single 16-
    bit 0000 field MUST be represented as 0.
 
 4.2.  "::" Usage
 
 4.2.1.  Shorten as Much as Possible
 
    The use of the symbol "::" MUST be used to its maximum capability.
    For example, 2001:db8:0:0:0:0:2:1 must be shortened to 2001:db8::2:1.
    Likewise, 2001:db8::0:1 is not acceptable, because the symbol "::"
    could have been used to produce a shorter representation 2001:db8::1.
 
 4.2.2.  Handling One 16-Bit 0 Field
 
    The symbol "::" MUST NOT be used to shorten just one 16-bit 0 field.
    For example, the representation 2001:db8:0:1:1:1:1:1 is correct, but
    2001:db8::1:1:1:1:1 is not correct.
 
 4.2.3.  Choice in Placement of "::"
 
    When there is an alternative choice in the placement of a "::", the
    longest run of consecutive 16-bit 0 fields MUST be shortened (i.e.,
    the sequence with three consecutive zero fields is shortened in 2001:
    0:0:1:0:0:0:1).  When the length of the consecutive 16-bit 0 fields
    are equal (i.e., 2001:db8:0:0:1:0:0:1), the first sequence of zero
    bits MUST be shortened.  For example, 2001:db8::1:0:0:1 is correct
    representation.
 
 4.3.  Lowercase
 
    The characters "a", "b", "c", "d", "e", and "f" in an IPv6 address
    MUST be represented in lowercase.
 \end{verbatim}
 \<close>
 text\<open>See @{file \<open>IP_Address_toString.thy\<close>} for examples and test cases.\<close>
 context
 begin
   private function goup_by_zeros :: "16 word list \<Rightarrow> 16 word list list" where
     "goup_by_zeros [] = []" |
     "goup_by_zeros (x#xs) = (
         if x = 0
         then takeWhile (\<lambda>x. x = 0) (x#xs) # (goup_by_zeros (dropWhile (\<lambda>x. x = 0) xs))
         else [x]#(goup_by_zeros xs))"
   by(pat_completeness, auto)
   
   termination goup_by_zeros
 	 apply(relation "measure (\<lambda>xs. length xs)")
 	   apply(simp_all)
 	 by (simp add: le_imp_less_Suc length_dropWhile_le)
 	
 	private lemma "goup_by_zeros [0,1,2,3,0,0,0,0,3,4,0,0,0,2,0,0,2,0,3,0] =
 	        [[0], [1], [2], [3], [0, 0, 0, 0], [3], [4], [0, 0, 0], [2], [0, 0], [2], [0], [3], [0]]"
 	by eval
 	
 	private lemma "concat (goup_by_zeros ls) = ls"
 	  by(induction ls rule:goup_by_zeros.induct) simp+
 	
 	private lemma "[] \<notin> set (goup_by_zeros ls)"
 	  by(induction ls rule:goup_by_zeros.induct) simp+
 	  
   private primrec List_replace1 :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
     "List_replace1 _ _ [] = []" |
     "List_replace1 a b (x#xs) = (if a = x then b#xs else x#List_replace1 a b xs)"
     
 	private lemma "List_replace1 a a ls = ls"
 	  by(induction ls) simp_all
 	
 	private lemma "a \<notin> set ls \<Longrightarrow> List_replace1 a b ls = ls"
 	  by(induction ls) simp_all
 	
 	private lemma "a \<in> set ls \<Longrightarrow> b \<in> set (List_replace1 a b ls)"
 	  apply(induction ls)
 	   apply(simp)
 	  apply(simp)
 	  by blast
   
 	private fun List_explode :: "'a list list \<Rightarrow> ('a option) list" where
 	  "List_explode [] = []" |
 	  "List_explode ([]#xs) = None#List_explode xs" |
 	  "List_explode (xs1#xs2) = map Some xs1@List_explode xs2"
 	  
   private lemma "List_explode [[0::int], [2,3], [], [3,4]] = [Some 0, Some 2, Some 3, None, Some 3, Some 4]"
   by eval
 
   private lemma List_explode_def: 
     "List_explode xss = concat (map (\<lambda>xs. if xs = [] then [None] else map Some xs) xss)"
     by(induction xss rule: List_explode.induct) simp+
 	  
   private lemma List_explode_no_empty: "[] \<notin> set xss \<Longrightarrow> List_explode xss = map Some (concat xss)"
     by(induction xss rule: List_explode.induct) simp+
 
   private lemma List_explode_replace1: "[] \<notin> set xss \<Longrightarrow> foo \<in> set xss \<Longrightarrow>
           List_explode (List_replace1 foo [] xss) =
             map Some (concat (takeWhile (\<lambda>xs. xs \<noteq> foo) xss)) @ [None] @
               map Some (concat (tl (dropWhile (\<lambda>xs. xs \<noteq> foo) xss)))"
     apply(induction xss rule: List_explode.induct)
       apply(simp; fail)
      apply(simp; fail)
     apply(simp)
     apply safe
       apply(simp_all add: List_explode_no_empty)
     done
     
   fun ipv6_preferred_to_compressed :: "ipv6addr_syntax \<Rightarrow> ((16 word) option) list" where
   "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
     let lss = goup_by_zeros [a,b,c,d,e,f,g,h];
         max_zero_seq = foldr (\<lambda>xs. max (length xs)) lss 0;
         shortened = if max_zero_seq > 1 then List_replace1 (replicate max_zero_seq 0) [] lss else lss
     in
       List_explode shortened
     )"
   declare ipv6_preferred_to_compressed.simps[simp del]
 
   private lemma foldr_max_length: "foldr (\<lambda>xs. max (length xs)) lss n = fold max (map length lss) n"
     apply(subst List.foldr_fold)
      apply fastforce
     apply(induction lss arbitrary: n)
      apply(simp; fail)
     apply(simp)
     done
 
   private lemma List_explode_goup_by_zeros: "List_explode (goup_by_zeros xs) = map Some xs"
     apply(induction xs rule: goup_by_zeros.induct)
      apply(simp; fail)
     apply(simp)
     apply(safe)
      apply(simp)
     by (metis map_append takeWhile_dropWhile_id)
   
   private definition "max_zero_streak xs \<equiv> foldr (\<lambda>xs. max (length xs)) (goup_by_zeros xs) 0"    
 
   private lemma max_zero_streak_def2: "max_zero_streak xs = fold max (map length (goup_by_zeros xs)) 0"
     unfolding max_zero_streak_def
     by(simp add: foldr_max_length)
 
   private lemma ipv6_preferred_to_compressed_pull_out_if:
     "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (
     if max_zero_streak [a,b,c,d,e,f,g,h] > 1 then
       List_explode (List_replace1 (replicate (max_zero_streak [a,b,c,d,e,f,g,h]) 0) [] (goup_by_zeros [a,b,c,d,e,f,g,h]))
     else
       map Some [a,b,c,d,e,f,g,h]
     )"
   by(simp add: ipv6_preferred_to_compressed.simps max_zero_streak_def List_explode_goup_by_zeros)
 
     
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0 0 0 0 0 0 0 0) = [None]" by eval
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 0 8 0x800 0x200C 0x417A) =
                 [Some 0x2001, Some 0xDB8, None,           Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred 0x2001 0xDB8 0 3 8 0x800 0x200C 0x417A) =
                 [Some 0x2001, Some 0xDB8, Some 0, Some 3, Some 8, Some 0x800, Some 0x200C, Some 0x417A]" by eval
 
   (*the output should even conform to RFC5952, ...*)
   lemma ipv6_preferred_to_compressed_RFC_4291_format:
     "ipv6_preferred_to_compressed ip = as \<Longrightarrow> 
           length (filter (\<lambda>p. p = None) as) = 0 \<and> length as = 8
           \<or>
           length (filter (\<lambda>p. p = None) as) = 1 \<and> length (filter (\<lambda>p. p \<noteq> None) as) \<le> 7"
   apply(cases ip)
   apply(simp add: ipv6_preferred_to_compressed_pull_out_if)
   apply(simp only: split: if_split_asm)
    subgoal for a b c d e f g h
    apply(rule disjI2)
    apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
          case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
    by(auto simp add: max_zero_streak_def) (*1min*)
   subgoal
   apply(rule disjI1)
   apply(simp)
   by force
   done
 
   \<comment> \<open>Idea for the following proof:\<close>
   private lemma "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
       xs = map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h])"
     apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
           case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
     by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*20s*)
 
 
  
   lemma ipv6_preferred_to_compressed:
     assumes "ipv6_unparsed_compressed_to_preferred (ipv6_preferred_to_compressed ip) = Some ip'"
     shows "ip = ip'"
   proof -
     from assms have 1: "\<exists>ipv6compressed.
          parse_ipv6_address_compressed (ipv6_preferred_to_compressed ip) = Some ipv6compressed \<and>
          ipv6addr_c2p ipv6compressed = ip'" using ipv6_unparsed_compressed_to_preferred_identity2 by simp
   
     obtain a b c d e f g h where ip: "ip = IPv6AddrPreferred a b c d e f g h" by(cases ip)
   
     have ipv6_preferred_to_compressed_None1:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [a,b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a b c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None2:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [b,c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None3:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [c,d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None4:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [d,e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None5:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [e,f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None6:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [f,g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None7:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [g,h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'"  for xs a' b' c' d' e' f'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
     have ipv6_preferred_to_compressed_None8:
       "ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h) = (Some a')#(Some b')#(Some c')#(Some d')#(Some e')#(Some f')#(Some g')#None#xs \<Longrightarrow>
         (map Some (dropWhile (\<lambda>x. x=0) [h]) = xs \<Longrightarrow> (IPv6AddrPreferred a' b' c' d' e' f' g' h) = ip') \<Longrightarrow>
         (IPv6AddrPreferred a b c d e f g h) = ip'" for xs a' b' c' d' e' f' g'
       apply(case_tac "a=0",case_tac [!] "b=0",case_tac [!] "c=0",case_tac [!] "d=0",
             case_tac [!] "e=0",case_tac [!] "f=0",case_tac [!] "g=0",case_tac [!] "h=0")
       by(simp_all add: ipv6_preferred_to_compressed_pull_out_if max_zero_streak_def) (*5s*)
 
     have 2: "parse_ipv6_address_compressed (ipv6_preferred_to_compressed (IPv6AddrPreferred a b c d e f g h))
                 = Some ipv6compressed \<Longrightarrow>
        ipv6addr_c2p ipv6compressed = ip' \<Longrightarrow>
        IPv6AddrPreferred a b c d e f g h = ip'"
     for ipv6compressed
       apply(erule parse_ipv6_address_compressed_someE)
                                          apply(simp_all)
                                          apply(erule ipv6_preferred_to_compressed_None1, simp split: if_split_asm)+
                                  apply(erule ipv6_preferred_to_compressed_None2, simp split: if_split_asm)+
                          apply(erule ipv6_preferred_to_compressed_None3, simp split: if_split_asm)+
                     apply(erule ipv6_preferred_to_compressed_None4, simp split: if_split_asm)+
                apply(erule ipv6_preferred_to_compressed_None5, simp split: if_split_asm)+
            apply(erule ipv6_preferred_to_compressed_None6, simp split: if_split_asm)+
         apply(erule ipv6_preferred_to_compressed_None7, simp split: if_split_asm)+
       apply(erule ipv6_preferred_to_compressed_None8, simp split: if_split_asm)
       done
     from 1 2 ip show ?thesis by(elim exE conjE, simp)
   qed
 end
 
 end
diff --git a/thys/IP_Addresses/NumberWang_IPv6.thy b/thys/IP_Addresses/NumberWang_IPv6.thy
--- a/thys/IP_Addresses/NumberWang_IPv6.thy
+++ b/thys/IP_Addresses/NumberWang_IPv6.thy
@@ -1,238 +1,231 @@
 theory NumberWang_IPv6
 imports 
   Word_Lib.Word_Lemmas
 begin
 
 section\<open>Helper Lemmas for Low-Level Operations on Machine Words\<close>
 text\<open>Needed for IPv6 Syntax\<close>
 
 lemma length_drop_bl: "length (dropWhile Not (to_bl (of_bl bs))) \<le> length bs"
 proof -
   have length_takeWhile_Not_replicate_False:
     "length (takeWhile Not (replicate n False @ ls)) = n + length (takeWhile Not ls)"
   for n ls by(subst takeWhile_append2) simp+
   show ?thesis by(simp add: word_rep_drop dropWhile_eq_drop length_takeWhile_Not_replicate_False)
 qed
 
 lemma bl_drop_leading_zeros: 
       "(of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs) =
        (of_bl:: bool list \<Rightarrow> 'a::len word) bs"
 by(induction bs) simp_all
 
 
 lemma bl_length_drop_bound: assumes "length (dropWhile Not bs) \<le> n"
   shows "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> n"
 proof -
   have bl_length_drop_twice: 
       "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs)))) =
        length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs)))"
     by(simp add: bl_drop_leading_zeros)
   from length_drop_bl
   have *: "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> length (dropWhile Not bs)"
    apply(rule dual_order.trans)
    apply(subst bl_length_drop_twice)
    ..
   show ?thesis
   apply(rule order.trans, rule *)
   using assms by(simp)
 qed
 
 lemma length_drop_mask_outer: fixes ip::"'a::len word"
   shows "LENGTH('a) - n' = len \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> len"
   apply(subst Word_Lemmas.word_and_mask_shiftl)
   apply(subst Word_Lib.shiftl_shiftr1)
    apply(simp; fail)
   apply(simp)
   apply(subst Word_Lib.and_mask)
   apply(simp add: word_size)
   apply(simp add: length_drop_mask)
   done
 lemma length_drop_mask_inner: fixes ip::"'a::len word"
   shows "n \<le> LENGTH('a) - n' \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> n"
   apply(subst Word_Lemmas.word_and_mask_shiftl)
   apply(subst Word_Lemmas.shiftl_shiftr3)
    apply(simp; fail)
   apply(simp)
   apply(simp add: word_size)
   apply(simp add: Word_Lemmas.mask_twice)
   apply(simp add: length_drop_mask)
   done
 
 
 lemma mask128: "0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF = mask 128"
-  by(simp add: mask_def)
+  by (simp add: mask_eq)
 
 
 (*-------------- things for ipv6 syntax round trip property two ------------------*)
 
 (*n small, m large*)
 lemma helper_masked_ucast_generic:
   fixes b::"16 word"
   assumes "n + 16 \<le> m" and "m < 128"
   shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
 proof -
   have "x < 2 ^ (m - n)" if mnh2: "x < 0x10000"
     for x::"128 word"
   proof -
     from assms(1) have mnh3: "16 \<le> m - n" by fastforce
     have power_2_16_nat: "(16::nat) \<le> n \<Longrightarrow> (65535::nat) < 2 ^ n" if a:"16 \<le> n"for n
     proof -
       have power2_rule: "a \<le> b \<Longrightarrow> (2::nat)^a \<le> 2 ^ b" for a b by fastforce
       show ?thesis
        apply(subgoal_tac "65536 \<le> 2 ^ n")
         apply(subst Nat.less_eq_Suc_le)
         apply(simp; fail)
        apply(subgoal_tac "(65536::nat) = 2^16")
         subgoal using power2_rule \<open>16 \<le> n\<close> by presburger
        by(simp)
     qed
     have "65536 = unat (65536::128 word)" by auto
     moreover from mnh2 have "unat x <  unat (65536::128 word)" by(rule Word.unat_mono)
     ultimately have x: "unat x < 65536" by simp
     with mnh3 have "unat x < 2 ^ (m - n)" 
       apply(rule_tac b=65535 in Orderings.order_class.order.strict_trans1)
        apply(simp_all)
       using power_2_16_nat apply blast
       done
     with assms(2) show ?thesis by(subst word_less_nat_alt) simp
   qed
   hence mnhelper2: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2 ^ (m - n)"
     apply(subgoal_tac "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2^(LENGTH(16))")
      apply(simp; fail)
     by(rule Word.of_bl_length_less) simp+
   have mnhelper3: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) * 2 ^ n < 2 ^ m"
     apply(rule Word.div_lt_mult)
      apply(rule Word_Lemmas.word_less_two_pow_divI)
        using assms by(simp_all add: mnhelper2 Word_Lib.p2_gt_0)
 
   from assms show ?thesis
     apply(subst Word.ucast_bl)+
     apply(subst Word.shiftl_of_bl)
     apply(subst Word.of_bl_append)
     apply simp
     apply(subst Word_Lemmas.word_and_mask_shiftl)
     apply(subst Word_Lib.shiftr_div_2n_w)
      subgoal by(simp add: word_size; fail)
     apply(subst Word_Lemmas.word_div_less)
      subgoal by(rule mnhelper3)
     apply simp
     done
 qed
 
 
 lemma unat_of_bl_128_16_less_helper:
   fixes b::"16 word"
   shows "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^16"
 proof -
   from Word.word_bl_Rep' have 1: "length (to_bl b) = 16" by simp
   have "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^(length (to_bl b))"
     by(fact Word_Lemmas.unat_of_bl_length)
   with 1 show ?thesis by auto
 qed
 lemma unat_of_bl_128_16_le_helper: "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl (b::16 word))) \<le> 65535"
 proof -
   from unat_of_bl_128_16_less_helper[of b] have
     "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl b)) < 65536" by simp 
   from Nat.Suc_leI[OF this] show ?thesis by simp
 qed
 
 
 (*reverse*)
  lemma helper_masked_ucast_reverse_generic:
    fixes b::"16 word"
    assumes "m + 16 \<le> n" and "n \<le> 128 - 16"
    shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
  proof -
 
    have power_less_128_helper: "2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2 ^ LENGTH(128)"
      if n: "n \<le> 128 - 16" for n
    proof -
      have help_mult: "n \<le> l \<Longrightarrow> 2 ^ n * x < 2 ^ l \<longleftrightarrow> x < 2 ^ (l - n)" for x::nat and l
        by (simp add: nat_mult_power_less_eq semiring_normalization_rules(7))
      from n show ?thesis
        apply(subst help_mult)
         subgoal by (simp)
        apply(rule order_less_le_trans)
         apply(rule unat_of_bl_128_16_less_helper)
        apply(rule Power.power_increasing)
         apply(simp_all)
        done
    qed
 
    have *: "2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))) = 
             2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))"
    proof(cases "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) = 0")
    case True thus ?thesis by simp
    next
    case False
     have help_mult: "x \<noteq> 0 \<Longrightarrow> b * (c * x) = a * (x::nat)  \<longleftrightarrow> b * c = a" for x a b c by simp
     from assms show ?thesis
      apply(subst help_mult[OF False])
      apply(subst Power.monoid_mult_class.power_add[symmetric])
      apply(simp)
      done
    qed
 
   from assms have "unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128) =
         2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128))"
      apply(subst nat_mod_eq')
       subgoal apply(subst Aligned.unat_power_lower)
        subgoal by(simp; fail)
       subgoal by (rule power_less_128_helper) simp
       done
      apply(subst nat_mod_eq')
       subgoal by(rule power_less_128_helper) simp
      apply(subst Aligned.unat_power_lower)
       apply(simp; fail)
      apply(simp only: *)
      done
    hence ex_k: "\<exists>k. unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ LENGTH(128) = 2 ^ m * k"
      by blast
 
    hence aligned: "is_aligned ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) m"
      unfolding is_aligned_def
      unfolding dvd_def
      unfolding Word.shiftl_t2n
      unfolding Word.unat_word_ariths(2)
      by assumption
 
    from assms have of_bl_to_bl_shift_mask: "((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) && mask (16 + m) = 0"
     using is_aligned_mask is_aligned_shiftl by force (*sledgehammer*)
 
    show ?thesis
     apply(subst Word.ucast_bl)+
     apply(subst Word_Lemmas.word_and_mask_shiftl)
     apply(subst Aligned.aligned_shiftr_mask_shiftl)
      subgoal by (fact aligned)
     subgoal by (fact of_bl_to_bl_shift_mask)
     done
 qed
 
 
 lemma helper_masked_ucast_equal_generic:
   fixes b::"16 word"
   assumes "n \<le> 128 - 16"
   shows "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << n) >> n) = b"
 proof -
- have ucast_mask: "(ucast:: 16 word \<Rightarrow> 128 word) b && mask 16 = ucast b" 
-  apply(subst Word_Lib.and_mask_eq_iff_le_mask)
-  apply(subst Word.ucast_bl)
-  apply(simp add: mask_def)
-  thm Word.word_uint_eqI word_le_nat_alt
-  apply(subst word_le_nat_alt)
-  apply(simp)
-  using unat_of_bl_128_16_le_helper by simp
-
+  have ucast_mask: "(ucast:: 16 word \<Rightarrow> 128 word) b && mask 16 = ucast b" 
+    by transfer (simp flip: take_bit_eq_mask)
   from assms have "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b && mask (128 - n) && mask 16) && mask (128 - n)) = b"
     by (auto simp add: nth_ucast word_size intro: word_eqI)
   thus ?thesis
   apply(subst Word_Lemmas.word_and_mask_shiftl)
   apply(subst Word_Lemmas.shiftl_shiftr3)
    apply(simp; fail)
   apply(simp)
   apply(subst Word_Lemmas.shiftl_shiftr3)
     apply(simp_all add: word_size and.assoc)
   done
 qed
 
 end
diff --git a/thys/IP_Addresses/Prefix_Match.thy b/thys/IP_Addresses/Prefix_Match.thy
--- a/thys/IP_Addresses/Prefix_Match.thy
+++ b/thys/IP_Addresses/Prefix_Match.thy
@@ -1,233 +1,235 @@
 (*  Title:      Prefix_Match.thy
     Authors:    Julius Michaelis, Cornelius Diekmann
 *)
 theory Prefix_Match
 imports IP_Address
 begin
 
 
 section\<open>Prefix Match\<close>
 text\<open>
   The main difference between the prefix match defined here and CIDR notation is a validity
   constraint imposed on prefix matches.
 
   For example, 192.168.42.42/16 is valid CIDR notation whereas for a prefix match,
   it must be 192.168.0.0/16.
 
   I.e. the last bits of the prefix must be set to zero.
 \<close>
 
 context
   notes [[typedef_overloaded]]
 begin
   datatype 'a prefix_match = PrefixMatch (pfxm_prefix: "'a::len word") (pfxm_length: nat)
 end
 
 definition pfxm_mask :: "'a prefix_match \<Rightarrow> 'a::len word" where
   "pfxm_mask x \<equiv> mask (len_of (TYPE('a)) - pfxm_length x)"
 
 definition valid_prefix :: "('a::len) prefix_match \<Rightarrow> bool" where
   "valid_prefix pf = ((pfxm_mask pf) AND pfxm_prefix pf = 0)"
 text\<open>Note that @{const valid_prefix} looks very elegant as a definition. However, it hides something nasty:\<close>
 lemma "valid_prefix (PrefixMatch (0::32 word) 42)" by eval
 
 text\<open>When zeroing all least significant bits which exceed the @{const pfxm_length},
      you get a @{const valid_prefix}\<close>
 lemma mk_valid_prefix:
   fixes base::"'a::len word"
   shows "valid_prefix (PrefixMatch (base AND NOT (mask (len_of TYPE ('a) - len))) len)"
 proof -
   have "mask (len - m) AND base AND NOT (mask (len - m)) = 0"
     for m len and base::"'a::len word" by(simp add: word_bw_lcs)
   thus ?thesis
   by(simp add: valid_prefix_def pfxm_mask_def pfxm_length_def pfxm_prefix_def)
 qed
 
 
 text\<open>The type @{typ "'a prefix_match"} usually requires @{const valid_prefix}.
       When we allow working on arbitrary IPs in CIDR notation,
       we will use the type @{typ "('i::len word \<times> nat)"} directly.\<close>
 
 lemma valid_prefix_00: "valid_prefix (PrefixMatch 0 0)" by (simp add: valid_prefix_def)
 
 definition prefix_match_to_CIDR :: "('i::len) prefix_match \<Rightarrow> ('i word \<times> nat)" where
   "prefix_match_to_CIDR pfx \<equiv> (pfxm_prefix pfx, pfxm_length pfx)"
 
 lemma prefix_match_to_CIDR_def2: "prefix_match_to_CIDR = (\<lambda>pfx. (pfxm_prefix pfx, pfxm_length pfx))"
   unfolding prefix_match_to_CIDR_def fun_eq_iff by simp
 
 
 definition "prefix_match_dtor m \<equiv> (case m of PrefixMatch p l \<Rightarrow> (p,l))"
 
 text\<open>Some more or less random linear order on prefixes.
      Only used for serialization at the time of this writing.\<close>
 instantiation prefix_match :: (len) linorder
 begin
 	definition "a \<le> b \<longleftrightarrow> (if pfxm_length a = pfxm_length b
                          then pfxm_prefix a \<le> pfxm_prefix b
                          else pfxm_length a > pfxm_length b)"
 	definition "a < b \<longleftrightarrow> (a \<noteq> b \<and>
 	                       (if pfxm_length a = pfxm_length b
 	                        then pfxm_prefix a \<le> pfxm_prefix b
 	                        else pfxm_length a > pfxm_length b))"
 instance
 by standard (auto simp: less_eq_prefix_match_def less_prefix_match_def prefix_match.expand
                   split: if_splits)
 end
 
 lemma "sorted_list_of_set
  {PrefixMatch 0 32 :: 32 prefix_match,
   PrefixMatch 42 32,
   PrefixMatch 0 0,
   PrefixMatch 0 1,
   PrefixMatch 12 31} =
     [PrefixMatch 0 32, PrefixMatch 0x2A 32, PrefixMatch 0xC 31, PrefixMatch 0 1, PrefixMatch 0 0]"
   by eval
 
 context
 begin
 
 private lemma valid_prefix_E: "valid_prefix pf \<Longrightarrow> ((pfxm_mask pf) AND pfxm_prefix pf = 0)" 
   unfolding valid_prefix_def .
 private lemma valid_prefix_alt: fixes p::"'a::len prefix_match"
   shows "valid_prefix p = (pfxm_prefix p AND (2 ^ ((len_of TYPE ('a)) - pfxm_length p) - 1) = 0)"
   unfolding valid_prefix_def
-  unfolding mask_def
+  unfolding mask_eq
   using word_bw_comms(1)
    arg_cong[where f = "\<lambda>x. (pfxm_prefix p AND x - 1 = 0)"]
    shiftl_1
-  unfolding pfxm_prefix_def pfxm_mask_def mask_def
-  by metis
+  unfolding pfxm_prefix_def pfxm_mask_def mask_eq
+  apply (cases p)
+  apply (simp add: ac_simps)
+  done
 
 subsection\<open>Address Semantics\<close>
   text\<open>Matching on a @{typ "'a::len prefix_match"}. Think of routing tables.\<close>
   definition prefix_match_semantics where
     "prefix_match_semantics m a \<equiv> pfxm_prefix m = NOT (pfxm_mask m) AND a"
 
 lemma same_length_prefixes_distinct: "valid_prefix pfx1 \<Longrightarrow> valid_prefix pfx2 \<Longrightarrow> pfx1 \<noteq> pfx2 \<Longrightarrow> pfxm_length pfx1 = pfxm_length pfx2 \<Longrightarrow> prefix_match_semantics pfx1 w \<Longrightarrow> prefix_match_semantics pfx2 w \<Longrightarrow> False"
   by (simp add: pfxm_mask_def prefix_match.expand prefix_match_semantics_def)
 
 subsection\<open>Relation between prefix and set\<close>
 
   definition prefix_to_wordset :: "'a::len prefix_match \<Rightarrow> 'a word set" where
     "prefix_to_wordset pfx = {pfxm_prefix pfx .. pfxm_prefix pfx OR pfxm_mask pfx}"
   
   private lemma pfx_not_empty: "valid_prefix pfx \<Longrightarrow> prefix_to_wordset pfx \<noteq> {}"
     unfolding valid_prefix_def prefix_to_wordset_def by(simp add: le_word_or2)
   
   lemma zero_prefix_match_all:
     "valid_prefix m \<Longrightarrow> pfxm_length m = 0 \<Longrightarrow> prefix_match_semantics m ip"
     by(simp add: pfxm_mask_def mask_2pm1 valid_prefix_alt prefix_match_semantics_def)
   
   lemma prefix_to_wordset_subset_ipset_from_cidr: 
       "prefix_to_wordset pfx \<subseteq> ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
     apply(rule subsetI)
     apply(simp add: prefix_to_wordset_def addr_in_ipset_from_cidr_code)
     apply(intro impI conjI)
      apply (metis (erased, hide_lams) order_trans word_and_le2)
     apply(simp add: pfxm_mask_def)
     done
 
 subsection\<open>Equivalence Proofs\<close>
   theorem prefix_match_semantics_wordset:
     assumes "valid_prefix pfx" 
     shows "prefix_match_semantics pfx a \<longleftrightarrow> a \<in> prefix_to_wordset pfx"
     using assms
     unfolding valid_prefix_def pfxm_mask_def prefix_match_semantics_def prefix_to_wordset_def
     apply(cases pfx, rename_tac base len)
     apply(simp)
     apply(drule_tac base=base and len=len and a=a in zero_base_lsb_imp_set_eq_as_bit_operation)
     by (simp)
   
   private lemma valid_prefix_ipset_from_netmask_ipset_from_cidr:
     shows "ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx)) =
             ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
     apply(cases pfx)
     apply(simp add: ipset_from_cidr_alt2 pfxm_mask_def)
    done
   
   lemma prefix_match_semantics_ipset_from_netmask:
     assumes "valid_prefix pfx"
     shows "prefix_match_semantics pfx a \<longleftrightarrow>
             a \<in> ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx))"
     unfolding prefix_match_semantics_wordset[OF assms]
     unfolding valid_prefix_ipset_from_netmask_ipset_from_cidr
     unfolding prefix_to_wordset_def
     apply(subst ipset_from_cidr_base_wellforemd)
      subgoal using assms by(simp add: valid_prefix_def pfxm_mask_def)
     by(simp add: pfxm_mask_def)
     
   lemma prefix_match_semantics_ipset_from_netmask2:
     assumes "valid_prefix pfx"
     shows "prefix_match_semantics pfx (a :: 'i::len word) \<longleftrightarrow>
             a \<in> ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
    unfolding prefix_match_semantics_ipset_from_netmask[OF assms] pfxm_mask_def ipset_from_cidr_def
    by (metis (full_types) NOT_mask_shifted_lenword word_not_not)
 
   lemma prefix_to_wordset_ipset_from_cidr:
     assumes "valid_prefix (pfx::'a::len prefix_match)"
     shows "prefix_to_wordset pfx = ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
   proof -
     have helper3: "(x::'a::len word) OR y = x OR y AND NOT x" for x y by (simp add: word_oa_dist2)
     have prefix_match_semantics_ipset_from_netmask:
            "(prefix_to_wordset pfx) = ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx))"
       unfolding prefix_to_wordset_def ipset_from_netmask_def Let_def
       using assms
         by (clarsimp dest!: valid_prefix_E) (metis bit.conj_commute mask_eq_0_eq_x)
       have "((mask len)::'a::len word) << LENGTH('a) - len = ~~ (mask (LENGTH('a) - len))"
         for len using NOT_mask_shifted_lenword by (metis word_not_not)
       from this[of "(pfxm_length pfx)"] have mask_def2_symmetric:
         "((mask (pfxm_length pfx)::'a::len word) << LENGTH('a) - pfxm_length pfx) =
           NOT (pfxm_mask pfx)"
         unfolding pfxm_mask_def by simp
   
       have ipset_from_netmask_prefix: 
         "ipset_from_netmask (pfxm_prefix pfx) (NOT (pfxm_mask pfx)) =
           ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
        unfolding ipset_from_netmask_def ipset_from_cidr_alt
        unfolding pfxm_mask_def[symmetric]
        unfolding mask_def2_symmetric
        apply(simp)
        unfolding Let_def
        using assms[unfolded valid_prefix_def]
        by (metis helper3 word_bw_comms(2))
       
       show ?thesis by (metis ipset_from_netmask_prefix local.prefix_match_semantics_ipset_from_netmask) 
   qed
 
   definition prefix_to_wordinterval :: "'a::len prefix_match \<Rightarrow> 'a wordinterval" where
     "prefix_to_wordinterval pfx \<equiv> WordInterval (pfxm_prefix pfx) (pfxm_prefix pfx OR pfxm_mask pfx)"
   
   lemma prefix_to_wordinterval_set_eq[simp]:
     "wordinterval_to_set (prefix_to_wordinterval pfx) = prefix_to_wordset pfx"
     unfolding prefix_to_wordinterval_def prefix_to_wordset_def by simp
   
   lemma prefix_to_wordinterval_def2:
     "prefix_to_wordinterval pfx =
       iprange_interval ((pfxm_prefix pfx), (pfxm_prefix pfx OR pfxm_mask pfx))"
     unfolding iprange_interval.simps prefix_to_wordinterval_def by simp
   corollary prefix_to_wordinterval_ipset_from_cidr: "valid_prefix pfx \<Longrightarrow>
     wordinterval_to_set (prefix_to_wordinterval pfx) =
       ipset_from_cidr (pfxm_prefix pfx) (pfxm_length pfx)"
   using prefix_to_wordset_ipset_from_cidr prefix_to_wordinterval_set_eq by auto
 end
 
 
 lemma prefix_never_empty: 
   fixes d:: "'a::len prefix_match"
   shows"\<not> wordinterval_empty (prefix_to_wordinterval d)"
 by (simp add: le_word_or2 prefix_to_wordinterval_def)
 
 
 text\<open>Getting a lowest element\<close>
   lemma ipset_from_cidr_lowest: "a \<in> ipset_from_cidr a n" 
     using ip_cidr_set_def ipset_from_cidr_eq_ip_cidr_set by blast
 
   (*this is why I call the previous lemma 'lowest'*)
   lemma "valid_prefix (PrefixMatch a n) \<Longrightarrow> is_lowest_element a (ipset_from_cidr a n)"
     apply(simp add: is_lowest_element_def ipset_from_cidr_lowest)
     apply(simp add: ipset_from_cidr_eq_ip_cidr_set ip_cidr_set_def)
     apply(simp add: valid_prefix_def pfxm_mask_def)
     by (metis diff_zero eq_iff mask_out_sub_mask word_and_le2 word_bw_comms(1))
 
 end
diff --git a/thys/Interval_Arithmetic_Word32/Interpreter.thy b/thys/Interval_Arithmetic_Word32/Interpreter.thy
--- a/thys/Interval_Arithmetic_Word32/Interpreter.thy
+++ b/thys/Interval_Arithmetic_Word32/Interpreter.thy
@@ -1,603 +1,603 @@
 text\<open>
 Interpreter.thy defines a simple programming language over interval-valued variables and executable
 semantics (interpreter) for that language. We then prove that the interpretation of interval terms
 is a sound over-approximation of a real-valued semantics of the same language.
 
 Our language is a version of first order dynamic logic-style regular programs.
 We use a finite identifier space for compatibility with Differential-Dynamic-Logic, where identifier
 finiteness is required to treat program states as Banach spaces to enable differentiation.
 \<close>
 (* Author:     Brandon Bohrer *)
 theory Interpreter
 imports
   Complex_Main
-  "./Finite_String"
+  Finite_String
   Interval_Word32
   Word_Lib.Word_Lemmas
   Word_Lib.Word_Lib
   Word_Lib.Word_Syntax
 begin
 
 section\<open>Syntax\<close>
 text\<open>Our term language supports variables, polynomial arithmetic, and extrema. This choice was made
    based on the needs of the original paper and could be extended if necessary.\<close>
 datatype  trm =
   Var fin_string
 | Const lit
 | Plus trm trm
 | Times trm trm
 | Neg trm
 | Max trm trm
 | Min trm trm
 | Abs trm
 
 text\<open>Our statement language is nondeterministic first-order regular programs.
  This coincides with the discrete subset of hybrid programs from the dL entry.
 
 Our assertion language are the formulas of first-order dynamic logic\<close>
 datatype prog =
   Assign fin_string "trm"     (infixr ":=" 10)
 | AssignAny fin_string                
 | Test "formula"              ("?")
 | Choice "prog" "prog"        (infixl "\<union>\<union>" 10)
 | Sequence "prog"  "prog"     (infixr ";;" 8)
 | Loop "prog"                 ("_**")
 
 and formula =
   Geq "trm" "trm"
 | Not "formula"                        ("!")
 | And "formula" "formula"              (infixl "&&" 8)
 | Exists fin_string "formula"
 | Diamond "prog" "formula"               ("(\<langle> _ \<rangle> _)" 10)
     
 text\<open>Derived forms\<close>
 definition Or :: "formula \<Rightarrow> formula \<Rightarrow> formula" (infixl "||" 7)
 where or_simp[simp]:"Or P Q = Not (And (Not P) (Not Q))"
 
 definition Equals :: "trm \<Rightarrow> trm \<Rightarrow> formula"
 where equals_simp[simp]:"Equals \<theta> \<theta>' = (And (Geq \<theta> \<theta>') (Geq \<theta>' \<theta>))"
 
 definition Greater :: "trm \<Rightarrow> trm \<Rightarrow> formula"
 where greater_simp[simp]:"Greater \<theta> \<theta>' = Not (Geq \<theta>' \<theta>)"
 
 definition Leq :: "trm \<Rightarrow> trm \<Rightarrow> formula"
 where leq_simp[simp]:"Leq \<theta> \<theta>' = (Geq \<theta>' \<theta>)"
 
 definition Less :: "trm \<Rightarrow> trm \<Rightarrow> formula"
 where less_simp[simp]:"Less \<theta> \<theta>' = (Not (Geq \<theta> \<theta>'))"
 
 section \<open>Semantics\<close>
 text\<open> States over reals vs. word intervals which contain them\<close>
 type_synonym rstate = "fin_string \<Rightarrow> real"
 type_synonym wstate = "(fin_string + fin_string) \<Rightarrow> word"
 
 definition wstate::"wstate \<Rightarrow> prop"
 where wstate_def[simp]:"wstate \<nu> \<equiv> (\<And>i. word (\<nu> (Inl i)) \<and> word (\<nu> (Inr i)))"
 
 text\<open>Interpretation of a term in a state\<close>
 inductive rtsem :: "trm \<Rightarrow> rstate \<Rightarrow> real  \<Rightarrow> bool"  ("([_]_ \<down> _)" 10)
   where 
   rtsem_Const:"Rep_bword w \<equiv>\<^sub>E r \<Longrightarrow> ([Const w]\<nu> \<down> r)"
 | rtsem_Var:"([Var x]\<nu> \<down> \<nu> x)"
 | rtsem_Plus:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> ([Plus \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> (r1 + r2))"
 | rtsem_Times:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> ([Times \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> (r1 * r2))"
 | rtsem_Max:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> ([Max \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> (max r1 r2))"
 | rtsem_Min:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> ([Min \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> (min r1 r2))"
 | rtsem_Abs:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1)\<rbrakk> \<Longrightarrow> ([Abs \<theta>\<^sub>1]\<nu> \<down> (abs r1))"
 | rtsem_Neg:"([\<theta>]\<nu> \<down> r) \<Longrightarrow> ([Neg \<theta>]\<nu> \<down> -r)"
 
 inductive_simps 
     rtsem_Const_simps[simp] : "([(Const w)]\<nu> \<down> r)"
 and rtsem_Var_simps[simp] : "([Var x]\<nu> \<down> r)"
 and rtsem_PlusU_simps[simp] : "([Plus \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> r)"
 and rtsem_TimesU_simps[simp] : "([Times \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<down> r)"
 and rtsem_Max_simps[simp] : "([Max \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<down> r)"
 and rtsem_Min_simps[simp] : "([Min \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<down> r)"
 and rtsem_Abs_simps[simp] : "([Abs \<theta>] \<nu> \<down> r)"
 and rtsem_Neg_simps[simp] : "([Neg \<theta>] \<nu> \<down> r)"
 
 definition set_less :: "real set \<Rightarrow> real set \<Rightarrow> bool" (infix "<\<^sub>S" 10)
 where "set_less A B \<equiv> (\<forall> x y. x \<in> A \<and> y \<in> B \<longrightarrow> x < y)"
 
 definition set_geq :: "real set \<Rightarrow> real set \<Rightarrow> bool" (infix "\<ge>\<^sub>S" 10)
 where "set_geq A B \<equiv> (\<forall> x y. x \<in> A \<and> y \<in> B \<longrightarrow> x \<ge> y)"
 
 text\<open>Interpretation of an assertion in a state\<close>
 inductive rfsem :: "formula \<Rightarrow> rstate \<Rightarrow> bool \<Rightarrow> bool" ("([_]_) \<downharpoonright> _" 20)
 where 
   rGreaterT:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r1 > r2 \<Longrightarrow> ([Greater \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> True)"
 | rGreaterF:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r2 \<ge> r1 \<Longrightarrow> ([Greater \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> False)"
 | rGeqT:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r1 \<ge> r2 \<Longrightarrow> ([Geq \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> True)"
 | rGeqF:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r2 > r1 \<Longrightarrow> ([Geq \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> False)"
 | rEqualsT:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r1 = r2 \<Longrightarrow> ([Equals \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> True)"
 | rEqualsF:"\<lbrakk>([\<theta>\<^sub>1]\<nu> \<down> r1); ([\<theta>\<^sub>2]\<nu> \<down> r2)\<rbrakk> \<Longrightarrow> r1 \<noteq> r2 \<Longrightarrow> ([Equals \<theta>\<^sub>1 \<theta>\<^sub>2] \<nu> \<downharpoonright> False)"
 | rAndT:"\<lbrakk>([\<phi>]\<nu> \<downharpoonright> True); ([\<psi>]\<nu> \<downharpoonright> True)\<rbrakk> \<Longrightarrow> ([And \<phi> \<psi>]\<nu> \<downharpoonright> True)"
 | rAndF1:"([\<phi>]\<nu> \<downharpoonright> False) \<Longrightarrow> ([And \<phi> \<psi>]\<nu> \<downharpoonright> False)"
 | rAndF2:"([\<psi>]\<nu> \<downharpoonright> False) \<Longrightarrow> ([And \<phi> \<psi>]\<nu> \<downharpoonright> False)"
 | rOrT1:"([\<phi>]\<nu> \<downharpoonright> True) \<Longrightarrow> ([Or \<phi> \<psi>]\<nu> \<downharpoonright> True)"
 | rOrT2:"([\<psi>]\<nu> \<downharpoonright> True) \<Longrightarrow> ([Or \<phi> \<psi>]\<nu> \<downharpoonright> True)"
 | rOrF:"\<lbrakk>([\<phi>]\<nu> \<downharpoonright> False) ;([\<psi>]\<nu> \<downharpoonright> False)\<rbrakk> \<Longrightarrow> ([And \<phi> \<psi>]\<nu> \<downharpoonright> False)"
 | rNotT:"([\<phi>]\<nu> \<downharpoonright> False) \<Longrightarrow> ([(Not \<phi>)]\<nu> \<downharpoonright> True)"
 | rNotF:"([\<phi>]\<nu> \<downharpoonright> True) \<Longrightarrow> ([(Not \<phi>)]\<nu> \<downharpoonright> False)"
 
 inductive_simps
     rfsem_Greater_simps[simp]: "([Greater \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<downharpoonright> b)"
 and rfsem_Geq_simps[simp]: "([Geq \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<downharpoonright> b)"
 and rfsem_Equals_simps[simp]: "([Equals \<theta>\<^sub>1 \<theta>\<^sub>2]\<nu> \<downharpoonright> b)"
 and rfsem_And_simps[simp]: "([And \<phi>  \<psi>]\<nu> \<downharpoonright> b)"
 and rfsem_Or_simps[simp]: "([(Or \<phi> \<psi>)]\<nu> \<downharpoonright> b)"
 and rfsem_Not_simps[simp]: "([Not \<phi>]\<nu> \<downharpoonright> b)"
 
 text\<open>Interpretation of a program is a transition relation on states\<close>
 inductive rpsem :: "prog \<Rightarrow> rstate \<Rightarrow>  rstate \<Rightarrow> bool" ("([_]_) \<downharpoonleft> _" 20)
 where
   rTest[simp]:"\<lbrakk>([\<phi>]\<nu> \<downharpoonright> True); \<nu> = \<omega>\<rbrakk> \<Longrightarrow> ([? \<phi>]\<nu> \<downharpoonleft> \<omega>)"
 | rSeq[simp]:"\<lbrakk>([\<alpha>]\<nu> \<downharpoonleft> \<mu>); ([\<beta>]\<mu> \<downharpoonleft> \<omega>)\<rbrakk> \<Longrightarrow> ([\<alpha>;; \<beta>]\<nu> \<downharpoonleft> \<omega>)"
 | rAssign[simp]:"\<lbrakk>([\<theta>]\<nu> \<down> r); \<omega> = (\<nu> (x := r))\<rbrakk> \<Longrightarrow> ([Assign x \<theta>]\<nu> \<downharpoonleft> \<omega>)"
 | rChoice1[simp]:"([\<alpha>]\<nu> \<downharpoonleft> \<omega>) \<Longrightarrow> ([Choice \<alpha> \<beta>]\<nu> \<downharpoonleft> \<omega>)"
 | rChoice2[simp]:"([\<beta>]\<nu> \<downharpoonleft> \<omega>) \<Longrightarrow> ([Choice \<alpha> \<beta>]\<nu> \<downharpoonleft> \<omega>)"
 
 inductive_simps
     rpsem_Test_simps[simp]: "([? \<phi>]\<nu> \<downharpoonleft> b)"
 and rpsem_Seq_simps[simp]: "([\<alpha>;; \<beta>]\<nu> \<downharpoonleft> b)"
 and rpsem_Assign_simps[simp]: "([Assign x \<theta>]\<nu> \<downharpoonleft> b)"
 and rpsem_Choice_simps[simp]: "([Choice \<alpha> \<beta>]\<nu> \<downharpoonleft> b)"
 
 text\<open>Upper bound of arbitrary term\<close>
 fun wtsemU :: "trm \<Rightarrow> wstate \<Rightarrow>  word * word " ("([_]<>_)" 20)
 where "([Const r]<>\<nu>) = (Rep_bword r::word, Rep_bword r)"
 | wVarU:"([Var x]<>\<nu>) = (\<nu> (Inl x), \<nu> (Inr x))"
 | wPlusU:"([Plus \<theta>\<^sub>1 \<theta>\<^sub>2]<> \<nu>) = 
   (let (l1, u1) = [\<theta>\<^sub>1]<> \<nu> in 
    let (l2, u2) = [\<theta>\<^sub>2]<> \<nu> in
    (pl l1 l2, pu u1 u2))"
 | wTimesU:"([(Times \<theta>\<^sub>1 \<theta>\<^sub>2)]<> \<nu>) = 
   (let (l1, u1) = [\<theta>\<^sub>1]<> \<nu> in 
    let (l2, u2) = [\<theta>\<^sub>2]<> \<nu> in
    (tl l1 u1 l2 u2, tu l1 u1 l2 u2))"
 | wMaxU:"([(Max \<theta>\<^sub>1 \<theta>\<^sub>2)]<> \<nu>) = 
   (let (l1, u1) = [\<theta>\<^sub>1]<> \<nu> in 
    let (l2, u2) = [\<theta>\<^sub>2]<> \<nu> in
   (wmax l1 l2, wmax u1 u2))"
 | wMinU:"([(Min \<theta>\<^sub>1 \<theta>\<^sub>2)]<> \<nu>) = 
   (let (l1, u1) = [\<theta>\<^sub>1]<> \<nu> in 
    let (l2, u2) = [\<theta>\<^sub>2]<> \<nu> in
   (wmin l1 l2, wmin u1 u2))"
 | wNegU:"([(Neg \<theta>)]<> \<nu>) =
   (let (l, u) = [\<theta>]<> \<nu> in
    (wneg u, wneg l))"
 | wAbsU:"([(Abs \<theta>\<^sub>1)]<> \<nu>) = 
   (let (l1, u1) = [\<theta>\<^sub>1]<> \<nu> in 
   (wmax l1 (wneg u1), wmax u1 (wneg l1)))"
 
 inductive wfsem :: "formula \<Rightarrow> wstate \<Rightarrow> bool \<Rightarrow> bool" ("([[_]]_ \<down> _)" 20)
 where 
   wGreaterT:"wgreater (fst ([\<theta>\<^sub>1]<>\<nu>)) (snd ([\<theta>\<^sub>2]<>\<nu>)) \<Longrightarrow>  ([[(Greater \<theta>\<^sub>1 \<theta>\<^sub>2)]]\<nu> \<down> True)"
 | wGreaterF:"wgeq (fst ([\<theta>\<^sub>2]<>\<nu>)) (snd ([\<theta>\<^sub>1]<>\<nu>)) \<Longrightarrow>  ([[(Greater \<theta>\<^sub>1 \<theta>\<^sub>2)]]\<nu> \<down> False)"
 | wGeqT:"wgeq (fst ([\<theta>\<^sub>1]<> \<nu>)) (snd ([\<theta>\<^sub>2]<>\<nu>)) \<Longrightarrow>  ([[(Geq \<theta>\<^sub>1 \<theta>\<^sub>2)]]\<nu> \<down> True)"
 | wGeqF:"wgreater (fst ([\<theta>\<^sub>2]<>\<nu>)) (snd ([\<theta>\<^sub>1]<>\<nu>)) \<Longrightarrow>  ([[(Geq \<theta>\<^sub>1 \<theta>\<^sub>2)]]\<nu> \<down> False)"
 | wEqualsT:"\<lbrakk>(fst ([\<theta>\<^sub>2]<>\<nu>) = snd ([\<theta>\<^sub>2]<>\<nu>)); (snd ([\<theta>\<^sub>2]<>\<nu>) = snd ([\<theta>\<^sub>1]<>\<nu>)); 
              (snd ([\<theta>\<^sub>1]<>\<nu>) = fst ([\<theta>\<^sub>1]<>\<nu>)); (fst ([\<theta>\<^sub>2]<>\<nu>) \<noteq> NEG_INF); 
              (fst ([\<theta>\<^sub>2]<>\<nu>) \<noteq> POS_INF)\<rbrakk> 
          \<Longrightarrow> ([[Equals \<theta>\<^sub>1 \<theta>\<^sub>2]] \<nu> \<down> True)"
 | wEqualsF1:"wgreater (fst ([\<theta>\<^sub>1]<> \<nu>)) (snd ([\<theta>\<^sub>2]<>\<nu>)) \<Longrightarrow>  ([[Equals \<theta>\<^sub>1 \<theta>\<^sub>2]] \<nu> \<down> False)"
 | wEqualsF2:"wgreater (fst ([\<theta>\<^sub>2]<> \<nu>)) (snd ([\<theta>\<^sub>1]<>\<nu>)) \<Longrightarrow>  ([[Equals \<theta>\<^sub>1 \<theta>\<^sub>2]] \<nu> \<down> False)"
 | wAndT:"\<lbrakk>[[\<phi>]]\<nu> \<down> True; [[\<psi>]]\<nu> \<down> True\<rbrakk> \<Longrightarrow> ([[And \<phi> \<psi>]]\<nu> \<down> True)"
 | wAndF1:"[[\<phi>]]\<nu> \<down> False \<Longrightarrow> ([[And \<phi> \<psi>]]\<nu> \<down> False)"
 | wAndF2:"[[\<psi>]]\<nu> \<down> False \<Longrightarrow> ([[And \<phi> \<psi>]]\<nu> \<down> False)"
 | wOrT1:"([[\<phi>]]\<nu> \<down> True) \<Longrightarrow> ([[Or \<phi> \<psi>]]\<nu> \<down> True)"
 | wOrT2:"([[\<psi>]]\<nu> \<down> True) \<Longrightarrow> ([[Or \<phi> \<psi>]]\<nu> \<down> True)"
 | wOrF:"\<lbrakk>[[\<phi>]]\<nu> \<down> False; [[\<psi>]]\<nu> \<down> False\<rbrakk> \<Longrightarrow> ([[And \<phi> \<psi>]]\<nu> \<down> False)"
 | wNotT:"([[\<phi>]]\<nu> \<down> False) \<Longrightarrow> ([[Not \<phi>]]\<nu> \<down> True)"
 | wNotF:"([[\<phi>]]\<nu> \<down> True) \<Longrightarrow> ([[Not \<phi>]]\<nu> \<down> False)"
 
 inductive_simps
     wfsem_Gr_simps[simp]: "([[Le \<theta>\<^sub>1 \<theta>\<^sub>2]]\<nu> \<down> b)"
 and wfsem_And_simps[simp]: "([[And \<phi> \<psi>]]\<nu> \<down> b)"
 and wfsem_Or_simps[simp]: "([[Or \<phi> \<psi>]]\<nu> \<down> b)"
 and wfsem_Not_simps[simp]: "([[Not \<phi>]]\<nu> \<down> b)"
 and wfsem_Equals_simps[simp]: "([[Equals \<theta>\<^sub>1 \<theta>\<^sub>2]]\<nu> \<down> b)"
 
 text\<open>Program semantics\<close>
 inductive wpsem :: "prog \<Rightarrow>  wstate \<Rightarrow> wstate \<Rightarrow> bool" ("([[_]]_ \<down> _)" 20)
 where
   wTest:"([[\<phi>]]\<nu> \<down> True) \<Longrightarrow> \<nu> = \<omega> \<Longrightarrow> ([[? \<phi>]] \<nu> \<down> \<omega>)"
 | wSeq:"([[\<alpha>]]\<nu> \<down> \<mu>) \<Longrightarrow> ([[\<beta>]] \<mu> \<down> \<omega>) \<Longrightarrow> ([[\<alpha>;; \<beta>]] \<nu> \<down> \<omega>)"
 | wAssign:"\<omega> = ((\<nu> ((Inr x) := snd([\<theta>]<>\<nu>))) ((Inl x) := fst([\<theta>]<>\<nu>))) \<Longrightarrow> ([[Assign x \<theta>]] \<nu> \<down> \<omega>)"
 | wChoice1[simp]:"([[\<alpha>]]\<nu> \<down> \<omega>) \<Longrightarrow> ([[Choice \<alpha> \<beta>]]\<nu> \<down> \<omega>)"
 | wChoice2[simp]:"([[\<beta>]]\<nu> \<down> \<omega>) \<Longrightarrow> ([[Choice \<alpha> \<beta>]]\<nu> \<down> \<omega>)"
 
 inductive_simps
     wpsem_Test_simps[simp]: "([[Test \<phi>]]\<nu> \<down> b)"
 and wpsem_Seq_simps[simp]: "([[\<alpha>;; \<beta>]]\<nu> \<down> b)"
 and wpsem_Assign_simps[simp]: "([[Assign x \<theta>]]\<nu> \<down> b)"
 and wpsem_Choice_simps[simp]: "([[Choice \<alpha> \<beta>]]\<nu> \<down> b)"
 
 lemmas real_max_mono =  Lattices.linorder_class.max.mono  
 lemmas real_minus_le_minus = Groups.ordered_ab_group_add_class.neg_le_iff_le
 
 text\<open>Interval state consists of upper and lower bounds for each real variable\<close>
 inductive represents_state::"wstate \<Rightarrow> rstate \<Rightarrow> bool" (infix "REP" 10)
 where REPI:"(\<And>x. (\<nu> (Inl x) \<equiv>\<^sub>L \<nu>' x) \<and> (\<nu> (Inr x) \<equiv>\<^sub>U \<nu>' x)) \<Longrightarrow> (\<nu> REP \<nu>')"
 
 inductive_simps repstate_simps:"\<nu> REP \<nu>'"
 
 section\<open>Soundness proofs\<close>
 text\<open>Interval term valuation soundly contains real valuation\<close>
 lemma trm_sound:
   fixes \<theta>::"trm"
   shows "([\<theta>]\<nu>' \<down> r) \<Longrightarrow> (\<nu> REP \<nu>') \<Longrightarrow>   ([\<theta>]<>\<nu>) \<equiv>\<^sub>P r"
 proof (induction rule: rtsem.induct)
  case rtsem_Const 
    fix w r \<nu>'
    show "Rep_bword w \<equiv>\<^sub>E r \<Longrightarrow> \<nu> REP \<nu>' \<Longrightarrow> [Const w]<>\<nu> \<equiv>\<^sub>P r"
      using repU_def repL_def repP_def repe.simps rep_simps repstate_simps 
      by auto
 next
  case rtsem_Var
    fix x \<nu>'
    show "\<nu> REP \<nu>' \<Longrightarrow> [Var x]<>\<nu> \<equiv>\<^sub>P \<nu>' x"
    by(auto simp add: repU_def repL_def repP_def repe.simps rep_simps repstate_simps)
 next
  case rtsem_Plus
    fix \<theta>\<^sub>1 :: "trm" and \<nu>':: "rstate" and r1 and \<theta>\<^sub>2 :: "trm" and  r2
    assume rep:"\<nu> REP \<nu>'"
    assume eval1:"[\<theta>\<^sub>1]\<nu>' \<down> r1"
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1)"
    then have IH1:"[\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1" using rep by auto
    assume eval2:"[\<theta>\<^sub>2]\<nu>' \<down> r2"
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2)"
    then have IH2:"[\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2" using rep by auto
    obtain l1 u1 l2 u2 where 
         lu1:"(l1, u1) = ([\<theta>\<^sub>1]<> \<nu>)" 
     and lu2:"(l2, u2) = ([\<theta>\<^sub>2]<> \<nu>)"
     using IH1 IH2 repP_def by auto
    from lu1 and lu2 have
         lu1':"([\<theta>\<^sub>1]<> \<nu>) = (l1, u1)" 
     and lu2':"([\<theta>\<^sub>2]<> \<nu>) = (l2, u2)"
     by auto
   have l1:"l1 \<equiv>\<^sub>L r1" using IH1 lu1 unfolding repP_def by auto
   have u1:"u1 \<equiv>\<^sub>U r1" using IH1 lu1 unfolding repP_def by auto
   have l2:"l2 \<equiv>\<^sub>L r2" using IH2 lu2 unfolding repP_def by auto
   have u2:"u2 \<equiv>\<^sub>U r2" using IH2 lu2 unfolding repP_def by auto
   then have "([(Plus \<theta>\<^sub>1 \<theta>\<^sub>2)]<>\<nu>) = (pl l1 l2, pu u1 u2)"  
    using lu1' lu2' by auto
   have lBound:"(pl l1 l2 \<equiv>\<^sub>L r1 + r2)"
     using l1 l2 pl_lemma by auto
   have uBound:"(pu u1 u2 \<equiv>\<^sub>U r1 + r2)"
     using pu_lemma[OF u1 u2] by auto
   have "(pl l1 l2, pu u1 u2) \<equiv>\<^sub>P (r1 + r2)"
     unfolding repP_def Let_def using lBound uBound by auto
   then show"[Plus \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r1 + r2"
     using lu1' lu2' by auto
 next
  case rtsem_Times
    fix \<theta>\<^sub>1 :: "trm" and \<nu>' r1 and \<theta>\<^sub>2 :: "trm" and r2
    assume eval1:"[\<theta>\<^sub>1]\<nu>' \<down> r1"
    assume eval2:"[\<theta>\<^sub>2]\<nu>' \<down> r2"
    assume rep:"\<nu> REP \<nu>'"
    assume "(\<nu> REP \<nu>' \<Longrightarrow> ([\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1))"
    then have IH1:"[\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1" using rep by auto 
    assume "(\<nu> REP \<nu>' \<Longrightarrow> ([\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2))"
    then have IH2:"[\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2" using rep by auto
     obtain l1 u1 l2 u2 where 
         lu1:"([\<theta>\<^sub>1]<> \<nu>) = (l1, u1) " 
     and lu2:"([\<theta>\<^sub>2]<> \<nu>) = (l2, u2)"
     using IH1 IH2 repP_def by auto
   have l1:"l1 \<equiv>\<^sub>L r1" using IH1 lu1 unfolding repP_def by auto
   have u1:"u1 \<equiv>\<^sub>U r1" using IH1 lu1 unfolding repP_def by auto
   have l2:"l2 \<equiv>\<^sub>L r2" using IH2 lu2 unfolding repP_def by auto
   have u2:"u2 \<equiv>\<^sub>U r2" using IH2 lu2 unfolding repP_def by auto
   then have "([(Times \<theta>\<^sub>1  \<theta>\<^sub>2)]<>\<nu>) = (tl l1 u1 l2 u2, tu l1 u1 l2 u2)"  
    using lu1 lu2 unfolding wTimesU Let_def by auto 
   have lBound:"(tl l1 u1 l2 u2 \<equiv>\<^sub>L r1 * r2)"
     using l1 u1 l2 u2 tl_lemma by auto
   have uBound:"(tu l1 u1 l2 u2 \<equiv>\<^sub>U r1 * r2)"
     using l1 u1 l2 u2 tu_lemma by auto
   have "(tl l1 u1 l2 u2, tu l1 u1 l2 u2) \<equiv>\<^sub>P (r1 * r2)"
     unfolding repP_def Let_def using lBound uBound by auto
   then show "[Times \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r1 * r2"
     using lu1 lu2 by auto
 next
  case rtsem_Max
    fix \<theta>\<^sub>1 :: "trm" and \<nu>' r1 and \<theta>\<^sub>2 :: "trm" and  r2
    assume eval1:"([\<theta>\<^sub>1]\<nu>' \<down> r1)"
    assume eval2:"([\<theta>\<^sub>2]\<nu>' \<down> r2)"
    assume rep:"\<nu> REP \<nu>'"
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1)"
    then have IH1:"[\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1" using rep by auto
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2)"
    then have IH2:"[\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2" using rep by auto
    obtain l1 u1 l2 u2 where 
         lu1:"([\<theta>\<^sub>1]<> \<nu>) = (l1, u1)" 
     and lu2:"([\<theta>\<^sub>2]<> \<nu>) = (l2, u2)"
     using IH1 IH2 repP_def by auto
    from IH1 IH2 
    obtain ub1 ub2 lb1 lb2:: real 
    where urep1:"(ub1 \<ge> r1) \<and> (snd ([\<theta>\<^sub>1]<>\<nu>) \<equiv>\<^sub>E ub1)" 
    and   urep2:"(ub2 \<ge> r2) \<and> (snd ([\<theta>\<^sub>2]<>\<nu>) \<equiv>\<^sub>E ub2)"
    and   lrep1:"(lb1 \<le> r1) \<and> (fst ([\<theta>\<^sub>1]<>\<nu>) \<equiv>\<^sub>E lb1)" 
    and   lrep2:"(lb2 \<le> r2) \<and> (fst ([\<theta>\<^sub>2]<>\<nu>) \<equiv>\<^sub>E lb2)"
      using repP_def repU_def repL_def by auto
    have lbound:"wmax l1 l2 \<equiv>\<^sub>L max r1 r2"
      by (metis dual_order.trans fst_conv le_cases lrep1 lrep2 lu1 lu2 max_def repL_def wmax.elims)
    have ubound:"wmax u1 u2 \<equiv>\<^sub>U max r1 r2"     
      by (metis real_max_mono lu1 lu2 repU_def snd_conv urep1 urep2 wmax_lemma)
    have "([trm.Max \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu>) = (wmax l1 l2, wmax u1 u2)"
      using lu1 lu2 unfolding wMaxU Let_def 
      by (simp)
    then show "[trm.Max \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P max r1 r2"
     unfolding repP_def
     using lbound ubound lu1 lu2 by auto
 next
   case rtsem_Min
     fix \<theta>\<^sub>1 :: "trm" and \<nu>' r1 and \<theta>\<^sub>2 :: "trm" and  r2
    assume eval1:"([\<theta>\<^sub>1]\<nu>' \<down> r1)"
    assume eval2:"([\<theta>\<^sub>2]\<nu>' \<down> r2)"
    assume rep:"\<nu> REP \<nu>'"
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1)"
    then have IH1:"[\<theta>\<^sub>1]<>\<nu> \<equiv>\<^sub>P r1" using rep by auto
    assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2)"
    then have IH2:"[\<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P r2" using rep by auto
    obtain l1 u1 l2 u2 where 
         lu1:"([\<theta>\<^sub>1]<> \<nu>) = (l1, u1)" 
     and lu2:"([\<theta>\<^sub>2]<> \<nu>) = (l2, u2)"
     using IH1 IH2 repP_def by auto
    from IH1 IH2 
    obtain ub1 ub2 lb1 lb2:: real 
    where urep1:"(ub1 \<ge> r1) \<and> (snd ([\<theta>\<^sub>1]<>\<nu>) \<equiv>\<^sub>E ub1)" 
    and   urep2:"(ub2 \<ge> r2) \<and> (snd ([\<theta>\<^sub>2]<>\<nu>) \<equiv>\<^sub>E ub2)"
    and   lrep1:"(lb1 \<le> r1) \<and> (fst ([\<theta>\<^sub>1]<>\<nu>) \<equiv>\<^sub>E lb1)" 
    and   lrep2:"(lb2 \<le> r2) \<and> (fst ([\<theta>\<^sub>2]<>\<nu>) \<equiv>\<^sub>E lb2)"
      using prod.case_eq_if repP_def  repU_def repL_def by auto
    have lbound:"wmin l1 l2 \<equiv>\<^sub>L min r1 r2"
      by (metis fst_conv lrep1 lrep2 lu1 lu2 min.mono repL_def wmin_lemma)
    have ubound:"wmin u1 u2 \<equiv>\<^sub>U min r1 r2"     
      using lu1 lu2 min_le_iff_disj repU_def urep1 urep2 by auto
    have "([Min \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu>) = (wmin l1 l2, wmin u1 u2)"
      using lu1 lu2 unfolding wMinU Let_def by auto
   then show "[Min \<theta>\<^sub>1 \<theta>\<^sub>2]<>\<nu> \<equiv>\<^sub>P min r1 r2"
     unfolding repP_def
     using lbound ubound lu1 lu2 by auto
 next
   case rtsem_Neg
   fix \<theta> :: "trm" and \<nu>' r
   assume eval:"[\<theta>]\<nu>' \<down> r"
   assume rep:"\<nu> REP \<nu>'"
   assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>]<>\<nu> \<equiv>\<^sub>P r)"
   then have IH:"[\<theta>]<>\<nu> \<equiv>\<^sub>P r" using rep by auto
   obtain l1 u1  where 
         lu:"([\<theta>]<> \<nu>) = (l1, u1)" 
     using IH repP_def by auto
   from IH 
   obtain ub lb:: real 
    where urep:"(ub \<ge> r) \<and> (snd ([\<theta>]<>\<nu>) \<equiv>\<^sub>E ub)" 
    and   lrep:"(lb \<le> r) \<and> (fst ([\<theta>]<>\<nu>) \<equiv>\<^sub>E lb)" 
     using  repP_def repU_def repL_def by auto
   have ubound:"((wneg u1) \<equiv>\<^sub>L (uminus r))"
     by (metis real_minus_le_minus lu repL_def snd_conv urep wneg_lemma)
   have lbound:"((wneg l1) \<equiv>\<^sub>U (uminus r))"
     using real_minus_le_minus lu repU_def lrep wneg_lemma
     by (metis fst_conv)
   show "[Neg \<theta>]<>\<nu> \<equiv>\<^sub>P - r"
     unfolding repP_def Let_def using ubound lbound lu 
     by (auto)
 next
   case rtsem_Abs
   fix \<theta> :: "trm" and \<nu>' r
   assume eval:"[\<theta>]\<nu>' \<down> r"
   assume rep:"\<nu> REP \<nu>'"
   assume "(\<nu> REP \<nu>' \<Longrightarrow> [\<theta>]<>\<nu> \<equiv>\<^sub>P r)"
   then have IH:"[\<theta>]<>\<nu> \<equiv>\<^sub>P r" using rep by auto
   obtain l1 u1  where 
         lu:"([\<theta>]<> \<nu>) = (l1, u1)" 
     using IH repP_def by auto
   from IH 
   obtain ub lb:: real 
    where urep:"(ub \<ge> r) \<and> (snd ([\<theta>]<>\<nu>) \<equiv>\<^sub>E ub)" 
    and   lrep:"(lb \<le> r) \<and> (fst ([\<theta>]<>\<nu>) \<equiv>\<^sub>E lb)" 
     using prod.case_eq_if repP_def  repU_def repL_def by auto
   have lbound:"wmax l1 (wneg u1) \<equiv>\<^sub>L (abs r)"
     apply(simp only: repL_def)
     apply(rule exI[where x="max lb (- ub)"])
     apply(rule conjI)  
     using lrep wmax_lemma lu urep wneg_lemma by auto
   have ubound:"(wmax u1 (wneg l1) \<equiv>\<^sub>U (abs r))"
     apply(simp only: repU_def)
     apply(rule exI[where x="max ub (- lb)"])
     using lrep wmax_lemma lu urep wneg_lemma by auto 
   show "[Abs \<theta>]<>\<nu> \<equiv>\<^sub>P abs r"
     using repP_def Let_def ubound lbound lu lu wAbsU by auto
 qed
 
 text\<open>Every word represents some real\<close>
 lemma word_rep:"\<And>bw::bword. \<exists>r::real. Rep_bword bw \<equiv>\<^sub>E r"
 proof -
   fix bw
   obtain w where weq:"w = Rep_bword bw" by auto
   have negInfCase:"w = NEG_INF \<Longrightarrow> ?thesis bw"
    apply(rule exI[where x="-((2 ^ 31) -1)"])
     using weq by (auto simp add: repe.simps)
   have posInfCase:"w = POS_INF \<Longrightarrow> ?thesis bw"
     apply(rule exI[where x="((2 ^ 31) -1)"])
     using weq by (auto simp add: repe.simps)
   have boundU:"w \<noteq> NEG_INF \<Longrightarrow> w \<noteq> POS_INF \<Longrightarrow> sint (Rep_bword bw) < sint POS_INF"
     using Rep_bword weq
     by (metis (no_types, lifting) mem_Collect_eq min.absorb_iff2 min_def not_le 
         Word.word_sint.Rep_eqD)
   have boundL:"w \<noteq> NEG_INF \<Longrightarrow> w \<noteq> POS_INF \<Longrightarrow> sint NEG_INF < sint (Rep_bword bw)"
     using Rep_bword weq
     by (metis (no_types, lifting) mem_Collect_eq min.absorb_iff2 min_def not_le 
         Word.word_sint.Rep_eqD)
   have intCase:"w \<noteq> NEG_INF \<Longrightarrow> w \<noteq> POS_INF \<Longrightarrow> ?thesis bw"
     apply(rule exI[where x=" (real_of_int (sint (Rep_bword bw)))"])
     apply(rule repINT)
     using boundU boundL by(auto)
   then show "?thesis bw"
     apply(cases "w = POS_INF")
      apply(cases "w = NEG_INF")
       using posInfCase intCase negInfCase by auto
   qed
 
 text\<open>Every term has a value\<close>
 lemma eval_tot:"(\<exists>r. ([\<theta>::trm]\<nu>' \<down> r))"
 proof (induction "\<theta>")
 qed (auto simp add: Min_def word_rep bword_neg_one_def, blast?)
 
 text\<open>Interval formula semantics soundly implies real semantics\<close>
 lemma fml_sound:
   fixes \<phi>::"formula" and \<nu>::"wstate"
   shows "(wfsem \<phi> \<nu> b) \<Longrightarrow>  (\<nu> REP \<nu>') \<Longrightarrow> (rfsem \<phi> \<nu>'  b)"
 proof (induction arbitrary: \<nu>' rule: wfsem.induct)
 case (wGreaterT t1 v t2 w)
   assume wle:"wgreater (fst ([t1]<>v)) (snd ([t2]<>v))"
   assume rep:"v REP w" 
   obtain r1 and r2 where eval1:"[t1]w \<down> r1" and  eval2:"[t2]w \<down> r2"
     using eval_tot[of t1 w] eval_tot[of t2 w] by (auto)
   note rep1 = trm_sound[of t1 w r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 w r2, where \<nu>=v, OF eval2 rep]
   show "[Greater t1 t2]w \<downharpoonright> True"
     apply(rule rGreaterT[where ?r1.0 = r1, where ?r2.0 = r2]) 
     prefer 3
     apply(rule wgreater_lemma[where ?w1.0="fst([t1]<> v)", where ?w2.0="snd([t2]<> v)"])
     using rep1 rep2 wle repP_def repL_def repU_def  eval1 eval2 
     by ((simp add: prod.case_eq_if | blast)+)
 next
   case (wGreaterF t2 v t1 v')
   assume wl:"wgeq (fst ([t2]<>v)) (snd ([t1]<>v))"
   assume rep:"v REP v'"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
     eval2:"rtsem t2 v' r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v']  by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Greater t1 t2]v' \<downharpoonright> False"
     apply(rule rGreaterF [of t1 v' r1 t2 r2])
     apply(rule eval1)
      apply(rule eval2)
     apply(rule wgeq_lemma[where ?w1.0="fst([t2]<> v)", where ?w2.0="snd([t1]<> v)"])
     using rep1 rep2 repP_def wgeq_lemma wl rep
     by auto
 next
   case (wGeqT t1 v t2 v')
   assume a1:"wgeq (fst ([t1]<>v)) (snd ([t2]<>v))"
   assume rep:"v REP v'"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
     eval2:"rtsem t2 v' r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v']  by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Geq t1 t2]v' \<downharpoonright> True"
     apply(rule rGeqT)
       apply(rule eval1)
     apply(rule eval2)
   using wgeq_lemma eval1 eval2 rep1 rep2 unfolding repP_def Let_def
   using wgreater_lemma prod.case_eq_if a1
   by auto
 next
   case (wGeqF t2 v t1 v')
   assume a1:"wgreater (fst ([t2]<>v)) (snd ([t1]<>v))"
   assume rep:"v REP v'"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
     eval2:"rtsem t2 v'  r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v'] by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Geq t1 t2]v' \<downharpoonright> False"
     apply(rule rGeqF, rule eval1, rule eval2)
   using wgeq_lemma eval1 eval2 rep1 rep2 unfolding repP_def Let_def
   using wgreater_lemma rGreaterF prod.case_eq_if a1 rGreaterF by auto
 next
   case (wEqualsT t2 v t1 v')
   assume eq1:"fst ([t2]<>v) = snd ([t2]<>v)"
   assume eq2:"snd ([t2]<>v) = snd ([t1]<>v)"
   assume eq3:"snd ([t1]<>v) = fst ([t1]<>v)"
   assume rep:"v REP v'"  
   assume neq1:"fst ([t2]<>v) \<noteq> NEG_INF"
   assume neq2:"fst ([t2]<>v) \<noteq> POS_INF"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
         eval2:"rtsem t2 v'  r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v'] by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Equals t1 t2]v' \<downharpoonright> True"
     apply(rule rEqualsT, rule eval1, rule eval2)
     using eq1 eq2 eq3 eval1 eval2 rep1 rep2
     unfolding repP_def Let_def repL_def repU_def repe.simps using neq1 neq2 by auto
 next
   case (wEqualsF1 t1 v t2 v')
   assume wle:"wgreater (fst ([t1]<>v)) (snd ([t2]<>v))"
   assume rep:"v REP v'"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
     eval2:"rtsem t2 v'  r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v'] by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Equals t1 t2]v' \<downharpoonright> False"
   apply(rule rEqualsF, rule eval1, rule eval2)
     using wgeq_lemma eval1 eval2 rep1 rep2 wgreater_lemma rGreaterF  prod.case_eq_if wle
     unfolding repP_def
     by (metis (no_types, lifting) less_irrefl) 
 next
   case (wEqualsF2 t2 v t1 v')
   assume wle:"wgreater (fst ([t2]<>v)) (snd ([t1]<>v))"
   assume rep:"v REP v'"
   obtain r1 r2:: real
   where eval1:"(rtsem t1 v' r1)" and  
     eval2:"rtsem t2 v'  r2"
     using eval_tot[of t1 v'] eval_tot[of t2 v'] by (auto)
   note rep1 = trm_sound[of t1 v' r1, where \<nu>=v, OF eval1 rep]
   note rep2 = trm_sound[of t2 v' r2, where \<nu>=v, OF eval2 rep]
   show "[Equals t1 t2]v' \<downharpoonright> False"
     apply(rule rEqualsF, rule eval1, rule eval2)
     using wgeq_lemma eval1 eval2 rep1 rep2  wgreater_lemma rGreaterF prod.case_eq_if wle
     unfolding repP_def
     by (metis (no_types, lifting) less_irrefl)
 qed (auto)
   
 lemma rep_upd:"\<omega> = (\<nu>(Inr x := snd([\<theta>]<>\<nu>)))(Inl x := fst([\<theta>]<>\<nu>))
 \<Longrightarrow> \<nu> REP \<nu>' \<Longrightarrow> ([\<theta>::trm]\<nu>' \<down> r) \<Longrightarrow> \<omega> REP \<nu>'(x := r)"
   apply(rule REPI)
   apply(rule conjI)
    apply(unfold repL_def)
    using trm_sound prod.case_eq_if repP_def repstate_simps repL_def 
    apply(metis (no_types, lifting) Inl_Inr_False fun_upd_apply sum.inject(1))
   using repP_def repstate_simps repU_def
   apply(auto simp add: repU_def)
   by (metis (full_types) surjective_pairing trm_sound)
 
 text\<open>Interval program semantics soundly contains real semantics existentially\<close>
 theorem interval_program_sound:
   fixes \<alpha>::"prog"
   shows "([[\<alpha>]] \<nu> \<down> \<omega>)  \<Longrightarrow> \<nu> REP \<nu>' \<Longrightarrow> (\<exists>\<omega>'. (\<omega> REP \<omega>') \<and> ([\<alpha>] \<nu>' \<downharpoonleft> \<omega>'))"
 proof (induction arbitrary: \<nu>' rule: wpsem.induct)
   case (wTest \<phi> \<nu> \<omega> \<nu>') 
   assume sem:"[[\<phi>]]\<nu> \<down> True"
   and eq:"\<nu> = \<omega>"
   and rep:"\<nu> REP \<nu>'"
   show ?case 
     apply(rule exI[where x=\<nu>'])
     using sem rep by (auto simp add: eq fml_sound rep)
 next
   case (wAssign \<omega> \<nu> x \<theta> \<nu>') 
   assume eq:"\<omega> = \<nu>(Inr x := snd ([\<theta>]<>\<nu>), Inl x := fst ([\<theta>]<>\<nu>))"
   and rep:"\<nu> REP \<nu>'"
   obtain r::real where eval:"([\<theta>::trm]\<nu>' \<down> r)" using eval_tot  by auto
   show ?case 
     apply(rule exI[where x="\<nu>'(x := r)"])
     apply(rule conjI)
     apply(rule rep_upd[OF eq rep eval])
     apply auto
     apply(rule exI[where x=r])
     by (auto simp add: eval)
 next case (wSeq \<alpha> \<nu> \<mu> \<beta> \<omega> \<nu>') then show ?case by (simp, blast)
 next case (wChoice1 a v w b v') then show ?case by auto
 next case (wChoice2 a v w b v') then show ?case by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Interval_Arithmetic_Word32/Interval_Word32.thy b/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
--- a/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
+++ b/thys/Interval_Arithmetic_Word32/Interval_Word32.thy
@@ -1,3885 +1,3886 @@
 (* Author:     Brandon Bohrer *)
 theory Interval_Word32
 imports
   Complex_Main
+  "HOL-Word.More_Word"
   Word_Lib.Word_Lemmas
   Word_Lib.Word_Lib
   Word_Lib.Word_Syntax
   Word_Lib.Bitwise
 begin
 
 text\<open>Interval-Word32.thy implements conservative interval arithmetic operators on 32-bit word 
    values, with explicit infinities for values outside the representable bounds. It is suitable 
    for use in interpreters for languages which  must have a well-understood low-level behavior
    (see Interpreter.thy). This work was originally part of the paper by Bohrer \emph{et al.}~\cite{BohrerTMMP18}.
 
    It is worth noting that this is not the first formalization of interval arithmetic in 
    Isabelle/HOL. This article is presented regardless because it has unique goals in mind
    which have led to unique design decisions. Our goal is generate code which can be used to 
    perform conservative arithmetic in implementations extracted from a proof.
 
    The Isabelle standard library now features interval arithmetic, for example in Approximation.thy.
    Ours differs in two ways:
    1) We use intervals with explicit positive and negative infinities, and with overflow checking.
       Such checking is often relevant in implementation-level code with unknown inputs.
       To promote memory-efficient implementations, we moreover use sentinel values for infinities,
       rather than datatype constructors. This is especially important in real-time settings where
       the garbarge collection required for datatypes can be a concern.
    2) Our goal is not to use interval arithmetic to discharge Isabelle goals, but to generate useful
       proven-correct implementation code, see Interpreter.thy. On the other hand,  we are not 
       concerned with producing interval-based automation for arithmetic goals in HOL.
 
    In practice, much of the work in this theory comes down to sheer case-analysis.
    Bounds-checking requires many edge cases in arithmetic functions, which come with many cases in
    proofs. Where possible, we attempt to offload interesting facts about word representations of 
    numbers into reusable lemmas, but even then main results require many subcases, each with 
    a certain amount of arithmetic grunt work.
 \<close>
 
 section \<open>Interval arithmetic definitions\<close>
 subsection \<open>Syntax\<close>
 text\<open>Words are 32-bit\<close>
 type_synonym word = "32 Word.word"
 
 text\<open>Sentinel values for infinities. Note that we leave the maximum value ($2^31$) 
   completed unused, so that negation of $(2^{31})-1$ is not an edge case\<close>
 definition NEG_INF::"word"
 where NEG_INF_def[simp]:"NEG_INF = -((2 ^ 31) -1)"
 
 definition NegInf::"real"
 where NegInf[simp]:"NegInf = real_of_int (sint NEG_INF)"
 
 definition POS_INF::"word"
 where POS_INF_def[simp]:"POS_INF = (2^31) - 1"
 
 definition PosInf::"real"
 where PosInf[simp]:"PosInf = real_of_int (sint POS_INF)"
 
 text\<open>Subtype of words who represent a finite value. \<close>
 typedef bword = "{n::word. sint n \<ge> sint NEG_INF \<and> sint n \<le> sint POS_INF}"
   apply(rule exI[where x=NEG_INF])
   by (auto)
 
 text\<open>Numeric literals\<close>
 type_synonym lit = bword
       
 setup_lifting type_definition_bword
 
 lift_definition bword_zero::"bword" is "0::32 Word.word"
   by auto
 
 lift_definition bword_one::"bword" is "1::32 Word.word"
   by(auto simp add: sint_uint)
 
 lift_definition bword_neg_one::"bword" is "-1::32 Word.word"
   by(auto)
 
 
 definition word::"word \<Rightarrow> bool"
 where word_def[simp]:"word w \<equiv> w \<in> {NEG_INF..POS_INF}"
 
 
 named_theorems rep_simps "Simplifications for representation functions"
 
 text\<open>Definitions of interval containment and word representation
 repe w r iff word w encodes real number r\<close>
 inductive repe ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>E" 10)
 where 
   repPOS_INF:"r \<ge> real_of_int (sint POS_INF) \<Longrightarrow> repe POS_INF r" 
 | repNEG_INF:"r \<le> real_of_int (sint NEG_INF) \<Longrightarrow> repe NEG_INF r"
 | repINT:"(sint w) < real_of_int(sint POS_INF) \<Longrightarrow> (sint w) > real_of_int(sint NEG_INF) 
     \<Longrightarrow> repe w (sint w)"
 
 inductive_simps 
     repePos_simps[rep_simps]:"repe POS_INF r"
 and repeNeg_simps[rep_simps]:"repe NEG_INF r"
 and repeInt_simps[rep_simps]:"repe w (sint w)"
 
 text\<open>repU w r if w represents an upper bound of r\<close>
 definition repU ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>U" 10)
 where "repU w r \<equiv> \<exists> r'. r' \<ge> r \<and> repe w r'"
 
 lemma repU_leq:"repU w r \<Longrightarrow> r' \<le> r \<Longrightarrow> repU w r'"
   unfolding repU_def
   using order_trans by auto
 
 text\<open>repU w r if w represents a lower bound of r\<close>
 definition repL ::"word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>L" 10)
 where "repL w r \<equiv> \<exists> r'. r' \<le> r \<and> repe w r'"
 
 lemma repL_geq:"repL w r \<Longrightarrow> r' \<ge> r \<Longrightarrow> repL w r'"
   unfolding repL_def
   using order_trans by auto
 
 text\<open>repP (l,u) r  iff l and u encode lower and upper bounds of r\<close>
 definition repP ::"word * word \<Rightarrow> real \<Rightarrow> bool" (infix "\<equiv>\<^sub>P" 10)
 where "repP w r \<equiv> let (w1, w2) = w in repL w1 r \<and> repU w2 r" 
 
 
 lemma int_not_posinf:
   assumes b1:"real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) <  real_of_int (sint ra)"
   shows "ra \<noteq> POS_INF"
   using b1 b2 by auto
         
 lemma int_not_neginf:
   assumes b1:" real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:" real_of_int (sint NEG_INF) <  real_of_int (sint ra)"
   shows "ra \<noteq> NEG_INF"
   using b1 b2 by auto
 
 lemma int_not_undef:
   assumes b1:"real_of_int (sint ra) <  real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) < real_of_int (sint ra)"
   shows "ra \<noteq> NEG_INF-1"
   using b1 b2  by auto
 
 lemma sint_range:
   assumes b1:"real_of_int (sint ra) < real_of_int (sint POS_INF)"
   assumes b2:"real_of_int (sint NEG_INF) < real_of_int (sint ra)"
   shows "sint ra  \<in> {i. i > -((2^31)-1)  \<and> i < (2^31)-1}"
   using b1 b2 by auto
 
 lemma word_size_neg:
   fixes w :: "32 Word.word"
   shows "size (-w) = size w"
   using Word.word_size[of w] Word.word_size[of "-w"] by auto
 
 lemma uint_distinct:
   fixes w1 w2
   shows "w1 \<noteq> w2 \<Longrightarrow> uint w1 \<noteq> uint w2"
   by auto
 
 section \<open>Preliminary lemmas\<close>
 subsection \<open>Case analysis lemmas\<close>
 text\<open>Case analysis principle for pairs of intervals, used in proofs of arithmetic operations\<close>
 lemma ivl_zero_case:
   fixes l1 u1 l2 u2 :: real
   assumes ivl1:"l1 \<le> u1"
   assumes ivl2:"l2 \<le> u2"
   shows 
 "(l1 \<le> 0 \<and> 0 \<le> u1 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(l1 \<le> 0 \<and> 0 \<le> u1 \<and> 0 \<le> l2)
 \<or>(l1 \<le> 0 \<and> 0 \<le> u1 \<and> u2 \<le> 0)
 \<or>(0 \<le> l1 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(u1 \<le> 0 \<and> l2 \<le> 0 \<and> 0 \<le> u2)
 \<or>(u1 \<le> 0 \<and> u2 \<le> 0)
 \<or>(u1 \<le> 0 \<and> 0 \<le> l2)
 \<or>(0 \<le> l1 \<and> u2 \<le> 0)
 \<or>(0 \<le> l1 \<and> 0 \<le> l2)"
 using ivl1 ivl2 
 by (metis le_cases)
 
 lemma case_ivl_zero
 [consumes 2, case_names ZeroZero ZeroPos ZeroNeg PosZero NegZero NegNeg NegPos PosNeg PosPos]:
   fixes l1 u1 l2 u2 :: real
   shows
   "l1 \<le> u1 \<Longrightarrow>
    l2 \<le> u2 \<Longrightarrow> 
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow>
 ((l1 \<le> 0 \<and> 0 \<le> u1 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
  ((0 \<le> l1 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> l2 \<le> 0 \<and> 0 \<le> u2) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
 ((u1 \<le> 0 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow>
 ((0 \<le> l1 \<and> u2 \<le> 0) \<Longrightarrow> P) \<Longrightarrow>
 ((0 \<le> l1 \<and> 0 \<le> l2) \<Longrightarrow> P) \<Longrightarrow> P"
   using ivl_zero_case[of l1 u1 l2 u2]
   by auto
 
 lemma case_inf2[case_names PosPos PosNeg PosNum NegPos NegNeg NegNum NumPos NumNeg NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = POS_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma case_pu_inf[case_names PosAny AnyPos NegNeg NegNum NumNeg NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma case_pl_inf[case_names NegAny AnyNeg PosPos PosNum NumPos NumNum]:
   shows 
   "\<And>w1 w2 P.
       (w1 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w2 = NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 = POS_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 = POS_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> (w1 \<noteq> POS_INF \<Longrightarrow> w1 \<noteq> NEG_INF \<Longrightarrow> w2 \<noteq> POS_INF \<Longrightarrow> w2 \<noteq> NEG_INF \<Longrightarrow> P w1 w2)
   \<Longrightarrow> P w1 w2"
   by(auto)
 
 lemma word_trichotomy[case_names Less Equal Greater]:
   fixes w1 w2 :: word
   shows 
   "(w1 <s w2 \<Longrightarrow> P w1 w2) \<Longrightarrow>
    (w1 = w2  \<Longrightarrow> P w1 w2) \<Longrightarrow>
    (w2 <s w1 \<Longrightarrow> P w1 w2) \<Longrightarrow> P w1 w2"
   using signed.linorder_cases by auto
 
 lemma case_times_inf
  [case_names 
   PosPos NegPos PosNeg NegNeg 
   PosLo PosHi PosZero NegLo NegHi NegZero
   LoPos HiPos ZeroPos LoNeg HiNeg ZeroNeg
   AllFinite]:
   fixes w1 w2 P
   assumes pp:"(w1 = POS_INF \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and np:"(w1 = NEG_INF \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and pn:"(w1 = POS_INF \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and nn:"(w1 = NEG_INF \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and pl:"(w1 = POS_INF \<and> w2 \<noteq> NEG_INF \<and> w2 <s 0 \<Longrightarrow> P w1 w2)"
   and ph:"(w1 = POS_INF \<and> w2 \<noteq> POS_INF \<and> 0 <s w2   \<Longrightarrow> P w1 w2)"
   and pz:"(w1 = POS_INF \<and> w2 = 0 \<Longrightarrow> P w1 w2)"
   and nl:"(w1 = NEG_INF \<and> w2 \<noteq> NEG_INF \<and> w2 <s 0 \<Longrightarrow> P w1 w2)"
   and nh:"(w1 = NEG_INF \<and> w2 \<noteq> POS_INF \<and> 0 <s w2 \<Longrightarrow> P w1 w2)"
   and nz:"(w1 = NEG_INF \<and> 0 = w2 \<Longrightarrow> P w1 w2)"
   and lp:"(w1 \<noteq> NEG_INF \<and> w1 <s 0 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and hp:"(w1 \<noteq> POS_INF \<and> 0 <s w1 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and zp:"(0 = w1 \<and> w2 = POS_INF \<Longrightarrow> P w1 w2)"
   and ln:"(w1 \<noteq> NEG_INF \<and> w1 <s 0 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and hn:"(w1 \<noteq> POS_INF \<and> 0 <s w1 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and zn:"(0 = w1 \<and> w2 = NEG_INF \<Longrightarrow> P w1 w2)"
   and allFinite:"w1 \<noteq> NEG_INF \<and> w1 \<noteq> POS_INF \<and> w2 \<noteq> NEG_INF \<and> w2 \<noteq> POS_INF \<Longrightarrow> P w1 w2"
   shows " P w1 w2"
   proof (cases rule: word_trichotomy[of w1 0])
     case Less then have w1l:"w1 <s 0" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis 
         using nn nl ln nz zn allFinite w1l lp pl by blast
     next
       case Equal 
       then show ?thesis
         using nn nl ln nz zn  w1l allFinite lp pz
         by (auto)
     next
       case Greater
       then show ?thesis
         using  nh np zp lp w1l allFinite ln ph
         by (auto)
     qed
   next
     case Equal then have w1z:"w1 = 0" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis
         using zn allFinite w1z nl pl zp by auto
     next
       case Equal
       then show ?thesis
         using w1z allFinite
         by (auto)
     next
       case Greater
       then show ?thesis
         using allFinite zp w1z nh ph zn by auto
     qed
   next
     case Greater then have w1h:"0 <s w1" by auto
     then show ?thesis
     proof (cases rule: word_trichotomy[of w2 0])
       case Less
       then show ?thesis
         using pn pl hn  w1h allFinite hp nl by blast
     next
       case Equal
       then show ?thesis
         using pz pz allFinite w1h hn hp nz by blast
     next
       case Greater
       then show ?thesis
         using pp ph hp w1h allFinite hn nh by blast
     qed
   qed
 
 
 subsection \<open>Trivial arithmetic lemmas\<close>
 
 lemma max_diff_pos:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
 
 lemma max_less:"2 ^ 31 < (9223372039002259455::int)" by auto
 
 lemma sints64:"sints 64 = {i. - (2 ^ 63) \<le> i \<and> i < 2 ^ 63}"
   using sints_def[of 64] range_sbintrunc[of 63] by auto 
 
 lemma sints32:"sints 32 = {i. - (2 ^ 31) \<le> i \<and> i < 2 ^ 31}"
   using sints_def[of 32] range_sbintrunc[of 31] by auto 
 
 lemma upcast_max:"sint((scast(0x80000001::word))::64 Word.word)=sint((0x80000001::32 Word.word))"
   by auto
 
 lemma upcast_min:"(0xFFFFFFFF80000001::64 Word.word) = ((scast (-0x7FFFFFFF::word))::64 Word.word)"
   by auto
 
 lemma min_extend_neg:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
   by auto
 
 lemma min_extend_val':"sint ((-0x7FFFFFFF)::64 Word.word) = (-0x7FFFFFFF)" by auto
 
 lemma min_extend_val:"(-0x7FFFFFFF::64 Word.word) = 0xFFFFFFFF80000001" by auto
 
 lemma range2s:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
   by auto
 
 
 section \<open>Arithmetic operations\<close>
 text\<open>This section defines operations which conservatively compute upper and lower bounds of 
  arithmetic functions given upper and lower bounds on their arguments. Each function comes with a 
  proof that it rounds in the advertised direction.
 \<close>
 subsection \<open>Addition upper bound\<close>
 text\<open>Upper bound of w1 + w2\<close>
 fun pu :: "word \<Rightarrow> word \<Rightarrow> word"
 where "pu w1 w2 = 
 (if w1 = POS_INF then POS_INF
  else if w2 = POS_INF then POS_INF
  else if w1 = NEG_INF then 
   (if w2 = NEG_INF then NEG_INF 
    else
      (let sum::64 Word.word = ((scast w2)::64 Word.word) + ((scast NEG_INF)::64 Word.word) in
      if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
      else scast sum))
  else if w2 = NEG_INF then 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast NEG_INF)::64 Word.word) in
    if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum)
  else 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s (sum::64 Word.word) then POS_INF
    else if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum))"
 
 lemma scast_down_range:
 fixes w::"'a::len Word.word"
 assumes "sint w \<in> sints (len_of (TYPE('b::len)))"
 shows "sint w = sint ((scast w)::'b Word.word)"
 unfolding scast_def
 by (simp add: assms word_sint.Abs_inverse)
 
 lemma pu_lemma:
   fixes w1 w2
   fixes r1 r2 :: real
   assumes up1:"w1 \<equiv>\<^sub>U (r1::real)"
   assumes up2:"w2 \<equiv>\<^sub>U (r2::real)"
   shows   "pu w1 w2 \<equiv>\<^sub>U (r1 + r2)"
 proof -
   have scast_eq1:"sint((scast w1)::64 Word.word) = sint w1" 
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have scast_eq2:"sint((scast (0x80000001::word))::64 Word.word) 
   = sint ((0x80000001::32 Word.word))"
      by auto
   have scast_eq3:"sint((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have w2Geq:"sint ((scast w2)::64 Word.word) \<ge> - (2 ^ 31) " 
     using Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 Word.word_size 
       scast_eq1 upcast_max scast_eq3 len32 mem_Collect_eq 
     by auto
   have "sint ((scast w2)::64 Word.word) \<le> 2 ^ 31"
     apply (auto simp add: Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 
         scast_eq3 len32)
     using Word.word_sint.Rep[of "(w2)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   then have w2Less:"sint ((scast w2)::64 Word.word) < 9223372039002259455" by auto
   have w2Range:
     "-(2 ^ (size ((scast w2)::64 Word.word) - 1)) 
      \<le> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
    \<and> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
      \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
     apply(auto simp add: Word.word_size scast_eq1 upcast_max sints64 max_less)
     using max_diff_pos max_less w2Less w2Geq by auto
   have w2case1a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
             =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF w2Range])
   have w1Lower:"sint ((scast w1)::64 Word.word) \<ge> - (2 ^ 31) " 
     using Word.word_sint.Rep[of "(w1)::32 Word.word"] sints32 Word.word_size scast_eq1 scast_eq2 
       scast_eq3 len32 mem_Collect_eq 
     by auto
   have w1Leq:"sint ((scast w1)::64 Word.word) \<le> 2 ^ 31"
     apply (auto simp add: Word.word_sint.Rep[of "(w1)::32 Word.word"] sints32 scast_eq1 len32)
     using Word.word_sint.Rep[of "(w1)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   then have w1Less:"sint ((scast w1)::64 Word.word) < 9223372039002259455"
     using max_less by auto
   have w1MinusBound:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
     \<le> sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
   \<and> sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
     \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     apply(auto simp add:
     Word.word_size[of "(scast w1)::64 Word.word"] 
     Word.word_size[of "(scast (-0x7FFFFFFF))::64 Word.word"]
     scast_eq3 scast_eq2 
     Word.word_sint.Rep[of "(w1)::32 Word.word"]
     Word.word_sint.Rep[of "0x80000001::32 Word.word"]
     Word.word_sint.Rep[of "(scast w1)::64 Word.word"]
     Word.word_sint.Rep[of "-0x7FFFFFFF::64 Word.word"]
     sints64 sints32)
     using w1Lower w1Less by auto
   have w1case1a:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
              = sint ((scast w1)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by (rule signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(- 0x7FFFFFFF)", OF w1MinusBound])
   have w1case1a':"sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) 
         = sint ((scast w1)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word)"
     using min_extend_val w1case1a by auto
   have w1Leq':"sint w1 \<le> 2^31 - 1"
     using Word.word_sint.Rep[of "(w1)::32 Word.word"] 
     by (auto simp add:  sints32 len32[of "TYPE(32)"])
   have neg64:"(((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
             = ((scast w2)::64 Word.word) + (-0x7FFFFFFF)" by auto
   have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
     by auto
   obtain r'\<^sub>1 and r'\<^sub>2 where   
             geq1:"r'\<^sub>1\<ge>r1" and equiv1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
         and geq2:"r'\<^sub>2\<ge>r2" and equiv2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
           using up1 up2 unfolding repU_def by auto
   show ?thesis
 proof (cases rule: case_pu_inf[where ?w1.0=w1, where ?w2.0=w2])
   case PosAny then show ?thesis
     apply (auto simp add: repU_def repe.simps)
     using linear by blast 
 next
   case AnyPos
   then show ?thesis
   apply (auto simp add: repU_def repe.simps)
   using linear by blast
 next
   case NegNeg
   then show ?thesis 
   using up1 up2 
   by (auto simp add: repU_def repe.simps)
 next
   case NegNum
   assume neq1:"w2 \<noteq> POS_INF"
   assume eq2:"w1 = NEG_INF"
   assume neq3:"w2 \<noteq> NEG_INF"
   let ?sum = "(scast w2 + scast NEG_INF)::64 Word.word"
   have leq1:"r'\<^sub>1 \<le>  (real_of_int (sint NEG_INF))" 
     using equiv1 neq1 eq2 neq3 by (auto simp add: repe.simps)
   have leq2:"r'\<^sub>2 =  (real_of_int (sint w2))"
     using equiv2 neq1 eq2 neq3 by (auto simp add: repe.simps)
   have case1:"?sum <=s ((scast NEG_INF)::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
-    using up1 up2 apply (simp add: repU_def repe.simps word_sle_def)
+    using up1 up2 apply (simp add: repU_def repe.simps word_sle_eq)
     apply(rule exI[where x= "r1 + r2"])
-    apply(auto)
+      apply(auto)
         using w2case1a min_extend_neg
-        apply (auto simp add: neq1 eq2 neq3 repINT repU_def repe.simps repeInt_simps
+               apply (auto simp add: neq1 eq2 neq3 repINT repU_def repe.simps repeInt_simps
         up2 word_sless_alt) 
     using repINT repU_def repe.simps repeInt_simps up2 word_sless_alt 
       add.right_neutral add_mono dual_order.trans of_int_le_0_iff scast_eq3 by fastforce+
   have case2:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> scast ?sum \<equiv>\<^sub>U r1 + r2"
     apply(simp add: repU_def repe.simps word_sle_def up1 up2)
     apply(rule exI[where x= "r'\<^sub>2 - 0x7FFFFFFF"])
     apply(rule conjI)
     subgoal 
       proof -
         assume " \<not> sint (scast w2 + 0xFFFFFFFF80000001) \<le> - 2147483647"
         have bound1:"r1 \<le> - 2147483647"
           using leq1 geq1 by (auto)
         have bound2:"r2 \<le> r'\<^sub>2"
           using leq2 geq2 by auto        
         show "r1 + r2 \<le> r'\<^sub>2 - 2147483647"
           using bound1 bound2
           by(linarith)
       qed
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto)
     subgoal
       proof -
         assume a:"\<not> sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
         then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
           unfolding min_extend_val by auto 
         have case1a:" sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                  =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
           by(rule signed_arith_sint(1)[OF w2Range])
         have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
           using sintw2_bound case1a min_extend_val' scast_eq3 by linarith
         then have w2bound:"0 < sint w2" 
           using less_add_same_cancel2 by blast
         have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           using case1a scast_eq3 min_extend_val' Word.word_sint.Rep[of "(w2)::32 Word.word"] w2bound
           by (auto simp add: sints32 len32[of "TYPE(32)"])
         have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word)) "
           using scast_down_range[OF rightSize]
           by auto
         then have b:"sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word)
                  = sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001)" 
           using min_extend_val by auto
         have c:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
             = sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word)"
           using min_extend_val case1a by auto
         show "r'\<^sub>2 - 2147483647 
         = (real_of_int (sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word)))"
           using a b min_extend_val' scast_eq3 leq2 case1a
           by auto
       qed
     subgoal  
     proof -
       have range2a:" - (2 ^ (size ((scast w2)::64 Word.word) - 1)) 
         \<le> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
       \<and> sint ((scast w2)::64 Word.word) + sint ((-0x7FFFFFFF)::64 Word.word) 
         \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
         apply(auto simp add: Word.word_size scast_eq1 upcast_max sints64 sints32 max_less)
         using max_diff_pos max_less w2Geq w2Less by auto
       have case2a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                 =  sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF range2a])
       have neg64:"(((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) 
                 = ((scast w2)::64 Word.word) + (-0x7FFFFFFF)" by auto
       assume "\<not> sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 by auto 
       have a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((-0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have b:"sint ((scast w2)::64 Word.word) = sint w2" 
         apply(rule Word.sint_up_scast)
         unfolding Word.is_up by auto
       have d:"sint w2 \<le> 2^31 - 1"
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] 
         by (auto simp add:  sints32 len32[of "TYPE(32)"])
       have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
         using sintw2_bound case2a min_extend_val' scast_eq3 by linarith
       then have w2bound:"0 < sint w2" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a b min_extend_val'
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                   = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have "sint (scast (((scast w2)::64 Word.word) + (-0x7FFFFFFF))::word) < 2147483647"
         unfolding downcast a b min_extend_val'
         using range2s[of "sint w2", OF d]
         by auto
       then show "sint (scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001)::word) < 2147483647"
         by auto
     qed
     subgoal proof -
       assume notLeq:"\<not> sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have gr:"sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647" 
         by auto
       have case2a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
                  = sint ((scast w2)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF w2Range])
       from neg64
       have sintw2_bound:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 using notLeq by auto 
       have a:"sint (((scast w2)::64 Word.word) + (-0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((-0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have c:"sint((-0x7FFFFFFF)::64 Word.word) = -0x7FFFFFFF" 
         by auto
       have d:"sint w2 \<le> 2^31 - 1"
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] 
         by (auto simp add:  sints32 len32[of "TYPE(32)"])
       have "- 0x7FFFFFFF < sint w2 + (- 0x7FFFFFFF)"
         using sintw2_bound case2a c scast_eq3 by linarith
       then have w2bound:"0 < sint w2" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w2)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a scast_eq3
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w2)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have sintEq:" sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word) 
           = sint (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001) "
           using downcast by auto
       show "-2147483647 
           < real_of_int (sint ((scast (((scast w2)::64 Word.word) + 0xFFFFFFFF80000001))::word))"
         unfolding sintEq  
         using gr of_int_less_iff of_int_minus of_int_numeral by linarith
       qed
     done
   have castEquiv:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> (scast ?sum) \<equiv>\<^sub>U r1 + r2"
     using up1 up2 case1 case2  by fastforce
   have letRep:"(let sum = ?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum) \<equiv>\<^sub>U r1 + r2"
     using case1 case2
     by(cases "?sum <=s scast NEG_INF"; auto) 
   show "pu w1 w2 \<equiv>\<^sub>U r1 + r2"
     using letRep eq2 neq1 
     by(auto)
 next
   case NumNeg
   assume neq3:"w1 \<noteq> NEG_INF"
   assume neq1:"w1 \<noteq> POS_INF"
   assume eq2:"w2 = NEG_INF"
   let ?sum = "(scast w1 + scast NEG_INF)::64 Word.word"
   have case1:"?sum <=s ((scast NEG_INF)::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
     using up1 up2 apply (simp add: repU_def repe.simps word_sle_def)
     apply(rule exI[where x= "r1 + r2"])
     apply(auto)
         using w1case1a min_extend_neg 
         apply (auto simp add: neq1 eq2 neq3 repINT repU_def repe.simps repeInt_simps 
         up2 word_sless_alt) 
     using repINT repU_def repe.simps repeInt_simps up2 word_sless_alt
     proof -
       fix r'
       assume a1:"sint ((scast w1)::64 Word.word) \<le> 0"
       then have h3:"sint w1 \<le> 0" using scast_eq1 by auto 
       assume a2:"r2 \<le> r'"
       assume a3:"r1 \<le>  (real_of_int (sint w1))"
       assume a4:"r' \<le>  (- 2147483647)"
       from a2 a4 have h1:"r2 \<le> - 2147483647" by auto
       from a1 a3 h3 have h2:"r1 \<le> 0" 
       using dual_order.trans of_int_le_0_iff by blast
       show "r1 + r2 \<le>  (- 2147483647)"
         using h1 h2 add.right_neutral add_mono by fastforce
     qed
   have leq1:"r'\<^sub>2 \<le>  (real_of_int (sint NEG_INF))" and leq2:"r'\<^sub>1 =  (real_of_int (sint w1))" 
     using equiv1 equiv2 neq1 eq2 neq3 unfolding repe.simps by auto
   have case1a:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF::64 Word.word)) 
              = sint ((scast w1)::64 Word.word) + sint (-0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF w1MinusBound])
   have case2:"\<not>(?sum <=s scast NEG_INF) \<Longrightarrow> scast ?sum \<equiv>\<^sub>U r1 + r2"
     apply (simp add: repU_def repe.simps word_sle_def up1 up2)
     apply(rule exI[where x= "r'\<^sub>1 - 0x7FFFFFFF"]) (*r1 + r2*)
     apply(rule conjI)
     subgoal using leq1 leq2 geq1 geq2 by auto
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto)
     subgoal
       proof -
       have f:"r'\<^sub>1 =  (real_of_int (sint w1))"
         by (simp add: leq1 leq2 )
        assume a:"\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
        then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
          unfolding min_extend_val by auto 
        have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
          using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
        then have w2bound:"0 < sint w1" 
          using less_add_same_cancel2 by blast
        have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
          unfolding w1case1a 
          using w2bound Word.word_sint.Rep[of "(w1)::32 Word.word"]
          by (auto simp add: sints32 len32[of "TYPE(32)"] scast_eq1)
       have downcast:"sint ((scast (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF))))::word)
                    = sint (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then have b:"sint ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word) 
                  = sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001)" 
         using min_extend_val by auto
       have "(real_of_int (sint ((scast w1)::64 Word.word ) - 2147483647)) 
           = r'\<^sub>1 -  (real_of_int 2147483647)"
           by (simp add: scast_eq1 leq2)
       then show "r'\<^sub>1 -  2147483647 
         = (real_of_int (sint ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word)))"
         by (metis b w1case1a' min_extend_val' diff_minus_eq_add minus_minus of_int_numeral)
       qed
     subgoal  
     proof -
       assume "\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 by auto 
       have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
         using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
       then have w2bound:"0 < sint w1" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case1a scast_eq1 w1case1a'
         using Word.word_sint.Rep[of "(w1)::32 Word.word"] w2bound
         by(auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF))))::word) 
                    = sint (((scast w1)::64 Word.word) + ((- 0x7FFFFFFF)::64 Word.word)) "
         using scast_down_range[OF rightSize]
         by auto
       show "sint (scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001)::word) < 2147483647"
         using downcast min_extend_val' w1case1a' scast_eq1 arith[of "sint w1", OF w1Leq']
         by auto
     qed
     subgoal proof -
       assume notLeq:"\<not> sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) \<le> - 2147483647"
       then have gr:"sint (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) > - 2147483647" 
         by auto
       then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (-0x7FFFFFFF)) > - 2147483647"
         unfolding neg64 using notLeq by auto 
       have "- 0x7FFFFFFF < sint w1 + (- 0x7FFFFFFF)"
         using sintw2_bound case1a min_extend_val' scast_eq1 by linarith
       then have w2bound:"0 < sint w1" 
         using less_add_same_cancel2 by blast
       have rightSize:"sint (((scast w1)::64 Word.word) + - 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case1a scast_eq1 w1case1a'
         using Word.word_sint.Rep[of "(w1)::32 Word.word"] w2bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       show "- 2147483647 
         < real_of_int (sint ((scast (((scast w1)::64 Word.word) + 0xFFFFFFFF80000001))::word))"
         using scast_down_range[OF rightSize] gr of_int_less_iff of_int_minus of_int_numeral
         by auto
       qed
       done
     have letUp:"(let sum=?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum) \<equiv>\<^sub>U r1+r2"
       using case1 case2
       by (auto simp add: Let_def)
     have puSimp:"pu w1 w2=(let sum = ?sum in if sum <=s scast NEG_INF then NEG_INF else scast sum)"
       using neq3 neq1 eq2 equiv1 leq2 repeInt_simps by force
     then show "pu w1 w2 \<equiv>\<^sub>U r1 + r2"      
       using letUp puSimp by auto
 next
   case NumNum
   assume notinf1:"w1 \<noteq> POS_INF"
   assume notinf2:"w2 \<noteq> POS_INF"
   assume notneginf1:"w1 \<noteq> NEG_INF"
   assume notneginf2:"w2 \<noteq> NEG_INF"
   let ?sum = "((scast w1)::64 Word.word) + ((scast w2):: 64 Word.word)"
   have inf_case:"scast POS_INF <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>U r1 + r2"
     using repU_def repePos_simps 
     by (meson dual_order.strict_trans not_less order_refl)
   have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
      \<le> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
    \<and> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
      \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     using Word.word_size[of "(scast w2)::64 Word.word"]
       Word.word_size[of "(scast w1)::64 Word.word"]
     scast_eq1 scast_eq3
     Word.word_sint.Rep[of "(w1)::32 Word.word"]
     Word.word_sint.Rep[of "(w2)::32 Word.word"]
     Word.word_sint.Rep[of "(scast w1)::64 Word.word"]
     Word.word_sint.Rep[of "(scast w2)::64 Word.word"]
     sints64 sints32 by auto 
   have sint_eq:"sint((scast w1 + scast w2)::64 Word.word) = sint w1 + sint w2"
     using signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(scast w2)::64 Word.word", OF truth]
       scast_eq1 scast_eq3
     by auto
   have bigOne:"scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<ge>r1 + r2. r' \<le>  (- 0x7FFFFFFF)"
    proof -
      assume "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)"
      then have sum_leq:"sint w1 + sint w2 \<le> - 0x7FFFFFFF"
            and sum_leq':" (sint w1 + sint w2) \<le>  (- 2147483647)"
-       using sint_eq unfolding Word.word_sle_def by auto 
+       using sint_eq unfolding word_sle_eq by auto 
      obtain r'\<^sub>1 r'\<^sub>2 ::real where 
        bound1:"r'\<^sub>1 \<ge> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
        bound2:"r'\<^sub>2 \<ge> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using up1 up2 unfolding repU_def by auto
      have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
        using \<open>scast w1 + scast w2 <=s - 0x7FFFFFFF\<close>  word_sle_def notinf1 notinf2 
          bound1 bound2 unfolding repe.simps by auto
      have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
        using somethingA somethingB add_mono by fastforce  
      show "\<exists>r'\<ge>r1 + r2. r' \<le> (- 0x7FFFFFFF)"
        apply(rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
        using bound1 bound2 add_mono something sum_leq' order.trans 
        by auto
    qed
    have anImp:"\<And>r'.  (r'\<ge>r1 + r2 \<and> r' \<le>  (- 2147483647)) \<Longrightarrow> 
     (\<exists>r. - (2 ^ 31 - 1) = - (2 ^ 31 - 1) 
      \<and> r' = r \<and> r \<le> (real_of_int (sint ((- (2 ^ 31 - 1))::32 Word.word))))"
       by auto
    have anEq:"((scast ((- (2 ^ 31 - 1))::32 Word.word))::64 Word.word) =  (- 0x7FFFFFFF)"
      by auto
    have bigTwo:
    "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow> 
     \<not>(?sum <=s ((scast NEG_INF)::64 Word.word)) \<Longrightarrow> 
     \<exists>r'\<ge>r1 + r2. r' = 
       (real_of_int (sint (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)))
     \<and> (r' <  0x7FFFFFFF \<and>  (-0x7FFFFFFF) < r')"
    proof -
      assume "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum)"
      then have sum_leq:"sint w1 + sint w2 < 0x7FFFFFFF"
-       unfolding Word.word_sle_def POS_INF_def using sint_eq by auto
+       unfolding word_sle_eq POS_INF_def using sint_eq by auto
      then have sum_leq':" (sint w1 + sint w2) <  (2147483647)"
        by auto
      assume "\<not>(?sum <=s ((scast NEG_INF)::64 Word.word))"
      then have sum_geq:"(- 0x7FFFFFFF) < sint w1 + sint w2"
-       unfolding Word.word_sle_def NEG_INF_def using sint_eq by auto 
+       unfolding word_sle_eq NEG_INF_def using sint_eq by auto 
      then have sum_geq':" (- 2147483647) <  (sint w1 + sint w2)"
        by auto
      obtain r'\<^sub>1 r'\<^sub>2 ::real where 
        bound1:"r'\<^sub>1 \<ge> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
        bound2:"r'\<^sub>2 \<ge> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using up1 up2 unfolding repU_def by auto
      have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
        using word_sle_def notinf1 notinf2 bound1 bound2 unfolding repe.simps by auto
      have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
        using somethingA somethingB add_mono by fastforce  
      have "(w1 \<equiv>\<^sub>E r'\<^sub>1)" using bound1 by auto
      then have
            r1w1:"r'\<^sub>1 =  (real_of_int (sint w1))"
        and w1U:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
        and w1L:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
        unfolding repe.simps
        using notinf1 notinf2 notneginf1 notneginf2 by (auto)
      have "(w2 \<equiv>\<^sub>E r'\<^sub>2)" using bound2 by auto
      then have
            r2w1:"r'\<^sub>2 =  (real_of_int (sint w2))"
        and w2U:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
        and w2L:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
        unfolding repe.simps
        using notinf1 notinf2 notneginf1 notneginf2 by (auto)
      have "sint (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)) 
          = sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word)"
        apply(rule scast_down_range)
        unfolding sint_eq using sints32 sum_geq sum_leq by auto
      then have cast_eq:"(sint ((scast (((scast w1)::64 Word.word) 
                       + ((scast w2)::64 Word.word)))::word)) 
                     = sint w1 + sint w2"
        using scast_down_range sints32 sum_geq sum_leq sint_eq by auto
      from something and cast_eq 
      have r12_sint_scast:"r'\<^sub>1 + r'\<^sub>2 
        = (sint ((scast (((scast w1)::64 Word.word) 
          + ((scast w2)::64 Word.word)))::word))"
        using r1w1 w1U w1L r2w1 w2U w2L by (simp)
      show ?thesis 
        using bound1 bound2 add_mono r12_sint_scast cast_eq sum_leq sum_leq' sum_geq' 
        \<open>r'\<^sub>1 + r'\<^sub>2 =  (real_of_int (sint (scast (scast w1 + scast w2))))\<close>
        by auto
    qed
    have neg_inf_case:"?sum <=s ((scast ((NEG_INF)::word))::64 Word.word) \<Longrightarrow> NEG_INF \<equiv>\<^sub>U r1 + r2"
    proof (unfold repU_def NEG_INF_def repe.simps)
      assume "scast w1 + scast w2 <=s ((scast ((- (2 ^ 31 - 1))::word))::64 Word.word)"
      then have "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)" 
        by (metis anEq)
      then obtain r' where geq:"(r' \<ge> r1 + r2)" and leq:"(r' \<le>  (- 0x7FFFFFFF))"
       using bigOne by auto
      show "(\<exists>r'\<ge>plus r1 r2.
        (\<exists>r. uminus (minus(2 ^ 31) 1) = POS_INF \<and> r' = r \<and>  (real_of_int (sint POS_INF)) \<le> r) 
      \<or> (\<exists>r. uminus (minus(2 ^ 31) 1) = uminus (minus(2 ^ 31)  1) 
         \<and> r' = r \<and> r \<le> real_of_int (sint ((uminus (minus(2 ^ 31) 1))::word)))
      \<or> (\<exists>w. uminus (minus(2 ^ 31) 1) = w 
         \<and> r' = real_of_int (sint w)
         \<and> (real_of_int (sint w)) <  (real_of_int (sint POS_INF)) 
         \<and> less (real_of_int (sint (uminus (minus(2 ^ 31) 1))))  (real_of_int (sint w))))"
        using  leq anImp geq by auto
    qed
    have int_case:"\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) 
               \<Longrightarrow> \<not> (?sum <=s ((scast NEG_INF)::64 Word.word)) 
               \<Longrightarrow> ((scast ?sum)::word) \<equiv>\<^sub>U r1 + r2"
    proof -
      assume bound1:"\<not> ((scast POS_INF)::64 Word.word) <=s scast w1 + scast w2"
      assume bound2:"\<not> scast w1 + scast w2 <=s ((scast NEG_INF)::64 Word.word)"
      obtain r'::real  
        where rDef:"r' = (real_of_int (sint ((scast (((scast w1)::64 Word.word) 
                         + ((scast w2)::64 Word.word)))::word)))"
        and r12:"r'\<ge>r1 + r2" 
        and boundU:"r' <  0x7FFFFFFF" 
        and boundL:"(-0x7FFFFFFF) < r'"
        using bigTwo[OF bound1 bound2] by auto
      obtain w::word 
      where wdef:"w = (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)"
        by auto
      then have wr:"r' = (real_of_int (sint w))"
        using r12 bound1 bound2 rDef by blast
      show ?thesis
        unfolding repU_def repe.simps 
        using r12 wdef rDef boundU boundL wr  
        by auto 
    qed
    have almost:"(let sum::64 Word.word = scast w1 + scast w2 in 
      if scast POS_INF <=s sum then POS_INF 
      else if sum <=s scast NEG_INF then NEG_INF 
     else scast sum) \<equiv>\<^sub>U r1 + r2"
    apply(cases "((scast POS_INF)::64 Word.word) <=s ((?sum)::64 Word.word)")
    subgoal using inf_case Let_def int_case neg_inf_case by auto
    apply(cases "?sum <=s scast NEG_INF")
    subgoal 
      using inf_case Let_def int_case neg_inf_case 
      proof -
        assume "\<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2"
        then have "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
                 \<and> \<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2 
                 \<and> \<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
              \<or> ((let w = scast w1 + scast w2 in 
                 if scast POS_INF <=s (w::64 Word.word)  then POS_INF 
                 else if w <=s scast NEG_INF then NEG_INF 
                 else scast w) \<equiv>\<^sub>U r1 + r2)"
          using neg_inf_case by presburger
        then show ?thesis
          using int_case by force
      qed
    subgoal using inf_case Let_def int_case neg_inf_case 
    proof -
      assume a1: "\<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2"
      assume "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF"
      have "\<not> (scast w1::64 Word.word) + scast w2 <=s scast NEG_INF 
          \<and> \<not> (scast POS_INF::64 Word.word) <=s scast w1 + scast w2 
       \<or> ((let w = scast w1 + scast w2 in 
          if scast POS_INF <=s (w::64 Word.word) then POS_INF 
          else if w <=s scast NEG_INF then NEG_INF 
          else scast w) \<equiv>\<^sub>U r1 + r2)"
        using a1 neg_inf_case by presburger
      then show ?thesis
        using int_case by force
    qed
    done
   then show ?thesis 
     using notinf1 notinf2 notneginf1 notneginf2 by auto
 qed
 qed
 
 text\<open>Lower bound of w1 + w2\<close>
 fun pl :: "word \<Rightarrow> word \<Rightarrow> word"
 where "pl w1 w2 = 
 (if w1 = NEG_INF then NEG_INF
  else if w2 = NEG_INF then NEG_INF
  else if w1 = POS_INF then 
   (if w2 = POS_INF then POS_INF 
    else
      (let sum::64 Word.word = ((scast w2)::64 Word.word) + ((scast POS_INF)::64 Word.word) in
      if ((scast POS_INF)::64 Word.word) <=s(sum::64 Word.word) then POS_INF
      else scast sum))
  else if w2 = POS_INF then 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast POS_INF)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s(sum::64 Word.word)  then POS_INF
    else scast sum)
  else 
   (let sum::64 Word.word = ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) in
    if ((scast POS_INF)::64 Word.word) <=s (sum::64 Word.word) then POS_INF
    else if (sum::64 Word.word) <=s ((scast NEG_INF)::64 Word.word) then NEG_INF
    else scast sum))"
 
 
 subsection \<open>Addition lower bound\<close>
 
 text\<open>Correctness of lower bound of w1 + w2\<close>
 lemma pl_lemma:
 assumes lo1:"w1 \<equiv>\<^sub>L (r1::real)"
 assumes lo2:"w2 \<equiv>\<^sub>L (r2::real)"
 shows "pl w1 w2 \<equiv>\<^sub>L (r1 + r2)"
 proof -
   have scast_eq1:"sint((scast w1)::64 Word.word) = sint w1" 
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have scast_eq2:"sint((scast (0x80000001::word))::64 Word.word)=sint((0x80000001::32 Word.word))"
     by auto
   have scast_eq3:"sint((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have sints64:"sints 64 = {i. - (2 ^ 63) \<le> i \<and> i < 2 ^ 63}"
     using sints_def[of 64] range_sbintrunc[of 63] by auto 
   have sints32:"sints 32 = {i. - (2 ^ 31) \<le> i \<and> i < 2 ^ 31}"
     using sints_def[of 32] range_sbintrunc[of 31] by auto 
   have thing1:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
   have "sint (( w2)) \<ge> (-(2 ^ 31))"
     using Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 mem_Collect_eq
     Word.word_size[of "(scast w2)::64 Word.word"] scast_eq1 scast_eq2 scast_eq3 len32 
     by auto
   then have thing4:"sint ((scast w2)::64 Word.word) \<ge> (-(2 ^ 31))" 
     using scast_down_range sint_ge sints_num
     using scast_eq3 by linarith
   have aLeq2:"(-(2 ^ 31)::int) \<ge> -9223372039002259455" by auto 
   then have thing2:" (0::int) \<le> 9223372039002259455 + sint ((scast w2)::64 Word.word)"
     using thing4 aLeq2 
     by (metis ab_group_add_class.ab_left_minus add.commute add_mono neg_le_iff_le)
   have aLeq:"2 ^ 31 \<le> (9223372039002259455::int)" by auto
   have bLeq:"sint ((scast w2)::64 Word.word) \<le> 2 ^ 31"
     apply ( auto simp add: Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 
         scast_eq3 len32)
     using Word.word_sint.Rep[of "(w2)::32 Word.word"] len32[of "TYPE(32)"] sints32 by auto
   have thing3:" sint ((scast w2)::64 Word.word) \<le> 9223372034707292160 "
     using aLeq bLeq by auto
   have truth:" - (2 ^ (size ((scast w2)::64 Word.word) - 1)) 
       \<le> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
     \<and> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
       \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
     by(auto simp add:
     Word.word_size[of "(scast w2)::64 Word.word"] 
     Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
     scast_eq1 scast_eq2 
     sints64 sints32 thing2 thing1 thing3)
   have case1a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
              =  sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
     by(rule signed_arith_sint(1)[OF truth])
   have case1b:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
     by auto
   have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
     by auto
   have neg64:"(((scast w2)::64 Word.word) + 0x7FFFFFFF) 
             = ((scast w2)::64 Word.word) + (0x7FFFFFFF)"
     by auto
   obtain r'\<^sub>1 and r'\<^sub>2 where   
             geq1:"r'\<^sub>1\<le>r1" and equiv1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
         and geq2:"r'\<^sub>2\<le>r2" and equiv2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
           using lo1 lo2 unfolding repL_def by auto
   show ?thesis
 proof (cases rule: case_pl_inf[where ?w1.0=w1, where ?w2.0=w2])
   case NegAny
   then show ?thesis
   apply (auto simp add: repL_def repe.simps)
   using lo1 lo2 linear by auto
 next
   case AnyNeg
   then show ?thesis 
   apply (auto simp add: repL_def repe.simps)
   using linear by auto
 next
   case PosPos
   then show ?thesis 
   using lo1 lo2 
   by (auto simp add: repL_def repe.simps)
 next
   case PosNum
   assume neq1:"w2 \<noteq> POS_INF"
   assume eq2:"w1 = POS_INF"
   assume neq3:"w2 \<noteq> NEG_INF"
   let ?sum = "(scast w2 + scast POS_INF)::64 Word.word"
   have case1:"(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
     using lo1 lo2 apply (simp add: repL_def repe.simps word_sle_def)
     apply(rule exI[where x= "r1 + r2"])
     using case1a case1b 
     apply (auto simp add: neq1 eq2 neq3 repINT repL_def repe.simps 
       repeInt_simps lo2 word_sless_alt)
    proof -
       fix r'
       assume a1:"0 \<le> sint (((scast w2)::64 Word.word))"
       from a1 have h3:"2147483647 \<le> sint w2 + 0x7FFFFFFF " using scast_eq3
         by auto
       assume a2:"r' \<le> r1"
       assume a3:"(real_of_int (sint w2)) \<le> r2"
       assume a4:"(2147483647) \<le> r'"
       from a2 a4 have h1:"2147483647 \<le> r1" by auto
       from a1 a3 h3 have h2:"0 \<le> r2" 
         using dual_order.trans of_int_le_0_iff le_add_same_cancel2 by fastforce
       show "(2147483647) \<le> r1 + r2 "
         using h1 h2 h3 add.right_neutral add_mono  
         by fastforce
       qed
   have leq1:"r'\<^sub>1 \<ge>  (real_of_int (sint POS_INF))" 
     using equiv1 neq1 eq2 neq3 
     unfolding repe.simps by auto
   have leq2:"r'\<^sub>2 = (real_of_int (sint w2))"
     using equiv2 neq1 eq2 neq3
     unfolding repe.simps by auto      
   have case2:"\<not>(scast POS_INF <=s ?sum) \<Longrightarrow> scast ?sum \<equiv>\<^sub>L r1 + r2"
     apply (simp add: repL_def repe.simps word_sle_def lo1 lo2)
     apply(rule exI[where x= "r'\<^sub>2 + 0x7FFFFFFF"]) (*r1 + r2*)
     apply(rule conjI)
     subgoal 
       proof -
         assume "\<not> 2147483647 \<le> sint (scast w2 + 0x7FFFFFFF)"
         have bound1:"2147483647 \<le> r1"
           using leq1 geq1 by (auto)
         have bound2:"r'\<^sub>2 \<le> r2 "
           using leq2 geq2 by auto        
         show "r'\<^sub>2 + 2147483647 \<le> r1 + r2"
           using bound1 bound2
           by linarith
       qed
     apply(rule disjI2)
     apply(rule disjI2)
     apply(auto)
     subgoal
       proof -
        assume a:"\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
        then have sintw2_bound:"2147483647 > sint (((scast w2)::64 Word.word) + (0x7FFFFFFF))"
          by auto 
        have case1a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                  =  sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
          by(rule signed_arith_sint(1)[OF truth])
        have a1:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
               = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)" 
          using case1a by auto
        have c1:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
          by auto
        have "sint w2 + ( 0x7FFFFFFF) <  0x7FFFFFFF"
          using sintw2_bound case1a c1 scast_eq3 by linarith
        then have w2bound:"sint w2 < 0" 
          using add_less_same_cancel2 by blast
        have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
          unfolding case1a scast_eq3 c1 
          using Word.word_sint.Rep[of "(w2)::32 Word.word"] w2bound 
          by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word)
         = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then have b:"sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word)
                  = sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)" 
         by auto
       have c:"sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)
             = sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)"
         using case1a by auto
       have d:"sint ((0x7FFFFFFF)::64 Word.word) = (0x7FFFFFFF)" by auto 
       have f:"r'\<^sub>2 =  (real_of_int (sint w2))"
         by (simp add: leq2)
       show "r'\<^sub>2 +  2147483647 
         = (real_of_int (sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word)))"
         using a b c d scast_eq3 f leq2 of_int_numeral by fastforce
       qed
     subgoal  
     proof -
       have truth2a:"-(2^(size ((scast w2)::64 Word.word)-1)) 
           \<le> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
         \<and> sint ((scast w2)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
           \<le> 2 ^ (size ((scast w2)::64 Word.word) - 1) - 1"
         apply(auto simp add:
             Word.word_size[of "(scast w2)::64 Word.word"]
             Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
             scast_eq1 scast_eq2 sints64 sints32 thing2)
         using thing1 thing2 thing3 by auto
       have case2a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                   = sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF truth2a])
       have min_cast:"(0x7FFFFFFF::64 Word.word) =((scast (0x7FFFFFFF::word))::64 Word.word)"
         by auto
       assume "\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
       then have sintw2_bound:"2147483647 > sint (((scast w2)::64 Word.word) + (0x7FFFFFFF))"
         using neg64 by auto
       have a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)" 
         using case2a by auto
       have c:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
         by auto
       have " 0x7FFFFFFF > sint w2 + ( 0x7FFFFFFF)"
         using sintw2_bound case2a c scast_eq3 by linarith
       then have w2bound:" sint w2 < 0" 
         by simp
       have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         unfolding case2a scast_eq3 c
         apply (auto simp add: sints32 len32[of "TYPE(32)"])
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32[of "TYPE(32)"] w2bound 
         by auto
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word) 
         = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       then show "sint (scast (((scast w2)::64 Word.word) + 0x7FFFFFFF)::word) < 2147483647"
         unfolding downcast a scast_eq3 c
         using w2bound by auto
     qed
     subgoal proof -
       assume notLeq:"\<not> 2147483647 \<le> sint (((scast w2)::64 Word.word) + 0x7FFFFFFF)"
       then have gr:"sint (((scast w2)::64 Word.word) + 0x7FFFFFFF) <  2147483647" 
         by auto
       have case2a:" sint (((scast w2)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                   = sint ((scast w2)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
         by(rule signed_arith_sint(1)[OF truth])
       have min_cast:"(0x7FFFFFFF::64 Word.word) =((scast (0x7FFFFFFF::word))::64 Word.word)"
         by auto
       have neg64:"(((scast w2)::64 Word.word) + 0x7FFFFFFF) 
                 = ((scast w2)::64 Word.word) + (0x7FFFFFFF)"
         by auto
       then have sintw2_bound:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
         using neg64 using notLeq by auto 
       have a:"sint (((scast w2)::64 Word.word) + (0x7FFFFFFF)) 
             = sint((scast w2)::64 Word.word) + sint((0x7FFFFFFF)::64 Word.word)"
         using case2a by auto
       have c:"sint((0x7FFFFFFF)::64 Word.word) = 0x7FFFFFFF" 
         by auto
       have "- 2147483647 \<noteq> w2" using neq3 unfolding NEG_INF_def by auto
       then have "sint((- 2147483647)::word) \<noteq> sint w2"
         using word_sint.Rep_inject by blast
       then have n1:"- 2147483647 \<noteq> sint w2"
         by auto
       have "- 2147483648 \<noteq> w2"
         apply(rule repe.cases[OF equiv2])
         by auto
       then have "sint(- 2147483648::word) \<noteq> sint w2"
       using word_sint.Rep_inject by blast
       then have n2:"- 2147483648 \<noteq> sint w2" 
         by auto
       then have d:"sint w2 > - 2147483647"
         using Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32[of "TYPE(32)"] neq3 n1 n2
         by auto
       have w2bound:"- 2147483647 < sint w2 + 0x7FFFFFFF"
         using sintw2_bound case2a c scast_eq3 d by linarith
       have rightSize:"sint (((scast w2)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
         using sints32 len32[of "TYPE(32)"] w2bound Word.word_sint.Rep[of "(w2)::32 Word.word"] 
           c case2a scast_eq3 sintw2_bound
         by (auto simp add: sints32 len32[of "TYPE(32)"])
       have downcast:"sint ((scast (((scast w2)::64 Word.word) + (( 0x7FFFFFFF))))::word)
                    = sint (((scast w2)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
         using scast_down_range[OF rightSize]
         by auto
       have sintEq:" sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word) =
           sint (((scast w2)::64 Word.word) + 0x7FFFFFFF) "
           using downcast by auto
       show "- 2147483647 
           < real_of_int (sint ((scast (((scast w2)::64 Word.word) + 0x7FFFFFFF))::word))"
         unfolding sintEq  
         using gr of_int_less_iff of_int_minus of_int_numeral c case2a scast_eq3 w2bound by linarith
       qed
       done
   have "(let sum = ?sum in if scast POS_INF <=s sum then POS_INF else scast sum) \<equiv>\<^sub>L r1 + r2"
     using case1 case2
     by (auto simp add: Let_def)
   then show ?thesis 
     using lo1 lo2 neq1 eq2 neq3 
     by (auto)
 next
   case NumPos
     assume neq3:"w1 \<noteq> NEG_INF"
     assume neq1:"w1 \<noteq> POS_INF"
     assume eq2:"w2 = POS_INF"
     let ?sum = "(scast w1 + scast POS_INF)::64 Word.word"
     have thing1:"0 \<le> 9223372034707292161 + ((-(2 ^ 31))::real)" by auto
     have "sint (( w1)) \<ge> (-(2 ^ 31))"
       using Word.word_sint.Rep[of "(w1)::32 Word.word"] scast_eq1 scast_eq2 scast_eq3
         Word.word_size[of "(scast w1)::64 Word.word"] sints32 len32 mem_Collect_eq
       by auto
     then have thing4:"sint ((scast w1)::64 Word.word) \<ge> (-(2 ^ 31))" 
       using scast_down_range sint_ge sints_num scast_eq3 scast_eq1 by linarith
     have aLeq2:"(-(2 ^ 31)::int) \<ge> -9223372039002259455" by auto 
     then have thing2:" (0::int) \<le> 9223372039002259455 + sint ((scast w1)::64 Word.word)"
       using thing4 aLeq2 
       by (metis ab_group_add_class.ab_left_minus add.commute add_mono neg_le_iff_le)
     have aLeq:"2 ^ 31 \<le> (9223372039002259455::int)" by auto
     have bLeq:"sint ((scast w1)::64 Word.word) \<le> 2 ^ 31"
       apply (auto simp add: Word.word_sint.Rep[of "(w1)::32 Word.word"] sints32 
           scast_eq1 len32)
       using Word.word_sint.Rep[of "(w1)::32 Word.word"] len32[of "TYPE(32)"] sints32
       by clarsimp
     have thing3:" sint ((scast w1)::64 Word.word) \<le> 9223372034707292160 "
       using aLeq bLeq by auto
     have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
                    \<le> sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)
                  \<and> sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word) 
                    \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
       by(auto simp add:
       Word.word_size[of "(scast w1)::64 Word.word"]
       Word.word_size[of "(scast (0x7FFFFFFF))::64 Word.word"]
       scast_eq3 scast_eq2 sints64 sints32 thing2 thing1 thing3)
     have case1a:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF::64 Word.word)) 
                = sint ((scast w1)::64 Word.word) + sint (0x7FFFFFFF::64 Word.word)"
       by(rule signed_arith_sint(1)[OF truth])
     have case1b:"sint ((0xFFFFFFFF80000001)::64 Word.word) < 0"
       by auto
     have g:"(0x7FFFFFFF::64 Word.word) = 0x7FFFFFFF" by auto
     have c:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) 
           = sint ((scast w1)::64 Word.word) + sint ((0x7FFFFFFF)::64 Word.word)"
       using g case1a 
       by blast
     have d:"sint ((0x7FFFFFFF)::64 Word.word) = (0x7FFFFFFF)" by auto 
     have e:"sint ((scast w1)::64 Word.word) = sint w1" 
       using scast_eq1 by blast
     have d2:"sint w1 \<le> 2^31 - 1"
       using Word.word_sint.Rep[of "(w1)::32 Word.word"] 
       by (auto simp add: sints32 len32[of "TYPE(32)"])
     have case1:"scast POS_INF <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
       using lo1 lo2 apply (simp add: repL_def repe.simps word_sle_def)
       apply(rule exI[where x= "r1 + r2"])
       apply(auto)
           using case1a case1b 
           apply (auto simp add: neq1 eq2 neq3 repINT repL_def 
             repe.simps repeInt_simps lo2 word_sless_alt) (* close 4 goals *)
      proof -
         fix r'
         have h3:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) 
           = sint (((scast w1)::64 Word.word)) + sint(0x7FFFFFFF::64 Word.word)" 
           using case1a by auto 
         have h4:"sint(0x7FFFFFFF::64 Word.word) = 2147483647" by auto
         assume a1:"0 \<le> sint ((scast w1)::64 Word.word)"
         then have h3:"sint w1 \<ge> 0" using scast_eq1 h3 h4 by auto 
         assume a2:"r' \<le> r2"
         assume a3:"(real_of_int (sint w1)) \<le> r1"
         assume a4:"(2147483647) \<le> r'"
         from a2 a4 have h1:"r2 \<ge>  2147483647" by auto
         from a1 a3 h3 have h2:"r1 \<ge> 0" 
           using dual_order.trans of_int_0_le_iff by fastforce
         show " 2147483647 \<le> r1 + r2"
           using h1 h2 add.right_neutral add_mono by fastforce
         qed
     have leq1:"r'\<^sub>2 \<ge>  (real_of_int (sint POS_INF))" and leq2:"r'\<^sub>1 =  (real_of_int (sint w1))" 
       using equiv1 equiv2 neq1 eq2 neq3 unfolding repe.simps by auto
     have neg64:"(((scast w1)::64 Word.word) + 0xFFFFFFFF80000001) 
               = ((scast w1)::64 Word.word) + (-0x7FFFFFFF)" 
       by auto
     have case2:"\<not>(scast POS_INF <=s ?sum) \<Longrightarrow> scast ?sum \<equiv>\<^sub>L r1 + r2"
       apply (simp add: repL_def repe.simps word_sle_def lo1 lo2)
       apply(rule exI[where x= "r'\<^sub>1 + 0x7FFFFFFF"]) 
       apply(rule conjI)
       subgoal 
         proof -
           assume "\<not> 2147483647 \<le> sint (scast w1 + 0x7FFFFFFF)"
           have bound1:"r2 \<ge>  2147483647"
             using leq1 geq2 by (auto)
           have bound2:"r1 \<ge> r'\<^sub>1"
             using leq2 geq1 by auto        
           show "r'\<^sub>1 + 2147483647 \<le> r1 + r2"
             using bound1 bound2
             by linarith
           qed
       apply(rule disjI2)
       apply(rule disjI2)
       apply(auto)
       subgoal
         proof -
         have f:"r'\<^sub>1 =  (real_of_int (sint w1))"
           by (simp add: leq1 leq2 )
          assume a:"\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
          then have sintw2_bound:"2147483647 > sint (((scast w1)::64 Word.word) + (0x7FFFFFFF))"
            by auto 
          have "0x7FFFFFFF > sint w1 + (0x7FFFFFFF)"
            using sintw2_bound case1a d scast_eq1 by linarith
          then have w2bound:"0 > sint w1" 
            using add_less_same_cancel2 by blast
          have rightSize:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
            unfolding case1a e 
            using w2bound Word.word_sint.Rep[of "(w1)::32 Word.word"]
            by (auto simp add: sints32 len32[of "TYPE(32)"] )
         have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
           by auto
         have downcast:"sint ((scast (((scast w1)::64 Word.word) + (( 0x7FFFFFFF))))::word) 
                      = sint (((scast w1)::64 Word.word) + (( 0x7FFFFFFF)::64 Word.word))"
           using scast_down_range[OF rightSize]
           by auto
         then have b:"sint((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word)
                    = sint(((scast w1)::64 Word.word) + 0x7FFFFFFF)" 
           using g by auto
         show "r'\<^sub>1 + 2147483647
           = (real_of_int (sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word)))"
           using a b c d e f 
           proof -
             have "(real_of_int (sint ((scast w1)::64 Word.word ) + 2147483647)) 
                 = r'\<^sub>1 +  (real_of_int 2147483647)"
               using e leq2 by auto
             then show ?thesis
               using b c d of_int_numeral by metis
           qed
         qed
       subgoal  
       proof -
         assume "\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
         then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
           unfolding neg64 by auto 
         have "0x7FFFFFFF > sint w1 + (0x7FFFFFFF)"
           using sintw2_bound case1a d scast_eq1 by linarith
         then have w2bound:"0 > sint w1" 
           using add_less_same_cancel2 by blast
         have rightSize:"sint (((scast w1)::64 Word.word) + 0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           unfolding case1a e c 
           using Word.word_sint.Rep[of "(w1)::32 Word.word"] w2bound
           by (auto simp add: sints32 len32[of "TYPE(32)"])
         have arith:"\<And>x::int. x \<le> 2 ^ 31 - 1 \<Longrightarrow> x + (- 2147483647) < 2147483647"
           by auto
         have downcast:"sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word) 
           = sint (((scast w1)::64 Word.word) + ((0x7FFFFFFF)::64 Word.word))"
           using scast_down_range[OF rightSize]
           by auto
         show "sint (scast (((scast w1)::64 Word.word) + 0x7FFFFFFF)::word) < 2147483647"
           using downcast d e c arith[of "sint w1", OF d2] sintw2_bound by linarith
       qed
       subgoal proof -
         assume notLeq:"\<not> 2147483647 \<le> sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)"
         then have gr:"2147483647 > sint (((scast w1)::64 Word.word) + 0x7FFFFFFF)" 
           by auto
         then have sintw2_bound:"sint (((scast w1)::64 Word.word) + (0x7FFFFFFF)) < 2147483647"
           unfolding neg64 using notLeq by auto 
         have "0x7FFFFFFF > sint w1 + ( 0x7FFFFFFF)"
           using sintw2_bound case1a d scast_eq1 by linarith
         then have useful:"0 > sint w1"
           using add_less_same_cancel2 by blast
         have rightSize:"sint (((scast w1)::64 Word.word) +  0x7FFFFFFF) \<in> sints (len_of TYPE(32))"
           unfolding case1a e
           using Word.word_sint.Rep[of "(w1)::32 Word.word"]
             sints32 len32[of "TYPE(32)"] useful
           by auto
         have "- 2147483647 \<noteq> w1" using neq3 unfolding NEG_INF_def by auto
         then have "sint((- 2147483647)::word) \<noteq> sint w1"
           using word_sint.Rep_inject by blast
         then have n1:"- 2147483647 \<noteq> sint w1"
           by auto
         have "- 2147483648 \<noteq> w1"
           apply(rule repe.cases[OF equiv1]) using int_not_undef[of w1] by auto
         then have "sint(- 2147483648::word) \<noteq> sint w1"
           using word_sint.Rep_inject by blast
         then have n2:"- 2147483648 \<noteq> sint w1" 
           by auto
         then have d:"sint w1 > - 2147483647"
           using Word.word_sint.Rep[of "(w1)::32 Word.word"] 
             sints32 len32[of "TYPE(32)"] n1 n2 neq3 
           by (simp)
         have d2:"sint (0x7FFFFFFF::64 Word.word) > 0"
           by auto
         from d d2 have d3:"- 2147483647 < sint w1 + sint (0x7FFFFFFF::64 Word.word)"
           by auto
         have d4:"sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word) 
           = sint w1 + sint (0x7FFFFFFF::64 Word.word)"
           using case1a rightSize scast_down_range scast_eq1 by fastforce  
         then show "-2147483647 
           < real_of_int (sint ((scast (((scast w1)::64 Word.word) + 0x7FFFFFFF))::word))"
           using d3 d4 by auto
         qed done
       have "(let sum = ?sum in if scast POS_INF <=s sum then POS_INF else scast sum) \<equiv>\<^sub>L r1 + r2"
         using case1 case2
         by (auto simp add: Let_def)
       then show ?thesis 
         using neq1 eq2 neq3 by (auto)
 next
   case NumNum
   assume notinf1:"w1 \<noteq> POS_INF"
   assume notinf2:"w2 \<noteq> POS_INF"
   assume notneginf1:"w1 \<noteq> NEG_INF"
   assume notneginf2:"w2 \<noteq> NEG_INF"
   let ?sum = "((scast w1)::64 Word.word) + ((scast w2):: 64 Word.word)"
   have truth:" - (2 ^ (size ((scast w1)::64 Word.word) - 1)) 
       \<le> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
     \<and> sint ((scast w1)::64 Word.word) + sint ((scast w2)::64 Word.word) 
       \<le> 2 ^ (size ((scast w1)::64 Word.word) - 1) - 1"
     using Word.word_size[of "(scast w2)::64 Word.word"] 
       Word.word_size[of "(scast w1)::64 Word.word"]
       scast_eq1 scast_eq3 sints64 sints32
       Word.word_sint.Rep[of "(w1)::32 Word.word"]
       Word.word_sint.Rep[of "(w2)::32 Word.word"]
     by auto 
   have sint_eq:"sint((scast w1 + scast w2)::64 Word.word) = sint w1 + sint w2"
     using signed_arith_sint(1)[of "(scast w1)::64 Word.word" "(scast w2)::64 Word.word", OF truth]
       scast_eq1 scast_eq3
     by auto
   have bigOne:"scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<le>r1 + r2. r' \<le>  -0x7FFFFFFF"
   proof -
     assume "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)"
     then have sum_leq:"sint w1 + sint w2 \<le> - 0x7FFFFFFF"
           and sum_leq':" (sint w1 + sint w2) \<le>  (- 2147483647)"
-      using sint_eq unfolding Word.word_sle_def by auto 
+      using sint_eq unfolding word_sle_eq by auto 
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
       using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1 \<le> sint w1" and somethingB:"r'\<^sub>2 \<le> sint w2" 
       using bound1 bound2 \<open>scast w1 + scast w2 <=s -0x7FFFFFFF\<close> word_sle_def notinf1 notinf2 
       unfolding repe.simps by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono 
       by fastforce  
     show "\<exists>r'\<le>r1 + r2. r' \<le> (-0x7FFFFFFF)"
       apply(rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
       using bound1 bound2 add_mono something sum_leq' order.trans by auto
   qed
   have anImp:"\<And>r'.  (r'\<ge>r1 + r2 \<and> r' \<le>  (- 2147483647)) \<Longrightarrow>
    (\<exists>r. - (2 ^ 31 - 1) = - (2 ^ 31 - 1) \<and> r' = r \<and> r 
         \<le> (real_of_int (sint ((- (2 ^ 31 - 1))::32 Word.word))))"
     by auto
   have anEq:"((scast ((- (2 ^ 31 - 1))::32 Word.word))::64 Word.word) = (- 0x7FFFFFFF)"
     by auto
   have bigTwo:
    "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) \<Longrightarrow>
     \<not>(?sum <=s ((scast NEG_INF)::64 Word.word)) \<Longrightarrow>
     \<exists>r'\<le>r1 + r2. r' = (real_of_int (sint (scast (((scast w1)::64 Word.word)
                       + ((scast w2)::64 Word.word))::word)))
                \<and> (r' <  0x7FFFFFFF \<and>  (-0x7FFFFFFF) < r')"
   proof -
     assume "\<not>(((scast POS_INF)::64 Word.word) <=s ?sum)"
     then have sum_leq:"sint w1 + sint w2 < 0x7FFFFFFF"
-      unfolding Word.word_sle_def using sint_eq by auto
+      unfolding word_sle_eq using sint_eq by auto
     then have sum_leq':" (sint w1 + sint w2) < (2147483647)"
       by auto
     assume "\<not>(?sum <=s ((scast NEG_INF)::64 Word.word))"
     then have sum_geq:"(- 0x7FFFFFFF) < sint w1 + sint w2"
-      unfolding Word.word_sle_def using sint_eq by auto
+      unfolding word_sle_eq using sint_eq by auto
     then have sum_geq':" (- 2147483647) <  (sint w1 + sint w2)"
       by auto
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
        using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2 \<le> sint w2" 
       using word_sle_def notinf1 notinf2 bound1 bound2 unfolding repe.simps by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono 
       by fastforce  
     have "(w1 \<equiv>\<^sub>E r'\<^sub>1)" using bound1 by auto
     then have
           r1w1:"r'\<^sub>1 = (real_of_int (sint w1))"
       and w1U:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
       and w1L:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
       unfolding repe.simps
       using notinf1 notinf2 notneginf1 notneginf2 by (auto)
     have "(w2 \<equiv>\<^sub>E r'\<^sub>2)" using bound2 by auto
     then have
           r2w1:"r'\<^sub>2 =  (real_of_int (sint w2))"
       and w2U:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
       and w2L:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
       unfolding repe.simps
       using notinf1 notinf2 notneginf1 notneginf2 by (auto)
     have "sint (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)) 
         = sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word)"
       apply(rule scast_down_range)
       unfolding sint_eq using sints32 sum_geq sum_leq by auto
     then have cast_eq:"(sint ((scast (((scast w1)::64 Word.word) 
         + ((scast w2)::64 Word.word)))::word)) 
       = sint w1 + sint w2"
       using scast_down_range sints32 sum_geq sum_leq sint_eq by auto
     from something and cast_eq 
     have r12_sint_scast:"r'\<^sub>1 + r'\<^sub>2 
       = (sint ((scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)))::word))"
       using r1w1 w1U w1L r2w1 w2U w2L 
       by (simp)
     have leq_ref:"\<And>x y ::real. x = y ==> x \<le> y" by auto
     show ?thesis
       apply(rule exI[where x="r'\<^sub>1 + r'\<^sub>2"])
       apply(rule conjI)
       subgoal 
         using r12_sint_scast cast_eq leq_ref r2w1 r1w1 add_mono[of r'\<^sub>1 r1 r'\<^sub>2 r2] bound1 bound2
         by auto
       using bound1 bound2 add_mono r12_sint_scast cast_eq sum_leq sum_leq' sum_geq' sum_geq
       \<open>r'\<^sub>1 + r'\<^sub>2 =  (real_of_int (sint (scast (scast w1 + scast w2))))\<close> 
       by auto
     qed
   have neg_inf_case:"?sum <=s ((scast ((NEG_INF)::word))::64 Word.word)  \<Longrightarrow> NEG_INF \<equiv>\<^sub>L r1 + r2"
   proof (unfold repL_def NEG_INF_def repe.simps)
     assume "scast w1 + scast w2 <=s ((scast ((- (2 ^ 31 - 1))::word))::64 Word.word)"
     then have "scast w1 + scast w2 <=s ((- 0x7FFFFFFF)::64 Word.word)" 
       by (metis anEq)
     then obtain r' where geq:"(r' \<le> r1 + r2)" and leq:"(r' \<le> (-0x7FFFFFFF))"
       using bigOne by auto
     show "(\<exists>r'\<le>plus r1  r2.
       (\<exists>r. uminus (minus(2 ^ 31) 1) = POS_INF \<and> r' = r \<and>  (real_of_int (sint POS_INF)) \<le> r)
     \<or> (\<exists>r. uminus (minus(2 ^ 31) 1) = uminus (minus(2 ^ 31)  1) 
         \<and> r' = r \<and> r \<le>  (real_of_int (sint ((uminus (minus(2 ^ 31) 1))::word))))
     \<or> (\<exists>w. uminus (minus(2 ^ 31) 1) = w \<and>
            r' =  (real_of_int (sint w)) \<and>
             (real_of_int (sint w)) <  (real_of_int (sint POS_INF)) 
         \<and> less ( (real_of_int (sint (uminus (minus(2 ^ 31) 1))))) ((real_of_int (sint w)))))"
     using  leq geq by auto
   qed
   have bigThree:"0x7FFFFFFF <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word) 
     \<Longrightarrow> \<exists>r'\<le>r1 + r2. 2147483647 \<le> r'"
   proof -
     assume "0x7FFFFFFF <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
     then have sum_leq:"0x7FFFFFFF \<le> sint w1 + sint w2 "
           and sum_leq':" 2147483647 \<le>  (sint w1 + sint w2)"
-      using sint_eq unfolding Word.word_sle_def by auto 
+      using sint_eq unfolding word_sle_eq by auto 
     obtain r'\<^sub>1 r'\<^sub>2 ::real where 
       bound1:"r'\<^sub>1 \<le> r1 \<and> (w1 \<equiv>\<^sub>E r'\<^sub>1)" and
       bound2:"r'\<^sub>2 \<le> r2 \<and> (w2 \<equiv>\<^sub>E r'\<^sub>2)"
       using lo1 lo2 unfolding repL_def by auto
     have somethingA:"r'\<^sub>1  \<le>  sint w1" and somethingB:"r'\<^sub>2  \<le>  sint w2" 
       using \<open> 0x7FFFFFFF <=s scast w1 + scast w2 \<close> word_sle_def notinf1 notinf2
         bound1 bound2 repe.simps
       by auto
     have something:"r'\<^sub>1 + r'\<^sub>2 \<le>  sint w1 + sint w2"
       using somethingA somethingB add_mono of_int_add  
       by fastforce  
     show "\<exists>r'\<le> r1 + r2.  (2147483647) \<le> r'"
       apply(rule exI[where x = "r'\<^sub>1 + r'\<^sub>2"])
       using bound1 bound2 add_mono something sum_leq' order.trans
     proof -
       have f1: " (real_of_int (sint w2)) = r'\<^sub>2"
         by (metis bound2 notinf2 notneginf2 repe.cases)
       have " (real_of_int (sint w1)) = r'\<^sub>1"
         by (metis bound1 notinf1 notneginf1 repe.cases)
       then have f2: " (real_of_int 2147483647) \<le> r'\<^sub>2 + r'\<^sub>1"
         using f1 sum_leq' by force
       have "r'\<^sub>2 + r'\<^sub>1 \<le> r2 + r1"
         by (meson add_left_mono add_right_mono bound1 bound2 order.trans)
       then show "r'\<^sub>1 + r'\<^sub>2 \<le> r1 + r2 \<and>  2147483647 \<le> r'\<^sub>1 + r'\<^sub>2"
         using f2 by (simp add: add.commute)
     qed
   qed
   have inf_case:"((scast POS_INF)::64 Word.word) <=s ?sum \<Longrightarrow> POS_INF \<equiv>\<^sub>L r1 + r2"
     proof -
       assume "((scast POS_INF)::64 Word.word) 
           <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
       then have "((scast ((2 ^ 31 - 1)::word))::64 Word.word) 
              <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
         unfolding  repL_def repe.simps by auto
       then have "(0x7FFFFFFF::64 Word.word) 
              <=s ((scast w1)::64 Word.word) + ((scast w2)::64 Word.word)"
         by auto
       then obtain r' where geq:"(r' \<le> r1 + r2)" and leq:"(0x7FFFFFFF \<le> r')"
         using bigThree by auto
       show "?thesis"
         unfolding repL_def repe.simps using leq geq by auto
     qed
   have int_case:"\<not>(((scast POS_INF)::64 Word.word) <=s ?sum) 
     \<Longrightarrow> \<not> (?sum <=s ((scast NEG_INF)::64 Word.word)) 
     \<Longrightarrow> ((scast ?sum)::word) \<equiv>\<^sub>L r1 + r2"
   proof -
     assume bound1:"\<not> ((scast POS_INF)::64 Word.word) <=s scast w1 + scast w2"
     assume bound2:"\<not> scast w1 + scast w2 <=s ((scast NEG_INF)::64 Word.word)"
     obtain r'::real  
       where rDef:"r' = (real_of_int (sint ((scast (((scast w1)::64 Word.word) 
                      + ((scast w2)::64 Word.word)))::word)))"
       and r12:"r'\<le>r1 + r2" 
       and boundU:"r' <  0x7FFFFFFF" 
       and boundL:" (-0x7FFFFFFF) < r'"
       using bigTwo[OF bound1 bound2] by auto
     obtain w::word 
     where wdef:"w = (scast (((scast w1)::64 Word.word) + ((scast w2)::64 Word.word))::word)"
       by auto
     then have wr:"r' =  (real_of_int (sint w))"
       using r12 bound1 bound2 rDef by blast
     show ?thesis
       unfolding repL_def repe.simps 
       using r12 wdef rDef boundU boundL wr  
       by auto 
   qed
   have "(let sum = ?sum in
     if scast POS_INF <=s sum then POS_INF 
     else if sum <=s scast NEG_INF then NEG_INF 
     else scast sum) \<equiv>\<^sub>L r1 + r2"
     apply(cases "((scast POS_INF)::64 Word.word) <=s ?sum")
      apply(cases "?sum <=s scast NEG_INF")
       using inf_case neg_inf_case int_case by (auto simp add: Let_def)
   then show ?thesis 
     using notinf1 notinf2 notneginf1 notneginf2
     by(auto)
 qed
 qed
 
 subsection \<open>Max function\<close>
 
 text\<open>Maximum of w1 + w2 in 2s-complement\<close>
 fun wmax :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wmax w1 w2 = (if w1 <s w2 then w2 else w1)"
 
 text\<open>Correctness of wmax\<close>
 lemma wmax_lemma:
   assumes eq1:"w1 \<equiv>\<^sub>E (r1::real)"
   assumes eq2:"w2 \<equiv>\<^sub>E (r2::real)"
   shows "wmax w1 w2 \<equiv>\<^sub>E (max r1 r2)"
 proof(cases rule: case_inf2[where ?w1.0=w1, where ?w2.0=w2])
   case PosPos
   from PosPos eq1 eq2
   have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
   and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)
   have eqInf:"wmax w1 w2 = POS_INF"
     using PosPos unfolding wmax.simps by auto
   have pos_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2
     by linarith
   show ?thesis
     using pos_eq eqInf by auto
 next
   case PosNeg
   from PosNeg 
   have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
    and bound2:"r2 \<le> (real_of_int (sint NEG_INF))"
     using eq1 eq2 by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     unfolding eq1 eq2 wmax.simps PosNeg word_sless_def word_sle_def
     by(auto) 
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 eq1 eq2 by auto
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case PosNum
   from PosNum eq1 eq2
   have bound1:" (real_of_int (sint POS_INF)) \<le> r1"
   and bound2a:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
   and bound2b:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     using PosNum bound2b 
     unfolding wmax.simps word_sless_def word_sle_def
     by auto 
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply (rule repPOS_INF)
     using bound1 bound2a bound2b word_sless_alt le_max_iff_disj 
     unfolding eq1 eq2 by blast
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case NegPos
   from NegPos eq1 eq2
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:" (real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)
   have eqNeg:"wmax w1 w2 = POS_INF"
     unfolding NegPos word_sless_def word_sle_def
     by(auto)
   have neg_eq:"POS_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 by auto
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNeg
   from NegNeg eq1 eq2
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"NEG_INF \<equiv>\<^sub>E max r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1 bound2
     by(auto)
   have neg_eq:"wmax w1 w2 = NEG_INF"
     using NegNeg by auto 
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNum
   from NegNum eq1 eq2
   have eq3:"r2 = (real_of_int (sint w2))"
    and bound2a:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
    and bound2b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
    and bound1:"r1 \<le> (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)
   have eqNeg:"max r1 r2 = (real_of_int (sint w2))"
     using NegNum assms(2) bound2a eq3 repeInt_simps bound1 bound2a bound2b
     by (metis less_irrefl max.bounded_iff max_def not_less)
   then have extra_eq:"(wmax w1 w2) = w2"
     using assms(2) bound2a eq3 NegNum repeInt_simps 
     by (simp add: word_sless_alt)
   have neg_eq:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply(rule repINT)
     using extra_eq eq3 bound2a bound2b by(auto)
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using eqNeg neg_eq extra_eq by auto
 next
   case NumPos
   from NumPos eq1 eq2
   have p2:"w2 = POS_INF"
    and eq1:"r1 = (real_of_int (sint w1))"
    and eq2:"r2 = r2"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     by (auto simp add: repe.simps)    
   have res1:"wmax w1 w2 = POS_INF"
     using NumPos p2 eq1 eq2 assms(1) bound1b p2 repeInt_simps 
     by (simp add: word_sless_alt)
   have res3:"POS_INF \<equiv>\<^sub>E max r1 r2"
     using repPOS_INF NumPos bound2 le_max_iff_disj by blast
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2" 
     using res1 res3 by auto
 next
   case NumNeg
   from NumNeg eq1 eq2
   have n2:"w2 = NEG_INF"
    and rw1:"r1 = (real_of_int (sint w1))"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2:"r2 \<le> (real_of_int (sint NEG_INF))"
     by (auto simp add: repe.simps)    
   have res1:"max r1 r2 = (real_of_int (sint (wmax w1 w2)))"
     using bound1b bound2 NumNeg less_trans wmax.simps of_int_less_iff 
       word_sless_alt rw1 antisym_conv2 less_imp_le max_def
     by metis
   have res2:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply(rule repINT)
     using bound1a bound1b bound2 NumNeg leD leI less_trans n2 wmax.simps 
     by (auto simp add: word_sless_alt)
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using res1 res2 by auto
 next
   case NumNum
   from NumNum eq1 eq2
   have eq1:"r1 = (real_of_int (sint w1))"
    and eq2:"r2 = (real_of_int (sint w2))"
    and bound1a:"(real_of_int (sint w1)) < (real_of_int (sint POS_INF))"
    and bound1b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w1))"
    and bound2a:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
    and bound2b:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
     by (auto simp add: repe.simps)    
   have res1:"max r1 r2 = (real_of_int (sint (wmax w1 w2)))"
     using eq1 eq2 bound1a bound1b bound2a bound2b
     by (simp add: max_def word_sless_alt)
   have res2:"wmax w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmax w1 w2)))"
     apply (rule repINT)
     using bound1a bound1b bound2a bound2b
     by (simp add: \<open>max r1 r2 =  (real_of_int (sint (wmax w1 w2)))\<close> eq2 min_less_iff_disj)+
   show "wmax w1 w2 \<equiv>\<^sub>E max r1 r2"
     using res1 res2 by auto
 qed
 
 lemma max_repU1:
   assumes "w1 \<equiv>\<^sub>U x"
   assumes "w2 \<equiv>\<^sub>U y"
   shows "wmax w1 w2 \<equiv>\<^sub>U x "
   using wmax_lemma assms repU_def
   by (meson le_max_iff_disj)
   
 lemma max_repU2:
   assumes "w1 \<equiv>\<^sub>U y"
   assumes "w2 \<equiv>\<^sub>U x"
   shows "wmax w1 w2 \<equiv>\<^sub>U x"
   using wmax_lemma assms repU_def
   by (meson le_max_iff_disj)
 
 text\<open>Product of w1 * w2 with bounds checking\<close>
 fun wtimes :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wtimes w1 w2 =
  (if w1 = POS_INF \<and> w2 = POS_INF then POS_INF
   else if w1 = NEG_INF \<and> w2 = POS_INF then NEG_INF
   else if w1 = POS_INF \<and> w2 = NEG_INF then NEG_INF
   else if w1 = NEG_INF \<and> w2 = NEG_INF then POS_INF
   
   else if w1 = POS_INF \<and> w2 <s 0 then NEG_INF 
   else if w1 = POS_INF \<and> 0 <s w2 then POS_INF 
   else if w1 = POS_INF \<and> 0 = w2 then 0 
   else if w1 = NEG_INF \<and> w2 <s 0 then POS_INF 
   else if w1 = NEG_INF \<and> 0 <s w2 then NEG_INF 
   else if w1 = NEG_INF \<and> 0 = w2 then 0 
   
   else if w1 <s 0 \<and> w2 = POS_INF then NEG_INF 
   else if 0 <s w1 \<and> w2 = POS_INF then POS_INF 
   else if 0 = w1 \<and> w2 = POS_INF then 0
   else if w1 <s 0 \<and> w2 = NEG_INF then POS_INF 
   else if 0 <s w1 \<and> w2 = NEG_INF then NEG_INF 
   else if 0 = w1 \<and> w2 = NEG_INF then 0 
   
   else 
   (let prod::64 Word.word = (scast w1) * (scast w2) in
    if prod <=s (scast NEG_INF) then NEG_INF
    else if (scast POS_INF) <=s prod then POS_INF
    else (scast prod)))"
 
 
 subsection \<open>Multiplication upper bound\<close>
 text\<open>Product of 32-bit numbers fits in 64 bits\<close>
 lemma times_upcast_lower:
   fixes x y::int
   assumes a1:"x \<ge> -2147483648"
   assumes a2:"y \<ge> -2147483648"
   assumes a3:"x \<le> 2147483648"
   assumes a4:"y \<le> 2147483648"
   shows "- 4611686018427387904 \<le>  x * y"
 proof -
   let ?thesis = "- 4611686018427387904 \<le> x * y"
   have is_neg:"- 4611686018427387904 < (0::int)" by auto
   have case1:"x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<ge> 0"
       have h1:"x * y \<ge> 0"
         using a5 a6 by (simp add: zero_le_mult_iff)
       then show ?thesis using is_neg by auto
     qed
   have case2:"x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis" 
     proof -
       assume a5:"x \<le> 0" and a6:"y \<ge> 0"
       have h1:"-2147483648 * (2147483648) \<le> x * 2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"-2147483648 \<le> y" using a6 by auto
       have h3:"x * 2147483648 \<le> x * y" 
         using a1 a2 a3 a4 a5 a6 h2 
         using mult_left_mono_neg by blast
       show ?thesis using h1 h2 h3 by auto
     qed
   have case3:"x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<le> 0"
       have h1:"2147483648 * (-2147483648) \<le> 2147483648 * y"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"-2147483648 \<le> x" using a5 by auto
       have h3:"2147483648 * y \<le> x * y" 
         using a1 a2 a3 a4 a5 a6 h2 
         using mult_left_mono_neg mult_right_mono_neg by blast
       show ?thesis using h1 h2 h3 by auto
     qed
   have case4:"x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
   proof -
       assume a5:"x \<le> 0" and a6:"y \<le> 0"
       have h1:"x * y \<ge> 0"
         using a5 a6 by (simp add: zero_le_mult_iff)
       then show ?thesis using is_neg by auto
     qed
   show ?thesis
     using case1 case2 case3 case4 by linarith
 qed
 
 text\<open>Product of 32-bit numbers fits in 64 bits\<close>
 lemma times_upcast_upper:
   fixes x y ::int
   assumes a1:"x \<ge> -2147483648"
   assumes a2:"y \<ge> -2147483648"
   assumes a3:"x \<le> 2147483648"
   assumes a4:"y \<le> 2147483648"
   shows "x * y \<le> 4611686018427387904" 
 proof -
   let ?thesis = "x * y \<le> 4611686018427387904"
   have case1:"x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<ge> 0"
       have h1:"2147483648 * 2147483648 \<ge> x * 2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"x * 2147483648 \<ge> x * y" 
         using a1 a2 a3 a4 a5 a6 by (simp add: mult_mono)
       show ?thesis using h1 h2 by auto
     qed
   have case2:"x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<le> 0" and a6:"y \<ge> 0"
       have h1:"2147483648 * 2147483648 \<ge> (0::int)" by auto
       have h2:"0 \<ge> x * y"
         using a5 a6 mult_nonneg_nonpos2 by blast
       show ?thesis using h1 h2 by auto
     qed
   have case3:"x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<ge> 0" and a6:"y \<le> 0"
       have h1:"2147483648 * 2147483648 \<ge> (0::int)" by auto
       have h2:"0 \<ge> x * y"
         using a5 a6 mult_nonneg_nonpos by blast
       show ?thesis using h1 h2 by auto
     qed
   have case4:"x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume a5:"x \<le> 0" and a6:"y \<le> 0"
       have h1:"-2147483648 * -2147483648 \<ge> x * -2147483648"
         using a1 a2 a3 a4 a5 a6 by linarith
       have h2:"x * -2147483648 \<ge> x * y" 
         using a1 a2 a3 a4 a5 a6 mult_left_mono_neg by blast
       show ?thesis using h1 h2 by auto
     qed
 show "x * y \<le> 4611686018427387904"
   using case1 case2 case3 case4
   by linarith
 qed
    
 text\<open>Correctness of 32x32 bit multiplication\<close>
 
 subsection \<open>Exact multiplication\<close>
 lemma wtimes_exact:
 assumes eq1:"w1 \<equiv>\<^sub>E r1"
 assumes eq2:"w2 \<equiv>\<^sub>E r2"
 shows "wtimes w1 w2 \<equiv>\<^sub>E r1 * r2"
 proof -
   have POS_cast:"sint ((scast POS_INF)::64 Word.word) = sint POS_INF"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have POS_sint:"sint POS_INF = (2^31)-1"  by auto
   have w1_cast:"sint ((scast w1)::64 Word.word) = sint w1"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have w2_cast:"sint ((scast w2)::64 Word.word) = sint w2"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have NEG_cast:"sint ((scast NEG_INF)::64 Word.word) = sint NEG_INF"
     apply(rule Word.sint_up_scast)
     unfolding Word.is_up by auto
   have rangew1:"sint ((scast w1)::64 Word.word) \<in> {- (2 ^ 31).. (2^31)} " 
     using Word.word_sint.Rep[of "(w1)::32 Word.word"] sints32 len32 mem_Collect_eq POS_cast w1_cast 
     by auto
   have rangew2:"sint ((scast w2)::64 Word.word) \<in> {- (2 ^ 31).. (2^31)} " 
     using Word.word_sint.Rep[of "(w2)::32 Word.word"] sints32 len32 mem_Collect_eq POS_cast w2_cast 
     by auto
   show ?thesis
 proof (cases rule: case_times_inf[of w1 w2])
   case PosPos then
   have a1: "PosInf \<le> r1"
   and  a2: "PosInf \<le> r2" 
     using "PosPos" eq1 eq2 repe.simps by (auto)
   have f3: "\<And>n e::real.  1 \<le> max ( (numeral n)) e"
     by (simp add: le_max_iff_disj)
   have "\<And>n e::real. 0 \<le> max ( (numeral n)) e"
     by (simp add: le_max_iff_disj)
   then have "r1 \<le> r1 * r2"
     using f3 "PosPos" eq1 eq2 repe.simps
     using eq1 eq2 by (auto simp add: repe.simps)
   then have "PosInf \<le> r1 * r2"
     using a1 by linarith
   then show ?thesis
     using "PosPos"  by(auto simp add: repe.simps)
 next
   case NegPos
   from "NegPos" have notPos:"w1 \<noteq> POS_INF" unfolding POS_INF_def NEG_INF_def by auto
   have a1: "NegInf \<ge> r1"
     using eq1 "NegPos" by (auto simp add: repe.simps)
   have a2: "PosInf \<le> r2"
     using eq2 "NegPos" by (auto simp add: repe.simps)
   have f1: "real_of_int Numeral1 = 1"
     by simp
   have f3: "(real_of_int 3) \<le> - r1"
     using a1 by (auto)
   have f4:"0 \<le> r2"
     using f1 a2 by(auto)
   have f5: "r1 \<le>  - 1"
     using f3 by auto
   have fact:"r1 * r2 \<le> - r2"
     using f5 f4 mult_right_mono by fastforce
   show ?thesis
     using a1 a2 fact by (auto simp add: repe.simps "NegPos")
 next
   case PosNeg
   have a1: "PosInf \<le> r1"
     using eq1 "PosNeg" by (auto simp add: repe.simps)
   then have h1:"r1 \<ge> 1"
     by (auto)
   have a2: " NegInf \<ge> r2"
     using eq2 "PosNeg" by (auto simp add: repe.simps)
   have f1: "\<not>  NegInf *  (- 1) \<le> 1"
     by (auto)
   have f2: "\<forall>e ea::real. (e *  (- 1) \<le> ea) = (ea *  (- 1) \<le> e)" by force
   then have f3: "\<not> 1 *  (- 1::real) \<le>  NegInf"
     using f1 by blast
   have f4: "r1 *  (- 1) \<le>  NegInf"
     using f2 a1 
     by(auto)
   have f5: "\<forall>e ea eb. (if (ea::real) \<le> eb then e \<le> eb else e \<le> ea) = (e \<le> ea \<or> e \<le> eb)"
     by force
   have " 0 *  (- 1::real) \<le> 1"
     by simp
   then have "r1 *  (- 1) \<le>  0"
     using f5 f4 f3 f2 by meson
   then have f6: "0 \<le> r1" by fastforce
   have "1 *  (- 1) \<le>  (- 1::real)"
     using f2 by force
   then have fact:"r2 \<le>  (- 1)"
     using f3 a2 by fastforce
   have rule:"\<And>c. c > 0 \<Longrightarrow> r1 \<ge> c \<and> r2 \<le> -1 \<Longrightarrow> r1 * r2 \<le> -c"
     apply auto
     by (metis (no_types, hide_lams) f5 mult_less_cancel_left_pos 
         mult_minus1_right neg_le_iff_le not_less)
   have "r1 * r2 \<le> NegInf"
     using "PosNeg" f6 fact rule[of PosInf] a1
     by(auto)
   then show ?thesis
     using "PosNeg" by (auto simp add: repe.simps)
 next
   case NegNeg
   have a1: "(-2147483647) \<ge> r1"
     using eq1 "NegNeg" by (auto simp add: repe.simps)
   then have h1:"r1 \<le> -1"
     using max.bounded_iff max_def one_le_numeral
     by auto
   have a2: " (-2147483647) \<ge> r2"
     using eq2 "NegNeg" by (auto simp add: repe.simps)
   have f1: "\<forall>e ea eb. \<not> (e::real) \<le> ea \<or> \<not> 0 \<le> eb \<or> eb * e \<le> eb * ea"
     using mult_left_mono by metis
   have f2: "-  1 =  (- 1::real)"
     by force
   have f3: " 0 \<le>  (1::real)"
     by simp
   have f4: "\<forall>e ea eb. (ea::real) \<le> e \<or> \<not> ea \<le> eb \<or> \<not> eb \<le> e"
     by (meson less_le_trans not_le)
   have f5: " 0 \<le>  (2147483647::real)"
     by simp
   have f6: "-  (- 2147483647) =  (2147483647::real)"
     by force
   then have f7: "- ( (- 2147483647) * r1) =  (2147483647 * r1)"
     by (metis mult_minus_left)
   have f8: "- ( (- 2147483647) *  (- 1)) =  2147483647 *  (- 1::real)"
     by simp
   have " 2147483647 = -  1 *  (- 2147483647::real)"
     by simp
   then have f9: "r1 \<le>  (- 1) \<longrightarrow>  2147483647 \<le> r1 *  (- 2147483647)"
     using f8 f7 f5 f2 f1 by linarith
   have f10: "-  2147483647 =  (- 2147483647::real)"
     by fastforce
   have f11: "- (r2 *  1 * (r1 *  (- 1))) = r1 * r2"
     by (simp add: mult.commute)
   have f12: "r1 *  (- 1) = - (r1 *  1)"
     by simp
   have "r1 *  1 * ( (- 2147483647) *  1) =  (- 2147483647) * r1"
     by (simp add: mult.commute)
   then have f13: "r1 *  (- 1) * ( (- 2147483647) *  1) =  2147483647 * r1"
     using f12 f6 by (metis (no_types) mult_minus_left)
   have " 1 * r1 \<le>  1 *  (- 2147483647)"
     using a1 
     by (auto simp add: a1)
   then have " 2147483647 \<le> r1 *  (- 1)" by fastforce
   then have "0 \<le> r1 *  (- 1)"
     using f5 f4 by (metis)
   then have "r1 \<le>  (- 1) \<and> - (r1 *  2147483647) \<le> - (r2 *  1 * (r1 *  (- 1)))"
     by (metis a2 f11 h1 mult_left_mono_neg minus_mult_right mult_minus1_right neg_0_le_iff_le)
   then have "r1 \<le>  (- 1) \<and> r1 *  (- 2147483647) \<le> r2 * r1"
     using f11 f10 by (metis mult_minus_left mult.commute)
   then have fact:" 2147483647 \<le> r2 * r1"
     using f9 f4 by blast
   show ?thesis
     using a1 a2 h1 fact
     by (auto simp add: repe.simps "NegNeg" mult.commute)
 next
   case PosLo
   from "PosLo"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" by (auto)
   from eq1 "PosLo" 
   have upper:" (real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 < 0" using "PosLo" 
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w2 \<le> -1" by auto
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosLo"  
     by (auto simp add: repe.simps)
   have f4: "r1 *  (- 1) \<le>  (- 2147483647)"
     using upper by (auto)
   have f5: "r2 \<le>  (- 1)"
     using lower2 rw2 by simp
   have "0 < r1"
     using upper by (auto) 
   have "\<forall>r. r < - 2147483647 \<or> \<not> r < r1 * - 1"
     using f4 less_le_trans by blast
   then have "r1 *  (real_of_int (sint w2)) \<le>  (- 2147483647)"
     using f5 f4 upper lower2 rw2 mult_left_mono
     by (metis \<open>0 < r1\<close> dual_order.order_iff_strict f5 mult_left_mono rw2)
   then have "r1 * r2 \<le> real_of_int (sint NEG_INF)" 
     using upper lower2  rw2 
     by (auto)
   then show ?thesis
     using "PosLo" by (auto simp add: repe.simps)
 next
   case PosHi
   from "PosHi"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     by (auto)
   from eq1 "PosHi" 
   have upper:"(real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 > 0" using "PosHi" 
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w2 \<ge> 1" by auto
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosHi"
     by (auto) 
   have "0 \<le> r1" using upper by (auto)
   then have "r1 \<le> r1 * r2"
     using rw2 lower2 by (metis (no_types)  mult_left_mono mult.right_neutral of_int_1_le_iff)
   have "PosInf \<le> r1 * r2"
       using upper lower2 rw2 
       apply (auto)
       using \<open>0 \<le> r1\<close> mult_mono mult_numeral_1_right numeral_One of_int_1_le_iff zero_le_one
       by metis
   then show ?thesis
   using "PosHi" by (auto simp add: repe.simps)
 next
   case PosZero
   from "PosZero"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF"
     by (auto)
   from eq1 "PosZero"
   have upper:" (real_of_int (sint POS_INF)) \<le> r1 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w2 = 0" using "PosZero" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "PosZero" 
     by auto 
   have "0 = r1 * r2"
     using "PosZero" rw2 by auto
   then show ?thesis
     using "PosZero" by (auto simp add: repe.simps)
 next
   case NegHi
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     using "NegHi" by (auto)
   from eq1 "NegHi" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r1 " 
     by (auto simp add: repe.simps)
   have low:"sint w2 > 0" using "NegHi"
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w2)) > 0" by auto
   then have lower2:"(real_of_int (sint w2)) \<ge> 1"  
     using low
     by (simp add: int_le_real_less) 
   from eq1 have rw1:"r1 \<le> (real_of_int (sint w1))" 
     using repe.simps "NegHi" 
     by (simp add: upper)
   from eq2 have rw2:"r2 = (real_of_int (sint w2))" 
     using repe.simps "NegHi"
     by (auto)
   have mylem:"\<And>x y z::real. x \<le> -1 \<Longrightarrow> y \<ge> 1 \<Longrightarrow> z \<le> -1 \<Longrightarrow> x \<le> z \<Longrightarrow>  x * y \<le> z"
     proof -
     fix x y z::real
     assume a1:"x \<le> -1"
     assume a2:"y \<ge> 1"
     then have h1:"-1 \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0"  by auto
     from a4 have h2:"-z > 0"  using leD leI by auto
     from a3 have h5:"-z \<ge> 1"  by (simp add: leD leI)
     assume a5:"x \<le> z"
     then have h6:"-x \<ge> -z" by auto
     have h3:"-x * -z = x * z" by auto
     show "x * y \<le> z"
       using a1 a2 a3 a5 a4 h1 h2 h3 h6 h5 a5 dual_order.trans leD mult.right_neutral
       by (metis dual_order.order_iff_strict mult_less_cancel_left2)
     qed
   have prereqs:"r1 \<le> - 1" "1 
       \<le> (real_of_int (sint w2))" " (- 2147483647::real) \<le> - 1 " "r1 \<le> (-2147483647)"
     using rw1 rw2 "NegHi" lower2 by (auto simp add: word_sless_def word_sle_def)
   have "r1 * r2 \<le> real_of_int (sint NEG_INF)"
     using upper lower1 lower2 rw1 rw2 
     apply (auto simp add: word_sless_def word_sle_def)
     using mylem[of  "r1" " (real_of_int (sint w2))" " (- 2147483647)"] prereqs
     by auto
   then show ?thesis
     using "NegHi" by (auto simp add: repe.simps)
 next
   case NegLo
   from "NegLo"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" 
     by (auto)
   from eq1 "NegLo" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r1" 
   by (auto simp add: repe.simps)
   have low:"sint w2 < 0" using "NegLo"
     by (auto simp add: word_sless_def word_sle_def dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w2)) < 0" by auto
   then have lower2:"(real_of_int (sint w2)) \<le> -1"  using low
   by (simp add: int_le_real_less) 
   from eq1 have rw1:"r1 \<le>  (real_of_int (sint w1))" 
     using repe.simps "NegLo"
     by (simp add: upper)
   from eq2 have rw2:"r2 =  (real_of_int (sint w2))" 
     using repe.simps "NegLo"
     by (auto)
   have hom:"(- 2147483647) = -(2147483647::real)" by auto
   have mylem:"\<And>x y z::real. y < 0 \<Longrightarrow>   x \<le> y \<Longrightarrow> z \<le> -1 \<Longrightarrow> -y \<le> x * z"
     proof -
     fix x y z::real
     assume a1:"y < 0"
     assume a2:"x \<le> y"
     then have h1:"-x \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0" 
       by auto
     from a4 have h2:"-z > 0" using leD leI by auto
     from a3 have h5:"-z \<ge> 1" by (simp add: leD leI)
     have h4:"-x * -z \<ge> -y"
       using  a1 a2 a3 a4 h1 h2 h5 dual_order.trans mult.right_neutral
       by (metis mult.commute neg_0_less_iff_less real_mult_le_cancel_iff1)
     have h3:"-x * -z = x * z" by auto
     show "- y \<le> x * z "
       using a1 a2 a3 a4 h1 h2 h3 h4 h5 
       by simp
     qed
   have prereqs:"- 2147483647 < (0::real)" " r1 \<le> - 2147483647" " (real_of_int (sint w2)) \<le> - 1"
     using rw1 rw2 "NegLo" by (auto simp add: word_sless_def word_sle_def lower2)
   have "2147483647 \<le> r1 * r2" 
     using upper lower1 lower2 rw1 rw2 prereqs
       mylem[of "-2147483647" "r1" "(real_of_int (sint w2))"] 
     by (auto simp add: word_sless_def word_sle_def)
   then show ?thesis
     using "NegLo" by (auto simp add: repe.simps)
 next
   case NegZero
   from "NegZero"
   have w2NotPinf:"w2 \<noteq> POS_INF" and w2NotNinf:"w2 \<noteq> NEG_INF" by (auto)
   from eq2 "NegZero" 
   have "r2 = 0" 
     using repe.simps "NegZero"
     by (auto)
   then show ?thesis
     using "NegZero" by (auto simp add: repe.simps)
 next
   case LoPos
   from "LoPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "LoPos" 
   have upper:"(real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 < 0" using "LoPos"
     apply (auto simp add: word_sless_def word_sle_def)   
     by (simp add: dual_order.order_iff_strict)
   then have lower2:"sint w1 \<le> -1" by auto
   from eq1 have rw1:"r1 = (real_of_int (sint w1))" 
     using repe.simps "LoPos" by (auto simp add: repe.simps)
   have f4: "r2 * (- 1) \<le> (- 2147483647)"
     using upper by(auto)
   have f5: "r1 \<le> (- 1)"
     using lower2 rw1 by simp
   have "0 < r2"
     using upper by(auto)
   then have "r2 * r1 \<le> r2 * (- 1)"
     by (metis dual_order.order_iff_strict mult_right_mono f5  mult.commute)
   then have "r2 * r1 \<le> (- 2147483647)"
     by (meson f4 less_le_trans not_le)
   then have "(real_of_int (sint w1)) * r2 \<le> (- 2147483647)"
     using f5 f4 rw1 less_le_trans not_le mult.commute rw1 
     by (auto simp add: mult.commute)
   then have "r1 * r2 \<le> NegInf"
     using rw1
     by (auto)
   then show ?thesis
     using "LoPos" by (auto simp: repe.simps)
 next
   case HiPos
   from "HiPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "HiPos"
   have upper:"(real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 > 0" using "HiPos"
     by (auto simp add: word_sless_def word_sle_def dual_order.order_iff_strict)
   then have lower2:"sint w1 \<ge> 1" by auto
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using "HiPos" 
     by (auto simp add: repe.simps)
   have "0 \<le> r2"
     using upper by(auto)
   then have "r2 \<le> r2 * r1"
     using lower2 rw2 by (metis (no_types) mult_left_mono mult.right_neutral of_int_1_le_iff)
   have "2147483647 \<le> r1 * r2"
     using upper lower2  rw2 
     by (auto simp add: word_sless_def word_sle_def order_trans)
   then show ?thesis
     using "HiPos" by (auto simp add: repe.simps)
 next
   case ZeroPos
   from "ZeroPos"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   from eq2 "ZeroPos" 
   have upper:" (real_of_int (sint POS_INF)) \<le> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 = 0" using "ZeroPos" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps "ZeroPos" 
     by (auto)
   have "r1 = 0" using lower1 rw2 by auto
   then show ?thesis
     using "ZeroPos" by (auto simp add: repe.simps)
 next 
   case ZeroNeg
   from "ZeroNeg" 
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF" 
     by (auto)
   from eq2 "ZeroNeg" 
   have upper:"(real_of_int (sint NEG_INF)) \<ge> r2 " 
     by (auto simp add: repe.simps)
   have lower1:"sint w1 = 0" using "ZeroNeg" 
     by (auto simp add: word_sless_def word_sle_def)   
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps "ZeroNeg" 
     by (auto)
   have "r1 = 0" using lower1 rw2 by auto
   then show ?thesis
     using "ZeroNeg" by (auto simp add: repe.simps)
 next
   case LoNeg
   from "LoNeg"
   have w2NotPinf:"w1 \<noteq> POS_INF" and w2NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   from eq2 "LoNeg" 
   have upper:" (real_of_int (sint NEG_INF)) \<ge> r2 " 
     by (auto simp add: repe.simps)
   have low:"sint w1 < 0" using "LoNeg" 
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w1)) < 0" by auto
   then have lower2:"(real_of_int (sint w1)) \<le> -1"  using low
     by (simp add:  int_le_real_less) 
   from eq1 have rw1:"r2 \<le>  (real_of_int (sint w2))" 
     using "LoNeg" upper by auto
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using "LoNeg" by (auto simp add: upper repe.simps)
   have hom:"(- 2147483647::real) = -(2147483647)" by auto
   have mylem:"\<And>x y z::real. y < 0 \<Longrightarrow>   x \<le> y \<Longrightarrow> z \<le> -1 \<Longrightarrow> -y \<le> x * z"
     proof -
     fix x y z::real
     assume a1:"y < 0"
     assume a2:"x \<le> y"
     then have h1:"-x \<ge> -y" by auto
     assume a3:"z \<le> -1"
     then have a4:"z < 0" by auto
     from a4 have h2:"-z > 0" 
       using leD leI by auto
     from a3 have h5:"-z \<ge> 1" 
       by (simp add:  leD leI)
     have h4:"-x * -z \<ge> -y"
       using  a1 a2 a3 a4 h1 h2 h5 dual_order.trans mult_left_mono mult.right_neutral mult.commute
       by (metis dual_order.order_iff_strict mult_minus_right mult_zero_right neg_le_iff_le)
     have h3:"-x * -z = x * z" by auto
     show "- y \<le> x * z "
       using a1 a2 a3 a4 h1 h2 h3 h4 h5 
       by simp
     qed
   have prereqs:"- 2147483647 < (0::real)" " r2 \<le> - 2147483647" " (real_of_int (sint w1)) \<le> - 1"
     using rw1 rw2 "LoNeg" lower2 by (auto simp add: word_sless_def word_sle_def lower2)
   have "2147483647 \<le> r1 * r2"
     using upper lower1 lower2 rw1 rw2 mylem[of "-2147483647" "r2" 
         "(real_of_int (sint w1))"] prereqs
     by (auto simp add:word_sless_def word_sle_def mult.commute)
   then show ?thesis
     using "LoNeg" by (auto simp add: repe.simps)
 next
   case HiNeg
   from HiNeg
   have w1NotPinf:"w1 \<noteq> POS_INF" and w1NotNinf:"w1 \<noteq> NEG_INF"
     by (auto)
   have upper:" (real_of_int (sint NEG_INF)) \<ge> r2 " 
     using HiNeg eq2
     by (auto simp add: repe.simps )
   have low:"sint w1 > 0" using HiNeg 
     apply (auto simp add: word_sless_def word_sle_def)
     by (simp add: dual_order.order_iff_strict)
   then have lower1:"(real_of_int (sint w1)) > 0" by auto
   then have lower2:"(real_of_int (sint w1)) \<ge> 1"  using low
   by (simp add: int_le_real_less) 
   from eq2 have rw1:"r2 \<le>  (real_of_int (sint w2))" 
     using repe.simps HiNeg by (simp add: upper)
   from eq1 have rw2:"r1 =  (real_of_int (sint w1))" 
     using repe.simps HiNeg  
     by (auto)
   have mylem:"\<And>x y z::real. x \<le> -1 \<Longrightarrow> y \<ge> 1 \<Longrightarrow> z \<le> -1 \<Longrightarrow> x \<le> z \<Longrightarrow>  x * y \<le> z"
     proof -
       fix x y z::real
       assume a1:"x \<le> -1"
       assume a2:"y \<ge> 1"
       then have h1:"-1 \<ge> -y" by auto
       assume a3:"z \<le> -1"
       then have a4:"z < 0" by auto
       from a4 have h2:"-z > 0" 
         using  leD leI by auto
       from a3 have h5:"-z \<ge> 1" 
         by (simp add:  leD leI)
       assume a5:"x \<le> z"
       then have h6:"-x \<ge> -z" by auto
       have h3:"-x * -z = x * z" by auto
       show "x * y \<le> z"
         using a1 a2 a3 a4 h1 h2 h3 h6 h5 a5 dual_order.trans less_eq_real_def
         by (metis mult_less_cancel_left1 not_le)
     qed
   have prereqs:"r2 \<le> - 1" "1 \<le> (real_of_int (sint w1))" 
                " (- 2147483647) \<le> - (1::real )" "r2 \<le>  (- 2147483647)"
     using rw1 rw2 HiNeg lower2 by (auto simp add: word_sless_def word_sle_def)
   have "r1 * r2 \<le> - 2147483647"
     using upper lower1 lower2 rw1 rw2 
     apply (auto simp add: word_sless_def word_sle_def)
     using mylem[of "r2" "(real_of_int (sint w1))" " (- 2147483647)"] prereqs
     by (auto simp add: mult.commute)
   then show ?thesis
     using HiNeg by(auto simp add: repe.simps)
 next
   case AllFinite
   let ?prod = "(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))"
   consider 
       (ProdNeg) "?prod <=s ((scast NEG_INF)::64 Word.word)" 
     | (ProdPos) "(((scast POS_INF)::64 Word.word) <=s ?prod)"
     | (ProdFin) "\<not>(?prod <=s ((scast NEG_INF)::64 Word.word)) 
               \<and>  \<not>((scast POS_INF)::64 Word.word) <=s ?prod"
     by (auto)
   then show ?thesis
   proof (cases)
     case ProdNeg
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
      sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
      apply(rule Word_Lemmas.signed_arith_sint(4))
      using rangew1 rangew2 w1_cast w2_cast 
      using Word.word_size[of "((scast w1)::64 Word.word)"] 
      using Word.word_size[of "((scast w2)::64 Word.word)"]
      using times_upcast_upper[of "sint w1" "sint w2"]
      using times_upcast_lower[of "sint w1" "sint w2"] 
      by auto
     assume "?prod <=s ((scast NEG_INF)::64 Word.word)"
     then have sint_leq:"sint ?prod \<le> sint ((scast NEG_INF)::64 Word.word)"
       using word_sle_def by blast
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 = (real_of_int (sint w1))" using neqs by (auto simp add: repe.simps)
     from eq2 have rw2:"r2 = (real_of_int (sint w2))" using neqs by (auto simp add: repe.simps)
     show ?thesis
       using AllFinite ProdNeg  w1_cast w2_cast rw1 rw2 sint_leq  
       apply (auto simp add: repe.simps)
       by (metis (no_types, hide_lams) eq3 of_int_le_iff of_int_minus of_int_mult of_int_numeral) 
   next
     case ProdPos
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
       sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
       apply(rule Word_Lemmas.signed_arith_sint(4))
       using rangew1 rangew2 POS_cast POS_sint w1_cast w2_cast
       using Word.word_size[of "((scast w1)::64 Word.word)"] 
       using Word.word_size[of "((scast w2)::64 Word.word)"]
       using times_upcast_upper[of "sint w1" "sint w2"]
       using times_upcast_lower[of "sint w1" "sint w2"] 
       by auto
     assume cast:"((scast POS_INF)::64 Word.word) <=s ?prod"
     then have sint_leq:"sint ((scast POS_INF)::64 Word.word) \<le> sint ?prod"
       using word_sle_def by blast
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 =  (real_of_int (sint w1))" 
       using repe.simps AllFinite neqs by auto
     from eq2 have rw2:"r2 = (real_of_int (sint w2))" 
       using repe.simps AllFinite neqs by auto
     have prodHi:"r1 * r2 \<ge> PosInf"
       using w1_cast w2_cast rw1 rw2 sint_leq apply(auto)
       by (metis (no_types, hide_lams) eq3 of_int_le_iff of_int_mult of_int_numeral)
     have infs:"SCAST(32 \<rightarrow> 64) NEG_INF <s SCAST(32 \<rightarrow> 64) POS_INF"
       by (auto)
     have casted:"SCAST(32 \<rightarrow> 64) POS_INF <=s SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2"
       using cast by auto
     have almostContra:"SCAST(32 \<rightarrow> 64) NEG_INF <s SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2"
       using infs cast  signed.order.strict_trans2 by blast
     have contra:"\<not>(SCAST(32 \<rightarrow> 64) w1 * SCAST(32 \<rightarrow> 64) w2 <=s SCAST(32 \<rightarrow> 64) NEG_INF)"
       using eq3 almostContra by auto
     have wtimesCase:"wtimes w1 w2 = POS_INF"
       using neqs ProdPos almostContra wtimes.simps AllFinite ProdPos
       by (auto simp add: repe.simps Let_def)
     show ?thesis
       using prodHi
       apply(simp only: repe.simps)      
       apply(rule disjI1)
       apply(rule exI[where x= "r1*r2"])
       apply(rule conjI)
        apply(rule wtimesCase)
       using prodHi by auto
   next
     case ProdFin
     have bigLeq:"(4611686018427387904::real) \<le> 9223372036854775807" by auto
     have set_cast:"\<And>x::int. (x \<in> {-(2^31)..2^31}) = ( (real_of_int x) \<in> {-(2^31)..2^31})"
       by auto
     have eq3:"sint(((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)) = 
       sint ((scast w1)::64 Word.word) * sint ((scast w2)::64 Word.word)"
       apply(rule Word_Lemmas.signed_arith_sint(4))
       using rangew1 rangew2 POS_cast POS_sint w1_cast w2_cast 
       using Word.word_size[of "((scast w1)::64 Word.word)"] 
       using Word.word_size[of "((scast w2)::64 Word.word)"]
       using times_upcast_upper[of "sint w1" "sint w2"]
       using times_upcast_lower[of "sint w1" "sint w2"] 
       by auto
     from ProdFin have a1:"\<not>(?prod <=s ((scast NEG_INF)::64 Word.word))"
       by auto
     then have sintGe:"sint (?prod) > sint (((scast NEG_INF)::64 Word.word))"
       using word_sle_def dual_order.order_iff_strict signed.linear 
       by fastforce
     from ProdFin have a2:"\<not>((scast POS_INF)::64 Word.word) <=s ?prod"
       by auto
     then have sintLe:"sint (((scast POS_INF)::64 Word.word)) > sint (?prod)"
       using word_sle_def dual_order.order_iff_strict signed.linear 
       by fastforce
     have neqs:"w1 \<noteq> POS_INF" " w1 \<noteq> NEG_INF" "w2 \<noteq> POS_INF" "w2 \<noteq> NEG_INF"
       using AllFinite word_sless_def signed.not_less_iff_gr_or_eq by force+
     from eq1 have rw1:"r1 =  (real_of_int (sint w1))" using neqs by(auto simp add: repe.simps)
     from eq2 have rw2:"r2 =  (real_of_int (sint w2))" using neqs by(auto simp add: repe.simps)
     from rw1 rw2 have "r1 * r2 =  (real_of_int ((sint w1) * (sint w2)))"
       by simp
     have rightSize:"sint (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))
       \<in> sints (len_of TYPE(32))"
       using sintLe sintGe sints32 by (simp) 
     have downcast:"sint ((scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word)))::word)
                  = sint (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))"
       using scast_down_range[OF rightSize]
       by auto
     then have res_eq:"r1 * r2 
       = real_of_int(sint((scast (((scast w1)::64 Word.word)*((scast w2)::64 Word.word)))::word))"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast downcast 
         \<open>r1 * r2 =  (real_of_int (sint w1 * sint w2))\<close> 
       by (auto)
     have res_up:"sint (scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))::word) 
                < sint POS_INF"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast downcast
         \<open>r1 * r2 = (real_of_int (sint w1 * sint w2))\<close> 
         \<open>sint (scast w1 * scast w2) < sint (scast POS_INF)\<close> 
           of_int_eq_iff res_eq 
       by presburger
     have res_lo:"sint NEG_INF 
                < sint (scast (((scast w1)::64 Word.word) * ((scast w2)::64 Word.word))::word)"
       using rw1 rw2 eq3 POS_cast POS_sint w1_cast w2_cast NEG_cast downcast
         \<open>r1 * r2 =  (real_of_int (sint w1 * sint w2))\<close> 
         \<open>sint (scast NEG_INF) < sint (scast w1 * scast w2)\<close> 
         of_int_eq_iff res_eq 
       by presburger
     have "scast ?prod \<equiv>\<^sub>E (r1 * r2)"
       using res_eq res_up res_lo 
       by (auto simp add: rep_simps)
     then show ?thesis 
       using AllFinite ProdFin by(auto)
   qed
 qed
 qed
 
 subsection \<open>Multiplication upper bound\<close>
 text\<open>Upper bound of multiplication from upper and lower bounds\<close>
 fun tu :: "word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word"
 where "tu w1l w1u w2l w2u = 
  wmax (wmax (wtimes w1l w2l) (wtimes w1u w2l))
       (wmax (wtimes w1l w2u) (wtimes w1u w2u))"
 
 lemma tu_lemma:
   assumes u1:"u\<^sub>1 \<equiv>\<^sub>U (r1::real)"
   assumes u2:"u\<^sub>2 \<equiv>\<^sub>U (r2::real)"
   assumes l1:"l\<^sub>1 \<equiv>\<^sub>L (r1::real)"
   assumes l2:"l\<^sub>2 \<equiv>\<^sub>L (r2::real)"
   shows "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U (r1 * r2)"
 proof -
   obtain rl1 rl2 ru1 ru2 :: real 
   where gru1:"ru1 \<ge> r1" and gru2:"ru2 \<ge> r2" and grl1:"rl1 \<le> r1" and grl2:"rl2 \<le> r2" 
   and eru1:"u\<^sub>1 \<equiv>\<^sub>E ru1" and eru2:"u\<^sub>2 \<equiv>\<^sub>E ru2" and erl1:"l\<^sub>1 \<equiv>\<^sub>E rl1" and erl2:"l\<^sub>2 \<equiv>\<^sub>E rl2"
   using u1 u2 l1 l2 unfolding repU_def repL_def by auto
   have timesuu:"wtimes u\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E ru1 * ru2"
     using wtimes_exact[OF eru1 eru2] by auto
   have timesul:"wtimes u\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E ru1 * rl2"
     using wtimes_exact[OF eru1 erl2] by auto
   have timeslu:"wtimes l\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E rl1 * ru2"
     using wtimes_exact[OF erl1 eru2] by auto
   have timesll:"wtimes l\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E rl1 * rl2"
     using wtimes_exact[OF erl1 erl2] by auto
   have maxt12:"wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>E max (rl1 * rl2) (ru1 * rl2)"
     by (rule  wmax_lemma[OF timesll timesul])
   have maxt34:"wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>E max (rl1 * ru2) (ru1 * ru2)"
     by (rule  wmax_lemma[OF timeslu timesuu])
   have bigMax:"wmax (wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>E max (max (rl1 * rl2) (ru1 * rl2)) (max (rl1 * ru2) (ru1 * ru2))"
     by (rule wmax_lemma[OF maxt12 maxt34])
   obtain maxt12val :: real 
     where maxU12:"wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>U max (rl1 * rl2) (ru1 * rl2)"
   using maxt12 unfolding repU_def by blast
   obtain maxt34val :: real 
     where maxU34:"wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>U max (rl1 * ru2) (ru1 * ru2)"
   using maxt34 unfolding repU_def by blast
   obtain bigMaxU:"wmax (wmax (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmax (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>U max (max (rl1 * rl2) (ru1 * rl2)) (max (rl1 * ru2) (ru1 * ru2))"
   using bigMax unfolding repU_def by blast
   have ivl1:"rl1 \<le> ru1" using grl1 gru1 by auto
   have ivl2:"rl2 \<le> ru2" using grl2 gru2 by auto
   let ?thesis = "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
   show ?thesis
   using ivl1 ivl2
   proof(cases rule: case_ivl_zero)
     case ZeroZero
     assume "rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     then have geq1:"ru1 \<ge> 0" and geq2:"ru2 \<ge> 0" by auto
     consider "r1 \<ge> 0 \<and> r2 \<ge> 0" | "r1 \<ge> 0 \<and> r2 \<le> 0" | "r1 \<le> 0 \<and> r2 \<ge> 0" | "r1 \<le> 0 \<and> r2 \<le> 0"
     using le_cases by auto
     then show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2" 
     proof (cases)
       case 1
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using "1" geq1 geq2 grl2 gru2
         by (simp add: mult_left_mono)
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using "1" geq1 geq2 grl1 grl2 gru1 gru2
         by (simp add: mult_right_mono)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up eru1 eru2 erl1 erl2 repU_def timesuu tu.simps
           max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU]
         by (metis wmax.elims)
     next
       case 2
       have g1:"ru1 * ru2 \<ge> 0" 
         using "2" geq1 geq2 grl2 gru2 by (simp)
       have g2:"0 \<ge> r1 * r2"
         using "2" by (simp add: mult_le_0_iff)
         from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12]
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis  repU_def  tu.simps)
     next
       case 3
       have g1:"ru1 * ru2 \<ge> 0" 
         using "3" geq1 geq2  by simp
       have g2:"0 \<ge> r1 * r2"
         using "3" by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] repU_def tu.simps timesuu
         by (metis max.coboundedI1 max.commute maxt34)
     next
       case 4
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using "4" geq1 geq2 grl1 grl2 gru1 gru2
         using  \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close> less_eq_real_def
           by (metis mult_left_mono_neg)
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using "4" geq1 geq2 grl1 grl2 gru1 gru2 \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close>  
           by (metis mult_left_mono_neg mult.commute)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesll tu.simps)
       qed
   next
     case ZeroPos
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> 0 \<le> rl2"
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     consider "r1 \<ge> 0" | "r1 \<le> 0" using le_cases by (auto)
     then show ?thesis
     proof (cases)
       case 1
       assume r1:"r1 \<ge> 0"
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_left_mono by blast
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono by blast
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
     next
       case 2
       assume r1:"r1 \<le> 0"
       have g1:"ru1 * ru2 \<ge> 0" 
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_left_mono 
         by (simp add: mult_less_0_iff less_le_trans not_less)
       have g2:"0 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
       qed 
   next
     case ZeroNeg
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> ru2 \<le> 0"
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have case1:"r1 \<ge> 0 \<Longrightarrow> ?thesis" 
     proof -
       assume r1:"r1 \<ge> 0"
       have g1:"rl1 * rl2 \<ge> 0" 
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult_less_0_iff less_le_trans not_less
         by metis
       have g2:"0 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2
         using mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis 
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU2 max_repU1 repU_def timesll tu.simps)
     qed
     have case2:"r1 \<le> 0 \<Longrightarrow> ?thesis"
     proof -
       assume r1:"r1 \<le> 0"
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using r1 r2 bounds  grl1 grl2 gru1 gru2
         by (metis mult_left_mono_neg)
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult.commute
         by (metis mult_left_mono_neg)
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34 
         by (metis max_repU1 repU_def timesll tu.simps) 
     qed
     show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
       using case1 case2 le_cases by blast
   next
     case PosZero
     assume bounds:"0 \<le> rl1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"ru1 * ru2 \<ge> ru1 * r2" 
         using "1" bounds grl1 grl2 gru1 gru2
         using mult_left_mono 
         using leD leI less_le_trans by metis
       have g2:"ru1 * r2 \<ge> r1 * r2"
         using "1" bounds grl1 grl2 gru1 gru2
         using mult_right_mono by blast
       from g1 and g2
       have up:"ru1 * ru2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
         by (metis repU_def tu.simps) 
     next
       case 2
         have g1:"ru1 * ru2 \<ge> 0" 
           using r1 bounds grl2 gru2 gru1 leD leI less_le_trans by auto
         have g2:"0 \<ge> r1 * r2"
           using r1 "2" 
           by (simp add: mult_le_0_iff)
         from g1 and g2
         have up:"ru1 * ru2 \<ge> r1 * r2"
           by auto
         show ?thesis
           using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
             max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.coboundedI1 max.commute maxt34
           by (metis repU_def  tu.simps)
       qed
   next
     case NegZero
     assume bounds:"ru1 \<le> 0 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<le> 0"  using bounds dual_order.trans gru1 by blast
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"ru1 * rl2 \<ge> 0" 
         using r1 "1" bounds grl1 grl2 gru1 gru2 mult_less_0_iff not_less
         by metis
       have g2:"0 \<ge> r1 * r2"
         using r1 "1" bounds grl1 grl2 gru1 gru2
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"ru1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesul tu.simps) 
     next
       case 2
       have lower:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
       have g1:"rl1 * rl2 \<ge> rl1 * r2" 
         using r1 "2" bounds grl1 grl2 gru1 gru2 less_eq(1) less_le_trans not_less 
           mult_le_cancel_left
         by metis
       have g2:"rl1 * r2 \<ge> r1 * r2"
         using r1 "2" bounds grl1 grl2 gru1 gru2 mult.commute not_le lower mult_le_cancel_left
         by metis
       from g1 and g2
       have up:"rl1 * rl2 \<ge> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
           max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34
         by (metis max_repU1 repU_def timesll tu.simps)
     qed
   next
     case NegNeg
     assume bounds:"ru1 \<le> 0 \<and> ru2 \<le> 0"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<le> 0" using bounds dual_order.trans grl2 r2 by blast
     have g1:"rl1 * rl2 \<ge> rl1 * r2" 
       using r1 r2 bounds  grl1 grl2 gru1 gru2 less_eq(1)  mult_le_cancel_left less_le_trans not_less
       by metis
     have g2:"rl1 * r2 \<ge> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult.commute not_le lower1 lower2 mult_le_cancel_left
       by metis
     from g1 and g2
     have up:"rl1 * rl2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims max_repU2 max_repU2[OF maxU12] 
         max_repU2[OF maxU34] max_repU2[OF bigMaxU] max.commute maxt34 
       by (metis max_repU1 repU_def timesll tu.simps)
   next
     case NegPos
     assume bounds:"ru1 \<le> 0 \<and> 0 \<le> rl2"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<le> 0" using bounds by auto 
     have upper2:"ru2 \<ge> 0" using bounds dual_order.trans gru2 r2 by blast
     have g1:"ru1 * rl2 \<ge> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 not_less upper1 lower2 mult_le_cancel_left
       by metis
     have g2:"ru1 * r2 \<ge> r1 * r2"
       using r1 upper1 r2 mult_right_mono gru1 by metis
     from g1 and g2
     have up:"ru1 * rl2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims maxt34
         max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU]
       by (metis max_repU1 repU_def timesul tu.simps)
   next
     case PosNeg
     assume bounds:"0 \<le> rl1 \<and> ru2 \<le> 0"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<le> 0" using dual_order.trans grl2 r2 by blast
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<le> 0" using bounds by auto
     have g1:"rl1 * ru2 \<ge> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 not_less upper2 lower1 mult_le_cancel_left 
       by metis
     have g2:"rl1 * r2 \<ge> r1 * r2"
       using r1 lower1 r2 not_less gru2 gru1 grl1 grl2
       by (metis mult_le_cancel_left mult.commute)
     from g1 and g2
     have up:"rl1 * ru2 \<ge> r1 * r2"
       by auto
     show "tu l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>U r1 * r2"
       using up maxU12 maxU34 bigMaxU wmax.elims max.coboundedI1 max.commute maxt34
         max_repU2[OF maxU12] max_repU2[OF maxU34] max_repU2[OF bigMaxU] 
       by (metis repU_def tu.simps)
   next
     case PosPos
     assume bounds:"0 \<le> rl1 \<and> 0 \<le> rl2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<ge> 0" using dual_order.trans gru2 u2 r2 bounds by blast
     have g1:"ru1 * ru2 \<ge> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_left_mono leD leI less_le_trans by metis
     have g2:"ru1 * r2 \<ge> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_right_mono by metis
     from g1 and g2
     have up:"ru1 * ru2 \<ge> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU wmax.elims max.coboundedI1 max.commute maxt34
         max_repU2[OF bigMaxU] max_repU2[OF maxU12] max_repU2[OF maxU34]
       by (metis repU_def tu.simps)
   qed
 qed
 
 subsection \<open>Minimum function\<close>
 text\<open>Minimum of 2s-complement words\<close>
 fun wmin :: "word \<Rightarrow> word \<Rightarrow> word"
 where "wmin w1 w2 = 
   (if w1 <s w2 then w1 else w2)"
                                             
 text\<open>Correctness of wmin\<close>
 lemma wmin_lemma:
   assumes eq1:"w1 \<equiv>\<^sub>E (r1::real)"
   assumes eq2:"w2 \<equiv>\<^sub>E (r2::real)"
   shows "wmin w1 w2 \<equiv>\<^sub>E (min r1 r2)"
 proof(cases rule: case_inf2[where ?w1.0=w1, where ?w2.0=w2])
   case PosPos
   assume p1:"w1 = POS_INF"   
      and p2:"w2 = POS_INF"
   then have bound1:"(real_of_int (sint POS_INF)) \<le> r1"
         and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     using eq1 eq2 by (auto simp add: rep_simps repe.simps)
   have eqInf:"wmin w1 w2 = POS_INF"
     using p1 p2 unfolding wmin.simps by auto
   have pos_eq:"POS_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repPOS_INF)
     using bound1 bound2 unfolding eq1 eq2 by auto
   show ?thesis
     using pos_eq eqInf by auto
 next
   case PosNeg
   assume p1:"w1 = POS_INF"
   assume n2:"w2 = NEG_INF"
   obtain r ra :: real 
   where bound1:" (real_of_int (sint POS_INF)) \<le> r"
     and bound2:"ra \<le>  (real_of_int (sint NEG_INF))"
     and eq1:"r1 = r"
     and eq2:"r2 = ra"
     using p1 n2 eq1 eq2 by(auto simp add: rep_simps repe.simps)
   have eqNeg:"wmin w1 w2 = NEG_INF"
     unfolding eq1 eq2 wmin.simps p1 n2 word_sless_def word_sle_def
     by(auto) 
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2 eq1 eq2 by auto
   show "?thesis"
     using eqNeg neg_eq by auto
 next
   case PosNum
   assume p1:"w1 = POS_INF"
   assume np2:"w2 \<noteq> POS_INF"
   assume nn2:"w2 \<noteq> NEG_INF"
   have eq2:"r2 = (real_of_int (sint w2))"
     and bound1:"(real_of_int (sint POS_INF)) \<le> r1"
     and bound2a:"(real_of_int (sint NEG_INF)) < (real_of_int (sint w2))"
     and bound2b:"(real_of_int (sint w2)) < (real_of_int (sint POS_INF))"
     using p1 np2 nn2 eq1 eq2 by(auto simp add: rep_simps repe.simps)
   have eqNeg:"min r1 r2 = sint w2"
     using p1
     by (metis bound1 bound2b dual_order.trans eq2 min_def not_less) 
   have neg_eq:"wmin w1 w2 \<equiv>\<^sub>E  (real_of_int (sint (wmin w1 w2)))"
     apply (rule repINT)
     using bound1 bound2a bound2b bound2b p1 unfolding eq1 eq2
     by (auto simp add: word_sless_alt)
   show "?thesis"
     using eqNeg neg_eq
     by (metis bound2b less_eq_real_def not_less of_int_less_iff p1 wmin.simps word_sless_alt)
 next
   case NegPos
   assume n1:"w1 = NEG_INF"   
   assume p2:"w2 = POS_INF"
   have  bound1:"r1 \<le> (real_of_int (sint NEG_INF))"
     and bound2:"(real_of_int (sint POS_INF)) \<le> r2"
     using n1 p2 eq1 eq2 by(auto simp add: rep_simps repe.simps)    
   have eqNeg:"wmin w1 w2 = NEG_INF"
     unfolding eq1 eq2 wmin.simps n1 p2 word_sless_def word_sle_def
     by(auto)
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2 unfolding eq1 eq2 by auto
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto                      
 next
   case NegNeg
   assume n1:"w1 = NEG_INF"                 
   assume n2:"w2 = NEG_INF" 
   have bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
    and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     using n1 n2 eq1 eq2 by(auto simp add: rep_simps repe.simps)    
   have eqNeg:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1 bound2 unfolding NEG_INF_def
     by (auto)
   have neg_eq:"wmin w1 w2 = NEG_INF"
     using n1 n2 unfolding NEG_INF_def wmin.simps by auto 
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto
 next
   case NegNum
   assume n1:"w1 = NEG_INF" 
     and  nn2:"w2 \<noteq> NEG_INF"
     and  np2:"w2 \<noteq> POS_INF"
   have eq2:"r2 =  (real_of_int (sint w2))"
     and bound2a:"(real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
     and bound2b:"(real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
     and bound1:"r1 \<le>  (real_of_int (sint NEG_INF))"
     using n1 nn2 np2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)  
   have eqNeg:"wmin w1 w2 = NEG_INF"
     using n1 assms(2) bound2a eq2 n1 repeInt_simps  
     by (auto simp add: word_sless_alt)
   have neg_eq:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using bound1 bound2a bound2b eq1 min_le_iff_disj by blast
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using eqNeg neg_eq by auto
 next
   case NumPos
   assume p2:"w2 = POS_INF"
    and  nn1:"w1 \<noteq> NEG_INF"
    and  np1:"w1 \<noteq> POS_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
     and bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
     and bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
     and bound2:" (real_of_int (sint POS_INF)) \<le> r2"
     using nn1 np1 p2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)  
   have res1:"wmin w1 w2 = w1"
     using p2 eq1 eq2  assms(1) bound1b p2 repeInt_simps  
     by (auto simp add: word_sless_alt)
   have res2:"min r1 r2 =  (real_of_int (sint w1))"
     using eq1 eq2 bound1a bound1b bound2 
     by (auto simp add: less_imp_le less_le_trans min_def)
   have res3:"wmin w1 w2 \<equiv>\<^sub>E  (real_of_int (sint (wmin w1 w2)))"
     apply(rule repINT)
     using p2 bound1a res1 bound1a bound1b bound2 
     by auto
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2" 
     using res1 res2 res3 by auto
 next
   case NumNeg
   assume nn1:"w1 \<noteq> NEG_INF"
   assume np1:"w1 \<noteq> POS_INF"
   assume n2:"w2 = NEG_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
     and bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
     and bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
     and bound2:"r2 \<le>  (real_of_int (sint NEG_INF))"
     using nn1 np1 n2 eq2 eq1 eq2 by (auto simp add: rep_simps repe.simps)
   have res1:"wmin w1 w2 = NEG_INF"
     using n2 bound1b
     by (metis min.absorb_iff2 min_def n2 not_less of_int_less_iff wmin.simps word_sless_alt)
   have res2:"NEG_INF \<equiv>\<^sub>E min r1 r2"
     apply(rule repNEG_INF)
     using eq1 eq2 bound1a bound1b bound2 min_le_iff_disj by blast
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using res1 res2 by auto
 next
   case NumNum
   assume np1:"w1 \<noteq> POS_INF"
   assume nn1:"w1 \<noteq> NEG_INF"
   assume np2:"w2 \<noteq> POS_INF"
   assume nn2:"w2 \<noteq> NEG_INF"
   have eq1:"r1 =  (real_of_int (sint w1))"
   and  eq2:"r2 =  (real_of_int (sint w2))"
   and  bound1a:" (real_of_int (sint w1)) <  (real_of_int (sint POS_INF))"
   and  bound1b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w1))"
   and  bound2a:" (real_of_int (sint w2)) <  (real_of_int (sint POS_INF))"
   and  bound2b:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint w2))"
     using nn1 np1 nn2 np2 eq2 eq1 eq2 
     by (auto simp add: rep_simps repe.simps)
   have res1:"min r1 r2 =  (real_of_int (sint (wmin w1 w2)))"
     using eq1 eq2 bound1a bound1b bound2a bound2b 
     by (simp add: min_def word_sless_alt)
   have res2:"wmin w1 w2 \<equiv>\<^sub>E (real_of_int (sint (wmin w1 w2)))"
     apply (rule repINT)
     using bound1a bound1b bound2a bound2b
     by (simp add: \<open>min r1 r2 = (real_of_int (sint (wmin w1 w2)))\<close> eq2 min_less_iff_disj)+
   show "wmin w1 w2 \<equiv>\<^sub>E min r1 r2"
     using res1 res2 by auto
 qed    
     
 lemma min_repU1:
   assumes "w1 \<equiv>\<^sub>L x"
   assumes "w2 \<equiv>\<^sub>L y"
   shows "wmin w1 w2 \<equiv>\<^sub>L x "
   using wmin_lemma assms repL_def
   by (meson min_le_iff_disj)
 
 lemma min_repU2:
   assumes "w1 \<equiv>\<^sub>L y"
   assumes "w2 \<equiv>\<^sub>L x"
   shows "wmin w1 w2 \<equiv>\<^sub>L x"
   using wmin_lemma assms repL_def
 by (meson min_le_iff_disj)
 
 
 subsection \<open>Multiplication lower bound\<close>
 text\<open>Multiplication lower bound\<close>
 fun tl :: "word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word \<Rightarrow> word"
 where "tl w1l w1u w2l w2u =
   wmin (wmin (wtimes w1l w2l) (wtimes w1u w2l))
        (wmin (wtimes w1l w2u) (wtimes w1u w2u))"
 
 text\<open>Correctness of multiplication lower bound\<close>
 lemma tl_lemma:
   assumes u1:"u\<^sub>1 \<equiv>\<^sub>U (r1::real)"
   assumes u2:"u\<^sub>2 \<equiv>\<^sub>U (r2::real)"
   assumes l1:"l\<^sub>1 \<equiv>\<^sub>L (r1::real)"
   assumes l2:"l\<^sub>2 \<equiv>\<^sub>L (r2::real)"
   shows "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L (r1 * r2)"
 proof -
   obtain rl1 rl2 ru1 ru2 :: real 
   where gru1:"ru1 \<ge> r1" and gru2:"ru2 \<ge> r2" and grl1:"rl1 \<le> r1" and grl2:"rl2 \<le> r2" 
   and eru1:"u\<^sub>1 \<equiv>\<^sub>E ru1" and eru2:"u\<^sub>2 \<equiv>\<^sub>E ru2" and erl1:"l\<^sub>1 \<equiv>\<^sub>E rl1" and erl2:"l\<^sub>2 \<equiv>\<^sub>E rl2"
   using u1 u2 l1 l2 unfolding repU_def repL_def by auto
   have timesuu:"wtimes u\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E ru1 * ru2"
     using wtimes_exact[OF eru1 eru2] by auto
   have timesul:"wtimes u\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E ru1 * rl2"
     using wtimes_exact[OF eru1 erl2] by auto
   have timeslu:"wtimes l\<^sub>1 u\<^sub>2 \<equiv>\<^sub>E rl1 * ru2"
     using wtimes_exact[OF erl1 eru2] by auto
   have timesll:"wtimes l\<^sub>1 l\<^sub>2 \<equiv>\<^sub>E rl1 * rl2"
     using wtimes_exact[OF erl1 erl2] by auto
   have maxt12:"wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>E min (rl1 * rl2) (ru1 * rl2)"
     by (rule  wmin_lemma[OF timesll timesul])
   have maxt34:"wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>E min (rl1 * ru2) (ru1 * ru2)"
     by (rule  wmin_lemma[OF timeslu timesuu])
   have bigMax:"wmin (wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>E min (min(rl1 * rl2) (ru1 * rl2)) (min (rl1 * ru2) (ru1 * ru2))"
     by (rule wmin_lemma[OF maxt12 maxt34])
   obtain maxt12val :: real 
     where maxU12:"wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2) \<equiv>\<^sub>L min (rl1 * rl2) (ru1 * rl2)"
   using maxt12 unfolding repL_def by blast
   obtain maxt34val :: real 
     where maxU34:"wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2) \<equiv>\<^sub>L min (rl1 * ru2) (ru1 * ru2)"
   using maxt34 unfolding repL_def by blast
   obtain bigMaxU:"wmin (wmin (wtimes l\<^sub>1 l\<^sub>2) (wtimes u\<^sub>1 l\<^sub>2)) (wmin (wtimes l\<^sub>1 u\<^sub>2) (wtimes u\<^sub>1 u\<^sub>2))
     \<equiv>\<^sub>L min (min (rl1 * rl2) (ru1 * rl2)) (min (rl1 * ru2) (ru1 * ru2))"
   using bigMax unfolding repL_def by blast
   have ivl1:"rl1 \<le> ru1" using grl1 gru1 by auto
   have ivl2:"rl2 \<le> ru2" using grl2 gru2 by auto
   let ?thesis = "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L r1 * r2"
   show ?thesis
   using ivl1 ivl2
   proof(cases rule: case_ivl_zero)
     case ZeroZero        
     assume "rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     then have geq1:"ru1 \<ge> 0" and geq2:"ru2 \<ge> 0" 
     and geq3:"rl1 \<le> 0" and geq4:"rl2 \<le> 0" by auto
     consider "r1 \<ge> 0 \<and> r2 \<ge> 0" | "r1 \<le> 0 \<and> r2 \<ge> 0" | "r1 \<ge> 0 \<and> r2 \<le> 0" | "r1 \<le> 0 \<and> r2 \<le> 0"
       using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * ru2 \<le> 0" 
         using "1" geq1 geq2 geq3 geq4 grl2 gru2 mult_le_0_iff by blast
       have g2:"0 \<le>  r1 * r2"
         using "1"  geq1 geq2 grl1 grl2 gru1 gru2
         by (simp)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up eru1 eru2 erl1 erl2 min_repU1 min_repU2 
           repL_def repU_def timeslu tl.simps wmin.elims
         by (metis bigMax min_le_iff_disj)
     next
       case 2
       have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using "2" geq1 geq2 grl2 gru2
         by (metis mult_le_cancel_left  geq3 leD)
       have g2:"rl1 * r2 \<le> r1 * r2"
         using "2" geq1 geq2 grl2 gru2
         by (simp add: mult_right_mono grl1)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         by (metis up maxU12 min_repU2 repL_def tl.simps min.coboundedI1 maxt34)
     next
       case 3
       have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using "3" geq1 geq2 grl2 gru2
         by (simp add: mult_left_mono)
       have g2:"ru1 * r2 \<le> r1 * r2"
         using "3" geq1 geq2 grl1 grl2 gru1 gru2 mult_minus_right mult_right_mono
         by (simp add: mult_right_mono_neg)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2" by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt34 timesul
         by (metis repL_def tl.simps)
     next
       case 4
       have g1:"ru1 * rl2 \<le> 0" 
         using "4" geq1 geq2 grl1 grl2 gru1 gru2 \<open>rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2\<close> 
           mult_less_0_iff  less_eq_real_def not_less
         by auto
       have g2:"0 \<le> r1 * r2"
         using "4" geq1 geq2 grl1 grl2 gru1 gru2
         by (metis mult_less_0_iff  not_less)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
       by (metis up maxU12 maxU34 wmin.elims min_repU1 min_repU2 repL_def timesul tl.simps) 
     qed
   next
     case ZeroPos
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> 0 \<le> rl2"
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     consider "r1 \<ge> 0" | "r1 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * rl2 \<le> 0" 
         using "1" r2 bounds grl1 grl2 gru1 gru2
         by (simp add: mult_le_0_iff)
       have g2:"0 \<le> r1 * r2"
         using "1" r2 bounds grl1 grl2 gru1 gru2
         by (simp)
       from g1 and g2
       have up:"rl1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         by (metis repL_def timesll tl.simps up maxU12 maxU34 wmin.elims min_repU2 min_repU1) 
     next
       case 2
       have bound:"ru2 \<ge> 0"
         using "2" r2 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
       then have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using "2" r2 bounds grl1 grl2 gru1 gru2 mult_le_cancel_left
         by fastforce
       have g2:"rl1 * r2 \<le> r1 * r2"
         using "2" r2 bounds grl1 grl2 gru1 gru2 mult_le_0_iff mult_le_cancel_right by fastforce
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2" by auto
       show ?thesis
         by (metis up maxU12 wmin.elims min_repU2 min.coboundedI1 maxt34 repL_def tl.simps) 
       qed
   next
     case ZeroNeg
     assume bounds:"rl1 \<le> 0 \<and> 0 \<le> ru1 \<and> ru2 \<le> 0"
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     consider (Pos) "r1 \<ge> 0" | (Neg) "r1 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case Pos
       have bound:"rl2 \<le> 0"
         using Pos r2 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
       then have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using Pos bounds grl1 grl2 gru1 gru2 mult_le_cancel_left
         by fastforce
       have p1:"\<And>a::real. (0 \<le> - a) = (a \<le> 0)"
         by(auto)
       have p2:"\<And>a b::real.  (- a \<le> - b) = (b \<le> a)" by auto
       have g2:"ru1 * r2 \<le> r1 * r2"
         using Pos r2 bounds grl1 grl2 gru1 gru2 p1 p2
         by (simp add: mult_right_mono_neg)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis 
         by (metis up maxU12 maxU34 wmin.elims min_repU2 min_repU1 repL_def timesul tl.simps)
     next
       case Neg
       have g1:"ru1 * ru2 \<le> 0" 
         using Neg r2 bounds  grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using Neg r2 zero_le_mult_iff by blast  
       from g1 and g2
       have up:"ru1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt34 
         by (metis repL_def tl.simps) 
       qed
   next
     case PosZero
     assume bounds:"0 \<le> rl1 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have bound:"0 \<le> ru1" using r1 bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       have g1:"rl1 * rl2 \<le> 0" 
         using r1 "1" bounds grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using r1 "1" bounds grl1 grl2 gru1 gru2 zero_le_mult_iff by blast
       from g1 and g2
       have up:"rl1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmax.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt12 maxt34 repL_def timesll tl.simps
         by metis          
     next
       case 2
       have g1:"ru1 * rl2 \<le> ru1 * r2" 
         using r1 "2" bounds bound grl1 grl2 gru1 gru2
         using mult_left_mono by blast
       have g2:"ru1 * r2 \<le> r1 * r2"
         using r1 "2" bounds bound grl2 gru2
         by (metis mult_left_mono_neg gru1 mult.commute)
       from g1 and g2
       have up:"ru1 * rl2 \<le> r1 * r2"
         by auto
       show ?thesis
         using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt34
         by (metis repL_def timesul tl.simps)
       qed
   next
     case NegZero
     assume bounds:"ru1 \<le> 0 \<and> rl2 \<le> 0 \<and> 0 \<le> ru2"
     have r1:"r1 \<le> 0"  using bounds dual_order.trans gru1 by blast
     have bound:"rl1 \<le> 0" using r1  bounds grl1 grl2 gru1 gru2 dual_order.trans by auto
     consider "r2 \<ge> 0" | "r2 \<le> 0" using le_cases by auto
     then show ?thesis
     proof (cases)
       case 1
       assume r2:"r2 \<ge> 0"
       have g1:"rl1 * ru2 \<le> rl1 * r2" 
         using r1 r2 bounds bound grl1 grl2 gru1 gru2
         by (metis mult_le_cancel_left leD)  
       have g2:"rl1 * r2 \<le> r1 * r2"
         using r1 r2 bounds grl1 grl2 gru1 gru2 mult_right_mono 
         by (simp add: mult_le_0_iff)
       from g1 and g2
       have up:"rl1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
       using up maxU12 maxU34 bigMaxU min_repU2 min_repU1 min.coboundedI1 maxt34
       by (metis min_repU2 repL_def tl.simps) 
     next
       case 2
       assume r2:"r2 \<le> 0"
       have lower:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
       have g1:"ru1 * ru2 \<le> 0" 
         using r1 r2 bounds  grl1 grl2 gru1 gru2 mult_le_0_iff by blast
       have g2:"0 \<le> r1 * r2"
         using r1 r2 
         by (simp add: zero_le_mult_iff)
       from g1 and g2
       have up:"ru1 * ru2 \<le> r1 * r2"
         by auto
       show ?thesis
       using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 
         min.coboundedI1 min.commute maxt34
       by (metis repL_def tl.simps)
       qed
   next
     case NegNeg
     assume bounds:"ru1 \<le> 0 \<and> ru2 \<le> 0"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<le> 0" using bounds dual_order.trans grl2 r2 by blast
     have g1:"ru1 * ru2 \<le> ru1 * r2" 
       using r1 r2 bounds  grl1 grl2 gru1 gru2
       using    not_less mult_le_cancel_left
       by metis
     have g2:"ru1 * r2 \<le> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_le_cancel_left mult.commute not_le lower1 lower2
       by metis
     from g1 and g2
     have up:"ru1 * ru2 \<le> r1 * r2"
       by auto
     show ?thesis
       using up maxU12 maxU34 bigMaxU 
       wmin.elims min_repU2 min_repU1 
       min.coboundedI1 min.commute maxt34 
       by (metis repL_def tl.simps)
   next
     case NegPos
     assume bounds:"ru1 \<le> 0 \<and> 0 \<le> rl2"
     have r1:"r1 \<le> 0" using bounds dual_order.trans gru1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<le> 0" using bounds dual_order.trans grl1 r1 by blast
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<le> 0" using bounds by auto 
     have upper2:"ru2 \<ge> 0" using bounds dual_order.trans gru2 r2 by blast
     have g1:"rl1 * ru2 \<le> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 less_le_trans upper1 lower2 
       by (metis mult_le_cancel_left not_less)
     have g2:"rl1 * r2 \<le> r1 * r2"
       using r1 upper1 r2 mult_right_mono mult_le_0_iff grl1 by blast
     from g1 and g2
     have up:"rl1 * ru2 \<le> r1 * r2"
       by auto
     show ?thesis
     using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1 maxt12 maxt34 
     by (metis repL_def timeslu tl.simps)
   next
     case PosNeg
     assume bounds:"0 \<le> rl1 \<and> ru2 \<le> 0"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<le> 0" using bounds dual_order.trans gru2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<le> 0" using dual_order.trans grl2 r2 by blast
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<le> 0" using bounds by auto
     have g1:"ru1 * rl2 \<le> ru1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2 mult_left_mono less_le_trans not_less
       by metis
     have g2:"ru1 * r2 \<le> r1 * r2"
       using r1 lower1 r2 not_less gru2 gru1 grl1 grl2
       by (metis mult_le_cancel_left  mult.commute)
     from g1 and g2
     have up:"ru1 * rl2 \<le> r1 * r2"
       by auto
     show "tl l\<^sub>1 u\<^sub>1 l\<^sub>2 u\<^sub>2 \<equiv>\<^sub>L r1 * r2"
       using up maxU12 maxU34 bigMaxU wmin.elims min_repU2 min_repU1
       by (metis repL_def timesul tl.simps)
   next
     case PosPos
     assume bounds:"0 \<le> rl1 \<and> 0 \<le> rl2"
     have r1:"r1 \<ge> 0" using bounds dual_order.trans grl1 by blast
     have r2:"r2 \<ge> 0" using bounds dual_order.trans grl2 by blast
     have lower1:"rl1 \<ge> 0" using bounds by auto
     have lower2:"rl2 \<ge> 0" using bounds by auto
     have upper1:"ru1 \<ge> 0" using dual_order.trans gru1 u1 r1 by blast  
     have upper2:"ru2 \<ge> 0" using dual_order.trans gru2 u2 r2 bounds by blast
     have g1:"rl1 * rl2 \<le> rl1 * r2" 
       using r1 r2 bounds grl1 grl2 gru1 gru2
       using mult_left_mono 
       using leD leI less_le_trans by auto
     have g2:"rl1 * r2 \<le> r1 * r2"
       using r1 r2 bounds grl1 grl2 gru1 gru2
       using mult_right_mono by blast
     from g1 and g2
     have up:"rl1 * rl2 \<le> r1 * r2"
       by auto
     show ?thesis
     using up maxU12 maxU34 bigMaxU min_repU2 min_repU1 min.coboundedI1 maxt12 maxt34
       by (metis repL_def tl.simps)
   qed
 qed
 
 text\<open>Most significant bit only changes under successor when all other bits are 1\<close>
 lemma msb_succ:
   fixes w :: "32 Word.word"
   assumes neq1:"uint w \<noteq> 0xFFFFFFFF"
   assumes neq2:"uint w \<noteq> 0x7FFFFFFF"
   shows "msb (w + 1) = msb w"
   proof -
     have "w \<noteq> 0xFFFFFFFF"
       using neq1 by auto
     then have neqneg1:"w \<noteq> -1" by auto
     have "w \<noteq> 0x7FFFFFFF"
       using neq2 by auto
     then have neqneg2:"w \<noteq> (2^31)-1" by auto
     show ?thesis using neq1 neq2  unfolding msb_big
     using Word_Lemmas.word_le_make_less[of "w + 1" "0x80000000"] 
           Word_Lemmas.word_le_make_less[of "w " "0x80000000"]
           neqneg1 neqneg2
       by auto
   qed
 
 text\<open>Negation commutes with msb except at edge cases\<close>
 lemma msb_non_min:
   fixes w :: "32 Word.word"
   assumes neq1:"uint w \<noteq> 0"
   assumes neq2:"uint w \<noteq> ((2^(len_of (TYPE(31)))))"
   shows "msb (uminus w) = HOL.Not(msb(w))"
   proof -
     have fact1:"uminus w = word_succ (~~ w)"
       by (rule twos_complement)
     have fact2:"msb (~~w) = HOL.Not(msb w)"
       using word_ops_msb[of w] 
       by auto
     have neqneg1:"w \<noteq> 0" using neq1 by auto
     have not_undef:"w \<noteq> 0x80000000"
       using neq2 by auto
     then have neqneg2:"w \<noteq> (2^31)" by auto
     from \<open>w \<noteq> 0\<close> have \<open>~~ w \<noteq> ~~ 0\<close>
       by (simp only: bit.compl_eq_compl_iff) simp
     then have "(~~ w) \<noteq> 0xFFFFFFFF"
       by auto
     then have uintNeq1:"uint (~~ w) \<noteq> 0xFFFFFFFF"
       using uint_distinct[of "~~w" "0xFFFFFFFF"] 
       by auto
     from \<open>w \<noteq> 2 ^ 31\<close> have \<open>~~ w \<noteq> ~~ 2 ^ 31\<close>
       by (simp only: bit.compl_eq_compl_iff) simp
     then have "(~~ w) \<noteq> 0x7FFFFFFF"
       by auto
     then have uintNeq2:" uint (~~ w) \<noteq> 0x7FFFFFFF"
       using uint_distinct[of "~~w" "0x7FFFFFFF"]
       by auto
     have fact3:"msb ((~~w) + 1) = msb (~~w)"
       apply(rule msb_succ[of "~~w"])
       using neq1 neq2 uintNeq1 uintNeq2 by auto 
     show "msb (uminus w) = HOL.Not(msb(w))"
       using fact1 fact2 fact3 by (simp add: word_succ_p1)
     qed
 
 text\<open>Only 0x80000000 preserves msb=1 under negation\<close>
 lemma msb_min_neg:
   fixes w::"word"
   assumes msb1:"msb (- w)"
   assumes msb2:"msb w"
   shows "uint w = ((2^(len_of (TYPE(31)))))"
 proof (rule ccontr)
   from \<open>msb w\<close> have \<open>w \<noteq> 0\<close>
     using word_msb_0 by auto
   then have \<open>uint w \<noteq> 0\<close>
     by transfer simp
   moreover assume \<open>uint w \<noteq> 2 ^ LENGTH(31)\<close>
   ultimately have \<open>msb (- w) \<longleftrightarrow> \<not> msb w\<close>
     by (rule msb_non_min)
   with assms show False
     by simp
 qed
 
 text\<open>Only 0x00000000 preserves msb=0 under negation\<close>
 lemma msb_zero:
   fixes w::"word"
   assumes msb1:"\<not> msb (- w)"
   assumes msb2:"\<not> msb w"
   shows "uint w = 0"
   proof -
     have neq:"w \<noteq> ((2 ^ len_of TYPE(31))::word)" using msb1 msb2 by auto
     have eq:"uint ((2 ^ len_of TYPE(31))::word) = 2 ^ len_of TYPE(31)" 
       by auto
     then have neq:"uint w \<noteq> uint ((2 ^ len_of TYPE(31))::word)" 
       using uint_distinct[of w "2^len_of TYPE(31)"] neq eq by auto
     show ?thesis
       using msb1 msb2 minus_zero msb_non_min[of w] neq by force
   qed
     
 text\<open>Finite numbers alternate msb under negation\<close>
 lemma msb_pos:
   fixes w::"word"
   assumes msb1:"msb (- w)"
   assumes msb2:"\<not> msb w"
   shows "uint w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}" 
   proof -
     have main: "w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}"
       using msb1 msb2 apply(clarsimp) 
       unfolding word_msb_sint
       apply(rule conjI)
       apply (metis neg_equal_0_iff_equal not_le word_less_1)
       proof -
         have imp:"w \<ge> 0x80000000 \<Longrightarrow> False"
           proof -
             assume geq:"w \<ge> 0x80000000"
             then have "msb w"
               using Word_Lemmas.msb_big[of w] by auto
             then show False using msb2 by auto
           qed
         have mylem:"\<And>w1 w2::word. uint w1 \<ge> uint w2 \<Longrightarrow> w1 \<ge> w2" 
           subgoal for w1 w2 
             by (simp add: word_le_def)
           done
         have mylem2:"\<And>w1 w2::word.  w1 >  w2 \<Longrightarrow> uint w1 > uint w2" 
           subgoal for w1 w2 
             by (simp add: word_less_def)
           done
         have gr_to_geq:"w > 0x7FFFFFFF \<Longrightarrow> w \<ge> 0x80000000"
           apply(rule mylem)
           using mylem2[of "0x7FFFFFFF" "w"] by auto
         have taut:"w \<le> 0x7FFFFFFF \<or> w > 0x7FFFFFFF" by auto        
         then show "w \<le> 0x7FFFFFFF"
         using imp taut gr_to_geq by auto
       qed
     have set_eq:"(uint ` (({1..(minus(2 ^ (minus(len_of TYPE(32))  1)) 1)})::word set)) 
                = ({1..minus(2 ^ (minus (len_of TYPE(32)) 1)) 1}::int set)"
       apply(auto simp add: word_le_def)
       subgoal for xa 
       proof -
         assume lower:"1 \<le> xa" and upper:"xa \<le> 2147483647"
         then have in_range:"xa \<in> {0 .. 2^32-1}" by auto
         then have "xa \<in> range (uint::word \<Rightarrow> int)" 
           unfolding Word.word_uint.Rep_range Word.uints_num by auto
         then obtain w::word  where xaw:"xa = uint w" by auto
         then have "w \<in> {1..0x7FFFFFFF} " 
         using lower upper apply(clarsimp, auto)
         by (auto simp add: word_le_def)
         then show ?thesis
           using uint_distinct uint_distinct main image_eqI word_le_def xaw by blast
       qed
       done
     then show  "uint w \<in> {1..2 ^ (len_of TYPE(32) - 1) - 1}" 
       using uint_distinct uint_distinct main image_eqI
       by blast
     qed
     
 lemma msb_neg:
   fixes w::"word"
   assumes msb1:"\<not> msb (- w)"
   assumes msb2:"msb w"
   shows "uint w \<in> {2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1}" 
   proof -
     have mylem:"\<And>w1 w2::word. uint w1 \<ge> uint w2 \<Longrightarrow> w1 \<ge> w2" 
       by (simp add: word_le_def)
     have mylem2:"\<And>w1 w2::word.  w1 >  w2 \<Longrightarrow> uint w1 > uint w2" 
       by (simp add: word_less_def)
     have gr_to_geq:"w > 0x80000000 \<Longrightarrow> w \<ge> 0x80000001"
       apply(rule mylem)
       using mylem2[of "0x80000000" "w"] by auto
     have taut:"w \<le> 0x80000000 \<or> 0x80000000 < w" by auto
     have imp:"w \<le> 0x80000000 \<Longrightarrow> False"
       proof -
         assume geq:"w \<le> 0x80000000"
         then have "(msb (-w))"
           using Word_Lemmas.msb_big[of "-w"] Word_Lemmas.msb_big[of "w"] 
           by (simp add: msb2) 
         then show False using msb1 by auto
       qed
     have main: "w \<in> {2^((len_of TYPE(32)) - 1)+1 .. 2^((len_of TYPE(32)))-1}"  
       using msb1 msb2 apply(clarsimp)
       unfolding word_msb_sint
       proof -
         show "0x80000001 \<le> w"
         using imp taut gr_to_geq by auto
       qed
     have set_eq:"(uint ` (({2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1})::word set)) 
                        = {2^((len_of TYPE(32) - 1))+1 .. 2^((len_of TYPE(32)))-1}"
       apply(auto)
       subgoal for xa by (simp add: word_le_def)
       subgoal for w using uint_lt [of w] by simp
       subgoal for xa
       proof -
         assume lower:"2147483649 \<le> xa" and upper:"xa \<le> 4294967295"
         then have in_range:"xa \<in> {0x80000000 .. 0xFFFFFFFF}" by auto
         then have "xa \<in> range (uint::word \<Rightarrow> int)" 
           unfolding Word.word_uint.Rep_range Word.uints_num by auto
         then obtain w::word  where xaw:"xa = uint w" by auto
         then have the_in:"w \<in> {0x80000001 .. 0xFFFFFFFF} " 
           using lower upper
           by (auto simp add: word_le_def)
         have the_eq:"(0xFFFFFFFF::word) = -1" by auto
         from the_in the_eq have "w \<in> {0x80000001 .. -1}" by auto
         then show ?thesis
       using uint_distinct uint_distinct main image_eqI word_le_def xaw by blast
       qed
       done
     then show  "uint w \<in> {2^((len_of TYPE(32)) - 1)+1 .. 2^((len_of TYPE(32)))-1}" 
       using uint_distinct uint_distinct main image_eqI
       by blast
     qed
 
 text\<open>2s-complement commutes with negation except edge cases\<close>
 lemma sint_neg_hom:
   fixes w :: "32 Word.word"
   shows "uint w \<noteq> ((2^(len_of (TYPE(31))))) \<Longrightarrow> (sint(-w) = -(sint w))"
   unfolding word_sint_msb_eq apply auto
     subgoal using msb_min_neg by auto 
    prefer 3 subgoal using msb_zero[of w] by (simp add: msb_zero)
   proof -
     assume msb1:"msb (- w)"
     assume msb2:"\<not> msb w"
     have "uint w \<in> {1 .. (2^((len_of TYPE(32)) - 1))-1}" using msb_pos[OF msb1 msb2] by auto
     then have bound:"uint w \<in> {1 .. 0x7FFFFFFF}" by auto
     have size:"size (w::32 Word.word) = 32" using Word.word_size[of w] by auto 
     have lem:"\<And>x::int. \<And>n::nat.   x \<in> {1..(2^n)-1} \<Longrightarrow> ((- x) mod (2^n)) - (2^n) = - x"
       subgoal for x n
         apply(cases "x mod 2^n = 0")
         by(auto simp add: Divides.zmod_zminus1_eq_if[of x  "2^n"])
       done
     have lem_rule:"uint w \<in> {1..2 ^ 32 - 1} 
       \<Longrightarrow> (- uint w mod  4294967296) - 4294967296 = - uint w"
       using lem[of "uint w" 32] by auto
     have almost:"- uint w mod 4294967296 - 4294967296 = - uint w"
       apply(rule lem_rule)  
       using bound by auto
     show "uint (- w) - 2 ^ size (- w) = - uint w"
     using bound
     unfolding Word.uint_word_ariths word_size_neg by (auto simp add: size almost)
 next
   assume neq:"uint w \<noteq> 0x80000000"
   assume msb1:"\<not> msb (- w)"
   assume msb2:"msb w"
   have bound:"uint w \<in> {0x80000001.. 0xFFFFFFFF}" using msb1 msb2 msb_neg by auto
   have size:"size (w::32 Word.word) = 32" using Word.word_size[of w] by auto
   have lem:"\<And>x::int. \<And>n::nat.   x \<in> {1..(2^n)-1} \<Longrightarrow> (-x mod (2^n)) = (2^n) - x"
       subgoal for x n
         apply(auto)
         apply(cases "x mod 2^n = 0")
         by (simp add: Divides.zmod_zminus1_eq_if[of x  "2^n"])+
       done
   from bound 
   have  wLeq: "uint w \<le> 4294967295"
     and wGeq: "2147483649 \<le> uint w"
     by auto
   from wLeq have wLeq':"uint w \<le> 4294967296" by fastforce
   have f3: "(0 \<le> 4294967296 + - 1 * uint w + - 1 * ((4294967296 + - 1 * uint w) mod 4294967296))
             = (uint w + (4294967296 + - 1 * uint w) mod 4294967296 \<le> 4294967296)"
     by auto
   have f4: "(0 \<le> 4294967296 + - 1 * uint w) = (uint w \<le> 4294967296)"
     by auto
   have f5: "\<forall>i ia. \<not> (0::int) \<le> i \<or> 0 \<le> i + - 1 * (i mod ia)"
     by (simp add: zmod_le_nonneg_dividend)
   then have f6: "uint w + (4294967296 + - 1 * uint w) mod 4294967296 \<le> 4294967296"
     using f4 f3 wLeq' by blast
   have f7: "4294967296 + - 1 * uint w + - 4294967296 = - 1 * uint w"
     by auto
   have f8: "- (1::int) * 4294967296 = - 4294967296"
     by auto
   have f9: "(0 \<le> - 1 * uint w) = (uint w \<le> 0)"
     by auto
   have f10: "(4294967296 + -1 * uint w + -1 * ((4294967296 + -1 * uint w) mod 4294967296) \<le> 0) 
            = (4294967296 \<le> uint w + (4294967296 + - 1 * uint w) mod 4294967296)"
     by auto
   have f11: "\<not> 4294967296 \<le> (0::int)"
     by auto
   have f12: "\<forall>x0. ((0::int) < x0) = (\<not> x0 \<le> 0)"
     by auto
   have f13: "\<forall>x0 x1. ((x1::int) < x0) = (\<not> 0 \<le> x1 + - 1 * x0)"
     by auto
   have f14: "\<forall>x0 x1. ((x1::int) \<le> x1 mod x0) = (x1 + - 1 * (x1 mod x0) \<le> 0)"
     by auto
   have "\<not> uint w \<le> 0"
     using wGeq by fastforce
   then have "4294967296 \<le> uint w + (4294967296 + - 1 * uint w) mod 4294967296"
     using f14 f13 f12 f11 f10 f9 f8 f7 by (metis (no_types) int_mod_ge)
   then 
   show "uint (- w) = 2 ^ size w - uint w"
     using f6
     unfolding Word.uint_word_ariths  
     by (auto simp add: size f4)
   qed
 
 text\<open>2s-complement encoding is injective\<close>
 lemma sint_dist:
   fixes x y ::word
   assumes "x \<noteq> y"
   shows "sint x \<noteq> sint y"
   by (simp add: assms)
 
 subsection\<open>Negation\<close>
 fun wneg :: "word \<Rightarrow> word"
 where "wneg w = 
   (if w = NEG_INF then POS_INF else if w = POS_INF then NEG_INF else -w)"
 
 text\<open>word negation is correct\<close>
 lemma wneg_lemma:
   assumes eq:"w \<equiv>\<^sub>E (r::real)"
   shows "wneg w \<equiv>\<^sub>E -r"
   apply(rule repe.cases[OF eq])
     apply(auto intro!: repNEG_INF repPOS_INF simp add: repe.simps)[2]
   subgoal for ra
   proof -
     assume eq:"w = ra"
     assume i:"r =  (real_of_int (sint ra))"
     assume bounda:" (real_of_int (sint ra)) <  (real_of_int (sint POS_INF))"
     assume boundb:" (real_of_int (sint NEG_INF)) <  (real_of_int (sint ra))"
     have raNeq:"ra \<noteq> 2147483647"
       using sint_range[OF bounda boundb]
       by (auto)
     have raNeqUndef:"ra \<noteq> 2147483648"
       using int_not_undef[OF bounda boundb]
       by (auto)
     have "uint ra \<noteq> uint ((2 ^ len_of TYPE(31))::word)"
       apply (rule uint_distinct)
       using raNeqUndef by auto
     then have raNeqUndefUint:"uint ra \<noteq> ((2 ^ len_of TYPE(31)))"
       by auto
     have res1:"wneg w \<equiv>\<^sub>E  (real_of_int (sint (wneg w)))"
       apply (rule repINT)
       using sint_range[OF bounda boundb] sint_neg_hom[of ra, OF raNeqUndefUint]
       raNeq raNeqUndefUint raNeqUndef eq 
       by(auto)
     have res2:"- r =  (real_of_int (sint (wneg w)))"
       using eq bounda boundb i sint_neg_hom[of ra, OF raNeqUndefUint] raNeq raNeqUndef eq
       by (auto)
     show ?thesis
       using res1 res2 by auto
     qed
   done
 
 subsection\<open>Comparison\<close>
 fun wgreater :: "word \<Rightarrow> word \<Rightarrow> bool"
 where "wgreater w1 w2 = (sint w1 > sint w2)"
 
 lemma neg_less_contra:"\<And>x. Suc x < - (Suc x) \<Longrightarrow> False"
   by auto
 
 text\<open>Comparison < is correct\<close>
 lemma wgreater_lemma:"w1 \<equiv>\<^sub>L (r1::real) \<Longrightarrow> w2 \<equiv>\<^sub>U r2 \<Longrightarrow> wgreater w1 w2 \<Longrightarrow> r1 > r2"
   proof (auto simp add: repU_def repL_def)
     fix r'\<^sub>1 r'\<^sub>2
     assume sint_le:"sint w1 > sint w2"
     then have sless:"(w2 <s w1)" using word_sless_alt by auto
     assume r1_leq:"r'\<^sub>1 \<le> r1"
     assume r2_leq:"r2 \<le> r'\<^sub>2"
     assume wr1:"w1 \<equiv>\<^sub>E r'\<^sub>1"
     assume wr2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
     have greater:"r'\<^sub>1 > r'\<^sub>2" 
       using wr1 wr2 apply(auto simp add: repe.simps)
       prefer 4 using sless sint_le  by (auto simp add: less_le_trans not_le)
     show "r1 > r2"
       using r1_leq r2_leq greater by auto
   qed
 
 text\<open>Comparison $\geq$ of words\<close>
 fun wgeq :: "word \<Rightarrow> word \<Rightarrow> bool"
 where "wgeq w1 w2 =
 ((\<not> ((w2 = NEG_INF \<and> w1 = NEG_INF)
   \<or>(w2 = POS_INF \<and> w1 = POS_INF))) \<and>
 (sint w2 \<le> sint w1))"
 
 text\<open>Comparison $\geq$ of words is correct\<close>
 lemma wgeq_lemma:"w1 \<equiv>\<^sub>L r1 \<Longrightarrow> w2 \<equiv>\<^sub>U (r2::real) \<Longrightarrow> wgeq w1 w2 \<Longrightarrow> r1 \<ge> r2"
   proof (unfold wgeq.simps)
     assume assms:"\<not> (w2 = NEG_INF \<and> w1 = NEG_INF \<or> w2 = POS_INF \<and> w1 = POS_INF) \<and> sint w2 \<le> sint w1"
     assume a1:"w1 \<equiv>\<^sub>L r1" and a2:"w2 \<equiv>\<^sub>U (r2::real)"
     from assms have sint_le:"sint w2 \<le> sint w1" by auto
     then have sless:"(w2 <=s w1)" using word_sless_alt word_sle_def by auto
     obtain r'\<^sub>1 r'\<^sub>2 where  r1_leq:"r'\<^sub>1 \<le> r1" and r2_leq:"r2 \<le> r'\<^sub>2"
     and wr1:"w1 \<equiv>\<^sub>E r'\<^sub>1" and wr2:"w2 \<equiv>\<^sub>E r'\<^sub>2"
     using a1 a2 unfolding repU_def repL_def by auto
     from assms have check1:"\<not> (w1 = NEG_INF \<and> w2 = NEG_INF)" by auto
     from assms have check2:"\<not> (w1 = POS_INF \<and> w2 = POS_INF)" by auto
     have less:"r'\<^sub>2 \<le> r'\<^sub>1" 
       using sless sint_le check1 check2 repe.simps wr2 wr1
       by(auto simp add: repe.simps)
     show "r1 \<ge> r2"
       using r1_leq r2_leq less by auto
   qed
 
 subsection\<open>Absolute value\<close>
 
 text\<open>Absolute value of word\<close>
 fun wabs :: "word \<Rightarrow> word"
   where "wabs l1 = (wmax l1 (wneg l1))"
 
 text\<open>Correctness of wmax\<close>
 lemma wabs_lemma:
   assumes eq:"w \<equiv>\<^sub>E (r::real)"
   shows "wabs w \<equiv>\<^sub>E (abs r)"
 proof -
   have w:"wmax w (wneg w) \<equiv>\<^sub>E max r (-r)" by (rule wmax_lemma[OF eq wneg_lemma[OF eq]])
   have r:"max r (-r) = abs r" by auto
   from w r show ?thesis by auto
 qed
 end
\ No newline at end of file
diff --git a/thys/Iptables_Semantics/Examples/Synology_Diskstation_DS414/Analyze_Synology_Diskstation.thy b/thys/Iptables_Semantics/Examples/Synology_Diskstation_DS414/Analyze_Synology_Diskstation.thy
--- a/thys/Iptables_Semantics/Examples/Synology_Diskstation_DS414/Analyze_Synology_Diskstation.thy
+++ b/thys/Iptables_Semantics/Examples/Synology_Diskstation_DS414/Analyze_Synology_Diskstation.thy
@@ -1,465 +1,465 @@
 theory Analyze_Synology_Diskstation
 imports iptables_Ln_tuned_parsed (*2014 firewall dump*)
   Iptables_Semantics.Parser
   Iptables_Semantics.Parser6
 begin
 
 
 section\<open>Example: Synology Diskstation 2014\<close>
 text\<open>We analyze a dump of a NAS. The dump was created 2014. Unfortunately, we don't have an 
       \<open>iptables-save\<close> dump from that time and have to rely on the \<open>iptables -L -n\<close>
       dump. This dump was translated by our legacy python importer.\<close>
 
 
 text\<open>we removed the established,related rule\<close>
   definition "example_ruleset == firewall_chains(''INPUT'' \<mapsto> 
     remove1 (Rule (MatchAnd (Match (Src (IpAddrNetmask 0 0)))
             (MatchAnd (Match (Dst (IpAddrNetmask 0 0)))
             (MatchAnd (Match (Prot (ProtoAny)))
             (Match (Extra (''state RELATED,ESTABLISHED'')))))) (action.Accept)) (the (firewall_chains ''INPUT'')))"
 
 text\<open>Infix pretty-printing for @{const MatchAnd} and @{const MatchNot}.\<close>
 abbreviation MatchAndInfix :: "'a match_expr \<Rightarrow> 'a match_expr \<Rightarrow> 'a match_expr" (infixr "MATCHAND" 65) where
   "MatchAndInfix m1 m2 \<equiv> MatchAnd m1 m2"
 abbreviation MatchNotPrefix :: "'a match_expr \<Rightarrow> 'a match_expr" ("\<not> \<langle>_\<rangle>" 66) where
   "MatchNotPrefix m \<equiv> MatchNot m"
 (*abbreviation MatchPrefix :: "'a \<Rightarrow> 'a match_expr" ("\<lozenge> _" 67) where (*This is too slow*)
   "MatchPrefix m \<equiv> Match m"*)
 (*This syntax can be pretty confusing when mixing it with other theories. Do not use outside this example!*)
 
 
 lemma "unfold_ruleset_INPUT action.Accept example_ruleset =
  [Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04''))
    action.Drop,
   Rule (\<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (Extra ''Prot icmp'') MATCHAND Match (Extra ''icmptype 8 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x04 limit: avg 1/sec burst 5'')\<rangle> MATCHAND
         \<not> \<langle>Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02 limit: avg 10000/sec burst 100'')\<rangle> MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp flags:0x17/0x02''))
    action.Drop,
   Rule (Match (Prot (Proto TCP)) MATCHAND Match (Extra ''tcp dpt:22'')) action.Drop,
   Rule (Match (Prot (Proto TCP)) MATCHAND Match (Extra ''multiport dports 21,873,5005,5006,80,548,111,2049,892''))
    action.Drop,
   Rule (Match (Prot (Proto UDP)) MATCHAND Match (Extra ''multiport dports 123,111,2049,892,5353'')) action.Drop,
   Rule (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192, 168, 0, 0)) 16))) action.Accept, Rule MatchAny action.Drop,
   Rule MatchAny action.Accept, Rule MatchAny action.Accept]
   " by eval
 
   lemma "good_ruleset (unfold_ruleset_INPUT action.Accept example_ruleset)" by eval
   lemma "simple_ruleset (unfold_ruleset_INPUT action.Accept example_ruleset)" by eval
 
 
   text\<open>packets from the local LAN are allowed (@{const in_doubt_allow})\<close>
   lemma "approximating_bigstep_fun (common_matcher, in_doubt_allow)
     \<lparr>p_iiface = ''eth0'', p_oiface = ''eth1'', p_src = ipv4addr_of_dotdecimal (192,168,2,45), p_dst= ipv4addr_of_dotdecimal (8,8,8,8),
          p_proto=TCP, p_sport=2065, p_dport=80, p_tcp_flags = {TCP_SYN}, p_payload='''', p_tag_ctstate = CT_New\<rparr>
         (unfold_ruleset_INPUT action.Accept example_ruleset)
         Undecided = Decision FinalAllow" by eval
 
   text\<open>However, they might also be rate-limited, ... (we don't know about icmp)\<close>
   lemma "approximating_bigstep_fun (common_matcher, in_doubt_deny)
     \<lparr>p_iiface = ''eth0'', p_oiface = ''eth1'', p_src = ipv4addr_of_dotdecimal (192,168,2,45), p_dst= ipv4addr_of_dotdecimal (8,8,8,8),
          p_proto=TCP, p_sport=2065, p_dport=80, p_tcp_flags = {TCP_SYN}, p_payload='''', p_tag_ctstate = CT_New\<rparr>
         (unfold_ruleset_INPUT action.Accept example_ruleset)
         Undecided = Decision FinalDeny" by eval
   
   text\<open>But we can guarantee that packets from the outside are blocked!\<close>
   lemma "approximating_bigstep_fun (common_matcher, in_doubt_allow)
     \<lparr>p_iiface = ''eth0'', p_oiface = ''eth1'', p_src = ipv4addr_of_dotdecimal (8,8,8,8), p_dst= 0, p_proto=TCP, p_sport=2065, p_dport=80,
      p_tcp_flags = {TCP_SYN}, p_payload='''', p_tag_ctstate = CT_New\<rparr> 
         (unfold_ruleset_INPUT action.Accept example_ruleset)
         Undecided = Decision FinalDeny" by eval
 
 
 
 text\<open>in doubt allow closure\<close>
 lemma upper: "upper_closure (unfold_ruleset_INPUT action.Accept example_ruleset) =
   [Rule (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192, 168, 0, 0)) 16))) action.Accept,
    Rule MatchAny action.Drop]" by eval
 
 text\<open>in doubt deny closure\<close>
 lemma lower: "lower_closure (unfold_ruleset_INPUT action.Accept example_ruleset) =
  [Rule MatchAny action.Drop]" by eval
 
 
 text\<open>upper closure\<close>
 lemma "rmshadow (common_matcher, in_doubt_allow) (upper_closure (unfold_ruleset_INPUT action.Accept example_ruleset)) UNIV = 
   [Rule (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192, 168, 0, 0)) 16))) action.Accept, Rule MatchAny action.Drop]"
 (*<*)apply(subst upper)
 apply(subst rmshadow.simps)
 apply(simp del: rmshadow.simps)
 apply(simp add: Matching_Ternary.matches_def)
 apply(intro conjI impI)
  apply(rule_tac x="undefined\<lparr>p_iiface := ''eth0'', p_oiface := ''eth1'',
                    p_src := ipv4addr_of_dotdecimal (8,8,8,8), p_dst := 0,
                    p_proto := TCP, p_sport:=2065, p_dport:=80\<rparr>" in exI)
- apply(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def ipset_from_cidr_alt mask_def; fail)
+ apply(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def ipset_from_cidr_alt mask_eq_decr_exp; fail)
 apply(rule_tac x="undefined\<lparr>p_iiface := ''eth0'', p_oiface := ''eth1'',
                             p_src := ipv4addr_of_dotdecimal (192,168,8,8), p_dst:= 0,
                             p_proto:=TCP, p_sport:=2065, p_dport:=80\<rparr> " in exI)
-apply(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def ipset_from_cidr_alt mask_def; fail)
+apply(simp add: ipv4addr_of_dotdecimal.simps ipv4addr_of_nat_def ipset_from_cidr_alt mask_eq_decr_exp; fail)
 done(*>*)
 
 
 text\<open>lower closure\<close>
 lemma "rmshadow (common_matcher, in_doubt_deny) (lower_closure (unfold_ruleset_INPUT action.Accept example_ruleset)) UNIV =  
   [Rule MatchAny action.Drop]"
 apply(subst lower)
 apply(subst rmshadow.simps)
 apply(simp del: rmshadow.simps)
 apply(simp add: Matching_Ternary.matches_def)
 done
 
 
 
 lemma "check_simple_fw_preconditions (upper_closure (unfold_ruleset_INPUT action.Accept example_ruleset))" by eval
 
 value[code] "map simple_rule_ipv4_toString (to_simple_firewall (upper_closure (unfold_ruleset_INPUT action.Accept example_ruleset)))"
 lemma "map simple_rule_ipv4_toString (to_simple_firewall (upper_closure (unfold_ruleset_INPUT action.Accept example_ruleset))) =
   [''ACCEPT     all  --  192.168.0.0/16            0.0.0.0/0    '',
    ''DROP     all  --  0.0.0.0/0            0.0.0.0/0    '']" by eval (*will break when simple_rule_ipv4_toString is changed*)
 
 lemma "check_simple_fw_preconditions (lower_closure (unfold_ruleset_INPUT action.Accept example_ruleset))" by eval
 value[code] "map simple_rule_ipv4_toString (to_simple_firewall (lower_closure (unfold_ruleset_INPUT action.Accept example_ruleset)))"
 
 
 lemma "length (unfold_ruleset_INPUT action.Accept example_ruleset) = 19" by eval
 text\<open>Wow, normalization has exponential(?) blowup here.\<close>
 lemma "length (normalize_rules_dnf (unfold_ruleset_INPUT action.Accept example_ruleset)) = 259" by eval
 
 
 section\<open>Synology Diskstation 2015\<close>
 text\<open>This is a snapshot from 2015, available as \<open>iptables-save\<close> format. The firewall definition
       and structure has changed with various firmware updates to the device.
       Also, the new parser also parses ports and interfaces\<close>
 
 parse_iptables_save ds2015_fw="iptables-save"
 
 thm ds2015_fw_def
 thm ds2015_fw_INPUT_default_policy_def
 
 
 text\<open>this time, we don't removed the established,related rule\<close>
 
 
 value[code] "unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw)"
 lemma "unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw) =
 [Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth1'')) MATCHAND Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth1'')) MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})))
    action.Drop,
   Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})) MATCHAND
            Match (Extra ''-m limit --limit 10000/sec --limit-burst 100'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth1'')) MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})))
    action.Drop,
   Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})) MATCHAND
            Match (Extra ''-m limit --limit 10000/sec --limit-burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth0'')) MATCHAND Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8''))
    action.Drop,
   Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})) MATCHAND
            Match (Extra ''-m limit --limit 10000/sec --limit-burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth0'')) MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})))
    action.Drop,
   Rule (\<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth1'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})) MATCHAND
            Match (Extra ''-m limit --limit 10000/sec --limit-burst 100'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto ICMP)) MATCHAND Match (Extra ''-m icmp --icmp-type 8 -m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_RST})) MATCHAND Match (Extra ''-m limit --limit 1/sec'')\<rangle> MATCHAND
         \<not> \<langle>Match (IIface (Iface ''eth0'')) MATCHAND
            Match (Prot (Proto TCP)) MATCHAND
            Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})) MATCHAND
            Match (Extra ''-m limit --limit 10000/sec --limit-burst 100'')\<rangle> MATCHAND
         Match (IIface (Iface ''eth0'')) MATCHAND
         Match (Prot (Proto TCP)) MATCHAND Match (L4_Flags (TCP_Flags {TCP_FIN, TCP_SYN, TCP_RST, TCP_ACK} {TCP_SYN})))
    action.Drop,
   Rule (Match (IIface (Iface ''lo''))) action.Accept, Rule (Match (CT_State {CT_Related, CT_Established})) action.Accept,
   Rule (Match (IIface (Iface ''eth0'')) MATCHAND Match (Prot (Proto TCP)) MATCHAND Match (Dst_Ports (L4Ports TCP [(0x16, 0x16)]))) action.Drop,
   Rule (Match (IIface (Iface ''eth0'')) MATCHAND
         Match (Prot (Proto TCP)) MATCHAND
         Match (Dst_Ports (L4Ports TCP 
                 [(0x15, 0x15), (0x369, 0x369), (0x138D, 0x138D), (0x138E, 0x138E), (0x50, 0x50), (0x224, 0x224), (0x6F, 0x6F), (0x37C, 0x37C),
                  (0x801, 0x801)])))
    action.Drop,
   Rule (Match (IIface (Iface ''eth0'')) MATCHAND
         Match (Prot (Proto UDP)) MATCHAND Match (Dst_Ports (L4Ports UDP [(0x7B, 0x7B), (0x6F, 0x6F), (0x37C, 0x37C), (0x801, 0x801), (0x14E9, 0x14E9)])))
    action.Drop,
   Rule (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192, 168, 0, 0)) 16)) MATCHAND Match (IIface (Iface ''eth0''))) action.Accept,
   Rule (Match (IIface (Iface ''eth0''))) action.Drop, Rule MatchAny action.Accept]" by eval
 
 value[code] "map common_primitive_rule_toString (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw))"
 
 value[code] "(upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw))))"
 
 value[code] "optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw))))"
 
 value[code] "upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw)))"
 
 lemma "check_simple_fw_preconditions (upper_closure (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw))))))" by eval
 
 value[code] "map simple_rule_ipv4_toString (to_simple_firewall
               (upper_closure (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw)))))))"
 lemma "simple_fw_valid (to_simple_firewall
               (upper_closure (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw)))))))" by eval
 lemma "simple_fw_valid (to_simple_firewall
               (lower_closure (optimize_matches abstract_for_simple_firewall (upper_closure (packet_assume_new (unfold_ruleset_INPUT ds2015_fw_INPUT_default_policy (map_of ds2015_fw)))))))" by eval
 
 parse_iptables_save ds2015_2_fw="iptables-save_jun_2015_cleanup"
 text\<open>In 2015 there was also an update and a cleanup of the ruleset.
 The following should be fulfilled:
 Port 80 globally blocked (fulfilled, only reachable by localhost).
 Port 22 globally blocked (not fulfilled, error in the ruleset).
 Port 8080 only reachable from 192.168.0.0/24 and localhost (fulfilled).
 \<close>
 
 value[code] "unfold_ruleset_INPUT ds2015_2_fw_INPUT_default_policy (map_of ds2015_2_fw)"
 
 lemma "access_matrix_pretty_ipv4 parts_connection_ssh
         (to_simple_firewall_without_interfaces ipassmt_generic_ipv4 None
           (unfold_ruleset_INPUT ds2015_2_fw_INPUT_default_policy (map_of ds2015_2_fw))) =
   ([(''0.0.0.0'', ''{0.0.0.0 .. 255.255.255.255}'')
    ],
    [(''0.0.0.0'', ''0.0.0.0'')])" by eval
 
 
 lemma "access_matrix_pretty_ipv4 parts_connection_http
         (to_simple_firewall_without_interfaces ipassmt_generic_ipv4 None
           (unfold_ruleset_INPUT ds2015_2_fw_INPUT_default_policy (map_of ds2015_2_fw))) =
   ([(''0.0.0.0'', ''{0.0.0.0 .. 126.255.255.255} u {128.0.0.0 .. 255.255.255.255}''),
     (''127.0.0.0'', ''{127.0.0.0 .. 127.255.255.255}'')
    ],
    [(''127.0.0.0'', ''0.0.0.0''),
     (''127.0.0.0'', ''127.0.0.0'')])" by eval
 
 lemma "access_matrix_pretty_ipv4 (mk_parts_connection_TCP 10000 8080)
         (to_simple_firewall_without_interfaces ipassmt_generic_ipv4 None
           (unfold_ruleset_INPUT ds2015_2_fw_INPUT_default_policy (map_of ds2015_2_fw))) = 
   ([(''127.0.0.0'', ''{127.0.0.0 .. 127.255.255.255} u {192.168.0.0 .. 192.168.255.255}''),
     (''0.0.0.0'', ''{0.0.0.0 .. 126.255.255.255} u {128.0.0.0 .. 192.167.255.255} u {192.169.0.0 .. 255.255.255.255}'')
    ],
    [(''127.0.0.0'', ''127.0.0.0''),
     (''127.0.0.0'', ''0.0.0.0'')])" by eval
 
 
 
 text\<open>The 2016 version with IPv6 is very interesting. 
  Some source ports for UDP are just allowed.
  Is this a typo? The original structure with the @{const Return}s is very complicated.
  Here is what is actually dropped and accepted:\<close>
 parse_ip6tables_save ds_2016_ipv6 = "ip6tables-save_jul_2016" (*5s*)
 
 lemma "map simple_rule_ipv6_toString
               (to_simple_firewall (upper_closure
                 (optimize_matches abstract_for_simple_firewall
                   (upper_closure (packet_assume_new
                     (unfold_ruleset_FORWARD ds_2016_ipv6_FORWARD_default_policy
                       (map_of ds_2016_ipv6))))))) =
 [ ''ACCEPT     all  --  ::/0            ::/0 in: lo   '',
   ''ACCEPT     ipv6-icmp  --  fe80::/10            ::/0    '',
   ''DROP     tcp  --  ::/0            ::/0    dports: 21'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 873'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 631'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 515'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 3260:3262'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 22:23'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 548'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 3493'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 3306'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 67:68'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 123'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 514'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 161'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 19999'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 5353'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 67:68'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 123'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 514'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 161'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 19999'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 5353'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 67:68'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 123'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 514'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 161'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 19999'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 5353'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 67:68'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 123'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 514'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 161'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 19999'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 5353'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 111'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 892'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 2049'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 111'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 892'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 2049'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 111'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 892'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 2049'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 111'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 892'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 2049'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 111'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 892'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 2049'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 0:79'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 81:442'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 444:9024'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 9041:50000'',
   ''DROP     tcp  --  ::/0            ::/0    dports: 50003:65535'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0   sports: 0:5001 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5003 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0   sports: 5005:65000 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0   sports: 65002:65535 dports: 65002:65535'',
   \<comment> \<open>The following eth0 rules are shadowed\<close>
   ''DROP     tcp  --  ::/0            ::/0 in: eth0   dports: 0:79'',
   ''DROP     tcp  --  ::/0            ::/0 in: eth0   dports: 81:442'',
   ''DROP     tcp  --  ::/0            ::/0 in: eth0   dports: 444:9024'',
   ''DROP     tcp  --  ::/0            ::/0 in: eth0   dports: 9041:50000'',
   ''DROP     tcp  --  ::/0            ::/0 in: eth0   dports: 50003:65535'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 0:5001 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 0:5001 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 0:5001 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 0:5001 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 0:5001 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5003 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5003 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5003 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5003 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5003 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5005:65000 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5005:65000 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5005:65000 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5005:65000 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 5005:65000 dports: 65002:65535'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 65002:65535 dports: 0:1899'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 65002:65535 dports: 1901:5001'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 65002:65535 dports: 5003'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 65002:65535 dports: 5005:65000'',
   ''DROP     udp  --  ::/0            ::/0 in: eth0  sports: 65002:65535 dports: 65002:65535'',
   ''ACCEPT     all  --  ::/0            ::/0    '']"
 by eval (*50s*)
 
 end
diff --git a/thys/JinjaThreads/BV/BVSpecTypeSafe.thy b/thys/JinjaThreads/BV/BVSpecTypeSafe.thy
--- a/thys/JinjaThreads/BV/BVSpecTypeSafe.thy
+++ b/thys/JinjaThreads/BV/BVSpecTypeSafe.thy
@@ -1,1841 +1,1841 @@
 (*  Title:      JinjaThreads/BV/BVSpecTypeSafe.thy
     Author:     Cornelia Pusch, Gerwin Klein, Andreas Lochbihler
 *)
 
 section \<open>BV Type Safety Proof \label{sec:BVSpecTypeSafe}\<close>
 
 theory BVSpecTypeSafe
 imports
   BVConform
   "../Common/ExternalCallWF"
 begin
 
 declare listE_length [simp del]
 
 text \<open>
   This theory contains proof that the specification of the bytecode
   verifier only admits type safe programs.  
 \<close>
 
 subsection \<open>Preliminaries\<close>
 
 text \<open>
   Simp and intro setup for the type safety proof:
 \<close>
 context JVM_heap_conf_base begin
 
 lemmas widen_rules [intro] = conf_widen confT_widen confs_widens confTs_widen
 
 end
   
 subsection \<open>Exception Handling\<close>
 
 
 text \<open>
   For the \<open>Invoke\<close> instruction the BV has checked all handlers
   that guard the current \<open>pc\<close>.
 \<close>
 lemma Invoke_handlers:
   "match_ex_table P C pc xt = Some (pc',d') \<Longrightarrow> 
   \<exists>(f,t,D,h,d) \<in> set (relevant_entries P (Invoke n M) pc xt). 
    (case D of None \<Rightarrow> True | Some D' \<Rightarrow> P \<turnstile> C \<preceq>\<^sup>* D') \<and> pc \<in> {f..<t} \<and> pc' = h \<and> d' = d"
   by (induct xt) (auto simp add: relevant_entries_def matches_ex_entry_def 
                                  is_relevant_entry_def split: if_split_asm)
 
 lemma match_is_relevant:
   assumes rv: "\<And>D'. P \<turnstile> D \<preceq>\<^sup>* D' \<Longrightarrow> is_relevant_class (ins ! i) P D'"
   assumes match: "match_ex_table P D pc xt = Some (pc',d')"
   shows "\<exists>(f,t,D',h,d) \<in> set (relevant_entries P (ins ! i) pc xt). (case D' of None \<Rightarrow> True | Some D'' \<Rightarrow> P \<turnstile> D \<preceq>\<^sup>* D'') \<and> pc \<in> {f..<t} \<and> pc' = h \<and> d' = d"
 using rv match
 by(fastforce simp add: relevant_entries_def is_relevant_entry_def matches_ex_entry_def dest: match_ex_table_SomeD)
 
 
 context JVM_heap_conf_base begin
 
 lemma exception_step_conform:
   fixes \<sigma>' :: "('addr, 'heap) jvm_state"
   assumes wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   assumes correct: "\<Phi> \<turnstile> t:(\<lfloor>xcp\<rfloor>, h, fr # frs) \<surd>"
   shows "\<Phi> \<turnstile> t:exception_step P xcp h fr frs \<surd>"
 proof -
   obtain stk loc C M pc where fr: "fr = (stk, loc, C, M, pc)" by(cases fr)
   from correct obtain Ts T mxs mxl\<^sub>0 ins xt 
     where meth: "P \<turnstile> C sees M:Ts \<rightarrow> T = \<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
     by (simp add: correct_state_def fr) blast
 
   from correct meth fr obtain D 
     where hxcp: "typeof_addr h xcp = \<lfloor>Class_type D\<rfloor>" and DsubThrowable: "P \<turnstile> D \<preceq>\<^sup>* Throwable"
     and rv: "\<And>D'. P \<turnstile> D \<preceq>\<^sup>* D' \<Longrightarrow> is_relevant_class (instrs_of P C M ! pc) P D'"
     by(fastforce simp add: correct_state_def dest: sees_method_fun)
   
   from meth have [simp]: "ex_table_of P C M = xt" by simp
 
   from correct have tconf: "P,h \<turnstile> t \<surd>t" by(simp add: correct_state_def)
 
   show ?thesis
   proof(cases "match_ex_table P D pc xt")
     case None
     with correct fr meth hxcp show ?thesis
       by(fastforce simp add: correct_state_def cname_of_def split: list.split)
   next
     case (Some pc_d)
     then obtain pc' d' where pcd: "pc_d = (pc', d')"
       and match: "match_ex_table P D pc xt = Some (pc',d')" by (cases pc_d) auto
     from match_is_relevant[OF rv match] meth obtain f t D'
       where rv: "(f, t, D', pc', d') \<in> set (relevant_entries P (ins ! pc) pc xt)"
       and DsubD': "(case D' of None \<Rightarrow> True | Some D'' \<Rightarrow> P \<turnstile> D \<preceq>\<^sup>* D'')" and pc: "pc \<in> {f..<t}" by(auto)
 
     from correct meth obtain ST LT
       where h_ok:  "hconf h"
       and \<Phi>_pc: "\<Phi> C M ! pc = Some (ST, LT)"
       and frame:  "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)"
       and frames: "conf_fs P h \<Phi> M (size Ts) T frs"
       and preh: "preallocated h"
       unfolding correct_state_def fr by(auto dest: sees_method_fun)
 
     from frame obtain stk: "P,h \<turnstile> stk [:\<le>] ST"
       and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and pc:  "pc < size ins" 
       by (unfold conf_f_def) auto
     
     from stk have [simp]: "size stk = size ST" ..
 
     from wtp meth correct fr have wt: "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
       by (auto simp add: correct_state_def conf_f_def
                    dest: sees_method_fun
                    elim!: wt_jvm_prog_impl_wt_instr)
 
     from wt \<Phi>_pc have
       eff: "\<forall>(pc', s')\<in>set (xcpt_eff (ins!pc) P pc (ST,LT) xt).
              pc' < size ins \<and> P \<turnstile> s' \<le>' \<Phi> C M!pc'"
       by (auto simp add: defs1)
 
     let ?stk' = "Addr xcp # drop (length stk - d') stk"
     let ?f = "(?stk', loc, C, M, pc')"
 
     have conf: "P,h \<turnstile> Addr xcp :\<le> Class (case D' of None \<Rightarrow> Throwable | Some D'' \<Rightarrow> D'')"
       using DsubD' hxcp DsubThrowable by(auto simp add: conf_def)
 
     obtain ST' LT' where
       \<Phi>_pc': "\<Phi> C M ! pc' = Some (ST', LT')" and
       pc':   "pc' < size ins" and
       less:  "P \<turnstile> (Class D # drop (size ST - d') ST, LT) \<le>\<^sub>i (ST', LT')"
     proof(cases D')
       case Some
       thus ?thesis using eff rv DsubD' conf that
         by(fastforce simp add: xcpt_eff_def sup_state_opt_any_Some intro: widen_trans[OF widen_subcls])
     next
       case None
       with that eff rv conf DsubThrowable show ?thesis
         by(fastforce simp add: xcpt_eff_def sup_state_opt_any_Some intro: widen_trans[OF widen_subcls])
     qed
 
     with conf loc stk hxcp have "conf_f P h (ST',LT') ins ?f" 
       by (auto simp add: defs1 conf_def intro: list_all2_dropI)
 
     with meth h_ok frames \<Phi>_pc' fr match hxcp tconf preh
     show ?thesis unfolding correct_state_def
       by(fastforce dest: sees_method_fun simp add: cname_of_def)
   qed
 qed
 
 end
 
 subsection \<open>Single Instructions\<close>
 
 text \<open>
   In this subsection we prove for each single (welltyped) instruction
   that the state after execution of the instruction still conforms.
   Since we have already handled raised exceptions above, we can now assume that
   no exception has been raised in this step.
 \<close>
 
 context JVM_conf_read begin
 
 declare defs1 [simp]
 
 lemma Invoke_correct: 
   fixes \<sigma>' :: "('addr, 'heap) jvm_state"
   assumes wtprog: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   assumes meth_C: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:    "ins ! pc = Invoke M' n"
   assumes wti:    "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes approx: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes exec: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma> \<surd>"
 proof -
   note split_paired_Ex [simp del]
   
   from wtprog obtain wfmb where wfprog: "wf_prog wfmb P" 
     by (simp add: wf_jvm_prog_phi_def)
       
   from ins meth_C approx obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (fastforce dest: sees_method_fun)
 
   from ins wti \<Phi>_pc
   have n: "n < size ST" by simp
   
   show ?thesis
   proof(cases "stk!n = Null")
     case True
     with ins heap_ok \<Phi>_pc frame frames exec meth_C tconf preh show ?thesis
       by(fastforce elim: wf_preallocatedE[OF wfprog, where C=NullPointer])
   next
     case False
     note Null = this
     have NT: "ST!n \<noteq> NT"
     proof
       assume "ST!n = NT"
       moreover from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with n have "P,h \<turnstile> stk!n :\<le> ST!n" by (simp add: list_all2_conv_all_nth)
       ultimately have "stk!n = Null" by simp
       with Null show False by contradiction
     qed
 
     from frame obtain 
       stk: "P,h \<turnstile> stk [:\<le>] ST" and
       loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" by simp
 
     from NT ins wti \<Phi>_pc have pc': "pc+1 < size ins" by simp
 
     from NT ins wti \<Phi>_pc obtain ST' LT'
       where pc': "pc+1 < size ins"
       and \<Phi>': "\<Phi> C M ! (pc+1) = Some (ST', LT')"
       and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'"
       by(auto simp add: neq_Nil_conv sup_state_opt_any_Some split: if_split_asm)
     with NT ins wti \<Phi>_pc obtain D D' TTs TT m
       where D: "class_type_of' (ST!n) = \<lfloor>D\<rfloor>"
       and m_D: "P \<turnstile> D sees M': TTs\<rightarrow>TT = m in D'"
       and Ts:  "P \<turnstile> rev (take n ST) [\<le>] TTs"
       and ST': "P \<turnstile> (TT # drop (n+1) ST) [\<le>] ST'" 
       by(auto)
 
     from n stk D have "P,h \<turnstile> stk!n :\<le> ST ! n"
       by (auto simp add: list_all2_conv_all_nth)
       
     from \<open>P,h \<turnstile> stk!n :\<le> ST ! n\<close> Null D
     obtain U a where
       Addr:   "stk!n = Addr a" and
       obj:    "typeof_addr h a = Some U" and
       UsubSTn: "P \<turnstile> ty_of_htype U \<le> ST ! n"
       by(cases "stk ! n")(auto simp add: conf_def widen_Class)
 
     from D UsubSTn obtain C' where
       C': "class_type_of' (ty_of_htype U) = \<lfloor>C'\<rfloor>" and C'subD: "P \<turnstile> C' \<preceq>\<^sup>* D"
       by(rule widen_is_class_type_of) simp
 
     with wfprog m_D
     obtain Ts' T' D'' meth' where
       m_C': "P \<turnstile> C' sees M': Ts'\<rightarrow>T' = meth' in D''" and
       T':   "P \<turnstile> T' \<le> TT" and
       Ts':  "P \<turnstile> TTs [\<le>] Ts'" 
       by (auto dest: sees_method_mono)
 
     from Ts n have [simp]: "size TTs = n" 
       by (auto dest: list_all2_lengthD simp: min_def)
     with Ts' have [simp]: "size Ts' = n" 
       by (auto dest: list_all2_lengthD)
 
     from m_C' wfprog
     obtain mD'': "P \<turnstile> D'' sees M':Ts'\<rightarrow>T'=meth' in D''"
       by (fast dest: sees_method_idemp)
 
     { fix mxs' mxl' ins' xt'
       assume [simp]: "meth' = \<lfloor>(mxs', mxl', ins', xt')\<rfloor>"
       let ?loc' = "Addr a # rev (take n stk) @ replicate mxl' undefined_value"
       let ?f' = "([], ?loc', D'', M', 0)"
       let ?f  = "(stk, loc, C, M, pc)"
       
       from Addr obj m_C' ins meth_C exec C' False
       have s': "\<sigma> = (None, h, ?f' # ?f # frs)" by(auto split: if_split_asm)
       
       moreover 
       from wtprog mD''
       obtain start: "wt_start P D'' Ts' mxl' (\<Phi> D'' M')" and ins': "ins' \<noteq> []"
         by (auto dest: wt_jvm_prog_impl_wt_start)
       then obtain LT\<^sub>0 where LT\<^sub>0: "\<Phi> D'' M' ! 0 = Some ([], LT\<^sub>0)"
         by (clarsimp simp add: wt_start_def defs1 sup_state_opt_any_Some)
       moreover
       have "conf_f P h ([], LT\<^sub>0) ins' ?f'"
       proof -
         let ?LT = "OK (Class D'') # (map OK Ts') @ (replicate mxl' Err)"
         
         from stk have "P,h \<turnstile> take n stk [:\<le>] take n ST" ..
         hence "P,h \<turnstile> rev (take n stk) [:\<le>] rev (take n ST)" by simp
         also note Ts also note Ts' finally
         have "P,h \<turnstile> rev (take n stk) [:\<le>\<^sub>\<top>] map OK Ts'" by simp 
         also
         have "P,h \<turnstile> replicate mxl' undefined_value [:\<le>\<^sub>\<top>] replicate mxl' Err" by simp
         also from m_C' have "P \<turnstile> C' \<preceq>\<^sup>* D''" by (rule sees_method_decl_above)
         from obj heap_ok have "is_htype P U" by (rule typeof_addr_is_type)
         with C' have "P \<turnstile> ty_of_htype U \<le> Class C'" 
           by(cases U)(simp_all add: widen_array_object)
         with \<open>P \<turnstile> C' \<preceq>\<^sup>* D''\<close> obj C' have "P,h \<turnstile> Addr a :\<le> Class D''"
           by (auto simp add: conf_def intro: widen_trans)
         ultimately
         have "P,h \<turnstile> ?loc' [:\<le>\<^sub>\<top>] ?LT" by simp
         also from start LT\<^sub>0 have "P \<turnstile> \<dots> [\<le>\<^sub>\<top>] LT\<^sub>0" by (simp add: wt_start_def)
         finally have "P,h \<turnstile> ?loc' [:\<le>\<^sub>\<top>] LT\<^sub>0" .
         thus ?thesis using ins' by simp
       qed
       ultimately have ?thesis using s' \<Phi>_pc approx meth_C m_D T' ins D tconf C' mD''
         by (fastforce dest: sees_method_fun [of _ C]) }
     moreover
     { assume [simp]: "meth' = Native"
       with wfprog m_C' have "D''\<bullet>M'(Ts') :: T'" by(simp add: sees_wf_native)
       with C' m_C' have nec: "is_native P U M'" by(auto intro: is_native.intros)
 
       from ins n Addr obj exec m_C' C'
       obtain va h' tas' where va: "(tas', va, h') \<in> red_external_aggr P t a M' (rev (take n stk)) h"
         and \<sigma>: "\<sigma> = extRet2JVM n h' stk loc C M pc frs va" by(auto)
       from va nec obj have hext: "h \<unlhd> h'" by(auto intro: red_external_aggr_hext)
       with frames have frames': "conf_fs P h' \<Phi> M (length Ts) T frs" by(rule conf_fs_hext)
       from preh hext have preh': "preallocated h'" by(rule preallocated_hext)      
       from va nec obj tconf have tconf': "P,h' \<turnstile> t \<surd>t"
         by(auto dest: red_external_aggr_preserves_tconf)
       from hext obj have obj': "typeof_addr h' a = \<lfloor>U\<rfloor>" by(rule typeof_addr_hext_mono)
 
       from stk have "P,h \<turnstile> take n stk [:\<le>] take n ST" by(rule list_all2_takeI)
       then obtain Us where "map typeof\<^bsub>h\<^esub> (take n stk) = map Some Us" "P \<turnstile> Us [\<le>] take n ST"
         by(auto simp add: confs_conv_map)
       hence Us: "map typeof\<^bsub>h\<^esub> (rev (take n stk)) = map Some (rev Us)" "P \<turnstile> rev Us [\<le>] rev (take n ST)"
         by- (simp only: rev_map[symmetric], simp)
       from \<open>P \<turnstile> rev Us [\<le>] rev (take n ST)\<close> Ts Ts'
       have "P \<turnstile> rev Us [\<le>] Ts'" by(blast intro: widens_trans)
       with obj \<open>map typeof\<^bsub>h\<^esub> (rev (take n stk)) = map Some (rev Us)\<close> C' m_C' 
       have wtext': "P,h \<turnstile> a\<bullet>M'(rev (take n stk)) : T'" by(simp add: external_WT'.intros)
       from va have va': "P,t \<turnstile> \<langle>a\<bullet>M'(rev (take n stk)),h\<rangle> -tas'\<rightarrow>ext \<langle>va,h'\<rangle>"
         by(unfold WT_red_external_list_conv[OF wfprog wtext' tconf])
       with heap_ok wtext' tconf wfprog have heap_ok': "hconf h'" by(auto dest: external_call_hconf)
 
       have ?thesis
       proof(cases va)
         case (RetExc a')
         from frame hext have "conf_f P h' (ST, LT) ins (stk, loc, C, M, pc)" by(rule conf_f_hext)
         with \<sigma> tconf' heap_ok' meth_C \<Phi>_pc frames' RetExc red_external_conf_extRet[OF wfprog va' wtext' heap_ok preh tconf] ins preh'
         show ?thesis by(fastforce simp add: conf_def widen_Class)
       next
         case RetStaySame
         from frame hext have "conf_f P h' (ST, LT) ins (stk, loc, C, M, pc)" by(rule conf_f_hext)
         with \<sigma> heap_ok' meth_C \<Phi>_pc RetStaySame frames' tconf' preh' show ?thesis by fastforce
       next
         case (RetVal v)
         with \<sigma> have \<sigma>: "\<sigma> = (None, h', (v # drop (n+1) stk, loc, C, M, pc+1) # frs)" by simp
         from heap_ok wtext' va' RetVal preh tconf have "P,h' \<turnstile> v :\<le> T'"
           by(auto dest: red_external_conf_extRet[OF wfprog])
         from stk have "P,h \<turnstile> drop (n + 1) stk [:\<le>] drop (n+1) ST" by(rule list_all2_dropI)
         hence "P,h' \<turnstile> drop (n + 1) stk [:\<le>] drop (n+1) ST" using hext by(rule confs_hext)
         with \<open>P,h' \<turnstile> v :\<le> T'\<close> have "P,h' \<turnstile> v # drop (n + 1) stk [:\<le>] T' # drop (n+1) ST"
           by(auto simp add: conf_def intro: widen_trans)
         also
         with NT ins wti \<Phi>_pc \<Phi>' nec False D m_D T'
         have "P \<turnstile> (T' # drop (n + 1) ST) [\<le>] ST'"
           by(auto dest: sees_method_fun intro: widen_trans)
         also from loc hext have "P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT" by(rule confTs_hext)
         hence "P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" using LT' by(rule confTs_widen)
         ultimately show ?thesis using \<open>hconf h'\<close> \<sigma> meth_C \<Phi>' pc' frames' tconf' preh' by fastforce
       qed }
     ultimately show ?thesis by(cases meth') auto
   qed
 qed
 
 declare list_all2_Cons2 [iff]
 
 lemma Return_correct:
   assumes wt_prog: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins: "ins ! pc = Return"
   assumes wt: "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes correct: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes s': "(tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs)"
   shows "\<Phi> \<turnstile> t:\<sigma>'\<surd>"
 proof -
   from wt_prog 
   obtain wfmb where wf: "wf_prog wfmb P" by (simp add: wf_jvm_prog_phi_def)
 
   from meth ins s' correct
   have "frs = [] \<Longrightarrow> ?thesis" by (simp add: correct_state_def)
   moreover
   { fix f frs' assume frs': "frs = f#frs'"
     moreover obtain stk' loc' C' M' pc' where 
       f: "f = (stk',loc',C',M',pc')" by (cases f)
     moreover note meth ins s'
     ultimately
     have \<sigma>':
       "\<sigma>' = (None,h,(hd stk#(drop (1+size Ts) stk'),loc',C',M',pc'+1)#frs')"
       (is "\<sigma>' = (None,h,?f'#frs')")
       by simp
     
     from correct meth
     obtain ST LT where
       h_ok:   "hconf h" and
       tconf: "P,h \<turnstile> t \<surd>t" and
       \<Phi>_pc: "\<Phi> C M ! pc = Some (ST, LT)" and
       frame:  "conf_f P h (ST, LT) ins (stk,loc,C,M,pc)" and
       frames: "conf_fs P h \<Phi> M (size Ts) T frs" and
       preh: "preallocated h"
       by (auto dest: sees_method_fun)
 
     from \<Phi>_pc ins wt
     obtain U ST\<^sub>0 where "ST = U # ST\<^sub>0" "P \<turnstile> U \<le> T"
       by (simp add: wt_instr_def app_def) blast    
     with wf frame 
     have hd_stk: "P,h \<turnstile> hd stk :\<le> T" by (auto simp add: conf_f_def)
 
     from f frs' frames
     obtain ST' LT' Ts'' T'' mxs' mxl\<^sub>0' ins' xt' Ts' T' where
       \<Phi>': "\<Phi> C' M' ! pc' = Some (ST', LT')" and
       meth_C':  "P \<turnstile> C' sees M':Ts''\<rightarrow>T''=\<lfloor>(mxs',mxl\<^sub>0',ins',xt')\<rfloor> in C'" and
       ins': "ins' ! pc' = Invoke M (size Ts)" and
       D: "\<exists>D m D'. class_type_of' (ST' ! (size Ts)) = Some D \<and> P \<turnstile> D sees M: Ts'\<rightarrow>T' = m in D'" and
       T': "P \<turnstile> T \<le> T'" and
       frame':   "conf_f P h (ST',LT') ins' f" and
       conf_fs:  "conf_fs P h \<Phi> M' (size Ts'') T'' frs'"
       by clarsimp blast
 
     from f frame' obtain
       stk': "P,h \<turnstile> stk' [:\<le>] ST'" and
       loc': "P,h \<turnstile> loc' [:\<le>\<^sub>\<top>] LT'" and
       pc':  "pc' < size ins'"
       by (simp add: conf_f_def)
     
     from wt_prog meth_C' pc'  
     have wti: "P,T'',mxs',size ins',xt' \<turnstile> ins'!pc',pc' :: \<Phi> C' M'"
       by (rule wt_jvm_prog_impl_wt_instr)
 
     obtain aTs ST'' LT'' where
       \<Phi>_suc:   "\<Phi> C' M' ! Suc pc' = Some (ST'', LT'')" and
       less:    "P \<turnstile> (T' # drop (size Ts+1) ST', LT') \<le>\<^sub>i (ST'', LT'')" and
       suc_pc': "Suc pc' < size ins'"
       using ins' \<Phi>' D T' wti
       by(fastforce simp add: sup_state_opt_any_Some split: if_split_asm)
 
     from hd_stk T' have hd_stk': "P,h \<turnstile> hd stk :\<le> T'"  ..
         
     have frame'':
       "conf_f P h (ST'',LT'') ins' ?f'" 
     proof -
       from stk'
       have "P,h \<turnstile> drop (1+size Ts) stk' [:\<le>] drop (1+size Ts) ST'" ..
       moreover
       with hd_stk' less
       have "P,h \<turnstile> hd stk # drop (1+size Ts) stk' [:\<le>] ST''" by auto
       moreover
       from wf loc' less have "P,h \<turnstile> loc' [:\<le>\<^sub>\<top>] LT''" by auto
       moreover note suc_pc' 
       ultimately show ?thesis by (simp add: conf_f_def)
     qed
 
     with \<sigma>' frs' f meth h_ok hd_stk \<Phi>_suc frames meth_C' \<Phi>'  tconf preh
     have ?thesis by (fastforce dest: sees_method_fun [of _ C'])
   }
   ultimately
   show ?thesis by (cases frs) blast+
 qed
 
 declare sup_state_opt_any_Some [iff]
 declare not_Err_eq [iff] 
 
 lemma Load_correct:
 "\<lbrakk> wf_prog wt P;
     P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
     ins!pc = Load idx; 
     P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
     \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd> ;
     (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>' \<surd>"
   by (fastforce dest: sees_method_fun [of _ C] elim!: confTs_confT_sup)
 
 declare [[simproc del: list_to_set_comprehension]]
 
 lemma Store_correct:
 "\<lbrakk> wf_prog wt P;
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C;
   ins!pc = Store idx;
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M;
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
   apply clarsimp 
   apply (drule (1) sees_method_fun)
   apply clarsimp
   apply (blast intro!: list_all2_update_cong)
   done
 
 lemma Push_correct:
 "\<lbrakk> wf_prog wt P;
     P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
     ins!pc = Push v;
     P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
     \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>; 
     (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>" 
   apply clarsimp 
   apply (drule (1) sees_method_fun)
   apply clarsimp
   apply (blast dest: typeof_lit_conf)
   done
 
 declare [[simproc add: list_to_set_comprehension]]
 
 lemma Checkcast_correct:
 "\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P;
     P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
     ins!pc = Checkcast D; 
     P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
     \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
     (tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs \<rbrakk> 
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma> \<surd>"
 using wf_preallocatedD[of "\<lambda>P C (M, Ts, T\<^sub>r, mxs, mxl\<^sub>0, is, xt). wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt (\<Phi> C M)" P h ClassCast]
 apply (clarsimp simp add: wf_jvm_prog_phi_def split: if_split_asm)
  apply(drule (1) sees_method_fun)
  apply(fastforce simp add: conf_def intro: widen_trans)
 apply (drule (1) sees_method_fun)
 apply(fastforce simp add: conf_def intro: widen_trans)
 done
 
 lemma Instanceof_correct:
 "\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P;
     P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
     ins!pc = Instanceof Ty; 
     P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
     \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
     (tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs \<rbrakk> 
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma> \<surd>"
   apply (clarsimp simp add: wf_jvm_prog_phi_def split: if_split_asm)
   apply (drule (1) sees_method_fun)
   apply fastforce
   done
 
 declare split_paired_All [simp del]
 
 end
 
 lemma widens_Cons [iff]:
   "P \<turnstile> (T # Ts) [\<le>] Us = (\<exists>z zs. Us = z # zs \<and> P \<turnstile> T \<le> z \<and> P \<turnstile> Ts [\<le>] zs)"
 by(rule list_all2_Cons1)
 
 context heap_conf_base begin
 
 
 end
 
 context JVM_conf_read begin
 
 lemma Getfield_correct:
   assumes wf: "wf_prog wt P"
   assumes mC: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes i:  "ins!pc = Getfield F D"
   assumes wt: "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes cf: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes xc: "(tas, \<sigma>') \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
 
   shows "\<Phi> \<turnstile> t:\<sigma>'\<surd>"
 proof -
   from mC cf obtain ST LT where    
     "h\<surd>": "hconf h" and
     tconf: "P,h \<turnstile> t \<surd>t" and
     \<Phi>: "\<Phi> C M ! pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     fs: "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh: "preallocated h"
     by (fastforce dest: sees_method_fun)
        
   from i \<Phi> wt obtain oT ST'' vT ST' LT' vT' fm where 
     oT: "P \<turnstile> oT \<le> Class D" and
     ST: "ST = oT # ST''" and
     F:  "P \<turnstile> D sees F:vT (fm) in D" and
     pc': "pc+1 < size ins"  and
     \<Phi>': "\<Phi> C M ! (pc+1) = Some (vT'#ST', LT')" and
     ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and  
     vT': "P \<turnstile> vT \<le> vT'"
     by fastforce                       
 
   from stk ST obtain ref stk' where 
     stk': "stk = ref#stk'" and
     ref:  "P,h \<turnstile> ref :\<le> oT" and
     ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
     by auto
 
   show ?thesis
   proof(cases "ref = Null")
     case True
     with tconf "h\<surd>" i xc stk' mC fs \<Phi> ST'' ref ST loc pc' 
       wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     from ref oT have "P,h \<turnstile> ref :\<le> Class D" ..
     with False obtain a U' D' where a: "ref = Addr a"
       and h: "typeof_addr h a = Some U'"
       and U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
       by (blast dest: non_npD2)
 
     { fix v
       assume read: "heap_read h a (CField D F) v"
       from D' F have has_field: "P \<turnstile> D' has F:vT (fm) in D"
         by (blast intro: has_field_mono has_visible_field)
       with h have "P,h \<turnstile> a@CField D F : vT" unfolding U' .. 
       with read have v: "P,h \<turnstile> v :\<le> vT" using "h\<surd>"
         by(rule heap_read_conf)
       
       from ST'' ST' have "P,h \<turnstile> stk' [:\<le>] ST'" ..
       moreover
       from v vT' have "P,h \<turnstile> v :\<le> vT'" by blast
       moreover
       from loc LT' have "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
       moreover
       note "h\<surd>" mC \<Phi>' pc' v fs tconf preh
       ultimately have "\<Phi> \<turnstile> t:(None, h, (v#stk',loc,C,M,pc+1)#frs) \<surd>" by fastforce }
     with a h i mC stk' xc
     show ?thesis by auto
   qed
 qed
 
 lemma Putfield_correct:
   assumes wf: "wf_prog wt P"
   assumes mC: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes i:  "ins!pc = Putfield F D"
   assumes wt: "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes cf: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes xc: "(tas, \<sigma>') \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma>' \<surd>"
 proof -
   from mC cf obtain ST LT where    
     "h\<surd>": "hconf h" and    
     tconf: "P,h \<turnstile> t \<surd>t" and
     \<Phi>: "\<Phi> C M ! pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     fs: "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh: "preallocated h"
     by (fastforce dest: sees_method_fun)
   
   from i \<Phi> wt obtain vT vT' oT ST'' ST' LT' fm where 
     ST: "ST = vT # oT # ST''" and
     field: "P \<turnstile> D sees F:vT' (fm) in D" and
     oT: "P \<turnstile> oT \<le> Class D" and vT: "P \<turnstile> vT \<le> vT'" and
     pc': "pc+1 < size ins" and 
     \<Phi>': "\<Phi> C M!(pc+1) = Some (ST',LT')" and
     ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'"
     by clarsimp
 
   from stk ST obtain v ref stk' where 
     stk': "stk = v#ref#stk'" and
     v:    "P,h \<turnstile> v :\<le> vT" and 
     ref:  "P,h \<turnstile> ref :\<le> oT" and
     ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
     by auto
 
   show ?thesis
   proof(cases "ref = Null")
     case True
     with tconf "h\<surd>" i xc stk' mC fs \<Phi> ST'' ref ST loc pc' v
       wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     from ref oT have "P,h \<turnstile> ref :\<le> Class D" ..
     with False obtain a U' D' where 
       a: "ref = Addr a" and h: "typeof_addr h a = Some U'"
       and U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
       by (blast dest: non_npD2)
     
     from v vT have vT': "P,h \<turnstile> v :\<le> vT'" ..
     
     from field D' have has_field: "P \<turnstile> D' has F:vT' (fm) in D"
       by (blast intro: has_field_mono has_visible_field)
     with h have al: "P,h \<turnstile> a@CField D F : vT'" unfolding U' ..
     let ?f' = "(stk',loc,C,M,pc+1)"
 
     { fix h'
       assume "write": "heap_write h a (CField D F) v h'"
       hence hext: "h \<unlhd> h'" by(rule hext_heap_write)
       with preh have "preallocated h'" by(rule preallocated_hext)
       moreover
       from "write" "h\<surd>" al vT' have "hconf h'" by(rule hconf_heap_write_mono)
       moreover
       from ST'' ST' have "P,h \<turnstile> stk' [:\<le>] ST'" ..
       from this hext have "P,h' \<turnstile> stk' [:\<le>] ST'" by (rule confs_hext)
       moreover
       from loc LT' have "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
       from this hext have "P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" by (rule confTs_hext)
       moreover
       from fs hext
       have "conf_fs P h' \<Phi> M (size Ts) T frs" by (rule conf_fs_hext)
       moreover
       note mC \<Phi>' pc' 
       moreover
       from tconf hext have "P,h' \<turnstile> t \<surd>t" by(rule tconf_hext_mono)
       ultimately have "\<Phi> \<turnstile> t:(None, h', ?f'#frs) \<surd>" by fastforce }
     with a h i mC stk' xc show ?thesis by(auto simp del: correct_state_def)
   qed
 qed
 
 lemma CAS_correct:
   assumes wf: "wf_prog wt P"
   assumes mC: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes i:  "ins!pc = CAS F D"
   assumes wt: "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes cf: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes xc: "(tas, \<sigma>') \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma>' \<surd>"
 proof -
   from mC cf obtain ST LT where    
     "h\<surd>": "hconf h" and    
     tconf: "P,h \<turnstile> t \<surd>t" and
     \<Phi>: "\<Phi> C M ! pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     fs: "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh: "preallocated h"
     by (fastforce dest: sees_method_fun)
   
   from i \<Phi> wt obtain T1 T2 T3 T' ST'' ST' LT' fm where 
     ST: "ST = T3 # T2 # T1 # ST''" and
     field: "P \<turnstile> D sees F:T' (fm) in D" and
     oT: "P \<turnstile> T1 \<le> Class D" and T2: "P \<turnstile> T2 \<le> T'" and T3: "P \<turnstile> T3 \<le> T'" and
     pc': "pc+1 < size ins" and 
     \<Phi>': "\<Phi> C M!(pc+1) = Some (Boolean # ST',LT')" and
     ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'"
     by clarsimp
 
   from stk ST obtain v'' v' v stk' where 
     stk': "stk = v''#v'#v#stk'" and
     v:    "P,h \<turnstile> v :\<le> T1" and 
     v':  "P,h \<turnstile> v' :\<le> T2" and
     v'': "P,h \<turnstile> v'' :\<le> T3" and
     ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
     by auto
 
   show ?thesis
   proof(cases "v = Null")
     case True
     with tconf "h\<surd>" i xc stk' mC fs \<Phi> ST'' v ST loc pc' v' v''
       wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     from v oT have "P,h \<turnstile> v :\<le> Class D" ..
     with False obtain a U' D' where 
       a: "v = Addr a" and h: "typeof_addr h a = Some U'"
       and U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
       by (blast dest: non_npD2)
     
     from v' T2 have vT': "P,h \<turnstile> v' :\<le> T'" ..
     from v'' T3 have vT'': "P,h \<turnstile> v'' :\<le> T'" ..
     
     from field D' have has_field: "P \<turnstile> D' has F:T' (fm) in D"
       by (blast intro: has_field_mono has_visible_field)
     with h have al: "P,h \<turnstile> a@CField D F : T'" unfolding U' ..
 
     from ST'' ST' have stk'': "P,h \<turnstile> stk' [:\<le>] ST'" ..
     from loc LT' have loc': "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
     { fix h'
       assume "write": "heap_write h a (CField D F) v'' h'"
       hence hext: "h \<unlhd> h'" by(rule hext_heap_write)
       with preh have "preallocated h'" by(rule preallocated_hext)
       moreover
       from "write" "h\<surd>" al vT'' have "hconf h'" by(rule hconf_heap_write_mono)
       moreover
       from stk'' hext have "P,h' \<turnstile> stk' [:\<le>] ST'" by (rule confs_hext)
       moreover
       from loc' hext have "P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" by (rule confTs_hext)
       moreover
       from fs hext
       have "conf_fs P h' \<Phi> M (size Ts) T frs" by (rule conf_fs_hext)
       moreover
       note mC \<Phi>' pc' 
       moreover
       let ?f' = "(Bool True # stk',loc,C,M,pc+1)"
       from tconf hext have "P,h' \<turnstile> t \<surd>t" by(rule tconf_hext_mono)
       ultimately have "\<Phi> \<turnstile> t:(None, h', ?f'#frs) \<surd>" by fastforce 
     } moreover {
       let ?f' = "(Bool False # stk',loc,C,M,pc+1)"
       have "\<Phi> \<turnstile> t:(None, h, ?f'#frs) \<surd>" using tconf "h\<surd>" preh mC \<Phi>' stk'' loc' pc' fs
         by fastforce
     } ultimately show ?thesis using a h i mC stk' xc by(auto simp del: correct_state_def)
   qed
 qed
 
 lemma New_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = New X"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from \<Phi>_pc ins wt
   obtain ST' LT' where
     is_class_X: "is_class P X" and
     mxs:       "size ST < mxs" and
     suc_pc:     "pc+1 < size ins" and
     \<Phi>_suc:      "\<Phi> C M!(pc+1) = Some (ST', LT')" and
     less:       "P \<turnstile> (Class X # ST, LT) \<le>\<^sub>i (ST', LT')"
     by auto
   show ?thesis
   proof(cases "allocate h (Class_type X) = {}")
     case True
     with frame frames tconf suc_pc no_x ins meth \<Phi>_pc
       wf_preallocatedD[OF wf, of h OutOfMemory] preh is_class_X heap_ok
     show ?thesis
       by(fastforce intro: tconf_hext_mono confs_hext confTs_hext conf_fs_hext)
   next
     case False
     with ins meth no_x obtain h' oref 
       where new: "(h', oref) \<in> allocate h (Class_type X)"
       and \<sigma>': "\<sigma> = (None, h', (Addr oref#stk,loc,C,M,pc+1)#frs)" (is "\<sigma> = (None, h', ?f # frs)")
       by auto
 
     from new have hext: "h \<unlhd> h'" by(rule hext_allocate)
     with preh have preh': "preallocated h'" by(rule preallocated_hext)
     from new heap_ok is_class_X have heap_ok': "hconf h'"
       by(auto intro: hconf_allocate_mono)
 
     with new is_class_X have h': "typeof_addr h' oref = \<lfloor>Class_type X\<rfloor>" by(auto dest: allocate_SomeD)
   
     note heap_ok' \<sigma>'
     moreover
     from frame less suc_pc wf h' hext
     have "conf_f P h' (ST', LT') ins ?f"
       apply (clarsimp simp add: fun_upd_apply conf_def split_beta)
       apply (auto intro: confs_hext confTs_hext)
       done
     moreover
     from frames hext have "conf_fs P h' \<Phi> M (size Ts) T frs" by (rule conf_fs_hext)
     moreover from tconf hext have "P,h' \<turnstile> t \<surd>t" by(rule tconf_hext_mono)
     ultimately
     show ?thesis using meth \<Phi>_suc preh' by fastforce
   qed
 qed
 
 lemma Goto_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = Goto branch; 
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>; 
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>' \<surd>"
 apply clarsimp 
 apply (drule (1) sees_method_fun)
 apply fastforce
 done
 
 declare [[simproc del: list_to_set_comprehension]]
 
 lemma IfFalse_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = IfFalse branch; 
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 apply clarsimp
 apply (drule (1) sees_method_fun)
 apply fastforce
 done
 
 declare [[simproc add: list_to_set_comprehension]]
 
 lemma BinOp_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = BinOpInstr bop;
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 apply clarsimp
 apply (drule (1) sees_method_fun)
 apply(clarsimp simp add: conf_def)
 apply(drule (2) WTrt_binop_widen_mono)
 apply clarsimp
 apply(frule (2) binop_progress)
 apply(clarsimp split: sum.split_asm)
  apply(frule (5) binop_type)
  apply(fastforce intro: widen_trans simp add: conf_def)
 apply(frule (5) binop_type)
 apply(clarsimp simp add: conf_def)
 apply(clarsimp simp add: widen_Class)
 apply(fastforce intro: widen_trans dest: binop_relevant_class simp add: cname_of_def conf_def)
 done
 
 lemma Pop_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = Pop;
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 apply clarsimp
 apply (drule (1) sees_method_fun)
 apply fastforce
 done
 
 lemma Dup_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = Dup;
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 apply clarsimp
 apply (drule (1) sees_method_fun)
 apply fastforce
 done
 
 lemma Swap_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = Swap;
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs) \<rbrakk>
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 apply clarsimp
 apply (drule (1) sees_method_fun)
 apply fastforce
 done
 
 declare [[simproc del: list_to_set_comprehension]]
 
 lemma Throw_correct:
 "\<lbrakk> wf_prog wt P; 
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C; 
   ins ! pc = ThrowExc; 
   P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M; 
   \<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>;
   (tas, \<sigma>') \<in> exec_instr (ins!pc) P t h stk loc C M pc frs \<rbrakk> 
 \<Longrightarrow> \<Phi> \<turnstile> t:\<sigma>'\<surd>"
 using wf_preallocatedD[of wt P h NullPointer]
 apply(clarsimp)
 apply(drule (1) sees_method_fun)
 apply(auto)
   apply fastforce
  apply fastforce
 apply(drule (1) non_npD)
 apply fastforce+
 done
 
 declare [[simproc add: list_to_set_comprehension]]
 
 lemma NewArray_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = NewArray X"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t:(None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf: "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins \<Phi>_pc wt obtain ST'' X' ST' LT' where 
     ST: "ST = Integer # ST''" and
     pc': "pc+1 < size ins"  and
     \<Phi>': "\<Phi> C M ! (pc+1) = Some (X'#ST', LT')" and
     ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
     XX': "P \<turnstile> X\<lfloor>\<rceil> \<le> X'" and
     suc_pc:     "pc+1 < size ins" and
     is_type_X: "is_type P (X\<lfloor>\<rceil>)"
     by(fastforce dest: Array_widen)
 
   from stk ST obtain si stk' where si: "stk = Intg si # stk'"
     by(auto simp add: conf_def)
 
   show ?thesis
   proof(cases "si <s 0 \<or> allocate h (Array_type X (nat (sint si))) = {}")
     case True
     with frame frames tconf heap_ok suc_pc no_x ins meth \<Phi>_pc si preh
       wf_preallocatedD[OF wf, of h OutOfMemory] wf_preallocatedD[OF wf, of h NegativeArraySize]
     show ?thesis
       by(fastforce intro: tconf_hext_mono confs_hext confTs_hext conf_fs_hext split: if_split_asm)+
   next
     case False
     with ins meth si no_x obtain h' oref 
       where new: "(h', oref) \<in> allocate h (Array_type X (nat (sint si)))"
       and \<sigma>': "\<sigma> = (None, h', (Addr oref#tl stk,loc,C,M,pc+1)#frs)" (is "\<sigma> = (None, h', ?f # frs)")
       by(auto split: if_split_asm)
     from new have hext: "h \<unlhd> h'" by(rule hext_allocate)
     with preh have preh': "preallocated h'" by(rule preallocated_hext)
     from new heap_ok is_type_X have heap_ok': "hconf h'" by(auto intro: hconf_allocate_mono)
     from False have si': "0 <=s si" by auto
     with new is_type_X have h': "typeof_addr h' oref = \<lfloor>Array_type X (nat (sint si))\<rfloor>" 
       by(auto dest: allocate_SomeD)
 
     note \<sigma>' heap_ok'
     moreover
     from frame ST' ST LT' suc_pc wf XX' h' hext
     have "conf_f P h' (X' # ST', LT') ins ?f"
       by(clarsimp simp add: fun_upd_apply conf_def split_beta)(auto intro: confs_hext confTs_hext)
     moreover
     from frames hext have "conf_fs P h' \<Phi> M (size Ts) T frs" by (rule conf_fs_hext)
     moreover from tconf hext have "P,h' \<turnstile> t \<surd>t" by(rule tconf_hext_mono)
     ultimately
     show ?thesis using meth \<Phi>' preh' by fastforce
   qed 
 qed
 
 lemma ALoad_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = ALoad"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t:\<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins wt \<Phi>_pc have lST: "length ST > 1" by(auto)
 
   show ?thesis
   proof(cases "hd (tl stk) = Null")
     case True
     with ins no_x heap_ok tconf \<Phi>_pc stk loc frame frames meth wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     note stkNN = this
     have STNN: "hd (tl ST) \<noteq> NT"
     proof
       assume "hd (tl ST) = NT"
       moreover 
       from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with lST have "P,h \<turnstile> hd (tl stk) :\<le> hd (tl ST)"
         by (cases ST, auto, case_tac list, auto)
       ultimately 
       have "hd (tl stk) = Null" by simp
       with stkNN show False by contradiction
     qed
 
     with stkNN ins \<Phi>_pc wt obtain ST'' X X' ST' LT' where 
       ST: "ST = Integer # X\<lfloor>\<rceil> # ST''" and
       pc': "pc+1 < size ins"  and
       \<Phi>': "\<Phi> C M ! (pc+1) = Some (X'#ST', LT')" and
       ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
       XX': "P \<turnstile> X \<le> X'" and
       suc_pc:     "pc+1 < size ins"
       by(fastforce)
 
     from stk ST obtain ref idx stk' where 
       stk': "stk = idx#ref#stk'" and
       idx: "P,h \<turnstile> idx :\<le> Integer" and
       ref:  "P,h \<turnstile> ref :\<le> X\<lfloor>\<rceil>" and
       ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
       by auto
 
     from stkNN stk' have "ref \<noteq> Null" by(simp)
     with ref obtain a Xel n
       where a: "ref = Addr a"
       and ha: "typeof_addr h a = \<lfloor>Array_type Xel n\<rfloor>"
       and Xel: "P \<turnstile> Xel \<le> X"
       by(cases ref)(fastforce simp add: conf_def widen_Array)+
 
     from idx obtain idxI where idxI: "idx = Intg idxI"
       by(auto simp add: conf_def)
     show ?thesis
     proof(cases "0 <=s idxI \<and> sint idxI < int n")
       case True
       hence si': "0 <=s idxI" "sint idxI < int n" by auto
       hence "nat (sint idxI) < n"
-        by(metis nat_less_iff  sint_0 word_sle_def)
+        by (simp add: word_sle_eq nat_less_iff)
       with ha have al: "P,h \<turnstile> a@ACell (nat (sint idxI)) : Xel" ..
 
       { fix v
         assume read: "heap_read h a (ACell (nat (sint idxI))) v"
         hence v: "P,h \<turnstile> v :\<le> Xel" using al heap_ok by(rule heap_read_conf)
 
         let ?f = "(v # stk', loc, C, M, pc + 1)"
         
         from frame ST' ST LT' suc_pc wf XX' Xel idxI si' v ST''
         have "conf_f P h (X' # ST', LT') ins ?f"
           by(auto intro: widen_trans simp add: conf_def)
         hence "\<Phi> \<turnstile> t:(None, h, ?f # frs) \<surd>"
           using meth \<Phi>' heap_ok \<Phi>_pc frames tconf preh by fastforce }
       with ins meth si' stk' a ha no_x idxI idx 
       show ?thesis by(auto simp del: correct_state_def split: if_split_asm)
     next
       case False
       with stk' idxI ins no_x heap_ok tconf meth a ha Xel \<Phi>_pc frame frames
         wf_preallocatedD[OF wf, of h ArrayIndexOutOfBounds] preh
       show ?thesis by(fastforce split: if_split_asm)
     qed
   qed
 qed
 
 
 lemma AStore_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = AStore"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t: \<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf: "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins wt \<Phi>_pc have lST: "length ST > 2" by(auto)
   
   show ?thesis
   proof(cases "hd (tl (tl stk)) = Null")
     case True
     with ins no_x heap_ok tconf \<Phi>_pc stk loc frame frames meth wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     note stkNN = this
     have STNN: "hd (tl (tl ST)) \<noteq> NT"       
     proof
       assume "hd (tl (tl ST)) = NT"
       moreover 
       from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with lST have "P,h \<turnstile> hd (tl (tl stk)) :\<le> hd (tl (tl ST))"
         by (cases ST, auto, case_tac list, auto, case_tac lista, auto)
       ultimately 
       have "hd (tl (tl stk)) = Null" by simp
       with stkNN show False by contradiction
     qed
 
     with ins stkNN \<Phi>_pc wt obtain ST'' Y X ST' LT' where 
       ST: "ST = Y # Integer # X\<lfloor>\<rceil> # ST''" and
       pc': "pc+1 < size ins"  and
       \<Phi>': "\<Phi> C M ! (pc+1) = Some (ST', LT')" and
       ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
       suc_pc:     "pc+1 < size ins"
       by(fastforce)
 
     from stk ST obtain ref e idx stk' where 
       stk': "stk = e#idx#ref#stk'" and
       idx: "P,h \<turnstile> idx :\<le> Integer" and
       ref:  "P,h \<turnstile> ref :\<le> X\<lfloor>\<rceil>" and
       e: "P,h \<turnstile> e :\<le> Y" and
       ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
       by auto
 
     from stkNN stk' have "ref \<noteq> Null" by(simp)
     with ref obtain a Xel n
       where a: "ref = Addr a"
       and ha: "typeof_addr h a = \<lfloor>Array_type Xel n\<rfloor>"
       and Xel: "P \<turnstile> Xel \<le> X"
       by(cases ref)(fastforce simp add: conf_def widen_Array)+
 
     from idx obtain idxI where idxI: "idx = Intg idxI"
       by(auto simp add: conf_def)
     
     show ?thesis
     proof(cases "0 <=s idxI \<and> sint idxI < int n")
       case True
       hence si': "0 <=s idxI" "sint idxI < int n" by simp_all
 
       from e obtain Te where Te: "typeof\<^bsub>h\<^esub> e = \<lfloor>Te\<rfloor>" "P \<turnstile> Te \<le> Y"
         by(auto simp add: conf_def)
 
       show ?thesis
       proof(cases "P \<turnstile> Te \<le> Xel")
         case True
         with Te have eXel: "P,h \<turnstile> e :\<le> Xel"
           by(auto simp add: conf_def intro: widen_trans)
 
         { fix h'
           assume "write": "heap_write h a (ACell (nat (sint idxI))) e h'"
           hence hext: "h \<unlhd> h'" by(rule hext_heap_write)
           with preh have preh': "preallocated h'" by(rule preallocated_hext)
 
           let ?f = "(stk', loc, C, M, pc + 1)"
 
           from si' have "nat (sint idxI) < n"
-            by(metis nat_less_iff  sint_0 word_sle_def)
+            by (simp add: word_sle_eq nat_less_iff)
           with ha have "P,h \<turnstile> a@ACell (nat (sint idxI)) : Xel" ..
           with "write" heap_ok have heap_ok': "hconf h'" using eXel
             by(rule hconf_heap_write_mono)
           moreover
           from ST stk stk' ST' have "P,h \<turnstile> stk' [:\<le>] ST'" by auto
           with hext have stk'': "P,h' \<turnstile> stk' [:\<le>] ST'"
             by- (rule confs_hext)
           moreover
           from loc LT' have "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
           with hext have "P,h' \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" by - (rule confTs_hext)
           moreover
           with frame ST' ST LT' suc_pc wf Xel idxI si' stk''
           have "conf_f P h' (ST', LT') ins ?f"
             by(clarsimp)
           with frames hext have "conf_fs P h' \<Phi> M (size Ts) T frs" by- (rule conf_fs_hext)
           moreover from tconf hext have "P,h' \<turnstile> t \<surd>t" by(rule tconf_hext_mono)
           ultimately have "\<Phi> \<turnstile> t:(None, h', ?f # frs) \<surd>" using meth \<Phi>' \<Phi>_pc suc_pc preh'
             by(fastforce) }
         with True si' ins meth stk' a ha no_x idxI idx Te
         show ?thesis
           by(auto split: if_split_asm simp del: correct_state_def intro: widen_trans)
       next
         case False
         with stk' idxI ins no_x heap_ok tconf meth a ha Xel Te \<Phi>_pc frame frames si' preh
           wf_preallocatedD[OF wf, of h ArrayStore]
         show ?thesis by(fastforce split: if_split_asm)
       qed
     next
       case False
       with stk' idxI ins no_x heap_ok tconf meth a ha Xel \<Phi>_pc frame frames preh
         wf_preallocatedD[OF wf, of h ArrayIndexOutOfBounds]
       show ?thesis by(fastforce split: if_split_asm)
     qed
   qed
 qed
 
 lemma ALength_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = ALength"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t: \<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins wt \<Phi>_pc have lST: "length ST > 0" by(auto)
   
   show ?thesis
   proof(cases "hd stk = Null")
     case True
     with ins no_x heap_ok tconf \<Phi>_pc stk loc frame frames meth wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     note stkNN = this
     have STNN: "hd ST \<noteq> NT"
     proof
       assume "hd ST = NT"
       moreover 
       from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with lST have "P,h \<turnstile> hd stk :\<le> hd ST"
         by (cases ST, auto)
       ultimately 
       have "hd stk = Null" by simp
       with stkNN show False by contradiction
     qed
 
     with stkNN ins \<Phi>_pc wt obtain ST'' X ST' LT' where 
       ST: "ST = (X\<lfloor>\<rceil>) # ST''" and
       pc': "pc+1 < size ins"  and
       \<Phi>': "\<Phi> C M ! (pc+1) = Some (ST', LT')" and
       ST': "P \<turnstile> (Integer # ST'') [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
       suc_pc:     "pc+1 < size ins"
       by(fastforce)
 
     from stk ST obtain ref stk' where 
       stk': "stk = ref#stk'" and
       ref:  "P,h \<turnstile> ref :\<le> X\<lfloor>\<rceil>" and
       ST'': "P,h \<turnstile> stk' [:\<le>] ST''"
       by auto
 
     from stkNN stk' have "ref \<noteq> Null" by(simp)
     with ref obtain a Xel n
       where a: "ref = Addr a"
       and ha: "typeof_addr h a = \<lfloor>Array_type Xel n\<rfloor>"
       and Xel: "P \<turnstile> Xel \<le> X"
       by(cases ref)(fastforce simp add: conf_def widen_Array)+
 
     from ins meth stk' a ha no_x have \<sigma>':
       "\<sigma> = (None, h, (Intg (word_of_int (int n)) # stk', loc, C, M, pc + 1) # frs)"
       (is "\<sigma> = (None, h, ?f # frs)")
       by(auto)
     moreover
     from ST stk stk' ST' have "P,h \<turnstile> Intg si # stk' [:\<le>] ST'" by(auto)
     with frame ST' ST LT' suc_pc wf
     have "conf_f P h (ST', LT') ins ?f"
       by(fastforce intro: widen_trans)
     ultimately show ?thesis using meth \<Phi>' heap_ok \<Phi>_pc frames tconf preh by fastforce
   qed
 qed
 
 
 lemma MEnter_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = MEnter"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t: \<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins wt \<Phi>_pc have lST: "length ST > 0" by(auto)
 
   show ?thesis
   proof(cases "hd stk = Null")
     case True
     with ins no_x heap_ok tconf \<Phi>_pc stk loc frame frames meth wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     note stkNN = this
     have STNN: "hd ST \<noteq> NT"
     proof
       assume "hd ST = NT"
       moreover 
       from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with lST have "P,h \<turnstile> hd stk :\<le> hd ST"
         by (cases ST, auto)
       ultimately 
       have "hd stk = Null" by simp
       with stkNN show False by contradiction
     qed
 
     with stkNN ins \<Phi>_pc wt obtain ST'' X ST' LT' where 
       ST: "ST = X # ST''" and
       refT: "is_refT X" and
       pc': "pc+1 < size ins"  and
       \<Phi>': "\<Phi> C M ! (pc+1) = Some (ST', LT')" and
       ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
       suc_pc:     "pc+1 < size ins"
       by(fastforce)
 
     from stk ST obtain ref stk' where 
       stk': "stk = ref#stk'" and
       ref:  "P,h \<turnstile> ref :\<le> X"
       by auto
 
     from stkNN stk' have "ref \<noteq> Null" by(simp)
     moreover
     from loc LT' have "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
     moreover
     from ST stk stk' ST'
     have "P,h \<turnstile> stk' [:\<le>] ST'" by(auto)
     ultimately show ?thesis using meth \<Phi>' heap_ok \<Phi>_pc suc_pc frames loc LT' no_x ins stk' ST' tconf preh
       by(fastforce)
   qed
 qed
 
 lemma MExit_correct:
   assumes wf:   "wf_prog wt P"
   assumes meth: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C"
   assumes ins:  "ins!pc = MExit"
   assumes wt:   "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M"
   assumes conf: "\<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd>"
   assumes no_x: "(tas, \<sigma>) \<in> exec_instr (ins!pc) P t h stk loc C M pc frs"
   shows "\<Phi> \<turnstile> t: \<sigma> \<surd>"
 proof - 
   from ins conf meth
   obtain ST LT where
     heap_ok: "hconf h" and
     tconf:   "P,h \<turnstile> t \<surd>t" and
     \<Phi>_pc:    "\<Phi> C M!pc = Some (ST,LT)" and
     stk: "P,h \<turnstile> stk [:\<le>] ST" and loc: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT" and
     pc: "pc < size ins" and 
     frame:   "conf_f P h (ST,LT) ins (stk,loc,C,M,pc)" and
     frames:  "conf_fs P h \<Phi> M (size Ts) T frs" and
     preh:    "preallocated h"
     by (auto dest: sees_method_fun)
 
   from ins wt \<Phi>_pc have lST: "length ST > 0" by(auto)
 
   show ?thesis
   proof(cases "hd stk = Null")
     case True
     with ins no_x heap_ok tconf \<Phi>_pc stk loc frame frames meth wf_preallocatedD[OF wf, of h NullPointer] preh
     show ?thesis by(fastforce)
   next
     case False
     note stkNN = this
     have STNN: "hd ST \<noteq> NT"
     proof
       assume "hd ST = NT"
       moreover 
       from frame have "P,h \<turnstile> stk [:\<le>] ST" by simp
       with lST have "P,h \<turnstile> hd stk :\<le> hd ST"
         by (cases ST, auto)
       ultimately 
       have "hd stk = Null" by simp
       with stkNN show False by contradiction
     qed
 
     with stkNN ins \<Phi>_pc wt obtain ST'' X ST' LT' where 
       ST: "ST = X # ST''" and
       refT: "is_refT X" and
       pc': "pc+1 < size ins"  and
       \<Phi>': "\<Phi> C M ! (pc+1) = Some (ST', LT')" and
       ST': "P \<turnstile> ST'' [\<le>] ST'" and LT': "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" and
       suc_pc:     "pc+1 < size ins"
       by(fastforce)
 
     from stk ST obtain ref stk' where 
       stk': "stk = ref#stk'" and
       ref:  "P,h \<turnstile> ref :\<le> X"
       by auto
 
     from stkNN stk' have "ref \<noteq> Null" by(simp)
     moreover
     from loc LT' have "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT'" ..
     moreover
     from ST stk stk' ST'
     have "P,h \<turnstile> stk' [:\<le>] ST'" by(auto)
     ultimately 
     show ?thesis using meth \<Phi>' heap_ok \<Phi>_pc suc_pc frames loc LT' no_x ins stk' ST' tconf frame preh
       wf_preallocatedD[OF wf, of h IllegalMonitorState]
       by(fastforce)
   qed
 qed
 
 text \<open>
   The next theorem collects the results of the sections above,
   i.e.~exception handling and the execution step for each 
   instruction. It states type safety for single step execution:
   in welltyped programs, a conforming state is transformed
   into another conforming state when one instruction is executed.
 \<close>
 theorem instr_correct:
 "\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P;
   P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(mxs,mxl\<^sub>0,ins,xt)\<rfloor> in C;
   (tas, \<sigma>') \<in> exec P t (None, h, (stk,loc,C,M,pc)#frs); 
   \<Phi> \<turnstile> t: (None, h, (stk,loc,C,M,pc)#frs)\<surd> \<rbrakk> 
 \<Longrightarrow> \<Phi> \<turnstile> t: \<sigma>'\<surd>"
 apply (subgoal_tac "P,T,mxs,size ins,xt \<turnstile> ins!pc,pc :: \<Phi> C M")
  prefer 2
  apply (erule wt_jvm_prog_impl_wt_instr, assumption)
  apply clarsimp
  apply (drule (1) sees_method_fun)
  apply simp
 apply(unfold exec.simps Let_def set_map)
 apply (frule wt_jvm_progD, erule exE)
 apply (cases "ins ! pc")
 apply (rule Load_correct, assumption+, fastforce)
 apply (rule Store_correct, assumption+, fastforce)
 apply (rule Push_correct, assumption+, fastforce)
 apply (rule New_correct, assumption+, fastforce)
 apply (rule NewArray_correct, assumption+, fastforce)
 apply (rule ALoad_correct, assumption+, fastforce)
 apply (rule AStore_correct, assumption+, fastforce)
 apply (rule ALength_correct, assumption+, fastforce)
 apply (rule Getfield_correct, assumption+, fastforce)
 apply (rule Putfield_correct, assumption+, fastforce)
 apply (rule CAS_correct, assumption+, fastforce)
 apply (rule Checkcast_correct, assumption+, fastforce)
 apply (rule Instanceof_correct, assumption+, fastforce)
 apply (rule Invoke_correct, assumption+, fastforce)
 apply (rule Return_correct, assumption+, fastforce simp add: split_beta)
 apply (rule Pop_correct, assumption+, fastforce)
 apply (rule Dup_correct, assumption+, fastforce)
 apply (rule Swap_correct, assumption+, fastforce)
 apply (rule BinOp_correct, assumption+, fastforce)
 apply (rule Goto_correct, assumption+, fastforce)
 apply (rule IfFalse_correct, assumption+, fastforce)
 apply (rule Throw_correct, assumption+, fastforce)
 apply (rule MEnter_correct, assumption+, fastforce)
 apply (rule MExit_correct, assumption+, fastforce)
 done
 
 declare defs1 [simp del]
 
 end
 
 subsection \<open>Main\<close>
 
 lemma (in JVM_conf_read) BV_correct_1 [rule_format]:
 "\<And>\<sigma>. \<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P; \<Phi> \<turnstile> t: \<sigma>\<surd>\<rbrakk> \<Longrightarrow> P,t \<turnstile> \<sigma> -tas-jvm\<rightarrow> \<sigma>' \<longrightarrow> \<Phi> \<turnstile> t: \<sigma>'\<surd>"
 apply (simp only: split_tupled_all exec_1_iff)
 apply (rename_tac xp h frs)
 apply (case_tac xp)
  apply (case_tac frs)
   apply simp
  apply (simp only: split_tupled_all)
  apply hypsubst
  apply (frule correct_state_impl_Some_method)
  apply clarify
  apply (rule instr_correct)
  apply assumption+
 apply clarify
 apply(case_tac frs)
  apply simp
 apply(clarsimp simp only: exec.simps set_simps)
 apply(erule (1) exception_step_conform)
 done
 
 theorem (in JVM_progress) progress:
   assumes wt: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and cs: "\<Phi> \<turnstile> t: (xcp, h, f # frs)\<surd>"
   shows "\<exists>ta \<sigma>'. P,t \<turnstile> (xcp, h, f # frs) -ta-jvm\<rightarrow> \<sigma>'"
 proof -
   obtain stk loc C M pc where f: "f = (stk, loc, C, M, pc)" by(cases f)
   with cs obtain Ts T mxs mxl\<^sub>0 "is" xt ST LT
     where hconf: "hconf h"
     and sees: "P \<turnstile> C sees M: Ts\<rightarrow>T = \<lfloor>(mxs, mxl\<^sub>0, is, xt)\<rfloor> in C"
     and \<Phi>_pc: "\<Phi> C M ! pc = \<lfloor>(ST, LT)\<rfloor>"
     and ST: "P,h \<turnstile> stk [:\<le>] ST"
     and LT: "P,h \<turnstile> loc [:\<le>\<^sub>\<top>] LT"
     and pc: "pc < length is"
     by(auto simp add: defs1)
   show ?thesis
   proof(cases xcp)
     case Some thus ?thesis
       unfolding f exec_1_iff by auto
   next
     case [simp]: None
     note [simp del] = split_paired_Ex
     note [simp] = defs1 list_all2_Cons2
 
 
     from wt obtain wf_md where wf: "wf_prog wf_md P" by(auto dest: wt_jvm_progD)
     from wt sees pc have wt: "P,T,mxs,size is,xt \<turnstile> is!pc,pc :: \<Phi> C M"
       by(rule wt_jvm_prog_impl_wt_instr)
 
 
     have "\<exists>ta \<sigma>'. (ta, \<sigma>') \<in> exec_instr (is ! pc) P t h stk loc C M pc frs"
     proof(cases "is ! pc")
       case [simp]: ALoad
       with wt \<Phi>_pc have lST: "length ST > 1" by(auto)
       show ?thesis
       proof(cases "hd (tl stk) = Null")
         case True thus ?thesis by simp
       next
         case False
         have STNN: "hd (tl ST) \<noteq> NT"
         proof
           assume "hd (tl ST) = NT"
           moreover 
           from ST lST have "P,h \<turnstile> hd (tl stk) :\<le> hd (tl ST)"
             by (cases ST)(auto, case_tac list, auto)
           ultimately have "hd (tl stk) = Null" by simp
           with False show False by contradiction
         qed
         
         with False \<Phi>_pc wt obtain ST'' X where "ST = Integer # X\<lfloor>\<rceil> # ST''" by auto
         with ST obtain ref idx stk' where stk': "stk = idx#ref#stk'" and idx: "P,h \<turnstile> idx :\<le> Integer" 
           and ref:  "P,h \<turnstile> ref :\<le> X\<lfloor>\<rceil>" by(auto)
 
         from False stk' have "ref \<noteq> Null" by(simp)
         with ref obtain a Xel n where a: "ref = Addr a"
           and ha: "typeof_addr h a = \<lfloor>Array_type Xel n\<rfloor>"
           and Xel: "P \<turnstile> Xel \<le> X"
           by(cases ref)(fastforce simp add: conf_def widen_Array)+
         
         from idx obtain idxI where idxI: "idx = Intg idxI"
           by(auto simp add: conf_def)
         show ?thesis
         proof(cases "0 <=s idxI \<and> sint idxI < int n")
           case True
           hence si': "0 <=s idxI" "sint idxI < int n" by auto
           hence "nat (sint idxI) < n"
-            by(metis nat_less_iff sint_0 word_sle_def)
+            by (simp add: word_sle_eq nat_less_iff)
           with ha have al: "P,h \<turnstile> a@ACell (nat (sint idxI)) : Xel" ..
           from heap_read_total[OF hconf this] True False ha stk' idxI a
           show ?thesis by auto
         next
           case False with ha stk' idxI a show ?thesis by auto
         qed
       qed
     next
       case [simp]: AStore
       from wt \<Phi>_pc have lST: "length ST > 2" by(auto)
       
       show ?thesis
       proof(cases "hd (tl (tl stk)) = Null")
         case True thus ?thesis by(fastforce)
       next
         case False
         note stkNN = this
         have STNN: "hd (tl (tl ST)) \<noteq> NT"       
         proof
           assume "hd (tl (tl ST)) = NT"
           moreover 
           from ST lST have "P,h \<turnstile> hd (tl (tl stk)) :\<le> hd (tl (tl ST))"
             by (cases ST, auto, case_tac list, auto, case_tac lista, auto)
           ultimately have "hd (tl (tl stk)) = Null" by simp
           with stkNN show False by contradiction
         qed
 
         with stkNN \<Phi>_pc wt obtain ST'' Y X
           where "ST = Y # Integer # X\<lfloor>\<rceil> # ST''" by(fastforce)
 
         with ST obtain ref e idx stk' where stk': "stk = e#idx#ref#stk'" 
           and idx: "P,h \<turnstile> idx :\<le> Integer" and ref:  "P,h \<turnstile> ref :\<le> X\<lfloor>\<rceil>" 
           and e: "P,h \<turnstile> e :\<le> Y" by auto
 
         from stkNN stk' have "ref \<noteq> Null" by(simp)
         with ref obtain a Xel n where a: "ref = Addr a"
           and ha: "typeof_addr h a = \<lfloor>Array_type Xel n\<rfloor>"
           and Xel: "P \<turnstile> Xel \<le> X"
           by(cases ref)(fastforce simp add: conf_def widen_Array)+
 
         from idx obtain idxI where idxI: "idx = Intg idxI"
           by(auto simp add: conf_def)
         
         show ?thesis
         proof(cases "0 <=s idxI \<and> sint idxI < int n")
           case True
           hence si': "0 <=s idxI" "sint idxI < int n" by simp_all
           hence "nat (sint idxI) < n"
-            by(metis nat_less_iff  sint_0 word_sle_def)
+            by (simp add: word_sle_eq nat_less_iff)
           with ha have adal: "P,h \<turnstile> a@ACell (nat (sint idxI)) : Xel" ..
           
           show ?thesis
           proof(cases "P \<turnstile> the (typeof\<^bsub>h\<^esub> e) \<le> Xel")
             case False
             with ha stk' idxI a show ?thesis by auto
           next
             case True
             hence "P,h \<turnstile> e :\<le> Xel" using e by(auto simp add: conf_def)
             from heap_write_total[OF hconf adal this] ha stk' idxI a show ?thesis by auto
           qed
         next
           case False with ha stk' idxI a show ?thesis by auto
         qed
       qed
     next
       case [simp]: (Getfield F D)
 
       from \<Phi>_pc wt obtain oT ST'' vT fm where oT: "P \<turnstile> oT \<le> Class D" 
         and "ST = oT # ST''" and F: "P \<turnstile> D sees F:vT (fm) in D" 
         by fastforce
 
       with ST obtain ref stk' where stk': "stk = ref#stk'" 
         and ref:  "P,h \<turnstile> ref :\<le> oT" by auto
 
       show ?thesis
       proof(cases "ref = Null")
         case True thus ?thesis using stk' by auto
       next
         case False
         from ref oT have "P,h \<turnstile> ref :\<le> Class D" ..
         with False obtain a U' D' where 
           a: "ref = Addr a" and h: "typeof_addr h a = Some U'"
           and U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
           by (blast dest: non_npD2)
     
         from D' F have has_field: "P \<turnstile> D' has F:vT (fm) in D"
           by (blast intro: has_field_mono has_visible_field)
         with h have "P,h \<turnstile> a@CField D F : vT" unfolding U' ..
         from heap_read_total[OF hconf this]
         show ?thesis using stk' a by auto
       qed
     next
       case [simp]: (Putfield F D)
 
       from \<Phi>_pc wt obtain vT vT' oT ST'' fm where "ST = vT # oT # ST''" 
         and field: "P \<turnstile> D sees F:vT' (fm) in D"
         and oT: "P \<turnstile> oT \<le> Class D"
         and vT': "P \<turnstile> vT \<le> vT'" by fastforce
       with ST obtain v ref stk' where stk': "stk = v#ref#stk'" 
         and ref:  "P,h \<turnstile> ref :\<le> oT" 
         and v: "P,h \<turnstile> v :\<le> vT" by auto
 
       show ?thesis
       proof(cases "ref = Null")
         case True with stk' show ?thesis by auto
       next
         case False
         from ref oT have "P,h \<turnstile> ref :\<le> Class D" ..
         with False obtain a U' D' where 
           a: "ref = Addr a" and h: "typeof_addr h a = Some U'" and
           U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
           by (blast dest: non_npD2)
 
         from field D' have has_field: "P \<turnstile> D' has F:vT' (fm) in D"
           by (blast intro: has_field_mono has_visible_field)
         with h have al: "P,h \<turnstile> a@CField D F : vT'" unfolding U' ..
         from v vT' have "P,h \<turnstile> v :\<le> vT'" by auto
         from heap_write_total[OF hconf al this] v a stk' h show ?thesis by auto
       qed
     next
       case [simp]: (CAS F D)
       from \<Phi>_pc wt obtain T' T1 T2 T3 ST'' fm where "ST = T3 # T2 # T1 # ST''" 
         and field: "P \<turnstile> D sees F:T' (fm) in D"
         and oT: "P \<turnstile> T1 \<le> Class D"
         and vT': "P \<turnstile> T2 \<le> T'" "P \<turnstile> T3 \<le> T'" by fastforce
       with ST obtain v v' v'' stk' where stk': "stk = v''#v'#v#stk'" 
         and v:  "P,h \<turnstile> v :\<le> T1" 
         and v': "P,h \<turnstile> v' :\<le> T2"
         and v'': "P,h \<turnstile> v'' :\<le> T3" by auto
       show ?thesis
       proof(cases "v= Null")
         case True with stk' show ?thesis by auto
       next
         case False
         from v oT have "P,h \<turnstile> v :\<le> Class D" ..
         with False obtain a U' D' where 
           a: "v = Addr a" and h: "typeof_addr h a = Some U'" and
           U': "D' = class_type_of U'" and D': "P \<turnstile> D' \<preceq>\<^sup>* D"
           by (blast dest: non_npD2)
 
         from field D' have has_field: "P \<turnstile> D' has F:T' (fm) in D"
           by (blast intro: has_field_mono has_visible_field)
         with h have al: "P,h \<turnstile> a@CField D F : T'" unfolding U' ..
         from v' vT' have "P,h \<turnstile> v' :\<le> T'" by auto
         from heap_read_total[OF hconf al] obtain v''' where v''': "heap_read h a (CField D F) v'''" by blast
         show ?thesis
         proof(cases "v''' = v'")
           case True
           from v'' vT' have "P,h \<turnstile> v'' :\<le> T'" by auto
           from heap_write_total[OF hconf al this] v a stk' h v''' True show ?thesis by auto
         next
           case False
           from v''' v a stk' h False show ?thesis by auto
         qed
       qed
     next
       case [simp]: (Invoke M' n)
 
       from wt \<Phi>_pc have n: "n < size ST" by simp
   
       show ?thesis
       proof(cases "stk!n = Null")
         case True thus ?thesis by simp
       next
         case False
         note Null = this
         have NT: "ST!n \<noteq> NT"
         proof
           assume "ST!n = NT"
           moreover from ST n have "P,h \<turnstile> stk!n :\<le> ST!n" by (simp add: list_all2_conv_all_nth)
           ultimately have "stk!n = Null" by simp
           with Null show False by contradiction
         qed
 
         from NT wt \<Phi>_pc obtain D D' Ts T m
           where D: "class_type_of' (ST!n) = Some D"
           and m_D: "P \<turnstile> D sees M': Ts\<rightarrow>T = m in D'"
           and Ts:  "P \<turnstile> rev (take n ST) [\<le>] Ts"
           by auto
 
         from n ST D have "P,h \<turnstile> stk!n :\<le> ST!n"
           by (auto simp add: list_all2_conv_all_nth)
 
         from \<open>P,h \<turnstile> stk!n :\<le> ST!n\<close> Null D
         obtain a T' where
           Addr:   "stk!n = Addr a" and
           obj:    "typeof_addr h a = Some T'" and
           T'subSTn: "P \<turnstile> ty_of_htype T' \<le> ST ! n"
           by(cases "stk ! n")(auto simp add: conf_def widen_Class)
 
         from D T'subSTn obtain C' where
           C': "class_type_of' (ty_of_htype T') = \<lfloor>C'\<rfloor>" and C'subD: "P \<turnstile> C' \<preceq>\<^sup>* D"
           by(rule widen_is_class_type_of) simp
 
         from Call_lemma[OF m_D C'subD wf]
         obtain D' Ts' T' m' 
           where Call': "P \<turnstile> C' sees M': Ts'\<rightarrow>T' = m' in D'" "P \<turnstile> Ts [\<le>] Ts'"
             "P \<turnstile> T' \<le> T" "P \<turnstile> C' \<preceq>\<^sup>* D'" "is_type P T'" "\<forall>T\<in>set Ts'. is_type P T"
           by blast
         
         show ?thesis
         proof(cases m')
           case Some with Call' C' obj Addr C' C'subD show ?thesis by(auto)
         next
           case [simp]: None
           from ST have "P,h \<turnstile> take n stk [:\<le>] take n ST" by(rule list_all2_takeI)
           then obtain Us where "map typeof\<^bsub>h\<^esub> (take n stk) = map Some Us" "P \<turnstile> Us [\<le>] take n ST"
             by(auto simp add: confs_conv_map)
           hence Us: "map typeof\<^bsub>h\<^esub> (rev (take n stk)) = map Some (rev Us)" "P \<turnstile> rev Us [\<le>] rev (take n ST)"
             by- (simp only: rev_map[symmetric], simp)
           with Ts \<open>P \<turnstile> Ts [\<le>] Ts'\<close> have "P \<turnstile> rev Us [\<le>] Ts'" by(blast intro: widens_trans)
           with obj Us Call' C' have "P,h \<turnstile> a\<bullet>M'(rev (take n stk)) : T'"
             by(auto intro!: external_WT'.intros)
           from external_call_progress[OF wf this hconf, of t] obj Addr Call' C'
           show ?thesis by(auto dest!: red_external_imp_red_external_aggr)
         qed
       qed
     qed(auto 4 4 simp add: split_beta split: if_split_asm)
     thus ?thesis using sees None
       unfolding f exec_1_iff by(simp del: split_paired_Ex)
   qed
 qed
 
 lemma (in JVM_heap_conf) BV_correct_initial:
   shows "\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P; start_heap_ok; P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>m\<rfloor> in D; P,start_heap \<turnstile> vs [:\<le>] Ts \<rbrakk>
   \<Longrightarrow> \<Phi> \<turnstile> start_tid:JVM_start_state' P C M vs \<surd>"
   apply (cases m)
   apply (unfold JVM_start_state'_def)
   apply (unfold correct_state_def)
   apply (clarsimp)
   apply (frule wt_jvm_progD)
   apply (erule exE)
   apply (frule wf_prog_wf_syscls)
   apply (rule conjI)
    apply(erule (1) tconf_start_heap_start_tid)
   apply(rule conjI)
    apply (simp add: wf_jvm_prog_phi_def hconf_start_heap) 
   apply(frule sees_method_idemp)
   apply (frule wt_jvm_prog_impl_wt_start, assumption+)
   apply (unfold conf_f_def wt_start_def)
   apply(auto simp add: sup_state_opt_any_Some)
    apply(erule preallocated_start_heap)
   apply(rule exI conjI|assumption)+
   apply(auto simp add: list_all2_append1)
   apply(auto dest: list_all2_lengthD intro!: exI)
   done
 
 end
diff --git a/thys/JinjaThreads/J/Deadlocked.thy b/thys/JinjaThreads/J/Deadlocked.thy
--- a/thys/JinjaThreads/J/Deadlocked.thy
+++ b/thys/JinjaThreads/J/Deadlocked.thy
@@ -1,462 +1,463 @@
 (*  Title:      JinjaThreads/J/Deadlocked.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>Preservation of Deadlock\<close>
 
 theory Deadlocked
 imports
   ProgressThreaded
 begin
 
 context J_progress begin
 
 lemma red_wt_hconf_hext:
   assumes wf: "wf_J_prog P"
   and hconf: "hconf H"
   and tconf: "P,H \<turnstile> t \<surd>t"
   shows "\<lbrakk> convert_extTA extNTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; P,E,H \<turnstile> e : T; hext H (hp s) \<rbrakk>
         \<Longrightarrow> \<exists>ta' e' s'. convert_extTA extNTA,P,t \<turnstile> \<langle>e, (H, lcl s)\<rangle> -ta'\<rightarrow> \<langle>e', s'\<rangle> \<and>
                        collect_locks \<lbrace>ta\<rbrace>\<^bsub>l\<^esub> = collect_locks \<lbrace>ta'\<rbrace>\<^bsub>l\<^esub> \<and> collect_cond_actions \<lbrace>ta\<rbrace>\<^bsub>c\<^esub> = collect_cond_actions \<lbrace>ta'\<rbrace>\<^bsub>c\<^esub> \<and>
                        collect_interrupts \<lbrace>ta\<rbrace>\<^bsub>i\<^esub> = collect_interrupts \<lbrace>ta'\<rbrace>\<^bsub>i\<^esub>"
   and "\<lbrakk> convert_extTA extNTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; P,E,H \<turnstile> es [:] Ts; hext H (hp s) \<rbrakk>
         \<Longrightarrow> \<exists>ta' es' s'. convert_extTA extNTA,P,t \<turnstile> \<langle>es, (H, lcl s)\<rangle> [-ta'\<rightarrow>] \<langle>es', s'\<rangle> \<and> 
                         collect_locks \<lbrace>ta\<rbrace>\<^bsub>l\<^esub> = collect_locks \<lbrace>ta'\<rbrace>\<^bsub>l\<^esub> \<and> collect_cond_actions \<lbrace>ta\<rbrace>\<^bsub>c\<^esub> = collect_cond_actions \<lbrace>ta'\<rbrace>\<^bsub>c\<^esub> \<and>
                         collect_interrupts \<lbrace>ta\<rbrace>\<^bsub>i\<^esub> = collect_interrupts \<lbrace>ta'\<rbrace>\<^bsub>i\<^esub>"
 proof(induct arbitrary: E T and E Ts rule: red_reds.inducts)
   case (RedNew h' a h C l)
   thus ?case
     by(cases "allocate H (Class_type C) = {}")(fastforce simp add: ta_upd_simps intro: RedNewFail red_reds.RedNew)+
 next
   case (RedNewFail h C l)
   thus ?case
     by(cases "allocate H (Class_type C) = {}")(fastforce simp add: ta_upd_simps intro: red_reds.RedNewFail RedNew)+
 next 
   case NewArrayRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedNewArray i h' a h T l E T')
   thus ?case
     by(cases "allocate H (Array_type T (nat (sint i))) = {}")(fastforce simp add: ta_upd_simps intro: red_reds.RedNewArray RedNewArrayFail)+
 next
   case RedNewArrayNegative thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedNewArrayFail i h T l E T')
   thus ?case 
     by(cases "allocate H (Array_type T (nat (sint i))) = {}")(fastforce simp add: ta_upd_simps intro: RedNewArray red_reds.RedNewArrayFail)+
 next
   case CastRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedCast s v U T E T')
   from \<open>P,E,H \<turnstile> Cast T (Val v) : T'\<close> show ?case
   proof(rule WTrt_elim_cases)
     fix T''
     assume wt: "P,E,H \<turnstile> Val v : T''" "T' = T"
     thus ?thesis
       by(cases "P \<turnstile> T'' \<le> T")(fastforce intro: red_reds.RedCast red_reds.RedCastFail)+
   qed
 next 
   case (RedCastFail s v U T E T')
   from \<open>P,E,H \<turnstile> Cast T (Val v) : T'\<close> 
   obtain T'' where "P,E,H \<turnstile> Val v : T''" "T = T'" by auto
   thus ?case
     by(cases "P \<turnstile> T'' \<le> T")(fastforce intro: red_reds.RedCast red_reds.RedCastFail)+
 next
   case InstanceOfRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedInstanceOf thus ?case
     using [[hypsubst_thin = true]] 
     by auto((rule exI conjI red_reds.RedInstanceOf)+, auto)
 next
   case BinOpRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case BinOpRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedBinOp thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedBinOpFail thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedVar thus ?case by(fastforce intro: red_reds.intros)
 next
   case LAssRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedLAss thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAccRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAccRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedAAccNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedAAccBounds thus ?case
     by(fastforce intro: red_reds.RedAAccBounds dest: hext_arrD)
 next 
   case (RedAAcc h a T n i v l E T')
   from \<open>P,E,H \<turnstile> addr a\<lfloor>Val (Intg i)\<rceil> : T'\<close> 
   have wt: "P,E,H \<turnstile> addr a : T'\<lfloor>\<rceil>" by(auto)
   with \<open>H \<unlhd> hp (h, l)\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have Ha: "typeof_addr H a = \<lfloor>Array_type T n\<rfloor>" by(auto dest: hext_arrD)
   with \<open>0 <=s i\<close> \<open>sint i < int n\<close>
-  have "nat (sint i) < n" by(metis nat_less_iff sint_0 word_sle_def)
+  have "nat (sint i) < n"
+    by (simp add: word_sle_eq nat_less_iff)
   with Ha have "P,H \<turnstile> a@ACell (nat (sint i)) : T"
     by(auto intro: addr_loc_type.intros)
   from heap_read_total[OF hconf this]
   obtain v where "heap_read H a (ACell (nat (sint i))) v" by blast
   with Ha \<open>0 <=s i\<close> \<open>sint i < int n\<close> show ?case
     by(fastforce intro: red_reds.RedAAcc simp add: ta_upd_simps)
 next
   case AAssRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAssRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAssRed3 thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedAAssNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedAAssBounds thus ?case by(fastforce intro: red_reds.RedAAssBounds dest: hext_arrD)
 next
   case (RedAAssStore s a T n i w U E T')
   from \<open>P,E,H \<turnstile> addr a\<lfloor>Val (Intg i)\<rceil> := Val w : T'\<close> 
   obtain T'' T''' where wt: "P,E,H \<turnstile> addr a : T''\<lfloor>\<rceil>"
     and wtw: "P,E,H \<turnstile> Val w : T'''" by auto
   with \<open>H \<unlhd> hp s\<close> \<open>typeof_addr (hp s) a = \<lfloor>Array_type T n\<rfloor>\<close>
   have Ha: "typeof_addr H a = \<lfloor>Array_type T n\<rfloor>" by(auto dest: hext_arrD)
   from \<open>typeof\<^bsub>hp s\<^esub> w = \<lfloor>U\<rfloor>\<close> wtw \<open>H \<unlhd> hp s\<close> have "typeof\<^bsub>H\<^esub> w = \<lfloor>U\<rfloor>" 
     by(auto dest: type_of_hext_type_of)
   with Ha \<open>0 <=s i\<close> \<open>sint i < int n\<close> \<open>\<not> P \<turnstile> U \<le> T\<close> show ?case
     by(fastforce intro: red_reds.RedAAssStore)
 next
   case (RedAAss h a T n i w U h' l E T')
   from \<open>P,E,H \<turnstile> addr a\<lfloor>Val (Intg i)\<rceil> := Val w : T'\<close>
   obtain T'' T''' where wt: "P,E,H \<turnstile> addr a : T''\<lfloor>\<rceil>"
       and wtw: "P,E,H \<turnstile> Val w : T'''" by auto
   with \<open>H \<unlhd> hp (h, l)\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have Ha: "typeof_addr H a = \<lfloor>Array_type T n\<rfloor>" by(auto dest: hext_arrD)
   from \<open>typeof\<^bsub>h\<^esub> w = \<lfloor>U\<rfloor>\<close> wtw \<open>H \<unlhd> hp (h, l)\<close> have "typeof\<^bsub>H\<^esub> w = \<lfloor>U\<rfloor>" 
     by(auto dest: type_of_hext_type_of)
   moreover
   with \<open>P \<turnstile> U \<le> T\<close> have conf: "P,H \<turnstile> w :\<le> T"
     by(auto simp add: conf_def)
   from \<open>0 <=s i\<close> \<open>sint i < int n\<close>
   have "nat (sint i) < n"
-    by (metis nat_less_iff sint_0 word_sle_def)
+    by (simp add: word_sle_eq nat_less_iff)
   with Ha have "P,H \<turnstile> a@ACell (nat (sint i)) : T"
     by(auto intro: addr_loc_type.intros)
   from heap_write_total[OF hconf this conf]
   obtain H' where "heap_write H a (ACell (nat (sint i))) w H'" ..
   ultimately show ?case using \<open>0 <=s i\<close> \<open>sint i < int n\<close> Ha \<open>P \<turnstile> U \<le> T\<close>
     by(fastforce simp del: split_paired_Ex intro: red_reds.RedAAss)
 next
   case ALengthRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedALength h a T n l E T')
   from \<open>P,E,H \<turnstile> addr a\<bullet>length : T'\<close>
   obtain T'' where [simp]: "T' = Integer"
       and wta: "P,E,H \<turnstile> addr a : T''\<lfloor>\<rceil>" by(auto)
   then obtain n'' where "typeof_addr H a = \<lfloor>Array_type T'' n''\<rfloor>" by(auto)
   thus ?case by(fastforce intro: red_reds.RedALength)
 next
   case RedALengthNull show ?case by(fastforce intro: red_reds.RedALengthNull)
 next
   case FAccRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedFAcc h a D F v l E T)
   from \<open>P,E,H \<turnstile> addr a\<bullet>F{D} : T\<close> obtain U C' fm
     where wt: "P,E,H \<turnstile> addr a : U"
     and icto: "class_type_of' U = \<lfloor>C'\<rfloor>"
     and has: "P \<turnstile> C' has F:T (fm) in D"
     by(auto)
   then obtain hU where Ha: "typeof_addr H a = \<lfloor>hU\<rfloor>" "U = ty_of_htype hU" by(auto)
   with icto \<open>P \<turnstile> C' has F:T (fm) in D\<close> have "P,H \<turnstile> a@CField D F : T"
     by(auto intro: addr_loc_type.intros)
   from heap_read_total[OF hconf this]
   obtain v where "heap_read H a (CField D F) v" by blast
   thus ?case by(fastforce intro: red_reds.RedFAcc simp add: ta_upd_simps)
 next
   case RedFAccNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case FAssRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case FAssRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedFAssNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedFAss h a D F v h' l E T)
   from \<open>P,E,H \<turnstile> addr a\<bullet>F{D} := Val v : T\<close> obtain U C' T' T2 fm
     where wt: "P,E,H \<turnstile> addr a : U"
     and icto: "class_type_of' U = \<lfloor>C'\<rfloor>"
     and has: "P \<turnstile> C' has F:T' (fm) in D"
     and wtv: "P,E,H \<turnstile> Val v : T2"
     and T2T: "P \<turnstile> T2 \<le> T'" by(auto)
   moreover from wt obtain hU where Ha: "typeof_addr H a = \<lfloor>hU\<rfloor>" "U = ty_of_htype hU" by(auto)
   with icto has have adal: "P,H \<turnstile> a@CField D F : T'" by(auto intro: addr_loc_type.intros)
   from wtv T2T have "P,H \<turnstile> v :\<le> T'" by(auto simp add: conf_def)
   from heap_write_total[OF hconf adal this]
   obtain h' where "heap_write H a (CField D F) v h'" ..
   thus ?case by(fastforce intro: red_reds.RedFAss)
 next
   case CASRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASRed3 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedCASSucceed h a D F v v' h' l)
   note split_paired_Ex[simp del]
   from RedCASSucceed.prems(1) obtain T' fm T2 T3 U C where *:
     "T = Boolean" "class_type_of' U = \<lfloor>C\<rfloor>" "P \<turnstile> C has F:T' (fm) in D" 
     "volatile fm" "P \<turnstile> T2 \<le> T'" "P \<turnstile> T3 \<le> T'"
     "P,E,H \<turnstile> Val v : T2" "P,E,H \<turnstile> Val v' : T3" "P,E,H \<turnstile> addr a : U" by auto
   then have adal: "P,H \<turnstile> a@CField D F : T'" by(auto intro: addr_loc_type.intros)
   from heap_read_total[OF hconf this] obtain v'' where v': "heap_read H a (CField D F) v''" by blast
   show ?case
   proof(cases "v'' = v")
     case True
     from * have "P,H \<turnstile> v' :\<le> T'" by(auto simp add: conf_def)
     from heap_write_total[OF hconf adal this] True * v'
     show ?thesis by(fastforce intro: red_reds.RedCASSucceed)
   next
     case False
     then show ?thesis using * v' by(fastforce intro: RedCASFail)
   qed
 next
   case (RedCASFail h a D F v'' v v' l)
   note split_paired_Ex[simp del]
   from RedCASFail.prems(1) obtain T' fm T2 T3 U C where *:
     "T = Boolean" "class_type_of' U = \<lfloor>C\<rfloor>" "P \<turnstile> C has F:T' (fm) in D" 
     "volatile fm" "P \<turnstile> T2 \<le> T'" "P \<turnstile> T3 \<le> T'"
     "P,E,H \<turnstile> Val v : T2" "P,E,H \<turnstile> Val v' : T3" "P,E,H \<turnstile> addr a : U" by auto
   then have adal: "P,H \<turnstile> a@CField D F : T'" by(auto intro: addr_loc_type.intros)
   from heap_read_total[OF hconf this] obtain v''' where v'': "heap_read H a (CField D F) v'''" by blast
   show ?case
   proof(cases "v''' = v")
     case True
     from * have "P,H \<turnstile> v' :\<le> T'" by(auto simp add: conf_def)
     from heap_write_total[OF hconf adal this] True * v''
     show ?thesis by(fastforce intro: red_reds.RedCASSucceed)
   next
     case False
     then show ?thesis using * v'' by(fastforce intro: red_reds.RedCASFail)
   qed
 next
   case CallObj thus ?case by(fastforce intro: red_reds.intros)
 next
   case CallParams thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedCall s a U M Ts T pns body D vs E T')
   from \<open>P,E,H \<turnstile> addr a\<bullet>M(map Val vs) : T'\<close> 
   obtain U' C' Ts' meth D' Ts''
     where wta: "P,E,H \<turnstile> addr a : U'"
     and icto: "class_type_of' U' = \<lfloor>C'\<rfloor>"
     and sees: "P \<turnstile> C' sees M: Ts'\<rightarrow>T' = meth in D'"
     and wtes: "P,E,H \<turnstile> map Val vs [:] Ts''"
     and widens: "P \<turnstile> Ts'' [\<le>] Ts'" by auto
   from wta obtain hU' where Ha: "typeof_addr H a = \<lfloor>hU'\<rfloor>" "U' = ty_of_htype hU'" by(auto)
   moreover from \<open>typeof_addr (hp s) a = \<lfloor>U\<rfloor>\<close> \<open>H \<unlhd> hp s\<close> Ha
   have [simp]: "U = hU'" by(auto dest: typeof_addr_hext_mono)
   from wtes have "length vs = length Ts''"
     by(auto intro: map_eq_imp_length_eq)
   moreover from widens have "length Ts'' = length Ts'"
     by(auto dest: widens_lengthD)
   moreover from sees icto sees \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D\<close> Ha
   have [simp]: "meth = \<lfloor>(pns, body)\<rfloor>" by(auto dest: sees_method_fun)
   with sees wf have "wf_mdecl wf_J_mdecl P D' (M, Ts', T', \<lfloor>(pns, body)\<rfloor>)"
     by(auto intro: sees_wf_mdecl)
   hence "length pns = length Ts'" by(simp add: wf_mdecl_def)
   ultimately show ?case using sees icto 
     by(fastforce intro: red_reds.RedCall)
 next
   case (RedCallExternal s a U M Ts T' D vs ta va h' ta' e' s')
   from \<open>P,E,H \<turnstile> addr a\<bullet>M(map Val vs) : T\<close> 
   obtain U' C' Ts' meth D' Ts'' 
     where wta: "P,E,H \<turnstile> addr a : U'" and icto: "class_type_of' U' = \<lfloor>C'\<rfloor>"
     and sees: "P \<turnstile> C' sees M: Ts'\<rightarrow>T = meth in D'"
     and wtvs: "P,E,H \<turnstile> map Val vs [:] Ts''" 
     and sub: "P \<turnstile> Ts'' [\<le>] Ts'" by auto
   from wta \<open>typeof_addr (hp s) a = \<lfloor>U\<rfloor>\<close> \<open>hext H (hp s)\<close> have [simp]: "U' = ty_of_htype U"
     by(auto dest: typeof_addr_hext_mono)
   with icto have [simp]: "C' = class_type_of U" by(auto)
   from sees \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T' = Native in D\<close>
   have [simp]: "meth = Native" by(auto dest: sees_method_fun)
   with wta sees icto wtvs sub have "P,H \<turnstile> a\<bullet>M(vs) : T"
     by(cases U)(auto 4 4 simp add: external_WT'_iff)
   from red_external_wt_hconf_hext[OF wf \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close> \<open>H \<unlhd> hp s\<close> this tconf hconf]
     wta icto sees \<open>ta' = convert_extTA extNTA ta\<close> \<open>e' = extRet2J (addr a\<bullet>M(map Val vs)) va\<close> \<open>s' = (h', lcl s)\<close>
   show ?case by(cases U)(auto 4 5 intro: red_reds.RedCallExternal simp del: split_paired_Ex)
 next
   case RedCallNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case (BlockRed e h l V vo ta e' h' l' T E T')
   note IH = BlockRed.hyps(2)
   from IH[of "E(V \<mapsto> T)" T'] \<open>P,E,H \<turnstile> {V:T=vo; e} : T'\<close> \<open>hext H (hp (h, l))\<close>
   show ?case by(fastforce dest: red_reds.BlockRed)
 next
   case RedBlock thus ?case by(fastforce intro: red_reds.intros)
 next
   case SynchronizedRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case SynchronizedNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case LockSynchronized thus ?case by(fastforce intro: red_reds.intros)
 next
   case SynchronizedRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case UnlockSynchronized thus ?case by(fastforce intro: red_reds.intros)
 next
   case SeqRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedSeq thus ?case by(fastforce intro: red_reds.intros)
 next
   case CondRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedCondT thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedCondF thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedWhile thus ?case by(fastforce intro: red_reds.intros)
 next
   case ThrowRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedThrowNull thus ?case by(fastforce intro: red_reds.intros)
 next
   case TryRed thus ?case by(fastforce intro: red_reds.intros)
 next
   case RedTry thus ?case by(fastforce intro: red_reds.intros)
 next
   case (RedTryCatch s a D C V e2 E T)
   from \<open>P,E,H \<turnstile> try Throw a catch(C V) e2 : T\<close>
   obtain T' where "P,E,H \<turnstile> addr a : T'" by auto
   with \<open>typeof_addr (hp s) a = \<lfloor>Class_type D\<rfloor>\<close> \<open>hext H (hp s)\<close>
   have Ha: "typeof_addr H a = \<lfloor>Class_type D\<rfloor>"
     by(auto dest: typeof_addr_hext_mono)
   with \<open>P \<turnstile> D \<preceq>\<^sup>* C\<close> show ?case
     by(fastforce intro: red_reds.RedTryCatch)
 next
   case (RedTryFail s a D C V e2 E T)
   from \<open>P,E,H \<turnstile> try Throw a catch(C V) e2 : T\<close>
   obtain T' where "P,E,H \<turnstile> addr a : T'" by auto
   with \<open>typeof_addr (hp s) a = \<lfloor>Class_type D\<rfloor>\<close> \<open>hext H (hp s)\<close>
   have Ha: "typeof_addr H a = \<lfloor>Class_type D\<rfloor>" 
     by(auto dest: typeof_addr_hext_mono)
   with \<open>\<not> P \<turnstile> D \<preceq>\<^sup>* C\<close> show ?case
     by(fastforce intro: red_reds.RedTryFail)
 next
   case ListRed1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case ListRed2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case NewArrayThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case CastThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case InstanceOfThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case BinOpThrow1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case BinOpThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case LAssThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAccThrow1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAccThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAssThrow1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAssThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case AAssThrow3 thus ?case by(fastforce intro: red_reds.intros)
 next
   case ALengthThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case FAccThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case FAssThrow1 thus ?case by(fastforce intro: red_reds.intros)
 next 
   case FAssThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CASThrow3 thus ?case by(fastforce intro: red_reds.intros)
 next
   case CallThrowObj thus ?case by(fastforce intro: red_reds.intros)
 next
   case CallThrowParams thus ?case by(fastforce intro: red_reds.intros)
 next
   case BlockThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case SynchronizedThrow1 thus ?case by(fastforce intro: red_reds.intros)
 next
   case SynchronizedThrow2 thus ?case by(fastforce intro: red_reds.intros)
 next
   case SeqThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case CondThrow thus ?case by(fastforce intro: red_reds.intros)
 next
   case ThrowThrow thus ?case by(fastforce intro: red_reds.intros)
 qed
 
 lemma can_lock_devreserp:
   "\<lbrakk> wf_J_prog P; red_mthr.can_sync P t (e, l) h' L; P,E,h \<turnstile> e : T; P,h \<turnstile> t \<surd>t; hconf h; h \<unlhd> h' \<rbrakk> 
   \<Longrightarrow> red_mthr.can_sync P t (e, l) h L"
 apply(erule red_mthr.can_syncE)
 apply(clarsimp)
 apply(drule red_wt_hconf_hext, assumption+)
  apply(simp)
 apply(fastforce intro!: red_mthr.can_syncI)
 done
 
 end
 
 context J_typesafe begin
 
 lemma preserve_deadlocked:
   assumes wf: "wf_J_prog P"
   shows "preserve_deadlocked final_expr (mred P) convert_RA ({s. sync_es_ok (thr s) (shr s) \<and> lock_ok (locks s) (thr s)} \<inter> {s. \<exists>Es. sconf_type_ts_ok Es (thr s) (shr s)} \<inter> {s. def_ass_ts_ok (thr s) (shr s)})"
   (is "preserve_deadlocked _ _ _ ?wf_state")
 proof(unfold_locales)
   show inv: "invariant3p (mredT P) ?wf_state"
     by(intro invariant3p_IntI invariant3p_sync_es_ok_lock_ok[OF wf] lifting_inv.invariant3p_ts_inv[OF lifting_inv_sconf_subject_ok[OF wf]] lifting_wf.invariant3p_ts_ok[OF lifting_wf_def_ass[OF wf]])
   
   fix s t' ta' s' t x ln
   assume wfs: "s \<in> ?wf_state" 
     and redT: "P \<turnstile> s -t'\<triangleright>ta'\<rightarrow> s'"
     and tst: "thr s t = \<lfloor>(x, ln)\<rfloor>" 
   from redT have hext: "shr s \<unlhd> shr s'" by(rule redT_hext_incr)
   
   from inv redT wfs have wfs': "s' \<in> ?wf_state" by(rule invariant3pD)
   from redT tst obtain x' ln' where ts't: "thr s' t= \<lfloor>(x', ln')\<rfloor>"
     by(cases "thr s' t")(cases s, cases s', auto dest: red_mthr.redT_thread_not_disappear)
 
   from wfs tst obtain E T where wt: "P,E,shr s \<turnstile> fst x : T" 
     and hconf: "hconf (shr s)"
     and da: "\<D> (fst x) \<lfloor>dom (snd x)\<rfloor>"
     and tconf: "P,shr s \<turnstile> t \<surd>t"
     by(force dest: ts_invD ts_okD simp add: type_ok_def sconf_def sconf_type_ok_def)
   from wt hext have wt': "P,E,shr s' \<turnstile> fst x : T" by(rule WTrt_hext_mono)
   from wfs' ts't have hconf': "hconf (shr s')" 
     by(auto dest: ts_invD simp add: type_ok_def sconf_def sconf_type_ok_def)
 
   {
     assume cs: "red_mthr.must_sync P t x (shr s)"
     from cs have "\<not> final (fst x)" by(auto elim!: red_mthr.must_syncE simp add: split_beta)
 
     from progress[OF wf_prog_wwf_prog[OF wf] hconf' wt' da this, of "extTA2J P" t]
     obtain e' h x' ta where "P,t \<turnstile> \<langle>fst x,(shr s', snd x)\<rangle> -ta\<rightarrow> \<langle>e', (h, x')\<rangle>" by auto
     with red_ta_satisfiable[OF this]
     show "red_mthr.must_sync P t x (shr s')"
       by-(rule red_mthr.must_syncI, fastforce simp add: split_beta)
   next
     fix LT
     assume "red_mthr.can_sync P t x (shr s') LT"
     with can_lock_devreserp[OF wf _ wt tconf hconf hext, of "snd x" LT]
     show "\<exists>LT'\<subseteq>LT. red_mthr.can_sync P t x (shr s) LT'" by auto
   }
 qed
 
 end
 
 end
diff --git a/thys/JinjaThreads/J/TypeSafe.thy b/thys/JinjaThreads/J/TypeSafe.thy
--- a/thys/JinjaThreads/J/TypeSafe.thy
+++ b/thys/JinjaThreads/J/TypeSafe.thy
@@ -1,886 +1,888 @@
 (*  Title:      JinjaThreads/J/SmallTypeSafe.thy
     Author:     Tobias Nipkow, Andreas Lochbihler
 *)
 
 section \<open>Type Safety Proof\<close>
 
 theory TypeSafe
 imports
   Progress
   DefAssPreservation
 begin
 
 subsection\<open>Basic preservation lemmas\<close>
 
 text\<open>First two easy preservation lemmas.\<close>
 
 theorem (in J_conf_read)
   shows red_preserves_hconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>; P,E,hp s \<turnstile> e : T; hconf (hp s) \<rbrakk> \<Longrightarrow> hconf (hp s')"
   and reds_preserves_hconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts; hconf (hp s) \<rbrakk> \<Longrightarrow> hconf (hp s')"
 proof (induct arbitrary: T E and Ts E rule: red_reds.inducts)
   case RedNew thus ?case
     by(auto intro: hconf_heap_ops_mono)
 next
   case RedNewFail thus ?case
     by(auto intro: hconf_heap_ops_mono)
 next
   case RedNewArray thus ?case
     by(auto intro: hconf_heap_ops_mono)
 next
   case RedNewArrayFail thus ?case
     by(auto intro: hconf_heap_ops_mono)
 next
   case (RedAAss h a U n i v U' h' l)
   from \<open>sint i < int n\<close> \<open>0 <=s i\<close>
-  have "nat (sint i) < n" by(metis nat_less_iff sint_0 word_sle_def)
+  have "nat (sint i) < n"
+    by (simp add: word_sle_eq nat_less_iff)
   thus ?case using RedAAss
     by(fastforce elim: hconf_heap_write_mono intro: addr_loc_type.intros simp add: conf_def)
 next
   case RedFAss thus ?case
     by(fastforce elim: hconf_heap_write_mono intro: addr_loc_type.intros simp add: conf_def)
 next
   case RedCASSucceed thus ?case
     by(fastforce elim: hconf_heap_write_mono intro: addr_loc_type.intros simp add: conf_def)
 next
   case (RedCallExternal s a U M Ts T' D vs ta va h' ta' e' s')
   hence "P,hp s \<turnstile> a\<bullet>M(vs) : T"
     by(fastforce simp add: external_WT'_iff dest: sees_method_fun)
   with RedCallExternal show ?case by(auto dest: external_call_hconf)
 qed auto
 
 theorem (in J_heap) red_preserves_lconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>; P,E,hp s \<turnstile> e:T; P,hp s \<turnstile> lcl s (:\<le>) E \<rbrakk> \<Longrightarrow> P,hp s' \<turnstile> lcl s' (:\<le>) E"
   and reds_preserves_lconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>; P,E,hp s \<turnstile> es[:]Ts; P,hp s \<turnstile> lcl s (:\<le>) E \<rbrakk> \<Longrightarrow> P,hp s' \<turnstile> lcl s' (:\<le>) E"
 proof(induct arbitrary: T E and Ts E rule:red_reds.inducts)
   case RedNew thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedNewFail thus ?case
     by(auto intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedNewArray thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedNewArrayFail thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedLAss thus ?case 
     by(fastforce elim: lconf_upd simp add: conf_def simp del: fun_upd_apply )
 next
   case RedAAss thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedFAss thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case RedCASSucceed thus ?case
     by(fastforce intro:lconf_hext hext_heap_ops simp del: fun_upd_apply)
 next
   case (BlockRed e h x V vo ta e' h' x' T T' E)
   note red = \<open>extTA,P,t \<turnstile> \<langle>e,(h, x(V := vo))\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close>
   note IH = \<open>\<And>T E. \<lbrakk>P,E,hp (h, x(V := vo)) \<turnstile> e : T;
                P,hp (h, x(V := vo)) \<turnstile> lcl (h, x(V := vo)) (:\<le>) E\<rbrakk>
               \<Longrightarrow> P,hp (h', x') \<turnstile> lcl (h', x') (:\<le>) E\<close>
   note wt = \<open>P,E,hp (h, x) \<turnstile> {V:T=vo; e} : T'\<close>
   note lconf = \<open>P,hp (h, x) \<turnstile> lcl (h, x) (:\<le>) E\<close>
   from lconf_hext[OF lconf[simplified] red_hext_incr[OF red, simplified]]
   have "P,h' \<turnstile> x (:\<le>) E" .
   moreover from wt have "P,E(V\<mapsto>T),h \<turnstile> e : T'" by(cases vo, auto)
   moreover from lconf wt have "P,h \<turnstile> x(V := vo) (:\<le>) E(V \<mapsto> T)"
     by(cases vo)(simp add: lconf_def,auto intro: lconf_upd2 simp add: conf_def)
   ultimately have "P,h' \<turnstile> x' (:\<le>) E(V\<mapsto>T)" 
     by(auto intro: IH[simplified])
   with \<open>P,h' \<turnstile> x (:\<le>) E\<close> show ?case
     by(auto simp add: lconf_def split: if_split_asm)
 next
   case (RedCallExternal s a U M Ts T' D vs ta va h' ta' e' s')
   from \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close> have "hp s \<unlhd> h'" by(rule red_external_hext)
   with \<open>s' = (h', lcl s)\<close> \<open>P,hp s \<turnstile> lcl s (:\<le>) E\<close> show ?case by(auto intro: lconf_hext)
 qed auto
 
 text\<open>Combining conformance of heap and local variables:\<close>
 
 definition (in J_heap_conf_base) sconf :: "env \<Rightarrow> ('addr, 'heap) Jstate \<Rightarrow> bool" ("_ \<turnstile> _ \<surd>"   [51,51]50)
   where "E \<turnstile> s \<surd>  \<equiv>  let (h,l) = s in hconf h \<and> P,h \<turnstile> l (:\<le>) E \<and> preallocated h"
 
 context J_conf_read begin
 
 lemma red_preserves_sconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>e,s\<rangle> -tas\<rightarrow> \<langle>e',s'\<rangle>; P,E,hp s \<turnstile> e : T; E \<turnstile> s \<surd> \<rbrakk> \<Longrightarrow> E \<turnstile> s' \<surd>"
 apply(auto dest: red_preserves_hconf red_preserves_lconf simp add:sconf_def)
 apply(fastforce dest: red_hext_incr intro: preallocated_hext)
 done
 
 lemma reds_preserves_sconf:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts; E \<turnstile> s \<surd> \<rbrakk> \<Longrightarrow> E \<turnstile> s' \<surd>"
 apply(auto dest: reds_preserves_hconf reds_preserves_lconf simp add: sconf_def)
 apply(fastforce dest: reds_hext_incr intro: preallocated_hext)
 done
 
 end
 
 lemma (in J_heap_base) wt_external_call:
   "\<lbrakk> conf_extRet P h va T; P,E,h \<turnstile> e : T \<rbrakk> \<Longrightarrow> \<exists>T'. P,E,h \<turnstile> extRet2J e va : T' \<and> P \<turnstile> T' \<le> T"
 by(cases va)(auto simp add: conf_def)
 
 subsection "Subject reduction"
 
 theorem (in J_conf_read) assumes wf: "wf_J_prog P"
   shows subject_reduction:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>; E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e:T; P,hp s \<turnstile> t \<surd>t \<rbrakk>
   \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e':T' \<and> P \<turnstile> T' \<le> T"
   and subjects_reduction:
   "\<lbrakk> extTA,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>; E \<turnstile> s \<surd>; P,E,hp s \<turnstile> es[:]Ts; P,hp s \<turnstile> t \<surd>t \<rbrakk>
   \<Longrightarrow> \<exists>Ts'. P,E,hp s' \<turnstile> es'[:]Ts' \<and> P \<turnstile> Ts' [\<le>] Ts"
 proof (induct arbitrary: T E and Ts E rule:red_reds.inducts)
   case RedNew
   thus ?case by(auto dest: allocate_SomeD)
 next
   case RedNewFail thus ?case unfolding sconf_def
     by(fastforce intro:typeof_OutOfMemory preallocated_heap_ops simp add: xcpt_subcls_Throwable[OF _ wf]) 
 next
   case NewArrayRed
   thus ?case by fastforce
 next
   case RedNewArray
   thus ?case by(auto dest: allocate_SomeD)
 next
   case RedNewArrayNegative thus ?case unfolding sconf_def
     by(fastforce intro: preallocated_heap_ops simp add: xcpt_subcls_Throwable[OF _ wf]) 
 next
   case RedNewArrayFail thus ?case unfolding sconf_def
     by(fastforce intro:typeof_OutOfMemory preallocated_heap_ops simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (CastRed e s ta e' s' C T E)
   have esse: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>" 
     and IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T"
     and hconf: "E \<turnstile> s \<surd>"
     and wtc: "P,E,hp s \<turnstile> Cast C e : T" by fact+
   thus ?case
   proof(clarsimp)
     fix T'
     assume wte: "P,E,hp s \<turnstile> e : T'" "is_type P C"
     from wte and hconf and IH and \<open>P,hp s \<turnstile> t \<surd>t\<close> have "\<exists>U. P,E,hp s' \<turnstile> e' : U \<and> P \<turnstile> U \<le> T'" by simp
     then obtain U where wtee: "P,E,hp s' \<turnstile> e' : U" and UsTT: "P \<turnstile> U \<le> T'" by blast
     from wtee \<open>is_type P C\<close> have "P,E,hp s' \<turnstile> Cast C e' : C" by(rule WTrtCast)
     thus "\<exists>T'. P,E,hp s' \<turnstile> Cast C e' : T' \<and> P \<turnstile> T' \<le> C" by blast
   qed
 next
   case RedCast thus ?case
     by(clarsimp simp add: is_refT_def)
 next
   case RedCastFail thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (InstanceOfRed e s ta e' s' U T E)
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T"
     and hconf: "E \<turnstile> s \<surd>"
     and wtc: "P,E,hp s \<turnstile> e instanceof U : T" 
     and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wtc obtain T' where "P,E,hp s \<turnstile> e : T'" by auto
   from IH[OF hconf this tconf] obtain T'' where "P,E,hp s' \<turnstile> e' : T''" by auto
   with wtc show ?case by auto
 next
   case RedInstanceOf thus ?case
     by(clarsimp)
 next
   case (BinOpRed1 e\<^sub>1 s ta e\<^sub>1' s' bop e\<^sub>2 T E)
   have red: "extTA,P,t \<turnstile> \<langle>e\<^sub>1, s\<rangle> -ta\<rightarrow> \<langle>e\<^sub>1', s'\<rangle>"
    and IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e\<^sub>1:T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e\<^sub>1' : U \<and> P \<turnstile> U \<le> T"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 : T" 
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt obtain T1 T2 where wt1: "P,E,hp s \<turnstile> e\<^sub>1 : T1"
     and wt2: "P,E,hp s \<turnstile> e\<^sub>2 : T2" and wtbop: "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T" by auto
   from IH[OF conf wt1 tconf] obtain T1' where wt1': "P,E,hp s' \<turnstile> e\<^sub>1' : T1'"
     and sub: "P \<turnstile> T1' \<le> T1" by blast
   from WTrt_binop_widen_mono[OF wtbop sub widen_refl]
   obtain T' where wtbop': "P \<turnstile> T1'\<guillemotleft>bop\<guillemotright>T2 : T'" and sub': "P \<turnstile> T' \<le> T" by blast
   from wt1' WTrt_hext_mono[OF wt2 red_hext_incr[OF red]] wtbop'
   have "P,E,hp s' \<turnstile> e\<^sub>1' \<guillemotleft>bop\<guillemotright> e\<^sub>2 : T'" by(rule WTrtBinOp)
   with sub' show ?case by blast
 next
   case (BinOpRed2 e\<^sub>2 s ta e\<^sub>2' s' v\<^sub>1 bop T E)
   have red: "extTA,P,t \<turnstile> \<langle>e\<^sub>2,s\<rangle> -ta\<rightarrow> \<langle>e\<^sub>2',s'\<rangle>" by fact
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e\<^sub>2:T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e\<^sub>2' : U \<and> P \<turnstile> U \<le> T" 
     and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   have conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> (Val v\<^sub>1) \<guillemotleft>bop\<guillemotright> e\<^sub>2 : T" by fact+
   from wt obtain T1 T2 where wt1: "P,E,hp s \<turnstile> Val v\<^sub>1 : T1"
     and wt2: "P,E,hp s \<turnstile> e\<^sub>2 : T2" and wtbop: "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T" by auto
   from IH[OF conf wt2 tconf] obtain T2' where wt2': "P,E,hp s' \<turnstile> e\<^sub>2' : T2'"
     and sub: "P \<turnstile> T2' \<le> T2" by blast
   from WTrt_binop_widen_mono[OF wtbop widen_refl sub]
   obtain T' where wtbop': "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2' : T'" and sub': "P \<turnstile> T' \<le> T" by blast
   from WTrt_hext_mono[OF wt1 red_hext_incr[OF red]] wt2' wtbop'
   have "P,E,hp s' \<turnstile> Val v\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2' : T'" by(rule WTrtBinOp)
   with sub' show ?case by blast
 next
   case (RedBinOp bop v1 v2 v s)
   from \<open>E \<turnstile> s \<surd>\<close> have preh: "preallocated (hp s)" by(cases s)(simp add: sconf_def)
   from \<open>P,E,hp s \<turnstile> Val v1 \<guillemotleft>bop\<guillemotright> Val v2 : T\<close> obtain T1 T2
     where "typeof\<^bsub>hp s\<^esub> v1 = \<lfloor>T1\<rfloor>" "typeof\<^bsub>hp s\<^esub> v2 = \<lfloor>T2\<rfloor>" "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T" by auto
   with wf preh have "P,hp s \<turnstile> v :\<le> T" using \<open>binop bop v1 v2 = \<lfloor>Inl v\<rfloor>\<close>
     by(rule binop_type)
   thus ?case by(auto simp add: conf_def)
 next
   case (RedBinOpFail bop v1 v2 a s)
   from \<open>E \<turnstile> s \<surd>\<close> have preh: "preallocated (hp s)" by(cases s)(simp add: sconf_def)
   from \<open>P,E,hp s \<turnstile> Val v1 \<guillemotleft>bop\<guillemotright> Val v2 : T\<close> obtain T1 T2
     where "typeof\<^bsub>hp s\<^esub> v1 = \<lfloor>T1\<rfloor>" "typeof\<^bsub>hp s\<^esub> v2 = \<lfloor>T2\<rfloor>" "P \<turnstile> T1\<guillemotleft>bop\<guillemotright>T2 : T" by auto
   with wf preh have "P,hp s \<turnstile> Addr a :\<le> Class Throwable" using \<open>binop bop v1 v2 = \<lfloor>Inr a\<rfloor>\<close>
     by(rule binop_type)
   thus ?case by(auto simp add: conf_def)
 next
   case RedVar thus ?case by (fastforce simp:sconf_def lconf_def conf_def)
 next
   case LAssRed thus ?case by(blast intro:widen_trans)
 next
   case RedLAss thus ?case by fastforce
 next
   case (AAccRed1 a s ta a' s' i T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> a : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> a' : T' \<and> P \<turnstile> T' \<le> T"
     and assa: "extTA,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>"
     and wt: "P,E,hp s \<turnstile> a\<lfloor>i\<rceil> : T"
     and hconf: "E \<turnstile> s \<surd>" 
     and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have wti: "P,E,hp s \<turnstile> i : Integer" by auto
   from wti red_hext_incr[OF assa] have wti': "P,E,hp s' \<turnstile> i : Integer" by - (rule WTrt_hext_mono)
   { assume wta: "P,E,hp s \<turnstile> a : T\<lfloor>\<rceil>"
     from IH[OF hconf wta tconf]
     obtain U where wta': "P,E,hp s' \<turnstile> a' : U" and UsubT: "P \<turnstile> U \<le> T\<lfloor>\<rceil>" by fastforce
     with wta' wti' have ?case by(cases U, auto simp add: widen_Array) }
   moreover
   { assume wta: "P,E,hp s \<turnstile> a : NT"
     from IH[OF hconf wta tconf] have "P,E,hp s' \<turnstile> a' : NT" by fastforce
     from this wti' have ?case
       by(fastforce intro:WTrtAAccNT) }
   ultimately show ?case using wt by auto
 next
   case (AAccRed2 i s ta i' s' a T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> i : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> i' : T' \<and> P \<turnstile> T' \<le> T"
     and issi: "extTA,P,t \<turnstile> \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>"
     and wt: "P,E,hp s \<turnstile> Val a\<lfloor>i\<rceil> : T"
     and sconf: "E \<turnstile> s \<surd>" 
     and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have wti: "P,E,hp s \<turnstile> i : Integer" by auto
   from wti IH sconf tconf have wti': "P,E,hp s' \<turnstile> i' : Integer" by blast
   from wt show ?case
   proof (rule WTrt_elim_cases)
     assume wta: "P,E,hp s \<turnstile> Val a : T\<lfloor>\<rceil>"
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : T\<lfloor>\<rceil>" by (rule WTrt_hext_mono)
     from wta' wti' show ?case by(fastforce)
   next
     assume wta: "P,E,hp s \<turnstile> Val a : NT"
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : NT" by (rule WTrt_hext_mono)
     from wta' wti' show ?case
       by(fastforce elim:WTrtAAccNT)
   qed
 next
   case RedAAccNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case RedAAccBounds thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (RedAAcc h a T n i v l T' E)
   from \<open>E \<turnstile> (h, l) \<surd>\<close> have "hconf h" by(clarsimp simp add: sconf_def)
   from \<open>0 <=s i\<close> \<open>sint i < int n\<close>
-  have "nat (sint i) < n" by(metis nat_less_iff sint_0 word_sle_def)
+  have "nat (sint i) < n"
+    by (simp add: word_sle_eq nat_less_iff)
   with \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close> have "P,h \<turnstile> a@ACell (nat (sint i)) : T"
     by(auto intro: addr_loc_type.intros)
   from heap_read_conf[OF \<open>heap_read h a (ACell (nat (sint i))) v\<close> this] \<open>hconf h\<close>
   have "P,h \<turnstile> v :\<le> T" by simp
   thus ?case using RedAAcc by(auto simp add: conf_def)
 next
   case (AAssRed1 a s ta a' s' i e T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> a : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> a' : T' \<and> P \<turnstile> T' \<le> T"
     and assa: "extTA,P,t \<turnstile> \<langle>a,s\<rangle> -ta\<rightarrow> \<langle>a',s'\<rangle>"
     and wt: "P,E,hp s \<turnstile> a\<lfloor>i\<rceil> := e : T"
     and sconf: "E \<turnstile> s \<surd>" 
     and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have void: "T = Void" by blast
   from wt have wti: "P,E,hp s \<turnstile> i : Integer" by auto
   from wti red_hext_incr[OF assa] have wti': "P,E,hp s' \<turnstile> i : Integer" by - (rule WTrt_hext_mono)
   { assume wta: "P,E,hp s \<turnstile> a : NT"
     from IH[OF sconf wta tconf] have wta': "P,E,hp s' \<turnstile> a' : NT" by fastforce
     from wt wta obtain V where wte: "P,E,hp s \<turnstile> e : V" by(auto)
     from wte red_hext_incr[OF assa] have wte': "P,E,hp s' \<turnstile> e : V" by - (rule WTrt_hext_mono)
     from wta' wti' wte' void have ?case
       by(fastforce elim: WTrtAAssNT) }
   moreover
   { fix U
     assume wta: "P,E,hp s \<turnstile> a : U\<lfloor>\<rceil>"
     from IH[OF sconf wta tconf]
     obtain U' where wta': "P,E,hp s' \<turnstile> a' : U'" and UsubT: "P \<turnstile> U' \<le> U\<lfloor>\<rceil>" by fastforce
     with wta' have ?case
     proof(cases U')
       case NT
       assume UNT: "U' = NT"
       from UNT wt wta obtain V where wte: "P,E,hp s \<turnstile> e : V" by(auto)
       from wte red_hext_incr[OF assa] have wte': "P,E,hp s' \<turnstile> e : V" by - (rule WTrt_hext_mono)
       from wta' UNT wti' wte' void show ?thesis
         by(fastforce elim: WTrtAAssNT)
     next
       case (Array A)
       have UA: "U' = A\<lfloor>\<rceil>" by fact
       with UA UsubT wt wta obtain V where wte: "P,E,hp s \<turnstile> e : V" by auto
       from wte red_hext_incr[OF assa] have wte': "P,E,hp s' \<turnstile> e : V" by - (rule WTrt_hext_mono)
       with wta' wte' UA wti' void show ?thesis by (fast elim:WTrtAAss)
     qed(simp_all add: widen_Array) }
   ultimately show ?case using wt by blast
 next
   case (AAssRed2 i s ta i' s' a e T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> i : T; P,hp s \<turnstile> t \<surd>t \<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> i' : T' \<and> P \<turnstile> T' \<le> T" 
     and issi: "extTA,P,t \<turnstile> \<langle>i,s\<rangle> -ta\<rightarrow> \<langle>i',s'\<rangle>" 
     and wt: "P,E,hp s \<turnstile> Val a\<lfloor>i\<rceil> := e : T" 
     and sconf: "E \<turnstile> s \<surd>" and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have void: "T = Void" by blast
   from wt have wti: "P,E,hp s \<turnstile> i : Integer" by auto
   from IH[OF sconf wti tconf] have wti': "P,E,hp s' \<turnstile> i' : Integer" by fastforce
   from wt show ?case
   proof(rule WTrt_elim_cases)
     fix U T'
     assume wta: "P,E,hp s \<turnstile> Val a : U\<lfloor>\<rceil>"
       and wte: "P,E,hp s \<turnstile> e : T'"
     from wte red_hext_incr[OF issi] have wte': "P,E,hp s' \<turnstile> e : T'" by - (rule WTrt_hext_mono)
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : U\<lfloor>\<rceil>" by - (rule WTrt_hext_mono)
     from wta' wti' wte' void show ?case by (fastforce elim:WTrtAAss)
   next
     fix T'
     assume wta: "P,E,hp s \<turnstile> Val a : NT"
       and wte: "P,E,hp s \<turnstile> e : T'"
     from wte red_hext_incr[OF issi] have wte': "P,E,hp s' \<turnstile> e : T'" by - (rule WTrt_hext_mono)
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : NT" by - (rule WTrt_hext_mono)
     from wta' wti' wte' void show ?case by (fastforce elim:WTrtAAss)
   qed
 next
   case (AAssRed3 e s ta e' s' a i T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T" 
     and issi: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>" 
     and wt: "P,E,hp s \<turnstile> Val a\<lfloor>Val i\<rceil> := e : T" 
     and sconf: "E \<turnstile> s \<surd>" and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have void: "T = Void" by blast
   from wt have wti: "P,E,hp s \<turnstile> Val i : Integer" by auto
   from wti red_hext_incr[OF issi] have wti': "P,E,hp s' \<turnstile> Val i : Integer" by - (rule WTrt_hext_mono)
   from wt show ?case
   proof(rule WTrt_elim_cases)
     fix U T'
     assume wta: "P,E,hp s \<turnstile> Val a : U\<lfloor>\<rceil>"
       and wte: "P,E,hp s \<turnstile> e : T'"
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : U\<lfloor>\<rceil>" by - (rule WTrt_hext_mono)
     from IH[OF sconf wte tconf]
     obtain V where wte': "P,E,hp s' \<turnstile> e' : V" by fastforce
     from wta' wti' wte' void show ?case by (fastforce elim:WTrtAAss)
   next
     fix T'
     assume wta: "P,E,hp s \<turnstile> Val a : NT"
       and wte: "P,E,hp s \<turnstile> e : T'"
     from wta red_hext_incr[OF issi] have wta': "P,E,hp s' \<turnstile> Val a : NT" by - (rule WTrt_hext_mono)
     from IH[OF sconf wte tconf]
     obtain V where wte': "P,E,hp s' \<turnstile> e' : V" by fastforce
     from wta' wti' wte' void show ?case by (fastforce elim:WTrtAAss)
   qed
 next
   case RedAAssNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case RedAAssBounds thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case RedAAssStore thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case RedAAss thus ?case
     by(auto simp del:fun_upd_apply)
 next
   case (ALengthRed a s ta a' s' T E)
   note IH = \<open>\<And>T'. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> a : T'; P,hp s \<turnstile> t \<surd>t\<rbrakk>
       \<Longrightarrow> \<exists>T''. P,E,hp s' \<turnstile> a' : T'' \<and> P \<turnstile> T'' \<le> T'\<close>
   from \<open>P,E,hp s \<turnstile> a\<bullet>length : T\<close>
   show ?case
   proof(rule WTrt_elim_cases)
     fix T'
     assume [simp]: "T = Integer"
       and wta: "P,E,hp s \<turnstile> a : T'\<lfloor>\<rceil>"
     from wta \<open>E \<turnstile> s \<surd>\<close> IH \<open>P,hp s \<turnstile> t \<surd>t\<close>
     obtain T'' where wta': "P,E,hp s' \<turnstile> a' : T''" 
       and sub: "P \<turnstile> T'' \<le> T'\<lfloor>\<rceil>" by blast
     from sub have "P,E,hp s' \<turnstile> a'\<bullet>length : Integer"
       unfolding widen_Array
     proof(rule disjE)
       assume "T'' = NT"
       with wta' show ?thesis by(auto)
     next
       assume "\<exists>V. T'' = V\<lfloor>\<rceil> \<and> P \<turnstile> V \<le> T'"
       then obtain V where "T'' = V\<lfloor>\<rceil>" "P \<turnstile> V \<le> T'" by blast
       with wta' show ?thesis by -(rule WTrtALength, simp)
     qed
     thus ?thesis by(simp)
   next
     assume "P,E,hp s \<turnstile> a : NT"
     with \<open>E \<turnstile> s \<surd>\<close> IH \<open>P,hp s \<turnstile> t \<surd>t\<close>
     obtain T'' where wta': "P,E,hp s' \<turnstile> a' : T''" 
       and sub: "P \<turnstile> T'' \<le> NT" by blast
     from sub have "T'' = NT" by auto
     with wta' show ?thesis by(auto)
   qed
 next
   case (RedALength h a T n l T' E)
   from \<open>P,E,hp (h, l) \<turnstile> addr a\<bullet>length : T'\<close> \<open>typeof_addr h a = \<lfloor>Array_type T n\<rfloor>\<close>
   have [simp]: "T' = Integer" by(auto)
   thus ?case by(auto)
 next
   case RedALengthNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (FAccRed e s ta e' s' F D T E)
   have IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e' : U \<and> P \<turnstile> U \<le> T"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> e\<bullet>F{D} : T" 
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   \<comment> \<open>Now distinguish the two cases how wt can have arisen.\<close>
   { fix T' C fm
     assume wte: "P,E,hp s \<turnstile> e : T'"
       and icto: "class_type_of' T' = \<lfloor>C\<rfloor>"
       and has: "P \<turnstile> C has F:T (fm) in D"
     from IH[OF conf wte tconf]
     obtain U where wte': "P,E,hp s' \<turnstile> e' : U" and UsubC: "P \<turnstile> U \<le> T'" by auto
     \<comment> \<open>Now distinguish what @{term U} can be.\<close>
     with UsubC have ?case
     proof(cases "U = NT")
       case True
       thus ?thesis using wte' by(blast intro:WTrtFAccNT widen_refl) 
     next
       case False
       with icto UsubC obtain C' where icto': "class_type_of' U = \<lfloor>C'\<rfloor>"
         and C'subC: "P \<turnstile> C' \<preceq>\<^sup>* C"
         by(rule widen_is_class_type_of)
       from has_field_mono[OF has C'subC] wte' icto'
       show ?thesis by(auto intro!:WTrtFAcc) 
     qed }
   moreover
   { assume "P,E,hp s \<turnstile> e : NT"
     hence "P,E,hp s' \<turnstile> e' : NT" using IH[OF conf _ tconf] by fastforce
     hence ?case  by(fastforce intro:WTrtFAccNT widen_refl) }
   ultimately show ?case using wt by blast
 next
   case RedFAcc thus ?case unfolding sconf_def
     by(fastforce dest: heap_read_conf intro: addr_loc_type.intros simp add: conf_def)
 next
   case RedFAccNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (FAssRed1 e s ta e' s' F D e\<^sub>2)
   have red: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>"
    and IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e' : U \<and> P \<turnstile> U \<le> T"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> e\<bullet>F{D}:=e\<^sub>2 : T"
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have void: "T = Void" by blast
   \<comment> \<open>We distinguish if @{term e} has type @{term NT} or a Class type\<close>
   { assume "P,E,hp s \<turnstile> e : NT"
     hence "P,E,hp s' \<turnstile> e' : NT" using IH[OF conf _ tconf] by fastforce
     moreover obtain T\<^sub>2 where "P,E,hp s \<turnstile> e\<^sub>2 : T\<^sub>2" using wt by auto
     from this red_hext_incr[OF red] have  "P,E,hp s' \<turnstile> e\<^sub>2 : T\<^sub>2"
       by(rule WTrt_hext_mono)
     ultimately have ?case using void by(blast intro!:WTrtFAssNT)
   }
   moreover
   { fix T' C TF T\<^sub>2 fm
     assume wt\<^sub>1: "P,E,hp s \<turnstile> e : T'" and icto: "class_type_of' T' = \<lfloor>C\<rfloor>" and wt\<^sub>2: "P,E,hp s \<turnstile> e\<^sub>2 : T\<^sub>2"
       and has: "P \<turnstile> C has F:TF (fm) in D" and sub: "P \<turnstile> T\<^sub>2 \<le> TF"
     obtain U where wt\<^sub>1': "P,E,hp s' \<turnstile> e' : U" and UsubC: "P \<turnstile> U \<le> T'"
       using IH[OF conf wt\<^sub>1 tconf] by blast
     have wt\<^sub>2': "P,E,hp s' \<turnstile> e\<^sub>2 : T\<^sub>2"
       by(rule WTrt_hext_mono[OF wt\<^sub>2 red_hext_incr[OF red]])
     \<comment> \<open>Is @{term U} the null type or a class type?\<close>
     have ?case
     proof(cases "U = NT")
       case True
       with wt\<^sub>1' wt\<^sub>2' void show ?thesis by(blast intro!:WTrtFAssNT)
     next
       case False
       with icto UsubC obtain C' where icto': "class_type_of' U = \<lfloor>C'\<rfloor>"
         and "subclass": "P \<turnstile> C' \<preceq>\<^sup>* C" by(rule widen_is_class_type_of)
       have "P \<turnstile> C' has F:TF (fm) in D" by(rule has_field_mono[OF has "subclass"])
       with wt\<^sub>1' show ?thesis using wt\<^sub>2' sub void icto' by(blast intro:WTrtFAss)
     qed }
   ultimately show ?case using wt by blast
 next
   case (FAssRed2 e\<^sub>2 s ta e\<^sub>2' s' v F D T E)
   have red: "extTA,P,t \<turnstile> \<langle>e\<^sub>2,s\<rangle> -ta\<rightarrow> \<langle>e\<^sub>2',s'\<rangle>"
    and IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e\<^sub>2 : T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e\<^sub>2' : U \<and> P \<turnstile> U \<le> T"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> Val v\<bullet>F{D}:=e\<^sub>2 : T" 
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt have [simp]: "T = Void" by auto
   from wt show ?case
   proof (rule WTrt_elim_cases)
     fix U C TF T\<^sub>2 fm
     assume wt\<^sub>1: "P,E,hp s \<turnstile> Val v : U"
       and icto: "class_type_of' U = \<lfloor>C\<rfloor>"
       and has: "P \<turnstile> C has F:TF (fm) in D"
       and wt\<^sub>2: "P,E,hp s \<turnstile> e\<^sub>2 : T\<^sub>2" and TsubTF: "P \<turnstile> T\<^sub>2 \<le> TF"
     have wt\<^sub>1': "P,E,hp s' \<turnstile> Val v : U"
       by(rule WTrt_hext_mono[OF wt\<^sub>1 red_hext_incr[OF red]])
     obtain T\<^sub>2' where wt\<^sub>2': "P,E,hp s' \<turnstile> e\<^sub>2' : T\<^sub>2'" and T'subT: "P \<turnstile> T\<^sub>2' \<le> T\<^sub>2"
       using IH[OF conf wt\<^sub>2 tconf] by blast
     have "P,E,hp s' \<turnstile> Val v\<bullet>F{D}:=e\<^sub>2' : Void"
       by(rule WTrtFAss[OF wt\<^sub>1' icto has wt\<^sub>2' widen_trans[OF T'subT TsubTF]])
     thus ?case by auto
   next
     fix T\<^sub>2 assume null: "P,E,hp s \<turnstile> Val v : NT" and wt\<^sub>2: "P,E,hp s \<turnstile> e\<^sub>2 : T\<^sub>2"
     from null have "v = Null" by simp
     moreover
     obtain T\<^sub>2' where "P,E,hp s' \<turnstile> e\<^sub>2' : T\<^sub>2' \<and> P \<turnstile> T\<^sub>2' \<le> T\<^sub>2"
       using IH[OF conf wt\<^sub>2 tconf] by blast
     ultimately show ?thesis by(fastforce intro:WTrtFAssNT)
   qed
 next
   case RedFAss thus ?case by(auto simp del:fun_upd_apply)
 next
   case RedFAssNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (CASRed1 e s ta e' s' D F e2 e3)
   from CASRed1.prems(2) consider (NT) T2 T3 where 
       "P,E,hp s \<turnstile> e : NT" "T = Boolean" "P,E,hp s \<turnstile> e2 : T2" "P,E,hp s \<turnstile> e3 : T3"
     | (RefT) U T' C fm T2 T3 where
       "P,E,hp s \<turnstile> e : U" "T = Boolean" "class_type_of' U = \<lfloor>C\<rfloor>" "P \<turnstile> C has F:T' (fm) in D"
       "P,E,hp s \<turnstile> e2 : T2" "P \<turnstile> T2 \<le> T'" "P,E,hp s \<turnstile> e3 : T3" "P \<turnstile> T3 \<le> T'" "volatile fm" by fastforce
   thus ?case
   proof cases
     case NT
     have "P,E,hp s' \<turnstile> e' : NT" using CASRed1.hyps(2)[OF CASRed1.prems(1) NT(1) CASRed1.prems(3)] by auto
     moreover from NT CASRed1.hyps(1)[THEN red_hext_incr]
     have "P,E,hp s' \<turnstile> e2 : T2" "P,E,hp s' \<turnstile> e3 : T3" by(auto intro: WTrt_hext_mono)
     ultimately show ?thesis using NT by(auto intro: WTrtCASNT)
   next
     case RefT
     from CASRed1.hyps(2)[OF CASRed1.prems(1) RefT(1) CASRed1.prems(3)]
     obtain U' where wt1: "P,E,hp s' \<turnstile> e' : U'" "P \<turnstile> U' \<le> U" by blast
     from RefT CASRed1.hyps(1)[THEN red_hext_incr]
     have wt2: "P,E,hp s' \<turnstile> e2 : T2" and wt3: "P,E,hp s' \<turnstile> e3 : T3" by(auto intro: WTrt_hext_mono)
     show ?thesis
     proof(cases "U' = NT")
       case True
       with RefT wt1 wt2 wt3 show ?thesis by(auto intro: WTrtCASNT)
     next
       case False
       with RefT(3) wt1 obtain C' where icto': "class_type_of' U' = \<lfloor>C'\<rfloor>"
         and "subclass": "P \<turnstile> C' \<preceq>\<^sup>* C" by(blast intro: widen_is_class_type_of)
       have "P \<turnstile> C' has F:T' (fm) in D" by(rule has_field_mono[OF RefT(4) "subclass"])
       with RefT wt1 wt2 wt3 icto' show ?thesis by(auto intro!: WTrtCAS)
     qed
   qed
 next
   case (CASRed2 e s ta e' s' v D F e3)
   consider (Null) "v = Null" | (Val) U C T' fm T2 T3 where
     "class_type_of' U = \<lfloor>C\<rfloor>" "P \<turnstile> C has F:T' (fm) in D" "volatile fm"
     "P,E,hp s \<turnstile> e : T2" "P \<turnstile> T2 \<le> T'" "P,E,hp s \<turnstile> e3 : T3" "P \<turnstile> T3 \<le> T'" "T = Boolean"
     "typeof\<^bsub>hp s\<^esub> v = \<lfloor>U\<rfloor>" using CASRed2.prems(2) by auto
   then show ?case 
   proof cases
     case Null
     then show ?thesis using CASRed2 
       by(force dest: red_hext_incr intro: WTrt_hext_mono WTrtCASNT)
   next
     case Val
     from CASRed2.hyps(1) have hext: "hp s \<unlhd> hp s'" by(auto dest: red_hext_incr)
     with Val(9) have "typeof\<^bsub>hp s'\<^esub> v = \<lfloor>U\<rfloor>" by(rule type_of_hext_type_of)
     moreover from CASRed2.hyps(2)[OF CASRed2.prems(1) Val(4) CASRed2.prems(3)] Val(5)
     obtain T2' where "P,E,hp s' \<turnstile> e' : T2'" "P \<turnstile> T2' \<le> T'" by(auto intro: widen_trans)
     moreover from Val(6) hext have "P,E,hp s' \<turnstile> e3 : T3" by(rule WTrt_hext_mono)
     ultimately show ?thesis using Val by(auto intro: WTrtCAS)
   qed
 next
   case (CASRed3 e s ta e' s' v D F v')
   consider (Null) "v = Null" | (Val) U C T' fm T2 T3 where 
     "T = Boolean" "class_type_of' U = \<lfloor>C\<rfloor>" "P \<turnstile> C has F:T' (fm) in D" "volatile fm"
     "P \<turnstile> T2 \<le> T'" "P,E,hp s \<turnstile> e : T3" "P \<turnstile> T3 \<le> T'"
     "typeof\<^bsub>hp s\<^esub> v = \<lfloor>U\<rfloor>" "typeof\<^bsub>hp s\<^esub> v' = \<lfloor>T2\<rfloor>"
     using CASRed3.prems(2) by auto
   then show ?case
   proof cases
     case Null
     then show ?thesis using CASRed3
       by(force dest: red_hext_incr intro: type_of_hext_type_of WTrtCASNT)
   next
     case Val
     from CASRed3.hyps(1) have hext: "hp s \<unlhd> hp s'" by(auto dest: red_hext_incr)
     with Val(8,9) have "typeof\<^bsub>hp s'\<^esub> v = \<lfloor>U\<rfloor>" "typeof\<^bsub>hp s'\<^esub> v' = \<lfloor>T2\<rfloor>"
       by(blast intro: type_of_hext_type_of)+
     moreover from CASRed3.hyps(2)[OF CASRed3.prems(1) Val(6) CASRed3.prems(3)] Val(7)
     obtain T3' where "P,E,hp s' \<turnstile> e' : T3'" "P \<turnstile> T3' \<le> T'" by(auto intro: widen_trans)
     ultimately show ?thesis using Val by(auto intro: WTrtCAS)
   qed
 next
   case CASNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (CallObj e s ta e' s' M es T E)
   have red: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>"
    and IH: "\<And>E T. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk>
                  \<Longrightarrow> \<exists>U. P,E,hp s' \<turnstile> e' : U \<and> P \<turnstile> U \<le> T"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> e\<bullet>M(es) : T"
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   \<comment> \<open>We distinguish if @{term e} has type @{term NT} or a Class type\<close>
   from wt show ?case
   proof(rule WTrt_elim_cases)
     fix T' C Ts meth D Us
     assume wte: "P,E,hp s \<turnstile> e : T'" and icto: "class_type_of' T' = \<lfloor>C\<rfloor>"
       and "method": "P \<turnstile> C sees M:Ts\<rightarrow>T = meth in D"
       and wtes: "P,E,hp s \<turnstile> es [:] Us" and subs: "P \<turnstile> Us [\<le>] Ts"
     obtain U where wte': "P,E,hp s' \<turnstile> e' : U" and UsubC: "P \<turnstile> U \<le> T'"
       using IH[OF conf wte tconf] by blast
     show ?thesis
     proof(cases "U = NT")
       case True
       moreover have "P,E,hp s' \<turnstile> es [:] Us"
         by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
       ultimately show ?thesis using wte' by(blast intro!:WTrtCallNT)
     next
       case False
       with icto UsubC obtain C'
         where icto': "class_type_of' U = \<lfloor>C'\<rfloor>" and "subclass": "P \<turnstile> C' \<preceq>\<^sup>* C"
         by(rule widen_is_class_type_of)
 
       obtain Ts' T' meth' D'
         where method': "P \<turnstile> C' sees M:Ts'\<rightarrow>T' = meth' in D'"
         and subs': "P \<turnstile> Ts [\<le>] Ts'" and sub': "P \<turnstile> T' \<le> T"
         using Call_lemma[OF "method" "subclass" wf] by fast
       have wtes': "P,E,hp s' \<turnstile> es [:] Us"
         by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
       show ?thesis using wtes' wte' icto' subs method' subs' sub' by(blast intro:widens_trans)
     qed
   next
     fix Ts
     assume "P,E,hp s \<turnstile> e:NT"
     hence "P,E,hp s' \<turnstile> e' : NT" using IH[OF conf _ tconf] by fastforce
     moreover
     fix Ts assume wtes: "P,E,hp s \<turnstile> es [:] Ts"
     have "P,E,hp s' \<turnstile> es [:] Ts"
       by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
     ultimately show ?thesis by(blast intro!:WTrtCallNT)
   qed
 next
   case (CallParams es s ta es' s' v M T E)
   have reds: "extTA,P,t \<turnstile> \<langle>es,s\<rangle> [-ta\<rightarrow>] \<langle>es',s'\<rangle>"
    and IH: "\<And>Ts E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> es [:] Ts; P,hp s \<turnstile> t \<surd>t\<rbrakk>
            \<Longrightarrow> \<exists>Ts'. P,E,hp s' \<turnstile> es' [:] Ts' \<and> P \<turnstile> Ts' [\<le>] Ts"
    and conf: "E \<turnstile> s \<surd>" and wt: "P,E,hp s \<turnstile> Val v\<bullet>M(es) : T" 
    and tconf: "P,hp s \<turnstile> t \<surd>t" by fact+
   from wt show ?case
   proof (rule WTrt_elim_cases)
     fix U C Ts meth D Us
     assume wte: "P,E,hp s \<turnstile> Val v : U" and icto: "class_type_of' U = \<lfloor>C\<rfloor>"
       and "P \<turnstile> C sees M:Ts\<rightarrow>T = meth in D"
       and wtes: "P,E,hp s \<turnstile> es [:] Us" and "P \<turnstile> Us [\<le>] Ts"
     moreover have "P,E,hp s' \<turnstile> Val v : U"
       by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
     moreover obtain Us' where "P,E,hp s' \<turnstile> es' [:] Us'" "P \<turnstile> Us' [\<le>] Us"
       using IH[OF conf wtes tconf] by blast
     ultimately show ?thesis by(fastforce intro:WTrtCall widens_trans)
   next
     fix Us
     assume null: "P,E,hp s \<turnstile> Val v : NT" and wtes: "P,E,hp s \<turnstile> es [:] Us"
     from null have "v = Null" by simp
     moreover
     obtain Us' where "P,E,hp s' \<turnstile> es' [:] Us' \<and> P \<turnstile> Us' [\<le>] Us"
       using IH[OF conf wtes tconf] by blast
     ultimately show ?thesis by(fastforce intro:WTrtCallNT)
   qed
 next
   case (RedCall s a U M Ts T pns body D vs T' E)
   have hp: "typeof_addr (hp s) a = \<lfloor>U\<rfloor>"
     and "method": "P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T = \<lfloor>(pns,body)\<rfloor> in D"
     and wt: "P,E,hp s \<turnstile> addr a\<bullet>M(map Val vs) : T'" by fact+
   obtain Ts' where wtes: "P,E,hp s \<turnstile> map Val vs [:] Ts'"
     and subs: "P \<turnstile> Ts' [\<le>] Ts" and T'isT: "T' = T"
     using wt "method" hp wf by(auto 4 3 dest: sees_method_fun)
   from wtes subs have length_vs: "length vs = length Ts"
     by(auto simp add: WTrts_conv_list_all2 dest!: list_all2_lengthD)
   have UsubD: "P \<turnstile> ty_of_htype U \<le> Class (class_type_of U)"
     by(cases U)(simp_all add: widen_array_object)
   from sees_wf_mdecl[OF wf "method"] obtain T''
     where wtabody: "P,[this#pns [\<mapsto>] Class D#Ts] \<turnstile> body :: T''"
     and T''subT: "P \<turnstile> T'' \<le> T" and length_pns: "length pns = length Ts"
     by(fastforce simp:wf_mdecl_def simp del:map_upds_twist)
   from wtabody have "P,Map.empty(this#pns [\<mapsto>] Class D#Ts),hp s \<turnstile> body : T''"
     by(rule WT_implies_WTrt)
   hence "P,E(this#pns [\<mapsto>] Class D#Ts),hp s \<turnstile> body : T''"
     by(rule WTrt_env_mono) simp
   hence "P,E,hp s \<turnstile> blocks (this#pns) (Class D#Ts) (Addr a#vs) body : T''"
     using wtes subs hp sees_method_decl_above[OF "method"] length_vs length_pns UsubD
     by(auto simp add:wt_blocks rel_list_all2_Cons2 intro: widen_trans)
   with T''subT T'isT show ?case by blast
 next
   case (RedCallExternal s a U M Ts T' D vs ta va h' ta' e' s')
   from \<open>P,t \<turnstile> \<langle>a\<bullet>M(vs),hp s\<rangle> -ta\<rightarrow>ext \<langle>va,h'\<rangle>\<close> have "hp s \<unlhd> h'" by(rule red_external_hext)
   with \<open>P,E,hp s \<turnstile> addr a\<bullet>M(map Val vs) : T\<close>
   have "P,E,h' \<turnstile> addr a\<bullet>M(map Val vs) : T" by(rule WTrt_hext_mono)
   moreover from \<open>typeof_addr (hp s) a = \<lfloor>U\<rfloor>\<close> \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>T' = Native in D\<close> \<open>P,E,hp s \<turnstile> addr a\<bullet>M(map Val vs) : T\<close>
   have "P,hp s \<turnstile> a\<bullet>M(vs) : T'"
     by(fastforce simp add: external_WT'_iff dest: sees_method_fun)
   ultimately show ?case using RedCallExternal
     by(auto 4 3 intro: red_external_conf_extRet[OF wf] intro!: wt_external_call simp add: sconf_def dest: sees_method_fun[where C="class_type_of U"])
 next
   case RedCallNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (BlockRed e h x V vo ta e' h' x' T T' E)
   note IH = \<open>\<And>T E. \<lbrakk>E \<turnstile> (h, x(V := vo)) \<surd>; P,E,hp (h, x(V := vo)) \<turnstile> e : T; P,hp (h, x(V := vo)) \<turnstile> t \<surd>t\<rbrakk>
              \<Longrightarrow> \<exists>T'. P,E,hp (h', x') \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T\<close>[simplified]
   from \<open>P,E,hp (h, x) \<turnstile> {V:T=vo; e} : T'\<close> have "P,E(V\<mapsto>T),h \<turnstile> e : T'" by(cases vo, auto)
   moreover from \<open>E \<turnstile> (h, x) \<surd>\<close> \<open>P,E,hp (h, x) \<turnstile> {V:T=vo; e} : T'\<close>
   have "(E(V \<mapsto> T)) \<turnstile> (h, x(V := vo)) \<surd>"
     by(cases vo)(simp add: lconf_def sconf_def,auto simp add: sconf_def conf_def intro: lconf_upd2)
   ultimately obtain T'' where wt': "P,E(V\<mapsto>T),h' \<turnstile> e' : T''" "P \<turnstile> T'' \<le> T'" using \<open>P,hp (h, x) \<turnstile> t \<surd>t\<close>
     by(auto dest: IH)
   { fix v
     assume vo: "x' V = \<lfloor>v\<rfloor>"
     from \<open>(E(V \<mapsto> T)) \<turnstile> (h, x(V := vo)) \<surd>\<close> \<open>extTA,P,t \<turnstile> \<langle>e,(h, x(V := vo))\<rangle> -ta\<rightarrow> \<langle>e',(h', x')\<rangle>\<close> \<open>P,E(V\<mapsto>T),h \<turnstile> e : T'\<close>
     have "P,h' \<turnstile> x' (:\<le>) (E(V \<mapsto> T))" by(auto simp add: sconf_def dest: red_preserves_lconf)
     with vo have "\<exists>T'. typeof\<^bsub>h'\<^esub> v = \<lfloor>T'\<rfloor> \<and> P \<turnstile> T' \<le> T" by(fastforce simp add: sconf_def lconf_def conf_def)
     then obtain T' where "typeof\<^bsub>h'\<^esub> v = \<lfloor>T'\<rfloor>" "P \<turnstile> T' \<le> T" by blast
     hence ?case using wt' vo by(auto) }
   moreover
   { assume "x' V = None" with wt' have ?case by(auto) }
   ultimately show ?case by blast
 next 
   case RedBlock thus ?case by auto
 next
   case (SynchronizedRed1 o' s ta o'' s' e T E)
   have red: "extTA,P,t \<turnstile> \<langle>o',s\<rangle> -ta\<rightarrow> \<langle>o'',s'\<rangle>" by fact
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> o' : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> o'' : T' \<and> P \<turnstile> T' \<le> T" by fact
   have conf: "E \<turnstile> s \<surd>" by fact
   have wt: "P,E,hp s \<turnstile> sync(o') e : T" by fact+
   thus ?case
   proof(rule WTrt_elim_cases)
     fix To
     assume wto: "P,E,hp s \<turnstile> o' : To"
       and refT: "is_refT To" 
       and wte: "P,E,hp s \<turnstile> e : T"
     from IH[OF conf wto \<open>P,hp s \<turnstile> t \<surd>t\<close>] obtain To' where "P,E,hp s' \<turnstile> o'' : To'" and sub: "P \<turnstile> To' \<le> To" by auto
     moreover have "P,E,hp s' \<turnstile> e : T"
       by(rule WTrt_hext_mono[OF wte red_hext_incr[OF red]])
     moreover have "is_refT To'" using refT sub by(auto intro: widen_refT)
     ultimately show ?thesis by(auto)
   qed
 next
   case SynchronizedNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case LockSynchronized thus ?case by(auto)
 next
   case (SynchronizedRed2 e s ta e' s' a T E)
   have red: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>" by fact
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T" by fact
   have conf: "E \<turnstile> s \<surd>" by fact
   have wt: "P,E,hp s \<turnstile> insync(a) e : T" by fact
   thus ?case
   proof(rule WTrt_elim_cases)
     fix Ta
     assume "P,E,hp s \<turnstile> e : T"
       and hpa: "typeof_addr (hp s) a = \<lfloor>Ta\<rfloor>"
     from \<open>P,E,hp s \<turnstile> e : T\<close> conf \<open>P,hp s \<turnstile> t \<surd>t\<close> obtain T'
       where "P,E,hp s' \<turnstile> e' : T'" "P \<turnstile> T' \<le> T" by(blast dest: IH)
     moreover from red have hext: "hp s \<unlhd> hp s'" by(auto dest: red_hext_incr)
     with hpa have "P,E,hp s' \<turnstile> addr a : ty_of_htype Ta"
       by(auto intro: typeof_addr_hext_mono)
     ultimately show ?thesis by auto
   qed
 next
   case UnlockSynchronized thus ?case by(auto)
 next
   case SeqRed thus ?case
     apply(auto)
     apply(drule WTrt_hext_mono[OF _ red_hext_incr], assumption)
     by auto
 next
   case (CondRed b s ta b' s' e1 e2 T E)
   have red: "extTA,P,t \<turnstile> \<langle>b,s\<rangle> -ta\<rightarrow> \<langle>b',s'\<rangle>" by fact
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> b : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> b' : T' \<and> P \<turnstile> T' \<le> T" by fact
   have conf: "E \<turnstile> s \<surd>" by fact
   have wt: "P,E,hp s \<turnstile> if (b) e1 else e2 : T" by fact
   thus ?case
   proof(rule WTrt_elim_cases)
     fix T1 T2
     assume wtb: "P,E,hp s \<turnstile> b : Boolean"
       and wte1: "P,E,hp s \<turnstile> e1 : T1"
       and wte2: "P,E,hp s \<turnstile> e2 : T2"
       and lub: "P \<turnstile> lub(T1, T2) = T"
     from IH[OF conf wtb \<open>P,hp s \<turnstile> t \<surd>t\<close>] have "P,E,hp s' \<turnstile> b' : Boolean" by(auto)
     moreover have "P,E,hp s' \<turnstile> e1 : T1"
       by(rule WTrt_hext_mono[OF wte1 red_hext_incr[OF red]])
     moreover have "P,E,hp s' \<turnstile> e2 : T2"
       by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
     ultimately show ?thesis using lub by auto
   qed
 next
   case (ThrowRed e s ta e' s' T E)
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T" by fact
   have conf: "E \<turnstile> s \<surd>" by fact
   have wt: "P,E,hp s \<turnstile> throw e : T" by fact
   then obtain T'
     where wte: "P,E,hp s \<turnstile> e : T'" 
     and nobject: "P \<turnstile> T' \<le> Class Throwable" by auto
   from IH[OF conf wte \<open>P,hp s \<turnstile> t \<surd>t\<close>] obtain T'' 
     where wte': "P,E,hp s' \<turnstile> e' : T''"
     and PT'T'': "P \<turnstile> T'' \<le> T'" by blast
   from nobject PT'T'' have "P \<turnstile> T'' \<le> Class Throwable"
     by(auto simp add: widen_Class)(erule notE, rule rtranclp_trans)
   hence "P,E,hp s' \<turnstile> throw e' : T" using wte' PT'T''
     by -(erule WTrtThrow)
   thus ?case by(auto)
 next
   case RedThrowNull thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case (TryRed e s ta e' s' C V e2 T E)
   have red: "extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>" by fact
   have IH: "\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T" by fact
   have conf: "E \<turnstile> s \<surd>" by fact
   have wt: "P,E,hp s \<turnstile> try e catch(C V) e2 : T" by fact
   thus ?case
   proof(rule WTrt_elim_cases)
     fix T1
     assume wte: "P,E,hp s \<turnstile> e : T1"
       and wte2: "P,E(V \<mapsto> Class C),hp s \<turnstile> e2 : T"
       and sub: "P \<turnstile> T1 \<le> T"
     from IH[OF conf wte \<open>P,hp s \<turnstile> t \<surd>t\<close>] obtain T1' where "P,E,hp s' \<turnstile> e' : T1'" and "P \<turnstile> T1' \<le> T1" by(auto)
     moreover have "P,E(V \<mapsto> Class C),hp s' \<turnstile> e2 : T"
       by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
     ultimately show ?thesis using sub by(auto elim: widen_trans)
   qed
 next
   case RedTryFail thus ?case unfolding sconf_def
     by(fastforce simp add: xcpt_subcls_Throwable[OF _ wf])
 next
   case RedSeq thus ?case by auto
 next
   case RedCondT thus ?case by(auto dest: is_lub_upper)
 next
   case RedCondF thus ?case by(auto dest: is_lub_upper)
 next
   case RedWhile thus ?case by(fastforce) 
 next
   case RedTry thus ?case by auto
 next
   case RedTryCatch thus ?case by(fastforce)
 next
   case (ListRed1 e s ta e' s' es Ts E)
   note IH = \<open>\<And>T E. \<lbrakk>E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e : T; P,hp s \<turnstile> t \<surd>t\<rbrakk> \<Longrightarrow> \<exists>T'. P,E,hp s' \<turnstile> e' : T' \<and> P \<turnstile> T' \<le> T\<close>
   from \<open>P,E,hp s \<turnstile> e # es [:] Ts\<close> obtain T Ts' where "Ts = T # Ts'" "P,E,hp s \<turnstile> e : T" "P,E,hp s \<turnstile> es [:] Ts'" by auto
   with IH[of E T] \<open>E \<turnstile> s \<surd>\<close> WTrts_hext_mono[OF \<open>P,E,hp s \<turnstile> es [:] Ts'\<close> red_hext_incr[OF \<open>extTA,P,t \<turnstile> \<langle>e,s\<rangle> -ta\<rightarrow> \<langle>e',s'\<rangle>\<close>]]
   show ?case using \<open>P,hp s \<turnstile> t \<surd>t\<close> by(auto simp add: list_all2_Cons2 intro: widens_refl)
 next
   case ListRed2 thus ?case
     by(fastforce dest: hext_typeof_mono[OF reds_hext_incr])
 qed(fastforce)+
 
 end
diff --git a/thys/JinjaThreads/MM/DRF_J.thy b/thys/JinjaThreads/MM/DRF_J.thy
--- a/thys/JinjaThreads/MM/DRF_J.thy
+++ b/thys/JinjaThreads/MM/DRF_J.thy
@@ -1,1093 +1,1093 @@
 (*  Title:      JinjaThreads/MM/DRF_J.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>JMM Instantiation for J\<close>
 
 theory DRF_J
 imports
   JMM_Common
   JMM_J
   "../J/ProgressThreaded"
   SC_Legal
 begin
 
 primrec ka :: "'addr expr \<Rightarrow> 'addr set"
   and kas :: "'addr expr list \<Rightarrow> 'addr set"
 where 
   "ka (new C) = {}"
 | "ka (newA T\<lfloor>e\<rceil>) = ka e"
 | "ka (Cast T e) = ka e"
 | "ka (e instanceof T) = ka e"
 | "ka (Val v) = ka_Val v"
 | "ka (Var V) = {}"
 | "ka (e1 \<guillemotleft>bop\<guillemotright> e2) = ka e1 \<union> ka e2"
 | "ka (V := e) = ka e"
 | "ka (a\<lfloor>e\<rceil>) = ka a \<union> ka e"
 | "ka (a\<lfloor>e\<rceil> := e') = ka a \<union> ka e \<union> ka e'"
 | "ka (a\<bullet>length) = ka a"
 | "ka (e\<bullet>F{D}) = ka e"
 | "ka (e\<bullet>F{D} := e') = ka e \<union> ka e'"
 | "ka (e\<bullet>compareAndSwap(D\<bullet>F, e', e'')) = ka e \<union> ka e' \<union> ka e''"
 | "ka (e\<bullet>M(es)) = ka e \<union> kas es"
 | "ka {V:T=vo; e} = ka e \<union> (case vo of None \<Rightarrow> {} | Some v \<Rightarrow> ka_Val v)"
 | "ka (Synchronized x e e') = ka e \<union> ka e'"
 | "ka (InSynchronized x a e) = insert a (ka e)"
 | "ka (e;; e') = ka e \<union> ka e'"
 | "ka (if (e) e1 else e2) = ka e \<union> ka e1 \<union> ka e2"
 | "ka (while (b) e) = ka b \<union> ka e"
 | "ka (throw e) = ka e"
 | "ka (try e catch(C V) e') = ka e \<union> ka e'"
 
 | "kas [] = {}"
 | "kas (e # es) = ka e \<union> kas es" 
 
 definition ka_locals :: "'addr locals \<Rightarrow> 'addr set"
 where "ka_locals xs = {a. Addr a \<in> ran xs}"
 
 lemma ka_Val_subset_ka_locals:
   "xs V = \<lfloor>v\<rfloor> \<Longrightarrow> ka_Val v \<subseteq> ka_locals xs"
 by(cases v)(auto simp add: ka_locals_def ran_def)
 
 lemma ka_locals_update_subset: 
   "ka_locals (xs(V := None)) \<subseteq> ka_locals xs"
   "ka_locals (xs(V \<mapsto> v)) \<subseteq> ka_Val v \<union> ka_locals xs"
 by(auto simp add: ka_locals_def ran_def)
 
 lemma ka_locals_empty [simp]: "ka_locals Map.empty = {}"
 by(simp add: ka_locals_def)
 
 lemma kas_append [simp]: "kas (es @ es') = kas es \<union> kas es'"
 by(induct es) auto
 
 lemma kas_map_Val [simp]: "kas (map Val vs) = \<Union>(ka_Val ` set vs)"
 by(induct vs) auto
 
 lemma ka_blocks:
   "\<lbrakk> length pns = length Ts; length vs = length Ts \<rbrakk> 
   \<Longrightarrow> ka (blocks pns Ts vs body) = \<Union>(ka_Val ` set vs) \<union> ka body"
 by(induct pns Ts vs body rule: blocks.induct)(auto)
 
 lemma WT_ka: "P,E \<turnstile> e :: T \<Longrightarrow> ka e = {}"
   and WTs_kas: "P,E \<turnstile> es [::] Ts \<Longrightarrow> kas es = {}"
 by(induct rule: WT_WTs.inducts)(auto simp add: typeof_ka)
 
 context J_heap_base begin
 
 primrec J_known_addrs :: "'thread_id \<Rightarrow> 'addr expr \<times> 'addr locals \<Rightarrow> 'addr set"
 where "J_known_addrs t (e, xs) = insert (thread_id2addr t) (ka e \<union> ka_locals xs \<union> set start_addrs)"
 
 lemma assumes wf: "wf_J_prog P" 
   and ok: "start_heap_ok"
   shows red_known_addrs_mono:
   "P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle> \<Longrightarrow> J_known_addrs t (e', lcl s') \<subseteq> J_known_addrs t (e, lcl s) \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and reds_known_addrs_mono:
   "P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle> \<Longrightarrow> kas es' \<union> ka_locals (lcl s') \<subseteq> insert (thread_id2addr t) (kas es \<union> ka_locals (lcl s)) \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<union> set start_addrs"
 proof(induct rule: red_reds.inducts)
   case RedVar thus ?case by(auto dest: ka_Val_subset_ka_locals)
 next
   case RedLAss thus ?case by(auto simp add: ka_locals_def ran_def)
 next
   case RedBinOp thus ?case by(auto dest: binop_known_addrs[OF ok])
 next
   case RedBinOpFail thus ?case by(auto dest: binop_known_addrs[OF ok])
 next
   case RedCall thus ?case
     by(auto simp add: ka_blocks new_obs_addrs_def wf_mdecl_def dest!: sees_wf_mdecl[OF wf] WT_ka)
 next
   case (RedCallExternal s a T M Ts T D vs ta va h') thus ?case
     by(cases va)(auto dest!: red_external_known_addrs_mono[OF ok])
 next
   case (BlockRed e h l V vo ta e' h' l')
   thus ?case using ka_locals_update_subset[where xs = l and V=V] ka_locals_update_subset[where xs = l' and V=V]
     apply(cases "l V")
     apply(auto simp del: fun_upd_apply del: subsetI)
     apply(blast dest: ka_Val_subset_ka_locals)+
     done
 qed(simp_all add: new_obs_addrs_def addr_of_sys_xcpt_start_addr[OF ok] subset_Un1 subset_Un2 subset_insert ka_Val_subset_new_obs_Addr_ReadMem ka_blocks del: fun_upd_apply, blast+)
 
 lemma red_known_addrs_ReadMem:
   "\<lbrakk> P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> \<Longrightarrow> ad \<in> J_known_addrs t (e, lcl s)"
   and reds_known_addrss_ReadMem:
   "\<lbrakk> P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> insert (thread_id2addr t) (kas es \<union> ka_locals (lcl s)) \<union> set start_addrs"
 proof(induct rule: red_reds.inducts)
   case RedCallExternal thus ?case by simp (blast dest: red_external_known_addrs_ReadMem)
 next
   case (BlockRed e h l V vo ta e' h' l')
   thus ?case using ka_locals_update_subset[where xs = l and V=V] ka_locals_update_subset[where xs = l' and V=V]
     by(auto simp del: fun_upd_apply)
 qed(simp_all, blast+)
 
 lemma red_known_addrs_WriteMem:
   "\<lbrakk> P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a \<in> J_known_addrs t (e, lcl s) \<or> a \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   and reds_known_addrss_WriteMem:
   "\<lbrakk> P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a \<in> insert (thread_id2addr t) (kas es \<union> ka_locals (lcl s)) \<union> set start_addrs \<union> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 proof(induct rule: red_reds.inducts)
   case RedCASSucceed thus ?case by(auto simp add: nth_Cons split: nat.split_asm)
 next
   case RedCallExternal thus ?case by simp (blast dest: red_external_known_addrs_WriteMem)
 next                                                            
   case (BlockRed e h l V vo ta e' h' l')
   thus ?case using ka_locals_update_subset[where xs = l and V=V] ka_locals_update_subset[where xs = l' and V=V]
     by(auto simp del: fun_upd_apply)
 qed(simp_all, blast+)
 
 end
 
 context J_heap begin
 
 lemma
   assumes wf: "wf_J_prog P" 
   and ok: "start_heap_ok"
   shows red_known_addrs_new_thread:
   "\<lbrakk> P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; NewThread t' x' h' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> J_known_addrs t' x' \<subseteq> J_known_addrs t (e, lcl s)"
   and reds_known_addrss_new_thread:
   "\<lbrakk> P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; NewThread t' x' h' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> J_known_addrs t' x' \<subseteq> insert (thread_id2addr t) (kas es \<union> ka_locals (lcl s) \<union> set start_addrs)"
 proof(induct rule: red_reds.inducts)
   case RedCallExternal thus ?case
     apply clarsimp
     apply(frule (1) red_external_new_thread_sub_thread)
     apply(frule (1) red_external_NewThread_idD)
     apply clarsimp
     
     apply(drule (1) addr2thread_id_inverse)
     apply simp
     apply(drule sub_Thread_sees_run[OF wf])
     apply clarsimp
     apply(auto 4 4 dest: sees_wf_mdecl[OF wf] WT_ka simp add: wf_mdecl_def)
     done
 next
   case (BlockRed e h l V vo ta e' h' l')
   thus ?case using ka_locals_update_subset[where xs = l and V=V] ka_locals_update_subset[where xs = l' and V=V]
     by(cases "l V")(auto simp del: fun_upd_apply)
 qed(simp_all, blast+)
 
 lemma red_New_same_addr_same:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
   and reds_New_same_addr_same:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 apply(induct rule: red_reds.inducts)
 apply(auto dest: red_external_New_same_addr_same simp add: nth_Cons split: nat.split_asm)
 done
 
 end
 
 locale J_allocated_heap = allocated_heap +
   constrains addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and P :: "'addr J_prog"
 
 sublocale J_allocated_heap < J_heap
 by(unfold_locales)
 
 context J_allocated_heap begin
 
 lemma red_allocated_mono: "P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle> \<Longrightarrow> allocated (hp s) \<subseteq> allocated (hp s')"
   and reds_allocated_mono: "P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle> \<Longrightarrow> allocated (hp s) \<subseteq> allocated (hp s')"
 by(induct rule: red_reds.inducts)(auto dest: allocate_allocatedD heap_write_allocated_same red_external_allocated_mono del: subsetI)
 
 lemma red_allocatedD:
   "\<lbrakk> P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> \<Longrightarrow> ad \<in> allocated (hp s') \<and> ad \<notin> allocated (hp s)"
   and reds_allocatedD:
   "\<lbrakk> P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> \<Longrightarrow> ad \<in> allocated (hp s') \<and> ad \<notin> allocated (hp s)"
 by(induct rule: red_reds.inducts)(auto dest: allocate_allocatedD heap_write_allocated_same red_external_allocatedD)
 
 lemma red_allocated_NewHeapElemD:
   "\<lbrakk> P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; ad \<in> allocated (hp s'); ad \<notin> allocated (hp s) \<rbrakk> \<Longrightarrow> \<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and reds_allocated_NewHeapElemD:
   "\<lbrakk> P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; ad \<in> allocated (hp s'); ad \<notin> allocated (hp s) \<rbrakk> \<Longrightarrow> \<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 by(induct rule: red_reds.inducts)(auto dest: allocate_allocatedD heap_write_allocated_same red_external_NewHeapElemD)
 
 lemma mred_allocated_multithreaded:
   "allocated_multithreaded addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated final_expr (mred P) P"
 proof
   fix t x m ta x' m'
   assume "mred P t (x, m) ta (x', m')"
   thus "allocated m \<subseteq> allocated m'"
     by(auto dest: red_allocated_mono del: subsetI simp add: split_beta)
 next
   fix x t m ta x' m' ad CTn
   assume "mred P t (x, m) ta (x', m')"
     and "NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad \<in> allocated m' \<and> ad \<notin> allocated m"
     by(auto dest: red_allocatedD simp add: split_beta)
 next
   fix t x m ta x' m' ad
   assume "mred P t (x, m) ta (x', m')"
     and "ad \<in> allocated m'" "ad \<notin> allocated m"
   thus "\<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     by(auto dest: red_allocated_NewHeapElemD simp add: split_beta)
 next
   fix t x m ta x' m' i a CTn j CTn'
   assume "mred P t (x, m) ta (x', m')"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a CTn" "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a CTn'" "j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "i = j" by(auto dest: red_New_same_addr_same simp add: split_beta)
 qed
 
 end
 
 sublocale J_allocated_heap < red_mthr: allocated_multithreaded 
   addr2thread_id thread_id2addr 
   spurious_wakeups
   empty_heap allocate typeof_addr heap_read heap_write allocated 
   final_expr "mred P" 
   P
 by(rule mred_allocated_multithreaded)
 
 context J_allocated_heap begin
 
 lemma mred_known_addrs: 
   assumes wf: "wf_J_prog P"
   and ok: "start_heap_ok"
   shows "known_addrs addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated J_known_addrs final_expr (mred P) P"
 proof
   fix t x m ta x' m'
   assume "mred P t (x, m) ta (x', m')"
   thus "J_known_addrs t x' \<subseteq> J_known_addrs t x \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     by(auto del: subsetI simp add: split_beta dest: red_known_addrs_mono[OF wf ok])
 next
   fix t x m ta x' m' t' x'' m''
   assume "mred P t (x, m) ta (x', m')"
     and "NewThread t' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
   thus "J_known_addrs t' x'' \<subseteq> J_known_addrs t x"
     by(auto del: subsetI simp add: split_beta dest: red_known_addrs_new_thread[OF wf ok])
 next
   fix t x m ta x' m' ad al v
   assume "mred P t (x, m) ta (x', m')"
     and "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad \<in> J_known_addrs t x"
     by(auto simp add: split_beta dest: red_known_addrs_ReadMem)
 next
   fix t x m ta x' m' n ad al ad'
   assume "mred P t (x, m) ta (x', m')"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr ad')" "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad' \<in> J_known_addrs t x \<or> ad' \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     by(auto simp add: split_beta dest: red_known_addrs_WriteMem)
 qed
 
 end
 
 
 context J_heap begin
 
 lemma red_read_typeable:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; P,E,hp s \<turnstile> e : T; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> 
   \<Longrightarrow> \<exists>T'. P,hp s \<turnstile> ad@al : T'"
   and reds_read_typeable:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> 
   \<Longrightarrow> \<exists>T'. P,hp s \<turnstile> ad@al : T'"
 proof(induct arbitrary: E T and E Ts rule: red_reds.inducts)
   case RedAAcc thus ?case
-    by(fastforce intro: addr_loc_type.intros simp add: nat_less_iff word_sle_def)
+    by(fastforce intro: addr_loc_type.intros simp add: nat_less_iff word_sle_eq)
 next
   case RedFAcc thus ?case
     by(fastforce intro: addr_loc_type.intros)
 next
   case RedCASSucceed thus ?case
     by(fastforce intro: addr_loc_type.intros)
 next
   case RedCASFail thus ?case
     by(fastforce intro: addr_loc_type.intros)
 next
   case RedCallExternal thus ?case
     by(auto intro: red_external_read_mem_typeable)
 qed auto
 
 end
 
 primrec new_types :: "('a, 'b, 'addr) exp \<Rightarrow> ty set"
   and new_typess :: "('a, 'b, 'addr) exp list \<Rightarrow> ty set"
 where 
   "new_types (new C) = {Class C}"
 | "new_types (newA T\<lfloor>e\<rceil>) = insert (T\<lfloor>\<rceil>) (new_types e)"
 | "new_types (Cast T e) = new_types e"
 | "new_types (e instanceof T) = new_types e"
 | "new_types (Val v) = {}"
 | "new_types (Var V) = {}"
 | "new_types (e1 \<guillemotleft>bop\<guillemotright> e2) = new_types e1 \<union> new_types e2"
 | "new_types (V := e) = new_types e"
 | "new_types (a\<lfloor>e\<rceil>) = new_types a \<union> new_types e"
 | "new_types (a\<lfloor>e\<rceil> := e') = new_types a \<union> new_types e \<union> new_types e'"
 | "new_types (a\<bullet>length) = new_types a"
 | "new_types (e\<bullet>F{D}) = new_types e"
 | "new_types (e\<bullet>F{D} := e') = new_types e \<union> new_types e'"
 | "new_types (e\<bullet>compareAndSwap(D\<bullet>F, e', e'')) = new_types e \<union> new_types e' \<union> new_types e''"
 | "new_types (e\<bullet>M(es)) = new_types e \<union> new_typess es"
 | "new_types {V:T=vo; e} = new_types e"
 | "new_types (Synchronized x e e') = new_types e \<union> new_types e'"
 | "new_types (InSynchronized x a e) = new_types e"
 | "new_types (e;; e') = new_types e \<union> new_types e'"
 | "new_types (if (e) e1 else e2) = new_types e \<union> new_types e1 \<union> new_types e2"
 | "new_types (while (b) e) = new_types b \<union> new_types e"
 | "new_types (throw e) = new_types e"
 | "new_types (try e catch(C V) e') = new_types e \<union> new_types e'"
 
 | "new_typess [] = {}"
 | "new_typess (e # es) = new_types e \<union> new_typess es"
 
 lemma new_types_blocks:
   "\<lbrakk> length pns = length Ts; length vs = length Ts \<rbrakk> \<Longrightarrow> new_types (blocks pns vs Ts e) = new_types e"
 apply(induct rule: blocks.induct)
 apply(simp_all)
 done
 
 context J_heap_base begin
 
 lemma WTrt_new_types_types: "P,E,h \<turnstile> e : T \<Longrightarrow> new_types e \<subseteq> types P"
   and WTrts_new_typess_types: "P,E,h \<turnstile> es [:] Ts \<Longrightarrow> new_typess es \<subseteq> types P"
 by(induct rule: WTrt_WTrts.inducts) simp_all
 
 end
 
 lemma WT_new_types_types: "P,E \<turnstile> e :: T \<Longrightarrow> new_types e \<subseteq> types P"
   and WTs_new_typess_types: "P,E \<turnstile> es [::] Ts \<Longrightarrow> new_typess es \<subseteq> types P"
 by(induct rule: WT_WTs.inducts) simp_all
 
 context J_heap_conf begin
 
 lemma red_New_typeof_addrD:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; new_types e \<subseteq> types P; hconf (hp s); NewHeapElem a x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> typeof_addr (hp s') a = Some x"
   and reds_New_typeof_addrD:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; new_typess es \<subseteq> types P; hconf (hp s); NewHeapElem a x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> typeof_addr (hp s') a = Some x"
 apply(induct rule: red_reds.inducts)
 apply(auto dest: allocate_SomeD red_external_New_typeof_addrD)
 done
 
 lemma J_conf_read_heap_read_typed:
   "J_conf_read addr2thread_id thread_id2addr empty_heap allocate typeof_addr (heap_read_typed P) heap_write hconf P"
 proof -
   interpret conf: heap_conf_read
     addr2thread_id thread_id2addr 
     spurious_wakeups
     empty_heap allocate typeof_addr "heap_read_typed P" heap_write hconf 
     P
     by(rule heap_conf_read_heap_read_typed)
   show ?thesis by(unfold_locales)
 qed
 
 lemma red_non_speculative_vs_conf:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; P,E,hp s \<turnstile> e : T;
     non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))); vs_conf P (hp s) vs; hconf (hp s) \<rbrakk>
   \<Longrightarrow> vs_conf P (hp s') (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   and reds_non_speculative_vs_conf:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts;
     non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))); vs_conf P (hp s) vs; hconf (hp s) \<rbrakk>
   \<Longrightarrow> vs_conf P (hp s') (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 proof(induct arbitrary: E T and E Ts rule: red_reds.inducts)
   case (RedAAss h a U n i w V h' xs)
   from \<open>sint i < int n\<close> \<open>0 <=s i\<close> have "nat (sint i) < n"
-    by (metis nat_less_iff sint_0 word_sle_def)
+    by (simp add: word_sle_eq nat_less_iff)
   with \<open>typeof_addr h a = \<lfloor>Array_type U n\<rfloor>\<close> have "P,h \<turnstile> a@ACell (nat (sint i)) : U"
     by(auto intro: addr_loc_type.intros)
   moreover from \<open>heap_write h a (ACell (nat (sint i))) w h'\<close> have "h \<unlhd> h'" by(rule hext_heap_write)
   ultimately have "P,h' \<turnstile> a@ACell (nat (sint i)) : U" by(rule addr_loc_type_hext_mono)
   moreover from \<open>typeof\<^bsub>h\<^esub> w = \<lfloor>V\<rfloor>\<close> \<open>P \<turnstile> V \<le> U\<close> have "P,h \<turnstile> w :\<le> U" by(simp add: conf_def)
   with \<open>h \<unlhd> h'\<close> have "P,h' \<turnstile> w :\<le> U" by(rule conf_hext)
   ultimately have "\<exists>T. P,h' \<turnstile> a@ACell (nat (sint i)) : T \<and> P,h' \<turnstile> w :\<le> T" by blast 
   thus ?case using RedAAss
     by(auto intro!: vs_confI split: if_split_asm dest: vs_confD simp add: take_Cons')(blast dest: vs_confD hext_heap_write intro: addr_loc_type_hext_mono conf_hext)+
 next
   case (RedFAss h e D F v h' xs)
   hence "\<exists>T. P,h' \<turnstile> e@CField D F : T \<and> P,h' \<turnstile> v :\<le> T"
     by(force dest!: hext_heap_write intro!: addr_loc_type.intros intro: typeof_addr_hext_mono type_of_hext_type_of simp add: conf_def)
   thus ?case using RedFAss
     by(auto intro!: vs_confI simp add: take_Cons' split: if_split_asm dest: vs_confD)(blast dest: vs_confD hext_heap_write intro: addr_loc_type_hext_mono conf_hext)+
 next
   case (RedCASSucceed h a D F v v' h' l)
   hence "\<exists>T. P,h' \<turnstile> a@CField D F : T \<and> P,h' \<turnstile> v' :\<le> T"
     by(force dest!: hext_heap_write intro!: addr_loc_type.intros intro: typeof_addr_hext_mono type_of_hext_type_of simp add: conf_def take_Cons')
   thus ?case using RedCASSucceed
     by(auto simp add: take_Cons' split: if_split_asm dest: vs_confD intro!: vs_confI)
       (blast dest: vs_confD hext_heap_write intro: addr_loc_type_hext_mono conf_hext)+
 next
   case RedCallExternal thus ?case by(auto intro: red_external_non_speculative_vs_conf)
 qed(auto dest: vs_conf_allocate hext_allocate intro: vs_conf_hext simp add: take_Cons')
 
 lemma red_non_speculative_typeable:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>e, s\<rangle> -ta\<rightarrow> \<langle>e', s'\<rangle>; P,E,hp s \<turnstile> e : T;
     non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)); vs_conf P (hp s) vs; hconf (hp s) \<rbrakk>
   \<Longrightarrow> J_heap_base.red addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write (convert_extTA extTA) P t e s ta e' s'"
   and reds_non_speculative_typeable:
   "\<lbrakk> convert_extTA extTA,P,t \<turnstile> \<langle>es, s\<rangle> [-ta\<rightarrow>] \<langle>es', s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts;
     non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)); vs_conf P (hp s) vs; hconf (hp s) \<rbrakk>
   \<Longrightarrow> J_heap_base.reds addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write (convert_extTA extTA) P t es s ta es' s'"
 proof(induct arbitrary: E T and E Ts rule: red_reds.inducts)
   case RedCall thus ?case by(blast intro: J_heap_base.red_reds.RedCall)
 next
   case RedCallExternal thus ?case
     by(auto intro: J_heap_base.red_reds.RedCallExternal red_external_non_speculative_typeable)
 qed(auto intro: J_heap_base.red_reds.intros intro!: heap_read_typedI dest: vs_confD addr_loc_type_fun)
 
 end
 
 sublocale J_heap_base < red_mthr: 
   if_multithreaded
     final_expr
     "mred P"
     convert_RA
   for P
 by(unfold_locales)
 
 
 locale J_allocated_heap_conf = 
   J_heap_conf 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     P
   +
   J_allocated_heap 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     allocated
     P
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and allocated :: "'heap \<Rightarrow> 'addr set"
   and P :: "'addr J_prog"
 begin
 
 lemma mred_known_addrs_typing:
   assumes wf: "wf_J_prog P"
   and ok: "start_heap_ok"
   shows "known_addrs_typing addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated J_known_addrs final_expr (mred P) (\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h) P"
 proof -
   interpret known_addrs
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated J_known_addrs
     final_expr "mred P" P
     using wf ok by(rule mred_known_addrs)
   
   show ?thesis
   proof
     fix t x m ta x' m'
     assume "mred P t (x, m) ta (x', m')"
     thus "m \<unlhd> m'" by(auto dest: red_hext_incr simp add: split_beta)
   next
     fix t x m ta x' m' vs
     assume red: "mred P t (x, m) ta (x', m')"
       and ts_ok: "\<exists>ET. sconf_type_ok ET t x m"
       and vs: "vs_conf P m vs"
       and ns: "non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
     
     let ?mred = "J_heap_base.mred addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write P"
 
     have lift: "lifting_inv final_expr ?mred sconf_type_ok"
       by(intro J_conf_read.lifting_inv_sconf_subject_ok J_conf_read_heap_read_typed wf)
     moreover
     from ts_ok obtain ET where type: "sconf_type_ok ET t x m" ..
     with red vs ns have red': "?mred t (x, m) ta (x', m')"
       by(auto simp add: split_beta sconf_type_ok_def sconf_def type_ok_def dest: red_non_speculative_typeable)
     ultimately have "sconf_type_ok ET t x' m'" using type
       by(rule lifting_inv.invariant_red[where r="?mred"])
     thus "\<exists>ET. sconf_type_ok ET t x' m'" ..
     { fix t'' x'' m''
       assume New: "NewThread t'' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
       with red have "m'' = snd (x', m')" by(rule red_mthr.new_thread_memory)
       with lift red' type New
       show "\<exists>ET. sconf_type_ok ET t'' x'' m''"
         by-(rule lifting_inv.invariant_NewThread[where r="?mred"], simp_all) }
     { fix t'' x''
       assume "\<exists>ET. sconf_type_ok ET t'' x'' m"
       with lifting_inv.invariant_other[where r="?mred", OF lift red' type]
       show "\<exists>ET. sconf_type_ok ET t'' x'' m'" by blast }
   next
     fix t x m ta x' m' vs n
     assume red: "mred P t (x, m) ta (x', m')"
       and ts_ok: "\<exists>ET. sconf_type_ok ET t x m"
       and vs: "vs_conf P m vs"
       and ns: "non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
     thus "vs_conf P m' (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
       by(cases x)(auto dest: red_non_speculative_vs_conf simp add: sconf_type_ok_def type_ok_def sconf_def)
   next
     fix t x m ta x' m' ad al v
     assume "mred P t (x, m) ta (x', m')"
       and "\<exists>ET. sconf_type_ok ET t x m"
       and "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     thus "\<exists>T. P,m \<turnstile> ad@al : T"
       by(fastforce simp add: sconf_type_ok_def type_ok_def sconf_def split_beta dest: red_read_typeable)
   next
     fix t x m ta x' m' ad hT
     assume "mred P t (x, m) ta (x', m')"
       and "\<exists>ET. sconf_type_ok ET t x m"
       and "NewHeapElem ad hT \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     thus "typeof_addr m' ad = \<lfloor>hT\<rfloor>"
       by(auto dest: red_New_typeof_addrD[where x="hT"] dest!: WTrt_new_types_types simp add: split_beta sconf_type_ok_def sconf_def type_ok_def)
   qed
 qed
 
 end
 
 context J_allocated_heap_conf begin
 
 lemma executions_sc:
   assumes wf: "wf_J_prog P"
   and wf_start: "wf_start_state P C M vs"
   and vs2: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "executions_sc_hb (J_\<E> P C M vs status) P"
   (is "executions_sc_hb ?E P")
 proof -
   from wf_start obtain Ts T pns body D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>(pns, body)\<rfloor> in D"
     and vs1: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases auto
   
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated J_known_addrs
     final_expr "mred P" "\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h" P
     using wf ok by(rule mred_known_addrs_typing)
   
   from wf_prog_wf_syscls[OF wf] J_start_state_sconf_type_ok[OF wf wf_start]
   show ?thesis
   proof(rule executions_sc_hb)
     from wf sees have "wf_mdecl wf_J_mdecl P D (M, Ts, T, \<lfloor>(pns, body)\<rfloor>)" by(rule sees_wf_mdecl)
     then obtain T' where len1: "length pns = length Ts" and wt: "P,[this\<mapsto>Class D,pns [\<mapsto>] Ts] \<turnstile> body :: T'"
       by(auto simp add: wf_mdecl_def)
     from vs1 have len2: "length vs = length Ts" by(rule list_all2_lengthD)
     show "J_known_addrs start_tid ((\<lambda>(pns, body) vs. (blocks (this # pns) (Class (fst (method P C M)) # fst (snd (method P C M))) (Null # vs) body, Map.empty)) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
       using sees vs2 len1 len2 WT_ka[OF wt]
       by(auto simp add: split_beta start_addrs_allocated ka_blocks intro: start_tid_start_addrs[OF wf_prog_wf_syscls[OF wf] ok])
   qed
 qed
 
 end
 
 declare split_paired_Ex [simp del]
 
 context J_progress begin
 
 lemma ex_WTrt_simps:
   "P,E,h \<turnstile> e : T \<Longrightarrow> \<exists>E T. P,E,h \<turnstile> e : T"
 by blast
 
 abbreviation (input) J_non_speculative_read_bound :: nat
   where "J_non_speculative_read_bound \<equiv> 2"
 
 lemma assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P (shr s) vs"
   and hconf: "hconf (shr s)"
   shows red_non_speculative_read:
   "\<lbrakk> P,t \<turnstile> \<langle>e, (shr s, xs)\<rangle> -ta\<rightarrow> \<langle>e', (h', xs')\<rangle>; \<exists>E T. P,E,shr s \<turnstile> e : T;
     red_mthr.mthr.if.actions_ok s t ta; 
     I < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v; v' \<in> w_values P vs (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'');
     non_speculative P vs (llist_of (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))) \<rbrakk>
   \<Longrightarrow> \<exists>ta' e'' xs'' h''. P,t \<turnstile> \<langle>e, (shr s, xs)\<rangle> -ta'\<rightarrow> \<langle>e'', (h'', xs'')\<rangle> \<and> 
            red_mthr.mthr.if.actions_ok s t ta' \<and> 
            I < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
            \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v' \<and> length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max J_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
   and reds_non_speculative_read:
   "\<lbrakk> P,t \<turnstile> \<langle>es, (shr s, xs)\<rangle> [-ta\<rightarrow>] \<langle>es', (h', xs')\<rangle>; \<exists>E Ts. P,E,shr s \<turnstile> es [:] Ts;
      red_mthr.mthr.if.actions_ok s t ta;
     I < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v; v' \<in> w_values P vs (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'');
     non_speculative P vs (llist_of (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))) \<rbrakk>
   \<Longrightarrow> \<exists>ta' es'' xs'' h''. P,t \<turnstile> \<langle>es, (shr s, xs)\<rangle> [-ta'\<rightarrow>] \<langle>es'', (h'', xs'')\<rangle> \<and> 
            red_mthr.mthr.if.actions_ok s t ta' \<and> 
            I < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
            \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v' \<and> length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max J_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 proof(induct e hxs\<equiv>"(shr s, xs)" ta e' hxs'\<equiv>"(h', xs')" 
         and es hxs\<equiv>"(shr s, xs)" ta es' hxs'\<equiv>"(h', xs')"
       arbitrary: xs xs' and xs xs' rule: red_reds.inducts)
   case (RedAAcc a U n i v e)
   hence [simp]: "I = 0" "al'' = ACell (nat (sint i))" "a'' = a" 
     and v': "v' \<in> vs (a, ACell (nat (sint i)))" by simp_all
   from RedAAcc have adal: "P,shr s \<turnstile> a@ACell (nat (sint i)) : U"
-    by(auto intro: addr_loc_type.intros simp add: nat_less_iff word_sle_def)
+    by(auto intro: addr_loc_type.intros simp add: nat_less_iff word_sle_eq)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> U" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   with hrt adal have "heap_read (shr s) a (ACell (nat (sint i))) v'" using hconf by(rule heap_read_typeableD)
   with \<open>typeof_addr (shr s) a = \<lfloor>Array_type U n\<rfloor>\<close> \<open>0 <=s i\<close> \<open>sint i < int n\<close> 
     \<open>red_mthr.mthr.if.actions_ok s t \<lbrace>ReadMem a (ACell (nat (sint i))) v\<rbrace>\<close>
   show ?case by(fastforce intro: red_reds.RedAAcc)
 next
   case (RedFAcc a D F v)
   hence [simp]: "I = 0" "al'' = CField D F" "a'' = a"
     and v': "v' \<in> vs (a, CField D F)" by simp_all
   from RedFAcc obtain E T where "P,E,shr s \<turnstile> addr a\<bullet>F{D} : T" by blast
   with RedFAcc have adal: "P,shr s \<turnstile> a@CField D F : T" by(auto 4 4 intro: addr_loc_type.intros)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   with hrt adal have "heap_read (shr s) a (CField D F) v'" using hconf by(rule heap_read_typeableD)
   with \<open>red_mthr.mthr.if.actions_ok s t \<lbrace>ReadMem a (CField D F) v\<rbrace>\<close>
   show ?case by(fastforce intro: red_reds.RedFAcc)
 next
   case (RedCASSucceed a D F v'' v''')
   hence [simp]: "I = 0" "al'' = CField D F" "a'' = a" "v'' = v" 
     and v': "v' \<in> vs (a, CField D F)" by(auto simp add: take_Cons' split: if_split_asm)
   from RedCASSucceed.prems(1) obtain E T where
     "P,E,shr s \<turnstile> addr a\<bullet>compareAndSwap(D\<bullet>F, Val v'', Val v''') : T" by clarify
   then obtain T where adal: "P,shr s \<turnstile> a@CField D F : T" 
     and v'': "P,shr s \<turnstile> v'' :\<le> T" and v''': "P,shr s \<turnstile> v''' :\<le> T"
     by(fastforce intro: addr_loc_type.intros simp add: conf_def)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   from hrt adal this hconf have read: "heap_read (shr s) a (CField D F) v'" by(rule heap_read_typeableD)
   show ?case
   proof(cases "v' = v''")
     case True
     then show ?thesis using RedCASSucceed 
       by(fastforce intro: red_reds.RedCASSucceed)
   next
     case False
     then show ?thesis using read RedCASSucceed
       by(fastforce intro: RedCASFail)
   qed
 next
   case (RedCASFail a D F v'' v''' v'''')
   hence [simp]: "I = 0" "al'' = CField D F" "a'' = a" "v'' = v" 
     and v': "v' \<in> vs (a, CField D F)" by(auto simp add: take_Cons' split: if_split_asm)
   from RedCASFail.prems(1) obtain E T where
     "P,E,shr s \<turnstile> addr a\<bullet>compareAndSwap(D\<bullet>F, Val v''', Val v'''') : T" by(iprover)
   then obtain T where adal: "P,shr s \<turnstile> a@CField D F : T" 
     and v''': "P,shr s \<turnstile> v''' :\<le> T" and v'''': "P,shr s \<turnstile> v'''' :\<le> T"
     by(fastforce intro: addr_loc_type.intros simp add: conf_def)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   from hrt adal this hconf have read: "heap_read (shr s) a (CField D F) v'" by(rule heap_read_typeableD)
   show ?case
   proof(cases "v' = v'''")
     case True
     from heap_write_total[OF hconf adal v''''] obtain h' where
       "heap_write (shr s) a (CField D F) v'''' h'" ..
     with read RedCASFail True show ?thesis 
       by(fastforce intro: RedCASSucceed)
   next
     case False
     with read RedCASFail show ?thesis by(fastforce intro: red_reds.RedCASFail)
   qed
 next
   case (RedCallExternal a U M Ts Tr D ps ta' va h' ta e')
   from \<open>P,t \<turnstile> \<langle>a\<bullet>M(ps),hp (shr s, xs)\<rangle> -ta'\<rightarrow>ext \<langle>va,h'\<rangle>\<close>
   have red: "P,t \<turnstile> \<langle>a\<bullet>M(ps),shr s\<rangle> -ta'\<rightarrow>ext \<langle>va,h'\<rangle>" by simp
   from RedCallExternal have aok: "red_mthr.mthr.if.actions_ok s t ta'" by simp
   from RedCallExternal have "I < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
     and "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v"
     and "v' \<in> w_values P vs (map NormalAction (take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) (a'', al'')"
     and "non_speculative P vs (llist_of (map NormalAction (take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)))" by simp_all
   from red_external_non_speculative_read[OF hrt vs red aok hconf this]
     \<open>typeof_addr (hp (shr s, xs)) a = \<lfloor>U\<rfloor>\<close> 
     \<open>P \<turnstile> class_type_of U sees M: Ts\<rightarrow>Tr = Native in D\<close> \<open>ta = extTA2J P ta'\<close>
     \<open>I < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>\<close>
   show ?case by(fastforce intro: red_reds.RedCallExternal)
 next
   case NewArrayRed thus ?case by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.NewArrayRed)
 next 
   case CastRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CastRed)
 next
   case InstanceOfRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.InstanceOfRed)
 next
   case BinOpRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.BinOpRed1)
 next
   case BinOpRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.BinOpRed2)
 next
   case LAssRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.LAssRed)
 next
   case AAccRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.AAccRed1)
 next
   case AAccRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.AAccRed2)
 next
   case AAssRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.AAssRed1)
 next
   case AAssRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.AAssRed2)
 next
   case AAssRed3 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.AAssRed3)+
 next
   case ALengthRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.ALengthRed)
 next
   case FAccRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.FAccRed)
 next
   case FAssRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.FAssRed1)
 next
   case FAssRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.FAssRed2)
 next
   case CASRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CASRed1)
 next
   case CASRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CASRed2)
 next
   case CASRed3 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CASRed3)
 next
   case CallObj thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CallObj)
 next
   case CallParams thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CallParams)
 next
   case BlockRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(fastforce intro: red_reds.BlockRed)+
 next
   case SynchronizedRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.SynchronizedRed1)
 next
   case SynchronizedRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.SynchronizedRed2)
 next
   case SeqRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.SeqRed)
 next
   case CondRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.CondRed)
 next
   case ThrowRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.ThrowRed)
 next
   case TryRed thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.TryRed)
 next
   case ListRed1 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.ListRed1)
 next
   case ListRed2 thus ?case
     by(clarsimp simp add: split_paired_Ex ex_WTrt_simps)(blast intro: red_reds.ListRed2)
 qed(simp_all)
 
 end
 
 
 sublocale J_allocated_heap_conf < if_known_addrs_base
   J_known_addrs
   final_expr "mred P" convert_RA 
 .
 
 
 declare split_paired_Ex [simp]
 declare eq_upto_seq_inconsist_simps [simp del]
 
 locale J_allocated_progress = 
   J_progress
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     P
   +
   J_allocated_heap_conf
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     allocated
     P
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and allocated :: "'heap \<Rightarrow> 'addr set"
   and P :: "'addr J_prog"
 begin
 
 lemma non_speculative_read:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "red_mthr.if.non_speculative_read J_non_speculative_read_bound
       (init_fin_lift_state status (J_start_state P C M vs)) 
       (w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs)))"
   (is "red_mthr.if.non_speculative_read _ ?start_state ?start_vs")
 proof(rule red_mthr.if.non_speculative_readI)
   fix ttas s' t x ta x' m' i ad al v v'
   assume \<tau>Red: "red_mthr.mthr.if.RedT P ?start_state ttas s'"
     and sc: "non_speculative P ?start_vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     and ts't: "thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>"
     and red: "red_mthr.init_fin P t (x, shr s') ta (x', m')"
     and aok: "red_mthr.mthr.if.actions_ok s' t ta"
     and i: "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     and ns': "non_speculative P (w_values P ?start_vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
     and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v)"
     and v': "v' \<in> w_values P ?start_vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ad, al)" 
 
   from wf_start obtain Ts T pns body D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases auto
 
   let ?conv = "\<lambda>ttas. concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)"
   let ?vs' = "w_values P ?start_vs (?conv ttas)"
   let ?wt_ok = "init_fin_lift_inv sconf_type_ok"
   let ?ET_start = "J_sconf_type_ET_start P C M"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
   let ?start_state = "init_fin_lift_state status (J_start_state P C M vs)"
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated J_known_addrs
     final_expr "mred P" "\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h" P
     using wf ok by(rule mred_known_addrs_typing)
 
   from wf sees have "wf_mdecl wf_J_mdecl P D (M, Ts, T, \<lfloor>(pns, body)\<rfloor>)" by(rule sees_wf_mdecl)
   then obtain T' where len1: "length pns = length Ts" and wt: "P,[this\<mapsto>Class D,pns [\<mapsto>] Ts] \<turnstile> body :: T'"
     by(auto simp add: wf_mdecl_def)
   from conf have len2: "length vs = length Ts" by(rule list_all2_lengthD)
 
   from wf wf_start have ts_ok_start: "ts_ok (init_fin_lift (\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h)) (thr ?start_state) (shr ?start_state)"
     unfolding ts_ok_init_fin_lift_init_fin_lift_state shr_start_state by(rule J_start_state_sconf_type_ok)
   have sc': "non_speculative P ?start_vs (lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (llist_of ttas))))"
     using sc by(simp add: lmap_lconcat llist.map_comp o_def split_def lconcat_llist_of[symmetric])
 
   from start_state_vs_conf[OF wf_prog_wf_syscls[OF wf]]
   have vs_conf_start: "vs_conf P (shr ?start_state) ?start_vs"
     by(simp add:init_fin_lift_state_conv_simps start_state_def split_beta)
   with \<tau>Red ts_ok_start sc
   have wt': "ts_ok (init_fin_lift (\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h)) (thr s') (shr s')"
     and vs': "vs_conf P (shr s') ?vs'" by(rule if_RedT_non_speculative_invar)+
 
   from red i read obtain e xs e' xs' ta'
     where x: "x = (Running, e, xs)" and x': "x' = (Running, e', xs')"
     and ta: "ta = convert_TA_initial (convert_obs_initial ta')"
     and red': "P,t \<turnstile> \<langle>e, (shr s', xs)\<rangle> -ta'\<rightarrow> \<langle>e', (m', xs')\<rangle>"
     by cases fastforce+
   
   from ts't wt' x obtain E T where wte: "P,E,shr s' \<turnstile> e : T"
     and hconf: "hconf (shr s')"
     by(auto dest!: ts_okD simp add: sconf_type_ok_def sconf_def type_ok_def)
 
   have aok': "red_mthr.mthr.if.actions_ok s' t ta'" using aok unfolding ta by simp
 
   from i read v' ta ns' have "i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" and "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem ad al v" 
     and "v' \<in> w_values P ?vs' (map NormalAction (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) (ad, al)"
     and "non_speculative P ?vs' (llist_of (map NormalAction (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)))"
     by(simp_all add: take_map)
 
   from red_non_speculative_read[OF hrt vs' hconf red' _ aok' this] wte
   obtain ta'' e'' xs'' h''
     where red'': "P,t \<turnstile> \<langle>e, (shr s', xs)\<rangle> -ta''\<rightarrow> \<langle>e'', (h'', xs'')\<rangle>"
     and aok'': "red_mthr.mthr.if.actions_ok s' t ta''"
     and i'': "i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>"
     and eq'': "take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
     and read'': "\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem ad al v'"
     and len'': "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max J_non_speculative_read_bound (length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)" by blast
 
   let ?x' = "(Running, e'', xs'')"
   let ?ta' = "convert_TA_initial (convert_obs_initial ta'')"
   from red'' have "red_mthr.init_fin P t (x, shr s') ?ta' (?x', h'')"
     unfolding x by -(rule red_mthr.init_fin.NormalAction, simp)
   moreover from aok'' have "red_mthr.mthr.if.actions_ok s' t ?ta'" by simp
   moreover from i'' have "i < length \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub>" by simp
   moreover from eq'' have "take i \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" unfolding ta by(simp add: take_map)
   moreover from read'' i'' have "\<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v')" by(simp add: nth_map)
   moreover from len'' have "length \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> \<le> max J_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     unfolding ta by simp
   ultimately
   show "\<exists>ta' x'' m''. red_mthr.init_fin P t (x, shr s') ta' (x'', m'') \<and>
                       red_mthr.mthr.if.actions_ok s' t ta' \<and>
                       i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and>
                       \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v') \<and> 
                       length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max J_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     by blast
 qed
 
 lemma J_cut_and_update:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "red_mthr.if.cut_and_update (init_fin_lift_state status (J_start_state P C M vs))
            (mrw_values P Map.empty (map snd (lift_start_obs start_tid start_heap_obs)))"
 proof -
   from wf_start obtain Ts T pns body D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases auto
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated J_known_addrs
     final_expr "mred P" "\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h" P
     using wf ok by(rule mred_known_addrs_typing)
 
   let ?start_vs = "w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs))"
   let ?wt_ok = "init_fin_lift_inv sconf_type_ok"
   let ?ET_start = "J_sconf_type_ET_start P C M"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
   let ?start_state = "init_fin_lift_state status (J_start_state P C M vs)"
 
   from wf sees have "wf_mdecl wf_J_mdecl P D (M, Ts, T, \<lfloor>(pns, body)\<rfloor>)" by(rule sees_wf_mdecl)
   then obtain T' where len1: "length pns = length Ts" and wt: "P,[this\<mapsto>Class D,pns [\<mapsto>] Ts] \<turnstile> body :: T'"
     by(auto simp add: wf_mdecl_def)
   from conf have len2: "length vs = length Ts" by(rule list_all2_lengthD)
 
   note wf_prog_wf_syscls[OF wf] non_speculative_read[OF wf hrt wf_start ka]
   moreover 
   from wf wf_start have ts_ok_start: "ts_ok (init_fin_lift (\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h)) (thr ?start_state) (shr ?start_state)"
     unfolding ts_ok_init_fin_lift_init_fin_lift_state shr_start_state by(rule J_start_state_sconf_type_ok)
   moreover
   have ka: "J_known_addrs start_tid ((\<lambda>(pns, body) vs. (blocks (this # pns) (Class (fst (method P C M)) # fst (snd (method P C M))) (Null # vs) body, Map.empty)) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
     using sees ka len1 len2 WT_ka[OF wt]
     by(auto simp add: split_beta start_addrs_allocated ka_blocks intro: start_tid_start_addrs[OF wf_prog_wf_syscls[OF wf] ok])
   ultimately show ?thesis by(rule non_speculative_read_into_cut_and_update)
 qed
 
 lemma J_drf:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "drf (J_\<E> P C M vs status) P"
 proof -
   from wf_start obtain Ts T pns body D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases auto
 
   from J_cut_and_update[OF assms] wf_prog_wf_syscls[OF wf] J_start_state_sconf_type_ok[OF wf wf_start] show ?thesis
   proof(rule known_addrs_typing.drf[OF mred_known_addrs_typing[OF wf ok]])
     from wf sees have "wf_mdecl wf_J_mdecl P D (M, Ts, T, \<lfloor>(pns, body)\<rfloor>)" by(rule sees_wf_mdecl)
     then obtain T' where len1: "length pns = length Ts" and wt: "P,[this\<mapsto>Class D,pns [\<mapsto>] Ts] \<turnstile> body :: T'"
       by(auto simp add: wf_mdecl_def)
     from conf have len2: "length vs = length Ts" by(rule list_all2_lengthD)
     show "J_known_addrs start_tid ((\<lambda>(pns, body) vs. (blocks (this # pns) (Class (fst (method P C M)) # fst (snd (method P C M))) (Null # vs) body, Map.empty)) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
       using sees ka len1 len2 WT_ka[OF wt]
       by(auto simp add: split_beta start_addrs_allocated ka_blocks intro: start_tid_start_addrs[OF wf_prog_wf_syscls[OF wf] ok])
   qed
 qed
 
 lemma J_sc_legal:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "sc_legal (J_\<E> P C M vs status) P"
 proof -
   from wf_start obtain Ts T pns body D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M: Ts\<rightarrow>T = \<lfloor>(pns, body)\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases auto
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated J_known_addrs
     final_expr "mred P" "\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h" P
     using wf ok by(rule mred_known_addrs_typing)
 
   let ?start_vs = "w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs))"
   let ?wt_ok = "init_fin_lift_inv sconf_type_ok"
   let ?ET_start = "J_sconf_type_ET_start P C M"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
   let ?start_state = "init_fin_lift_state status (J_start_state P C M vs)"
 
   from wf sees have "wf_mdecl wf_J_mdecl P D (M, Ts, T, \<lfloor>(pns, body)\<rfloor>)" by(rule sees_wf_mdecl)
   then obtain T' where len1: "length pns = length Ts" and wt: "P,[this\<mapsto>Class D,pns [\<mapsto>] Ts] \<turnstile> body :: T'"
     by(auto simp add: wf_mdecl_def)
   from conf have len2: "length vs = length Ts" by(rule list_all2_lengthD)
 
   note wf_prog_wf_syscls[OF wf] non_speculative_read[OF wf hrt wf_start ka]
   moreover
   from wf wf_start have ts_ok_start: "ts_ok (init_fin_lift (\<lambda>t x h. \<exists>ET. sconf_type_ok ET t x h)) (thr ?start_state) (shr ?start_state)"
     unfolding ts_ok_init_fin_lift_init_fin_lift_state shr_start_state by(rule J_start_state_sconf_type_ok)
   moreover have ka_allocated: "J_known_addrs start_tid ((\<lambda>(pns, body) vs. (blocks (this # pns) (Class (fst (method P C M)) # fst (snd (method P C M))) (Null # vs) body, Map.empty)) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
     using sees ka len1 len2 WT_ka[OF wt]
     by(auto simp add: split_beta start_addrs_allocated ka_blocks intro: start_tid_start_addrs[OF wf_prog_wf_syscls[OF wf] ok])
   ultimately have "red_mthr.if.hb_completion ?start_state (lift_start_obs start_tid start_heap_obs)"
     by(rule non_speculative_read_into_hb_completion)
 
   thus ?thesis using wf_prog_wf_syscls[OF wf] J_start_state_sconf_type_ok[OF wf wf_start]
     by(rule sc_legal)(rule ka_allocated)
 qed
 
 lemma J_jmm_consistent:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "jmm_consistent (J_\<E> P C M vs status) P"
   (is "jmm_consistent ?\<E> P")
 proof -
   interpret drf "?\<E>" P using assms by(rule J_drf)
   interpret sc_legal "?\<E>" P using assms by(rule J_sc_legal)
   show ?thesis by unfold_locales
 qed
 
 lemma J_ex_sc_exec:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "\<exists>E ws. E \<in> J_\<E> P C M vs status \<and> P \<turnstile> (E, ws) \<surd> \<and> sequentially_consistent P (E, ws)"
   (is "\<exists>E ws. _ \<in> ?\<E> \<and> _")
 proof -
   interpret jmm: executions_sc_hb ?\<E> P using assms by -(rule executions_sc)
 
   let ?start_state = "init_fin_lift_state status (J_start_state P C M vs)"
   let ?start_mrw = "mrw_values P Map.empty (map snd (lift_start_obs start_tid start_heap_obs))"
 
   from red_mthr.if.sequential_completion_Runs[OF red_mthr.if.cut_and_update_imp_sc_completion[OF J_cut_and_update[OF assms]] ta_seq_consist_convert_RA]
   obtain ttas where Red: "red_mthr.mthr.if.mthr.Runs P ?start_state ttas"
     and sc: "ta_seq_consist P ?start_mrw (lconcat (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))" by blast
   let ?E = "lappend (llist_of (lift_start_obs start_tid start_heap_obs)) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas))"
   from Red have "?E \<in> ?\<E>" by(blast intro: red_mthr.mthr.if.\<E>.intros)
   moreover from Red have tsa: "thread_start_actions_ok ?E"
     by(blast intro: red_mthr.thread_start_actions_ok_init_fin red_mthr.mthr.if.\<E>.intros)
   from sc have "ta_seq_consist P Map.empty (lmap snd ?E)"
     unfolding lmap_lappend_distrib lmap_lconcat llist.map_comp split_def o_def lmap_llist_of map_map snd_conv
     by(simp add: ta_seq_consist_lappend ta_seq_consist_start_heap_obs)
   from ta_seq_consist_imp_sequentially_consistent[OF tsa jmm.\<E>_new_actions_for_fun[OF \<open>?E \<in> ?\<E>\<close>] this]
   obtain ws where "sequentially_consistent P (?E, ws)" "P \<turnstile> (?E, ws) \<surd>" by iprover
   ultimately show ?thesis by blast
 qed
 
 theorem J_consistent:
   assumes wf: "wf_J_prog P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "\<exists>E ws. legal_execution P (J_\<E> P C M vs status) (E, ws)"
 proof -
   let ?\<E> = "J_\<E> P C M vs status"
   interpret sc_legal "?\<E>" P using assms by(rule J_sc_legal)
   from J_ex_sc_exec[OF assms]
   obtain E ws where "E \<in> ?\<E>" "P \<turnstile> (E, ws) \<surd>" "sequentially_consistent P (E, ws)" by blast
   hence "legal_execution P ?\<E> (E, ws)" by(rule SC_is_legal)
   thus ?thesis by blast
 qed
 
 end
 
 end
diff --git a/thys/JinjaThreads/MM/DRF_JVM.thy b/thys/JinjaThreads/MM/DRF_JVM.thy
--- a/thys/JinjaThreads/MM/DRF_JVM.thy
+++ b/thys/JinjaThreads/MM/DRF_JVM.thy
@@ -1,1167 +1,1167 @@
 (*  Title:      JinjaThreads/MM/DRF_JVM.thy
     Author:     Andreas Lochbihler
 *)
 
 section \<open>JMM Instantiation for bytecode\<close>
 
 theory DRF_JVM
 imports
   JMM_Common
   JMM_JVM
   "../BV/BVProgressThreaded"
   SC_Legal
 begin
 
 subsection \<open>DRF guarantee for the JVM\<close>
 
 abbreviation (input) ka_xcp :: "'addr option \<Rightarrow> 'addr set"
 where "ka_xcp \<equiv> set_option"
 
 primrec jvm_ka :: "'addr jvm_thread_state \<Rightarrow> 'addr set"
 where
   "jvm_ka (xcp, frs) = 
    ka_xcp xcp \<union> (\<Union>(stk, loc, C, M, pc) \<in> set frs. (\<Union>v \<in> set stk. ka_Val v) \<union> (\<Union>v \<in> set loc. ka_Val v))"
 
 context heap begin
 
 lemma red_external_aggr_read_mem_typeable:
   "\<lbrakk> (ta, va, h') \<in> red_external_aggr P t a M vs h; ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> \<exists>T'. P,h \<turnstile> ad@al : T'"
 by(auto simp add: red_external_aggr_def split_beta split: if_split_asm dest: heap_clone_read_typeable)
 
 end
 
 context JVM_heap_base begin
 
 definition jvm_known_addrs :: "'thread_id \<Rightarrow> 'addr jvm_thread_state \<Rightarrow> 'addr set"
 where "jvm_known_addrs t xcpfrs = {thread_id2addr t} \<union> jvm_ka xcpfrs \<union> set start_addrs"
 
 end
 
 context JVM_heap begin
 
 lemma exec_instr_known_addrs:
   assumes ok: "start_heap_ok"
   and exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   shows "jvm_known_addrs t (xcp', frs') \<subseteq> jvm_known_addrs t (None, (stk, loc, C, M, pc) # frs) \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 proof -
   
   note [simp] = jvm_known_addrs_def new_obs_addrs_def addr_of_sys_xcpt_start_addr[OF ok] subset_Un1 subset_Un2 subset_insert ka_Val_subset_new_obs_Addr_ReadMem SUP_subset_mono split_beta neq_Nil_conv tl_conv_drop set_drop_subset is_Ref_def
 
   from exec check show ?thesis
   proof(cases "i")
     case Load with exec check show ?thesis by auto
   next
     case (Store V) with exec check show ?thesis
       using set_update_subset_insert[of loc V]
       by(clarsimp simp del: set_update_subsetI) blast
   next
     case (Push v)
     with check have "ka_Val v = {}" by(cases v) simp_all
     with Push exec check show ?thesis by(simp)
   next
     case (CAS F D)
     then show ?thesis using exec check 
       by(clarsimp split: if_split_asm)(fastforce dest!: in_set_dropD)+
   next
     case (Invoke M' n)
     show ?thesis
     proof(cases "stk ! n = Null")
       case True with exec check Invoke show ?thesis by(simp)
     next
       case [simp]: False
       with check Invoke obtain a where stkn: "stk ! n = Addr a" "n < length stk" by auto
       hence a: "a \<in> (\<Union>v \<in> set stk. ka_Val v)" by(fastforce dest: nth_mem)
       show ?thesis
       proof(cases "snd (snd (snd (method P (class_type_of (the (typeof_addr h (the_Addr (stk ! n))))) M'))) = Native")
         case True
         with exec check Invoke a stkn show ?thesis
           apply clarsimp
           apply(drule red_external_aggr_known_addrs_mono[OF ok], simp)
           apply(auto dest!: in_set_takeD dest: bspec subsetD split: extCallRet.split_asm simp add: has_method_def is_native.simps)
           done
       next
         case False
         with exec check Invoke a stkn show ?thesis
           by(auto simp add: set_replicate_conv_if dest!: in_set_takeD)
       qed
     qed
   next
     case Swap with exec check show ?thesis
       by(cases stk)(simp, case_tac list, auto)
   next
     case (BinOpInstr bop) with exec check show ?thesis
       using binop_known_addrs[OF ok, of bop "hd (drop (Suc 0) stk)" "hd stk"]
       apply(cases stk)
       apply(simp, case_tac list, simp)
       apply clarsimp
       apply(drule (2) binop_progress)
       apply(auto 6 2 split: sum.split_asm)
       done
   next
     case MExit with exec check show ?thesis by(auto split: if_split_asm)
   qed(clarsimp split: if_split_asm)+
 qed
 
 lemma exec_d_known_addrs_mono:
   assumes ok: "start_heap_ok"
   and exec: "mexecd P t (xcpfrs, h) ta (xcpfrs', h')"
   shows "jvm_known_addrs t xcpfrs' \<subseteq> jvm_known_addrs t xcpfrs \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 using exec
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply(simp add: split_beta)
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
  apply(fastforce simp add: check_def split_beta del: subsetI dest!: exec_instr_known_addrs[OF ok])
 apply(fastforce simp add: jvm_known_addrs_def split_beta dest!: in_set_dropD)
 done
 
 lemma exec_instr_known_addrs_ReadMem:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and read: "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "ad \<in> jvm_known_addrs t (None, (stk, loc, C, M, pc) # frs)"
 using assms
 proof(cases i)
   case ALoad thus ?thesis using assms
     by(cases stk)(case_tac [2] list, auto simp add: split_beta is_Ref_def jvm_known_addrs_def split: if_split_asm)
 next
   case (Invoke M n)
   with check have "stk ! n \<noteq> Null \<longrightarrow> the_Addr (stk ! n) \<in> ka_Val (stk ! n)" "stk ! n \<in> set stk"
     by(auto simp add: is_Ref_def)
   with assms Invoke show ?thesis
     by(auto simp add: split_beta is_Ref_def simp del: ka_Val.simps nth_mem split: if_split_asm dest!: red_external_aggr_known_addrs_ReadMem in_set_takeD del: is_AddrE)(auto simp add: jvm_known_addrs_def simp del: ka_Val.simps nth_mem del: is_AddrE)
 next
   case Getfield thus ?thesis using assms
     by(auto simp add: jvm_known_addrs_def neq_Nil_conv is_Ref_def split: if_split_asm)
 next
   case CAS thus ?thesis using assms
     apply(cases stk; simp)
     subgoal for v stk
       apply(cases stk; simp)
       subgoal for v stk
         by(cases stk)(auto split: if_split_asm simp add: jvm_known_addrs_def is_Ref_def)
       done
     done
 qed(auto simp add: split_beta is_Ref_def neq_Nil_conv split: if_split_asm)
 
 lemma mexecd_known_addrs_ReadMem:
   "\<lbrakk> mexecd P t (xcpfrs, h) ta (xcpfrs', h'); ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> jvm_known_addrs t xcpfrs"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply simp
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto simp add: check_def dest: exec_instr_known_addrs_ReadMem)
 done
 
 lemma exec_instr_known_addrs_WriteMem:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and "write": "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a)" "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "a \<in> jvm_known_addrs t (None, (stk, loc, C, M, pc) # frs) \<or> a \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 using assms
 proof(cases i)
   case (Invoke M n)
   with check have "stk ! n \<noteq> Null \<longrightarrow> the_Addr (stk ! n) \<in> ka_Val (stk ! n)" "stk ! n \<in> set stk"
     by(auto simp add: is_Ref_def)
   thus ?thesis using assms Invoke
     by(auto simp add: is_Ref_def split_beta split: if_split_asm simp del: ka_Val.simps nth_mem dest!: red_external_aggr_known_addrs_WriteMem in_set_takeD del: is_AddrE)(auto simp add: jvm_known_addrs_def del: is_AddrE)
 next
   case AStore with assms show ?thesis
     by(cases stk)(auto simp add: jvm_known_addrs_def split: if_split_asm)
 next
   case Putfield with assms show ?thesis
     by(cases stk)(auto simp add: jvm_known_addrs_def split: if_split_asm)
 next
   case CAS with assms show ?thesis
     apply(cases stk; simp)
     subgoal for v stk
       apply(cases stk; simp)
       subgoal for v stk
         by(cases stk)(auto split: if_split_asm simp add: take_Cons' jvm_known_addrs_def)
       done
     done
 qed(auto simp add: split_beta split: if_split_asm)
 
 lemma mexecd_known_addrs_WriteMem:
   "\<lbrakk> mexecd P t (xcpfrs, h) ta (xcpfrs', h'); \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr a); n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> a \<in> jvm_known_addrs t xcpfrs \<or> a \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply simp
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto simp add: check_def dest: exec_instr_known_addrs_WriteMem)
 done
 
 lemma exec_instr_known_addrs_new_thread:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and new: "NewThread t' x' h'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
   shows "jvm_known_addrs t' x' \<subseteq> jvm_known_addrs t (None, (stk, loc, C, M, pc) # frs)"
 using assms
 proof(cases i)
   case (Invoke M n)
   with assms have "stk ! n \<noteq> Null \<longrightarrow> the_Addr (stk ! n) \<in> ka_Val (stk ! n) \<and> thread_id2addr (addr2thread_id (the_Addr (stk ! n))) = the_Addr (stk ! n)" "stk ! n \<in> set stk"
     apply(auto simp add: is_Ref_def split: if_split_asm)
     apply(frule red_external_aggr_NewThread_idD, simp, simp)
     apply(drule red_external_aggr_new_thread_sub_thread)
     apply(auto intro: addr2thread_id_inverse)
     done
   with assms Invoke show ?thesis
     apply(auto simp add: is_Ref_def split_beta split: if_split_asm simp del: nth_mem del: is_AddrE)
     apply(drule red_external_aggr_NewThread_idD)
     apply(auto simp add: extNTA2JVM_def jvm_known_addrs_def split_beta simp del: nth_mem del: is_AddrE)
     done
 qed(auto simp add: split_beta split: if_split_asm)
 
 lemma mexecd_known_addrs_new_thread:
   "\<lbrakk> mexecd P t (xcpfrs, h) ta (xcpfrs', h'); NewThread t' x' h'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub> \<rbrakk>
   \<Longrightarrow> jvm_known_addrs t' x' \<subseteq> jvm_known_addrs t xcpfrs"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply simp
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto 4 3 simp add: check_def dest: exec_instr_known_addrs_new_thread)
 done
 
 lemma exec_instr_New_same_addr_same:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec_instr ins P t h stk loc C M pc frs;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 apply(cases ins)
 apply(auto simp add: nth_Cons' split: prod.split_asm if_split_asm)
 apply(auto split: extCallRet.split_asm dest: red_external_aggr_New_same_addr_same)
 done
 
 lemma exec_New_same_addr_same:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec P t (xcp, h, frs); 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 apply(cases "(P, t, xcp, h, frs)" rule: exec.cases)
 apply(auto dest: exec_instr_New_same_addr_same)
 done
 
 lemma exec_1_d_New_same_addr_same:
   "\<lbrakk> P,t \<turnstile> Normal (xcp, h, frs) -ta-jvmd\<rightarrow> Normal (xcp', h', frs'); 
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a x; i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>;
      \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a x'; j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> i = j"
 by(erule jvmd_NormalE)(rule exec_New_same_addr_same)
 
 end
 
 
 
 locale JVM_allocated_heap = allocated_heap +
   constrains addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and allocated :: "'heap \<Rightarrow> 'addr set"
   and P :: "'addr jvm_prog"
 
 sublocale JVM_allocated_heap < JVM_heap
 by(unfold_locales)
 
 context JVM_allocated_heap begin
 
 lemma exec_instr_allocated_mono:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs; check_instr i P h stk loc C M pc frs \<rbrakk>
   \<Longrightarrow> allocated h \<subseteq> allocated h'"
 apply(cases i)
 apply(auto 4 4 simp add: split_beta has_method_def is_native.simps split: if_split_asm sum.split_asm intro: allocate_allocated_mono dest: heap_write_allocated_same dest!: red_external_aggr_allocated_mono del: subsetI)
 done
 
 lemma mexecd_allocated_mono:
   "mexecd P t (xcpfrs, h) ta (xcpfrs', h') \<Longrightarrow> allocated h \<subseteq> allocated h'"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply(simp)
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto del: subsetI simp add: check_def dest: exec_instr_allocated_mono)
 done
 
 lemma exec_instr_allocatedD:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs; 
      check_instr i P h stk loc C M pc frs; NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> ad \<in> allocated h' \<and> ad \<notin> allocated h"
 apply(cases i)
 apply(auto 4 4 split: if_split_asm prod.split_asm dest: allocate_allocatedD dest!: red_external_aggr_allocatedD simp add: has_method_def is_native.simps)
 done
 
 lemma mexecd_allocatedD:
   "\<lbrakk> mexecd P t (xcpfrs, h) ta (xcpfrs', h'); NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk> 
   \<Longrightarrow> ad \<in> allocated h' \<and> ad \<notin> allocated h"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply(simp)
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto del: subsetI dest: exec_instr_allocatedD simp add: check_def)
 done
 
 lemma exec_instr_NewHeapElemD:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs; check_instr i P h stk loc C M pc frs;
      ad \<in> allocated h'; ad \<notin> allocated h \<rbrakk>
   \<Longrightarrow> \<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 apply(cases i)
 apply(auto 4 3 split: if_split_asm prod.split_asm sum.split_asm dest: allocate_allocatedD heap_write_allocated_same dest!: red_external_aggr_NewHeapElemD simp add: is_native.simps has_method_def)
 done
 
 lemma mexecd_NewHeapElemD:
   "\<lbrakk> mexecd P t (xcpfrs, h) ta (xcpfrs', h'); ad \<in> allocated h'; ad \<notin> allocated h \<rbrakk>
   \<Longrightarrow> \<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
 apply(cases xcpfrs)
 apply(cases xcpfrs')
 apply(simp)
 apply(erule jvmd_NormalE)
 apply(cases "fst xcpfrs")
 apply(auto dest: exec_instr_NewHeapElemD simp add: check_def)
 done
 
 lemma mexecd_allocated_multithreaded:
   "allocated_multithreaded addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated JVM_final (mexecd P) P"
 proof
   fix t x m ta x' m'
   assume "mexecd P t (x, m) ta (x', m')"
   thus "allocated m \<subseteq> allocated m'" by(rule mexecd_allocated_mono)
 next
   fix x t m ta x' m' ad CTn
   assume "mexecd P t (x, m) ta (x', m')"
     and "NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad \<in> allocated m' \<and> ad \<notin> allocated m" by(rule mexecd_allocatedD)
 next
   fix t x m ta x' m' ad
   assume "mexecd P t (x, m) ta (x', m')"
     and "ad \<in> allocated m'" "ad \<notin> allocated m"
   thus "\<exists>CTn. NewHeapElem ad CTn \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" by(rule mexecd_NewHeapElemD)
 next
   fix t x m ta x' m' i a CTn j CTn'
   assume "mexecd P t (x, m) ta (x', m')"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NewHeapElem a CTn" "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! j = NewHeapElem a CTn'" "j < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "i = j" by(auto dest: exec_1_d_New_same_addr_same simp add: split_beta)
 qed
 
 end
 
 sublocale JVM_allocated_heap < execd_mthr: allocated_multithreaded 
   addr2thread_id thread_id2addr 
   spurious_wakeups
   empty_heap allocate typeof_addr heap_read heap_write allocated 
   JVM_final "mexecd P" 
   P
 by(rule mexecd_allocated_multithreaded)
 
 context JVM_allocated_heap begin
 
 lemma mexecd_known_addrs: 
   assumes wf: "wf_prog wfmd P"
   and ok: "start_heap_ok"
   shows "known_addrs addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated jvm_known_addrs JVM_final (mexecd P) P"
 proof
   fix t x m ta x' m'
   assume "mexecd P t (x, m) ta (x', m')"
   thus "jvm_known_addrs t x' \<subseteq> jvm_known_addrs t x \<union> new_obs_addrs \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     by(rule exec_d_known_addrs_mono[OF ok])
 next
   fix t x m ta x' m' t' x'' m''
   assume "mexecd P t (x, m) ta (x', m')"
     and "NewThread t' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
   thus "jvm_known_addrs t' x'' \<subseteq> jvm_known_addrs t x" by(rule mexecd_known_addrs_new_thread)
 next
   fix t x m ta x' m' ad al v
   assume "mexecd P t (x, m) ta (x', m')"
     and "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad \<in> jvm_known_addrs t x" by(rule mexecd_known_addrs_ReadMem)
 next
   fix t x m ta x' m' n ad al ad'
   assume "mexecd P t (x, m) ta (x', m')"
     and "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! n = WriteMem ad al (Addr ad')" "n < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   thus "ad' \<in> jvm_known_addrs t x \<or> ad' \<in> new_obs_addrs (take n \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     by(rule mexecd_known_addrs_WriteMem)
 qed
 
 end
 
 context JVM_heap begin
 
 lemma exec_instr_read_typeable:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and read: "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   shows "\<exists>T'. P,h \<turnstile> ad@al : T'"
 using exec check read
 proof(cases i)
   case ALoad
   with assms show ?thesis
     by(fastforce simp add: split_beta is_Ref_def nat_less_iff word_sless_alt intro: addr_loc_type.intros split: if_split_asm)
 next
   case (Getfield F D)
   with assms show ?thesis
     by(clarsimp simp add: split_beta is_Ref_def split: if_split_asm)(blast intro: addr_loc_type.intros dest: has_visible_field has_field_mono)
 next
   case (Invoke M n)
   with exec check read obtain a vs ta' va T
     where "(ta', va, h') \<in> red_external_aggr P t a M vs h"
     and "ReadMem ad al v \<in> set \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
     by(auto split: if_split_asm simp add: is_Ref_def)
   thus ?thesis by(rule red_external_aggr_read_mem_typeable)
 next
   case (CAS F D)
   with assms show ?thesis
     by(clarsimp simp add: split_beta is_Ref_def conf_def split: if_split_asm)
       (force intro: addr_loc_type.intros dest: has_visible_field[THEN has_field_mono])
 qed(auto simp add: split_beta is_Ref_def split: if_split_asm)
 
 lemma exec_1_d_read_typeable:
   "\<lbrakk> P,t \<turnstile> Normal (xcp, h, frs) -ta-jvmd\<rightarrow> Normal (xcp', h', frs'); 
      ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> \<exists>T'. P,h \<turnstile> ad@al : T'"
 apply(erule jvmd_NormalE)
 apply(cases "(P, t, xcp, h, frs)" rule: exec.cases)
 apply(auto intro: exec_instr_read_typeable simp add: check_def)
 done
 
 end
 
 sublocale JVM_heap_base < execd_mthr: 
   if_multithreaded
     JVM_final
     "mexecd P"
     convert_RA
   for P
 by(unfold_locales)
 
 context JVM_heap_conf begin
 
 lemma JVM_conf_read_heap_read_typed:
   "JVM_conf_read addr2thread_id thread_id2addr empty_heap allocate typeof_addr (heap_read_typed P) heap_write hconf P"
 proof -
   interpret conf: heap_conf_read
     addr2thread_id thread_id2addr 
     spurious_wakeups
     empty_heap allocate typeof_addr "heap_read_typed P" heap_write hconf 
     P
     by(rule heap_conf_read_heap_read_typed)
   show ?thesis by(unfold_locales)
 qed
 
 lemma exec_instr_New_typeof_addrD:
   "\<lbrakk> (ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs; 
      check_instr i P h stk loc C M pc frs; hconf h;
      NewHeapElem a x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<rbrakk>
   \<Longrightarrow> typeof_addr h' a = Some x"
 apply(cases i)
 apply(auto dest: allocate_SomeD split: prod.split_asm if_split_asm)
 apply(auto 4 4 split: extCallRet.split_asm dest!: red_external_aggr_New_typeof_addrD simp add: has_method_def is_native.simps)
 done
 
 lemma exec_1_d_New_typeof_addrD:
   "\<lbrakk> P,t \<turnstile> Normal (xcp, h, frs) -ta-jvmd\<rightarrow> Normal (xcp', h', frs'); NewHeapElem a x \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>; hconf h \<rbrakk>
   \<Longrightarrow> typeof_addr h' a = Some x"
 apply(erule jvmd_NormalE)
 apply(cases "xcp")
 apply(auto dest: exec_instr_New_typeof_addrD simp add: check_def)
 done
 
 lemma exec_instr_non_speculative_typeable:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and sc: "non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
   and vs_conf: "vs_conf P h vs"
   and hconf: "hconf h"
   shows "(ta, xcp', h', frs') \<in> JVM_heap_base.exec_instr addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write i P t h stk loc C M pc frs"
 proof -
   note [simp] = JVM_heap_base.exec_instr.simps
     and [split] = if_split_asm prod.split_asm sum.split_asm
     and [split del] = if_split
   from assms show "?thesis"
   proof(cases i)
     case ALoad with assms show ?thesis
       by(auto 4 3 intro!: heap_read_typedI dest: vs_confD addr_loc_type_fun)
   next
     case Getfield with assms show ?thesis
       by(auto 4 3 intro!: heap_read_typedI dest: vs_confD addr_loc_type_fun)
   next
     case CAS with assms show ?thesis
       by(auto 4 3 intro!: heap_read_typedI dest: vs_confD addr_loc_type_fun)
   next
     case Invoke with assms show ?thesis
       by(fastforce dest: red_external_aggr_non_speculative_typeable simp add: has_method_def is_native.simps)
   qed(auto)
 qed
 
 lemma exec_instr_non_speculative_vs_conf:
   assumes exec: "(ta, xcp', h', frs') \<in> exec_instr i P t h stk loc C M pc frs"
   and check: "check_instr i P h stk loc C M pc frs"
   and sc: "non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   and vs_conf: "vs_conf P h vs"
   and hconf: "hconf h"
   shows "vs_conf P h' (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 proof -
   note [simp] = JVM_heap_base.exec_instr.simps take_Cons'
     and [split] = if_split_asm prod.split_asm sum.split_asm
     and [split del] = if_split
   from assms show ?thesis
   proof(cases i)
     case New with assms show ?thesis
       by(auto 4 4 dest: hext_allocate vs_conf_allocate intro: vs_conf_hext)
   next
     case NewArray with assms show ?thesis
       by(auto 4 4 dest: hext_allocate vs_conf_allocate intro: vs_conf_hext cong: if_cong)
   next
     case Invoke with assms show ?thesis
       by(fastforce dest: red_external_aggr_non_speculative_vs_conf simp add: has_method_def is_native.simps)
   next
     case AStore
     { 
       assume "hd (tl (tl stk)) \<noteq> Null"
         and "\<not> the_Intg (hd (tl stk))  <s 0"
         and "\<not> int (alen_of_htype (the (typeof_addr h (the_Addr (hd (tl (tl stk))))))) \<le> sint (the_Intg (hd (tl stk)))"
         and "P \<turnstile> the (typeof\<^bsub>h\<^esub> (hd stk)) \<le> the_Array (ty_of_htype (the (typeof_addr h (the_Addr (hd (tl (tl stk)))))))"
       moreover hence "nat (sint (the_Intg (hd (tl stk)))) < alen_of_htype (the (typeof_addr h (the_Addr (hd (tl (tl stk))))))"
-        by(auto simp add: not_le nat_less_iff word_sle_def word_sless_def not_less)
+        by(auto simp add: not_le nat_less_iff word_sle_eq word_sless_eq not_less)
       with assms AStore have "nat (sint (the_Intg (hd (tl stk)))) < alen_of_htype (the (typeof_addr h' (the_Addr (hd (tl (tl stk))))))"
         by(auto dest!: hext_arrD hext_heap_write)
       ultimately have "\<exists>T. P,h' \<turnstile> the_Addr (hd (tl (tl stk)))@ACell (nat (sint (the_Intg (hd (tl stk))))) : T \<and> P,h' \<turnstile> hd stk :\<le> T"
         using assms AStore
         by(auto 4 4 simp add: is_Ref_def conf_def dest!: hext_heap_write dest: hext_arrD intro!: addr_loc_type.intros intro: typeof_addr_hext_mono type_of_hext_type_of) }
     thus ?thesis using assms AStore
       by(auto intro!: vs_confI)(blast intro: addr_loc_type_hext_mono conf_hext dest: hext_heap_write vs_confD)+
   next
     case Putfield
     show ?thesis using assms Putfield
       by(auto intro!: vs_confI dest!: hext_heap_write)(blast intro: addr_loc_type.intros addr_loc_type_hext_mono typeof_addr_hext_mono has_field_mono[OF has_visible_field] conf_hext dest: vs_confD)+
   next
     case CAS
     show ?thesis using assms CAS
       by(auto intro!: vs_confI dest!: hext_heap_write)(blast intro: addr_loc_type.intros addr_loc_type_hext_mono typeof_addr_hext_mono has_field_mono[OF has_visible_field] conf_hext dest: vs_confD)+
   qed(auto)
 qed
 
 lemma mexecd_non_speculative_typeable:
   "\<lbrakk> P,t \<turnstile> Normal (xcp, h, stk) -ta-jvmd\<rightarrow> Normal (xcp', h', frs'); non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>));
     vs_conf P h vs; hconf h \<rbrakk>
   \<Longrightarrow> JVM_heap_base.exec_1_d addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write P t (Normal (xcp, h, stk)) ta (Normal (xcp', h', frs'))"
 apply(erule jvmd_NormalE)
 apply(cases xcp)
 apply(auto intro!: JVM_heap_base.exec_1_d.intros simp add: JVM_heap_base.exec_d_def check_def JVM_heap_base.exec.simps intro: exec_instr_non_speculative_typeable)
 done
 
 lemma mexecd_non_speculative_vs_conf:
   "\<lbrakk> P,t \<turnstile> Normal (xcp, h, stk) -ta-jvmd\<rightarrow> Normal (xcp', h', frs');
     non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)));
     vs_conf P h vs; hconf h \<rbrakk>
   \<Longrightarrow> vs_conf P h' (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
 apply(erule jvmd_NormalE)
 apply(cases xcp)
 apply(auto intro!: JVM_heap_base.exec_1_d.intros simp add: JVM_heap_base.exec_d_def check_def JVM_heap_base.exec.simps intro: exec_instr_non_speculative_vs_conf)
 done
 
 end
 
 locale JVM_allocated_heap_conf = 
   JVM_heap_conf 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     P
   +
   JVM_allocated_heap 
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write
     allocated
     P
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and allocated :: "'heap \<Rightarrow> 'addr set"
   and P :: "'addr jvm_prog"
 begin
 
 lemma mexecd_known_addrs_typing:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and ok: "start_heap_ok"
   shows "known_addrs_typing addr2thread_id thread_id2addr empty_heap allocate typeof_addr heap_write allocated jvm_known_addrs JVM_final (mexecd P) (\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>) P"
 proof -
   from wf obtain wf_md where "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
   then
   interpret known_addrs
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated jvm_known_addrs
     JVM_final "mexecd P" P
     using ok by(rule mexecd_known_addrs)
   
   show ?thesis
   proof
     fix t x m ta x' m'
     assume "mexecd P t (x, m) ta (x', m')"
     thus "m \<unlhd> m'" by(auto simp add: split_beta intro: exec_1_d_hext)
   next
     fix t x m ta x' m' vs
     assume exec: "mexecd P t (x, m) ta (x', m')"
       and ts_ok: "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t:(xcp, h, frstls) \<surd>) x m"
       and vs: "vs_conf P m vs"
       and ns: "non_speculative P vs (llist_of (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
 
     let ?mexecd = "JVM_heap_base.mexecd addr2thread_id thread_id2addr spurious_wakeups empty_heap allocate typeof_addr (heap_read_typed P) heap_write P"    
     have lift: "lifting_wf JVM_final ?mexecd (\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>)"
       by(intro JVM_conf_read.lifting_wf_correct_state_d JVM_conf_read_heap_read_typed wf)
 
     from exec ns vs ts_ok have exec': "?mexecd t (x, m) ta (x', m')"
       by(auto simp add: split_beta correct_state_def dest: mexecd_non_speculative_typeable)
     thus "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t:(xcp, h, frstls) \<surd>) x' m'" using ts_ok
       by(rule lifting_wf.preserves_red[OF lift])
     {
       fix t'' x'' m''
       assume New: "NewThread t'' x'' m'' \<in> set \<lbrace>ta\<rbrace>\<^bsub>t\<^esub>"
       with exec have "m'' = snd (x', m')" by(rule execd_mthr.new_thread_memory)
       thus "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t'':(xcp, h, frstls) \<surd>) x'' m''"
         using lifting_wf.preserves_NewThread[where ?r="?mexecd", OF lift exec' ts_ok] New
         by auto }
     { fix t'' x''
       assume "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t'':(xcp, h, frstls) \<surd>) x'' m"
       with lift exec' ts_ok show "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t'':(xcp, h, frstls) \<surd>) x'' m'"
         by(rule lifting_wf.preserves_other) }
   next
     fix t x m ta x' m' vs n
     assume exec: "mexecd P t (x, m) ta (x', m')"
       and ts_ok: "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t:(xcp, h, frstls) \<surd>) x m"
       and vs: "vs_conf P m vs"
       and ns: "non_speculative P vs (llist_of (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
     thus "vs_conf P m' (w_values P vs (take n (map NormalAction \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
       by(auto simp add: correct_state_def dest: mexecd_non_speculative_vs_conf)
   next
     fix t x m ta x' m' ad al v
     assume "mexecd P t (x, m) ta (x', m')"
       and "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t:(xcp, h, frstls) \<surd>) x m"
       and "ReadMem ad al v \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     thus "\<exists>T. P,m \<turnstile> ad@al : T"
       by(auto simp add: correct_state_def split_beta dest: exec_1_d_read_typeable)
   next
     fix t x m ta x' m' ad hT
     assume "mexecd P t (x, m) ta (x', m')"
       and "(\<lambda>(xcp, frstls) h. \<Phi> \<turnstile> t:(xcp, h, frstls) \<surd>) x m"
       and "NewHeapElem ad hT \<in> set \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     thus "typeof_addr m' ad = \<lfloor>hT\<rfloor>"
       by(auto dest: exec_1_d_New_typeof_addrD[where x="hT"] simp add: split_beta correct_state_def)
   qed
 qed
 
 lemma executions_sc:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and wf_start: "wf_start_state P C M vs"
   and vs2: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "executions_sc_hb (JVMd_\<E> P C M vs status) P"
     (is "executions_sc_hb ?E P")
 proof -
   from wf_start obtain Ts T meth D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T=\<lfloor>meth\<rfloor> in D"
     and vs1: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated jvm_known_addrs
     JVM_final "mexecd P" "\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>" P
     using wf ok by(rule mexecd_known_addrs_typing)
   
   from wf obtain wf_md where wf': "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
   hence "wf_syscls P" by(rule wf_prog_wf_syscls) 
   thus ?thesis
   proof(rule executions_sc_hb)
     from correct_jvm_state_initial[OF wf wf_start]
     show "correct_state_ts \<Phi> (thr (JVM_start_state P C M vs)) start_heap"
       by(simp add: correct_jvm_state_def start_state_def split_beta)
   next
     show "jvm_known_addrs start_tid ((\<lambda>(mxs, mxl0, b) vs. (None, [([], Null # vs @ replicate mxl0 undefined_value, fst (method P C M), M, 0)])) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
       using vs2
       by(auto simp add: split_beta start_addrs_allocated jvm_known_addrs_def intro: start_tid_start_addrs[OF \<open>wf_syscls P\<close> ok])
   qed
 qed
 
 end
 
 declare split_paired_Ex [simp del]
 declare eq_upto_seq_inconsist_simps [simp]
 
 context JVM_progress begin
 
 abbreviation (input) jvm_non_speculative_read_bound :: nat where
   "jvm_non_speculative_read_bound \<equiv> 2"
 
 lemma exec_instr_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P (shr s) vs"
   and hconf: "hconf (shr s)"
   and exec_i: "(ta, xcp', h', frs') \<in> exec_instr i P t (shr s) stk loc C M pc frs"
   and check: "check_instr i P (shr s) stk loc C M pc frs"
   and aok: "execd_mthr.mthr.if.actions_ok s t ta"
   and i: "I < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v"
   and v': "v' \<in> w_values P vs (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   shows "\<exists>ta' xcp'' h'' frs''. (ta', xcp'', h'', frs'') \<in> exec_instr i P t (shr s) stk loc C M pc frs \<and>
            execd_mthr.mthr.if.actions_ok s t ta' \<and> 
            I < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
            \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v' \<and> 
            length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max jvm_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 using exec_i i read
 proof(cases i)
   case [simp]: ALoad
   let ?a = "the_Addr (hd (tl stk))"
   let ?i = "the_Intg (hd stk)"
   from exec_i i read have Null: "hd (tl stk) \<noteq> Null"
     and bounds: "0 <=s ?i" "sint ?i < int (alen_of_htype (the (typeof_addr (shr s) ?a)))"
     and [simp]: "I = 0" "a'' = ?a" "al'' = ACell (nat (sint ?i))"
     by(auto split: if_split_asm)
 
   from Null check obtain a T n 
     where a: "length stk > 1" "hd (tl stk) = Addr a"
     and type: "typeof_addr (shr s) ?a = \<lfloor>Array_type T n\<rfloor>" by(fastforce simp add: is_Ref_def)
   from bounds type have "nat (sint ?i) < n"
-    by(simp add: word_sle_def nat_less_iff)
+    by (simp add: word_sle_eq nat_less_iff)
   with type have adal: "P,shr s \<turnstile> ?a@ACell (nat (sint ?i)) : T"
     by(rule addr_loc_type.intros)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)
   with hrt adal have "heap_read (shr s) ?a (ACell (nat (sint ?i))) v'" using hconf by(rule heap_read_typeableD)
   with type bounds Null aok exec_i show ?thesis by(fastforce)
 next
   case [simp]: (Getfield F D)
   let ?a = "the_Addr (hd stk)"
 
   from exec_i i read have Null: "hd stk \<noteq> Null"
     and [simp]: "I = 0" "a'' = ?a" "al'' = CField D F"
     by(auto split: if_split_asm)
   with check obtain U T fm C' a
     where sees: "P \<turnstile> D sees F:T (fm) in D"
     and type: "typeof_addr (shr s) ?a = \<lfloor>U\<rfloor>" 
     and sub: "P \<turnstile> class_type_of U \<preceq>\<^sup>* D" 
     and a: "hd stk = Addr a" "length stk > 0" by(auto simp add: is_Ref_def)
   from has_visible_field[OF sees] sub
   have "P \<turnstile> class_type_of U has F:T (fm) in D" by(rule has_field_mono)
   with type have adal: "P,shr s \<turnstile> ?a@CField D F : T"
     by(rule addr_loc_type.intros)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   with hrt adal have "heap_read (shr s) ?a (CField D F) v'" using hconf by(rule heap_read_typeableD)
   with type Null aok exec_i show ?thesis by(fastforce)
 next
   case [simp]: (CAS F D)
   let ?a = "the_Addr (hd (tl (tl stk)))"
 
   from exec_i i read have Null: "hd (tl (tl stk)) \<noteq> Null"
     and [simp]: "I = 0" "a'' = ?a" "al'' = CField D F"
     by(auto split: if_split_asm simp add: nth_Cons')
   with check obtain U T fm C' a
     where sees: "P \<turnstile> D sees F:T (fm) in D"
     and type: "typeof_addr (shr s) ?a = \<lfloor>U\<rfloor>" 
     and sub: "P \<turnstile> class_type_of U \<preceq>\<^sup>* D" 
     and a: "hd (tl (tl stk)) = Addr a" "length stk > 2" 
     and v: "P,shr s \<turnstile> hd stk :\<le> T"
     by(auto simp add: is_Ref_def)
   from has_visible_field[OF sees] sub
   have "P \<turnstile> class_type_of U has F:T (fm) in D" by(rule has_field_mono)
   with type have adal: "P,shr s \<turnstile> ?a@CField D F : T"
     by(rule addr_loc_type.intros)
   from v' vs adal have "P,shr s \<turnstile> v' :\<le> T" by(auto dest!: vs_confD dest: addr_loc_type_fun)  
   with hrt adal have read: "heap_read (shr s) ?a (CField D F) v'" using hconf by(rule heap_read_typeableD)
   show ?thesis
   proof(cases "v' = hd (tl stk)")
     case True
     from heap_write_total[OF hconf adal v] a obtain h'
       where "heap_write (shr s) a (CField D F) (hd stk) h'" by auto
     then show ?thesis using read a True aok exec_i by fastforce
   next
     case False
     then show ?thesis using read a aok exec_i
       by(fastforce intro!: disjI2)
   qed
 next
   case [simp]: (Invoke M n)
   let ?a = "the_Addr (stk ! n)"
   let ?vs = "rev (take n stk)"
   from exec_i i read have Null: "stk ! n \<noteq> Null" 
     and iec: "snd (snd (snd (method P (class_type_of (the (typeof_addr (shr s) ?a))) M))) = Native"
     by(auto split: if_split_asm)
   with check obtain a T Ts Tr D
     where a: "stk ! n = Addr a" "n < length stk"
     and type: "typeof_addr (shr s) ?a = \<lfloor>T\<rfloor>"
     and extwt: "P \<turnstile> class_type_of T sees M:Ts\<rightarrow>Tr = Native in D" "D\<bullet>M(Ts) :: Tr"
     by(auto simp add: is_Ref_def has_method_def)
   from extwt have native: "is_native P T M" by(auto simp add: is_native.simps)
   from Null iec type exec_i obtain ta' va
     where red: "(ta', va, h') \<in> red_external_aggr P t ?a M ?vs (shr s)"
     and ta: "ta = extTA2JVM P ta'" by(fastforce)
   from aok ta have aok': "execd_mthr.mthr.if.actions_ok s t ta'" by simp
   from red_external_aggr_non_speculative_read[OF hrt vs red[unfolded a the_Addr.simps] _ aok' hconf, of I a'' al'' v v']
     native type i read v' ns a ta
   obtain ta'' va'' h''
     where "(ta'', va'', h'') \<in> red_external_aggr P t a M (rev (take n stk)) (shr s)"
     and "execd_mthr.mthr.if.actions_ok s t ta''"
     and "I < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>" "take I \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" 
     and "\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v'" "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" by auto
   thus ?thesis using Null iec ta extwt a type
     by(cases va'') force+
 qed(auto simp add: split_beta split: if_split_asm)
 
 lemma exec_1_d_non_speculative_read:
   assumes hrt: "heap_read_typeable hconf P"
   and vs: "vs_conf P (shr s) vs"
   and exec: "P,t \<turnstile> Normal (xcp, shr s, frs) -ta-jvmd\<rightarrow> Normal (xcp', h', frs')"
   and aok: "execd_mthr.mthr.if.actions_ok s t ta"
   and hconf: "hconf (shr s)"
   and i: "I < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
   and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v"
   and v': "v' \<in> w_values P vs (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (a'', al'')"
   and ns: "non_speculative P vs (llist_of (map NormalAction (take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)))"
   shows "\<exists>ta' xcp'' h'' frs''. P,t \<turnstile> Normal (xcp, shr s, frs) -ta'-jvmd\<rightarrow> Normal (xcp'', h'', frs'') \<and>
            execd_mthr.mthr.if.actions_ok s t ta' \<and> 
            I < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take I \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take I \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and> 
            \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! I = ReadMem a'' al'' v' \<and> 
            length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max jvm_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
 using assms
 apply -
 apply(erule jvmd_NormalE)
 apply(cases "(P, t, xcp, shr s, frs)" rule: exec.cases)
   apply simp
  defer
  apply simp
 apply clarsimp
 apply(drule (3) exec_instr_non_speculative_read)
       apply(clarsimp simp add: check_def has_method_def)
      apply simp
     apply(rule i)
    apply(rule read)
   apply(rule v')
  apply(rule ns)
 apply(clarsimp simp add: exec_1_d.simps exec_d_def)
 done
 
 end
 
 declare split_paired_Ex [simp]
 declare eq_upto_seq_inconsist_simps [simp del]
 
 locale JVM_allocated_progress = 
   JVM_progress
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     P
   +
   JVM_allocated_heap_conf
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write hconf
     allocated
     P
   for addr2thread_id :: "('addr :: addr) \<Rightarrow> 'thread_id"
   and thread_id2addr :: "'thread_id \<Rightarrow> 'addr"
   and spurious_wakeups :: bool
   and empty_heap :: "'heap"
   and allocate :: "'heap \<Rightarrow> htype \<Rightarrow> ('heap \<times> 'addr) set"
   and typeof_addr :: "'heap \<Rightarrow> 'addr \<rightharpoonup> htype"
   and heap_read :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> bool"
   and heap_write :: "'heap \<Rightarrow> 'addr \<Rightarrow> addr_loc \<Rightarrow> 'addr val \<Rightarrow> 'heap \<Rightarrow> bool"
   and hconf :: "'heap \<Rightarrow> bool"
   and allocated :: "'heap \<Rightarrow> 'addr set"
   and P :: "'addr jvm_prog"
 begin
 
 lemma non_speculative_read:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "execd_mthr.if.non_speculative_read jvm_non_speculative_read_bound
       (init_fin_lift_state status (JVM_start_state P C M vs)) 
       (w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs)))"
   (is "execd_mthr.if.non_speculative_read _ ?start_state ?start_vs")
 proof(rule execd_mthr.if.non_speculative_readI)
   fix ttas s' t x ta x' m' i ad al v v'
 
   assume \<tau>Red: "execd_mthr.mthr.if.RedT P ?start_state ttas s'"
     and sc: "non_speculative P ?start_vs (llist_of (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)))"
     and ts't: "thr s' t = \<lfloor>(x, no_wait_locks)\<rfloor>"
     and red: "execd_mthr.init_fin P t (x, shr s') ta (x', m')"
     and aok: "execd_mthr.mthr.if.actions_ok s' t ta"
     and i: "i < length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>"
     and ns': "non_speculative P (w_values P ?start_vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))) (llist_of (take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>))"
     and read: "\<lbrace>ta\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v)"
     and v': "v' \<in> w_values P ?start_vs (concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas) @ take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) (ad, al)"
 
   from wf_start obtain Ts T meth D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases
 
   let ?conv = "\<lambda>ttas. concat (map (\<lambda>(t, ta). \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas)"
   let ?vs' = "w_values P ?start_vs (?conv ttas)"
   let ?wt_ok = "init_fin_lift (\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>)"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
 
   from wf obtain wf_md where wf': "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated jvm_known_addrs
     JVM_final "mexecd P" "\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>"
     using wf ok by(rule mexecd_known_addrs_typing)
 
   from conf have len2: "length vs = length Ts" by(rule list_all2_lengthD)
 
   from correct_jvm_state_initial[OF wf wf_start]
   have "correct_state_ts \<Phi> (thr (JVM_start_state P C M vs)) start_heap"
     by(simp add: correct_jvm_state_def start_state_def split_beta)
   hence ts_ok_start: "ts_ok ?wt_ok (thr ?start_state) (shr ?start_state)"
     unfolding ts_ok_init_fin_lift_init_fin_lift_state by(simp add: start_state_def split_beta)
 
   have sc': "non_speculative P ?start_vs (lmap snd (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) (llist_of ttas))))"
     using sc by(simp add: lmap_lconcat llist.map_comp o_def split_def lconcat_llist_of[symmetric])
   from start_state_vs_conf[OF wf_prog_wf_syscls[OF wf']]
   have vs_conf_start: "vs_conf P (shr ?start_state) ?start_vs"
     by(simp add:init_fin_lift_state_conv_simps start_state_def split_beta)
   with \<tau>Red ts_ok_start sc
   have wt': "ts_ok ?wt_ok (thr s') (shr s')"
     and vs': "vs_conf P (shr s') ?vs'" by(rule if_RedT_non_speculative_invar)+
 
   from red i read obtain xcp frs xcp' frs' ta'
     where x: "x = (Running, xcp, frs)" and x': "x' = (Running, xcp', frs')"
     and ta: "ta = convert_TA_initial (convert_obs_initial ta')"
     and red': "P,t \<turnstile> Normal (xcp, shr s', frs) -ta'-jvmd\<rightarrow> Normal (xcp', m', frs')"
     by cases fastforce+
 
   from ts't wt' x have hconf: "hconf (shr s')" by(auto dest!: ts_okD simp add: correct_state_def)
 
   have aok': "execd_mthr.mthr.if.actions_ok s' t ta'" using aok unfolding ta by simp
   
   from i read v' ns' ta have "i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>" 
     and "\<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem ad al v"
     and "v' \<in> w_values P ?vs' (map NormalAction (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)) (ad, al)"
     and "non_speculative P ?vs' (llist_of (map NormalAction (take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)))"
     by(simp_all add: take_map)
 
   from exec_1_d_non_speculative_read[OF hrt vs' red' aok' hconf this]
   obtain ta'' xcp'' frs'' h''
     where red'': "P,t \<turnstile> Normal (xcp, shr s', frs) -ta''-jvmd\<rightarrow> Normal (xcp'', h'', frs'')"
     and aok'': "execd_mthr.mthr.if.actions_ok s' t ta''"
     and i'': " i < length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub>"
     and eq'': "take i \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>"
     and read'': "\<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> ! i = ReadMem ad al v'"
     and len'': "length \<lbrace>ta''\<rbrace>\<^bsub>o\<^esub> \<le> max jvm_non_speculative_read_bound (length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub>)" by blast
 
   let ?x' = "(Running, xcp'', frs'')"
   let ?ta' = "convert_TA_initial (convert_obs_initial ta'')"
   from red'' have "execd_mthr.init_fin P t (x, shr s') ?ta' (?x', h'')"
     unfolding x by -(rule execd_mthr.init_fin.NormalAction, simp)
   moreover from aok'' have "execd_mthr.mthr.if.actions_ok s' t ?ta'" by simp
   moreover from i'' have "i < length \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub>" by simp
   moreover from eq'' have "take i \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>" unfolding ta by(simp add: take_map)
   moreover from read'' i'' have "\<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v')" by(simp add: nth_map)
   moreover from len'' have "length \<lbrace>?ta'\<rbrace>\<^bsub>o\<^esub> \<le> max jvm_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)" 
     unfolding ta by simp
   ultimately
   show "\<exists>ta' x'' m''. execd_mthr.init_fin P t (x, shr s') ta' (x'', m'') \<and>
                       execd_mthr.mthr.if.actions_ok s' t ta' \<and>
                       i < length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<and> take i \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> = take i \<lbrace>ta\<rbrace>\<^bsub>o\<^esub> \<and>
                       \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> ! i = NormalAction (ReadMem ad al v') \<and> 
                       length \<lbrace>ta'\<rbrace>\<^bsub>o\<^esub> \<le> max jvm_non_speculative_read_bound (length \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)"
     by blast
 qed
 
 lemma JVM_cut_and_update:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P" 
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "execd_mthr.if.cut_and_update (init_fin_lift_state status (JVM_start_state P C M vs))
            (mrw_values P Map.empty (map snd (lift_start_obs start_tid start_heap_obs)))"
 proof -
   from wf_start obtain Ts T meth D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated jvm_known_addrs
     JVM_final "mexecd P" "\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>"
     using wf ok by(rule mexecd_known_addrs_typing)
 
   let ?start_vs = "w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs))"
   let ?wt_ok = "init_fin_lift (\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>)"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
   let ?start_state = "init_fin_lift_state status (JVM_start_state P C M vs)"
 
   from wf obtain wf_md where wf': "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
   hence "wf_syscls P" by(rule wf_prog_wf_syscls)
   moreover
   note non_speculative_read[OF wf hrt wf_start ka]
   moreover have "ts_ok ?wt_ok (thr ?start_state) (shr ?start_state)"
     using correct_jvm_state_initial[OF wf wf_start]
     by(simp add: correct_jvm_state_def start_state_def split_beta)
   moreover have ka: "jvm_known_addrs start_tid ((\<lambda>(mxs, mxl0, b) vs. (None, [([], Null # vs @ replicate mxl0 undefined_value, fst (method P C M), M, 0)])) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
       using ka by(auto simp add: split_beta start_addrs_allocated jvm_known_addrs_def intro: start_tid_start_addrs[OF \<open>wf_syscls P\<close> ok])
   ultimately show ?thesis by(rule non_speculative_read_into_cut_and_update)
 qed
 
 lemma JVM_drf:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "drf (JVMd_\<E> P C M vs status) P"
 proof -
   from wf_start obtain Ts T meth D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases
 
   from wf obtain wf_md where wf': "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
   hence "wf_syscls P" by(rule wf_prog_wf_syscls)
   with JVM_cut_and_update[OF assms]
   show ?thesis
   proof(rule known_addrs_typing.drf[OF mexecd_known_addrs_typing[OF wf ok]])
     from correct_jvm_state_initial[OF wf wf_start]
     show "correct_state_ts \<Phi> (thr (JVM_start_state P C M vs)) start_heap"
       by(simp add: correct_jvm_state_def start_state_def split_beta)
   next
     show "jvm_known_addrs start_tid ((\<lambda>(mxs, mxl0, b) vs. (None, [([], Null # vs @ replicate mxl0 undefined_value, fst (method P C M), M, 0)])) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
       using ka by(auto simp add: split_beta start_addrs_allocated jvm_known_addrs_def intro: start_tid_start_addrs[OF \<open>wf_syscls P\<close> ok])
   qed
 qed
 
 lemma JVM_sc_legal:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
 shows "sc_legal (JVMd_\<E> P C M vs status) P"
 proof -
   from wf_start obtain Ts T meth D where ok: "start_heap_ok"
     and sees: "P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>meth\<rfloor> in D"
     and conf: "P,start_heap \<turnstile> vs [:\<le>] Ts" by cases
 
   interpret known_addrs_typing
     addr2thread_id thread_id2addr
     spurious_wakeups
     empty_heap allocate typeof_addr heap_read heap_write 
     allocated jvm_known_addrs
     JVM_final "mexecd P" "\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>"
     using wf ok by(rule mexecd_known_addrs_typing)
 
   from wf obtain wf_md where wf': "wf_prog wf_md P" by(blast dest: wt_jvm_progD)
   hence "wf_syscls P" by(rule wf_prog_wf_syscls)
 
   let ?start_vs = "w_values P (\<lambda>_. {}) (map snd (lift_start_obs start_tid start_heap_obs))"
   let ?wt_ok = "init_fin_lift (\<lambda>t (xcp, frstls) h. \<Phi> \<turnstile> t: (xcp, h, frstls) \<surd>)"
   let ?start_obs = "map snd (lift_start_obs start_tid start_heap_obs)"
   let ?start_state = "init_fin_lift_state status (JVM_start_state P C M vs)"
 
   note \<open>wf_syscls P\<close> non_speculative_read[OF wf hrt wf_start ka]
   moreover have "ts_ok ?wt_ok (thr ?start_state) (shr ?start_state)"
     using correct_jvm_state_initial[OF wf wf_start]
     by(simp add: correct_jvm_state_def start_state_def split_beta)
   moreover
   have ka_allocated: "jvm_known_addrs start_tid ((\<lambda>(mxs, mxl0, b) vs. (None, [([], Null # vs @ replicate mxl0 undefined_value, fst (method P C M), M, 0)])) (the (snd (snd (snd (method P C M))))) vs) \<subseteq> allocated start_heap"
     using ka by(auto simp add: split_beta start_addrs_allocated jvm_known_addrs_def intro: start_tid_start_addrs[OF \<open>wf_syscls P\<close> ok])
   ultimately have "execd_mthr.if.hb_completion ?start_state (lift_start_obs start_tid start_heap_obs)"
     by(rule non_speculative_read_into_hb_completion)
 
   thus ?thesis using \<open>wf_syscls P\<close>
   proof(rule sc_legal)
     from correct_jvm_state_initial[OF wf wf_start]
     show "correct_state_ts \<Phi> (thr (JVM_start_state P C M vs)) start_heap"
       by(simp add: correct_jvm_state_def start_state_def split_beta)
   qed(rule ka_allocated)
 qed
 
 lemma JVM_jmm_consistent:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "jmm_consistent (JVMd_\<E> P C M vs status) P"
     (is "jmm_consistent ?\<E> P")
 proof -
   interpret drf "?\<E>" P using assms by(rule JVM_drf)
   interpret sc_legal "?\<E>" P using assms by(rule JVM_sc_legal)
   show ?thesis by unfold_locales
 qed
 
 lemma JVM_ex_sc_exec:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "\<exists>E ws. E \<in> JVMd_\<E> P C M vs status \<and> P \<turnstile> (E, ws) \<surd> \<and> sequentially_consistent P (E, ws)"
   (is "\<exists>E ws. _ \<in> ?\<E> \<and> _")
 proof -
   interpret jmm: executions_sc_hb ?\<E> P using assms by -(rule executions_sc)
 
   let ?start_state = "init_fin_lift_state status (JVM_start_state P C M vs)"
   let ?start_mrw = "mrw_values P Map.empty (map snd (lift_start_obs start_tid start_heap_obs))"
 
   from execd_mthr.if.sequential_completion_Runs[OF execd_mthr.if.cut_and_update_imp_sc_completion[OF JVM_cut_and_update[OF assms]] ta_seq_consist_convert_RA]
   obtain ttas where Red: "execd_mthr.mthr.if.mthr.Runs P ?start_state ttas"
     and sc: "ta_seq_consist P ?start_mrw (lconcat (lmap (\<lambda>(t, ta). llist_of \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>) ttas))" by blast
   let ?E = "lappend (llist_of (lift_start_obs start_tid start_heap_obs)) (lconcat (lmap (\<lambda>(t, ta). llist_of (map (Pair t) \<lbrace>ta\<rbrace>\<^bsub>o\<^esub>)) ttas))"
   from Red have "?E \<in> ?\<E>" by(blast intro: execd_mthr.mthr.if.\<E>.intros)
   moreover from Red have tsa: "thread_start_actions_ok ?E"
     by(blast intro: execd_mthr.thread_start_actions_ok_init_fin execd_mthr.mthr.if.\<E>.intros)
   from sc have "ta_seq_consist P Map.empty (lmap snd ?E)"
     unfolding lmap_lappend_distrib lmap_lconcat llist.map_comp split_def o_def lmap_llist_of map_map snd_conv
     by(simp add: ta_seq_consist_lappend ta_seq_consist_start_heap_obs)
   from ta_seq_consist_imp_sequentially_consistent[OF tsa jmm.\<E>_new_actions_for_fun[OF \<open>?E \<in> ?\<E>\<close>] this]
   obtain ws where "sequentially_consistent P (?E, ws)" "P \<turnstile> (?E, ws) \<surd>" by iprover
   ultimately show ?thesis by blast
 qed
 
 theorem JVM_consistent:
   assumes wf: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
   and hrt: "heap_read_typeable hconf P"
   and wf_start: "wf_start_state P C M vs"
   and ka: "\<Union>(ka_Val ` set vs) \<subseteq> set start_addrs"
   shows "\<exists>E ws. legal_execution P (JVMd_\<E> P C M vs status) (E, ws)"
 proof -
   let ?\<E> = "JVMd_\<E> P C M vs status"
   interpret sc_legal "?\<E>" P using assms by(rule JVM_sc_legal)
   from JVM_ex_sc_exec[OF assms]
   obtain E ws where "E \<in> ?\<E>" "P \<turnstile> (E, ws) \<surd>" "sequentially_consistent P (E, ws)" by blast
   hence "legal_execution P ?\<E> (E, ws)" by(rule SC_is_legal)
   thus ?thesis by blast
 qed
 
 end
 
 text \<open>
   One could now also prove that the aggressive JVM satisfies @{term drf}.
   The key would be that \<open>welltyped_commute\<close> also holds for @{term "non_speculative"} prefixes from start.
 \<close>
 
 end
diff --git a/thys/LOFT/OpenFlow_Documentation.thy b/thys/LOFT/OpenFlow_Documentation.thy
--- a/thys/LOFT/OpenFlow_Documentation.thy
+++ b/thys/LOFT/OpenFlow_Documentation.thy
@@ -1,533 +1,533 @@
 text_raw\<open>
 \twocolumn
 \columnsep 2pc          %    Space between columns
 \textwidth 42pc         % Width of text line.
 \part{Documentation}
 \label{part2}
 \<close>
 section\<open>Configuration Translation\<close>
 text_raw\<open>\label{sec:conv}\<close>
 text\<open>
 All the results we present in this section are formalized and verified in Isabelle/HOL~\cite{nipkow2002isabelle}.
 This means that their formal correctness can be trusted a level close to absolute certainty.
 The definitions and lemmas stated here are merely a repetition of lemmas stated in other theory files.
 This means that they have been directly set to this document from Isabelle and no typos or hidden assumptions are possible.
 Additionally, it allows us to omit various helper lemmas that do not help the understanding.
 However, it causes some notation inaccuracy, as type and function definitions are stated as lemmas or schematic goals.
 \<close>
 theory OpenFlow_Documentation
 (*<*)
 imports 
   LinuxRouter_OpenFlow_Translation 
   Featherweight_OpenFlow_Comparison
   "HOL-Library.LaTeXsugar"
 begin
 (*>*)
 
 subsection\<open>Linux Firewall Model\<close>
 text_raw\<open>\label{sec:lfw}\<close>
 text\<open>We want to write a program that translates the configuration of a linux firewall to that of an OpenFlow switch.
 We furthermore want to verify that translation.
 For this purpose, we need a clear definition of the behavior of the two device types -- we need their models and semantics.
 In case of a linux firewall, this is problematic because a linux firewall is a highly complex device that is ultimately capable of general purpose computation.
 Creating a comprehensive semantics that encompasses all possible configuration types of a linux firewall is thus 
 highly non-trivial and not useful for the purpose of analysis.
 We decided to approach the problem from the other side: we created a model that includes only the most basic features. (This implies neglecting IPv6.)
 Fortunately, many of the highly complex features are rarely essential and even our basic model is still of some use.
 \<close>
 
 text\<open>We first divided the firewall into subsystems.
 Given a routing table @{term rt}, the firewall rules @{term fw},
   the routing decision for a packet @{term p} can be obtained by @{term "routing_table_semantics rt (p_dst p)"}, 
   the firewall decision by @{term "simple_fw fw p"}.
 We draft the first description of our linux router model:
 \begin{enumerate}
   \item The destination MAC address of an arriving packet is checked: Does it match the MAC address of the ingress port? 
   If it does, we continue, otherwise, the packet is discarded.
   \item The routing decision @{term "rd \<equiv> routing_table_semantics rt p"} is obtained.
   \item The packet's output interface is updated based on @{term rd}\footnote{Note that we assume a packet model with input and output interfaces. The origin of this is explained in Section~\ref{sec:lfwfw}}.
   \item The firewall is queried for a decision: @{term "simple_fw fw p"}. If the decision is to @{const[names_short] simple_action.Drop}, the packet is discarded.
   \item The next hop is computed: If @{term rd} provides a next hop, that is used. 
     Otherwise, the destination address of the packet is used.
   \item The MAC address of the next hop is looked up; the packet is updated with it and sent.
 \end{enumerate}
 We decided that this description is best formalized as an abortable program in the option monad:\<close>
 lemma "simple_linux_router rt fw mlf ifl p \<equiv> do {
 	_ \<leftarrow> iface_packet_check ifl p;
 	let rd \<comment> \<open>(routing decision)\<close> = routing_table_semantics rt (p_dst p);
 	let p = p\<lparr>p_oiface := output_iface rd\<rparr>;
 	let fd \<comment> \<open>(firewall decision)\<close> = simple_fw fw p;
 	_ \<leftarrow> (case fd of Decision FinalAllow \<Rightarrow> Some () | Decision FinalDeny \<Rightarrow> None);
 	let nh = (case next_hop rd of None \<Rightarrow> p_dst p | Some a \<Rightarrow> a);
 	ma \<leftarrow> mlf nh;
 	Some (p\<lparr>p_l2dst := ma\<rparr>)
 }" 
 unfolding fromMaybe_def[symmetric] by(fact simple_linux_router_def)
 text\<open>where @{term "mlf :: ipv4addr \<Rightarrow> 48 word"} is a function that looks up the MAC address for an IP address.\<close>
 
 text\<open>There are already a few important aspects that have not been modelled, but they are not core essential for the functionality of a firewall.
 Namely, there is no local traffic from/to the firewall.
 This is problematic since this model can not generate ARP replies --- thus, an equivalent OpenFlow device will not do so, either.
 Furthermore, this model is problematic because it requires access to a function that looks up a MAC address, 
 something that may not be known at the time of time running a translation to an OpenFlow configuration.
 \<close>
 text\<open>It is possible to circumvent these problems by inserting static ARP table entries in the directly connected devices 
 and looking up their MAC addresses \emph{a priori}. 
 A test-wise implementation of the translation based on this model showed acceptable results.
 However, we deemed the \emph{a priori} lookup of the MAC addresses to be rather inelegant and built a second model.\<close>
 definition "simple_linux_router_altered rt fw ifl p \<equiv> do {
 	let rd = routing_table_semantics rt (p_dst p);
 	let p = p\<lparr>p_oiface := output_iface rd\<rparr>;
 		_ \<leftarrow> if p_oiface p = p_iiface p then None else Some ();
 	let fd = simple_fw fw p;
 	_ \<leftarrow> (case fd of Decision FinalAllow \<Rightarrow> Some () | Decision FinalDeny \<Rightarrow> None);
 	Some p
 }"
 (* TODO: Would a router actually forward a packet on the same interface? *)
 text\<open>In this model, all access to the MAC layer has been eliminated.
 This is done by the approximation that the firewall will be asked to route a packet 
 (i.e. be addressed on the MAC layer) iff the destination IP address of the packet causes it to be routed out on a different interface.
 Because this model does not insert destination MAC addresses, the destination MAC address has to be already correct when the packet is sent.
 This can only be achieved by changing the subnet of all connected device, moving them into one common subnet\footnote{There are cases where this is not possible --- A limitation of our system.}.
 \<close>
 text\<open>
 While a test-wise implementation based on this model also showed acceptable results, the model is still problematic.
 The check @{term "p_oiface p = p_iiface p"} and the firewall require access to the output interface.
 The details of why this cannot be provided are be elaborated in Section~\ref{sec:convi}. 
 The intuitive explanation is that an OpenFlow match can not have a field for the output interface.
 We thus simplified the model even further:
 \<close>
 lemma "simple_linux_router_nol12 rt fw p \<equiv> do {
 	let rd = routing_table_semantics rt (p_dst p);
 	let p = p\<lparr>p_oiface := output_iface rd\<rparr>;
 	let fd = simple_fw fw p;
 	_ \<leftarrow> (case fd of Decision FinalAllow \<Rightarrow> Some () | Decision FinalDeny \<Rightarrow> None);
 	Some p
 }" by(fact simple_linux_router_nol12_def)
 text\<open>We continue with this definition as a basis for our translation.
 Even this strongly altered version and the original linux firewall still behave the same in a substantial amount of cases:\<close>
 theorem
 	"\<lbrakk>iface_packet_check ifl pii \<noteq> None;
 	mlf (case next_hop (routing_table_semantics rt (p_dst pii)) of None \<Rightarrow> p_dst pii | Some a \<Rightarrow> a) \<noteq> None\<rbrakk> \<Longrightarrow>
 	\<exists>x. map_option (\<lambda>p. p\<lparr>p_l2dst := x\<rparr>) (simple_linux_router_nol12 rt fw pii) = simple_linux_router rt fw mlf ifl pii"
 by(fact rtr_nomac_eq[unfolded fromMaybe_def])
 text\<open>The conditions are to be read as ``The check whether a received packet has the correct destination MAC never returns @{const False}'' and 
 ``The next hop MAC address for all packets can be looked up''.
 Obviously, these conditions do not hold for all packets. 
 We will show an example where this makes a difference in Section~\ref{sec:mnex}.\<close>
 
 subsubsection\<open>Routing Table\<close>
 text_raw\<open>\label{sec:lfwr}\<close>
 text\<open>
 The routing system in linux features multiple tables and a system that can use the iptables firewall and an additional match language to select a routing table.
 Based on our directive, we only focused on the single most used \texttt{main} routing table.\<close>
 text\<open>
 We define a routing table entry to be a record (named tuple) of a prefix match, a metric and the routing action, which in turn is a record of an output interface and an optional next-hop address.\<close>
 schematic_goal "(?rtbl_entry :: ('a::len) routing_rule) = \<lparr> routing_match = PrefixMatch pfx len, metric = met, routing_action = \<lparr> output_iface = oif_string, next_hop = (h :: 'a word option) \<rparr> \<rparr>" ..
 text\<open>A routing table is then a list of these entries:\<close>
 lemma "(rtbl :: ('a :: len) prefix_routing) = (rtbl :: 'a routing_rule list)" by rule
 text\<open>Not all members of the type @{type prefix_routing} are sane routing tables. There are three different validity criteria that we require so that our definitions are adequate.
 \begin{itemize}
   \item The prefixes have to be 0 in bits exceeding their length.
   \item There has to be a default rule, i.e. one with prefix length 0. With the condition above, that implies that all its prefix bits are zero and it thus matches any address.
   \item The entries have to be sorted by prefix length and metric.
 \end{itemize}
 The first two are set into code in the following way:
 \<close>
 lemma "valid_prefix (PrefixMatch pfx len) \<equiv> pfx && (2 ^ (32 - len) - 1) = (0 :: 32 word)" 
-unfolding valid_prefix_def pfxm_mask_def mask_def by (simp add: word_bw_comms(1))
+  by (simp add: valid_prefix_def pfxm_mask_def mask_eq_decr_exp and.commute)
 lemma "has_default_route rt \<longleftrightarrow> (\<exists>r \<in> set rt. pfxm_length (routing_match r) = 0)" 
 by(fact has_default_route_alt)
 text\<open>The third is not needed in any of the further proofs, so we omit it.\<close>
 
 text\<open>The semantics of a routing table is to simply traverse the list until a matching entry is found.\<close>
 schematic_goal "routing_table_semantics (rt_entry # rt) dst_addr = (if prefix_match_semantics (routing_match rt_entry) dst_addr then routing_action rt_entry else routing_table_semantics rt dst_addr)" by(fact routing_table_semantics.simps)
 text\<open>If no matching entry is found, the behavior is undefined.\<close>
 
 subsubsection\<open>iptables Firewall\<close>
 text_raw\<open>\label{sec:lfwfw}\<close>
 text\<open>The firewall subsystem in a linux router is not any less complex than any of the of the other systems.
 Fortunately, this complexity has been dealt with in~\cite{diekmann2016verified,Iptables_Semantics-AFP} already and we can directly use the result.\<close>
 text\<open>In short, one of the results is that a complex \emph{iptables} configuration can be simplified to be represented by a single list of matches that only support the following match conditions:
 \begin{itemize}
   \item (String) prefix matches on the input and output interfaces.
   \item A @{type prefix_match} on the source and destination IP address.
   \item An exact match on the layer 4 protocol.
   \item Interval matches on the source or destination port, e.g. @{term "p\<^sub>d \<in> {(1::16 word)..1023}"}
 \end{itemize}
 The model/type of the packet is adjusted to fit that: it is a record of the fields matched on.
 This also means that input and output interface are coded to the packet.
 Given that this information is usually stored alongside the packet content, this can be deemed a reasonable model.
 In case the output interface is not needed (e.g., when evaluating an OpenFlow table), it can simply be left blank.
 
 Obviously, a simplification into the above match type cannot always produce an equivalent firewall, and the set of accepted packets has to be over- or underapproximated.
 The reader interested in the details of this is strongly referred to~\cite{diekmann2016verified}; we are simply going to continue with the result: @{const simple_fw}.
 \<close>
 text\<open>One property of the simplification is worth noting here: The simplified firewall does not know state and the simplification approximates stateful matches by stateless ones. 
 Thus, the overapproximation of a stateful firewall ruleset that begins with accepting packets of established connections usually begins with a rule that accepts all packets.
 Dealing with this by writing a meaningful simplification of stateful firewalls is future work.
 \<close>
 
 subsection\<open>OpenFlow Switch Model\<close>
 text\<open>In this section, we present our model of an OpenFlow switch.
 The requirements for this model are derived from the fact that it models devices that are the target of a configuration translation.
 This has two implications:
 \begin{itemize}
 \item All configurations that are representable in our model should produce the correct behavior wrt. their semantics.
   The problem is that correct here means that the behavior is the same that any real device would produce.
   Since we cannot possibly account for all device types, we instead focus on those that conform to the OpenFlow specifications.
   To account for the multiple different versions of the specification (e.g.~\cite{specification10,specification15}), we tried making our model a subset of 
   both the oldest stable version 1.0~\cite{specification10} and the newest available specification version 1.5.1~\cite{specification15}.
 \item Conversely, our model does not need to represent all possible behavior of an OpenFlow switch, just the behavior that can be invoked by the result of our translation.
   This is especially useful regarding for controller interaction, but also for MPLS or VLANs, which we did not model in Section \ref{sec:lfw}.
 \end{itemize}\<close>
 
 text\<open>More concretely, we set the following rough outline for our model.
 \begin{itemize}
   \item A switch consists of a single flow table.
   \item A flow table entry consists of a priority, a match condition and an action list.
   \item The only possible action (we require) is to forward the packet on a port.
   \item We do not model controller interaction.
 \end{itemize}
 Additionally, we decided that we wanted to be able to ensure the validity of the flow table in all qualities,
 i.e. we want to model the conditions `no overlapping flow entries appear', `all match conditions have their necessary preconditions'.
 The details of this are explained in the following sections.
 \<close>
 
 subsubsection\<open>Matching Flow Table entries\<close>
 text_raw\<open>\label{sec:of_match}\<close>
 text\<open>Table 3 of Section 3.1 of \cite{specification10} gives a list of required packet fields that can be used to match packets.
 This directly translates into the type for a match expression on a single field:\<close>
 
 schematic_goal "(field_match :: of_match_field) \<in> {
   IngressPort (?s::string),
   EtherSrc (?as::48 word), EtherDst (?ad::48 word),
 	EtherType (?t::16 word),
 	VlanId (?i::16 word), VlanPriority (?p::16 word),
 	IPv4Src (?pms::32 prefix_match), 
 	IPv4Dst (?pmd::32 prefix_match),
 	IPv4Proto (?ipp :: 8 word),
 	L4Src (?ps :: 16 word) (?ms :: 16 word),
 	L4Dst (?pd :: 16 word) (?md :: 16 word)
 }" by(fact of_match_field_typeset)
 text\<open>
 Two things are worth additional mention: L3 and L4 ``addressess''.
 The @{term IPv4Src} and @{term IPv4Dst} matches are specified as ``can be subnet masked'' in~\cite{specification10}, 
   whereras~\cite{specification15} states clearly that arbitrary bitmasks can be used. We took the conservative approach here.
 Our alteration of @{term L4Src} and @{term L4Dst} is more grave. While~\cite{specification10} does not state anything about layer 4 ports and masks,
 \cite{specification15} specifically forbids using masks on them. 
 Nevertheless, OpenVSwitch \cite{openvswitch} and some other implementations support them.
 We will explain in detail why we must include bitmasks on layer 4 ports to obtain a meaningful translation in Section~\ref{sec:convi}.\<close>
 
 text\<open>One @{type of_match_field} is not enough to classify a packet. 
 To match packets, we thus use entire sets of match fields.
 As Guha \emph{et al.}~\cite{guha2013machine} noted\footnote{See also: \cite[\<section>2.3]{michaelis2016middlebox}}, executing a set of given @{type of_match_field}s on a packet requires careful consideration.
 For example, it is not meaningful to use @{term IPv4Dst} if the given packet is not actually an IP packet, i.e.
 @{term IPv4Dst} has the prerequisite of @{term "EtherType 0x0800"} being among the match fields.
 Guha \emph{et al.} decided to use the fact that the preconditions can be arranged on a directed acyclic graph (or rather: an acyclic forest).
 They evaluated match conditions in a manner following that graph:
 first, all field matches without preconditions are evaluated.
 Upon evaluating a field match (e.g., @{term "EtherType 0x0800"}), the matches that had their precondition fulfilled by it
   (e.g., @{term IPv4Src} and @{term IPv4Src} in this example) are evalutated.
 This mirrors the faulty behavior of some implementations (see \cite{guha2013machine}).
 Adopting that behavior into our model would mean that any packet matches against the field match set @{term "{IPv4Dst (PrefixMatch 134744072 32)}"} 
 instead of just those destined for 8.8.8.8 or causing an error. We found this to be unsatisfactory.\<close>
 
 text\<open>To solve this problem, we made three definitions.
 The first, @{term match_no_prereq} matches an @{type of_match_field} against a packet without considering prerequisites.
 The second, @{term prerequisites}, checks for a given @{type of_match_field} whether its prerequisites are in a set of given match fields.
 Especially:
 \<close>
 lemma 
   "prerequisites (VlanPriority pri) m = (\<exists>id. let v = VlanId id in v \<in> m \<and> prerequisites v m)"
   "prerequisites (IPv4Proto pr) m = (let v = EtherType 0x0800 in v \<in> m \<and> prerequisites v m)"
   "prerequisites (IPv4Src a) m = (let v = EtherType 0x0800 in v \<in> m \<and> prerequisites v m)"
   "prerequisites (IPv4Dst a) m = (let v = EtherType 0x0800 in v \<in> m \<and> prerequisites v m)"
   "prerequisites (L4Src p msk) m = (\<exists>proto \<in> {TCP,UDP,L4_Protocol.SCTP}. let v = IPv4Proto proto in v \<in> m \<and> prerequisites v m)"
   "prerequisites (L4Dst p msk) m = prerequisites (L4Src undefined undefined) m"
   by(fact prerequisites.simps)+
 text\<open>Then, to actually match a set of @{type of_match_field} against a packet, we use the option type:\<close>
 lemma "OF_match_fields m p =
   (if \<exists>f \<in> m. \<not>prerequisites f m then None else 
     if \<forall>f \<in> m. match_no_prereq f p then Some True else Some False)"
 by(fact OF_match_fields_alt)
 
 subsubsection\<open>Evaluating a Flow Table\<close>
 text\<open>In the previous section, we explained how we match the set of match fields belonging to a single flow entry against a packet.
 This section explains how the correct flow entry from a table can be selected.
 To prevent to much entanglement with the previous section, we assume an arbitrary match function @{term "\<gamma> :: 'match_field set \<Rightarrow> 'packet \<Rightarrow> bool"}.
 This function @{term "\<gamma>"} takes the match condition @{term m} from a flow entry @{term "OFEntry (priority::16 word) (m::'match_field set) action"}
 and decides whether a packet matches those.\<close>
 
 text\<open>The flow table is simply a list of flow table entries @{type flow_entry_match}.
 Deciding the right flow entry to use for a given packet is explained in the OpenFlow specification \cite{specification10}, Section 3.4:
 \begin{quote}
   Packets are matched against flow entries based on prioritization. 
   An entry that specifies an exact match (i.e., has no wildcards) is always the highest priority\footnote{This behavior has been deprecated.}.
   All wildcard entries have a priority associated with them. 
   Higher priority entries must match before lower priority ones.
   If multiple entries have the same priority, the switch is free to choose any ordering.
 \end{quote}
 We use the term ``overlapping'' for  the flow entries that can cause a packet to match multiple flow entries with the same priority.
 Guha \emph{et al.}~\cite{guha2013machine} have dealt with overlapping.
 However, the semantics for a flow table they presented \cite[Figure 5]{guha2013machine}
   is slightly different from what they actually used in their theory files.
 We have tried to reproduce the original inductive definition (while keeping our abstraction @{term \<gamma>}),
  in Isabelle/HOL\footnote{The original is written in Coq~\cite{barras1997coq} and we can not use it directly.}:\<close>
 lemma "\<gamma> (ofe_fields fe) p = True \<Longrightarrow>
  \<forall>fe' \<in> set (ft1 @ ft2). ofe_prio fe' > ofe_prio fe \<longrightarrow> \<gamma> (ofe_fields fe') p = False \<Longrightarrow> 
  guha_table_semantics \<gamma> (ft1 @ fe # ft2) p (Some (ofe_action fe))" 
  "\<forall>fe \<in> set ft. \<gamma> (ofe_fields fe) p = False \<Longrightarrow>
  guha_table_semantics \<gamma> ft p None" by(fact guha_matched guha_unmatched)+
 text\<open>Guha \emph{et al.} have deliberately made their semantics non-deterministic, to match the fact that the switch ``may choose any ordering''.
 This can lead to undesired results:\<close>
 lemma "CARD('action) \<ge> 2 \<Longrightarrow> \<exists>ff. \<gamma> ff p \<Longrightarrow> \<exists>ft (a1 :: 'action) (a2 :: 'action). a1 \<noteq> a2 \<and> guha_table_semantics \<gamma> ft p (Some a1) \<and> guha_table_semantics \<gamma> ft p (Some a2)"
 by(fact guha_table_semantics_ex2res)
 text\<open>This means that, given at least two distinct actions exist and our matcher @{term \<gamma>} is not false for all possible match conditions, 
 we can say that a flow table and two actions exist such that both actions are executed. This can be misleading, as the switch might choose an 
 ordering on some flow table and never execute some of the (overlapped) actions.\<close>
 
 text\<open>Instead, we decided to follow Section 5.3 of the specification \cite{specification15}, which states:
 \begin{quote}
   If there are multiple matching flow entries, the selected flow entry is explicitly undefined.
 \end{quote}
 This still leaves some room for interpretation, but it clearly states that overlapping flow entries are undefined behavior, 
   and undefined behavior should not be invoked.
 Thus, we came up with a semantics that clearly indicates when undefined behavior has been invoked:\<close>
 lemma
   "OF_priority_match \<gamma> flow_entries packet = (
   let m  = filter (\<lambda>f. \<gamma> (ofe_fields f) packet) flow_entries;
   	  m' = filter (\<lambda>f. \<forall>fo \<in> set m. ofe_prio fo \<le> ofe_prio f) m in
   	case m' of []  \<Rightarrow> NoAction
              | [s] \<Rightarrow> Action (ofe_action s)
              |  _  \<Rightarrow> Undefined)"
 unfolding OF_priority_match_def ..
 text\<open>The definition works the following way\footnote{Note that the order of the flow table entries is irrelevant. 
 We could have made this definition on sets but chose not to for consistency.}:
 \begin{enumerate}
   \item The flow table is filtered for those entries that match, the result is called $m$.
   \item $m$ is filtered again, leaving only those entries for which no entries with lower priority could be found, i.e. the matching flow table entries with minimal priority. The result is called $m'$.
   \item A case distinction on $m'$ is made. If only one matching entry was found, its action is returned for execution. 
   If $m$ is empty, the flow table semantics returns @{term NoAction} to indicate that the flow table does not decide an action for the packet.
   If,  not zero or one entry is found, but more, the special value @{term Undefined} for indicating undefined behavior is returned.
 \end{enumerate}
 The use of @{term Undefined} immediately raises the question in which condition it cannot occur.
 We give the following definition:\<close>
 lemma "check_no_overlap \<gamma> ft = (\<forall>a \<in> set ft. \<forall>b \<in> set ft. (a \<noteq> b \<and> ofe_prio a = ofe_prio b) \<longrightarrow> \<not>(\<exists>p. \<gamma> (ofe_fields a) p \<and> \<gamma> (ofe_fields b) p))" unfolding check_no_overlap_alt check_no_overlap2_def by force
 text\<open>Together with distinctness of the flow table, this provides the abscence of @{term Undefined}\footnote{It is slightly stronger than necessary, overlapping rules might be shadowed and thus never influence the behavior.}:\<close>
 lemma "\<lbrakk>check_no_overlap \<gamma> ft; distinct ft\<rbrakk> \<Longrightarrow>
   OF_priority_match \<gamma> ft p \<noteq> Undefined" by (simp add: no_overlapsI no_overlaps_not_unefined)
 
 text\<open>Given the absence of overlapping or duplicate flow entries, we can show two interesting equivalences.
 the first is the equality to the semantics defined by Guha \emph{et al.}:\<close>
 lemma "\<lbrakk>check_no_overlap \<gamma> ft; distinct ft\<rbrakk> \<Longrightarrow> 
 OF_priority_match \<gamma> ft p = option_to_ftb d \<longleftrightarrow> guha_table_semantics \<gamma> ft p d"
 by (simp add: guha_equal no_overlapsI)
 text\<open>where @{term option_to_ftb} maps between the return type of @{term OF_priority_match} and an option type as one would expect.\<close>
 
 text\<open>The second equality for @{term OF_priority_match} is one that helps reasoning about flow tables.
 We define a simple recursive traversal for flow tables:\<close>
 lemma
   "OF_match_linear \<gamma> [] p = NoAction"
   "OF_match_linear \<gamma> (a#as) p = (if \<gamma> (ofe_fields a) p then Action (ofe_action a) else OF_match_linear \<gamma> as p)"
 by(fact OF_match_linear.simps)+
 text\<open>For this definition to be equivalent, we need the flow table to be sorted:\<close>
 lemma"
 	\<lbrakk>no_overlaps \<gamma> f ;sorted_descending (map ofe_prio f)\<rbrakk> \<Longrightarrow>
 	OF_match_linear \<gamma> f p = OF_priority_match \<gamma> f p"
 by(fact  OF_eq)
 
 text\<open>As the last step, we implemented a serialization function for flow entries; it has to remain unverified.
 The serialization function deals with one little inaccuracy: We have modelled the @{term IngressPort} match to use the interface name, but OpenFlow requires numerical interface IDs instead.
 We deemed that pulling this translation step into the main translation would only make the correctness lemma of the translation more complicated while not increasing the confidence in the correctness significantly.
 We thus made replacing interface names by their ID part of the serialization.
 \<close>
 
 text\<open>Having collected all important definitions and models, we can move on to the conversion.\<close>
 (*text\<open>\todo{Maybe I should make a sweet little subsection that merges this all into a single model definition.}\<close>*)
 
 subsection\<open>Translation Implementation\<close>
 text_raw\<open>\label{sec:convi}\<close>
 text\<open>This section explains how the functions that are executed sequentially in a linux firewall can be compressed into a single OpenFlow table.
 Creating this flow table in a single step would be immensely complicated.
 We thus divided the task into several steps using the following key insights:
 \begin{itemize}
   \item All steps that are executed in the linux router can be formulated as a firewall, more specifically, a generalization of @{term simple_fw} that allows arbitrary actions instead of just accept and drop.
   \item A function that computes the conjunction of two @{term simple_fw} matches is already present.
     Extending this to a function that computes the join of two firewalls is relatively simple. This is explained in Section \ref{sec:fwconj}
 \end{itemize}
 \<close>
 subsubsection\<open>Chaining Firewalls\<close>
 text_raw\<open>\label{sec:fwconj}\<close>
 text\<open>This section explains how to compute the join of two firewalls.\<close>
 text\<open>The basis of this is a generalization of @{const simple_fw}.
 Instead of only allowing @{const simple_action.Accept} or @{const simple_action.Drop} as actions, it allows arbitrary actions. The type of the function that evaluates this generalized simple firewall is
 @{term "generalized_sfw :: ('i::len simple_match \<times> 'a) list \<Rightarrow> ('i, 'b) simple_packet_scheme \<Rightarrow> ('i simple_match \<times> 'a) option"}.
 The definition is straightforward:\<close>
 lemma 
 "generalized_sfw [] p = None" 
 "generalized_sfw (a # as) p = (if (case a of (m,_) \<Rightarrow> simple_matches m p) then Some a else generalized_sfw as p)"
 	by(fact generalized_sfw_simps)+
 text\<open>Based on that, we asked: if @{term fw\<^sub>1} makes the decision @{term a} (where @{term a} is the second element of the result tuple from @{const generalized_sfw}) and @{term fw\<^sub>2} makes the decision @{term b}, how can we compute the firewall that
 makes the decision @{term "(a,b)"}\footnote{Note that tuples are right-associative in Isabelle/HOL, i.e., @{term "(a::'a,(b,c)::('b\<times>'c))"} is a pair of @{term a} and the pair @{term "(b,c)"}}.
 One possible answer is given by the following definition:
 \<close>
 lemma "generalized_fw_join l1 l2 \<equiv> [(u,a,b). (m1,a) \<leftarrow> l1, (m2,b) \<leftarrow> l2, u \<leftarrow> (case simple_match_and m1 m2 of None \<Rightarrow> [] | Some s \<Rightarrow> [s])]"
 by(fact generalized_fw_join_def[unfolded option2list_def])+
 text\<open>This definition validates the following lemma:\<close>
 lemma "generalized_sfw (generalized_fw_join fw\<^sub>1 fw\<^sub>2) p = Some (u, d\<^sub>1,d\<^sub>2) \<longleftrightarrow> (\<exists>r\<^sub>1 r\<^sub>2. generalized_sfw fw\<^sub>1 p = Some (r\<^sub>1,d\<^sub>1) \<and> generalized_sfw fw\<^sub>2 p = Some (r\<^sub>2,d\<^sub>2) \<and> Some u = simple_match_and r\<^sub>1 r\<^sub>2)"
   by(force dest: generalized_fw_joinD generalized_fw_joinI intro: Some_to_the[symmetric])
 text\<open>Thus, @{const generalized_fw_join} has a number of applications.
 For example, it could be used to compute a firewall ruleset that represents two firewalls that are executed in sequence.
 \<close>
 definition "simple_action_conj a b \<equiv> (if a = simple_action.Accept \<and> b = simple_action.Accept then simple_action.Accept else simple_action.Drop)"
 definition "simple_rule_conj \<equiv> (uncurry SimpleRule \<circ> apsnd (uncurry simple_action_conj))"
 theorem "simple_fw rs\<^sub>1 p = Decision FinalAllow \<and> simple_fw rs\<^sub>2 p = Decision FinalAllow \<longleftrightarrow>
 simple_fw (map simple_rule_conj (generalized_fw_join (map simple_rule_dtor rs\<^sub>1) (map simple_rule_dtor rs\<^sub>2))) p = Decision FinalAllow"
 unfolding simple_rule_conj_def simple_action_conj_def[abs_def] using simple_fw_join by(force simp add: comp_def apsnd_def map_prod_def case_prod_unfold uncurry_def[abs_def])
 text\<open>Using the join, it should be possible to compute any $n$-ary logical operation on firewalls.
 We will use it for something somewhat different in the next section.\<close>
 
 subsubsection\<open>Translation Implementation\<close>
 
 text_raw\<open>
 \begin{figure*}
 \begin{framed}
 \<close>
 lemma "lr_of_tran rt fw ifs \<equiv> 
 if \<not> (no_oif_match fw \<and> has_default_policy fw \<and> simple_fw_valid fw	\<and> valid_prefixes rt \<and> has_default_route rt \<and> distinct ifs)
   then Inl ''Error in creating OpenFlow table: prerequisites not satisifed''
   else (
 let
   nfw = map simple_rule_dtor fw; 
   frt = map (\<lambda>r. (route2match r, output_iface (routing_action r))) rt; 
   nrd = generalized_fw_join frt nfw;
   ard = (map (apfst of_nat) \<circ> annotate_rlen) nrd
   in
   if length nrd < unat (max_word :: 16 word)
   then Inr (pack_OF_entries ifs ard)
   else Inl ''Error in creating OpenFlow table: priority number space exhausted''
 )"
 unfolding Let_def lr_of_tran_def lr_of_tran_fbs_def lr_of_tran_s1_def comp_def route2match_def by force
 
 text_raw\<open>
   \end{framed}
   \caption{Function for translating a @{typ "'i::len simple_rule list"}, a @{typ "'i routing_rule list"}, and a list of interfaces to a flow table.}
   \label{fig:convi}
 \end{figure*}
 \<close>
 
 text\<open>
 This section shows the actual definition of the translation function, in Figure~\ref{fig:convi}.
 Before beginning the translation, the definition checks whether the necessary preconditions are valid.
 This first two steps are to convert @{term fw} and @{term rt} to lists that can be evaluated by @{const generalized_sfw}.
 For @{term fw}, this is done by @{term "map simple_rule_dtor"}, which just deconstructs @{type simple_rule}s into tuples of match and action.
 For @{term rt}, we made a firewall ruleset with rules that use prefix matches on the destination IP address.
 The next step is to join the two rulesets.
  The result of the join is a ruleset with rules @{term r} that only match if both, the corresponding firewall rule @{term fwr} and the corresponding routing rule @{term rr} matches.
 The data accompanying @{term r} is the port from @{term rr} and the firewall decision from @{term fwr}.
 Next, descending priorities are added to the rules using @{term "map (apfst word_of_nat) \<circ> annotate_rlen"}.
 If the number of rules is too large to fit into the $2^{16}$ priority classes, an error is returned.
 Otherwise, the function @{const pack_OF_entries} is used to convert the @{typ "(16 word \<times> 32 simple_match \<times> char list \<times> simple_action) list"} to an OpenFlow table.
 While converting the @{typ "char list \<times> simple_action"} tuple is straightforward, converting the @{type simple_match} to an equivalent list of @{typ "of_match_field set"} is non-trivial.
 This is done by the function @{const simple_match_to_of_match}.
 \<close>
 text\<open>The main difficulties for @{const simple_match_to_of_match} lie in making sure that the prerequisites are satisfied
  and in the fact that a @{type simple_match} operates on slightly stronger match expressions.
 \begin{itemize}
   \item A @{type simple_match} allows a (string) prefix match on the input and output interfaces.
     Given a list of existing interfaces on the router @{term ifs}, the function has to insert flow entries for each interface matching the prefix.
   \item A @{type simple_match} can match ports by an interval. Now it becomes obvious why Section~\ref{sec:of_match} added bitmasks to @{const L4Src} and @{const L4Dst}.
     Using the algorithm to split word intervals into intervals that can be represented by prefix matches from~\cite{diekmann2016verified},
       we can efficiently represent the original interval by a few (32 in the worst case) prefix matches and insert flow entries for each of them.%
       \footnote{It might be possible to represent the interval match more efficiently than a split into prefixes. However, that would produce overlapping matches (which is not a problem if we assing separate priorities) 
         and we did not have a verified implementation of an algorithm that does so.}
 \end{itemize}
 The following lemma characterizes @{const simple_match_to_of_match}:
 \<close>
 lemma simple_match_to_of_match:
 assumes
   "simple_match_valid r" 
   "p_iiface p \<in> set ifs" 
   "match_iface (oiface r) (p_oiface p)"
   "p_l2type p = 0x800"
 shows
   "simple_matches r p \<longleftrightarrow> (\<exists>gr \<in> set (simple_match_to_of_match r ifs). OF_match_fields gr p = Some True)"
 using assms simple_match_to_of_matchD simple_match_to_of_matchI by blast
 
 text\<open>The assumptions are to be read as follows:
 \begin{itemize}
   \item The match @{term r} has to be valid, i.e. it has to use @{const valid_prefix} matches, and it cannot use anything other than $0$-$65535$ for the port matches unless its protocol match ensures @{const TCP}, @{const UDP} or @{const L4_Protocol.SCTP}.
   \item @{const simple_match_to_of_match} cannot produce rules for packets that have input interfaces that are not named in the interface list.
   \item The output interface of @{term p} has to match the output interface match of @{term r}. This is a weakened formulation of @{term "oiface r = ifaceAny"}, since @{thm[display] match_ifaceAny[no_vars]}.
     We require this because OpenFlow field matches cannot be used to match on the output port --- they are supposed to match a packet and decide an output port.
   \item The @{type simple_match} type was designed for IP(v4) packets, we limit ourselves to them.
 \end{itemize}
 The conclusion then states that the @{type simple_match} @{term r} matches iff an element of the result of @{const simple_match_to_of_match} matches.
 The third assumption is part of the explanation why we did not use @{const simple_linux_router_altered}:
 @{const simple_match_to_of_match} cannot deal with output interface matches. 
 Thus, before passing a generalized simple firewall to @{const pack_OF_entries}, we would have to set the output ports to @{const ifaceAny}.
 A system replace output interface matches with destination IP addresses has already been formalized and will be published in a future version of \cite{Iptables_Semantics-AFP}.
 For now, we limit ourselves to firewalls that do not do output port matching, i.e., we require @{term "no_oif_match fw"}.
 \<close>
 
 text_raw\<open>\begin{figure*}
 \begin{framed}
 \<close>
 theorem
 fixes
   p :: "(32, 'a) simple_packet_ext_scheme"
 assumes
   "p_iiface p \<in> set ifs" and "p_l2type p = 0x800"
   "lr_of_tran rt fw ifs = Inr oft"
 shows
   "OF_priority_match OF_match_fields_safe oft p = Action [Forward oif] \<longleftrightarrow> simple_linux_router_nol12 rt fw p = (Some (p\<lparr>p_oiface := oif\<rparr>))"
   "OF_priority_match OF_match_fields_safe oft p = Action [] \<longleftrightarrow> simple_linux_router_nol12 rt fw p = None"
   "OF_priority_match OF_match_fields_safe oft p \<noteq> NoAction" "OF_priority_match OF_match_fields_safe oft p \<noteq> Undefined"
   "OF_priority_match OF_match_fields_safe oft p = Action ls \<longrightarrow> length ls \<le> 1"
   "\<exists>ls. length ls \<le> 1 \<and> OF_priority_match OF_match_fields_safe oft p = Action ls"
 using assms lr_of_tran_correct by simp_all
 text_raw\<open>
 \end{framed}
 \caption{Central theorem on @{const lr_of_tran}}
 \label{fig:central}
 \end{figure*}
 \<close>
 
 text\<open>
 Given discussed properties, we present the central theorem for our translation in Figure~\ref{fig:central}.
 The first two assumptions are limitations on the traffic we make a statement about.
 Obviously, we will never see any packets with an input interface that is not in the interface list.
 Furthermore, we do not state anything about non-IPv4 traffic. (The traffic will remain unmatched in by the flow table, but we have not verified that.)
 The last assumption is that the translation does not return a run-time error.
 The translation will return a run-time error if the rules can not be assigned priorities from a 16 bit integer, 
 or when one of the following conditions on the input data is not satisifed:\<close>
 lemma "
   \<not> no_oif_match fw \<or> 
   \<not> has_default_policy fw \<or>
   \<not> simple_fw_valid fw	\<or>
   \<not> valid_prefixes rt \<or>
   \<not> has_default_route rt \<or>
   \<not> distinct ifs \<Longrightarrow> 
 \<exists>err. lr_of_tran rt fw ifs = Inl err" unfolding lr_of_tran_def by(simp split: if_splits)
 
 subsubsection\<open>Comparison to Exodus\<close>
 text\<open>
   We are not the first researchers to attempt automated static migration to SDN.
   The (only) other attempt we are aware of is \emph{Exodus} by Nelson \emph{et al.}~\cite{nelson2015exodus}.
 \<close>
 text\<open>
 There are some fundamental differences between Exodus and our work:
 \begin{itemize}
   \item Exodus focuses on Cisco IOS instead of linux.
   \item Exodus does not produce OpenFlow rulesets, but FlowLog~\cite{nelson2014tierless} controller programs.
   \item Exodus is not limited to using a single flow table.
   \item Exodus requires continuous controller interaction for some of its functions.
   \item Exodus attempts to support as much functionality as possible and has implemented support for dynamic routing, VLANs and NAT.
   \item Nelson \emph{et al.} reject the idea that the translation could or should be proven correct.
 \end{itemize}
 \<close>
 
 (*<*)
 end
 (*>*)
diff --git a/thys/Native_Word/Code_Target_Word_Base.thy b/thys/Native_Word/Code_Target_Word_Base.thy
--- a/thys/Native_Word/Code_Target_Word_Base.thy
+++ b/thys/Native_Word/Code_Target_Word_Base.thy
@@ -1,439 +1,439 @@
 (*  Title:      Code_Target_Word_Base.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Common base for target language implementations of word types\<close>
 
 theory Code_Target_Word_Base imports
   "HOL-Word.Word"
   Bits_Integer
 begin
 
 text \<open>More lemmas\<close>
 
 lemma nat_div_eq_Suc_0_iff: "n div m = Suc 0 \<longleftrightarrow> m \<le> n \<and> n < 2 * m"
   apply auto
   using div_greater_zero_iff apply fastforce
    apply (metis One_nat_def div_greater_zero_iff dividend_less_div_times mult.right_neutral mult_Suc mult_numeral_1 numeral_2_eq_2 zero_less_numeral)
   apply (simp add: div_nat_eqI)
   done
 
 lemma Suc_0_lt_2p_len_of: "Suc 0 < 2 ^ LENGTH('a :: len)"
   by (metis One_nat_def len_gt_0 lessI numeral_2_eq_2 one_less_power)
 
 lemma div_half_nat:
   fixes x y :: nat
   assumes "y \<noteq> 0"
   shows "(x div y, x mod y) = (let q = 2 * (x div 2 div y); r = x - q * y in if y \<le> r then (q + 1, r - y) else (q, r))"
 proof -
   let ?q = "2 * (x div 2 div y)"
   have q: "?q = x div y - x div y mod 2"
     by(metis div_mult2_eq mult.commute minus_mod_eq_mult_div [symmetric])
   let ?r = "x - ?q * y"
   have r: "?r = x mod y + x div y mod 2 * y"
     by(simp add: q diff_mult_distrib minus_mod_eq_div_mult [symmetric])(metis diff_diff_cancel mod_less_eq_dividend mod_mult2_eq add.commute mult.commute)
 
   show ?thesis
   proof(cases "y \<le> x - ?q * y")
     case True
     with assms q have "x div y mod 2 \<noteq> 0" unfolding r
       by (metis Nat.add_0_right diff_0_eq_0 diff_Suc_1 le_div_geq mod2_gr_0 mod_div_trivial mult_0 neq0_conv numeral_1_eq_Suc_0 numerals(1)) 
     hence "x div y = ?q + 1" unfolding q
       by simp
     moreover hence "x mod y = ?r - y"
       by simp(metis minus_div_mult_eq_mod [symmetric] diff_commute diff_diff_left mult_Suc)
     ultimately show ?thesis using True by(simp add: Let_def)
   next
     case False
     hence "x div y mod 2 = 0" unfolding r
       by(simp add: not_le)(metis Nat.add_0_right assms div_less div_mult_self2 mod_div_trivial mult.commute)
     hence "x div y = ?q" unfolding q by simp
     moreover hence "x mod y = ?r" by (metis minus_div_mult_eq_mod [symmetric])
     ultimately show ?thesis using False by(simp add: Let_def)
   qed
 qed
 
 lemma unat_p2: "n < LENGTH('a :: len) \<Longrightarrow> unat (2 ^ n :: 'a word) = 2 ^ n"
 proof(induct n)
   case 0 thus ?case by simp
 next
   case (Suc n)
   then obtain n' where "LENGTH('a) = Suc n'" by(cases "LENGTH('a)") simp_all
   with Suc show ?case by (simp add: unat_word_ariths bintrunc_mod2p)
 qed
 
 lemma word_div_lt_eq_0:
   "x < y \<Longrightarrow> x div y = 0" for x :: "'a :: len word"
   by (simp add: word_eq_iff word_less_def word_test_bit_def uint_div)
 
 lemma word_div_eq_1_iff: "n div m = 1 \<longleftrightarrow> n \<ge> m \<and> unat n < 2 * unat (m :: 'a :: len word)"
 apply(simp only: word_arith_nat_defs word_le_nat_alt nat_div_eq_Suc_0_iff[symmetric])
 apply(rule word_unat.Abs_inject)
  apply(simp only: unat_div[symmetric] word_unat.Rep)
 apply(simp add: unats_def Suc_0_lt_2p_len_of)
 done
 
 lemma div_half_word:
   fixes x y :: "'a :: len word"
   assumes "y \<noteq> 0"
   shows "(x div y, x mod y) = (let q = (x >> 1) div y << 1; r = x - q * y in if y \<le> r then (q + 1, r - y) else (q, r))"
 proof -
   obtain n where n: "x = of_nat n" "n < 2 ^ LENGTH('a)" by (cases x)
   moreover obtain m where m: "y = of_nat m" "m < 2 ^ LENGTH('a)" by (cases y)
   ultimately have [simp]: \<open>unat (of_nat n :: 'a word) = n\<close> \<open>unat (of_nat m :: 'a word) = m\<close>
-    by (simp add: unat_def, transfer, simp_all add: take_bit_of_nat take_bit_eq_self)+
+    by (transfer, simp add: take_bit_of_nat take_bit_eq_self)+
   let ?q = "(x >> 1) div y << 1"
   let ?q' = "2 * (n div 2 div m)"
   have "n div 2 div m < 2 ^ LENGTH('a)" using n by (metis of_nat_inverse unat_lt2p uno_simps(2))
   hence q: "?q = of_nat ?q'" using n m
     apply (auto simp add: shiftr_word_eq drop_bit_eq_div shiftl_t2n word_arith_nat_div uno_simps)
     apply (metis \<open>unat (of_nat n) = n\<close> uno_simps(2))
     done
   from assms have "m \<noteq> 0" using m by -(rule notI, simp)
 
   from n have "2 * (n div 2 div m) < 2 ^ LENGTH('a)"
     by(metis mult.commute div_mult2_eq minus_mod_eq_mult_div [symmetric] less_imp_diff_less of_nat_inverse unat_lt2p uno_simps(2))
   moreover
   have "2 * (n div 2 div m) * m < 2 ^ LENGTH('a)" using n unfolding div_mult2_eq[symmetric]
     by(subst (2) mult.commute)(simp add: minus_mod_eq_div_mult [symmetric] diff_mult_distrib minus_mod_eq_mult_div [symmetric] div_mult2_eq)
   moreover have "2 * (n div 2 div m) * m \<le> n"
     by (metis div_mult2_eq dtle mult.assoc mult.left_commute)
   ultimately
   have r: "x - ?q * y = of_nat (n - ?q' * m)"
     and "y \<le> x - ?q * y \<Longrightarrow> of_nat (n - ?q' * m) - y = of_nat (n - ?q' * m - m)"
     using n m unfolding q
     by (simp_all add: word_sub_wi word_mult_def uint_nat unat_of_nat of_nat_mult [symmetric] word_of_nat[symmetric] of_nat_diff word_le_nat_alt del: of_nat_mult)
       (metis diff_diff_left less_imp_diff_less of_nat_diff of_nat_inverse word_of_nat)
   thus ?thesis using n m div_half_nat[OF \<open>m \<noteq> 0\<close>, of n] unfolding q
     by(simp add: word_le_nat_alt word_div_def word_mod_def uint_nat unat_of_nat zmod_int[symmetric] zdiv_int[symmetric] word_of_nat[symmetric])(simp add: Let_def split del: if_split split: if_split_asm)
 qed
 
 lemma word_test_bit_set_bits: "(BITS n. f n :: 'a :: len word) !! n \<longleftrightarrow> n < LENGTH('a) \<and> f n"
   by (simp add: test_bit_eq_bit bit_set_bits_word_iff)
 
 lemma word_of_int_conv_set_bits: "word_of_int i = (BITS n. i !! n)"
   by (rule word_eqI) (auto simp add: word_test_bit_set_bits test_bit.eq_norm)
 
 lemma word_and_mask_or_conv_and_mask:
   "n !! index \<Longrightarrow> (n AND mask index) OR (1 << index) = n AND mask (index + 1)"
 by(rule word_eqI)(auto simp add: word_ao_nth word_size nth_shiftl simp del: shiftl_1)
 
 lemma uint_and_mask_or_full:
   fixes n :: "'a :: len word"
   assumes "n !! (LENGTH('a) - 1)"
   and "mask1 = mask (LENGTH('a) - 1)"
   and "mask2 = 1 << LENGTH('a) - 1"
   shows "uint (n AND mask1) OR mask2 = uint n"
 proof -
   have "mask2 = uint (1 << LENGTH('a) - 1 :: 'a word)" using assms
     by (simp add: uint_shiftl word_size bintrunc_shiftl del: shiftl_1)
   hence "uint (n AND mask1) OR mask2 = uint (n AND mask1 OR (1 << LENGTH('a) - 1 :: 'a word))"
     by(simp add: uint_or)
   also have "\<dots> = uint (n AND mask (LENGTH('a) - 1 + 1))"
     using assms by(simp only: word_and_mask_or_conv_and_mask)
   also have "\<dots> = uint n" by simp
   finally show ?thesis .
 qed
 
 
 text \<open>Division on @{typ "'a word"} is unsigned, but Scala and OCaml only have signed division and modulus.\<close>
 
 definition word_sdiv :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "sdiv" 70)
 where [code]:
   "x sdiv y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0) \<noteq> (y' < 0);
         result = abs x' div abs y'
     in word_of_int (if negative then -result else result))"
 
 definition word_smod :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word" (infixl "smod" 70)
 where [code]:
   "x smod y =
    (let x' = sint x; y' = sint y;
         negative = (x' < 0);
         result = abs x' mod abs y'
     in word_of_int (if negative then -result else result))"
 
 lemma sdiv_smod_id: "(a sdiv b) * b + (a smod b) = a"
 proof -
   note [simp] = word_sdiv_def word_smod_def
   have F5: "\<forall>u::'a word. - (- u) = u" by (metis minus_minus)
   have F7: "\<forall>v u::'a word. u + v = v + u" by(metis add.left_commute add_0_right)
   have F8: "\<forall>(w::'a word) (v::int) u::int. word_of_int u + word_of_int v * w = word_of_int (u + v * sint w)"
     by (metis word_sint.Rep_inverse wi_hom_syms(1) wi_hom_syms(3))
   have "\<exists>u. u = - sint b \<and> word_of_int (sint a mod u + - (- u * (sint a div u))) = a"
     using F5 by (metis minus_minus word_sint.Rep_inverse' mult_minus_left add.commute mult_div_mod_eq [symmetric])
   hence "word_of_int (sint a mod - sint b + - (sint b * (sint a div - sint b))) = a" by (metis equation_minus_iff)
   hence "word_of_int (sint a mod - sint b) + word_of_int (- (sint a div - sint b)) * b = a"
     using F8 by(metis mult.commute mult_minus_left)
   hence eq: "word_of_int (- (sint a div - sint b)) * b + word_of_int (sint a mod - sint b) = a" using F7 by metis
 
   show ?thesis
   proof(cases "sint a < 0")
     case True note a = this
     show ?thesis
     proof(cases "sint b < 0")
       case True
       with a show ?thesis
         by simp (metis F7 F8 eq minus_equation_iff minus_mult_minus mod_div_mult_eq)
     next
       case False
       from eq have "word_of_int (- (- sint a div sint b)) * b + word_of_int (- (- sint a mod sint b)) = a"
         by (metis div_minus_right mod_minus_right)
       with a False show ?thesis by simp
     qed
   next
     case False note a = this
     show ?thesis
     proof(cases "sint b < 0")
       case True
       with a eq show ?thesis by simp
     next
       case False with a show ?thesis
         by simp (metis wi_hom_add wi_hom_mult add.commute mult.commute word_sint.Rep_inverse add.commute mult_div_mod_eq [symmetric])
     qed
   qed
 qed
 
 text \<open>
   This algorithm implements unsigned division in terms of signed division.
   Taken from Hacker's Delight.
 \<close>
 
 lemma divmod_via_sdivmod:
   fixes x y :: "'a :: len word"
   assumes "y \<noteq> 0"
   shows
   "(x div y, x mod y) =
   (if 1 << (LENGTH('a) - 1) \<le> y then if x < y then (0, x) else (1, x - y)
    else let q = ((x >> 1) sdiv y) << 1;
             r = x - q * y
         in if r \<ge> y then (q + 1, r - y) else (q, r))"
 proof(cases "1 << (LENGTH('a) - 1) \<le> y")
   case True
   note y = this
   show ?thesis
   proof(cases "x < y")
     case True
     then have "x mod y = x"
       by (cases x, cases y) (simp add: word_less_def word_mod_def)
     thus ?thesis using True y by(simp add: word_div_lt_eq_0)
   next
     case False
     obtain n where n: "y = of_nat n" "n < 2 ^ LENGTH('a)" by(cases y)
     have "unat x < 2 ^ LENGTH('a)" by(rule unat_lt2p)
     also have "\<dots> = 2 * 2 ^ (LENGTH('a) - 1)"
       by(metis Suc_pred len_gt_0 power_Suc One_nat_def)
     also have "\<dots> \<le> 2 * n" using y n
       by(simp add: word_le_nat_alt unat_of_nat unat_p2)
     finally have div: "x div of_nat n = 1" using False n
       by(simp add: word_div_eq_1_iff not_less word_le_nat_alt unat_of_nat)
     moreover have "x mod y = x - x div y * y"
       by (simp add: minus_div_mult_eq_mod)
     with div n have "x mod y = x - y" by simp
     ultimately show ?thesis using False y n by simp
   qed
 next
   case False
   note y = this
   obtain n where n: "x = of_nat n" "n < 2 ^ LENGTH('a)" by(cases x)
   hence "int n div 2 + 2 ^ (LENGTH('a) - Suc 0) < 2 ^ LENGTH('a)"
     by (cases "LENGTH('a)")
       (simp_all, simp only: of_nat_numeral [where ?'a = int, symmetric]
       zdiv_int [symmetric] of_nat_power [symmetric])
   with y n have "sint (x >> 1) = uint (x >> 1)"
     by (simp add: sint_uint sbintrunc_mod2p shiftr_div_2n) (simp add: uint_nat unat_of_nat)
   moreover have "uint y + 2 ^ (LENGTH('a) - Suc 0) < 2 ^ LENGTH('a)"
     using y by (cases "LENGTH('a)")
       (simp_all add: not_le word_2p_lem word_size)
   then have "sint y = uint y"
     by (simp add: sint_uint sbintrunc_mod2p)
   ultimately show ?thesis using y
     by(subst div_half_word[OF assms])(simp add: word_sdiv_def uint_div[symmetric])
 qed
 
 
 text \<open>More implementations tailored towards target-language implementations\<close>
 
 context
 includes integer.lifting
 begin
 lift_definition word_of_integer :: "integer \<Rightarrow> 'a :: len word" is word_of_int .
 
 lemma word_of_integer_code [code]: "word_of_integer n = word_of_int (int_of_integer n)"
 by(simp add: word_of_integer.rep_eq)
 end
 
 lemma word_of_int_code [code abstract]:
   "uint (word_of_int x :: 'a word) = x AND bin_mask (LENGTH('a :: len))"
 by(simp add: uint_word_of_int and_bin_mask_conv_mod)
 
 context fixes f :: "nat \<Rightarrow> bool" begin
 
 definition set_bits_aux :: \<open>'a word \<Rightarrow> nat \<Rightarrow> 'a :: len word\<close>
   where \<open>set_bits_aux w n = push_bit n w OR take_bit n (set_bits f)\<close>
 
 lemma set_bits_aux_conv:
   \<open>set_bits_aux w n = (w << n) OR (set_bits f AND mask n)\<close>
   by (rule bit_word_eqI)
     (auto simp add: set_bits_aux_def shiftl_word_eq mask_eq_mask bit_and_iff bit_or_iff bit_push_bit_iff bit_take_bit_iff bit_mask_iff bit_set_bits_word_iff exp_eq_zero_iff)
 
 corollary set_bits_conv_set_bits_aux:
   \<open>set_bits f = (set_bits_aux 0 (LENGTH('a)) :: 'a :: len word)\<close>
   by (simp add: set_bits_aux_conv)
 
 lemma set_bits_aux_0 [simp]:
   \<open>set_bits_aux w 0 = w\<close>
   by  (simp add: set_bits_aux_conv)
 
 lemma set_bits_aux_Suc [simp]:
   \<open>set_bits_aux w (Suc n) = set_bits_aux ((w << 1) OR (if f n then 1 else 0)) n\<close>
   by (simp add: set_bits_aux_def shiftl_word_eq bit_eq_iff bit_or_iff bit_push_bit_iff bit_take_bit_iff bit_set_bits_word_iff)
     (auto simp add: bit_exp_iff not_less bit_1_iff less_Suc_eq_le exp_eq_zero_iff)
 
 lemma set_bits_aux_simps [code]:
   \<open>set_bits_aux w 0 = w\<close>
   \<open>set_bits_aux w (Suc n) = set_bits_aux ((w << 1) OR (if f n then 1 else 0)) n\<close>
   by simp_all
 
 end
 
 lemma word_of_int_via_signed:
   fixes mask
   assumes mask_def: "mask = bin_mask (LENGTH('a))"
   and shift_def: "shift = 1 << LENGTH('a)"
   and index_def: "index = LENGTH('a) - 1"
   and overflow_def:"overflow = 1 << (LENGTH('a) - 1)"
   and least_def: "least = - overflow"
   shows
   "(word_of_int i :: 'a :: len word) =
    (let i' = i AND mask
     in if i' !! index then
          if i' - shift < least \<or> overflow \<le> i' - shift then arbitrary1 i' else word_of_int (i' - shift)
        else if i' < least \<or> overflow \<le> i' then arbitrary2 i' else word_of_int i')"
 proof -
   define i' where "i' = i AND mask"
   have "shift = mask + 1" unfolding assms by(simp add: bin_mask_p1_conv_shift)
   hence "i' < shift" by(simp add: mask_def i'_def int_and_le)
   show ?thesis
   proof(cases "i' !! index")
     case True
     hence unf: "i' = overflow OR i'" unfolding assms i'_def
       by(auto intro!: bin_eqI simp add: bin_nth_ops)
     have "overflow \<le> i'" by(subst unf)(rule le_int_or, simp add: bin_sign_and assms i'_def)
     hence "i' - shift < least \<longleftrightarrow> False" unfolding assms
       by(cases "LENGTH('a)")(simp_all add: not_less)
     moreover
     have "overflow \<le> i' - shift \<longleftrightarrow> False" using \<open>i' < shift\<close> unfolding assms
       by(cases "LENGTH('a)")(auto simp add: not_le elim: less_le_trans)
     moreover
     have "word_of_int (i' - shift) = (word_of_int i :: 'a word)" using \<open>i' < shift\<close>
       by(auto intro!: word_eqI simp add: i'_def shift_def mask_def bin_nth_ops bin_nth_minus_p2 bin_sign_and)
     ultimately show ?thesis using True by(simp add: Let_def i'_def)
   next
     case False
     hence "i' = i AND bin_mask (LENGTH('a) - 1)" unfolding assms i'_def
       by(clarsimp simp add: i'_def bin_nth_ops intro!: bin_eqI)(cases "LENGTH('a)", auto simp add: less_Suc_eq)
     also have "\<dots> \<le> bin_mask (LENGTH('a) - 1)" by(rule int_and_le) simp
     also have "\<dots> < overflow" unfolding overflow_def
       by(simp add: bin_mask_p1_conv_shift[symmetric])
     also
     have "least \<le> 0" unfolding least_def overflow_def by simp
     have "0 \<le> i'" by(simp add: i'_def mask_def bin_mask_ge0)
     hence "least \<le> i'" using \<open>least \<le> 0\<close> by simp
     moreover
     have "word_of_int i' = (word_of_int i :: 'a word)"
       by(rule word_eqI)(auto simp add: i'_def bin_nth_ops mask_def)
     ultimately show ?thesis using False by(simp add: Let_def i'_def)
   qed
 qed
 
 
 
 text \<open>Quickcheck conversion functions\<close>
 
 notation scomp (infixl "\<circ>\<rightarrow>" 60)
 
 definition qc_random_cnv ::
   "(natural \<Rightarrow> 'a::term_of) \<Rightarrow> natural \<Rightarrow> Random.seed
     \<Rightarrow> ('a \<times> (unit \<Rightarrow> Code_Evaluation.term)) \<times> Random.seed"
   where "qc_random_cnv a_of_natural i = Random.range (i + 1) \<circ>\<rightarrow> (\<lambda>k. Pair (
        let n = a_of_natural k
        in (n, \<lambda>_. Code_Evaluation.term_of n)))"
 
 no_notation scomp (infixl "\<circ>\<rightarrow>" 60)
 
 definition qc_exhaustive_cnv :: "(natural \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> (bool \<times> term list) option)
   \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option"
 where
   "qc_exhaustive_cnv a_of_natural f d =
    Quickcheck_Exhaustive.exhaustive (%x. f (a_of_natural x)) d"
 
 definition qc_full_exhaustive_cnv ::
   "(natural \<Rightarrow> ('a::term_of)) \<Rightarrow> ('a \<times> (unit \<Rightarrow> term) \<Rightarrow> (bool \<times> term list) option)
   \<Rightarrow> natural \<Rightarrow> (bool \<times> term list) option"
 where
   "qc_full_exhaustive_cnv a_of_natural f d = Quickcheck_Exhaustive.full_exhaustive
   (%(x, xt). f (a_of_natural x, %_. Code_Evaluation.term_of (a_of_natural x))) d"
 
 declare [[quickcheck_narrowing_ghc_options = "-XTypeSynonymInstances"]]
 
 definition qc_narrowing_drawn_from :: "'a list \<Rightarrow> integer \<Rightarrow> _"
 where
   "qc_narrowing_drawn_from xs =
    foldr Quickcheck_Narrowing.sum (map Quickcheck_Narrowing.cons (butlast xs)) (Quickcheck_Narrowing.cons (last xs))"
 
 locale quickcheck_narrowing_samples =
   fixes a_of_integer :: "integer \<Rightarrow> 'a \<times> 'a :: {partial_term_of, term_of}"
   and zero :: "'a"
   and tr :: "typerep"
 begin
 
 function narrowing_samples :: "integer \<Rightarrow> 'a list"
 where
   "narrowing_samples i =
    (if i > 0 then let (a, a') = a_of_integer i in narrowing_samples (i - 1) @ [a, a'] else [zero])"
 by pat_completeness auto
 termination including integer.lifting
 proof(relation "measure nat_of_integer")
   fix i :: integer
   assume "0 < i"
   thus "(i - 1, i) \<in> measure nat_of_integer"
     by simp(transfer, simp)
 qed simp
 
 definition partial_term_of_sample :: "integer \<Rightarrow> 'a"
 where
   "partial_term_of_sample i =
   (if i < 0 then undefined
    else if i = 0 then zero
    else if i mod 2 = 0 then snd (a_of_integer (i div 2))
    else fst (a_of_integer (i div 2 + 1)))"
 
 lemma partial_term_of_code:
   "partial_term_of (ty :: 'a itself) (Quickcheck_Narrowing.Narrowing_variable p t) \<equiv>
     Code_Evaluation.Free (STR ''_'') tr"
   "partial_term_of (ty :: 'a itself) (Quickcheck_Narrowing.Narrowing_constructor i []) \<equiv>
    Code_Evaluation.term_of (partial_term_of_sample i)"
 by (rule partial_term_of_anything)+
 
 end
 
 lemmas [code] =
   quickcheck_narrowing_samples.narrowing_samples.simps
   quickcheck_narrowing_samples.partial_term_of_sample_def
 
 
 text \<open>
   The separate code target \<open>SML_word\<close> collects setups for the
   code generator that PolyML does not provide.
 \<close>
 
 setup \<open>Code_Target.add_derived_target ("SML_word", [(Code_ML.target_SML, I)])\<close>
 
 code_identifier code_module Code_Target_Word_Base \<rightharpoonup>
   (SML) Word and (Haskell) Word and (OCaml) Word and (Scala) Word
 
 export_code sbintrunc bin_mask in SML module_name Code
 
 end
diff --git a/thys/Native_Word/Uint_Userguide.thy b/thys/Native_Word/Uint_Userguide.thy
--- a/thys/Native_Word/Uint_Userguide.thy
+++ b/thys/Native_Word/Uint_Userguide.thy
@@ -1,345 +1,343 @@
 (*  Title:      Uint_Userguide.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>User guide for native words\<close>
 
 (*<*)
 theory Uint_Userguide imports
   Uint32
   Uint16
   Code_Target_Bits_Int
 begin
 (*>*)
 
 text \<open>
   This tutorial explains how to best use the types for native
   words like @{typ "uint32"} in your formalisation.
   You can base your formalisation
   \begin{enumerate}
   \item either directly on these types,
   \item or on the generic @{typ "'a word"} and only introduce native
     words a posteriori via code generator refinement.
   \end{enumerate}
 
   The first option causes the least overhead if you have to prove only
   little about the words you use and start a fresh formalisation.
   Just use the native type @{typ uint32} instead of @{typ "32 word"}
   and similarly for \<open>uint64\<close>, \<open>uint16\<close>, and \<open>uint8\<close>.
   As native word types are meant only for code generation, the lemmas
   about @{typ "'a word"}  have not been duplicated, but you can transfer
   theorems between native word types and @{typ "'a word"} using the
   transfer package.
 
   Note, however, that this option restricts your work a bit:
   your own functions cannot be ``polymorphic'' in the word length,
   but you have to define a separate function for every word length you need.
 
   The second option is recommended if you already have a formalisation
   based on @{typ "'a word"} or if your proofs involve words and their
   properties. It separates code generation from modelling and proving,
   i.e., you can work with words as usual. Consequently, you have to
   manually setup the code generator to use the native types wherever
   you want. The following describes how to achieve this with moderate
   effort.
 
   Note, however, that some target languages of the code generator
   (especially OCaml) do not support all the native word types provided.
   Therefore, you should only import those types that you need -- the
   theory file for each type mentions at the top the restrictions for
   code generation. For example, PolyML does not provide the Word16
   structure, and OCaml provides neither Word8 nor Word16.
   You can still use these theories provided that you also import
   the theory @{theory Native_Word.Code_Target_Bits_Int} (which implements
   @{typ int} by target-language integers), but these words will
   be implemented via Isabelle's \<open>HOL-Word\<close> library, i.e.,
   you do not gain anything in terms of efficiency.
 
   \textbf{There is a separate code target \<open>SML_word\<close> for SML.}
   If you use one of the native words that PolyML does not support
   (such as \<open>uint16\<close> and \<open>uint64\<close> in 32-bit mode), but would
   like to map its operations to the Standard Basis Library functions,
   make sure to use the target \<open>SML_word\<close> instead of \<open>SML\<close>;
   if you only use native word sizes that PolyML supports, you can stick
   with \<open>SML\<close>.  This ensures that code generation within Isabelle
   as used by \<open>Quickcheck\<close>, \<open>value\<close> and @\{code\} in ML blocks
   continues to work.
 \<close>
 
 section \<open>Lifting functions from @{typ "'a word"} to native words\<close>
 
 text \<open>
   This section shows how to convert functions from @{typ "'a word"} to native 
   words. For example, the following function \<open>sum_squares\<close> computes 
   the sum of the first @{term n} square numbers in 16 bit arithmetic using
   a tail-recursive function \<open>gen_sum_squares\<close> with accumulator;
   for convenience, \<open>sum_squares_int\<close> takes an integer instead of a word.
 \<close>
 
 function gen_sum_squares :: "16 word \<Rightarrow> 16 word \<Rightarrow> 16 word" where (*<*)[simp del]:(*>*)
 
   "gen_sum_squares accum n =
    (if n = 0 then accum else gen_sum_squares (accum + n * n) (n - 1))"
 (*<*)by pat_completeness simp
-termination by(relation "measure (nat \<circ> uint \<circ> snd)")
-  (simp_all, metis (hide_lams, mono_tags) uint_1 uint_eq_0 uint_minus_simple_alt uint_sub_ge word_le_sub1 word_less_def word_neq_0_conv word_zero_le zle_diff1_eq)(*>*)
-
+termination by (relation \<open>measure (nat \<circ> uint \<circ> snd)\<close>) (simp_all add: measure_unat)
 
 definition sum_squares :: "16 word \<Rightarrow> 16 word" where
    "sum_squares = gen_sum_squares 0"
 
 definition sum_squares_int :: "int \<Rightarrow> 16 word" where
   "sum_squares_int n = sum_squares (word_of_int n)"
 
 text \<open>
   The generated code for @{term sum_squares} and @{term sum_squares_int} 
   emulates words with unbounded integers and explicit modulus as specified 
   in the theory @{theory "HOL-Word.Word"}. But for efficiency, we want that the
   generated code uses machine words and machine arithmetic. Unfortunately,
   as @{typ "'a word"} is polymorphic in the word length, the code generator
   can only do this if we use another type for machine words. The theory
   @{theory Native_Word.Uint16} defines the type @{typ uint16} for machine words of
   16~bits. We just have to follow two steps to use it:
   
   First, we lift all our functions from @{typ "16 word"} to @{typ uint16},
   i.e., @{term sum_squares}, @{term gen_sum_squares}, and 
   @{term sum_squares_int} in our case. The theory @{theory Native_Word.Uint16} sets
   up the lifting package for this and has already taken care of the
   arithmetic and bit-wise operations.
 \<close>
 lift_definition gen_sum_squares_uint :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16" 
   is gen_sum_squares .
 lift_definition sum_squares_uint :: "uint16 \<Rightarrow> uint16" is sum_squares .
 lift_definition sum_squares_int_uint :: "int \<Rightarrow> uint16" is sum_squares_int .
 
 text \<open>
   Second, we also have to transfer the code equations for our functions.
   The attribute \<open>Transfer.transferred\<close> takes care of that, but it is
   better to check that the transfer succeeded: inspect the theorem to check
   that the new constants are used throughout.
 \<close>
 
 lemmas [Transfer.transferred, code] =
   gen_sum_squares.simps
   sum_squares_def
   sum_squares_int_def
 
 text \<open>
   Finally, we export the code to standard ML.  We use the target
   \<open>SML_word\<close> instead of \<open>SML\<close> to have the operations
   on @{typ uint16} mapped to the Standard Basis Library. As PolyML
   does not provide a Word16 type, the mapping for @{typ uint16} is only
   active in the refined target \<open>SML_word\<close>.
 \<close>
 export_code sum_squares_int_uint in SML_word
 
 text \<open>
   Nevertheless, we can still evaluate terms with @{term "uint16"} within 
   Isabelle, i.e., PolyML, but this will be translated to @{typ "16 word"}
   and therefore less efficient.
 \<close>
 
 value "sum_squares_int_uint 40"
 
 section \<open>Storing native words in datatypes\<close>
 
 text \<open>
   The above lifting is necessary for all functions whose type mentions
   the word type. Fortunately, we do not have to duplicate functions that
   merely operate on datatypes that contain words. Nevertheless, we have
   to tell the code generator that these functions should call the new ones,
   which operate on machine words. This section shows how to achieve this
   with data refinement.
 \<close>
 
 subsection \<open>Example: expressions and two semantics\<close>
 
 text \<open>
   As the running example, we consider a language of expressions (literal values, less-than comparisions and conditional) where values are either booleans or 32-bit words.
   The original specification uses the type @{typ "32 word"}.
 \<close>
 
 datatype val = Bool bool | Word "32 word"
 datatype expr = Lit val | LT expr expr | IF expr expr expr
 
 abbreviation (input) word :: "32 word \<Rightarrow> expr" where "word i \<equiv> Lit (Word i)"
 abbreviation (input) bool :: "bool \<Rightarrow> expr" where "bool i \<equiv> Lit (Bool i)"
 
 \<comment> \<open>Denotational semantics of expressions, @{term None} denotes a type error\<close>
 fun eval :: "expr \<Rightarrow> val option" where
   "eval (Lit v) = Some v"
 | "eval (LT e\<^sub>1 e\<^sub>2) = 
   (case (eval e\<^sub>1, eval e\<^sub>2) 
    of (Some (Word i\<^sub>1), Some (Word i\<^sub>2)) \<Rightarrow> Some (Bool (i\<^sub>1 < i\<^sub>2))
    | _ \<Rightarrow> None)"
 | "eval (IF e\<^sub>1 e\<^sub>2 e\<^sub>3) =
   (case eval e\<^sub>1 of Some (Bool b) \<Rightarrow> if b then eval e\<^sub>2 else eval e\<^sub>3
    | _ \<Rightarrow> None)"
 
 \<comment> \<open>Small-step semantics of expressions, it gets stuck upon type errors.\<close>
 inductive step :: "expr \<Rightarrow> expr \<Rightarrow> bool" ("_ \<rightarrow> _" [50, 50] 60) where
   "e \<rightarrow> e' \<Longrightarrow> LT e e\<^sub>2 \<rightarrow> LT e' e\<^sub>2"
 | "e \<rightarrow> e' \<Longrightarrow> LT (word i) e \<rightarrow> LT (word i) e'"
 | "LT (word i\<^sub>1) (word i\<^sub>2) \<rightarrow> bool (i\<^sub>1 < i\<^sub>2)"
 | "e \<rightarrow> e' \<Longrightarrow> IF e e\<^sub>1 e\<^sub>2 \<rightarrow> IF e' e\<^sub>1 e\<^sub>2"
 | "IF (bool True) e\<^sub>1 e\<^sub>2 \<rightarrow> e\<^sub>1"
 | "IF (bool False) e\<^sub>1 e\<^sub>2 \<rightarrow> e\<^sub>2"
 
 \<comment> \<open>Compile the inductive definition with the predicate compiler\<close>
 code_pred (modes: i \<Rightarrow> o \<Rightarrow> bool as reduce, i \<Rightarrow> i \<Rightarrow> bool as step') step .
 
 subsection \<open>Change the datatype to use machine words\<close>
 
 text \<open>
   Now, we want to use @{typ uint32} instead of @{typ "32 word"}.
   The goal is to make the code generator use the new type without
   duplicating any of the types (@{typ val}, @{typ expr}) or the
   functions (@{term eval}, @{term reduce}) on such types.
 
   The constructor @{term Word} has @{typ "32 word"} in its type, so
   we have to lift it to \<open>Word'\<close>, and the same holds for the
   case combinator @{term case_val}, which @{term case_val'} replaces.%
   \footnote{%
     Note that we should not declare a case translation for the new
     case combinator because this will break parsing case expressions
     with old case combinator.
   }
   Next, we set up the code generator accordingly:
   @{term Bool} and @{term Word'} are the new constructors for @{typ val},
   and @{term case_val'} is the new case combinator with an appropriate 
   case certificate.%
   \footnote{%
     Case certificates tell the code generator to replace the HOL
     case combinator for a datatype with the case combinator of the
     target language.  Without a case certificate, the code generator
     generates a function that re-implements the case combinator; 
     in a strict languages like ML or Scala, this means that the code
     evaluates all possible cases before it decides which one is taken.
 
     Case certificates are described in Haftmann's PhD thesis
     \cite[Def.\ 27]{Haftmann2009PhD}. For a datatype \<open>dt\<close>
     with constructors \<open>C\<^sub>1\<close> to \<open>C\<^sub>n\<close>
     where each constructor \<open>C\<^sub>i\<close> takes \<open>k\<^sub>i\<close> parameters,
     the certificate for the case combinator \<open>case_dt\<close>
     looks as follows:
 
     {
       \isamarkuptrue\isacommand{lemma}\isamarkupfalse\isanewline%
       \ \ \isakeyword{assumes}\ {\isachardoublequoteopen}CASE\ {\isasymequiv}\ dt{\isacharunderscore}case\ c\isactrlsub {\isadigit{1}}\ c\isactrlsub {\isadigit{2}}\ \ldots\ c\isactrlsub{n}{\isachardoublequoteclose}\isanewline
       \ \ \isakeyword{shows}\ {\isachardoublequoteopen}{\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{1}}\isactrlsub {k\ensuremath{{}_1}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{1}}\isactrlsub {k\ensuremath{{}_1}}{\isacharparenright}\isanewline
       \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ {\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {\isadigit{2}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{2}}\isactrlsub {k\ensuremath{{}_2}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {\isadigit{2}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{2}}\isactrlsub {k\ensuremath{{}_2}}{\isacharparenright}\isanewline
       \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ \ldots\isanewline
       \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ {\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {n}\ a\isactrlsub {n}\isactrlsub {\isadigit{1}}\ a\isactrlsub {n}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {n}\isactrlsub {k\ensuremath{{}_n}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {n}\ a\isactrlsub {n}\isactrlsub {\isadigit{1}}\ a\isactrlsub {n}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {n}\isactrlsub {k\ensuremath{{}_n}}{\isacharparenright}{\isachardoublequoteclose}\isanewline
     }
   }
   We delete the code equations for the old constructor @{term Word}
   and case combinator @{term case_val} such that the code generator
   reports missing adaptations.
 \<close>
 
 lift_definition Word' :: "uint32 \<Rightarrow> val" is Word .
 
 code_datatype Bool Word'
 
 lift_definition case_val' :: "(bool \<Rightarrow> 'a) \<Rightarrow> (uint32 \<Rightarrow> 'a) \<Rightarrow> val \<Rightarrow> 'a" is case_val .
 
 lemmas [code, simp] = val.case [Transfer.transferred]
 
 lemma case_val'_cert:
   fixes bool word' b w
   assumes "CASE \<equiv> case_val' bool word'"
   shows "(CASE (Bool b) \<equiv> bool b) &&& (CASE (Word' w) \<equiv> word' w)"
   by (simp_all add: assms)
 
 setup \<open>Code.declare_case_global @{thm case_val'_cert}\<close>
 
 declare [[code drop: case_val Word]]
 
 
 subsection \<open>Make functions use functions on machine words\<close>
 
 text \<open>
   Finally, we merely have to change the code equations to use the 
   new functions that operate on @{typ uint32}. As before, the
   attribute \<open>Transfer.transferred\<close> does the job. In our example,
   we adapt the equality test on @{typ val} (code equations
   @{thm [source] val.eq.simps}) and the denotational and small-step 
   semantics (code equations @{thm [source] eval.simps} and
   @{thm [source] step.equation}, respectively).
 
   We check that the adaptation has suceeded by exporting the functions.
   As we only use native word sizes that PolyML supports, we can use 
   the usual target \<open>SML\<close> instead of \<open>SML_word\<close>.
 \<close>
 
 lemmas [code] = 
   val.eq.simps[THEN meta_eq_to_obj_eq, Transfer.transferred, THEN eq_reflection]
   eval.simps[Transfer.transferred]
   step.equation[Transfer.transferred]
 
 export_code reduce step' eval checking SML
 
 section \<open>Troubleshooting\<close>
 
 text \<open>
   This section explains some possible problems when using native words.
   If you experience other difficulties, please contact the author.
 \<close>
 
 subsection \<open>\<open>export_code\<close> raises an exception \label{section:export_code:exception}\<close>
 
 text \<open>
   Probably, you have defined and are using a function on a native word type,
   but the code equation refers to emulated words. For example, the following
   defines a function \<open>double\<close> that doubles a word. When we try to export
   code for \<open>double\<close> without any further setup, \<open>export_code\<close> will
   raise an exception or generate code that does not compile.
 \<close>
 
 lift_definition double :: "uint32 \<Rightarrow> uint32" is "\<lambda>x. x + x" .
 
 text \<open>
   We have to prove a code equation that only uses the existing operations on
   @{typ uint32}. Then, \<open>export_code\<close> works again.
 \<close>
 
 lemma double_code [code]: "double n = n + n"
 by transfer simp
 
 subsection \<open>The generated code does not compile\<close>
 
 text \<open>
   Probably, you have been exporting to a target language for which there
   is no setup, or your compiler does not provide the required API. Every
   theory for native words mentions at the start the limitations on code
   generation. Check that your concrete application meets all the
   requirements.
 
   Alternatively, this might be an instance of the problem described 
   in \S\ref{section:export_code:exception}.
 
   For Haskell, you have to enable the extension TypeSynonymInstances with \texttt{-XTypeSynonymInstances}
   if you are using polymorphic bit operations on the native word types.
 \<close>
 
 subsection \<open>The generated code is too slow\<close>
 
 text \<open>
   The generated code will most likely not be as fast as a direct implementation in the target language with manual tuning.
   This is because we want the configuration of the code generation to be sound (as it can be used to prove theorems in Isabelle).
   Therefore, the bit operations sometimes perform range checks before they call the target language API.
   Here are some examples:
   \begin{itemize}
   \item Shift distances and bit indices in target languages are often expected to fit into a bounded integer or word.
     However, the size of these types varies across target languages and platforms.
     Hence, no Isabelle/HOL type can model uniformly all of them.
     Instead, the bit operations use arbitrary-precision integers for such quantities and check at run-time that the values fit into a bounded integer or word, respectively -- if not, they raise an exception.
   
   \item Division and modulo operations explicitly test whether the divisor is $0$ and return the HOL value of division by $0$ in that case.
     This is necessary because some languages leave the behaviour of division by 0 unspecified.
   \end{itemize}
   
   If you have better ideas how to eliminate such checks and speed up the generated code without sacrificing soundness, please contact the author!
 \<close>
 
 (*<*)end(*>*)
diff --git a/thys/SPARCv8/SparcModel_MMU/Sparc_Properties.thy b/thys/SPARCv8/SparcModel_MMU/Sparc_Properties.thy
--- a/thys/SPARCv8/SparcModel_MMU/Sparc_Properties.thy
+++ b/thys/SPARCv8/SparcModel_MMU/Sparc_Properties.thy
@@ -1,8575 +1,8575 @@
 (*
  * Copyright 2016, NTU
  *
  * This software may be distributed and modified according to the terms of
  * the BSD 2-Clause license. Note that NO WARRANTY is provided.
  * See "LICENSE_BSD2.txt" for details.
  *
  * Author: Zhe Hou.
  *)
 
 theory Sparc_Properties
 
 imports Main Sparc_Execution
 
 begin
 
 (*********************************************************************)
 
 section\<open>Single step theorem\<close>
 
 (*********************************************************************)
 
 text \<open>The following shows that, if the pre-state satisfies certain 
   conditions called \<open>good_context\<close>, there must be a defined post-state 
   after a single step execution.\<close>
 
 method save_restore_proof =
 ((simp add: save_restore_instr_def),
  (simp add: Let_def simpler_gets_def bind_def h1_def h2_def),
  (simp add: case_prod_unfold),
  (simp add: raise_trap_def simpler_modify_def),
  (simp add: simpler_gets_def bind_def h1_def h2_def),
  (simp add: save_retore_sub1_def),
  (simp add: write_cpu_def simpler_modify_def),
  (simp add: write_reg_def simpler_modify_def),
  (simp add: get_curr_win_def),
  (simp add: simpler_gets_def bind_def h1_def h2_def))
 
 method select_trap_proof0 = 
 ((simp add: select_trap_def exec_gets return_def),
  (simp add: DetMonad.bind_def h1_def h2_def simpler_modify_def),
  (simp add: write_cpu_tt_def write_cpu_def),
  (simp add: DetMonad.bind_def h1_def h2_def simpler_modify_def),
  (simp add: return_def simpler_gets_def))
 
 method select_trap_proof1 =
 ((simp add: select_trap_def exec_gets return_def),
  (simp add: DetMonad.bind_def h1_def h2_def simpler_modify_def),
  (simp add: write_cpu_tt_def write_cpu_def),
  (simp add: DetMonad.bind_def h1_def h2_def simpler_modify_def),
  (simp add: return_def simpler_gets_def),
  (simp add: emp_trap_set_def err_mode_val_def cpu_reg_mod_def))
 
 method dispatch_instr_proof1 =
 ((simp add: dispatch_instruction_def),
  (simp add: simpler_gets_def bind_def h1_def h2_def),
  (simp add: Let_def))
 
 method exe_proof_to_decode =
 ((simp add: execute_instruction_def),
  (simp add: exec_gets bind_def h1_def h2_def Let_def return_def),
  clarsimp,
  (simp add: simpler_gets_def bind_def h1_def h2_def Let_def simpler_modify_def),
  (simp add: return_def))
 
 method exe_proof_dispatch_rett =
 ((simp add: dispatch_instruction_def),
  (simp add: simpler_gets_def bind_def h1_def h2_def Let_def),
  (simp add: rett_instr_def),
  (simp add: simpler_gets_def bind_def h1_def h2_def Let_def))
 
 lemma write_cpu_result: "snd (write_cpu w r s) = False"
 by (simp add: write_cpu_def simpler_modify_def)
 
 lemma set_annul_result: "snd (set_annul b s) = False"
 by (simp add: set_annul_def simpler_modify_def)
 
 lemma raise_trap_result : "snd (raise_trap t s) = False"
 by (simp add: raise_trap_def simpler_modify_def)
 
 lemma rett_instr_result: "(fst i) = ctrl_type RETT \<and> 
   (get_ET (cpu_reg_val PSR s) \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s)))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s)) = 0 \<and>
   ((AND) (get_addr (snd i) s) (0b00000000000000000000000000000011::word32)) = 0) \<Longrightarrow>
   snd (rett_instr i s) = False"
 apply (simp add: rett_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
-apply (simp add: write_cpu_def simpler_modify_def)
-apply (simp add: raise_trap_def simpler_modify_def)
-by (simp add: return_def)
+  apply (simp add: write_cpu_def simpler_modify_def)
+  apply (auto simp add: Let_def return_def)
+  done
 
 lemma call_instr_result: "(fst i) = call_type CALL \<Longrightarrow>
   snd (call_instr i s) = False"
 apply (simp add: call_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def case_prod_unfold)
 apply (simp add: write_cpu_def write_reg_def)
 apply (simp add: get_curr_win_def get_CWP_def)
 by (simp add: simpler_modify_def simpler_gets_def)
 
 lemma branch_instr_result: "(fst i) \<in> {bicc_type BE,bicc_type BNE,bicc_type BGU,
  bicc_type BLE,bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
  bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,bicc_type BN}  \<Longrightarrow>
   snd (branch_instr i s) = False" 
 proof (cases "eval_icc (fst i) (get_icc_N ((cpu_reg s) PSR)) (get_icc_Z ((cpu_reg s) PSR))
                            (get_icc_V ((cpu_reg s) PSR)) (get_icc_C ((cpu_reg s) PSR)) = 1")
   case True
   then have f1: "eval_icc (fst i) (get_icc_N ((cpu_reg s) PSR)) (get_icc_Z ((cpu_reg s) PSR))
                            (get_icc_V ((cpu_reg s) PSR)) (get_icc_C ((cpu_reg s) PSR)) = 1" 
     by auto
   then show ?thesis
   proof (cases "(fst i) = bicc_type BA \<and> get_operand_flag ((snd i)!0) = 1")
     case True
     then show ?thesis using f1
     apply (simp add: branch_instr_def)
     apply (simp add: Let_def simpler_gets_def bind_def h1_def h2_def)    
     apply (simp add: set_annul_def case_prod_unfold)
     apply (simp add: write_cpu_def simpler_modify_def)
     by (simp add: return_def)   
   next
     case False
     then have f2: "\<not> (fst i = bicc_type BA \<and> get_operand_flag (snd i ! 0) = 1)" by auto
     then show ?thesis using f1
     apply (simp add: branch_instr_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: write_cpu_def simpler_modify_def)
     apply (simp add: branch_instr_sub1_def)
     apply (simp add: Let_def)
     apply auto
     apply (simp add: write_cpu_def simpler_modify_def)    
     by (simp add: write_cpu_def simpler_modify_def)
   qed
 next
   case False
   then show ?thesis
   apply (simp add: branch_instr_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: write_cpu_def simpler_modify_def)
   apply (simp add: branch_instr_sub1_def)
   apply (simp add: Let_def)
   apply auto
    apply (simp add: Let_def bind_def h1_def h2_def)
    apply (simp add: write_cpu_def simpler_modify_def)
    apply (simp add: cpu_reg_mod_def set_annul_def simpler_modify_def)
   by (simp add: write_cpu_def simpler_modify_def)
 qed
 
 lemma nop_instr_result: "(fst i) = nop_type NOP \<Longrightarrow>
   snd (nop_instr i s) = False"
 apply (simp add: nop_instr_def)
 by (simp add: returnOk_def return_def)
 
 lemma sethi_instr_result: "(fst i) = sethi_type SETHI \<Longrightarrow>
   snd (sethi_instr i s) = False"
 apply (simp add: sethi_instr_def)
 apply (simp add: Let_def)
 apply (simp add: get_curr_win_def get_CWP_def cpu_reg_val_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: write_reg_def simpler_modify_def)
 by (simp add: return_def)
 
 lemma jmpl_instr_result: "(fst i) = ctrl_type JMPL \<Longrightarrow>
   snd (jmpl_instr i s) = False"
 apply (simp add: jmpl_instr_def)
 apply (simp add: get_curr_win_def get_CWP_def cpu_reg_val_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: write_cpu_def simpler_modify_def)
 by (simp add: raise_trap_def simpler_modify_def)
 
 lemma save_restore_instr_result: "(fst i) \<in> {ctrl_type SAVE,ctrl_type RESTORE} \<Longrightarrow>
   snd (save_restore_instr i s) = False"
 proof (cases "(fst i) = ctrl_type SAVE")
   case True
   then show ?thesis
   by save_restore_proof
 next
   case False
   then show ?thesis
   by save_restore_proof
 qed
 
 lemma flush_instr_result: "(fst i) = load_store_type FLUSH  \<Longrightarrow>
   snd (flush_instr i s) = False" 
 apply (simp add: flush_instr_def)
 by (simp add: simpler_gets_def bind_def h1_def h2_def simpler_modify_def)
 
 lemma read_state_reg_instr_result: "(fst i) \<in> {sreg_type RDY,sreg_type RDPSR,
   sreg_type RDWIM,sreg_type RDTBR} \<Longrightarrow>
   snd (read_state_reg_instr i s) = False"
 apply (simp add: read_state_reg_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: simpler_gets_def bind_def)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: raise_trap_def simpler_modify_def return_def)
 apply (simp add: bind_def h1_def h2_def)
 by (simp add: get_curr_win_def simpler_gets_def)
 
 lemma write_state_reg_instr_result: "(fst i) \<in> {sreg_type WRY,sreg_type WRPSR,
   sreg_type WRWIM,sreg_type WRTBR} \<Longrightarrow>
   snd (write_state_reg_instr i s) = False" 
 apply (simp add: write_state_reg_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: simpler_modify_def)
 apply (simp add: raise_trap_def simpler_modify_def return_def)
 apply (simp add: bind_def h1_def h2_def)
 apply (simp add: simpler_gets_def)
 apply (simp add: write_cpu_def simpler_modify_def)
 by (simp add: get_curr_win_def simpler_gets_def)
 
 lemma logical_instr_result: "(fst i) \<in> {logic_type ANDs,logic_type ANDcc,
   logic_type ANDN,logic_type ANDNcc,logic_type ORs,logic_type ORcc,
   logic_type ORN,logic_type XORs,logic_type XNOR} \<Longrightarrow>
   snd (logical_instr i s) = False"
 apply (simp add: logical_instr_def)
 apply (simp add: Let_def simpler_gets_def)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: logical_instr_sub1_def)
 apply (simp add: return_def)
 apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: simpler_gets_def)
 by (simp add: get_curr_win_def simpler_gets_def)
 
 lemma shift_instr_result: "(fst i) \<in> {shift_type SLL,shift_type 
   SRL,shift_type SRA} \<Longrightarrow>
   snd (shift_instr i s) = False"
 apply (simp add: shift_instr_def)
 apply (simp add: Let_def)
 apply (simp add: get_curr_win_def simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: return_def)
 apply (simp add: bind_def h1_def h2_def)
 by (simp add: write_reg_def simpler_modify_def)
 
 method add_sub_instr_proof =
 ((simp add: Let_def),
  auto,
  (simp add: write_reg_def simpler_modify_def),
  (simp add: simpler_gets_def bind_def),
  (simp add: get_curr_win_def simpler_gets_def),
  (simp add: write_reg_def write_cpu_def simpler_modify_def),
  (simp add: bind_def),
  (simp add: case_prod_unfold),
  (simp add: simpler_gets_def),
  (simp add: get_curr_win_def simpler_gets_def),
  (simp add: write_reg_def simpler_modify_def),
  (simp add: simpler_gets_def bind_def),
  (simp add: get_curr_win_def simpler_gets_def))
 
 lemma add_instr_result: "(fst i) \<in> {arith_type ADD,arith_type 
   ADDcc,arith_type ADDX} \<Longrightarrow>
   snd (add_instr i s) = False"
 apply (simp add: add_instr_def)
 apply (simp add: Let_def)
 apply auto
   apply (simp add: add_instr_sub1_def)
   apply (simp add: write_reg_def simpler_modify_def)
   apply (simp add: bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: simpler_gets_def)
   apply (simp add: get_curr_win_def simpler_gets_def)
  apply (simp add: add_instr_sub1_def)
  apply (simp add: write_reg_def simpler_modify_def)
  apply (simp add: simpler_gets_def bind_def h1_def h2_def)
  apply (simp add: get_curr_win_def simpler_gets_def)
  apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: add_instr_sub1_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: get_curr_win_def simpler_gets_def)
 by (simp add: write_reg_def simpler_modify_def)
 
 lemma sub_instr_result: "(fst i) \<in> {arith_type SUB,arith_type SUBcc,
   arith_type SUBX} \<Longrightarrow>
   snd (sub_instr i s) = False"
 apply (simp add: sub_instr_def)
 apply (simp add: Let_def)
 apply auto
   apply (simp add: sub_instr_sub1_def)
   apply (simp add: write_reg_def simpler_modify_def)
   apply (simp add: bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: simpler_gets_def)
   apply (simp add: get_curr_win_def simpler_gets_def)
  apply (simp add: sub_instr_sub1_def)
  apply (simp add: write_reg_def simpler_modify_def)
  apply (simp add: simpler_gets_def bind_def h1_def h2_def)
  apply (simp add: get_curr_win_def simpler_gets_def)
  apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: sub_instr_sub1_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: get_curr_win_def simpler_gets_def)
 by (simp add: write_reg_def simpler_modify_def)
 
 lemma mul_instr_result: "(fst i) \<in> {arith_type UMUL,arith_type SMUL,
   arith_type SMULcc} \<Longrightarrow>
   snd (mul_instr i s) = False"
 apply (simp add: mul_instr_def)
 apply (simp add: Let_def)
 apply auto
   apply (simp add: mul_instr_sub1_def)
   apply (simp add: write_reg_def simpler_modify_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: get_curr_win_def simpler_gets_def)
   apply (simp add: write_reg_def write_cpu_def simpler_modify_def)
  apply (simp add: mul_instr_sub1_def)
  apply (simp add: simpler_gets_def)
  apply (simp add: write_cpu_def write_reg_def simpler_modify_def)
  apply (simp add: bind_def h1_def h2_def Let_def)
  apply (simp add: get_curr_win_def simpler_gets_def)
 apply (simp add: mul_instr_sub1_def)
 apply (simp add: simpler_gets_def)
 apply (simp add: write_cpu_def write_reg_def simpler_modify_def)
 apply (simp add: bind_def h1_def h2_def)
 by (simp add: get_curr_win_def simpler_gets_def)
 
 lemma div_write_new_val_result: "snd (div_write_new_val i result temp_V s) = False"
 apply (simp add: div_write_new_val_def)
 apply (simp add: return_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 by (simp add: write_cpu_def simpler_modify_def)
 
 lemma div_result: "snd (div_comp instr rs1 rd operand2 s) = False"
 apply (simp add: div_comp_def)
 apply (simp add: simpler_gets_def)
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: get_curr_win_def simpler_gets_def)
 by (simp add: div_write_new_val_result)
 
 lemma div_instr_result: "(fst i) \<in> {arith_type UDIV,arith_type UDIVcc,
   arith_type SDIV} \<Longrightarrow>
   snd (div_instr i s) = False"
 apply (simp add: div_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: return_def bind_def)
 by (simp add: div_result)
 
 lemma load_sub2_result: "snd (load_sub2 address asi rd curr_win word0 s) = False"
 apply (simp add: load_sub2_def)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: bind_def h1_def h2_def)
 apply (simp add: write_reg_def simpler_modify_def)
 by (simp add: simpler_gets_def)
 
 lemma load_sub3_result: "snd (load_sub3 instr curr_win rd asi address s) = False"
 apply (simp add: load_sub3_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
 apply (simp add: write_reg_def simpler_modify_def)
 apply (simp add: load_sub2_result)
 by (simp add: raise_trap_def simpler_modify_def)
 
 lemma load_sub1_result: "snd (load_sub1 i rd s_val s) = False"
 apply (simp add: load_sub1_def)
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: get_curr_win_def simpler_gets_def)
 by (simp add: load_sub3_result)
 
 lemma load_instr_result: "(fst i) \<in> {load_store_type LDSB,load_store_type LDUB,
   load_store_type LDUBA,load_store_type LDUH,load_store_type LD,
   load_store_type LDA,load_store_type LDD} \<Longrightarrow>
   snd (load_instr i s) = False"
 apply (simp add: load_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: return_def)
 by (simp add: load_sub1_result)
 
 lemma store_sub2_result: "snd (store_sub2 instr curr_win rd asi address s) = False"
 apply (simp add: store_sub2_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: return_def)
 apply (simp add: raise_trap_def simpler_modify_def)
 by (simp add: bind_def h1_def h2_def)
 
 lemma store_sub1_result: "snd (store_sub1 instr rd s_val s) = False"
 apply (simp add: store_sub1_def)
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: get_curr_win_def)
 apply (simp add: simpler_gets_def)
 by (simp add: store_sub2_result)
 
 lemma store_instr_result: "(fst i) \<in> {load_store_type STB,load_store_type STH,
   load_store_type ST,load_store_type STA,load_store_type STD} \<Longrightarrow>
   snd (store_instr i s) = False"
 apply (simp add: store_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: raise_trap_def simpler_modify_def)
 apply (simp add: return_def)
 by (simp add: store_sub1_result)
 
 lemma supported_instr_set: "supported_instruction i = True \<Longrightarrow> 
   i \<in> {load_store_type LDSB,load_store_type LDUB,load_store_type LDUBA,
               load_store_type LDUH,load_store_type LD,load_store_type LDA,
               load_store_type LDD,
               load_store_type STB,load_store_type STH,load_store_type ST,
               load_store_type STA,load_store_type STD,
               sethi_type SETHI,
               nop_type NOP,
               logic_type ANDs,logic_type ANDcc,logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR,
               shift_type SLL,shift_type SRL,shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               ctrl_type RETT,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
 apply (simp add: supported_instruction_def)
 by presburger
 
 lemma dispatch_instr_result: 
 assumes a1: "supported_instruction (fst i) = True \<and> (fst i) \<noteq> ctrl_type RETT"
 shows "snd (dispatch_instruction i s) = False"
 proof (cases "get_trap_set s = {}")
   case True
   then have f1: "get_trap_set s = {}" by auto
   then show ?thesis 
   proof (cases "(fst i) \<in> {load_store_type LDSB,load_store_type LDUB,
     load_store_type LDUBA,load_store_type LDUH,load_store_type LD,
     load_store_type LDA,load_store_type LDD}")
     case True
     then show ?thesis using f1 
     apply dispatch_instr_proof1
     by (simp add: load_instr_result)
   next
     case False
     then have f2: "(fst i) \<in> {load_store_type STB,load_store_type STH,load_store_type ST,
               load_store_type STA,load_store_type STD,
               sethi_type SETHI,
               nop_type NOP,
               logic_type ANDs,logic_type ANDcc,logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR,
               shift_type SLL,shift_type SRL,shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
      using a1 
      apply (simp add: supported_instruction_def)
      by presburger
      then show ?thesis 
      proof (cases "(fst i) \<in> {load_store_type STB,load_store_type STH,
        load_store_type ST,
        load_store_type STA,load_store_type STD}")
       case True
       then show ?thesis using f1
       apply dispatch_instr_proof1      
       by (auto simp add: store_instr_result)
      next
       case False
       then have f3: "(fst i) \<in> {sethi_type SETHI,
               nop_type NOP,
               logic_type ANDs,logic_type ANDcc,logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR,
               shift_type SLL,shift_type SRL,shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
       using f2 by auto
       then show ?thesis 
       proof (cases "(fst i) = sethi_type SETHI")
         case True
         then show ?thesis using f1
         apply dispatch_instr_proof1
         by (simp add: sethi_instr_result)
       next
         case False
         then have f4: "(fst i) \<in> {nop_type NOP,
               logic_type ANDs,logic_type ANDcc,logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR,
               shift_type SLL,shift_type SRL,shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
         using f3 by auto         
         then show ?thesis 
         proof (cases "fst i = nop_type NOP")
           case True
           then show ?thesis using f1
           apply dispatch_instr_proof1
           by (simp add: nop_instr_result)
         next
           case False
           then have f5: "(fst i) \<in> {logic_type ANDs,logic_type ANDcc,
               logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR,
               shift_type SLL,shift_type SRL,shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
           using f4 by auto
           then show ?thesis 
           proof (cases "(fst i) \<in> {logic_type ANDs,logic_type ANDcc,
               logic_type ANDN,logic_type ANDNcc,
               logic_type ORs,logic_type ORcc,logic_type ORN,logic_type XORs,
               logic_type XNOR}")
             case True
             then show ?thesis using f1
             apply dispatch_instr_proof1
             by (auto simp add: logical_instr_result)
           next
             case False
             then have f6: "(fst i) \<in> {shift_type SLL,shift_type SRL,
               shift_type SRA,
               arith_type ADD,arith_type ADDcc,arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
             using f5 by auto
             then show ?thesis 
             proof (cases "(fst i) \<in> {shift_type SLL,shift_type SRL,
               shift_type SRA}")
               case True
               then show ?thesis using f1
               apply dispatch_instr_proof1
               by (auto simp add: shift_instr_result)
             next 
               case False
               then have f7: "(fst i) \<in> {arith_type ADD,arith_type ADDcc,
               arith_type ADDX,
               arith_type SUB,arith_type SUBcc,arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}" 
               using f6 by auto
               then show ?thesis 
               proof (cases "(fst i) \<in> {arith_type ADD,arith_type ADDcc,
               arith_type ADDX}")
                 case True
                 then show ?thesis using f1
                 apply dispatch_instr_proof1
                 by (auto simp add: add_instr_result)
               next
                 case False
                 then have f8: "(fst i) \<in> {arith_type SUB,arith_type SUBcc,
                 arith_type SUBX,
               arith_type UMUL,arith_type SMUL,arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                 using f7 by auto
                 then show ?thesis 
                 proof (cases "(fst i) \<in> {arith_type SUB,arith_type SUBcc,
                 arith_type SUBX}")
                   case True
                   then show ?thesis using f1
                   apply dispatch_instr_proof1
                   by (auto simp add: sub_instr_result)
                 next
                   case False
                   then have f9: "(fst i) \<in> {arith_type UMUL,arith_type SMUL,
                   arith_type SMULcc,
               arith_type UDIV,arith_type UDIVcc,arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                   using f8 by auto
                   then show ?thesis 
                   proof (cases "(fst i) \<in> {arith_type UMUL,arith_type SMUL,
                   arith_type SMULcc}")
                     case True
                     then show ?thesis using f1
                     apply dispatch_instr_proof1
                     by (auto simp add: mul_instr_result)
                   next
                     case False
                     then have f10: "(fst i) \<in> {arith_type UDIV,arith_type UDIVcc,
                     arith_type SDIV,
               ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                     using f9 by auto
                     then show ?thesis 
                     proof (cases "(fst i) \<in> {arith_type UDIV,arith_type UDIVcc,
                     arith_type SDIV}")
                       case True
                       then show ?thesis 
                       apply dispatch_instr_proof1 using f1
                       by (auto simp add: div_instr_result)
                     next
                       case False
                       then have f11: "(fst i) \<in> {ctrl_type SAVE,ctrl_type RESTORE,
               call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                       using f10 by auto
                       then show ?thesis 
                       proof (cases "(fst i) \<in> {ctrl_type SAVE,ctrl_type RESTORE}")
                         case True
                         then show ?thesis using f1
                         apply dispatch_instr_proof1 
                         by (auto simp add: save_restore_instr_result)
                       next
                         case False
                         then have f12: "(fst i) \<in> {call_type CALL,
               ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                         using f11 by auto
                         then show ?thesis 
                         proof (cases "(fst i) = call_type CALL")
                           case True
                           then show ?thesis using f1
                           apply dispatch_instr_proof1
                           by (auto simp add: call_instr_result)
                         next
                           case False
                           then have f13: "(fst i) \<in> {ctrl_type JMPL,
               sreg_type RDY,sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                           using f12 by auto
                           then show ?thesis 
                           proof (cases "(fst i) = ctrl_type JMPL")
                             case True
                             then show ?thesis using f1
                             apply dispatch_instr_proof1
                             by (auto simp add: jmpl_instr_result)
                           next
                             case False
                             then have f14: "(fst i) \<in> {
                             sreg_type RDY,
                             sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR,
               sreg_type WRY,sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                             using f13 by auto
                             then show ?thesis 
                             proof (cases "(fst i) \<in> {sreg_type RDY,
                             sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR}")
                               case True
                               then show ?thesis using f1
                               apply dispatch_instr_proof1
                               by (auto simp add: read_state_reg_instr_result)
                             next
                               case False
                               then have f15: "(fst i) \<in> {
                               sreg_type WRY,
                               sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR,
               load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                               using f14 by auto
                               then show ?thesis 
                               proof (cases "(fst i) \<in> {sreg_type WRY,
                               sreg_type WRPSR,sreg_type WRWIM,sreg_type WRTBR}")
                                 case True
                                 then show ?thesis using f1
                                 apply dispatch_instr_proof1
                                 by (auto simp add: write_state_reg_instr_result)
                               next
                                 case False
                                 then have f16: "(fst i) \<in> {
                                 load_store_type FLUSH,
               bicc_type BE,bicc_type BNE,bicc_type BGU,bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                                 using f15 by auto
                                 then show ?thesis 
                                 proof (cases "(fst i) = load_store_type FLUSH")
                                   case True
                                   then show ?thesis using f1
                                   apply dispatch_instr_proof1
                                   by (auto simp add: flush_instr_result)
                                 next
                                   case False
                                   then have f17: "(fst i) \<in>
                                   {
                                   bicc_type BE,bicc_type BNE,bicc_type BGU,
                                   bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA,
               bicc_type BN}"
                                   using f16 by auto
                                   then show ?thesis using f1
                                   proof (cases "(fst i) \<in> {bicc_type BE,
                                     bicc_type BNE,bicc_type BGU,
                                   bicc_type BLE,
               bicc_type BL,bicc_type BGE,bicc_type BNEG,bicc_type BG,
               bicc_type BCS,bicc_type BLEU,bicc_type BCC,bicc_type BA
               }")
                                     case True
                                     then show ?thesis using f1
                                     apply dispatch_instr_proof1
                                     apply auto
                                                by (auto simp add: branch_instr_result)
                                   next
                                     case False
                                     then have f18: "(fst i) \<in> {bicc_type BN}" 
                                     using f17 by auto
                                     then show ?thesis using f1
                                     apply dispatch_instr_proof1
                                     apply auto
                                     by (auto simp add: branch_instr_result)
                                   qed
                                 qed
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
      qed
   qed
 next
   case False
   then show ?thesis
   apply (simp add: dispatch_instruction_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: Let_def)
   by (simp add: returnOk_def return_def)
 qed
 
 lemma dispatch_instr_result_rett: 
 assumes a1: "(fst i) = ctrl_type RETT \<and> (get_ET (cpu_reg_val PSR s) \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s)))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s)) = 0 \<and>
   ((AND) (get_addr (snd i) s) (0b00000000000000000000000000000011::word32)) = 0)"
 shows "snd (dispatch_instruction i s) = False"
 proof (cases "get_trap_set s = {}")
   case True
   then show ?thesis using a1
   apply (simp add: dispatch_instruction_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (simp add: rett_instr_result)
 next
   case False
   then show ?thesis using a1
   apply (simp add: dispatch_instruction_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (simp add: return_def)
 qed
 
 lemma execute_instr_sub1_result: "snd (execute_instr_sub1 i s) = False"
 proof (cases "get_trap_set s = {} \<and> (fst i) \<in> {call_type CALL,ctrl_type RETT,
   ctrl_type JMPL}")
   case True
   then show ?thesis 
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: write_cpu_def simpler_modify_def)
   apply auto
      by (auto simp add: return_def)
 next
   case False
   then show ?thesis
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: write_cpu_def simpler_modify_def)
   by (auto simp add: return_def)
 qed
 
 lemma next_match : "snd (execute_instruction () s) = False \<Longrightarrow>
   NEXT s = Some (snd (fst (execute_instruction () s)))"
 apply (simp add: NEXT_def)
 by (simp add: case_prod_unfold)
 
 lemma exec_ss1 : "\<exists>s'. (execute_instruction () s = (s', False)) \<Longrightarrow> 
   \<exists>s''. (execute_instruction() s = (s'', False))"
 proof -
   assume "\<exists>s'. (execute_instruction () s = (s', False))"
   hence "(snd (execute_instruction() s)) = False" 
          by (auto simp add: execute_instruction_def case_prod_unfold)         
   hence "(execute_instruction() s) = 
         ((fst (execute_instruction() s)),False)"
          by (metis (full_types) prod.collapse) 
   hence "\<exists>s''. (execute_instruction() s = (s'', False))" 
         by blast
   thus ?thesis by assumption
 qed
 
 lemma exec_ss2 : "snd (execute_instruction() s) = False \<Longrightarrow>
   snd (execute_instruction () s) = False"
 proof -
   assume "snd (execute_instruction() s) = False"
   hence "snd (execute_instruction () s) = False" 
     by (auto simp add:execute_instruction_def)
   thus ?thesis by assumption
 qed
 
 lemma good_context_1 : "good_context s \<and> s' = s \<and>
   (get_trap_set s') \<noteq> {} \<and> (reset_trap_val s') = False \<and> get_ET (cpu_reg_val PSR s') = 0 
   \<Longrightarrow> False"
 proof -
   assume asm: "good_context s \<and> s' = s \<and>
     (get_trap_set s') \<noteq> {} \<and> (reset_trap_val s') = False \<and> get_ET (cpu_reg_val PSR s') = 0"
   then have  "(get_trap_set s') \<noteq> {} \<and> (reset_trap_val s') = False \<and> 
   get_ET (cpu_reg_val PSR s') = 0 \<Longrightarrow> False" 
     by (simp add: good_context_def get_ET_def cpu_reg_val_def) 
   then show ?thesis using asm by auto 
 qed
 
 lemma fetch_instr_result_1 : "\<not> (\<exists>e. fetch_instruction s' = Inl e) \<Longrightarrow>
   (\<exists>v. fetch_instruction s' = Inr v)"
 by (meson sumE)
 
 lemma fetch_instr_result_2 : "(\<exists>v. fetch_instruction s' = Inr v) \<Longrightarrow>
   \<not> (\<exists>e. fetch_instruction s' = Inl e)"
 by force
 
 lemma fetch_instr_result_3 : "(\<exists>e. fetch_instruction s' = Inl e) \<Longrightarrow>
   \<not> (\<exists>v. fetch_instruction s' = Inr v)"
 by auto
 
 lemma decode_instr_result_1 : 
 "\<not>(\<exists>v2. ((decode_instruction v1)::(Exception list + instruction)) = Inr v2) \<Longrightarrow>
   (\<exists>e. ((decode_instruction v1)::(Exception list + instruction)) = Inl e)"
 by (meson sumE)
 
 lemma decode_instr_result_2 : 
 "(\<exists>e. ((decode_instruction v1)::(Exception list + instruction)) = Inl e) \<Longrightarrow>
   \<not>(\<exists>v2. ((decode_instruction v1)::(Exception list + instruction)) = Inr v2)"
 by force
 
 lemma decode_instr_result_3 : "x = decode_instruction v1 \<and> y = decode_instruction v2 
   \<and> v1 = v2 \<Longrightarrow> x = y"
 by auto
 
 lemma decode_instr_result_4 : 
 "\<not> (\<exists>e. ((decode_instruction v1)::(Exception list + instruction)) = Inl e) \<Longrightarrow>
   (\<exists>v2. ((decode_instruction v1)::(Exception list + instruction)) = Inr v2)"
 by (meson sumE)
 
 lemma good_context_2 : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  fetch_instruction (delayed_pool_write s) = Inr v1  \<and> 
  \<not>(\<exists>v2. (decode_instruction v1::(Exception list + instruction)) = Inr v2) 
  \<Longrightarrow> False"
 proof -
   assume "good_context s \<and> 
     fetch_instruction (delayed_pool_write s) = Inr v1 \<and> 
     \<not>(\<exists>v2. ((decode_instruction v1)::(Exception list + instruction)) = Inr v2)"
   hence fact1: "good_context s \<and> 
     fetch_instruction (delayed_pool_write s) = Inr v1 \<and> 
     (\<exists>e. ((decode_instruction v1)::(Exception list + instruction)) = Inl e)" 
     using decode_instr_result_1 by auto
   hence fact2: "\<not>(\<exists>e. fetch_instruction (delayed_pool_write s) = Inl e)" 
     using fetch_instr_result_2 by auto
   then have "fetch_instruction (delayed_pool_write s) = Inr v1 \<and> 
             (\<exists>e. ((decode_instruction v1)::(Exception list + instruction)) = Inl e) 
             \<Longrightarrow> False"
     proof (cases "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
       get_ET (cpu_reg_val PSR s) = 0") 
       case True 
       from this fact1 show ?thesis using good_context_1 by blast
     next
       case False
         then have fact3: "(get_trap_set s) = {} \<or> (reset_trap_val s) \<noteq> False 
         \<or> get_ET (cpu_reg_val PSR s) \<noteq> 0"
           by auto
         then show ?thesis 
           using fact1 decode_instr_result_3
           by (metis (no_types, lifting) good_context_def sum.case(1) sum.case(2))        
     qed
   thus ?thesis using fact1 by auto
 qed
 
 lemma good_context_3 : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  s'' = delayed_pool_write s \<and>
  fetch_instruction s'' = Inr v1  \<and> 
  (decode_instruction v1::(Exception list + instruction)) = Inr v2 \<and>
  annul_val s'' = False \<and> supported_instruction (fst v2) = False
  \<Longrightarrow> False"
 proof -
   assume asm: "good_context (s::(('a::len) sparc_state)) \<and> 
   s'' = delayed_pool_write s \<and>
   fetch_instruction s'' = Inr v1  \<and> 
   (decode_instruction v1::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> supported_instruction (fst v2) = False"
   then have "annul_val s'' = False \<and> supported_instruction (fst v2) = False
     \<Longrightarrow> False"
     proof (cases "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
       get_ET (cpu_reg_val PSR s) = 0")
       case True
       from this asm show ?thesis using good_context_1 by blast
     next 
       case False
       then have fact3: "(get_trap_set s) = {} \<or> (reset_trap_val s) \<noteq> False \<or> 
       get_ET (cpu_reg_val PSR s) \<noteq> 0"
         by auto
       thus ?thesis using asm by (auto simp add: good_context_def)
     qed
   thus ?thesis using asm by auto
 qed
 
 lemma good_context_4 : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  s'' = delayed_pool_write s \<and>
  fetch_instruction s'' = Inr v1 \<and> 
  ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
  annul_val s'' = False \<and> 
  supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
  (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
- ((ucast (get_S (cpu_reg_val PSR s'')))::word1) = 0
+ (((get_S (cpu_reg_val PSR s'')))::word1) = 0
  \<Longrightarrow> False"
 proof -
   assume asm: "good_context (s::(('a::len) sparc_state)) \<and> 
   s'' = delayed_pool_write s \<and>
   fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> 
   supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s'')))::word1) = 0"
   then have "(fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) = 0 \<Longrightarrow> False"
+  (((get_S (cpu_reg_val PSR s'')))::word1) = 0 \<Longrightarrow> False"
     proof (cases "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
       get_ET (cpu_reg_val PSR s) = 0")
       case True
       from this asm show ?thesis using good_context_1 by blast
     next 
       case False
       then have fact3: "(get_trap_set s) = {} \<or> (reset_trap_val s) \<noteq> False \<or> 
       get_ET (cpu_reg_val PSR s) \<noteq> 0"
         by auto
       thus ?thesis using asm by (auto simp add: good_context_def)
     qed
   thus ?thesis using asm by auto
 qed
 
 lemma good_context_5 : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  s'' = delayed_pool_write s \<and>
  fetch_instruction s'' = Inr v1 \<and> 
  ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
  annul_val s'' = False \<and> 
  supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
  (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
- ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+ (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
  (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
   (cpu_reg_val WIM s'')) \<noteq> 0
  \<Longrightarrow> False"
 proof -
   assume asm: "good_context (s::(('a::len) sparc_state)) \<and> 
   s'' = delayed_pool_write s \<and>
   fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> 
   supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) \<noteq> 0"
   then have "(fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) \<noteq> 0
   \<Longrightarrow> False"
     proof (cases "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
       get_ET (cpu_reg_val PSR s) = 0")
       case True
       from this asm show ?thesis using good_context_1 by blast
     next 
       case False
       then have fact3: "(get_trap_set s) = {} \<or> (reset_trap_val s) \<noteq> False \<or>
       get_ET (cpu_reg_val PSR s) \<noteq> 0"
         by auto
       thus ?thesis using asm by (auto simp add: good_context_def)
     qed
   thus ?thesis using asm by auto
 qed
 
 lemma good_context_6 : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  s'' = delayed_pool_write s \<and>
  fetch_instruction s'' = Inr v1 \<and> 
  ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
  annul_val s'' = False \<and> 
  supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
  (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
- ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+ (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
  (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
   (cpu_reg_val WIM s'')) = 0 \<and>
  ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) \<noteq> 0
  \<Longrightarrow> False"
 proof -
   assume asm: "good_context (s::(('a::len) sparc_state)) \<and> 
   s'' = delayed_pool_write s \<and>
   fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> 
   supported_instruction (fst v2) = True \<and> \<comment> \<open>This line is redundant\<close>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) = 0 \<and>
   ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) \<noteq> 0"
   then have "(fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) = 0 \<and>
   ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) \<noteq> 0
   \<Longrightarrow> False"
     proof (cases "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
       get_ET (cpu_reg_val PSR s) = 0")
       case True
       from this asm show ?thesis using good_context_1 by blast
     next 
       case False
       then have fact3: "(get_trap_set s) = {} \<or> (reset_trap_val s) \<noteq> False \<or>
       get_ET (cpu_reg_val PSR s) \<noteq> 0"
         by auto
       thus ?thesis using asm by (auto simp add: good_context_def)
     qed
   thus ?thesis using asm by auto
 qed
 
 lemma good_context_all : 
 "good_context (s::(('a::len) sparc_state)) \<and> 
  s'' = delayed_pool_write s \<Longrightarrow>
  (get_trap_set s = {} \<or> (reset_trap_val s) \<noteq> False \<or> get_ET (cpu_reg_val PSR s) \<noteq> 0) \<and>
  ((\<exists>e. fetch_instruction s'' = Inl e) \<or> 
   (\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
    ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
    (annul_val s'' = True \<or>
     (annul_val s'' = False \<and> 
      (\<forall>v1' v2'. fetch_instruction s'' = Inr v1' \<and> 
       ((decode_instruction v1')::(Exception list + instruction)) = Inr v2' \<longrightarrow>
       supported_instruction (fst v2') = True) \<and>
      ((fst v2) \<noteq> ctrl_type RETT \<or>
       ((fst v2) = ctrl_type RETT \<and> 
        (get_ET (cpu_reg_val PSR s'') = 1 \<or>
         (get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-        ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+        (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
         (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
           (cpu_reg_val WIM s'')) = 0 \<and>
         ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) = 0))))))))"
 proof -
  assume asm: "good_context s \<and> s'' = delayed_pool_write s"
  from asm have "(get_trap_set s) \<noteq> {} \<and> (reset_trap_val s) = False \<and> 
  get_ET (cpu_reg_val PSR s) = 0 \<Longrightarrow> False"
   using good_context_1 by blast  
  hence fact1: "(get_trap_set s = {} \<or> (reset_trap_val s) \<noteq> False \<or> 
  get_ET (cpu_reg_val PSR s) \<noteq> 0)" by auto
  have fact2: "\<not>(\<exists>e. fetch_instruction s'' = Inl e) \<and> \<not> (\<exists>v1. fetch_instruction s'' = Inr v1) 
   \<Longrightarrow> False" using fetch_instr_result_1 by blast
  from asm have fact3: "\<exists>v1. fetch_instruction s'' = Inr v1 \<and>
   \<not>(\<exists>v2.((decode_instruction v1)::(Exception list + instruction)) = Inr v2)
   \<Longrightarrow> False"
   using good_context_2 by blast
  from asm have fact4: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> supported_instruction (fst v2) = False
   \<Longrightarrow> False"
   using good_context_3 by blast
  from asm have fact5: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> supported_instruction (fst v2) = True \<and>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) = 0
+  (((get_S (cpu_reg_val PSR s'')))::word1) = 0
   \<Longrightarrow> False"
   using good_context_4 by blast
  from asm have fact6: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> supported_instruction (fst v2) = True \<and>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) \<noteq> 0
   \<Longrightarrow> False" 
   using good_context_5 by blast
  from asm have fact7: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
   ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
   annul_val s'' = False \<and> supported_instruction (fst v2) = True \<and>
   (fst v2) = ctrl_type RETT \<and> get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and>
-  ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
+  (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0 \<and>
   (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) mod NWINDOWS)) 
     (cpu_reg_val WIM s'')) = 0 \<and>
   ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) \<noteq> 0
   \<Longrightarrow> False"
     using good_context_6 by blast
  from asm show ?thesis 
   proof (cases "(\<exists>e. fetch_instruction s'' = Inl e)")
     case True
     then show ?thesis using fact1 by auto
   next 
     case False
     then have fact8: "\<exists>v1. fetch_instruction s'' = Inr v1 \<and> 
     (\<exists>v2.((decode_instruction v1)::(Exception list + instruction)) = Inr v2)"
       using fact2 fact3 by auto
     then show ?thesis 
       proof (cases "annul_val s'' = True")
         case True
         then show ?thesis using fact1 fact8 by auto
       next 
         case False
         then have fact9: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
         ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
         annul_val s'' = False \<and> supported_instruction (fst v2) = True"
           using fact4 fact8 by blast
         then show ?thesis 
           proof (cases "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
             (fst v2) \<noteq> ctrl_type RETT")
             case True
             then show ?thesis using fact1 fact9 by auto  
           next
             case False
             then have fact10: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
             annul_val s'' = False \<and> supported_instruction (fst v2) = True \<and> 
               (fst v2) = ctrl_type RETT"
               using fact9 by auto
             then show ?thesis 
               proof (cases "get_ET (cpu_reg_val PSR s'') = 1")
                 case True
                 then show ?thesis using fact1 fact9 by auto
               next
                 case False
                 then have fact11: "get_ET (cpu_reg_val PSR s'') \<noteq> 1 \<and> 
-                ((ucast (get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0"
+                (((get_S (cpu_reg_val PSR s'')))::word1) \<noteq> 0"
                   using fact10 fact5 by auto
                 then have fact12: "(get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR s''))) + 1) 
                   mod NWINDOWS)) (cpu_reg_val WIM s'')) = 0" 
                   using fact10 fact6 by auto
                 then have fact13: "\<exists>v1 v2. fetch_instruction s'' = Inr v1 \<and> 
                 ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
                 ((AND) (get_addr (snd v2) s'') (0b00000000000000000000000000000011::word32)) = 0"
                   using fact10 fact11 fact7 by blast
                 thus ?thesis using fact1 fact10 fact11 fact12 by auto
               qed
           qed
       qed
   qed
 qed
 
 lemma select_trap_result1 : "(reset_trap_val s) = True \<Longrightarrow>
   snd (select_trap() s) = False"   
 apply (simp add: select_trap_def exec_gets return_def)
 by (simp add: bind_def  h1_def h2_def simpler_modify_def)
 
 lemma select_trap_result2 : 
 assumes a1: "\<not>(reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) = 0)"
 shows  "snd (select_trap() s) = False"
 proof (cases "reset_trap_val s = True") 
   case True
   then show ?thesis using select_trap_result1 
   by blast
 next
   case False
   then have f1: "reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) \<noteq> 0"
     using a1 by auto
     then show ?thesis
     proof (cases "data_store_error \<in> get_trap_set s")
       case True
       then show ?thesis using f1
       by select_trap_proof0
     next
       case False
       then have f2: "data_store_error \<notin> get_trap_set s" by auto
       then show ?thesis 
       proof (cases "instruction_access_error \<in> get_trap_set s")
         case True
         then show ?thesis using f1 f2
         by select_trap_proof0
       next
         case False
         then have f3: "instruction_access_error \<notin> get_trap_set s" by auto
         then show ?thesis 
         proof (cases "r_register_access_error \<in> get_trap_set s")
           case True
           then show ?thesis using f1 f2 f3
           by select_trap_proof0
         next
           case False
           then have f4: "r_register_access_error \<notin> get_trap_set s" by auto
           then show ?thesis 
           proof (cases "instruction_access_exception \<in> get_trap_set s")
             case True
             then show ?thesis using f1 f2 f3 f4
             by select_trap_proof0
           next
             case False
             then have f5: "instruction_access_exception \<notin> get_trap_set s" by auto
             then show ?thesis 
             proof (cases "privileged_instruction \<in> get_trap_set s")
               case True
               then show ?thesis using f1 f2 f3 f4 f5
               by select_trap_proof0
             next  
               case False
               then have f6: "privileged_instruction \<notin> get_trap_set s" by auto
               then show ?thesis 
               proof (cases "illegal_instruction \<in> get_trap_set s")
                 case True
                 then show ?thesis using f1 f2 f3 f4 f5 f6
                 by select_trap_proof0
               next
                 case False
                 then have f7: "illegal_instruction \<notin> get_trap_set s" by auto
                 then show ?thesis
                 proof (cases "fp_disabled \<in> get_trap_set s")
                   case True
                   then show ?thesis using f1 f2 f3 f4 f5 f6 f7
                   by select_trap_proof0
                 next
                   case False
                   then have f8: "fp_disabled \<notin> get_trap_set s" by auto
                   then show ?thesis 
                   proof (cases "cp_disabled \<in> get_trap_set s")
                     case True
                     then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8
                     by select_trap_proof0
                   next
                     case False
                     then have f9: "cp_disabled \<notin> get_trap_set s" by auto
                     then show ?thesis 
                     proof (cases "unimplemented_FLUSH \<in> get_trap_set s")
                       case True
                       then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9
                       by select_trap_proof0
                     next
                       case False
                       then have f10: "unimplemented_FLUSH \<notin> get_trap_set s" by auto
                       then show ?thesis 
                       proof (cases "window_overflow \<in> get_trap_set s")
                         case True
                         then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10
                         by select_trap_proof0
                       next 
                         case False
                         then have f11: "window_overflow \<notin> get_trap_set s" by auto
                         then show ?thesis 
                         proof (cases "window_underflow \<in> get_trap_set s")
                           case True
                           then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11
                           by select_trap_proof0
                         next
                           case False
                           then have f12: "window_underflow \<notin> get_trap_set s" by auto
                           then show ?thesis 
                           proof (cases "mem_address_not_aligned \<in> get_trap_set s")
                             case True
                             then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
                             by select_trap_proof0
                           next
                             case False
                             then have f13: "mem_address_not_aligned \<notin> get_trap_set s" by auto
                             then show ?thesis 
                             proof (cases "fp_exception \<in> get_trap_set s")
                               case True
                               then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                               by select_trap_proof0
                             next
                               case False
                               then have f14: "fp_exception \<notin> get_trap_set s" by auto
                               then show ?thesis 
                               proof (cases "cp_exception \<in> get_trap_set s")
                                 case True
                                 then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                 f14 
                                 by select_trap_proof0
                               next
                                 case False
                                 then have f15: "cp_exception \<notin> get_trap_set s" by auto
                                 then show ?thesis 
                                 proof (cases "data_access_error \<in> get_trap_set s")
                                   case True
                                   then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                 f14 f15 
                                 by select_trap_proof0
                                 next
                                   case False
                                   then have f16: "data_access_error \<notin> get_trap_set s" by auto
                                   then show ?thesis 
                                   proof (cases "data_access_exception \<in> get_trap_set s")
                                     case True
                                     then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                     f13 f14 f15 f16
                                     by select_trap_proof0
                                   next
                                     case False
                                     then have f17: "data_access_exception \<notin> get_trap_set s" by auto
                                     then show ?thesis 
                                     proof (cases "tag_overflow \<in> get_trap_set s")
                                       case True
                                       then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                       f13 f14 f15 f16 f17
                                       by select_trap_proof0
                                     next
                                       case False
                                       then have f18: "tag_overflow \<notin> get_trap_set s" by auto
                                       then show ?thesis 
                                       proof (cases "division_by_zero \<in> get_trap_set s")
                                         case True
                                         then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                         f12 f13 f14 f15 f16 f17 f18 
                                         by select_trap_proof0
                                       next
                                         case False
                                         then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                         f12 f13 f14 f15 f16 f17 f18
                                         apply (simp add: select_trap_def exec_gets return_def)
                                         apply (simp add: DetMonad.bind_def h1_def h2_def simpler_modify_def)
                                         apply (simp add: return_def simpler_gets_def)
                                         apply (simp add: case_prod_unfold)
                                         apply (simp add: return_def)
                                         apply (simp add: write_cpu_tt_def write_cpu_def)
                                         by (simp add: simpler_gets_def bind_def h1_def h2_def simpler_modify_def)
                                       qed
                                     qed
                                   qed
                                 qed
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
 qed
 
 lemma emp_trap_set_err_mode : "err_mode_val s = err_mode_val (emp_trap_set s)"
 by (auto simp add: emp_trap_set_def err_mode_val_def)
 
 lemma write_cpu_tt_err_mode : "err_mode_val s = err_mode_val (snd (fst (write_cpu_tt w s)))"
 apply (simp add: write_cpu_tt_def err_mode_val_def write_cpu_def)  
 apply (simp add: exec_gets return_def)
 apply (simp add: bind_def simpler_modify_def)
 by (simp add: cpu_reg_mod_def)
 
 lemma select_trap_monad : "snd (select_trap() s) = False \<Longrightarrow> 
   err_mode_val s = err_mode_val (snd (fst (select_trap () s)))"
 proof -
   assume a1: "snd (select_trap() s) = False"
   then have f0: "reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) = 0 \<Longrightarrow> False" 
     apply (simp add: select_trap_def exec_gets return_def)
     apply (simp add: bind_def h1_def h2_def simpler_modify_def)
     by (simp add: fail_def split_def)  
   then show ?thesis
     proof (cases "reset_trap_val s = True")
       case True
       from a1 f0 this show ?thesis 
       apply (simp add: select_trap_def exec_gets return_def)
       apply (simp add: bind_def h1_def h2_def simpler_modify_def)
       by (simp add: emp_trap_set_def err_mode_val_def)
     next
       case False
       then have f1: "reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) \<noteq> 0" using f0 by auto
       then show ?thesis using f1 a1
       proof (cases "data_store_error \<in> get_trap_set s")
         case True
         then show ?thesis using f1 a1
         by select_trap_proof1
       next 
         case False
         then have f2: "data_store_error \<notin> get_trap_set s" by auto
         then show ?thesis 
         proof (cases "instruction_access_error \<in> get_trap_set s")
           case True
           then show ?thesis using f1 f2 a1
           by select_trap_proof1
         next
           case False
           then have f3: "instruction_access_error \<notin> get_trap_set s" by auto
           then show ?thesis 
           proof (cases "r_register_access_error \<in> get_trap_set s")
             case True
             then show ?thesis using f1 f2 f3 a1
             by select_trap_proof1
           next
             case False
             then have f4: "r_register_access_error \<notin> get_trap_set s" by auto
             then show ?thesis 
             proof (cases "instruction_access_exception \<in> get_trap_set s")
               case True
               then show ?thesis using f1 f2 f3 f4 a1
               by select_trap_proof1
             next
               case False
               then have f5: "instruction_access_exception \<notin> get_trap_set s" by auto
               then show ?thesis 
               proof (cases "privileged_instruction \<in> get_trap_set s")
                 case True
                 then show ?thesis using f1 f2 f3 f4 f5 a1
                 by select_trap_proof1
               next  
                 case False
                 then have f6: "privileged_instruction \<notin> get_trap_set s" by auto
                 then show ?thesis 
                 proof (cases "illegal_instruction \<in> get_trap_set s")
                   case True
                   then show ?thesis using f1 f2 f3 f4 f5 f6 a1
                   by select_trap_proof1
                 next
                   case False
                   then have f7: "illegal_instruction \<notin> get_trap_set s" by auto
                   then show ?thesis
                   proof (cases "fp_disabled \<in> get_trap_set s")
                     case True
                     then show ?thesis using f1 f2 f3 f4 f5 f6 f7 a1
                     by select_trap_proof1
                   next
                     case False
                     then have f8: "fp_disabled \<notin> get_trap_set s" by auto
                     then show ?thesis 
                     proof (cases "cp_disabled \<in> get_trap_set s")
                       case True
                       then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 a1
                       by select_trap_proof1
                     next
                       case False
                       then have f9: "cp_disabled \<notin> get_trap_set s" by auto
                       then show ?thesis 
                       proof (cases "unimplemented_FLUSH \<in> get_trap_set s")
                         case True
                         then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 a1
                         by select_trap_proof1
                       next
                         case False
                         then have f10: "unimplemented_FLUSH \<notin> get_trap_set s" by auto
                         then show ?thesis 
                         proof (cases "window_overflow \<in> get_trap_set s")
                           case True
                           then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 a1
                           by select_trap_proof1
                         next 
                           case False
                           then have f11: "window_overflow \<notin> get_trap_set s" by auto
                           then show ?thesis 
                           proof (cases "window_underflow \<in> get_trap_set s")
                             case True
                             then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 a1
                             by select_trap_proof1
                           next
                             case False
                             then have f12: "window_underflow \<notin> get_trap_set s" by auto
                             then show ?thesis 
                             proof (cases "mem_address_not_aligned \<in> get_trap_set s")
                               case True
                               then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 a1
                               by select_trap_proof1
                             next
                               case False
                               then have f13: "mem_address_not_aligned \<notin> get_trap_set s" by auto
                               then show ?thesis 
                               proof (cases "fp_exception \<in> get_trap_set s")
                                 case True
                                 then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                 a1
                                 by select_trap_proof1
                               next
                                 case False
                                 then have f14: "fp_exception \<notin> get_trap_set s" by auto
                                 then show ?thesis 
                                 proof (cases "cp_exception \<in> get_trap_set s")
                                   case True
                                   then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                   f14 a1
                                   by select_trap_proof1
                                 next
                                   case False
                                   then have f15: "cp_exception \<notin> get_trap_set s" by auto
                                   then show ?thesis 
                                   proof (cases "data_access_error \<in> get_trap_set s")
                                     case True
                                     then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                     f14 f15 a1
                                     by select_trap_proof1
                                   next
                                     case False
                                     then have f16: "data_access_error \<notin> get_trap_set s" by auto
                                     then show ?thesis 
                                     proof (cases "data_access_exception \<in> get_trap_set s")
                                       case True
                                       then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                       f13 f14 f15 f16 a1
                                       by select_trap_proof1
                                     next
                                       case False
                                       then have f17: "data_access_exception \<notin> get_trap_set s" by auto
                                       then show ?thesis 
                                       proof (cases "tag_overflow \<in> get_trap_set s")
                                         case True
                                         then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                         f13 f14 f15 f16 f17 a1
                                         by select_trap_proof1
                                       next
                                         case False
                                         then have f18: "tag_overflow \<notin> get_trap_set s" by auto
                                         then show ?thesis 
                                         proof (cases "division_by_zero \<in> get_trap_set s")
                                           case True
                                           then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                           f12 f13 f14 f15 f16 f17 f18 a1
                                           by select_trap_proof1
                                         next
                                           case False
                                           then show ?thesis using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                           f12 f13 f14 f15 f16 f17 f18 a1
                                           apply (simp add: select_trap_def exec_gets return_def)
                                           apply (simp add: bind_def h1_def h2_def simpler_modify_def)
                                           apply (simp add: return_def simpler_gets_def)
                                           apply (simp add: emp_trap_set_def err_mode_val_def
                                             cpu_reg_mod_def)
                                           apply (simp add: case_prod_unfold)
                                           apply (simp add: return_def)
                                           apply clarsimp                                          
                                           apply (simp add: write_cpu_tt_def write_cpu_def write_tt_def)
                                           apply (simp add: simpler_gets_def bind_def h1_def h2_def)
                                           apply (simp add: simpler_modify_def)
                                           by (simp add: cpu_reg_val_def cpu_reg_mod_def)
                                         qed
                                       qed
                                     qed
                                   qed
                                 qed
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
 qed
 
 lemma exe_trap_st_pc_result : "snd (exe_trap_st_pc() s) = False"
 proof (cases "annul_val s = True")
   case True
   then show ?thesis 
   apply (simp add: exe_trap_st_pc_def get_curr_win_def)
   apply (simp add: exec_gets return_def)
   apply (simp add: DetMonad.bind_def h1_def h2_def)
   by (simp add: set_annul_def write_reg_def simpler_modify_def)
 next
   case False
   then show ?thesis
   apply (simp add: exe_trap_st_pc_def get_curr_win_def)
   apply (simp add: exec_gets return_def)
   apply (simp add: DetMonad.bind_def h1_def h2_def)
   by (simp add: write_reg_def simpler_modify_def)
 qed
 
 lemma exe_trap_wr_pc_result : "snd (exe_trap_wr_pc() s) = False"
 proof (cases "reset_trap_val s = True")
   case True
   then show ?thesis 
   apply (simp add: exe_trap_wr_pc_def get_curr_win_def)
   apply (simp add: exec_gets return_def)
   apply (simp add: DetMonad.bind_def h1_def h2_def)
   apply (simp add: write_cpu_def simpler_modify_def)
   apply (simp add: simpler_gets_def)
   apply (simp add: cpu_reg_val_def update_S_def cpu_reg_mod_def reset_trap_val_def)
   apply (simp add: write_cpu_def simpler_modify_def DetMonad.bind_def h1_def h2_def)
   apply (simp add: return_def)
   by (simp add: set_reset_trap_def simpler_modify_def DetMonad.bind_def h1_def h2_def return_def)
 next
   case False
   then show ?thesis
   apply (simp add: exe_trap_wr_pc_def get_curr_win_def)
   apply (simp add: exec_gets return_def)
   apply (simp add: DetMonad.bind_def h1_def h2_def)
   apply (simp add: write_cpu_def simpler_modify_def)
   apply (simp add: simpler_gets_def)
   apply (simp add: cpu_reg_val_def update_S_def cpu_reg_mod_def reset_trap_val_def)
   apply (simp add: write_cpu_def simpler_modify_def DetMonad.bind_def h1_def h2_def)
   by (simp add: return_def)
 qed
 
 lemma execute_trap_result : "\<not>(reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) = 0) \<Longrightarrow>
   snd (execute_trap() s) = False"
 proof -
   assume "\<not>(reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) = 0)"
   then have fact1: "snd (select_trap() s) = False" using select_trap_result2 by blast
   then show ?thesis 
     proof (cases "err_mode_val s = True")
       case True
       then show ?thesis using fact1 
         apply (simp add: execute_trap_def exec_gets return_def)
         apply (simp add: DetMonad.bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         by (simp add: in_gets return_def select_trap_monad simpler_gets_def)
     next 
       case False
       then show ?thesis using fact1 select_trap_monad
       apply (simp add: execute_trap_def exec_gets return_def)
       apply (simp add: DetMonad.bind_def h1_def h2_def)
       apply (simp add: case_prod_unfold)
       apply (simp add: simpler_gets_def)
       apply (auto simp add: select_trap_monad)
       apply (simp add: DetMonad.bind_def h1_def h2_def get_curr_win_def)
       apply (simp add: get_CWP_def cpu_reg_val_def)
       apply (simp add: simpler_gets_def return_def write_cpu_def)
       apply (simp add: simpler_modify_def DetMonad.bind_def h1_def h2_def)
       apply (simp add: exe_trap_st_pc_result)
       by (simp add: case_prod_unfold exe_trap_wr_pc_result)
     qed
 qed
 
 lemma execute_trap_result2 : "\<not>(reset_trap_val s = False \<and> get_ET (cpu_reg_val PSR s) = 0) \<Longrightarrow>
   snd (execute_trap() s) = False"
 using execute_trap_result
 by blast
 
 lemma exe_instr_all : 
 "good_context (s::(('a::len) sparc_state)) \<Longrightarrow> 
   snd (execute_instruction() s) = False"
 proof -
   assume asm1: "good_context s"
   let ?s' = "delayed_pool_write s"
   from asm1 have f1 : "(get_trap_set s = {} \<or> (reset_trap_val s) \<noteq> False \<or> 
   get_ET (cpu_reg_val PSR s) \<noteq> 0) \<and>
   ((\<exists>e. fetch_instruction ?s' = Inl e) \<or> 
   (\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
    ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
    (annul_val ?s' = True \<or>
     (annul_val ?s' = False \<and> 
      (\<forall>v1' v2'. fetch_instruction ?s' = Inr v1' \<and> 
       ((decode_instruction v1')::(Exception list + instruction)) = Inr v2' \<longrightarrow>
       supported_instruction (fst v2') = True) \<and>
      ((fst v2) \<noteq> ctrl_type RETT \<or>
       ((fst v2) = ctrl_type RETT \<and> 
        (get_ET (cpu_reg_val PSR ?s') = 1 \<or>
         (get_ET (cpu_reg_val PSR ?s') \<noteq> 1 \<and>
-        ((ucast (get_S (cpu_reg_val PSR ?s')))::word1) \<noteq> 0 \<and>
+        (((get_S (cpu_reg_val PSR ?s')))::word1) \<noteq> 0 \<and>
         (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR ?s'))) + 1) mod NWINDOWS)) 
           (cpu_reg_val WIM ?s')) = 0 \<and>
         ((AND) (get_addr (snd v2) ?s') (0b00000000000000000000000000000011::word32)) = 0))))))))"
        using good_context_all by blast
    from f1 have f2: "get_trap_set s \<noteq> {} \<Longrightarrow> 
    (reset_trap_val s) \<noteq> False \<or> get_ET (cpu_reg_val PSR s) \<noteq> 0" 
     by auto
    show ?thesis 
    proof (cases "get_trap_set s = {}")
     case True
     then have f3: "get_trap_set s = {}" by auto
     then show ?thesis
     proof (cases "exe_mode_val s = True")
       case True
       then have f4: "exe_mode_val s = True" by auto
       then show ?thesis 
       proof (cases "\<exists>e1. fetch_instruction ?s' = Inl e1")
         case True
         then show ?thesis using f3
         apply exe_proof_to_decode
         apply (simp add: raise_trap_def simpler_modify_def)
         by (simp add: bind_def h1_def h2_def return_def)
       next
         case False
         then have f5: "\<exists> v1. fetch_instruction ?s' = Inr v1" using fetch_instr_result_1 by blast
         then have f6: "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
           ((decode_instruction v1)::(Exception list + instruction)) = Inr v2"
         using f1 fetch_instr_result_2 by blast
         then show ?thesis 
         proof (cases "annul_val ?s' = True")
           case True
           then show ?thesis using f3 f4 f6
           apply exe_proof_to_decode
           apply (simp add: set_annul_def annul_mod_def simpler_modify_def bind_def h1_def h2_def)
           apply (simp add: return_def simpler_gets_def)
           by (simp add: write_cpu_def simpler_modify_def)
         next
           case False
           then have f7: "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
           ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and> 
           (\<forall>v1' v2'. fetch_instruction ?s' = Inr v1' \<and> 
           ((decode_instruction v1')::(Exception list +  instruction)) = Inr v2' \<longrightarrow>
           supported_instruction (fst v2') = True) \<and> annul_val ?s' = False"
           using f1 f6 fetch_instr_result_2 by auto
           then have f7': "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
           ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and> 
           supported_instruction (fst v2) = True \<and> annul_val ?s' = False"
           by auto
           then show ?thesis 
           proof (cases "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
           ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and> 
           (fst v2) = ctrl_type RETT")
             case True
             then have f8: "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and> 
             (fst v2) = ctrl_type RETT" by auto
             then show ?thesis 
             proof (cases "get_trap_set ?s' = {}")
               case True
               then have f9: "get_trap_set ?s' = {}" by auto
               then show ?thesis 
               proof (cases "get_ET (cpu_reg_val PSR ?s') = 1")
                 case True
                 then have f10: "get_ET (cpu_reg_val PSR ?s') = 1" by auto
                 then show ?thesis 
-                proof (cases "((ucast (get_S (cpu_reg_val PSR ?s')))::word1) = 0")
+                proof (cases "(((get_S (cpu_reg_val PSR ?s')))::word1) = 0")
                   case True
                   then show ?thesis using f3 f4 f7 f8 f9 f10
                   apply exe_proof_to_decode              
                   apply exe_proof_dispatch_rett
                   apply (simp add: raise_trap_def simpler_modify_def)
                   apply (auto simp add: execute_instr_sub1_result return_def)
                   by (simp add: case_prod_unfold)
                 next
                   case False
                   then show ?thesis using f3 f4 f7 f8 f9 f10
                   apply exe_proof_to_decode
                   apply exe_proof_dispatch_rett
                   apply (simp add: raise_trap_def simpler_modify_def)
                   apply (auto simp add: execute_instr_sub1_result return_def)
                   by (simp add: case_prod_unfold)
                 qed
               next
                 case False
                 then have f11: "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
                 ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
                 annul_val ?s' = False \<and>
                 (fst v2) = ctrl_type RETT \<and>
                 (get_ET (cpu_reg_val PSR ?s') \<noteq> 1 \<and>
-                ((ucast (get_S (cpu_reg_val PSR ?s')))::word1) \<noteq> 0 \<and>
+                (((get_S (cpu_reg_val PSR ?s')))::word1) \<noteq> 0 \<and>
                 (get_WIM_bit (nat (((uint (get_CWP (cpu_reg_val PSR ?s'))) + 1) mod NWINDOWS)) 
                   (cpu_reg_val WIM ?s')) = 0 \<and>
                 ((AND) (get_addr (snd v2) ?s') (0b00000000000000000000000000000011::word32)) = 0)"
                 using f1 fetch_instr_result_2 f7' f8 by auto
                 then show ?thesis using f3 f4
                 proof (cases "get_trap_set ?s' = {}")
                   case True
                   then show ?thesis using f3 f4 f11
                   apply (simp add: execute_instruction_def)
                   apply (simp add: simpler_gets_def bind_def h1_def h2_def simpler_modify_def)
                   apply clarsimp
                   apply (simp add: return_def)
                   apply (simp add: bind_def h1_def h2_def Let_def)
                   apply (simp add: case_prod_unfold)   
                   apply auto
                    apply (simp add: execute_instr_sub1_result)                
                   apply (simp add: dispatch_instruction_def)
                   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)  
                   by (simp add: rett_instr_result)
                 next
                   case False
                   then show ?thesis using f3 f4 f11
                   apply (simp add: execute_instruction_def)
                   apply (simp add: simpler_gets_def bind_def h1_def h2_def simpler_modify_def)
                   apply clarsimp
                   apply (simp add: return_def)
                   apply (simp add: bind_def h1_def h2_def)
                   apply (simp add: case_prod_unfold)   
                   apply (simp add: execute_instr_sub1_result)
                   apply (simp add: dispatch_instruction_def)
                   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
                   by (simp add: return_def)
                 qed             
               qed
             next
               case False
               then show ?thesis using f3 f4 f7 f8
               apply exe_proof_to_decode
               apply (simp add: dispatch_instruction_def)
               apply (simp add: simpler_gets_def bind_def h1_def h2_def)
               apply (simp add: case_prod_unfold)
               by (auto simp add: execute_instr_sub1_result return_def Let_def)
             qed
           next
             case False \<comment> \<open>Instruction is not \<open>RETT\<close>.\<close>
             then have "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and> 
             (fst v2) \<noteq> ctrl_type RETT" using f7 by auto
             then have "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
             (fst v2) \<noteq> ctrl_type RETT \<and>
             supported_instruction (fst v2) = True \<and> annul_val ?s' = False"
             using f7 by auto            
             then have "\<exists>v1 v2. fetch_instruction ?s' = Inr v1 \<and> 
             ((decode_instruction v1)::(Exception list + instruction)) = Inr v2 \<and>
             (fst v2) \<noteq> ctrl_type RETT \<and>
             supported_instruction (fst v2) = True \<and> annul_val ?s' = False \<and>
             snd (dispatch_instruction v2 ?s') = False"
             by (auto simp add: dispatch_instr_result)                   
             then show ?thesis using f3 f4
               apply exe_proof_to_decode
               apply (simp add: bind_def h1_def h2_def)
               apply (simp add: case_prod_unfold)
               by (simp add: execute_instr_sub1_result)            
           qed
         qed
       qed
     next
       case False
       then show ?thesis using f3
       apply (simp add: execute_instruction_def)
       by (simp add: exec_gets return_def)
     qed
    next
     case False
     then have "get_trap_set s \<noteq> {} \<and> 
     ((reset_trap_val s) \<noteq> False \<or> get_ET (cpu_reg_val PSR s) \<noteq> 0)" 
       using f2 by auto
     then show ?thesis
     apply (simp add: execute_instruction_def exec_gets)
     by (simp add: execute_trap_result2)
    qed
 qed
 
 lemma dispatch_fail: 
 "snd (execute_instruction() (s::(('a::len) sparc_state))) = False \<and>
   get_trap_set s = {} \<and>
   exe_mode_val s \<and>
   fetch_instruction (delayed_pool_write s) = Inr v  \<and> 
   ((decode_instruction v)::(Exception list + instruction)) = Inl e
  \<Longrightarrow> False"
 using decode_instr_result_2
 apply (simp add: execute_instruction_def)
 apply (simp add: exec_gets bind_def)
 apply clarsimp
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: simpler_modify_def return_def)
 by (simp add: fail_def)
 
 lemma no_error : "good_context s \<Longrightarrow> snd (execute_instruction () s) = False"
 proof -
   assume "good_context s"
   hence "snd (execute_instruction() s) = False" 
     using exe_instr_all by auto
   hence "snd (execute_instruction () s) = False" by (simp add: exec_ss2)
   thus ?thesis by assumption
 qed
 
 theorem single_step : "good_context s \<Longrightarrow> NEXT s = Some (snd (fst (execute_instruction () s)))"
 by (simp add: no_error next_match)
 
 (*********************************************************************)
 
 section \<open>Privilege safty\<close>
 
 (*********************************************************************)
 
 text \<open>The following shows that, if the pre-state is under user mode,
   then after a singel step execution, the post-state is aslo under user mode.\<close>
 
 lemma write_cpu_pc_privilege: "s' = snd (fst (write_cpu w PC s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: cpu_reg_mod_def)
 by (simp add: cpu_reg_val_def)
 
 lemma write_cpu_npc_privilege: "s' = snd (fst (write_cpu w nPC s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: cpu_reg_mod_def)
 by (simp add: cpu_reg_val_def)
 
 lemma write_cpu_y_privilege: "s' = snd (fst (write_cpu w Y s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: cpu_reg_mod_def)
 by (simp add: cpu_reg_val_def)
 
 lemma cpu_reg_mod_y_privilege: "s' = cpu_reg_mod w Y s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 by (simp add: cpu_reg_mod_def cpu_reg_val_def)
 
 lemma cpu_reg_mod_asr_privilege: "s' = cpu_reg_mod w (ASR r) s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 by (simp add: cpu_reg_mod_def cpu_reg_val_def)
 
 lemma global_reg_mod_privilege: "s' = global_reg_mod w1 n w2 s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (induction n arbitrary:s)
  apply (clarsimp)
 apply (auto)
 apply (simp add: Let_def)
 by (simp add: cpu_reg_val_def)
 
 lemma out_reg_mod_privilege: "s' = out_reg_mod a w r s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: out_reg_mod_def Let_def)
 by (simp add: cpu_reg_val_def)
 
 lemma in_reg_mod_privilege: "s' = in_reg_mod a w r s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: in_reg_mod_def Let_def)
 by (simp add: cpu_reg_val_def)
 
 lemma user_reg_mod_privilege: 
 assumes a1: " s' = user_reg_mod d (w::(('a::len) window_size)) r 
   (s::(('a::len) sparc_state)) \<and> 
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "r = 0")
   case True
   then show ?thesis using a1
   by (simp add: user_reg_mod_def)  
 next
   case False
   then have f1: "r \<noteq> 0" by auto
   then show ?thesis
   proof (cases "0 < r \<and> r < 8")
     case True
     then show ?thesis using a1 f1
     apply (simp add: user_reg_mod_def)
     by (auto intro: global_reg_mod_privilege)
   next
     case False
     then have f2: "\<not>(0 < r \<and> r < 8)" by auto
     then show ?thesis 
     proof (cases "7 < r \<and> r < 16")
       case True
       then show ?thesis using a1 f1 f2
       apply (simp add: user_reg_mod_def)
       by (auto intro: out_reg_mod_privilege)
     next
       case False
       then have f3: "\<not> (7 < r \<and> r < 16)" by auto
       then show ?thesis
       proof (cases "15 < r \<and> r < 24")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: user_reg_mod_def)
         by (simp add: cpu_reg_val_def)
       next
         case False
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: user_reg_mod_def)
         by (auto intro: in_reg_mod_privilege)
       qed
     qed
   qed
 qed
 
 lemma write_reg_privilege: "s' = snd (fst (write_reg w1 w2 w3 
   (s::(('a::len) sparc_state)))) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: write_reg_def simpler_modify_def)
 by (auto intro: user_reg_mod_privilege)
 
 lemma set_annul_privilege: "s' = snd (fst (set_annul b s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: set_annul_def simpler_modify_def)
 apply (simp add: annul_mod_def write_annul_def)
 by (simp add: cpu_reg_val_def)
 
 lemma set_reset_trap_privilege: "s' = snd (fst (set_reset_trap b s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: set_reset_trap_def simpler_modify_def)
 apply (simp add: reset_trap_mod_def write_annul_def)
 by (simp add: cpu_reg_val_def)
 
 lemma empty_delayed_pool_write_privilege: "get_delayed_pool s = [] \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<and>
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0 \<and>
   s' = delayed_pool_write s \<Longrightarrow> 
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: delayed_pool_write_def)
 by (simp add: get_delayed_write_def delayed_write_all_def delayed_pool_rm_list_def)
 
 lemma raise_trap_privilege: 
-"((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<and>
+"(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<and>
   s' = snd (fst (raise_trap t s)) \<Longrightarrow> 
-  ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: raise_trap_def)
 apply (simp add: simpler_modify_def add_trap_set_def)
 by (simp add: cpu_reg_val_def)
 
 lemma write_cpu_tt_privilege: "s' = snd (fst (write_cpu_tt w s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: write_cpu_tt_def)
 apply (simp add: exec_gets)
 apply (simp add: write_cpu_def cpu_reg_mod_def write_tt_def)
 apply (simp add: simpler_modify_def)
 by (simp add: cpu_reg_val_def)
 
 lemma emp_trap_set_privilege: "s' = emp_trap_set s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: emp_trap_set_def)
 by (simp add: cpu_reg_val_def)
 
 lemma sys_reg_mod_privilege: "s' = sys_reg_mod w r s 
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: sys_reg_mod_def)
 by (simp add: cpu_reg_val_def)
 
 lemma mem_mod_privilege: 
 assumes a1: "s' = mem_mod a1 a2 v s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "(uint a1) = 8 \<or> (uint a1) = 10")
   case True
   then show ?thesis using a1
   apply (simp add: mem_mod_def)
   apply (simp add: Let_def)
   by (simp add: cpu_reg_val_def)
 next
   case False
   then have f1: "\<not>((uint a1) = 8 \<or> (uint a1) = 10)" by auto
   then show ?thesis 
   proof (cases "(uint a1) = 9 \<or> (uint a1) = 11")
     case True
     then show ?thesis using a1 f1
     apply (simp add: mem_mod_def)
     apply (simp add: Let_def)
     by (simp add: cpu_reg_val_def)
   next
     case False
     then show ?thesis using a1 f1
     apply (simp add: mem_mod_def)
     by (simp add: cpu_reg_val_def)
   qed
 qed
 
 lemma mem_mod_w32_privilege: "s' = mem_mod_w32 a1 a2 b d s \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: mem_mod_w32_def)
 apply (simp add: Let_def)
 by (auto intro: mem_mod_privilege)
 
 lemma add_instr_cache_privilege: "s' = add_instr_cache s addr y m \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: add_instr_cache_def)
 apply (simp add: Let_def)
 by (simp add: icache_mod_def cpu_reg_val_def)
 
 lemma add_data_cache_privilege: "s' = add_data_cache s addr y m \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: add_data_cache_def)
 apply (simp add: Let_def)
 by (simp add: dcache_mod_def cpu_reg_val_def)
 
 lemma memory_read_privilege: 
 assumes a1: "s' = snd (memory_read asi addr s) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "uint asi = 1")
   case True
   then show ?thesis using a1 
   apply (simp add: memory_read_def)
   by (simp add: Let_def)
 next
   case False
   then have f1: "uint asi \<noteq> 1" by auto
   then show ?thesis  
   proof (cases "uint asi = 2")
     case True 
     then show ?thesis using a1 f1
     by (simp add: memory_read_def)    
   next
     case False
     then have f2: "uint asi \<noteq> 2" by auto
     then show ?thesis 
     proof (cases "uint asi \<in> {8,9}")
       case True
       then have f3: "uint asi \<in> {8,9}" by auto
       then show ?thesis
       proof (cases "load_word_mem s addr asi = None")
         case True
         then have f4: "load_word_mem s addr asi = None" by auto
         then show ?thesis 
         using a1 f1 f2 f3 f4
         by (simp add: memory_read_def)
       next
         case False
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: memory_read_def)      
         apply auto
          apply (simp add: add_instr_cache_privilege)
         by (simp add: add_instr_cache_privilege)
       qed
     next
       case False
       then have f5: "uint asi \<notin> {8, 9}" by auto
       then show ?thesis 
         proof (cases "uint asi \<in> {10,11}")
           case True
           then have f6: "uint asi \<in> {10,11}" by auto
           then show ?thesis
           proof (cases "load_word_mem s addr asi = None")
             case True
             then have f7: "load_word_mem s addr asi = None" by auto
             then show ?thesis 
             using a1 f1 f2 f5 f6 f7
             by (simp add: memory_read_def)
           next
             case False
             then show ?thesis using a1 f1 f2 f5 f6
             apply (simp add: memory_read_def)      
             apply auto
              apply (simp add: add_data_cache_privilege)
             by (simp add: add_data_cache_privilege)
           qed
       next
         case False
         then have f8: "uint asi \<notin> {10,11}" by auto
         then show ?thesis
         proof (cases "uint asi = 13")
           case True
           then have f9: "uint asi = 13" by auto
           then show ?thesis 
           proof (cases "read_instr_cache s addr = None")
             case True
             then show ?thesis using a1 f1 f2 f5 f8 f9
             by (simp add: memory_read_def) 
           next
             case False
             then show ?thesis using a1 f1 f2 f5 f8 f9
             apply (simp add: memory_read_def)
             by auto
           qed
         next
           case False
           then have f10: "uint asi \<noteq> 13" by auto
           then show ?thesis 
           proof (cases "uint asi = 15")
             case True
             then show ?thesis using a1 f1 f2 f5 f8 f10
             apply (simp add: memory_read_def)
             apply (cases "read_data_cache s addr = None")
              by auto
           next
             case False
             then show ?thesis using a1 f1 f2 f5 f8 f10
             apply (simp add: memory_read_def) \<comment> \<open>The rest cases are easy.\<close>
             by (simp add: Let_def)
           qed
         qed
       qed      
     qed
   qed
 qed
 
 lemma get_curr_win_privilege: "s' = snd (fst (get_curr_win() s)) \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: get_curr_win_def)
 by (simp add: simpler_gets_def)
 
 lemma load_sub2_privilege: 
 assumes a1: "s' = snd (fst (load_sub2 addr asi r win w s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "fst (memory_read asi (addr + 4)
                         (snd (fst (write_reg w win (r AND 30) s)))) =
                   None")
   case True
   then show ?thesis using a1
   apply (simp add: load_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   by (auto intro: raise_trap_privilege write_reg_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: load_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: case_prod_unfold)
   apply clarsimp
   apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
   by (auto intro: write_reg_privilege memory_read_privilege)
 qed
 
 lemma load_sub3_privilege: 
 assumes a1: "s' = snd (fst (load_sub3 instr curr_win rd asi address s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "fst (memory_read asi address s) = None")
   case True
   then show ?thesis using a1
   apply (simp add: load_sub3_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: case_prod_unfold)
   by (auto intro: raise_trap_privilege)
 next
   case False
   then have f1: "fst (memory_read asi address s) \<noteq> None " by auto
   then show ?thesis 
   proof (cases "rd \<noteq> 0 \<and>
                           (fst instr = load_store_type LD \<or>
                            fst instr = load_store_type LDA \<or>
                            fst instr = load_store_type LDUH \<or>
                            fst instr = load_store_type LDSB \<or>
                            fst instr = load_store_type LDUB \<or>
                            fst instr = load_store_type LDUBA \<or>
                            fst instr = load_store_type LDSH \<or>
                            fst instr = load_store_type LDSHA \<or>
                            fst instr = load_store_type LDUHA \<or>
                            fst instr = load_store_type LDSBA)")
     case True
     then show ?thesis using a1 f1
     apply (simp add: load_sub3_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: case_prod_unfold)
     apply clarsimp
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     by (auto intro: write_reg_privilege memory_read_privilege)
   next 
     case False
     then show ?thesis using a1 f1
     apply (simp add: load_sub3_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: case_prod_unfold)
     apply auto
      apply (simp add: simpler_modify_def bind_def h1_def h2_def)
      apply (auto intro: load_sub2_privilege memory_read_privilege)
     apply (simp add: simpler_modify_def bind_def h1_def h2_def)
     by (auto intro: load_sub2_privilege memory_read_privilege)
   qed
 qed
 
 lemma load_sub1_privilege: 
 assumes a1: "s' = snd (fst (load_sub1 instr rd s_val s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: load_sub1_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply auto
                by (auto intro: get_curr_win_privilege raise_trap_privilege load_sub3_privilege)
 
 lemma load_instr_privilege: "s' = snd (fst (load_instr i s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: load_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: Let_def)
 apply clarsimp
 by (auto intro: get_curr_win_privilege raise_trap_privilege load_sub1_privilege)
 
 lemma store_barrier_pending_mod_privilege: "s' = store_barrier_pending_mod b s
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0
+  \<Longrightarrow> (((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: store_barrier_pending_mod_def)
 apply (simp add: write_store_barrier_pending_def)
 by (simp add: cpu_reg_val_def)
 
 lemma store_word_mem_privilege: 
 assumes a1: "store_word_mem s addr data byte_mask asi = Some s' \<and> 
-((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1 apply (simp add: store_word_mem_def)
 apply (case_tac "virt_to_phys addr (mmu s) (mem s) = None")
 apply auto
 apply (case_tac "mmu_writable (get_acc_flag b) asi")
 apply auto
 by (simp add: mem_mod_w32_privilege)
 
-lemma flush_instr_cache_privilege: "((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+lemma flush_instr_cache_privilege: "(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
 s' = flush_instr_cache s \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: flush_instr_cache_def)
 by (simp add: cpu_reg_val_def)
 
-lemma flush_data_cache_privilege: "((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+lemma flush_data_cache_privilege: "(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
 s' = flush_data_cache s \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: flush_data_cache_def)
 by (simp add: cpu_reg_val_def)
 
-lemma flush_cache_all_privilege: "((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
+lemma flush_cache_all_privilege: "(((get_S (cpu_reg_val PSR s)))::word1) = 0 \<Longrightarrow>
 s' = flush_cache_all s \<Longrightarrow>
-((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 apply (simp add: flush_cache_all_def)
 by (simp add: cpu_reg_val_def)
 
 lemma memory_write_asi_privilege: 
 assumes a1: "r = memory_write_asi asi addr byte_mask data s \<and>
   r = Some s' \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "uint asi = 1")
   case True
   then show ?thesis using a1
   apply (simp add: memory_write_asi_def)
   by (auto intro: store_word_mem_privilege)
 next
   case False
   then have f1: "uint asi \<noteq> 1" by auto
   then show ?thesis
   proof (cases "uint asi = 2")
     case True
     then have f01: "uint asi = 2" by auto 
     then show ?thesis 
     proof (cases "uint addr = 0")
       case True
       then show ?thesis using a1 f1 f01      
       apply (simp add: memory_write_asi_def)
       apply (simp add: ccr_flush_def)
       apply (simp add: Let_def)
       apply auto
          apply (metis flush_data_cache_privilege flush_instr_cache_privilege sys_reg_mod_privilege)
         apply (metis flush_instr_cache_privilege sys_reg_mod_privilege)
        apply (metis flush_data_cache_privilege sys_reg_mod_privilege)
       by (simp add: sys_reg_mod_privilege)
     next
       case False
       then show ?thesis using a1 f1 f01
       apply (simp add: memory_write_asi_def)
       apply clarsimp
       by (metis option.distinct(1) option.sel sys_reg_mod_privilege)      
     qed      
   next
     case False
     then have f2: "uint asi \<noteq> 2" by auto
     then show ?thesis
     proof (cases "uint asi \<in> {8,9}")
       case True
       then show ?thesis using a1 f1 f2
       apply (simp add: memory_write_asi_def)
       using store_word_mem_privilege add_instr_cache_privilege
       by blast    
     next
       case False
       then have f3: "uint asi \<notin> {8,9}" by auto
       then show ?thesis 
       proof (cases "uint asi \<in> {10,11}")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: memory_write_asi_def)
         using store_word_mem_privilege add_data_cache_privilege
         by blast 
       next
         case False
         then have f4: "uint asi \<notin> {10,11}" by auto
         then show ?thesis 
         proof (cases "uint asi = 13")
           case True
           then show ?thesis using a1 f1 f2 f3 f4
           apply (simp add: memory_write_asi_def)
           by (auto simp add: add_instr_cache_privilege)
         next
           case False
           then have f5: "uint asi \<noteq> 13" by auto
           then show ?thesis
           proof (cases "uint asi = 15")
             case True
             then show ?thesis using a1 f1 f2 f3 f4 f5
             apply (simp add: memory_write_asi_def)
             by (auto simp add: add_data_cache_privilege)
           next
             case False
             then have f6: "uint asi \<noteq> 15" by auto
             then show ?thesis
             proof (cases "uint asi = 16")
               case True
               then show ?thesis using a1
               apply (simp add: memory_write_asi_def)
               by (auto simp add: flush_instr_cache_privilege)
             next
               case False
               then have f7: "uint asi \<noteq> 16" by auto
               then show ?thesis
               proof (cases "uint asi = 17")
                 case True
                 then show ?thesis using a1
                 apply (simp add: memory_write_asi_def)
                 by (auto simp add: flush_data_cache_privilege)
               next
                 case False
                 then have f8: "uint asi \<noteq> 17" by auto
                 then show ?thesis
                 proof (cases "uint asi = 24")
                   case True
                   then show ?thesis using a1
                   apply (simp add: memory_write_asi_def)
                   by (auto simp add: flush_cache_all_privilege)
                 next
                   case False
                   then have f9: "uint asi \<noteq> 24" by auto
                   then show ?thesis
                   proof (cases "uint asi = 25")
                     case True
                     then show ?thesis using a1
                     apply (simp add: memory_write_asi_def)
                     apply (case_tac "mmu_reg_mod (mmu s) addr data = None")
                      apply auto
                     by (simp add: cpu_reg_val_def)
                   next
                     case False
                     then have f10: "uint asi \<noteq> 25" by auto
                     then show ?thesis
                     proof (cases "uint asi = 28")
                       case True
                       then show ?thesis using a1
                       apply (simp add: memory_write_asi_def)
                       by (auto simp add: mem_mod_w32_privilege)
                     next
                       case False \<comment> \<open>The remaining cases are easy.\<close>
                       then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10
                       apply (simp add: memory_write_asi_def)
                       apply (auto simp add: Let_def)
                       apply (case_tac "uint asi = 20 \<or> uint asi = 21")
                        by auto                  
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 qed
 
 lemma memory_write_privilege: 
 assumes a1: "r = memory_write asi addr byte_mask data 
   (s::(('a::len) sparc_state)) \<and>
   r = Some s' \<and>
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR 
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR 
   (s'::(('a::len) sparc_state)))))::word1) = 0"
 proof -
   have "\<forall>x. Some x \<noteq> None" by auto
   then have "r \<noteq> None" using a1
     by (simp add: \<open>r = memory_write asi addr byte_mask data s \<and> 
-        r = Some s' \<and> ucast (get_S (cpu_reg_val PSR s)) = 0\<close>)  
+        r = Some s' \<and> (get_S (cpu_reg_val PSR s)) = 0\<close>)  
   then have "\<exists>s''. r = Some (store_barrier_pending_mod False s'')" using a1
     by (metis (no_types, lifting) memory_write_def option.case_eq_if) 
   then have "\<exists>s''. s' = store_barrier_pending_mod False s''" using a1
     by blast    
   then have "\<exists>s''. memory_write_asi asi addr byte_mask data s = Some s'' \<and> 
              s' = store_barrier_pending_mod False s''"
     by (metis (no_types, lifting) assms memory_write_def not_None_eq option.case_eq_if option.sel)
   then show ?thesis using a1
     using memory_write_asi_privilege store_barrier_pending_mod_privilege by blast   
 qed
 
 lemma store_sub2_privilege: 
 assumes a1: "s' = snd (fst (store_sub2 instr curr_win rd asi address s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "memory_write asi address (st_byte_mask instr address)
                         (st_data0 instr curr_win rd address s) s =
                        None")
   case True
   then show ?thesis using a1
   apply (simp add: store_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   by (metis fst_conv raise_trap_privilege return_def snd_conv)
 next
   case False
   then have f1: "\<not>(memory_write asi address (st_byte_mask instr address)
                         (st_data0 instr curr_win rd address s) s =
                        None)" 
     by auto
   then show ?thesis  
   proof (cases "(fst instr) \<in> {load_store_type STD,load_store_type STDA}")
     case True
     then have f2: "(fst instr) \<in> {load_store_type STD,load_store_type STDA}" by auto
     then show ?thesis using a1 f1
     apply (simp add: store_sub2_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     apply (simp add: return_def)
     apply (simp add: bind_def case_prod_unfold)
     apply (simp add: simpler_modify_def)
     apply clarsimp
     apply (simp add: case_prod_unfold bind_def h1_def h2_def Let_def simpler_modify_def)
     apply (simp add: simpler_gets_def)
     apply auto
        using memory_write_privilege raise_trap_privilege apply blast
       apply (simp add: simpler_modify_def simpler_gets_def bind_def)
       apply (meson memory_write_privilege)
      using memory_write_privilege raise_trap_privilege apply blast
     by (meson memory_write_privilege)    
   next
     case False
     then show ?thesis using a1 f1
     apply (simp add: store_sub2_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply clarsimp
     apply (simp add: simpler_modify_def return_def)
     by (auto intro: memory_write_privilege)
   qed
 qed
 
 lemma store_sub1_privilege: 
 assumes a1: "s' = snd (fst (store_sub1 instr rd s_val 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR 
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR 
   (s'::(('a::len) sparc_state)))))::word1) = 0"
 proof (cases "(fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s)))))::word1) \<noteq> 0")
   case True
   then show ?thesis using a1
   apply (simp add: store_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   using get_curr_win_privilege raise_trap_privilege by blast                
 next
   case False
   then have f1: "\<not>((fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s)))))::word1) \<noteq> 0)"
     by auto
   then show ?thesis 
   proof (cases "(fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s)))))::word2) \<noteq> 0")
     case True
     then show ?thesis using a1 f1
     apply (simp add: store_sub1_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply (simp add: case_prod_unfold)    
     using get_curr_win_privilege raise_trap_privilege by blast
   next
     case False
     then have f2: "\<not>((fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s)))))::word2) \<noteq> 0)"
       by auto
     then show ?thesis
     proof (cases "(fst instr \<in> {load_store_type STD,load_store_type STDA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s)))))::word3) \<noteq> 0")
       case True
       then show ?thesis using a1 f1 f2
       apply (simp add: store_sub1_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: case_prod_unfold) 
       using get_curr_win_privilege raise_trap_privilege by blast
     next
       case False
       then show ?thesis using a1 f1 f2
       apply (simp add: store_sub1_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: case_prod_unfold)
       by (meson get_curr_win_privilege store_sub2_privilege)       
     qed
   qed
 qed
 
 lemma store_instr_privilege: 
 assumes a1: "s' = snd (fst (store_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR 
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR 
   (s'::(('a::len) sparc_state)))))::word1) = 0"
 using a1
 apply (simp add: store_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: Let_def)
 using raise_trap_privilege store_sub1_privilege by blast
 
 lemma sethi_instr_privilege: 
 assumes a1: "s' = snd (fst (sethi_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: sethi_instr_def)
 apply (simp add: Let_def)
 apply auto
  apply (simp add: bind_def h1_def h2_def Let_def)
  apply (simp add: case_prod_unfold)
  using get_curr_win_privilege write_reg_privilege apply blast
 by (simp add: return_def)
 
 lemma nop_instr_privilege: 
 assumes a1: "s' = snd (fst (nop_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: nop_instr_def)
 by (simp add: return_def)
 
-lemma ucast_0: "((ucast (get_S w))::word1) = 0 \<Longrightarrow> get_S w = 0"
+lemma ucast_0: "(((get_S w))::word1) = 0 \<Longrightarrow> get_S w = 0"
 by (simp add: ucast_id)
 
-lemma ucast_02: "get_S w = 0 \<Longrightarrow> ((ucast (get_S w))::word1) = 0"
+lemma ucast_02: "get_S w = 0 \<Longrightarrow> (((get_S w))::word1) = 0"
 by simp
 
-lemma ucast_s: "((ucast (get_S w))::word1) = 0 \<Longrightarrow> 
+lemma ucast_s: "(((get_S w))::word1) = 0 \<Longrightarrow> 
   (AND) w (0b00000000000000000000000010000000::word32) = 0"
 apply (simp add: get_S_def)
 by (metis (mono_tags) ucast_id zero_neq_one)
 
 lemma ucast_s2: "(AND) w 0b00000000000000000000000010000000 = 0
-  \<Longrightarrow> ((ucast (get_S w))::word1) = 0"
+  \<Longrightarrow> (((get_S w))::word1) = 0"
 by (simp add: get_S_def)
 
 lemma update_PSR_icc_1: "w' = (AND) w (0b11111111000011111111111111111111::word32)
-  \<and> ((ucast (get_S w))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S w'))::word1) = 0"
+  \<and> (((get_S w))::word1) = 0
+  \<Longrightarrow> (((get_S w'))::word1) = 0"
 by (simp add: get_S_def word_bw_assocs(1))
 
 lemma and_num_1048576_128: "(AND) (0b00000000000100000000000000000000::word32)
   (0b00000000000000000000000010000000::word32) = 0"
 by simp
 
 lemma and_num_2097152_128: "(AND) (0b00000000001000000000000000000000::word32)
   (0b00000000000000000000000010000000::word32) = 0"
 by simp
 
 lemma and_num_4194304_128: "(AND) (0b00000000010000000000000000000000::word32)
   (0b00000000000000000000000010000000::word32) = 0"
 by simp
 
 lemma and_num_8388608_128: "(AND) (0b00000000100000000000000000000000::word32)
   (0b00000000000000000000000010000000::word32) = 0"
 by simp
 
 lemma or_and_s: "(AND) w1 (0b00000000000000000000000010000000::word32) = 0
   \<and> (AND) w2 (0b00000000000000000000000010000000::word32) = 0
   \<Longrightarrow> (AND) ((OR) w1 w2) (0b00000000000000000000000010000000::word32) = 0"
 by (simp add: word_ao_dist)
 
 lemma and_or_s: 
-assumes "((ucast (get_S w1))::word1) = 0 \<and> 
+assumes "(((get_S w1))::word1) = 0 \<and> 
   (AND) w2 (0b00000000000000000000000010000000::word32) = 0"
-shows "((ucast (get_S ((OR) ((AND) w1 
+shows "(((get_S ((OR) ((AND) w1 
   (0b11111111000011111111111111111111::word32)) w2)))::word1) = 0"
 proof -
   from assms have "w1 AND 128 = 0"
     using ucast_s by blast
   then have "(w1 AND 4279238655 OR w2) AND 128 = 0"
     using assms by (metis word_ao_absorbs(6) word_ao_dist word_bw_comms(2))
   then show ?thesis
     using ucast_s2 by blast
 qed 
 
 lemma and_or_or_s:
-assumes a1: "((ucast (get_S w1))::word1) = 0 \<and> 
+assumes a1: "(((get_S w1))::word1) = 0 \<and> 
   (AND) w2 (0b00000000000000000000000010000000::word32) = 0 \<and>  
   (AND) w3 (0b00000000000000000000000010000000::word32) = 0"
-shows "((ucast (get_S ((OR) ((OR) ((AND) w1 
+shows "(((get_S ((OR) ((OR) ((AND) w1 
   (0b11111111000011111111111111111111::word32)) w2) w3)))::word1) = 0"
 using and_or_s assms or_and_s ucast_s ucast_s2 by blast 
 
 lemma and_or_or_or_s:
-assumes a1: "((ucast (get_S w1))::word1) = 0 \<and> 
+assumes a1: "(((get_S w1))::word1) = 0 \<and> 
   (AND) w2 (0b00000000000000000000000010000000::word32) = 0 \<and>  
   (AND) w3 (0b00000000000000000000000010000000::word32) = 0 \<and>
   (AND) w4 (0b00000000000000000000000010000000::word32) = 0"
-shows "((ucast (get_S ((OR) ((OR) ((OR) ((AND) w1 
+shows "(((get_S ((OR) ((OR) ((OR) ((AND) w1 
   (0b11111111000011111111111111111111::word32)) w2) w3) w4)))::word1) = 0"
   using and_or_or_s assms or_and_s ucast_s ucast_s2
   by (simp add: and_or_or_s assms or_and_s ucast_s ucast_s2) 
 
 lemma and_or_or_or_or_s:
-assumes a1: "((ucast (get_S w1))::word1) = 0 \<and> 
+assumes a1: "(((get_S w1))::word1) = 0 \<and> 
   (AND) w2 (0b00000000000000000000000010000000::word32) = 0 \<and>  
   (AND) w3 (0b00000000000000000000000010000000::word32) = 0 \<and>
   (AND) w4 (0b00000000000000000000000010000000::word32) = 0 \<and> 
   (AND) w5 (0b00000000000000000000000010000000::word32) = 0"
-shows "((ucast (get_S ((OR) ((OR) ((OR) ((OR) ((AND) w1 
+shows "(((get_S ((OR) ((OR) ((OR) ((OR) ((AND) w1 
   (0b11111111000011111111111111111111::word32)) w2) w3) w4) w5)))::word1) = 0"
   using and_or_or_or_s assms or_and_s ucast_s ucast_s2
   by (simp add: and_or_or_or_s assms or_and_s ucast_s ucast_s2)
 
 lemma write_cpu_PSR_icc_privilege: 
 assumes a1: "s' = snd (fst (write_cpu (update_PSR_icc n_val z_val v_val c_val 
                                         (cpu_reg_val PSR s)) 
                                       PSR 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: write_cpu_def)
 apply (simp add: simpler_modify_def)
 apply (simp add: cpu_reg_mod_def update_PSR_icc_def)
 apply (simp add: cpu_reg_val_def)
 apply auto
                using update_PSR_icc_1 apply blast
               using update_PSR_icc_1 and_num_1048576_128 and_or_s apply blast
              using update_PSR_icc_1 and_num_2097152_128 and_or_s apply blast
             using update_PSR_icc_1 and_num_1048576_128 and_num_2097152_128 
             and_or_or_s apply blast
            using update_PSR_icc_1 and_num_4194304_128 and_or_s apply blast
           using update_PSR_icc_1 and_num_1048576_128 and_num_4194304_128 
           and_or_or_s apply blast
          using update_PSR_icc_1 and_num_2097152_128 and_num_4194304_128 
          and_or_or_s apply blast
         using update_PSR_icc_1 and_num_1048576_128 and_num_2097152_128 and_num_4194304_128
         and_or_or_or_s apply blast 
        using update_PSR_icc_1 and_num_8388608_128 and_or_s apply blast
       using update_PSR_icc_1 and_num_1048576_128 and_num_8388608_128 
       and_or_or_s apply blast
      using update_PSR_icc_1 and_num_2097152_128 and_num_8388608_128 
      and_or_or_s apply blast
     using update_PSR_icc_1 and_num_1048576_128 and_num_2097152_128 and_num_8388608_128
     and_or_or_or_s apply blast 
    using update_PSR_icc_1 and_num_4194304_128 and_num_8388608_128 
    and_or_or_s apply blast
   using update_PSR_icc_1 and_num_1048576_128 and_num_4194304_128 and_num_8388608_128
   and_or_or_or_s apply blast 
  using update_PSR_icc_1 and_num_2097152_128 and_num_4194304_128 and_num_8388608_128
  and_or_or_or_s apply blast 
 using update_PSR_icc_1 and_num_1048576_128 and_num_2097152_128 and_num_4194304_128 
 and_num_8388608_128 and_or_or_or_or_s by blast 
 
 lemma and_num_4294967167_128: "(AND) (0b11111111111111111111111101111111::word32)
   (0b00000000000000000000000010000000::word32) = 0"
 by simp
 
-lemma s_0_word: "((ucast (get_S ((AND) w 
+lemma s_0_word: "(((get_S ((AND) w 
   (0b11111111111111111111111101111111::word32))))::word1) = 0"
 apply (simp add: get_S_def)
   using and_num_4294967167_128
   by (simp add: ac_simps)
 
 lemma update_PSR_CWP_1: "w' = (AND) w (0b11111111111111111111111111100000::word32)
-  \<and> ((ucast (get_S w))::word1) = 0
-  \<Longrightarrow> ((ucast (get_S w'))::word1) = 0"
+  \<and> (((get_S w))::word1) = 0
+  \<Longrightarrow> (((get_S w'))::word1) = 0"
 by (simp add: get_S_def word_bw_assocs(1))
 
 lemma write_cpu_PSR_CWP_privilege: 
 assumes a1: "s' = snd (fst (write_cpu (update_CWP cwp_val 
                                         (cpu_reg_val PSR s)) 
                                       PSR 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: write_cpu_def)
 apply (simp add: simpler_modify_def)
 apply (simp add: cpu_reg_mod_def)
 apply (simp add: update_CWP_def)
 apply (simp add: Let_def)
 apply auto
 apply (simp add: cpu_reg_val_def)
 using s_0_word by blast
 
 lemma logical_instr_sub1_privilege: 
 assumes a1: "s' = snd (fst (logical_instr_sub1 instr_name result 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "instr_name = logic_type ANDcc \<or>
               instr_name = logic_type ANDNcc \<or>
               instr_name = logic_type ORcc \<or>
               instr_name = logic_type ORNcc \<or>
               instr_name = logic_type XORcc \<or> instr_name = logic_type XNORcc")
   case True
   then show ?thesis using a1
   apply (simp add: logical_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: logical_new_psr_val_def)
   using write_cpu_PSR_icc_privilege by blast
 next
   case False
   then show ?thesis using a1
   apply (simp add: logical_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma logical_instr_privilege: 
 assumes a1: "s' = snd (fst (logical_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: logical_instr_def)
 apply (simp add: Let_def simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold)
 apply auto
  apply (meson get_curr_win_privilege logical_instr_sub1_privilege write_reg_privilege)
 by (meson get_curr_win_privilege logical_instr_sub1_privilege write_reg_privilege)
 
 method shift_instr_privilege_proof = (
 (simp add: shift_instr_def),
 (simp add: Let_def), 
 (simp add: simpler_gets_def),
 (simp add: bind_def h1_def h2_def Let_def case_prod_unfold),
 auto,
 (blast intro: get_curr_win_privilege write_reg_privilege),
 (blast intro: get_curr_win_privilege write_reg_privilege)
 )
 
 lemma shift_instr_privilege: 
 assumes a1: "s' = snd (fst (shift_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "(fst instr = shift_type SLL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
   case True
   then show ?thesis using a1
   by shift_instr_privilege_proof
 next
   case False
   then have f1: "\<not>((fst instr = shift_type SLL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0))"
     by auto
   then show ?thesis
   proof (cases "(fst instr = shift_type SRL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
     case True
     then show ?thesis using a1 f1
     by shift_instr_privilege_proof
   next
     case False
     then have f2: "\<not>((fst instr = shift_type SRL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0))"
       by auto
     then show ?thesis 
     proof (cases "(fst instr = shift_type SRA) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
       case True
       then show ?thesis using a1 f1 f2
       by shift_instr_privilege_proof
     next
       case False
       then show ?thesis using a1 f1 f2
       apply (simp add: shift_instr_def)
       apply (simp add: Let_def) 
       apply (simp add: simpler_gets_def)
       apply (simp add: bind_def h1_def h2_def Let_def case_prod_unfold)
       apply (simp add: return_def)
       using get_curr_win_privilege by blast
     qed
   qed
 qed
 
 lemma add_instr_sub1_privilege: 
 assumes a1: "s' = snd (fst (add_instr_sub1 instr_name result rs1_val operand2 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "instr_name = arith_type ADDcc \<or> instr_name = arith_type ADDXcc")
   case True
   then show ?thesis using a1
   apply (simp add: add_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (blast intro: write_cpu_PSR_icc_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: add_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma add_instr_privilege: 
 assumes a1: "s' = snd (fst (add_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: add_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson add_instr_sub1_privilege get_curr_win_privilege write_reg_privilege)
 
 lemma sub_instr_sub1_privilege: 
 assumes a1: "s' = snd (fst (sub_instr_sub1 instr_name result rs1_val operand2 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "instr_name = arith_type SUBcc \<or> instr_name = arith_type SUBXcc")
   case True
   then show ?thesis using a1
   apply (simp add: sub_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (blast intro: write_cpu_PSR_icc_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: sub_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma sub_instr_privilege: 
 assumes a1: "s' = snd (fst (sub_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: sub_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson sub_instr_sub1_privilege get_curr_win_privilege write_reg_privilege)
 
 lemma mul_instr_sub1_privilege: 
 assumes a1: "s' = snd (fst (mul_instr_sub1 instr_name result  
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "instr_name \<in> {arith_type SMULcc,arith_type UMULcc}")
   case True
   then show ?thesis using a1
   apply (simp add: mul_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (blast intro: write_cpu_PSR_icc_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: mul_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma mul_instr_privilege: 
 assumes a1: "s' = snd (fst (mul_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: mul_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson get_curr_win_privilege mul_instr_sub1_privilege write_cpu_y_privilege write_reg_privilege)
 
 lemma div_write_new_val_privilege: 
 assumes a1: "s' = snd (fst (div_write_new_val i result temp_V  
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "(fst i) \<in> {arith_type UDIVcc,arith_type SDIVcc}")
   case True
   then show ?thesis using a1
   apply (simp add: div_write_new_val_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (blast intro: write_cpu_PSR_icc_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: div_write_new_val_def)
   by (simp add: return_def)
 qed
 
 lemma div_comp_privilege: 
 assumes a1: "s' = snd (fst (div_comp instr rs1 rd operand2  
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: div_comp_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson get_curr_win_privilege div_write_new_val_privilege write_reg_privilege)
 
 lemma div_instr_privilege: 
 assumes a1: "s' = snd (fst (div_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: div_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: return_def)
 apply auto
  using raise_trap_privilege apply blast
 using div_comp_privilege by blast
 
 lemma save_retore_sub1_privilege: 
 assumes a1: "s' = snd (fst (save_retore_sub1 result new_cwp rd 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: save_retore_sub1_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 using write_cpu_PSR_CWP_privilege write_reg_privilege by blast
 
 method save_restore_instr_privilege_proof = (
 (simp add: save_restore_instr_def),
 (simp add: Let_def),
 (simp add: simpler_gets_def bind_def h1_def h2_def Let_def),
 (simp add: case_prod_unfold),
 auto,
 (blast intro: get_curr_win_privilege raise_trap_privilege),
 (simp add: simpler_gets_def bind_def h1_def h2_def Let_def case_prod_unfold),
 (blast intro: get_curr_win_privilege save_retore_sub1_privilege)
 )
 
 lemma save_restore_instr_privilege: 
 assumes a1: "s' = snd (fst (save_restore_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "fst instr = ctrl_type SAVE")
   case True
   then have f1: "fst instr = ctrl_type SAVE" by auto
   then show ?thesis using a1
   by save_restore_instr_privilege_proof
 next
   case False
   then show ?thesis using a1
   by save_restore_instr_privilege_proof
 qed
 
 lemma call_instr_privilege: 
 assumes a1: "s' = snd (fst (call_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: call_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson get_curr_win_privilege write_cpu_npc_privilege write_cpu_pc_privilege write_reg_privilege)
 
 lemma jmpl_instr_privilege: 
 assumes a1: "s' = snd (fst (jmpl_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: jmpl_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply auto
  using get_curr_win_privilege raise_trap_privilege apply blast
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 by (meson get_curr_win_privilege write_cpu_npc_privilege write_cpu_pc_privilege write_reg_privilege)
 
 lemma rett_instr_privilege: 
 assumes a1: "snd (rett_instr i s) = False \<and>
   s' = snd (fst (rett_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: rett_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply auto
  apply (simp add: case_prod_unfold)
  apply (simp add: return_def)
  apply (blast intro: raise_trap_privilege)
 apply (simp add: bind_def h1_def h2_def Let_def)
 by (simp add: case_prod_unfold fail_def)
 
 method read_state_reg_instr_privilege_proof = (
 (simp add: read_state_reg_instr_def),
 (simp add: Let_def),
 (simp add: simpler_gets_def bind_def h1_def h2_def Let_def),
 (simp add: case_prod_unfold)
 )
 
 lemma read_state_reg_instr_privilege: 
 assumes a1: "s' = snd (fst (read_state_reg_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "(fst instr \<in> {sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR} \<or> 
         (fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 ((snd instr)!0))))")
   case True
   then have "(fst instr \<in> {sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR} \<or> 
         (fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 ((snd instr)!0))))
-        \<and> ((ucast (get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s))))))::word1) = 0"
+        \<and> (((get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s))))))::word1) = 0"
     by (metis assms get_curr_win_privilege)    
   then show ?thesis using a1
   apply read_state_reg_instr_privilege_proof
   by (blast intro: raise_trap_privilege get_curr_win_privilege)
 next
   case False
   then have f1: "\<not>((fst instr = sreg_type RDPSR \<or>
                     fst instr = sreg_type RDWIM \<or>
                     fst instr = sreg_type RDTBR \<or>
                     fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 (snd instr ! 0))) \<and>
-                   ucast (get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s))))) = 0)"
+                   (get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s))))) = 0)"
     by blast 
   then show ?thesis 
   proof (cases "illegal_instruction_ASR (get_operand_w5 ((snd instr)!0))")
     case True
     then show ?thesis using a1 f1
     apply read_state_reg_instr_privilege_proof
     by (simp add: illegal_instruction_ASR_def)    
   next
     case False
     then have f2: "\<not>(illegal_instruction_ASR (get_operand_w5 ((snd instr)!0)))" 
       by auto
     then show ?thesis 
     proof (cases "(get_operand_w5 ((snd instr)!1)) \<noteq> 0")
       case True
       then have f3: "(get_operand_w5 ((snd instr)!1)) \<noteq> 0" 
         by auto
       then show ?thesis 
       proof (cases "fst instr = sreg_type RDY")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: read_state_reg_instr_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         by (blast intro: get_curr_win_privilege write_reg_privilege)        
       next
         case False
         then have f4: "\<not>(fst instr = sreg_type RDY)" by auto
         then show ?thesis 
         proof (cases "fst instr = sreg_type RDASR")
           case True
           then show ?thesis using a1 f1 f2 f3 f4
           apply read_state_reg_instr_privilege_proof
           apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
           by (blast intro: get_curr_win_privilege write_reg_privilege) 
         next
           case False
           then have f5: "\<not>(fst instr = sreg_type RDASR)" by auto
           then show ?thesis 
           proof (cases "fst instr = sreg_type RDPSR")
             case True
             then show ?thesis using a1 f1 f2 f3 f4 f5
             apply read_state_reg_instr_privilege_proof
             by (blast intro: get_curr_win_privilege write_reg_privilege) 
           next
             case False
             then show ?thesis using a1 f1 f2 f3 f4 f5
             apply read_state_reg_instr_privilege_proof
             apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
             by (blast intro: get_curr_win_privilege write_reg_privilege) 
           qed
         qed
       qed
     next
       case False
       then show ?thesis using a1 
       apply read_state_reg_instr_privilege_proof
       apply (simp add: return_def) 
       using f1 f2 get_curr_win_privilege by blast     
     qed
   qed
 qed
 
 method write_state_reg_instr_privilege_proof = (
 (simp add: write_state_reg_instr_def),
 (simp add: Let_def),
 (simp add: simpler_gets_def bind_def h1_def h2_def Let_def),
 (simp add: case_prod_unfold)
 )
 
 lemma write_state_reg_instr_privilege: 
 assumes a1: "s' = snd (fst (write_state_reg_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "fst instr = sreg_type WRY")
   case True
   then show ?thesis using a1
   apply write_state_reg_instr_privilege_proof
   apply (simp add: simpler_modify_def)
   apply (simp add: delayed_pool_add_def DELAYNUM_def)
   by (blast intro: cpu_reg_mod_y_privilege get_curr_win_privilege)
 next
   case False
   then have f1: "\<not>(fst instr = sreg_type WRY)" by auto
   then show ?thesis
   proof (cases "fst instr = sreg_type WRASR")
     case True
     then show ?thesis
      using a1 f1
     apply write_state_reg_instr_privilege_proof
     apply (simp add: simpler_modify_def)
     apply auto
          using illegal_instruction_ASR_def apply blast
         using illegal_instruction_ASR_def apply blast
        using illegal_instruction_ASR_def apply blast
       using raise_trap_privilege get_curr_win_privilege apply blast
      apply (simp add: simpler_modify_def delayed_pool_add_def DELAYNUM_def)
      using cpu_reg_mod_asr_privilege get_curr_win_privilege apply blast
     apply (simp add: simpler_modify_def delayed_pool_add_def DELAYNUM_def)
     using cpu_reg_mod_asr_privilege get_curr_win_privilege by blast
   next
     case False
     then have f2: "\<not>(fst instr = sreg_type WRASR)" by auto
     have f3: "get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s)))) = 0"
       using get_curr_win_privilege a1 by (metis ucast_id)
     then show ?thesis 
     proof (cases "fst instr = sreg_type WRPSR")
       case True
       then show ?thesis using a1 f1 f2 f3
       apply write_state_reg_instr_privilege_proof
       by (metis raise_trap_privilege ucast_0)      
     next
       case False
       then have f4: "\<not>(fst instr = sreg_type WRPSR)" by auto
       then show ?thesis 
       proof (cases "fst instr = sreg_type WRWIM")  
         case True
         then show ?thesis using a1 f1 f2 f3 f4
         apply write_state_reg_instr_privilege_proof
         by (metis raise_trap_privilege ucast_0)  
       next
         case False
         then have f5: "\<not>(fst instr = sreg_type WRWIM)" by auto
         then show ?thesis using a1 f1 f2 f3 f4 f5
         apply write_state_reg_instr_privilege_proof
         by (metis raise_trap_privilege ucast_0)        
       qed
     qed
   qed
 qed
 
 lemma flush_instr_privilege: 
 assumes a1: "s' = snd (fst (flush_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: flush_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def simpler_modify_def)
 by (auto simp add: flush_cache_all_privilege)
 
 lemma branch_instr_privilege: 
 assumes a1: "s' = snd (fst (branch_instr instr 
   (s::(('a::len) sparc_state))))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 using a1
 apply (simp add: branch_instr_def)
 apply (simp add: Let_def simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold return_def)
 by (meson set_annul_privilege write_cpu_npc_privilege write_cpu_pc_privilege)
 
 method dispath_instr_privilege_proof = (
 (simp add: dispatch_instruction_def),
 (simp add: simpler_gets_def bind_def h1_def h2_def Let_def),
 (simp add: Let_def)
 )
 
 lemma dispath_instr_privilege: 
 assumes a1: "snd (dispatch_instruction instr s) = False \<and>
   s' = snd (fst (dispatch_instruction instr s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "get_trap_set s = {}")
   case True
   then have f1: "get_trap_set s = {}" by auto
   show ?thesis
   proof (cases "fst instr \<in> {load_store_type LDSB,load_store_type LDUB,
         load_store_type LDUBA,load_store_type LDUH,load_store_type LD,
         load_store_type LDA,load_store_type LDD}")
     case True
     then show ?thesis using a1 f1
     apply dispath_instr_privilege_proof
     by (blast intro: load_instr_privilege)    
   next
     case False
     then have f2: "\<not>(fst instr \<in> {load_store_type LDSB,load_store_type LDUB,
         load_store_type LDUBA,load_store_type LDUH,load_store_type LD,
         load_store_type LDA,load_store_type LDD})"
       by auto
     then show ?thesis 
     proof (cases "fst instr \<in> {load_store_type STB,load_store_type STH,
         load_store_type ST,load_store_type STA,load_store_type STD}")
       case True
       then show ?thesis using a1 f1 f2
       apply dispath_instr_privilege_proof
       by (blast intro: store_instr_privilege) 
     next
       case False
       then have f3: "\<not>(fst instr \<in> {load_store_type STB,load_store_type STH,
         load_store_type ST,load_store_type STA,load_store_type STD})"
         by auto
       then show ?thesis 
       proof (cases "fst instr \<in> {sethi_type SETHI}")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply dispath_instr_privilege_proof
         by (blast intro: sethi_instr_privilege) 
       next
         case False
         then have f4: "\<not>(fst instr \<in> {sethi_type SETHI})"
           by auto
         then show ?thesis
         proof (cases "fst instr \<in> {nop_type NOP}")
           case True
           then show ?thesis using a1 f1 f2 f3 f4
           apply dispath_instr_privilege_proof
           by (blast intro: nop_instr_privilege)
         next
           case False
           then have f5: "\<not>(fst instr \<in> {nop_type NOP})" 
             by auto
           then show ?thesis
           proof (cases "fst instr \<in> {logic_type ANDs,logic_type ANDcc,logic_type ANDN,
             logic_type ANDNcc,logic_type ORs,logic_type ORcc,logic_type ORN,
             logic_type XORs,logic_type XNOR}")
             case True
             then show ?thesis using a1 f1 f2 f3 f4 f5
             apply dispath_instr_privilege_proof
             by (blast intro: logical_instr_privilege)
           next
             case False
             then have f6: "\<not>(fst instr \<in> {logic_type ANDs,logic_type ANDcc,logic_type ANDN,
             logic_type ANDNcc,logic_type ORs,logic_type ORcc,logic_type ORN,
             logic_type XORs,logic_type XNOR})"
               by auto
             show ?thesis
             proof (cases "fst instr \<in> {shift_type SLL,shift_type SRL,shift_type SRA}")
               case True
               then show ?thesis using a1 f1 f2 f3 f4 f5 f6
               apply dispath_instr_privilege_proof
               by (blast intro: shift_instr_privilege)
             next
               case False
               then have f7: "\<not>(fst instr \<in> {shift_type SLL,shift_type SRL,shift_type SRA})"
                 by auto
               then show ?thesis 
               proof (cases "fst instr \<in> {arith_type ADD,arith_type ADDcc,arith_type ADDX}")
                 case True
                 then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7
                 apply dispath_instr_privilege_proof
                 by (blast intro: add_instr_privilege)
               next
                 case False
                 then have f8: "\<not>(fst instr \<in> {arith_type ADD,arith_type ADDcc,arith_type ADDX})"
                   by auto
                 then show ?thesis
                 proof (cases "fst instr \<in> {arith_type SUB,arith_type SUBcc,arith_type SUBX}")
                   case True
                   then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8
                   apply dispath_instr_privilege_proof
                   by (blast intro: sub_instr_privilege)
                 next
                   case False
                   then have f9: "\<not>(fst instr \<in> {arith_type SUB,arith_type SUBcc,arith_type SUBX})"
                     by auto
                   then show ?thesis
                   proof (cases "fst instr \<in> {arith_type UMUL,arith_type SMUL,arith_type SMULcc}")
                     case True
                     then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9
                     apply dispath_instr_privilege_proof
                     by (blast intro: mul_instr_privilege)
                   next
                     case False
                     then have f10: "\<not>(fst instr \<in> {arith_type UMUL,arith_type SMUL,
                       arith_type SMULcc})"
                       by auto
                     then show ?thesis 
                     proof (cases "fst instr \<in> {arith_type UDIV,arith_type UDIVcc,arith_type SDIV}")
                       case True
                       then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10
                       apply dispath_instr_privilege_proof
                       by (blast intro: div_instr_privilege)
                     next
                       case False
                       then have f11: "\<not>(fst instr \<in> {arith_type UDIV,
                         arith_type UDIVcc,arith_type SDIV})"
                         by auto
                       then show ?thesis 
                       proof (cases "fst instr \<in> {ctrl_type SAVE,ctrl_type RESTORE}")
                         case True
                         then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11
                         apply dispath_instr_privilege_proof
                         by (blast intro: save_restore_instr_privilege)
                       next
                         case False
                         then have f12: "\<not>(fst instr \<in> {ctrl_type SAVE,ctrl_type RESTORE})"
                           by auto
                         then show ?thesis 
                         proof (cases "fst instr \<in> {call_type CALL}")
                           case True
                           then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
                           apply dispath_instr_privilege_proof
                           by (blast intro: call_instr_privilege)
                         next
                           case False
                           then have f13: "\<not>(fst instr \<in> {call_type CALL})" by auto
                           then show ?thesis
                           proof (cases "fst instr \<in> {ctrl_type JMPL}")
                             case True
                             then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                             apply dispath_instr_privilege_proof
                             by (blast intro: jmpl_instr_privilege)
                           next
                             case False
                             then have f14: "\<not>(fst instr \<in> {ctrl_type JMPL})" by auto
                             then show ?thesis 
                             proof (cases "fst instr \<in> {ctrl_type RETT}")
                               case True
                               then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13
                                 f14
                               apply dispath_instr_privilege_proof
                               by (blast intro: rett_instr_privilege)
                             next
                               case False
                               then have f15: "\<not>(fst instr \<in> {ctrl_type RETT})" by auto
                               then show ?thesis 
                               proof (cases "fst instr \<in> {sreg_type RDY,sreg_type RDPSR,
                                 sreg_type RDWIM, sreg_type RDTBR}")
                                 case True
                                 then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                 f13 f14 f15
                                 apply dispath_instr_privilege_proof
                                 by (blast intro: read_state_reg_instr_privilege)
                               next
                                 case False
                                 then have f16: "\<not>(fst instr \<in> {sreg_type RDY,sreg_type RDPSR,
                                 sreg_type RDWIM, sreg_type RDTBR})" by auto
                                 then show ?thesis
                                 proof (cases "fst instr \<in> {sreg_type WRY,sreg_type WRPSR,
                                   sreg_type WRWIM, sreg_type WRTBR}")
                                   case True
                                   then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 
                                   f13 f14 f15 f16
                                   apply dispath_instr_privilege_proof
                                   by (blast intro: write_state_reg_instr_privilege)
                                 next
                                   case False
                                   then have f17: "\<not>(fst instr \<in> {sreg_type WRY,sreg_type WRPSR,
                                   sreg_type WRWIM, sreg_type WRTBR})" by auto
                                   then show ?thesis
                                   proof (cases "fst instr \<in> {load_store_type FLUSH}")
                                     case True
                                     then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                     f12 f13 f14 f15 f16 f17
                                     apply dispath_instr_privilege_proof
                                     by (blast intro: flush_instr_privilege)
                                   next
                                     case False
                                     then have f18: "\<not>(fst instr \<in> {load_store_type FLUSH})" by auto
                                     then show ?thesis 
                                     proof (cases "fst instr \<in> {bicc_type BE,bicc_type BNE,
                                       bicc_type BGU,bicc_type BLE,bicc_type BL,bicc_type BGE,
                                       bicc_type BNEG,bicc_type BG,bicc_type BCS,bicc_type BLEU,
                                       bicc_type BCC,bicc_type BA,bicc_type BN}")
                                       case True
                                       then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                       f12 f13 f14 f15 f16 f17 f18
                                       apply dispath_instr_privilege_proof
                                       by (blast intro: branch_instr_privilege)
                                     next
                                       case False
                                       then show ?thesis using a1 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 
                                       f12 f13 f14 f15 f16 f17 f18
                                       apply dispath_instr_privilege_proof
                                       by (simp add: fail_def)
                                     qed
                                   qed
                                 qed
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case False
   then show ?thesis using a1
   apply (simp add: dispatch_instruction_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: Let_def)
   by (simp add: return_def)
 qed
 
 lemma execute_instr_sub1_privilege: 
 assumes a1: "snd (execute_instr_sub1 i s) = False \<and>
   s' = snd (fst (execute_instr_sub1 i s))
-  \<and> ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  \<and> (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "get_trap_set s = {} \<and> fst i \<notin> {call_type CALL,ctrl_type RETT,ctrl_type JMPL,
                                    bicc_type BE,bicc_type BNE,bicc_type BGU,
                                    bicc_type BLE,bicc_type BL,bicc_type BGE,
                                    bicc_type BNEG,bicc_type BG,
                                    bicc_type BCS,bicc_type BLEU,bicc_type BCC,
                                    bicc_type BA,bicc_type BN}")
   case True
   then show ?thesis using a1
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold return_def)
   by (auto intro: write_cpu_pc_privilege write_cpu_npc_privilege)
 next
   case False
   then show ?thesis using a1
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold return_def)
   by auto
 qed
 
 text \<open>
   Assume that there is no \<open>delayed_write\<close> and 
   there is no traps to be executed.
   If an instruction is executed as a user,
   the privilege will not be changed to supervisor after 
   the execution.\<close>
 theorem safe_privilege : 
 assumes a1: "get_delayed_pool s = [] \<and> get_trap_set s = {} \<and>
   snd (execute_instruction() s) = False \<and>
   s' = snd (fst (execute_instruction() s)) \<and> 
-  ((ucast (get_S (cpu_reg_val PSR s)))::word1) = 0"
-shows "((ucast (get_S (cpu_reg_val PSR s')))::word1) = 0"
+  (((get_S (cpu_reg_val PSR s)))::word1) = 0"
+shows "(((get_S (cpu_reg_val PSR s')))::word1) = 0"
 proof (cases "exe_mode_val s")
   case True   
   then have f2: "exe_mode_val s = True" by auto
   then show ?thesis
   proof (cases "\<exists>e. fetch_instruction (delayed_pool_write s) = Inl e")
     case True
     then have f3: "\<exists>e. fetch_instruction (delayed_pool_write s) = Inl e"
       by auto
     then have f4: "\<not> (\<exists>v. fetch_instruction (delayed_pool_write s) = Inr v)" 
       using fetch_instr_result_3 by auto
     then show ?thesis using a1 f2 f3 raise_trap_result empty_delayed_pool_write_privilege raise_trap_privilege        
     apply (simp add: execute_instruction_def)
     apply (simp add: exec_gets return_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply (simp add: simpler_modify_def)
     apply clarsimp
     apply (simp add: case_prod_unfold)
     by (blast intro: empty_delayed_pool_write_privilege raise_trap_privilege)      
   next
     case False
     then have f5: "\<exists>v. fetch_instruction (delayed_pool_write s) = Inr v"
       using fetch_instr_result_1 by blast
     then have f6: "\<exists>v. fetch_instruction (delayed_pool_write s) = Inr v \<and>
     \<not> (\<exists>e. ((decode_instruction v)::(Exception list + instruction)) = Inl e)"
       using a1 f2 dispatch_fail by blast 
     then have f7: "\<exists>v. fetch_instruction (delayed_pool_write s) = Inr v \<and>
     (\<exists>v1. ((decode_instruction v)::(Exception list + instruction)) = Inr v1)"
       using decode_instr_result_4 by auto 
     then show ?thesis
     proof (cases "annul_val (delayed_pool_write s)")
       case True
       then show ?thesis using  a1 f2 f7           
       apply (simp add: execute_instruction_def)
       apply (simp add: exec_gets return_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: simpler_modify_def)
       apply clarsimp
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: case_prod_unfold)
       by (auto intro: empty_delayed_pool_write_privilege 
       set_annul_privilege write_cpu_npc_privilege write_cpu_pc_privilege)
     next 
       case False
       then show ?thesis using  a1 f2 f7 
       apply (simp add: execute_instruction_def)
       apply (simp add: exec_gets return_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: simpler_modify_def)
       apply clarsimp
       apply (simp add: bind_def h1_def h2_def Let_def)
       apply (simp add: case_prod_unfold)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: simpler_modify_def return_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: case_prod_unfold)
       by (auto intro: empty_delayed_pool_write_privilege dispath_instr_privilege 
          execute_instr_sub1_privilege)        
     qed
   qed    
 next
   case False
   then show ?thesis using a1 
   apply (simp add: execute_instruction_def)
   by (simp add: simpler_gets_def bind_def h1_def h2_def Let_def return_def) 
 qed
 
 (*********************************************************************)
 
 section \<open>Single step non-interference property.\<close>
 
 (*********************************************************************)
 
 definition user_accessible:: "('a::len) sparc_state \<Rightarrow> phys_address \<Rightarrow> bool" where
 "user_accessible s pa \<equiv> \<exists>va p. (virt_to_phys va (mmu s) (mem s)) = Some p \<and>
   mmu_readable (get_acc_flag (snd p)) 10 \<and>
   (fst p) = pa" \<comment> \<open>Passing \<open>asi = 8\<close> is the same.\<close>
 
 lemma user_accessible_8: 
 assumes a1: "mmu_readable (get_acc_flag (snd p)) 8"
 shows "mmu_readable (get_acc_flag (snd p)) 10"
 using a1 by (simp add: mmu_readable_def)
 
 definition mem_equal:: "('a) sparc_state \<Rightarrow> ('a) sparc_state \<Rightarrow> 
   phys_address \<Rightarrow> bool" where
 "mem_equal s1 s2 pa \<equiv>
   (mem s1) 8 (pa AND 68719476732) = (mem s2) 8 (pa AND 68719476732) \<and>
   (mem s1) 8 ((pa AND 68719476732) + 1) = (mem s2) 8 ((pa AND 68719476732) + 1) \<and>
   (mem s1) 8 ((pa AND 68719476732) + 2) = (mem s2) 8 ((pa AND 68719476732) + 2) \<and>
   (mem s1) 8 ((pa AND 68719476732) + 3) = (mem s2) 8 ((pa AND 68719476732) + 3) \<and>
   (mem s1) 9 (pa AND 68719476732) = (mem s2) 9 (pa AND 68719476732) \<and>
   (mem s1) 9 ((pa AND 68719476732) + 1) = (mem s2) 9 ((pa AND 68719476732) + 1) \<and>
   (mem s1) 9 ((pa AND 68719476732) + 2) = (mem s2) 9 ((pa AND 68719476732) + 2) \<and>
   (mem s1) 9 ((pa AND 68719476732) + 3) = (mem s2) 9 ((pa AND 68719476732) + 3) \<and>
   (mem s1) 10 (pa AND 68719476732) = (mem s2) 10 (pa AND 68719476732) \<and>
   (mem s1) 10 ((pa AND 68719476732) + 1) = (mem s2) 10 ((pa AND 68719476732) + 1) \<and>
   (mem s1) 10 ((pa AND 68719476732) + 2) = (mem s2) 10 ((pa AND 68719476732) + 2) \<and>
   (mem s1) 10 ((pa AND 68719476732) + 3) = (mem s2) 10 ((pa AND 68719476732) + 3) \<and>
   (mem s1) 11 (pa AND 68719476732) = (mem s2) 11 (pa AND 68719476732) \<and>
   (mem s1) 11 ((pa AND 68719476732) + 1) = (mem s2) 11 ((pa AND 68719476732) + 1) \<and>
   (mem s1) 11 ((pa AND 68719476732) + 2) = (mem s2) 11 ((pa AND 68719476732) + 2) \<and>
   (mem s1) 11 ((pa AND 68719476732) + 3) = (mem s2) 11 ((pa AND 68719476732) + 3)"
 
 text \<open>\<open>low_equal\<close> defines the equivalence relation over two sparc
 states that is an analogy to the \<open>=\<^sub>L\<close> relation over memory contexts
 in the traditional non-interference theorem.\<close>
 
 definition low_equal:: "('a::len) sparc_state \<Rightarrow> ('a) sparc_state \<Rightarrow> bool" where
 "low_equal s1 s2 \<equiv> 
   (cpu_reg s1) = (cpu_reg s2) \<and>
   (user_reg s1) = (user_reg s2) \<and>
   (sys_reg s1) = (sys_reg s2) \<and>  
   (\<forall>va. (virt_to_phys va (mmu s1) (mem s1)) = (virt_to_phys va (mmu s2) (mem s2))) \<and>
   (\<forall>pa. (user_accessible s1 pa) \<longrightarrow> mem_equal s1 s2 pa) \<and>  
   (mmu s1) = (mmu s2) \<and> 
   (state_var s1) = (state_var s2) \<and>
   (traps s1) = (traps s2) \<and>
   (undef s1) = (undef s2)
 " 
 
 lemma low_equal_com: "low_equal s1 s2 \<Longrightarrow> low_equal s2 s1"
 apply (simp add: low_equal_def)
 apply (simp add: mem_equal_def user_accessible_def)
 by metis
 
 lemma non_exe_mode_equal: "exe_mode_val s = False \<and>
 get_trap_set s = {} \<and>
 Some t = NEXT s \<Longrightarrow> 
 t = s"
 apply (simp add: NEXT_def execute_instruction_def)
 apply auto
 by (simp add: simpler_gets_def bind_def h1_def h2_def Let_def return_def)
 
 lemma exe_mode_low_equal:
 assumes a1: "low_equal s1 s2"
 shows " exe_mode_val s1 =  exe_mode_val s2"
 using a1 apply (simp add: low_equal_def)
 by (simp add: exe_mode_val_def)
 
 lemma mem_val_mod_state: "mem_val_alt asi a s = mem_val_alt asi a 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>)"
 apply (simp add: mem_val_alt_def)
 by (simp add: Let_def)
 
 lemma mem_val_w32_mod_state: "mem_val_w32 asi a s = mem_val_w32 asi a 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>)"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 by (metis mem_val_mod_state)
 
 lemma load_word_mem_mod_state: "load_word_mem s addr asi = load_word_mem 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi"
 apply (simp add: load_word_mem_def)
 apply (case_tac "virt_to_phys addr (mmu s) (mem s) = None")
  apply auto
 by (auto simp add: mem_val_w32_mod_state)
 
 lemma load_word_mem2_mod_state: 
 "fst (case load_word_mem s addr asi of None \<Rightarrow> (None, s)
       | Some w \<Rightarrow> (Some w, add_data_cache s addr w 15)) =
  fst (case load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi of
          None \<Rightarrow> (None, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>))
       | Some w \<Rightarrow> (Some w, add_data_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr w 15))"
 proof (cases "load_word_mem s addr asi = None")
   case True
   then have "load_word_mem s addr asi = None \<and>
     load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi = None"
     using load_word_mem_mod_state by metis
   then show ?thesis by auto
 next
   case False
   then have "\<exists>w. load_word_mem s addr asi = Some w" by auto
   then have "\<exists>w. load_word_mem s addr asi = Some w \<and> 
     load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi = Some w"
   using load_word_mem_mod_state by metis
   then show ?thesis by auto
 qed
 
 lemma load_word_mem3_mod_state: 
 "fst (case load_word_mem s addr asi of None \<Rightarrow> (None, s)
       | Some w \<Rightarrow> (Some w, add_instr_cache s addr w 15)) =
  fst (case load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi of
          None \<Rightarrow> (None, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>))
       | Some w \<Rightarrow> (Some w, add_instr_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr w 15))"
 proof (cases "load_word_mem s addr asi = None")
   case True
   then have "load_word_mem s addr asi = None \<and>
     load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi = None"
     using load_word_mem_mod_state by metis
   then show ?thesis by auto
 next
   case False
   then have "\<exists>w. load_word_mem s addr asi = Some w" by auto
   then have "\<exists>w. load_word_mem s addr asi = Some w \<and> 
     load_word_mem (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr asi = Some w"
   using load_word_mem_mod_state by metis
   then show ?thesis by auto
 qed
 
 lemma read_dcache_mod_state: "read_data_cache s addr = read_data_cache 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr"
 apply (simp add: read_data_cache_def)
 by (simp add: dcache_val_def)
 
 lemma read_dcache2_mod_state: 
 "fst (case read_data_cache s addr of None \<Rightarrow> (None, s)
       | Some w \<Rightarrow> (Some w, s)) =
  fst (case read_data_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr of
          None \<Rightarrow> (None, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>))
       | Some w \<Rightarrow> (Some w, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>)))"
 proof (cases "read_data_cache s addr = None")
   case True
   then have "read_data_cache s addr = None \<and>
     read_data_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr = None"
     using read_dcache_mod_state by metis
   then show ?thesis by auto    
 next
   case False
   then have "\<exists>w. read_data_cache s addr = Some w" by auto
   then have "\<exists>w. read_data_cache s addr = Some w \<and> 
     read_data_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr = Some w"
     using read_dcache_mod_state by metis
   then show ?thesis by auto
 qed
 
 lemma read_icache_mod_state: "read_instr_cache s addr = read_instr_cache 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr"
 apply (simp add: read_instr_cache_def)
 by (simp add: icache_val_def)
 
 lemma read_icache2_mod_state: 
 "fst (case read_instr_cache s addr of None \<Rightarrow> (None, s)
       | Some w \<Rightarrow> (Some w, s)) =
  fst (case read_instr_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr of
          None \<Rightarrow> (None, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>))
       | Some w \<Rightarrow> (Some w, (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>)))"
 proof (cases "read_instr_cache s addr = None")
   case True
   then have "read_instr_cache s addr = None \<and>
     read_instr_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr = None"
     using read_icache_mod_state by metis
   then show ?thesis by auto    
 next
   case False
   then have "\<exists>w. read_instr_cache s addr = Some w" by auto
   then have "\<exists>w. read_instr_cache s addr = Some w \<and> 
     read_instr_cache (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) addr = Some w"
     using read_icache_mod_state by metis
   then show ?thesis by auto
 qed
 
 lemma mem_read_mod_state: "fst (memory_read asi addr s) =
 fst (memory_read asi addr 
 (s\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>))"
 apply (simp add: memory_read_def)
 apply (case_tac "uint asi = 1")
  apply (simp add: Let_def)
  apply (metis load_word_mem_mod_state option.distinct(1))
 apply (case_tac "uint asi = 2")
  apply (simp add: Let_def)
  apply (simp add: sys_reg_val_def)
 apply (case_tac "uint asi \<in> {8,9}")
  apply (simp add: Let_def)
  apply (simp add: load_word_mem3_mod_state)
  apply (simp add: load_word_mem_mod_state)
 apply (case_tac "uint asi \<in> {10,11}")
  apply (simp add: Let_def)
  apply (simp add: load_word_mem2_mod_state)
  apply (simp add: load_word_mem_mod_state)
 apply (case_tac "uint asi = 13")
  apply (simp add: Let_def)
  apply (simp add: read_icache2_mod_state)
 apply (case_tac "uint asi = 15")
  apply (simp add: Let_def)
  apply (simp add: read_dcache2_mod_state)
 apply (case_tac "uint asi = 25")
  apply (simp add: Let_def)
 apply (case_tac "uint asi = 28")
  apply (simp add: Let_def)
  apply (simp add: mem_val_w32_mod_state)
 by (simp add: Let_def)
 
 lemma insert_trap_mem: "fst (memory_read asi addr s) =
 fst (memory_read asi addr (s\<lparr>traps := new_traps\<rparr>))"
 proof -
   have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := (cpu_reg s),
          user_reg := (user_reg s),
          dwrite := (dwrite s),
          state_var := (state_var s),
          traps := new_traps,
          undef := (undef s)\<rparr>))"
     using mem_read_mod_state by blast
     then show ?thesis by auto
 qed
 
 lemma cpu_reg_mod_mem: "fst (memory_read asi addr s) =
 fst (memory_read asi addr (s\<lparr>cpu_reg := new_cpu_reg\<rparr>))"
 proof -
   have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := new_cpu_reg,
          user_reg := (user_reg s),
          dwrite := (dwrite s),
          state_var := (state_var s),
          traps := (traps s),
          undef := (undef s)\<rparr>))"
     using mem_read_mod_state by blast
     then show ?thesis by auto
 qed
 
 lemma user_reg_mod_mem: "fst (memory_read asi addr s) =
 fst (memory_read asi addr (s\<lparr>user_reg := new_user_reg\<rparr>))"
 proof -
   have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := (cpu_reg s),
          user_reg := new_user_reg,
          dwrite := (dwrite s),
          state_var := (state_var s),
          traps := (traps s),
          undef := (undef s)\<rparr>))"
     using mem_read_mod_state by blast
     then show ?thesis by auto
 qed
 
 lemma annul_mem: "fst (memory_read asi addr s) =
 fst (memory_read asi addr 
 (s\<lparr>state_var := new_state_var,
    cpu_reg := new_cpu_reg\<rparr>))"
 proof -
   have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := new_cpu_reg,
          user_reg := (user_reg s),
          dwrite := (dwrite s),
          state_var := new_state_var,
          traps := (traps s),
          undef := (undef s)\<rparr>))"
     using mem_read_mod_state by blast
   then have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := new_cpu_reg,
          state_var := new_state_var\<rparr>))"
     by auto        
   then show ?thesis 
     by (metis Sparc_State.sparc_state.surjective Sparc_State.sparc_state.update_convs(1) Sparc_State.sparc_state.update_convs(8))
 qed
 
 lemma state_var_mod_mem: "fst (memory_read asi addr s) =
 fst (memory_read asi addr (s\<lparr>state_var := new_state_var\<rparr>))"
 proof -
   have "fst (memory_read asi addr s) =
     fst (memory_read asi addr 
       (s\<lparr>cpu_reg := (cpu_reg s),
          user_reg := (user_reg s),
          dwrite := (dwrite s),
          state_var := new_state_var,
          traps := (traps s),
          undef := (undef s)\<rparr>))"
     using mem_read_mod_state by blast
     then show ?thesis by auto
 qed
 
 lemma mod_state_low_equal: "low_equal s1 s2 \<and>
 t1 = (s1\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) \<and>
 t2 = (s2\<lparr>cpu_reg := new_cpu_reg,
    user_reg := new_user_reg,
    dwrite := new_dwrite,
    state_var := new_state_var,
    traps := new_traps,
    undef := new_undef\<rparr>) \<Longrightarrow>
 low_equal t1 t2"
 apply (simp add: low_equal_def)
 apply clarsimp
 apply (simp add: mem_equal_def)
 by (simp add: user_accessible_def)
 
 lemma user_reg_state_mod_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>           
 t1 = (s1\<lparr>user_reg := new_user_reg\<rparr>) \<and>
 t2 = (s2\<lparr>user_reg := new_user_reg\<rparr>)"
 shows "low_equal t1 t2"
 proof -
   have "low_equal s1 s2 \<and>
 t1 = (s1\<lparr>cpu_reg := (cpu_reg s1),
    user_reg := new_user_reg,
    dwrite := (dwrite s1),
    state_var := (state_var s1),
    traps := (traps s1),
    undef := (undef s1)\<rparr>) \<and>
 t2 = (s2\<lparr>cpu_reg := (cpu_reg s2),
    user_reg := new_user_reg,
    dwrite := (dwrite s2),
    state_var := (state_var s2),
    traps := (traps s2),
    undef := (undef s2)\<rparr>) \<Longrightarrow>
 low_equal t1 t2"
     using mod_state_low_equal apply (simp add: low_equal_def)    
     apply (simp add: user_accessible_def mem_equal_def)
     by clarsimp
   then show ?thesis using a1
   by clarsimp
 qed
 
 lemma mod_trap_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>           
 t1 = (s1\<lparr>traps := new_traps\<rparr>) \<and>
 t2 = (s2\<lparr>traps := new_traps\<rparr>)"
 shows "low_equal t1 t2"
 proof -
   have "low_equal s1 s2 \<and>
 t1 = (s1\<lparr>cpu_reg := (cpu_reg s1),
    user_reg := (user_reg s1),
    dwrite := (dwrite s1),
    state_var := (state_var s1),
    traps := new_traps,
    undef := (undef s1)\<rparr>) \<and>
 t2 = (s2\<lparr>cpu_reg := (cpu_reg s2),
    user_reg := (user_reg s2),
    dwrite := (dwrite s2),
    state_var := (state_var s2),
    traps := new_traps,
    undef := (undef s2)\<rparr>) \<Longrightarrow>
 low_equal t1 t2"
     using mod_state_low_equal apply (simp add: low_equal_def)
     apply (simp add: user_accessible_def mem_equal_def)
     by clarsimp
   then show ?thesis using a1
   by clarsimp
 qed
 
 lemma state_var_low_equal: "low_equal s1 s2 \<Longrightarrow>
 state_var s1 = state_var s2"
 by (simp add: low_equal_def)
 
 lemma state_var2_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>           
 t1 = (s1\<lparr>state_var := new_state_var\<rparr>) \<and>
 t2 = (s2\<lparr>state_var := new_state_var\<rparr>)"
 shows "low_equal t1 t2"
 proof -
   have "low_equal s1 s2 \<and>
 t1 = (s1\<lparr>cpu_reg := (cpu_reg s1),
    user_reg := (user_reg s1),
    dwrite := (dwrite s1),
    state_var := new_state_var,
    traps := (traps s1),
    undef := (undef s1)\<rparr>) \<and>
 t2 = (s2\<lparr>cpu_reg := (cpu_reg s2),
    user_reg := (user_reg s2),
    dwrite := (dwrite s2),
    state_var := new_state_var,
    traps := (traps s2),
    undef := (undef s2)\<rparr>) \<Longrightarrow>
 low_equal t1 t2"
     using mod_state_low_equal apply (simp add: low_equal_def)
     apply (simp add: user_accessible_def mem_equal_def)
     by clarsimp   
   then show ?thesis using a1
   by clarsimp
 qed
 
 lemma traps_low_equal: "low_equal s1 s2 \<Longrightarrow> traps s1 = traps s2"
 by (simp add: low_equal_def)
 
 lemma s_low_equal: "low_equal s1 s2 \<Longrightarrow>
 (get_S (cpu_reg_val PSR s1)) = (get_S (cpu_reg_val PSR s2))"
 by (simp add: low_equal_def cpu_reg_val_def)
 
 lemma cpu_reg_val_low_equal: "low_equal s1 s2 \<Longrightarrow>
 (cpu_reg_val cr s1) = (cpu_reg_val cr s2)"
 by (simp add: cpu_reg_val_def low_equal_def)
 
 lemma get_curr_win_low_equal: "low_equal s1 s2 \<Longrightarrow>
 (fst (fst (get_curr_win () s1))) = (fst (fst (get_curr_win () s2)))"
 apply (simp add: low_equal_def)
 apply (simp add: get_curr_win_def cpu_reg_val_def get_CWP_def)
 by (simp add: simpler_gets_def)
 
 lemma get_curr_win2_low_equal: "low_equal s1 s2 \<Longrightarrow>
 t1 = (snd (fst (get_curr_win () s1))) \<Longrightarrow>
 t2 = (snd (fst (get_curr_win () s2))) \<Longrightarrow>
 low_equal t1 t2"
 apply (simp add: low_equal_def)
 apply (simp add: get_curr_win_def cpu_reg_val_def get_CWP_def)
 by (auto simp add: simpler_gets_def)
 
 lemma get_curr_win3_low_equal: "low_equal s1 s2 \<Longrightarrow>
 (traps (snd (fst (get_curr_win () s1)))) =
 (traps (snd (fst (get_curr_win () s2))))"
 using low_equal_def get_curr_win2_low_equal by blast
 
 lemma get_addr_low_equal: "low_equal s1 s2 \<Longrightarrow>
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) =
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<and>
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) =
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<and>
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) =
 ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word1)"
 apply (simp add: low_equal_def)
 apply (simp add: get_curr_win_def cpu_reg_val_def get_CWP_def)
 apply (simp add: simpler_gets_def get_addr_def user_reg_val_def)
 apply (simp add: Let_def )
 apply (simp add: get_CWP_def cpu_reg_val_def get_operand2_def)
 by (simp add: user_reg_val_def)
 
 lemma get_addr2_low_equal: "low_equal s1 s2 \<Longrightarrow>
 get_addr (snd instr) (snd (fst (get_curr_win () s1))) =
 get_addr (snd instr) (snd (fst (get_curr_win () s2)))"
 apply (simp add: low_equal_def)
 apply (simp add: get_curr_win_def cpu_reg_val_def get_CWP_def)
 apply (simp add: simpler_gets_def get_addr_def user_reg_val_def)
 apply (simp add: Let_def )
 apply (simp add: get_CWP_def cpu_reg_val_def get_operand2_def)
 by (simp add: user_reg_val_def)
 
 lemma sys_reg_low_equal: "low_equal s1 s2 \<Longrightarrow>
 sys_reg s1 = sys_reg s2"
 by (simp add: low_equal_def)
 
 lemma user_reg_low_equal: "low_equal s1 s2 \<Longrightarrow>
 user_reg s1 = user_reg s2"
 by (simp add: low_equal_def)
 
 lemma user_reg_val_low_equal: "low_equal s1 s2 \<Longrightarrow>
 user_reg_val win ur s1 = user_reg_val win ur s2"
 apply (simp add: user_reg_val_def)
 by (simp add: user_reg_low_equal)
 
 lemma get_operand2_low_equal: "low_equal s1 s2 \<Longrightarrow>
 get_operand2 op_list s1 = get_operand2 op_list s2"
 apply (simp add: get_operand2_def)
 apply (simp add: cpu_reg_val_low_equal)
 apply auto
 apply (simp add: user_reg_val_def)
 using user_reg_low_equal by fastforce
 
 lemma mem_val_mod_cache: "mem_val_alt asi a s = 
 mem_val_alt asi a (s\<lparr>cache := new_cache\<rparr>)"
 apply (simp add: mem_val_alt_def)
 by (simp add: Let_def)
 
 lemma mem_val_w32_mod_cache: "mem_val_w32 asi a s = 
 mem_val_w32 asi a (s\<lparr>cache := new_cache\<rparr>)"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 by (metis mem_val_mod_cache)
 
 lemma load_word_mem_mod_cache: 
 "load_word_mem s addr asi =
 load_word_mem (s\<lparr>cache := new_cache\<rparr>) addr asi"
 apply (simp add: load_word_mem_def)
 apply (case_tac "virt_to_phys addr (mmu s) (mem s) = None")
  apply auto
 by (simp add: mem_val_w32_mod_cache)
 
 lemma memory_read_8_mod_cache:
 "fst (memory_read 8 addr s) = fst (memory_read 8 addr (s\<lparr>cache := new_cache\<rparr>))"
 apply (simp add: memory_read_def)
 apply (case_tac "sys_reg s CCR AND 1 \<noteq> 0")
  apply auto
  apply (simp add: option.case_eq_if load_word_mem_mod_cache)
  apply (auto intro: load_word_mem_mod_cache)
  apply (metis load_word_mem_mod_cache option.distinct(1))
 by (metis load_word_mem_mod_cache option.distinct(1))
 
 lemma memory_read_10_mod_cache:
 "fst (memory_read 10 addr s) = fst (memory_read 10 addr (s\<lparr>cache := new_cache\<rparr>))"
 apply (simp add: memory_read_def)
 apply (case_tac "sys_reg s CCR AND 1 \<noteq> 0")
  apply auto
  apply (simp add: option.case_eq_if load_word_mem_mod_cache)
  apply (auto intro: load_word_mem_mod_cache)
  apply (metis load_word_mem_mod_cache option.distinct(1))
 by (metis load_word_mem_mod_cache option.distinct(1))
 
 lemma mem_equal_mod_cache: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_equal (s1\<lparr>cache := new_cache1\<rparr>) (s2\<lparr>cache := new_cache2\<rparr>) pa"
 by (simp add: mem_equal_def)
 
 lemma user_accessible_mod_cache: "user_accessible (s\<lparr>cache := new_cache\<rparr>) pa =
 user_accessible s pa"
 by (simp add: user_accessible_def)
 
 lemma mem_equal_mod_user_reg: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_equal (s1\<lparr>user_reg := new_user_reg1\<rparr>) (s2\<lparr>user_reg := user_reg2\<rparr>) pa"
 by (simp add: mem_equal_def)
 
 lemma user_accessible_mod_user_reg: "user_accessible (s\<lparr>user_reg := new_user_reg\<rparr>) pa =
 user_accessible s pa"
 by (simp add: user_accessible_def)
 
 lemma mem_equal_mod_cpu_reg: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_equal (s1\<lparr>cpu_reg := new_cpu1\<rparr>) (s2\<lparr>cpu_reg := cpu_reg2\<rparr>) pa"
 by (simp add: mem_equal_def)
 
 lemma user_accessible_mod_cpu_reg: "user_accessible (s\<lparr>cpu_reg := new_cpu_reg\<rparr>) pa =
 user_accessible s pa"
 by (simp add: user_accessible_def)
 
 lemma mem_equal_mod_trap: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_equal (s1\<lparr>traps := new_traps1\<rparr>) (s2\<lparr>traps := traps2\<rparr>) pa"
 by (simp add: mem_equal_def)
 
 lemma user_accessible_mod_trap: "user_accessible (s\<lparr>traps := new_traps\<rparr>) pa =
 user_accessible s pa"
 by (simp add: user_accessible_def)
 
 lemma mem_equal_annul: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_equal (s1\<lparr>state_var := new_state_var,
    cpu_reg := new_cpu_reg\<rparr>) (s2\<lparr>state_var := new_state_var2,
    cpu_reg := new_cpu_reg2\<rparr>) pa"
 by (simp add: mem_equal_def)
 
 lemma user_accessible_annul: "user_accessible (s\<lparr>state_var := new_state_var, 
   cpu_reg := new_cpu_reg\<rparr>) pa =
 user_accessible s pa"
 by (simp add: user_accessible_def)
 
 lemma mem_val_alt_10_mem_equal_0: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 10 (pa AND 68719476732) s1 = mem_val_alt 10 (pa AND 68719476732) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_mem_equal_1: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 10 ((pa AND 68719476732) + 1) s1 = mem_val_alt 10 ((pa AND 68719476732) + 1) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_mem_equal_2: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 10 ((pa AND 68719476732) + 2) s1 = mem_val_alt 10 ((pa AND 68719476732) + 2) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_mem_equal_3: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 10 ((pa AND 68719476732) + 3) s1 = mem_val_alt 10 ((pa AND 68719476732) + 3) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_mem_equal: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 (pa AND 68719476732) s1 = mem_val_alt 10 (pa AND 68719476732) s2 \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 1) s1 = mem_val_alt 10 ((pa AND 68719476732) + 1) s2 \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 2) s1 = mem_val_alt 10 ((pa AND 68719476732) + 2) s2 \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 3) s1 = mem_val_alt 10 ((pa AND 68719476732) + 3) s2"
 using mem_val_alt_10_mem_equal_0 mem_val_alt_10_mem_equal_1
 mem_val_alt_10_mem_equal_2 mem_val_alt_10_mem_equal_3 a1
 by blast
 
 lemma mem_val_w32_10_mem_equal: 
 assumes a1: "mem_equal s1 s2 a"
 shows "mem_val_w32 10 a s1 = mem_val_w32 10 a s2"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 using mem_val_alt_10_mem_equal a1 apply auto
         apply fastforce 
        apply fastforce
       apply fastforce
      apply fastforce
     apply fastforce
    apply fastforce
   apply fastforce
  apply fastforce
 by fastforce
 
 lemma mem_val_alt_8_mem_equal_0: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 8 (pa AND 68719476732) s1 = mem_val_alt 8 (pa AND 68719476732) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_mem_equal_1: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 8 ((pa AND 68719476732) + 1) s1 = mem_val_alt 8 ((pa AND 68719476732) + 1) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_mem_equal_2: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 8 ((pa AND 68719476732) + 2) s1 = mem_val_alt 8 ((pa AND 68719476732) + 2) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_mem_equal_3: "mem_equal s1 s2 pa \<Longrightarrow>
 mem_val_alt 8 ((pa AND 68719476732) + 3) s1 = mem_val_alt 8 ((pa AND 68719476732) + 3) s2"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_mem_equal: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 (pa AND 68719476732) s1 = mem_val_alt 8 (pa AND 68719476732) s2 \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 1) s1 = mem_val_alt 8 ((pa AND 68719476732) + 1) s2 \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 2) s1 = mem_val_alt 8 ((pa AND 68719476732) + 2) s2 \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 3) s1 = mem_val_alt 8 ((pa AND 68719476732) + 3) s2"
 using mem_val_alt_8_mem_equal_0 mem_val_alt_8_mem_equal_1
 mem_val_alt_8_mem_equal_2 mem_val_alt_8_mem_equal_3 a1
 by blast
 
 lemma mem_val_w32_8_mem_equal: 
 assumes a1: "mem_equal s1 s2 a"
 shows "mem_val_w32 8 a s1 = mem_val_w32 8 a s2"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 using mem_val_alt_8_mem_equal a1 apply auto
         apply fastforce 
        apply fastforce
       apply fastforce
      apply fastforce
     apply fastforce
    apply fastforce
   apply fastforce
  apply fastforce
 by fastforce
 
 lemma load_word_mem_10_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "load_word_mem s1 address 10 = load_word_mem s2 address 10"
 using a1 apply (simp add: low_equal_def load_word_mem_def)
 apply clarsimp
 apply (case_tac "virt_to_phys address (mmu s2) (mem s2) = None")
  apply auto
  apply (simp add: user_accessible_def)
  using mem_val_w32_10_mem_equal apply blast 
 apply (simp add: user_accessible_def)
 using mem_val_w32_10_mem_equal by blast 
 
 lemma load_word_mem_8_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "load_word_mem s1 address 8 = load_word_mem s2 address 8"
 using a1 apply (simp add: low_equal_def load_word_mem_def)
 apply clarsimp
 apply (case_tac "virt_to_phys address (mmu s2) (mem s2) = None")
  apply auto
  apply (simp add: user_accessible_def)
  using mem_val_w32_8_mem_equal user_accessible_8 apply fastforce
 apply (simp add: user_accessible_def)
 using mem_val_w32_8_mem_equal user_accessible_8 by fastforce
 
 lemma mem_read_low_equal: 
 assumes a1: "low_equal s1 s2 \<and> asi \<in> {8,10}"
 shows "fst (memory_read asi address s1) = fst (memory_read asi address s2)"
 proof (cases "asi = 8")
   case True
   then show ?thesis using a1 
   apply (simp add: low_equal_def)
   apply (simp add: memory_read_def)
   using a1 load_word_mem_8_low_equal apply auto
   apply (simp add: option.case_eq_if)
   by (simp add: option.case_eq_if)
 next
   case False
   then have "asi = 10" using a1 by auto
   then show ?thesis using a1
   apply (simp add: low_equal_def)
   apply (simp add: memory_read_def)
   using a1 load_word_mem_10_low_equal apply auto
   apply (simp add: option.case_eq_if)
   by (simp add: option.case_eq_if)
 qed 
 
 lemma read_mem_pc_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "fst (memory_read 8 (cpu_reg_val PC s1) s1) = 
 fst (memory_read 8 (cpu_reg_val PC s2) s2)"
 proof -
   have f2: "cpu_reg_val PC s1 = cpu_reg_val PC s2" using a1 
     by (simp add: low_equal_def cpu_reg_val_def)
   then show ?thesis using a1 f2 mem_read_low_equal
     by auto
 qed
 
 lemma dcache_mod_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = dcache_mod c v s1 \<and>
 t2 = dcache_mod c v s2"
 shows "low_equal t1 t2"
 using a1 apply (simp add: low_equal_def)
 apply (simp add: dcache_mod_def)
 apply auto
  apply (simp add: user_accessible_mod_cache mem_equal_mod_cache)
 by (simp add: user_accessible_mod_cache mem_equal_mod_cache)
 
 lemma add_data_cache_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = add_data_cache s1 address w bm \<and>
 t2 = add_data_cache s2 address w bm"
 shows "low_equal t1 t2"
 using a1 apply (simp add: add_data_cache_def)
 apply (case_tac "bm AND 8 >> 3 = 1")
  apply auto
  apply (case_tac "bm AND 4 >> 2 = 1")
   apply auto
   apply (case_tac "bm AND 2 >> Suc 0 = 1")
    apply auto
    apply (case_tac "bm AND 1 = 1")
     apply auto
     apply (meson dcache_mod_low_equal)
    apply (meson dcache_mod_low_equal)
   apply (case_tac "bm AND 1 = 1")
    apply auto
    apply (meson dcache_mod_low_equal)
   apply (meson dcache_mod_low_equal)
  apply (case_tac "bm AND 2 >> Suc 0 = 1")
   apply auto
   apply (case_tac "bm AND 1 = 1")
    apply auto
    apply (meson dcache_mod_low_equal)
   apply (meson dcache_mod_low_equal)
  apply (case_tac "bm AND 1 = 1")
   apply auto
   apply (meson dcache_mod_low_equal)
  apply (meson dcache_mod_low_equal)
 apply (case_tac "bm AND 4 >> 2 = 1")
  apply auto
  apply (case_tac "bm AND 2 >> Suc 0 = 1")
   apply auto
   apply (case_tac "bm AND 1 = 1")
    apply auto
    apply (meson dcache_mod_low_equal)
   apply (meson dcache_mod_low_equal)
  apply (case_tac "bm AND 1 = 1")
   apply auto
   apply (meson dcache_mod_low_equal)
  apply (meson dcache_mod_low_equal)
 apply (case_tac "bm AND 2 >> Suc 0 = 1")
  apply auto
  apply (case_tac "bm AND 1 = 1")
   apply auto
   apply (meson dcache_mod_low_equal)
  apply (meson dcache_mod_low_equal)
 by (meson dcache_mod_low_equal)
 
 lemma mem_read2_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (memory_read (10::word8) address s1) \<and>
 t2 = snd (memory_read (10::word8) address s2)"
 shows "low_equal t1 t2"
   using a1 apply (simp add: memory_read_def)
   using a1 apply (auto simp add: sys_reg_low_equal mod_2_eq_odd)
   using a1 apply (simp add: load_word_mem_10_low_equal)
   apply (auto split: option.splits)
   using add_data_cache_low_equal apply force
   using add_data_cache_low_equal apply force
   done
 
 lemma mem_read_delayed_write_low_equal:
 assumes a1: "low_equal s1 s2 \<and> get_delayed_pool s1 = [] \<and> get_delayed_pool s2 = []"
 shows "fst (memory_read 8 (cpu_reg_val PC (delayed_pool_write s1)) (delayed_pool_write s1)) =
 fst (memory_read 8 (cpu_reg_val PC (delayed_pool_write s2)) (delayed_pool_write s2))"
 using a1 apply (simp add: delayed_pool_write_def)
 apply (simp add: Let_def)
 apply (simp add: get_delayed_write_def)
 by (simp add: read_mem_pc_low_equal)
 
 lemma global_reg_mod_low_equal: 
 assumes a1: "low_equal s1 s2\<and>
 t1 = (global_reg_mod w n rd s1) \<and>
 t2 = (global_reg_mod w n rd s2)"
 shows "low_equal t1 t2"
 using a1 apply (induction n arbitrary: s1 s2)
  apply clarsimp
 apply auto
 apply (simp add: Let_def)
 apply (simp add: user_reg_low_equal)
 using user_reg_state_mod_low_equal by blast
 
 lemma out_reg_mod_low_equal: 
 assumes a1: "low_equal s1 s2\<and>
 t1 = (out_reg_mod w curr_win rd s1) \<and>
 t2 = (out_reg_mod w curr_win rd s2)"
 shows "low_equal t1 t2"
 using a1 apply (simp add: out_reg_mod_def Let_def)
 apply auto
  apply (simp add: user_reg_low_equal)
  using user_reg_state_mod_low_equal apply fastforce
 apply (simp add: user_reg_low_equal)
 using user_reg_state_mod_low_equal by blast
 
 lemma in_reg_mod_low_equal: 
 assumes a1: "low_equal s1 s2\<and>
 t1 = (in_reg_mod w curr_win rd s1) \<and>
 t2 = (in_reg_mod w curr_win rd s2)"
 shows "low_equal t1 t2"
 using a1 apply (simp add: in_reg_mod_def Let_def)
 apply auto
  apply (simp add: user_reg_low_equal)
  using user_reg_state_mod_low_equal apply fastforce
 apply (simp add: user_reg_low_equal)
 using user_reg_state_mod_low_equal by blast
 
 lemma user_reg_mod_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = user_reg_mod w curr_win rd s1 \<and> t2 = user_reg_mod w curr_win rd s2"
 shows "low_equal t1 t2"
 proof (cases "rd = 0")
   case True
   then show ?thesis using a1
   by (simp add: user_reg_mod_def)
 next
   case False
   then have f1: "rd \<noteq> 0" by auto
   then show ?thesis 
   proof (cases "0 < rd \<and> rd < 8")
     case True
     then show ?thesis using a1 f1
     apply (simp add: user_reg_mod_def)
     using global_reg_mod_low_equal by blast    
   next
     case False
     then have f2: "\<not> (0 < rd \<and> rd < 8)" by auto
     then show ?thesis  
     proof (cases "7 < rd \<and> rd < 16")
       case True
       then show ?thesis using a1 f1 f2
       apply (simp add: user_reg_mod_def)
       by (auto intro: out_reg_mod_low_equal)
     next
       case False
       then have f3: "\<not> (7 < rd \<and> rd < 16)" by auto      
       then show ?thesis 
       proof (cases "15 < rd \<and> rd < 24")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: user_reg_mod_def)
         apply (simp add: low_equal_def)
         apply clarsimp
         by (simp add: user_accessible_mod_user_reg mem_equal_mod_user_reg)     
       next
         case False
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: user_reg_mod_def)
         by (auto intro: in_reg_mod_low_equal)
       qed
     qed
   qed
 qed
 
 lemma virt_to_phys_low_equal: "low_equal s1 s2 \<Longrightarrow>
 virt_to_phys addr (mmu s1) (mem s1) = virt_to_phys addr (mmu s2) (mem s2)"
 by (auto simp add: low_equal_def)
 
 lemma write_reg_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = (snd (fst (write_reg w curr_win rd s1))) \<and>
 t2 = (snd (fst (write_reg w curr_win rd s2)))"
 shows "low_equal t1 t2"
 using a1 apply (simp add: write_reg_def)
 apply (simp add: simpler_modify_def)
 by (auto intro: user_reg_mod_low_equal)
 
 lemma write_cpu_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (write_cpu w cr s1)) \<and>
 t2 = (snd (fst (write_cpu w cr s2)))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: write_cpu_def simpler_modify_def)
 apply (simp add: cpu_reg_mod_def)
 apply (simp add: low_equal_def)
 using user_accessible_mod_cpu_reg mem_equal_mod_cpu_reg
 by metis
 
 lemma cpu_reg_mod_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = cpu_reg_mod w cr s1 \<and>
 t2 = cpu_reg_mod w cr s2"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: cpu_reg_mod_def)
 apply (simp add: low_equal_def)
 using user_accessible_mod_cpu_reg mem_equal_mod_cpu_reg
 by metis
 
 lemma load_sub2_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = (snd (fst (load_sub2 address 10 rd curr_win w s1))) \<and>
 t2 = (snd (fst (load_sub2 address 10 rd curr_win w s2)))"
 shows "low_equal t1 t2"
 proof (cases "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) = None")
   case True
   then have f0: "fst (memory_read 10 (address + 4) 
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) = None" by auto
   have f1: "low_equal (snd (fst (write_reg w curr_win (rd AND 30) s1)))
           (snd (fst (write_reg w curr_win (rd AND 30) s2)))"
     using a1 by (auto intro: write_reg_low_equal)
   then have "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) = None \<and>
         fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) =
         fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s2))))"
     using f0 by (blast intro: mem_read_low_equal)
   then have "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) = None \<and>
         fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s2)))) = None"
     by auto
   then show ?thesis using a1
   apply (simp add: load_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   using f1 apply (simp add: traps_low_equal)
   using f1 by (auto intro: mod_trap_low_equal)
 next
   case False
   then have f2: "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) \<noteq> None"
     by auto
   have f3: "low_equal (snd (fst (write_reg w curr_win (rd AND 30) s1)))
           (snd (fst (write_reg w curr_win (rd AND 30) s2)))"
     using a1 by (auto intro: write_reg_low_equal)
   then have f4: "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) =
         fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s2))))"
     using f2 by (blast intro: mem_read_low_equal)
   then have "fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s1)))) \<noteq> None \<and>
         fst (memory_read 10 (address + 4)
         (snd (fst (write_reg w curr_win (rd AND 30) s2)))) \<noteq> None"
     using f2 by auto
   then show ?thesis using a1
   apply (simp add: load_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply clarsimp
   apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
   using f4 apply clarsimp
   using f3 by (auto intro: mem_read2_low_equal write_reg_low_equal)
 qed
 
 lemma load_sub3_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (load_sub3 instr curr_win rd (10::word8) address s1)) \<and>
 t2 = snd (fst (load_sub3 instr curr_win rd (10::word8) address s2))"
 shows "low_equal t1 t2"
 proof (cases "fst (memory_read 10 address s1) = None")
   case True
   then have "fst (memory_read 10 address s1) = None \<and>
     fst (memory_read 10 address s2) = None"
     using a1 by (auto simp add: mem_read_low_equal)
   then show ?thesis using a1
   apply (simp add: load_sub3_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   apply (auto simp add: traps_low_equal)
   by (auto intro: mod_trap_low_equal)
 next
   case False
   then have f1: "fst (memory_read 10 address s1) \<noteq> None \<and> 
     fst (memory_read 10 address s2) \<noteq> None"
     using a1 by (auto simp add: mem_read_low_equal)  
   then show ?thesis 
   proof (cases "rd \<noteq> 0 \<and>
                           (fst instr = load_store_type LD \<or>
                            fst instr = load_store_type LDA \<or>
                            fst instr = load_store_type LDUH \<or>
                            fst instr = load_store_type LDSB \<or>
                            fst instr = load_store_type LDUB \<or>
                            fst instr = load_store_type LDUBA \<or>
                            fst instr = load_store_type LDSH \<or>
                            fst instr = load_store_type LDSHA \<or>
                            fst instr = load_store_type LDUHA \<or>
                            fst instr = load_store_type LDSBA)")
     case True
     then show ?thesis using a1 f1
     apply (simp add: load_sub3_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: case_prod_unfold)
     apply clarsimp
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     apply (simp add: mem_read_low_equal)
     by (meson mem_read2_low_equal write_reg_low_equal)
   next
     case False
     then show ?thesis using a1 f1
     apply (simp add: load_sub3_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: case_prod_unfold)
     apply clarsimp
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     apply (simp add: mem_read_low_equal)
     by (meson load_sub2_low_equal mem_read2_low_equal)
   qed
 qed
 
 lemma ld_asi_user:
 "(fst instr = load_store_type LDSB \<or>
 fst instr = load_store_type LDUB \<or>
 fst instr = load_store_type LDUH \<or> 
 fst instr = load_store_type LD \<or> 
 fst instr = load_store_type LDD) \<Longrightarrow> 
 ld_asi instr 0 = 10"
 apply (simp add: ld_asi_def)
 by auto
 
 lemma load_sub1_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 (fst instr = load_store_type LDSB \<or>
 fst instr = load_store_type LDUB \<or>
 fst instr = load_store_type LDUH \<or>
 fst instr = load_store_type LD \<or> 
 fst instr = load_store_type LDD) \<and>
 t1 = snd (fst (load_sub1 instr rd 0 s1)) \<and> 
 t2 = snd (fst (load_sub1 instr rd 0 s2))" 
 shows "low_equal t1 t2"
 proof (cases "(fst instr = load_store_type LDD \<or> fst instr = load_store_type LDDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0 \<or>
                        (fst instr = load_store_type LD \<or> fst instr = load_store_type LDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0 \<or>
                        (fst instr = load_store_type LDUH \<or>
                         fst instr = load_store_type LDUHA \<or>
                         fst instr = load_store_type LDSH \<or> fst instr = load_store_type LDSHA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0")
   case True
   then have "((fst instr = load_store_type LDD \<or> fst instr = load_store_type LDDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0 \<or>
                        (fst instr = load_store_type LD \<or> fst instr = load_store_type LDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0 \<or>
                        (fst instr = load_store_type LDUH \<or>
                         fst instr = load_store_type LDUHA \<or>
                         fst instr = load_store_type LDSH \<or> fst instr = load_store_type LDSHA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0) \<and>
             ((fst instr = load_store_type LDD \<or> fst instr = load_store_type LDDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<noteq> 0 \<or>
                        (fst instr = load_store_type LD \<or> fst instr = load_store_type LDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<noteq> 0 \<or>
                        (fst instr = load_store_type LDUH \<or>
                         fst instr = load_store_type LDUHA \<or>
                         fst instr = load_store_type LDSH \<or> fst instr = load_store_type LDSHA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word1) \<noteq> 0)"
     by (metis (mono_tags, lifting) assms get_addr_low_equal)    
   then show ?thesis using a1
   apply (simp add: load_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   apply clarsimp
   apply (simp add: get_curr_win3_low_equal)
   by (auto intro: get_curr_win2_low_equal mod_trap_low_equal)
 next
   case False
   then have f1: "\<not> ((fst instr = load_store_type LDD \<or> fst instr = load_store_type LDDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0 \<or>
                        (fst instr = load_store_type LD \<or> fst instr = load_store_type LDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0 \<or>
                        (fst instr = load_store_type LDUH \<or>
                         fst instr = load_store_type LDUHA \<or>
                         fst instr = load_store_type LDSH \<or> fst instr = load_store_type LDSHA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0) \<and>
             \<not> ((fst instr = load_store_type LDD \<or> fst instr = load_store_type LDDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<noteq> 0 \<or>
                        (fst instr = load_store_type LD \<or> fst instr = load_store_type LDA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<noteq> 0 \<or>
                        (fst instr = load_store_type LDUH \<or>
                         fst instr = load_store_type LDUHA \<or>
                         fst instr = load_store_type LDSH \<or> fst instr = load_store_type LDSHA) \<and>
                        ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word1) \<noteq> 0)"
     by (metis assms get_addr_low_equal)    
   show ?thesis  
   proof -
     have "low_equal s1 s2 \<Longrightarrow> 
           low_equal (snd (fst (get_curr_win () s1))) 
                     (snd (fst (get_curr_win () s2)))"
       using get_curr_win2_low_equal by auto
     then have f2: "low_equal s1 s2 \<Longrightarrow>
       low_equal (snd (fst (load_sub3 instr (fst (fst (get_curr_win () s2))) rd 10
                     (get_addr (snd instr) (snd (fst (get_curr_win () s2))))
                     (snd (fst (get_curr_win () s1)))))) 
                 (snd (fst (load_sub3 instr (fst (fst (get_curr_win () s2))) rd 10
                     (get_addr (snd instr) (snd (fst (get_curr_win () s2))))
                     (snd (fst (get_curr_win () s2))))))"
       using load_sub3_low_equal by blast 
     show ?thesis using a1
     unfolding load_sub1_def simpler_gets_def bind_def h1_def h2_def Let_def case_prod_unfold
     using f1 f2 apply clarsimp
     by (simp add: get_addr2_low_equal get_curr_win_low_equal ld_asi_user)
   qed
 qed
 
 lemma load_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 (fst instr = load_store_type LDSB \<or>
 fst instr = load_store_type LDUB \<or>
 fst instr = load_store_type LDUBA \<or>
 fst instr = load_store_type LDUH \<or>
 fst instr = load_store_type LD \<or> 
 fst instr = load_store_type LDA \<or> 
 fst instr = load_store_type LDD) \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 t1 = snd (fst (load_instr instr s1)) \<and> t2 = snd (fst (load_instr instr s2))"
 shows "low_equal t1 t2"
 proof -
   have "get_S (cpu_reg_val PSR s1) = 0 \<and> get_S (cpu_reg_val PSR s2) = 0"
     using a1 by (simp add: ucast_id) 
   then show ?thesis using a1
   apply (simp add: load_instr_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: Let_def)
   apply clarsimp
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   apply (simp add: traps_low_equal)
   by (auto intro: mod_trap_low_equal load_sub1_low_equal)
 qed
 
 lemma st_data0_low_equal: "low_equal s1 s2 \<Longrightarrow>
 st_data0 instr curr_win rd addr s1 = st_data0 instr curr_win rd addr s2"
 apply (simp add: st_data0_def)
 by (simp add: user_reg_val_def low_equal_def)
 
 lemma store_word_mem_low_equal_none: "low_equal s1 s2 \<Longrightarrow>
 store_word_mem (add_data_cache s1 addr data bm) addr data bm 10 = None \<Longrightarrow>
 store_word_mem (add_data_cache s2 addr data bm) addr data bm 10 = None"
 apply (simp add: store_word_mem_def)
 proof -
   assume a1: "low_equal s1 s2"
   assume a2: "(case virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) of None \<Rightarrow> None | Some pair \<Rightarrow> if mmu_writable (get_acc_flag (snd pair)) 10 then Some (mem_mod_w32 10 (fst pair) bm data (add_data_cache s1 addr data bm)) else None) = None"
   have f3: "(if mmu_writable (get_acc_flag (snd (v1_2 (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (v1_2 (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s2 addr data bm)) else None) = (case Some (v1_2 (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) of None \<Rightarrow> if mmu_writable (get_acc_flag (snd (v1_2 (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (v1_2 (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None)"
     by auto
   obtain pp :: "(word36 \<times> word8) option \<Rightarrow> word36 \<times> word8" where
     f4: "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = None \<or> virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = Some (pp (virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm))))"
     by (metis (no_types) option.exhaust)
   have f5: "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))"
     using a1 by (meson add_data_cache_low_equal virt_to_phys_low_equal)
   { assume "Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) \<noteq> (case Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s1 addr data bm)) else None)"
     then have "None = (if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s2 addr data bm)) else None)"
       by fastforce
     moreover
     { assume "(if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s2 addr data bm)) else None) \<noteq> (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None)"
       then have "(case Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) of None \<Rightarrow> if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) \<noteq> (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None)"
         using f3 by simp
       then have "Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<noteq> virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) \<or> (if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None) \<noteq> None"
       proof -
         have "(case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) = (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) \<or> Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<noteq> virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) \<or> (if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None) \<noteq> None"
           by simp
         then show ?thesis
           using \<open>(case Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) of None \<Rightarrow> if mmu_writable (get_acc_flag (snd (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))))) 10 then Some (mem_mod_w32 10 (fst (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))))) bm data (add_data_cache s1 addr data bm)) else None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) \<noteq> (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None)\<close> by force
       qed
       moreover
       { assume "Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<noteq> virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm))"
         then have "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) \<noteq> Some (pp (virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm))))"
           using f5 by simp }
       ultimately have "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) \<noteq> Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<or> virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) \<noteq> Some (pp (virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm))))"
         using a2 by force }
     ultimately have "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = Some (pp (virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)))) \<and> virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<longrightarrow> (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) = None"
       by fastforce }
   then have "virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = Some (pp (virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)))) \<and> virt_to_phys addr (mmu (add_data_cache s1 addr data bm)) (mem (add_data_cache s1 addr data bm)) = Some (pp (virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)))) \<longrightarrow> (case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) = None"
     using a2 by force
   then show "(case virt_to_phys addr (mmu (add_data_cache s2 addr data bm)) (mem (add_data_cache s2 addr data bm)) of None \<Rightarrow> None | Some p \<Rightarrow> if mmu_writable (get_acc_flag (snd p)) 10 then Some (mem_mod_w32 10 (fst p) bm data (add_data_cache s2 addr data bm)) else None) = None"
     using f5 f4 by force
 qed
 
 lemma memory_write_asi_low_equal_none: "low_equal s1 s2 \<Longrightarrow>
 memory_write_asi 10 addr bm data s1 = None \<Longrightarrow>
 memory_write_asi 10 addr bm data s2 = None"
 apply (simp add: memory_write_asi_def)
 by (simp add: store_word_mem_low_equal_none)
 
 lemma memory_write_low_equal_none: "low_equal s1 s2 \<Longrightarrow>
 memory_write 10 addr bm data s1 = None \<Longrightarrow>
 memory_write 10 addr bm data s2 = None"
 apply (simp add: memory_write_def)
 by (metis map_option_case memory_write_asi_low_equal_none option.map_disc_iff)
 
 lemma memory_write_low_equal_none2: "low_equal s1 s2 \<Longrightarrow>
 memory_write 10 addr bm data s2 = None \<Longrightarrow>
 memory_write 10 addr bm data s1 = None"
 apply (simp add: memory_write_def)
 by (metis low_equal_com memory_write_def memory_write_low_equal_none)
 
 lemma mem_context_val_9_unchanged:
 "mem_context_val 9 addr1 (mem s1) =
 mem_context_val 9 addr1
               ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))"
 apply (simp add: mem_context_val_def)
 by (simp add: Let_def)
 
 lemma mem_context_val_w32_9_unchanged:
 "mem_context_val_w32 9 addr1 (mem s1) =
 mem_context_val_w32 9 addr1
               ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))"
 apply (simp add: mem_context_val_w32_def)
 apply (simp add: Let_def)
 by (metis mem_context_val_9_unchanged)
 
 lemma ptd_lookup_unchanged_4: 
 "ptd_lookup va ptp (mem s1) 4 = 
 ptd_lookup va ptp ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                             11 := (mem s1 11)(addr := None))) 4"
 by auto
 
 lemma ptd_lookup_unchanged_3: 
 "ptd_lookup va ptp (mem s1) 3 = 
 ptd_lookup va ptp ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                             11 := (mem s1 11)(addr := None))) 3"
 proof (cases "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) (mem s1) = None")
   case True
   then have "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) (mem s1) = None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36)
            ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = None"
     using mem_context_val_w32_9_unchanged by metis    
   then show ?thesis 
   by auto  
 next
   case False
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None"
     using mem_context_val_w32_9_unchanged by metis
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None \<and>
     (\<forall>y. (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) (mem s1) = Some y) \<longrightarrow> 
     (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 12))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))= Some y))"
     using mem_context_val_w32_9_unchanged by metis
   then show ?thesis 
   apply auto
   by (simp add: Let_def)
 qed
 
 lemma ptd_lookup_unchanged_2: 
 "ptd_lookup va ptp (mem s1) 2 = 
 ptd_lookup va ptp ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                             11 := (mem s1 11)(addr := None))) 2"
 proof (cases "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) (mem s1) = None")
   case True
   then have "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) (mem s1) = None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36)
            ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = None"
     using mem_context_val_w32_9_unchanged by metis    
   then show ?thesis 
   by auto  
 next
   case False
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None"
     using mem_context_val_w32_9_unchanged by metis
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None \<and>
     (\<forall>y. (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) (mem s1) = Some y) \<longrightarrow> 
     (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 18))::word6))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))= Some y))"
     using mem_context_val_w32_9_unchanged by metis
   then show ?thesis 
   apply auto
   using ptd_lookup_unchanged_3   
   unfolding Let_def
   by auto
 qed
 
 lemma ptd_lookup_unchanged_1: 
 "ptd_lookup va ptp (mem s1) 1 = 
 ptd_lookup va ptp ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                             11 := (mem s1 11)(addr := None))) 1"
 proof (cases "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) (mem s1) = None")
   case True
   then have "mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) (mem s1) = None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36)
            ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = None"
     using mem_context_val_w32_9_unchanged by metis    
   then show ?thesis 
   by auto  
 next
   case False
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None"
     using mem_context_val_w32_9_unchanged by metis
   then have "mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) (mem s1) \<noteq> None \<and>
     mem_context_val_w32 9 ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None \<and>
     (\<forall>y. (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) (mem s1) = Some y) \<longrightarrow> 
     (mem_context_val_w32 9 
     ((ucast (ptp OR ((ucast ((ucast (va >> 24))::word8))::word32)))::word36) 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))= Some y))"
     using mem_context_val_w32_9_unchanged by metis
   then show ?thesis 
   apply auto
   using ptd_lookup_unchanged_2   
   unfolding Let_def
   proof -
     fix y :: word32
     have "(y AND 3 \<noteq> 0 \<or> y AND 3 = 0 \<or> (y AND 3 \<noteq> 1 \<or> ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) = None) \<and> (y AND 3 = 1 \<or> y AND 3 \<noteq> 2 \<or> None = Some ((ucast (ucast (y >> 8)::word24) << 12) OR (ucast (ucast va::word12)::word36), ucast y::word8))) \<and> (y AND 3 = 0 \<or> (y AND 3 \<noteq> 1 \<or> (y AND 3 \<noteq> 0 \<or> ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) = None) \<and> (y AND 3 = 0 \<or> (y AND 3 \<noteq> 1 \<or> ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) = ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1)) \<and> (y AND 3 = 1 \<or> (y AND 3 \<noteq> 2 \<or> ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) = Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y)) \<and> (y AND 3 = 2 \<or> ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) = None)))) \<and> (y AND 3 = 1 \<or> (y AND 3 \<noteq> 2 \<or> (y AND 3 \<noteq> 0 \<or> None = Some ((ucast (ucast (y >> 8)::word24) << 12) OR (ucast (ucast va::word12)::word36), ucast y::word8)) \<and> (y AND 3 = 0 \<or> (y AND 3 \<noteq> 1 \<or> ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) = Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y)) \<and> (y AND 3 = 1 \<or> y AND 3 = 2 \<or> None = Some ((ucast (ucast (y >> 8)::word24) << 12) OR (ucast (ucast va::word12)::word36), ucast y::word8)))) \<and> (y AND 3 = 2 \<or> y AND 3 = 0 \<or> (y AND 3 \<noteq> 1 \<or> ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) = None) \<and> (y AND 3 = 1 \<or> y AND 3 \<noteq> 2 \<or> None = Some ((ucast (ucast (y >> 8)::word24) << 12) OR (ucast (ucast va::word12)::word36), ucast y::word8))))) \<or> (\<forall>w. mem s1 w = ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) w)"
       by (metis (no_types) One_nat_def Suc_1 Suc_eq_plus1 ptd_lookup_unchanged_2)
     then show "(if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) = (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None)"
     proof -
       have f1: "2 = Suc 0 + 1"
         by (metis One_nat_def Suc_1 Suc_eq_plus1)
       { assume "y AND 3 = 1"
         moreover
         { assume "y AND 3 = 1 \<and> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) \<noteq> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None)"
           have "y AND 3 = 1 \<and> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) \<noteq> ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) \<or> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) = (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None)"
             by presburger
           moreover
           { assume "y AND 3 = 1 \<and> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) \<noteq> ptd_lookup va (y AND 4294967292) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) (Suc 0 + 1)"
             then have "y AND 3 = 1 \<and> (if y AND 3 = 0 then None else if y AND 3 = 1 then ptd_lookup va (y AND 4294967292) (mem s1) (Suc 0 + 1) else if y AND 3 = 2 then Some ((ucast (ucast (y >> 8)::word24) << 12) OR ucast (ucast va::word12), ucast y) else None) \<noteq> ptd_lookup va (y AND 4294967292) (mem s1) 2"
               by (metis One_nat_def Suc_1 Suc_eq_plus1 ptd_lookup_unchanged_2)
             then have ?thesis
               using f1 by auto }
           ultimately have ?thesis
             by blast }
         ultimately have ?thesis
           by blast }
       then show ?thesis
         by presburger
     qed  
   qed
 qed
 
 lemma virt_to_phys_unchanged_sub1: 
 assumes a1: "(let context_table_entry = (v1 >> 11 << 11) OR (v2 AND 511 << 2)
   in Let (mem_context_val_w32 (word_of_int 9) (ucast context_table_entry) (mem s1))
     (case_option None (\<lambda>lvl1_page_table. ptd_lookup va lvl1_page_table (mem s1) 1))) =
  (let context_table_entry = (v1 >> 11 << 11) OR (v2 AND 511 << 2)
   in Let (mem_context_val_w32 (word_of_int 9) (ucast context_table_entry) (mem s2))
     (case_option None (\<lambda>lvl1_page_table. ptd_lookup va lvl1_page_table (mem s2) 1)))"
 shows "(let context_table_entry = (v1 >> 11 << 11) OR (v2 AND 511 << 2)
   in Let (mem_context_val_w32 (word_of_int 9) (ucast context_table_entry)
     ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))))
      (case_option None (\<lambda>lvl1_page_table. ptd_lookup va lvl1_page_table
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1))) =
  (let context_table_entry = (v1 >> 11 << 11) OR (v2 AND 511 << 2)
   in Let (mem_context_val_w32 (word_of_int 9) (ucast context_table_entry)
     ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))))
      (case_option None (\<lambda>lvl1_page_table. ptd_lookup va lvl1_page_table
       ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) 1)))"
 proof -
   from a1 have 
    "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s1) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s1) 1) =
     (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1)" 
      unfolding Let_def by auto
   then have "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) 
      ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s1) 1) =
     (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) 
      ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1)"
     using mem_context_val_w32_9_unchanged
     by (metis word_numeral_alt) 
  then have "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) 
      ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table 
       ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1) =
     (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) 
      ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of
      None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table 
      ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) 1)"   
     using ptd_lookup_unchanged_1
     proof -
       obtain ww :: "word32 option \<Rightarrow> word32" where
         f1: "\<forall>z. (z = None \<or> z = Some (ww z)) \<and> (z \<noteq> None \<or> (\<forall>w. z \<noteq> Some w))"
         by moura
       then have f2: "(mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = None \<or> mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = Some (ww (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None)))))) \<and> (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None \<or> (\<forall>w. mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> Some w))"
         by blast
       then have f3: "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1) \<noteq> None \<longrightarrow> (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1) = (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w (mem s1) 1)"
         by (metis (no_types) \<open>\<And>val va s1 ptp addr. ptd_lookup va ptp (mem s1) 1 = ptd_lookup va ptp ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1\<close> option.case(2) option.simps(4))
       have f4: "mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) = Some (ww (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))))) \<and> mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) = Some (ww (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))))) \<longrightarrow> (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1) = (case Some (ww (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) 1)"
         by (metis (no_types) \<open>(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s1) 1) = (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1)\<close> \<open>\<And>val va s1 ptp addr. ptd_lookup va ptp (mem s1) 1 = ptd_lookup va ptp ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1\<close> option.case(2))
       have f5: "(mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) = None \<or> mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) = Some (ww (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None)))))) \<and> (mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) \<noteq> None \<or> (\<forall>w. mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) \<noteq> Some w))"
         using f1 by blast
       { assume "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1) \<noteq> (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) 1)"
         { assume "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w (mem s2) 1) \<noteq> None \<and> (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w (mem s2) 1) \<noteq> None"
           then have "(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some w \<Rightarrow> ptd_lookup va w (mem s2) 1) \<noteq> None \<and> mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) \<noteq> None"
             by (metis (no_types) \<open>(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s1) 1) = (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1)\<close> option.simps(4))
           then have ?thesis
             using f5 f4 f2 by force }
         then have ?thesis
           using f5 f3 by (metis (no_types) \<open>(case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s1) 1) = (case mem_context_val_w32 (word_of_int 9) (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2) (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1)\<close> \<open>\<And>val va s1 ptp addr. ptd_lookup va ptp (mem s1) 1 = ptd_lookup va ptp ((mem s1) (10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) 1\<close> option.case(2) option.simps(4)) }
       then show ?thesis
         by blast
     qed
  then show ?thesis 
   unfolding Let_def by auto 
 qed
 
 lemma virt_to_phys_unchanged: 
 assumes a1: "(\<forall>va. virt_to_phys va (mmu s2) (mem s1) = virt_to_phys va (mmu s2) (mem s2))"
 shows "(\<forall>va. virt_to_phys va (mmu s2) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                          11 := (mem s1 11)(addr := None))) =
              virt_to_phys va (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                          11 := (mem s2 11)(addr := None))))"
 proof (cases "registers (mmu s2) CR AND 1 \<noteq> 0")
   case True
   then have f1: "registers (mmu s2) CR AND 1 \<noteq> 0" by auto
   then show ?thesis 
   proof (cases "mmu_reg_val (mmu s2) 256 = None")
     case True
     then show ?thesis 
     by (simp add: virt_to_phys_def)
   next
     case False
     then have f2: "mmu_reg_val (mmu s2) 256 \<noteq> None" by auto
     then show ?thesis 
     proof (cases "mmu_reg_val (mmu s2) 512 = None")
       case True
       then show ?thesis using f1 f2
       apply (simp add: virt_to_phys_def)
       by auto
     next
       case False
       then show ?thesis using f1 f2 a1
       apply (simp add: virt_to_phys_def)
       apply clarify
       using virt_to_phys_unchanged_sub1 by fastforce
     qed
   qed
 next
   case False
   then show ?thesis 
   by (simp add: virt_to_phys_def)
 qed
 
 lemma virt_to_phys_unchanged2_sub1: 
 "(case mem_context_val_w32 (word_of_int 9) 
   (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) of
   None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table (mem s2) 1) =
 (case mem_context_val_w32 (word_of_int 9) 
   (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2)
     (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) of
   None \<Rightarrow> None | Some lvl1_page_table \<Rightarrow> ptd_lookup va lvl1_page_table ((mem s2)
     (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) 1)"
 proof (cases "mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) = None")
   case True
   then have "mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) = None \<and>
     mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2)
     (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) = None"
     using mem_context_val_w32_9_unchanged by metis
   then show ?thesis 
   by auto
 next
   case False
   then have "mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) \<noteq> None \<and> 
     (\<forall>y. mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) (mem s2) = Some y \<longrightarrow>
          mem_context_val_w32 9 (ucast ((v1 >> 11 << 11) OR (v2 AND 511 << 2))) ((mem s2)
          (10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))) = Some y)"
     using mem_context_val_w32_9_unchanged by metis 
   then show ?thesis
   using ptd_lookup_unchanged_1 by fastforce 
 qed
 
 lemma virt_to_phys_unchanged2: 
 "virt_to_phys va (mmu s2) (mem s2) =
 virt_to_phys va (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                          11 := (mem s2 11)(addr := None)))"
 proof (cases "registers (mmu s2) CR AND 1 \<noteq> 0")
   case True
   then have f1: "registers (mmu s2) CR AND 1 \<noteq> 0" by auto
   then show ?thesis 
   proof (cases "mmu_reg_val (mmu s2) 256 = None")
     case True
     then show ?thesis 
     by (simp add: virt_to_phys_def)
   next
     case False
     then have f2: "mmu_reg_val (mmu s2) 256 \<noteq> None" by auto
     then show ?thesis 
     proof (cases "mmu_reg_val (mmu s2) 512 = None")
       case True
       then show ?thesis using f1 f2
       apply (simp add: virt_to_phys_def)
       by auto
     next
       case False
       then show ?thesis 
       using f1 f2
       apply (simp add: virt_to_phys_def)
       apply clarify
       unfolding Let_def
       using virt_to_phys_unchanged2_sub1
       by auto      
     qed
   qed
 next
   case False
   then show ?thesis 
   by (simp add: virt_to_phys_def)
 qed
 
 lemma virt_to_phys_unchanged_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "(\<forall>va. virt_to_phys va (mmu s2) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                          11 := (mem s1 11)(addr := None))) =
              virt_to_phys va (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                          11 := (mem s2 11)(addr := None))))"
 using a1 apply (simp add: low_equal_def)
 using virt_to_phys_unchanged
 by metis 
 
 lemma mmu_low_equal: "low_equal s1 s2 \<Longrightarrow> mmu s1 = mmu s2"
 by (simp add: low_equal_def)
 
 lemma mem_val_alt_8_unchanged0: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 (pa AND 68719476732) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 (pa AND 68719476732) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_unchanged1: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 ((pa AND 68719476732) + 1) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 1) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_unchanged2: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 ((pa AND 68719476732) + 2) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 2) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_unchanged3: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 ((pa AND 68719476732) + 3) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 3) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_8_unchanged: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 8 (pa AND 68719476732) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 (pa AND 68719476732) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 1) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 1) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 2) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 2) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 8 ((pa AND 68719476732) + 3) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 8 ((pa AND 68719476732) + 3) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 using a1 mem_val_alt_8_unchanged0 mem_val_alt_8_unchanged1
 mem_val_alt_8_unchanged2 mem_val_alt_8_unchanged3
 by blast
 
 lemma mem_val_w32_8_unchanged: 
 assumes a1: "mem_equal s1 s2 a"
 shows "mem_val_w32 8 a (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) =
 mem_val_w32 8 a (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 using mem_val_alt_8_unchanged a1 apply auto
         apply fastforce
        apply fastforce
       apply fastforce
      apply fastforce
     apply fastforce
    apply fastforce
   apply fastforce
  apply fastforce
 by fastforce
 
 lemma load_word_mem_8_unchanged: 
 assumes a1: "low_equal s1 s2 \<and> 
 load_word_mem s1 addra 8 = load_word_mem s2 addra 8"
 shows "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                          11 := (mem s1 11)(addr := None))\<rparr>) addra 8 =
        load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                          11 := (mem s2 11)(addr := None))\<rparr>) addra 8"
 proof (cases "virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = None")
   case True
   then have "virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = None \<and>
              virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = None"
     using a1 apply (auto simp add: mmu_low_equal)
     using a1 virt_to_phys_unchanged_low_equal by metis
   then show ?thesis
   by (simp add: load_word_mem_def)
 next
   case False
   then have "\<exists>p. virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = Some p \<and>
              virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = Some p"
     using a1 apply (auto simp add: mmu_low_equal)
     using a1 virt_to_phys_unchanged_low_equal by metis
   then have "\<exists>p. virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = Some p \<and>
             virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = Some p \<and> 
             virt_to_phys addra (mmu s1) (mem s1) = Some p \<and>
             virt_to_phys addra (mmu s2) (mem s2) = Some p"
     using virt_to_phys_unchanged2 by metis
   then show ?thesis using a1  
   apply (simp add: load_word_mem_def)
   apply auto
   apply (simp add: low_equal_def)
   apply (simp add: user_accessible_def)
   using mem_val_w32_8_unchanged a1 user_accessible_8
   by (metis snd_conv)
 qed
 
 lemma load_word_mem_select_8: 
 assumes a1: "fst (case load_word_mem s1 addra 8 of None \<Rightarrow> (None, s1)
   | Some w \<Rightarrow> (Some w, add_instr_cache s1 addra w 15)) =
 fst (case load_word_mem s2 addra 8 of None \<Rightarrow> (None, s2)
   | Some w \<Rightarrow> (Some w, add_instr_cache s2 addra w 15))"
 shows "load_word_mem s1 addra 8 = load_word_mem s2 addra 8"
 using a1
 by (metis (mono_tags, lifting) fst_conv not_None_eq option.simps(4) option.simps(5))
 
 lemma memory_read_8_unchanged: 
 assumes a1: "low_equal s1 s2 \<and>
 fst (memory_read 8 addra s1) = fst (memory_read 8 addra s2)"
 shows "fst (memory_read 8 addra
                    (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                        11 := (mem s1 11)(addr := None))\<rparr>)) =
          fst (memory_read 8 addra
                    (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                        11 := (mem s2 11)(addr := None))\<rparr>))"
 proof (cases "sys_reg s1 CCR AND 1 = 0")
   case True
   then have "sys_reg s1 CCR AND 1 = 0 \<and> sys_reg s2 CCR AND 1 = 0"
     using a1 sys_reg_low_equal by fastforce
   then show ?thesis using a1
   apply (simp add: memory_read_def)
   using load_word_mem_8_unchanged by blast
 next
   case False
   then have f1: "sys_reg s1 CCR AND 1 \<noteq> 0 \<and> sys_reg s2 CCR AND 1 \<noteq> 0"
     using a1 sys_reg_low_equal by fastforce
   then show ?thesis using a1
   proof (cases "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 8 = None")
     case True
     then have "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 8 = None \<and> 
       load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
       11 := (mem s2 11)(addr := None))\<rparr>) addra 8 = None"
       using a1 f1  
       apply (simp add: memory_read_def)
       apply clarsimp
       using load_word_mem_select_8 load_word_mem_8_unchanged
       by fastforce      
     then show ?thesis
     by (simp add: memory_read_def)
   next
     case False
     then have "\<exists>y. load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 8 = Some y" by auto
     then have "\<exists>y. load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 8 = Some y \<and> 
                    load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
       11 := (mem s2 11)(addr := None))\<rparr>) addra 8 = Some y"
       using a1 f1
       apply (simp add: memory_read_def)
       apply clarsimp
       using load_word_mem_select_8 load_word_mem_8_unchanged by fastforce
     then show ?thesis using a1 f1
     apply (simp add: memory_read_def)
     by auto
   qed
 qed
 
 lemma mem_val_alt_mod: 
 assumes a1: "addr1 \<noteq> addr2"
 shows "mem_val_alt 10 addr1 s = 
 mem_val_alt 10 addr1 (s\<lparr>mem := (mem s)(10 := mem s 10(addr2 \<mapsto> val), 
   11 := (mem s 11)(addr2 := None))\<rparr>)"
 using a1 apply (simp add: mem_val_alt_def)
 by (simp add: Let_def)
 
 lemma mem_val_alt_mod2: 
 "mem_val_alt 10 addr (s\<lparr>mem := (mem s)(10 := mem s 10(addr \<mapsto> val), 
   11 := (mem s 11)(addr := None))\<rparr>) = Some val"
 by (simp add: mem_val_alt_def)
 
 lemma mem_val_alt_10_unchanged0: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 (pa AND 68719476732) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 (pa AND 68719476732) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_unchanged1: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 ((pa AND 68719476732) + 1) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 1) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_unchanged2: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 ((pa AND 68719476732) + 2) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 2) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_unchanged3: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 ((pa AND 68719476732) + 3) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 3) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_alt_def)
 apply (simp add: Let_def)
 using a1 apply (simp add: mem_equal_def)
 by (metis option.distinct(1))
 
 lemma mem_val_alt_10_unchanged: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_val_alt 10 (pa AND 68719476732) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 (pa AND 68719476732) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 1) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 1) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 2) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 2) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>) \<and>
   mem_val_alt 10 ((pa AND 68719476732) + 3) (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) = 
   mem_val_alt 10 ((pa AND 68719476732) + 3) (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 using a1 mem_val_alt_10_unchanged0 mem_val_alt_10_unchanged1
 mem_val_alt_10_unchanged2 mem_val_alt_10_unchanged3
 by blast
 
 lemma mem_val_w32_10_unchanged: 
 assumes a1: "mem_equal s1 s2 a"
 shows "mem_val_w32 10 a (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>) =
 mem_val_w32 10 a (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)"
 apply (simp add: mem_val_w32_def)
 apply (simp add: Let_def)
 using mem_val_alt_10_unchanged a1 apply auto
         apply fastforce
        apply fastforce
       apply fastforce
      apply fastforce
     apply fastforce
    apply fastforce
   apply fastforce
  apply fastforce
 by fastforce
 
 lemma is_accessible: "low_equal s1 s2 \<Longrightarrow>
 virt_to_phys addra (mmu s1) (mem s1) = Some (a, b) \<Longrightarrow>
 virt_to_phys addra (mmu s2) (mem s2) = Some (a, b) \<Longrightarrow>
 mmu_readable (get_acc_flag b) 10 \<Longrightarrow>
 mem_equal s1 s2 a"
 apply (simp add: low_equal_def)
 apply (simp add: user_accessible_def)
 by fastforce
 
 lemma load_word_mem_10_unchanged: 
 assumes a1: "low_equal s1 s2 \<and> 
 load_word_mem s1 addra 10 = load_word_mem s2 addra 10"
 shows "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                          11 := (mem s1 11)(addr := None))\<rparr>) addra 10 =
        load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                          11 := (mem s2 11)(addr := None))\<rparr>) addra 10"
 proof (cases "virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = None")
   case True
   then have "virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = None \<and>
              virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = None"
     using a1 apply (auto simp add: mmu_low_equal)
     using a1 virt_to_phys_unchanged_low_equal by metis
   then show ?thesis
   by (simp add: load_word_mem_def)
 next
   case False
   then have "\<exists>p. virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = Some p \<and>
              virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = Some p"
     using a1 apply (auto simp add: mmu_low_equal)
     using a1 virt_to_phys_unchanged_low_equal by metis
   then have "\<exists>p. virt_to_phys addra (mmu s1) ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 
           11 := (mem s1 11)(addr := None))) = Some p \<and>
             virt_to_phys addra (mmu s2) ((mem s2)(10 := mem s2 10(addr \<mapsto> val), 
           11 := (mem s2 11)(addr := None))) = Some p \<and> 
             virt_to_phys addra (mmu s1) (mem s1) = Some p \<and>
             virt_to_phys addra (mmu s2) (mem s2) = Some p"
     using virt_to_phys_unchanged2 by metis
   then show ?thesis using a1  
   apply (simp add: load_word_mem_def)
   apply auto
   apply (simp add: low_equal_def)
   apply (simp add: user_accessible_def)
   using mem_val_w32_10_unchanged a1 by metis
 qed
 
 lemma load_word_mem_select_10: 
 assumes a1: "fst (case load_word_mem s1 addra 10 of None \<Rightarrow> (None, s1)
   | Some w \<Rightarrow> (Some w, add_data_cache s1 addra w 15)) =
 fst (case load_word_mem s2 addra 10 of None \<Rightarrow> (None, s2)
   | Some w \<Rightarrow> (Some w, add_data_cache s2 addra w 15))"
 shows "load_word_mem s1 addra 10 = load_word_mem s2 addra 10"
 using a1
 by (metis (mono_tags, lifting) fst_conv not_None_eq option.simps(4) option.simps(5))
 
 lemma memory_read_10_unchanged: 
 assumes a1: "low_equal s1 s2 \<and>
 fst (memory_read 10 addra s1) = fst (memory_read 10 addra s2)"
 shows "fst (memory_read 10 addra
                    (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
                                        11 := (mem s1 11)(addr := None))\<rparr>)) =
          fst (memory_read 10 addra
                    (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
                                        11 := (mem s2 11)(addr := None))\<rparr>))"
 proof (cases "sys_reg s1 CCR AND 1 = 0")
   case True
   then have "sys_reg s1 CCR AND 1 = 0 \<and> sys_reg s2 CCR AND 1 = 0"
     using a1 sys_reg_low_equal by fastforce
   then show ?thesis using a1
   apply (simp add: memory_read_def)
   using load_word_mem_10_unchanged by blast
 next
   case False
   then have f1: "sys_reg s1 CCR AND 1 \<noteq> 0 \<and> sys_reg s2 CCR AND 1 \<noteq> 0"
     using a1 sys_reg_low_equal by fastforce
   then show ?thesis using a1
   proof (cases "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 10 = None")
     case True
     then have "load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 10 = None \<and> 
       load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
       11 := (mem s2 11)(addr := None))\<rparr>) addra 10 = None"
       using a1 f1  
       apply (simp add: memory_read_def)
       apply clarsimp
       using load_word_mem_select_10 load_word_mem_10_unchanged by fastforce
     then show ?thesis
     by (simp add: memory_read_def)
   next
     case False
     then have "\<exists>y. load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 10 = Some y" by auto
     then have "\<exists>y. load_word_mem (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
       11 := (mem s1 11)(addr := None))\<rparr>) addra 10 = Some y \<and> 
                    load_word_mem (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
       11 := (mem s2 11)(addr := None))\<rparr>) addra 10 = Some y"
       using a1 f1
       apply (simp add: memory_read_def)
       apply clarsimp
       using load_word_mem_select_10 load_word_mem_10_unchanged by fastforce
     then show ?thesis using a1 f1
     apply (simp add: memory_read_def)
     by auto
   qed
 qed
 
 lemma state_mem_mod_1011_low_equal_sub1: 
 assumes a1: "(\<forall>va. virt_to_phys va (mmu s2) (mem s1) =
             virt_to_phys va (mmu s2) (mem s2)) \<and>
   (\<forall>pa. (\<exists>va b. virt_to_phys va (mmu s2) (mem s2) = Some (pa, b) \<and>
   mmu_readable (get_acc_flag b) 10) \<longrightarrow>
   mem_equal s1 s2 pa) \<and>
   mmu s1 = mmu s2 \<and>
   virt_to_phys va (mmu s2)
   ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) =
   Some (pa, b) \<and>
   mmu_readable (get_acc_flag b) 10"
 shows "mem_equal s1 s2 pa"
 proof -
   have "virt_to_phys va (mmu s1)
   ((mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))) =
   Some (pa, b)"
     using a1 by auto
   then have "virt_to_phys va (mmu s1) (mem s1) = Some (pa, b)"
     using virt_to_phys_unchanged2 by metis
   then have "virt_to_phys va (mmu s2) (mem s2) = Some (pa, b)"
     using a1 by auto
   then show ?thesis using a1 by auto
 qed
 
 lemma mem_equal_unchanged: 
 assumes a1: "mem_equal s1 s2 pa"
 shows "mem_equal (s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 
   11 := (mem s1 11)(addr := None))\<rparr>)
  (s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 
   11 := (mem s2 11)(addr := None))\<rparr>)
  pa"
 using a1 apply (simp add: mem_equal_def)
 by auto
 
 lemma state_mem_mod_1011_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = s1\<lparr>mem := (mem s1)(10 := mem s1 10(addr \<mapsto> val), 11 := (mem s1 11)(addr := None))\<rparr> \<and>
 t2 = s2\<lparr>mem := (mem s2)(10 := mem s2 10(addr \<mapsto> val), 11 := (mem s2 11)(addr := None))\<rparr>"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: low_equal_def)
 apply (simp add: user_accessible_def)
 apply auto
    apply (simp add: assms virt_to_phys_unchanged_low_equal)
   using state_mem_mod_1011_low_equal_sub1 mem_equal_unchanged
   apply metis
  apply (metis virt_to_phys_unchanged2)
 using state_mem_mod_1011_low_equal_sub1 mem_equal_unchanged
 by metis
 
 lemma mem_mod_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = (mem_mod 10 addr val s1) \<and>
 t2 = (mem_mod 10 addr val s2)"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: mem_mod_def)
 by (auto intro: state_mem_mod_1011_low_equal)
 
 lemma mem_mod_w32_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = mem_mod_w32 10 a bm data s1 \<and>
 t2 = mem_mod_w32 10 a bm data s2"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: mem_mod_w32_def)
 apply (simp add: Let_def)
 by (meson mem_mod_low_equal)
 
 lemma store_word_mem_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 Some t1 = store_word_mem s1 addr data bm 10 \<and>
 Some t2 = store_word_mem s2 addr data bm 10" 
 shows "low_equal t1 t2" using a1
 apply (simp add: store_word_mem_def)
 apply (auto simp add: virt_to_phys_low_equal)
 apply (case_tac "virt_to_phys addr (mmu s2) (mem s2) = None")
  apply auto
 apply (case_tac "mmu_writable (get_acc_flag b) 10")
  apply auto
 using mem_mod_w32_low_equal by blast
 
 lemma memory_write_asi_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 Some t1 = memory_write_asi 10 addr bm data s1 \<and>
 Some t2 = memory_write_asi 10 addr bm data s2"
 shows "low_equal t1 t2"
 using a1 apply (simp add: memory_write_asi_def)
 by (meson add_data_cache_low_equal store_word_mem_low_equal)
 
 lemma store_barrier_pending_mod_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = store_barrier_pending_mod False s1 \<and>
 t2 = store_barrier_pending_mod False s2"
 shows "low_equal t1 t2"
 using a1 apply (simp add: store_barrier_pending_mod_def)
 apply clarsimp
 using a1 apply (auto simp add: state_var_low_equal)
 by (auto intro: state_var2_low_equal)
 
 lemma memory_write_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 Some t1 = memory_write 10 addr bm data s1 \<and>
 Some t2 = memory_write 10 addr bm data s2"
 shows "low_equal t1 t2"
 apply (case_tac "memory_write_asi 10 addr bm data s1 = None")
  using a1 apply (simp add: memory_write_def)
 apply (case_tac "memory_write_asi 10 addr bm data s2 = None")
  apply (meson assms low_equal_com memory_write_asi_low_equal_none)
 using a1 apply (simp add: memory_write_def)
 apply auto
 by (metis memory_write_asi_low_equal store_barrier_pending_mod_low_equal)
 
 lemma memory_write_low_equal2: 
 assumes a1: "low_equal s1 s2 \<and>
 Some t1 = memory_write 10 addr bm data s1"
 shows "\<exists>t2. Some t2 = memory_write 10 addr bm data s2"
 using a1
 apply (simp add: memory_write_def)
 apply auto
 by (metis (full_types) memory_write_def memory_write_low_equal_none2 not_None_eq) 
 
 lemma store_sub2_low_equal_sub1:
 assumes a1: "low_equal s1 s2 \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s1 = Some y \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s2 = Some ya"
 shows "low_equal (y\<lparr>traps := insert data_access_exception (traps y)\<rparr>)
         (ya\<lparr>traps := insert data_access_exception (traps ya)\<rparr>)"
 proof -
   from a1 have f1: "low_equal y ya" using memory_write_low_equal by metis
   then have "traps y = traps ya" by (simp add: low_equal_def)
   then show ?thesis using f1 mod_trap_low_equal by fastforce
 qed
 
 lemma store_sub2_low_equal_sub2:
 assumes a1: "low_equal s1 s2 \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s1 = Some y \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s2 = Some ya \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) y) y = None \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) ya) ya = Some yb"
 shows "False"
 proof -
   from a1 have f1: "low_equal y ya" using memory_write_low_equal by metis
   then have "(user_reg_val curr_win (rd OR 1) y) = 
     (user_reg_val curr_win (rd OR 1) ya)" 
     by (simp add: low_equal_def user_reg_val_def)
   then show ?thesis using a1
   using f1 memory_write_low_equal_none by fastforce  
 qed
 
 lemma store_sub2_low_equal_sub3:
 assumes a1: "low_equal s1 s2 \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s1 = Some y \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s2 = Some ya \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) y) y = Some yb \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) ya) ya = None"
 shows "False"
 proof -
   from a1 have f1: "low_equal y ya" using memory_write_low_equal by metis
   then have "(user_reg_val curr_win (rd OR 1) y) = 
     (user_reg_val curr_win (rd OR 1) ya)" 
     by (simp add: low_equal_def user_reg_val_def)
   then show ?thesis using a1
   using f1 memory_write_low_equal_none2 by fastforce  
 qed
 
 lemma store_sub2_low_equal_sub4:
 assumes a1: "low_equal s1 s2 \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s1 = Some y \<and>
 memory_write 10 addr (st_byte_mask instr addr)
   (st_data0 instr curr_win rd addr s2) s2 = Some ya \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) y) y = Some yb \<and>
 memory_write 10 (addr + 4) 15 (user_reg_val curr_win (rd OR 1) ya) ya = Some yc" 
 shows "low_equal yb yc"
 proof -
   from a1 have f1: "low_equal y ya" using memory_write_low_equal by metis
   then have "(user_reg_val curr_win (rd OR 1) y) = 
     (user_reg_val curr_win (rd OR 1) ya)" 
     by (simp add: low_equal_def user_reg_val_def)
   then show ?thesis using a1 f1
   by (metis memory_write_low_equal)  
 qed
 
 lemma store_sub2_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (store_sub2 instr curr_win rd 10 addr s1)) \<and>
 t2 = snd (fst (store_sub2 instr curr_win rd 10 addr s2))"
 shows "low_equal t1 t2"
 proof (cases "memory_write 10 addr (st_byte_mask instr addr)
         (st_data0 instr curr_win rd addr s1) s1 = None")
   case True
   then have "memory_write 10 addr (st_byte_mask instr addr)
         (st_data0 instr curr_win rd addr s1) s1 = None \<and>
         memory_write 10 addr (st_byte_mask instr addr)
         (st_data0 instr curr_win rd addr s2) s2 = None"
     using a1 by (metis memory_write_low_equal_none st_data0_low_equal) 
   then show ?thesis using a1
   apply (simp add: store_sub2_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold return_def)
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   using mod_trap_low_equal traps_low_equal by fastforce  
 next
   case False
   then have f1: "memory_write 10 addr (st_byte_mask instr addr) 
     (st_data0 instr curr_win rd addr s1) s1 \<noteq> None \<and>
     memory_write 10 addr (st_byte_mask instr addr) 
     (st_data0 instr curr_win rd addr s2) s2 \<noteq> None"
     using a1 by (metis memory_write_low_equal_none2 st_data0_low_equal)     
   then show ?thesis 
   proof (cases "(fst instr) \<in> {load_store_type STD,load_store_type STDA}")
     case True
     then show ?thesis using a1 f1
     apply (simp add: store_sub2_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     apply (simp add: return_def)
     apply (simp add: bind_def case_prod_unfold)
     apply (simp add: simpler_modify_def)
     apply clarsimp
     apply (simp add: case_prod_unfold bind_def h1_def h2_def Let_def simpler_modify_def)
     apply (simp add: simpler_gets_def)
     apply auto
            apply (simp add: raise_trap_def add_trap_set_def)
            apply (simp add: simpler_modify_def)
            apply (simp add: st_data0_low_equal)    
            apply (simp add: store_sub2_low_equal_sub1)
           apply (simp add: st_data0_low_equal)
           using store_sub2_low_equal_sub2 apply blast
          apply (simp add: st_data0_low_equal)
          using store_sub2_low_equal_sub3 apply blast
         apply (simp add: st_data0_low_equal)
         using store_sub2_low_equal_sub4 apply blast
        apply (simp add: st_data0_low_equal)
        apply (simp add: raise_trap_def add_trap_set_def)
        apply (simp add: simpler_modify_def)
        using store_sub2_low_equal_sub1 apply blast
       apply (simp add: st_data0_low_equal)
       using store_sub2_low_equal_sub2 apply blast
      apply (simp add: st_data0_low_equal)
      using store_sub2_low_equal_sub3 apply blast
     apply (simp add: st_data0_low_equal)
     using store_sub2_low_equal_sub4 by blast
   next
     case False
     then show ?thesis using a1 f1
     apply (simp add: store_sub2_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def)
     apply (simp add: simpler_modify_def bind_def h1_def h2_def Let_def)
     apply (simp add: return_def)
     apply (simp add: bind_def case_prod_unfold)
     apply clarsimp
     apply (simp add: simpler_modify_def)
     apply (simp add: st_data0_low_equal)
     using memory_write_low_equal by metis
   qed
 qed
 
 lemma store_sub1_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 (fst instr = load_store_type STB \<or>
 fst instr = load_store_type STH \<or>
 fst instr = load_store_type ST \<or> 
 fst instr = load_store_type STD) \<and>
 t1 = snd (fst (store_sub1 instr rd 0 s1)) \<and>
 t2 = snd (fst (store_sub1 instr rd 0 s2))"
 shows "low_equal t1 t2"
 proof (cases "(fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0")
   case True
   then have "((fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0) \<and> 
              ((fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word1) \<noteq> 0)"
     by (metis (mono_tags, lifting) assms get_addr_low_equal) 
   then show ?thesis using a1
   apply (simp add: store_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   apply clarsimp
   apply (simp add: get_curr_win3_low_equal)
   by (auto intro: get_curr_win2_low_equal mod_trap_low_equal)
 next
   case False
   then have f1: "\<not> ((fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
       ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word1) \<noteq> 0) \<and>
       \<not> ((fst instr = load_store_type STH \<or> fst instr = load_store_type STHA) \<and>
       ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word1) \<noteq> 0)"
     by (metis (mono_tags, lifting) assms get_addr_low_equal) 
   then show ?thesis 
   proof (cases "(fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0")
     case True
     then have "(fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0 \<and>
               (fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<noteq> 0"
       by (metis (mono_tags, lifting) assms get_addr_low_equal) 
     then show ?thesis using a1 f1
     apply (simp add: store_sub1_def)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply (simp add: case_prod_unfold) 
     apply (simp add: raise_trap_def add_trap_set_def)
     apply (simp add: simpler_modify_def)
     apply clarsimp
     apply (simp add: get_curr_win3_low_equal)
     by (auto intro: get_curr_win2_low_equal mod_trap_low_equal)
   next
     case False
     then have "\<not>((fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0) \<and>
               \<not>((fst instr \<in> {load_store_type ST,load_store_type STA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<noteq> 0)"
       by (metis (mono_tags, lifting) assms get_addr_low_equal) 
     then have f2: "\<not>((fst instr = load_store_type ST \<or> fst instr = load_store_type STA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word2) \<noteq> 0) \<and>
               \<not>((fst instr = load_store_type ST \<or> fst instr = load_store_type STA) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word2) \<noteq> 0)"
       by auto
     then show ?thesis 
     proof (cases "(fst instr \<in> {load_store_type STD,load_store_type STDA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0")
       case True
       then have "(fst instr \<in> {load_store_type STD,load_store_type STDA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0 \<and>
               (fst instr \<in> {load_store_type STD,load_store_type STDA}) \<and>
               ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<noteq> 0"
         by (metis (mono_tags, lifting) assms get_addr_low_equal) 
       then show ?thesis using a1 
       apply (simp add: store_sub1_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply auto
       apply (simp add: case_prod_unfold) 
       apply (simp add: raise_trap_def add_trap_set_def)
       apply (simp add: simpler_modify_def)
       apply (simp add: get_curr_win3_low_equal)
       by (auto intro: get_curr_win2_low_equal mod_trap_low_equal)         
     next
       case False
       then have "\<not> (fst instr \<in> {load_store_type STD, load_store_type STDA} \<and>
         ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0) \<and>
         \<not> (fst instr \<in> {load_store_type STD, load_store_type STDA} \<and>
         ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<noteq> 0)"
         by (metis (mono_tags, lifting) assms get_addr_low_equal)
       then have f3: "\<not> ((fst instr = load_store_type STD \<or> fst instr = load_store_type STDA) \<and>
         ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s1)))))::word3) \<noteq> 0) \<and>
         \<not> ((fst instr = load_store_type STD \<or> fst instr = load_store_type STDA) \<and>
         ((ucast (get_addr (snd instr) (snd (fst (get_curr_win () s2)))))::word3) \<noteq> 0)"
         by auto
       show ?thesis using a1
       apply (simp add: store_sub1_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (unfold case_prod_beta)
       apply (simp add: f1 f2 f3)
       apply (simp_all add: st_asi_def)
       using a1 apply clarsimp
       apply (simp add: get_curr_win_low_equal get_addr2_low_equal)
       by (metis store_sub2_low_equal get_curr_win2_low_equal)      
     qed
   qed
 qed
 
 lemma store_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 (fst instr = load_store_type STB \<or>
 fst instr = load_store_type STH \<or>
 fst instr = load_store_type ST \<or> 
 fst instr = load_store_type STA \<or> 
 fst instr = load_store_type STD) \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 t1 = snd (fst (store_instr instr s1)) \<and> t2 = snd (fst (store_instr instr s2))"
 shows "low_equal t1 t2"
 proof -
   have "get_S (cpu_reg_val PSR s1) = 0 \<and> get_S (cpu_reg_val PSR s2) = 0"
     using a1 by (simp add: ucast_id) 
   then show ?thesis using a1
   apply (simp add: store_instr_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: Let_def)
   apply clarsimp
   apply (simp add: raise_trap_def add_trap_set_def)
   apply (simp add: simpler_modify_def)
   apply (simp add: traps_low_equal)
   by (auto intro: mod_trap_low_equal store_sub1_low_equal)
 qed
 
 lemma sethi_low_equal: "low_equal s1 s2 \<and>
 t1 = snd (fst (sethi_instr instr s1)) \<and> t2 = snd (fst (sethi_instr instr s2)) \<Longrightarrow>
 low_equal t1 t2"
 apply (simp add: sethi_instr_def)
 apply (simp add: Let_def)
 apply (case_tac "get_operand_w5 (snd instr ! Suc 0) \<noteq> 0")
  apply auto
  apply (simp add: bind_def h1_def h2_def Let_def)
  apply (simp add: case_prod_unfold)
  apply (simp add: get_curr_win_low_equal)
  using get_curr_win2_low_equal write_reg_low_equal
  apply metis
 by (simp add: return_def)
 
 lemma nop_low_equal: "low_equal s1 s2 \<and>
 t1 = snd (fst (nop_instr instr s1)) \<and> t2 = snd (fst (nop_instr instr s2)) \<Longrightarrow>
 low_equal t1 t2"
 apply (simp add: nop_instr_def)
 by (simp add: return_def)
 
 lemma logical_instr_sub1_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (logical_instr_sub1 instr_name result s1)) \<and> 
 t2 = snd (fst (logical_instr_sub1 instr_name result s2))"
 shows "low_equal t1 t2"
 proof (cases "instr_name = logic_type ANDcc \<or>
               instr_name = logic_type ANDNcc \<or>
               instr_name = logic_type ORcc \<or>
               instr_name = logic_type ORNcc \<or>
               instr_name = logic_type XORcc \<or> instr_name = logic_type XNORcc")
   case True
   then show ?thesis using a1
   apply (simp add: logical_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: logical_new_psr_val_def)    
   using write_cpu_low_equal cpu_reg_val_low_equal
   by fastforce  
 next
   case False
   then show ?thesis using a1
   apply (simp add: logical_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma logical_instr_low_equal: "low_equal s1 s2 \<and>
 t1 = snd (fst (logical_instr instr s1)) \<and> t2 = snd (fst (logical_instr instr s2)) \<Longrightarrow>
 low_equal t1 t2"
 apply (simp add: logical_instr_def)
 apply (simp add: Let_def simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold)
 apply auto
  apply (simp_all add: get_curr_win_low_equal)
  apply (simp_all add: get_operand2_low_equal)
  using logical_instr_sub1_low_equal get_operand2_low_equal
  get_curr_win2_low_equal write_reg_low_equal user_reg_val_low_equal
  proof -
   assume a1: "low_equal s1 s2"
   assume "t2 = snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))))"
   assume "t1 = snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))"
   have "\<And>w wa. user_reg_val w wa (snd (fst (get_curr_win () s2))) = user_reg_val w wa (snd (fst (get_curr_win () s1)))"
     using a1 by (metis (no_types) get_curr_win2_low_equal user_reg_val_low_equal)
   then show "low_equal (snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))) (snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))))"
     using a1 by (metis (no_types) get_curr_win2_low_equal logical_instr_sub1_low_equal write_reg_low_equal)
  next
   assume a2: "low_equal s1 s2"
   assume "t1 = snd (fst (logical_instr_sub1 (fst instr)
                     (logical_result (fst instr)
                       (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                         (snd (fst (get_curr_win () s1))))
                       (get_operand2 (snd instr) s2))
                     (snd (fst (write_reg
                                 (user_reg_val (fst (fst (get_curr_win () s2))) 0
                                   (snd (fst (get_curr_win () s1))))
                                 (fst (fst (get_curr_win () s2))) 0
                                 (snd (fst (get_curr_win () s1))))))))"
   assume "t2 = snd (fst (logical_instr_sub1 (fst instr)
                     (logical_result (fst instr)
                       (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                         (snd (fst (get_curr_win () s2))))
                       (get_operand2 (snd instr) s2))
                     (snd (fst (write_reg
                                 (user_reg_val (fst (fst (get_curr_win () s2))) 0
                                   (snd (fst (get_curr_win () s2))))
                                 (fst (fst (get_curr_win () s2))) 0
                                 (snd (fst (get_curr_win () s2))))))))"
   have "\<And>w wa. user_reg_val w wa (snd (fst (get_curr_win () s2))) = user_reg_val w wa (snd (fst (get_curr_win () s1)))"
     using a2 by (metis (no_types) get_curr_win2_low_equal user_reg_val_low_equal)
   then show "low_equal
      (snd (fst (logical_instr_sub1 (fst instr)
                  (logical_result (fst instr)
                    (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                      (snd (fst (get_curr_win () s1))))
                    (get_operand2 (snd instr) s2))
                  (snd (fst (write_reg
                              (user_reg_val (fst (fst (get_curr_win () s2))) 0
                                (snd (fst (get_curr_win () s1))))
                              (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))))))))
      (snd (fst (logical_instr_sub1 (fst instr)
                  (logical_result (fst instr)
                    (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                      (snd (fst (get_curr_win () s2))))
                    (get_operand2 (snd instr) s2))
                  (snd (fst (write_reg
                              (user_reg_val (fst (fst (get_curr_win () s2))) 0
                                (snd (fst (get_curr_win () s2))))
                              (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
   proof -
     have "low_equal (snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (logical_instr_sub1 (fst instr) (logical_result (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s2)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
       by (meson a2 get_curr_win2_low_equal logical_instr_sub1_low_equal write_reg_low_equal)
     then show ?thesis
       using \<open>\<And>wa w. user_reg_val w wa (snd (fst (get_curr_win () s2))) = user_reg_val w wa (snd (fst (get_curr_win () s1)))\<close> by presburger
   qed   
  qed
 
 lemma shift_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (shift_instr instr s1)) \<and> t2 = snd (fst (shift_instr instr s2))"
 shows "low_equal t1 t2"
 proof (cases "(fst instr = shift_type SLL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
   case True
   then show ?thesis using a1
   apply (simp add: shift_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def)
   apply (simp add: bind_def h1_def h2_def Let_def case_prod_unfold)
   apply auto
     apply (simp_all add: get_curr_win_low_equal)
     proof -
       assume a1: "low_equal s1 s2"
       assume "t2 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) << unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))"
       assume "t1 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) << unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))"
       have "\<And>w wa wb. low_equal (snd (fst (write_reg w wa wb s1))) (snd (fst (write_reg w wa wb s2)))"
         using a1 by (metis write_reg_low_equal)
       then show "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) << unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) << unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
         using a1 by (simp add: get_curr_win_def simpler_gets_def user_reg_val_low_equal)
     next
       assume a2: "low_equal s1 s2"
       assume "t1 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s1))) <<
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s1)))))"
       assume "t2 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s2))) <<
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s2)))))"
       have "\<And>w wa wb. low_equal (snd (fst (write_reg w wa wb s1))) (snd (fst (write_reg w wa wb s2)))"
         using a2 by (metis write_reg_low_equal)
       then show "low_equal
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s1))) <<
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s1))))))
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s2))) <<
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s2))))))"
       proof -
         assume a1: "\<And>w wa wb. low_equal (snd (fst (write_reg w wa wb s1))) (snd (fst (write_reg w wa wb s2)))"
         have "\<And>u s. fst (get_curr_win u s) = (ucast (get_CWP (cpu_reg_val PSR s))::'a word, s)"
           by (simp add: get_curr_win_def simpler_gets_def)
         then show ?thesis
           using a1 assms user_reg_val_low_equal by fastforce
       qed      
     qed
 next
   case False
   then have f1: "\<not>((fst instr = shift_type SLL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0))"
     by auto
   then show ?thesis
   proof (cases "(fst instr = shift_type SRL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
     case True
     then show ?thesis using a1 f1
     apply (simp add: shift_instr_def)
     apply (simp add: Let_def)
     apply (simp add: simpler_gets_def)
     apply (simp add: bind_def h1_def h2_def Let_def case_prod_unfold)
     apply auto
       apply (simp_all add: get_curr_win_low_equal)
       proof -
         assume a1: "low_equal s1 s2"
         assume "t2 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) >> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))"
         assume "t1 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) >> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))"
         have "\<And>u s. fst (get_curr_win u s) = (ucast (get_CWP (cpu_reg_val PSR s))::'a word, s)"
           by (simp add: get_curr_win_def simpler_gets_def)
         then show "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) >> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) >> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
           using a1 user_reg_val_low_equal write_reg_low_equal by fastforce
       next
         assume a2: "low_equal s1 s2"
         assume "t1 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s1))) >>
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s1)))))" 
         assume "t2 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s2))) >>
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s2)))))"
         have "\<And>u s. fst (get_curr_win u s) = (ucast (get_CWP (cpu_reg_val PSR s))::'a word, s)"
           by (simp add: get_curr_win_def simpler_gets_def)
         then show "low_equal
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s1))) >>
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s1))))))
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s2))) >>
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s2))))))"
           using a2 user_reg_val_low_equal write_reg_low_equal by fastforce
       qed  
   next
     case False
     then have f2: "\<not>((fst instr = shift_type SRL) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0))"
       by auto
     then show ?thesis 
     proof (cases "(fst instr = shift_type SRA) \<and> (get_operand_w5 ((snd instr)!3) \<noteq> 0)")
       case True
       then show ?thesis using a1 f1 f2
       apply (simp add: shift_instr_def)
       apply (simp add: Let_def)
       apply (simp add: simpler_gets_def)
       apply (simp add: bind_def h1_def h2_def Let_def case_prod_unfold)
       apply auto
        apply (simp_all add: get_curr_win_low_equal)
        proof -
         assume a1: "low_equal s1 s2"
         assume "t1 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) >>> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))"
         assume "t2 = snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) >>> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))"
         have "\<forall>w wa. user_reg_val wa w (snd (fst (get_curr_win () s1))) = user_reg_val wa w (snd (fst (get_curr_win () s2)))"
           using a1 by (meson get_curr_win2_low_equal user_reg_val_low_equal)
         then show "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) >>> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s1))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) >>> unat (ucast (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 2)) (snd (fst (get_curr_win () s2))))::word5)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
           using a1 by (metis (no_types) get_curr_win2_low_equal write_reg_low_equal)
        next
         assume a2: "low_equal s1 s2"
         assume "t1 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s1))) >>>
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s1)))))"
         assume "t2 = snd (fst (write_reg
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s2))) >>>
                      unat (get_operand_w5 (snd instr ! 2)))
                     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                     (snd (fst (get_curr_win () s2)))))"
         have "\<forall>w wa. user_reg_val wa w (snd (fst (get_curr_win () s1))) = user_reg_val wa w (snd (fst (get_curr_win () s2)))"
           using a2 by (meson get_curr_win2_low_equal user_reg_val_low_equal)
         then show "low_equal
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s1))) >>>
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s1))))))
                 (snd (fst (write_reg
                  (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s2))) >>>
                   unat (get_operand_w5 (snd instr ! 2)))
                  (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                  (snd (fst (get_curr_win () s2))))))"
            using a2 get_curr_win2_low_equal write_reg_low_equal by fastforce         
        qed
     next
       case False
       then show ?thesis using a1 f1 f2
       apply (simp add: shift_instr_def)
       apply (simp add: Let_def) 
       apply (simp add: simpler_gets_def)
       apply (simp add: bind_def h1_def h2_def Let_def case_prod_unfold)
       apply (simp add: return_def)
       using get_curr_win2_low_equal by blast
     qed
   qed
 qed
 
 lemma add_instr_sub1_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (add_instr_sub1 instr_name result rs1_val operand2 s1)) \<and>
 t2 = snd (fst (add_instr_sub1 instr_name result rs1_val operand2 s2))"
 shows "low_equal t1 t2"
 proof (cases "instr_name = arith_type ADDcc \<or> instr_name = arith_type ADDXcc")
   case True
   then show ?thesis using a1
   apply (simp add: add_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (clarsimp simp add: cpu_reg_val_low_equal)
   using write_cpu_low_equal by blast
 next
   case False
   then show ?thesis using a1
   apply (simp add: add_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma add_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (add_instr instr s1)) \<and> t2 = snd (fst (add_instr instr s2))"
 shows "low_equal t1 t2"
 proof -
   have f1: "low_equal s1 s2 \<and>
         t1 = snd (fst (add_instr_sub1 (fst instr)
                     (if fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc
                      then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s1))) +
                           get_operand2 (snd instr) s1
                      else user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s1))) +
                           get_operand2 (snd instr) s1 +
                           ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1))))))
                     (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s1))))
                     (get_operand2 (snd instr) s1)
                     (snd (fst (write_reg
                                 (if get_operand_w5 (snd instr ! 3) \<noteq> 0
                                  then if fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc
                                       then user_reg_val (fst (fst (get_curr_win () s1)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s1))) +
                                            get_operand2 (snd instr) s1
                                       else user_reg_val (fst (fst (get_curr_win () s1)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s1))) +
                                            get_operand2 (snd instr) s1 +
                                            ucast (get_icc_C
                                                    (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))
                                  else user_reg_val (fst (fst (get_curr_win () s1)))
                                        (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))
                                 (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3))
                                 (snd (fst (get_curr_win () s1)))))))) \<and>
     t2 = snd (fst (add_instr_sub1 (fst instr)
                     (if fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc
                      then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s2))) +
                           get_operand2 (snd instr) s2
                      else user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s2))) +
                           get_operand2 (snd instr) s2 +
                           ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))))
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s2))))
                     (get_operand2 (snd instr) s2)
                     (snd (fst (write_reg
                                 (if get_operand_w5 (snd instr ! 3) \<noteq> 0
                                  then if fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc
                                       then user_reg_val (fst (fst (get_curr_win () s2)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s2))) +
                                            get_operand2 (snd instr) s2
                                       else user_reg_val (fst (fst (get_curr_win () s2)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s2))) +
                                            get_operand2 (snd instr) s2 +
                                            ucast (get_icc_C
                                                    (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))
                                  else user_reg_val (fst (fst (get_curr_win () s2)))
                                        (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))
                                 (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                                 (snd (fst (get_curr_win () s2))))))))"
   using a1 apply (simp add: add_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (simp add: case_prod_unfold)
   then show ?thesis
   proof (cases "get_operand_w5 (snd instr ! 3) \<noteq> 0")
     case True
     then have f2: "get_operand_w5 (snd instr ! 3) \<noteq> 0" by auto
     then show ?thesis
     proof (cases "fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc")
       case True
       then show ?thesis 
       using f1 f2 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         assume "t1 = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))"
         assume a2: "t2 = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))))"
         have f3: "\<forall>is. get_operand2 is s1 = get_operand2 is s2"
           using a1 by (metis get_operand2_low_equal)
         have f4: "fst (fst (get_curr_win () s1)) = fst (fst (get_curr_win () s2))"
           using a1 by (meson get_curr_win_low_equal)
         have "\<forall>s. snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s + get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s + get_operand2 (snd instr) s2) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))) = t2 \<or> \<not> low_equal s (snd (fst (get_curr_win () s2)))"
           using a2 user_reg_val_low_equal by fastforce
         then show "low_equal (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))) (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))))"
           using f4 f3 a2 a1 by (metis (no_types) add_instr_sub1_low_equal get_curr_win2_low_equal write_reg_low_equal)
       qed
     next
       case False
       then show ?thesis
       using f1 f2 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         have f2: "\<forall>s sa sb w wa wb sc. (\<not> low_equal s sa \<or> sb \<noteq> snd (fst (write_reg w (wa::'a word) wb s)) \<or> sc \<noteq> snd (fst (write_reg w wa wb sa))) \<or> low_equal sb sc"
           by (meson write_reg_low_equal)
         have f3: "gets (\<lambda>s. ucast (get_CWP (cpu_reg_val PSR s))::'a word) = get_curr_win ()"
           by (simp add: get_curr_win_def)
         then have "((ucast (get_CWP (cpu_reg_val PSR s1)), s1), False) = (fst (get_curr_win () s1), snd (get_curr_win () s1))"
           by (metis (no_types) prod.collapse simpler_gets_def)
         then have "(ucast (get_CWP (cpu_reg_val PSR s1)), s1) = fst (get_curr_win () s1) \<and> \<not> snd (get_curr_win () s1)"
           by blast
         then have f4: "ucast (get_CWP (cpu_reg_val PSR s1)) = fst (fst (get_curr_win () s1)) \<and> s1 = snd (fst (get_curr_win () s1))"
           by (metis (no_types) prod.collapse prod.simps(1))
         have "((ucast (get_CWP (cpu_reg_val PSR s2)), s2), False) = (fst (get_curr_win () s2), snd (get_curr_win () s2))"
           using f3 by (metis (no_types) prod.collapse simpler_gets_def)
         then have "(ucast (get_CWP (cpu_reg_val PSR s2)), s2) = fst (get_curr_win () s2) \<and> \<not> snd (get_curr_win () s2)"
           by blast
         then have f5: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2)) \<and> s2 = snd (fst (get_curr_win () s2))"
           by (metis prod.collapse prod.simps(1))
         then have f6: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2))) = low_equal s1 s2"
           using f4 by presburger
         have f7: "fst (fst (get_curr_win () s1)) = ucast (get_CWP (cpu_reg_val PSR s1))"
           using f4 by presburger
         have f8: "cpu_reg_val PSR s1 = cpu_reg_val PSR s2"
           using a1 by (meson cpu_reg_val_low_equal)
         have f9: "user_reg_val (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) = user_reg_val (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))"
           using f6 a1 by (meson user_reg_val_low_equal)
         have f10: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2))"
           using f5 by meson
         have f11: "\<forall>s sa is. \<not> low_equal (s::'a sparc_state) sa \<or> get_operand2 is s = get_operand2 is sa"
           using get_operand2_low_equal by blast
         then have f12: "user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1))))) = user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))"
           using f9 f8 f5 f4 a1 by auto
         then have "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
           using f10 f8 f6 f4 f2 a1 by simp
         then show "low_equal (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))) (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))))"
           using f12 f11 f10 f9 f8 f7 a1 add_instr_sub1_low_equal by fastforce
       qed      
     qed
   next
     case False
     then have f3: "\<not> get_operand_w5 (snd instr ! 3) \<noteq> 0" by auto
     then show ?thesis
     proof (cases "fst instr = arith_type ADD \<or> fst instr = arith_type ADDcc")
       case True
       then show ?thesis
       using f1 f3 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         assume "t1 = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))"
         assume "t2 = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))"
         have f2: "\<forall>is. get_operand2 is s1 = get_operand2 is s2"
           using a1 by (meson get_operand2_low_equal)
         have f3: "fst (fst (get_curr_win () s1)) = fst (fst (get_curr_win () s2))"
           using a1 by (meson get_curr_win_low_equal)
         have "\<forall>w wa. user_reg_val wa w (snd (fst (get_curr_win () s1))) = user_reg_val wa w (snd (fst (get_curr_win () s2)))"
           using a1 by (meson get_curr_win2_low_equal user_reg_val_low_equal)
         then show "low_equal (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
           using f3 f2 a1 by (metis (no_types) add_instr_sub1_low_equal get_curr_win2_low_equal write_reg_low_equal)
       qed      
     next
       case False
       then show ?thesis
       using f1 f3 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         have f2: "gets (\<lambda>s. ucast (get_CWP (cpu_reg_val PSR s))::'a word) = get_curr_win ()"
           by (simp add: get_curr_win_def)
         then have "((ucast (get_CWP (cpu_reg_val PSR s1)), s1), False) = (fst (get_curr_win () s1), snd (get_curr_win () s1))"
           by (metis (no_types) prod.collapse simpler_gets_def)
         then have "(ucast (get_CWP (cpu_reg_val PSR s1)), s1) = fst (get_curr_win () s1) \<and> \<not> snd (get_curr_win () s1)"
           by fastforce
         then have f3: "ucast (get_CWP (cpu_reg_val PSR s1)) = fst (fst (get_curr_win () s1)) \<and> s1 = snd (fst (get_curr_win () s1))"
           by (metis prod.collapse prod.simps(1))
         have "((ucast (get_CWP (cpu_reg_val PSR s2)), s2), False) = (fst (get_curr_win () s2), snd (get_curr_win () s2))"
           using f2 by (metis (no_types) prod.collapse simpler_gets_def)
         then have "(ucast (get_CWP (cpu_reg_val PSR s2)), s2) = fst (get_curr_win () s2) \<and> \<not> snd (get_curr_win () s2)"
           by fastforce
         then have f4: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2)) \<and> s2 = snd (fst (get_curr_win () s2))"
           by (metis (no_types) prod.collapse prod.simps(1))
         then have f5: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2))) = low_equal s1 s2"
           using f3 by presburger
         have f6: "fst (fst (get_curr_win () s1)) = ucast (get_CWP (cpu_reg_val PSR s1))"
           using f3 by auto
         have f7: "cpu_reg_val PSR s1 = cpu_reg_val PSR s2"
           using a1 by (meson cpu_reg_val_low_equal)
         have f8: "\<forall>s sa w wa. \<not> low_equal s sa \<or> user_reg_val (w::'a word) wa s = user_reg_val w wa sa"
           by (meson user_reg_val_low_equal)
         have f9: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2))"
           using f4 by meson
         have "\<forall>s sa is. \<not> low_equal (s::'a sparc_state) sa \<or> get_operand2 is s = get_operand2 is sa"
           using get_operand2_low_equal by blast
         then have f10: "get_operand2 (snd instr) s1 = get_operand2 (snd instr) s2"
           using a1 by meson
         have f11: "cpu_reg_val PSR (snd (fst (get_curr_win () s2))) = cpu_reg_val PSR s1"
           using f4 a1 by (simp add: cpu_reg_val_low_equal)
         have f12: "user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))) = 0"
           by (meson user_reg_val_def)
         have "user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))) = 0"
           by (meson user_reg_val_def)
         then have "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))"
           using f12 f9 f7 f5 f3 a1 write_reg_low_equal by fastforce
         then have "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))) \<and> snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))))))) = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (if get_operand_w5 (snd instr ! Suc 0) = 0 then 0 else user_reg (snd (fst (get_curr_win () s2))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))))))) \<and> snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))) = snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (if get_operand_w5 (snd instr ! Suc 0) = 0 then 0 else user_reg (snd (fst (get_curr_win () s2))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))"
           using f11 f10 f9 f8 f7 f6 f5 f3 a1 by (simp add: user_reg_val_def)
         then show "low_equal (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) + get_operand2 (snd instr) s1 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (add_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) + get_operand2 (snd instr) s2 + ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
           using add_instr_sub1_low_equal by blast
       qed      
     qed
   qed
 qed
 
 lemma sub_instr_sub1_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (sub_instr_sub1 instr_name result rs1_val operand2 s1)) \<and> 
 t2 = snd (fst (sub_instr_sub1 instr_name result rs1_val operand2 s2))"
 shows "low_equal t1 t2"
 proof (cases "instr_name = arith_type SUBcc \<or> instr_name = arith_type SUBXcc")
   case True
   then show ?thesis using a1
   apply (simp add: sub_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (clarsimp simp add: cpu_reg_val_low_equal)
   using write_cpu_low_equal by blast
 next
   case False
   then show ?thesis using a1
   apply (simp add: sub_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma sub_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (sub_instr instr s1)) \<and> t2 = snd (fst (sub_instr instr s2))"
 shows "low_equal t1 t2"
 proof -
   have f1: "low_equal s1 s2 \<and>
     t1 = snd (fst (sub_instr_sub1 (fst instr)
                     (if fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc
                      then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s1))) -
                           get_operand2 (snd instr) s1
                      else user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s1))) -
                           get_operand2 (snd instr) s1 -
                           ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1))))))
                     (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s1))))
                     (get_operand2 (snd instr) s1)
                     (snd (fst (write_reg
                                 (if get_operand_w5 (snd instr ! 3) \<noteq> 0
                                  then if fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc
                                       then user_reg_val (fst (fst (get_curr_win () s1)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s1))) -
                                            get_operand2 (snd instr) s1
                                       else user_reg_val (fst (fst (get_curr_win () s1)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s1))) -
                                            get_operand2 (snd instr) s1 -
                                            ucast (get_icc_C
                                                    (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))
                                  else user_reg_val (fst (fst (get_curr_win () s1)))
                                        (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))
                                 (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3))
                                 (snd (fst (get_curr_win () s1)))))))) \<and>
     t2 = snd (fst (sub_instr_sub1 (fst instr)
                     (if fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc
                      then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s2))) -
                           get_operand2 (snd instr) s2
                      else user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                            (snd (fst (get_curr_win () s2))) -
                           get_operand2 (snd instr) s2 -
                           ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))))
                     (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                       (snd (fst (get_curr_win () s2))))
                     (get_operand2 (snd instr) s2)
                     (snd (fst (write_reg
                                 (if get_operand_w5 (snd instr ! 3) \<noteq> 0
                                  then if fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc
                                       then user_reg_val (fst (fst (get_curr_win () s2)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s2))) -
                                            get_operand2 (snd instr) s2
                                       else user_reg_val (fst (fst (get_curr_win () s2)))
                                             (get_operand_w5 (snd instr ! Suc 0))
                                             (snd (fst (get_curr_win () s2))) -
                                            get_operand2 (snd instr) s2 -
                                            ucast (get_icc_C
                                                    (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))
                                  else user_reg_val (fst (fst (get_curr_win () s2)))
                                        (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))
                                 (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
                                 (snd (fst (get_curr_win () s2))))))))"
   using a1 apply (simp add: sub_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (simp add: case_prod_unfold)
   then show ?thesis
   proof (cases "get_operand_w5 (snd instr ! 3) \<noteq> 0")
     case True
     then have f2: "get_operand_w5 (snd instr ! 3) \<noteq> 0" by auto
     then show ?thesis
     proof (cases "fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc")
       case True
       then show ?thesis
       using f1 f2 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         assume a2: "t1 = snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))"
         assume a3: "t2 = snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))))"
         then have f4: "snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))) = t2"
           using a1 by (simp add: get_operand2_low_equal)
         have "\<forall>s. \<not> low_equal (snd (fst (get_curr_win () s1))) s \<or> snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) s - get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))))) = t1"
           using a2 a1 by (simp add: get_curr_win_low_equal user_reg_val_low_equal)
         then show "low_equal (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))) (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))))"
           using f4 a3 a2 a1 by (metis (no_types) get_curr_win2_low_equal sub_instr_sub1_low_equal write_reg_low_equal)
       qed      
     next
       case False
       then show ?thesis
       using f1 f2 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         have f2: "fst (get_curr_win () s1) = (ucast (get_CWP (cpu_reg_val PSR s1)), s1)"
           by (simp add: get_curr_win_def simpler_gets_def)
         have f3: "cpu_reg_val PSR s1 = cpu_reg_val PSR s2"
           using a1 by (meson cpu_reg_val_low_equal)
         then have f4: "user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) = user_reg_val (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! Suc 0)) s1"
           using f2 by simp
         have f5: "\<forall>s sa is. \<not> low_equal (s::'a sparc_state) sa \<or> get_operand2 is s = get_operand2 is sa"
           using get_operand2_low_equal by blast
         then have f6: "sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! Suc 0)) s2) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) = sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))"
           using f4 a1 by (simp add: user_reg_val_low_equal)
         have f7: "fst (get_curr_win () s2) = (ucast (get_CWP (cpu_reg_val PSR s2)), s2)"
           by (simp add: get_curr_win_def simpler_gets_def)
         then have f8: "user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))) = user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))"
           using f5 f2 a1 by (simp add: cpu_reg_val_low_equal user_reg_val_low_equal)
         then have f9: "sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! Suc 0)) s2) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))) = sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
           using f7 by fastforce
         have "write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (ucast (get_CWP (cpu_reg_val PSR s2))) (get_operand_w5 (snd instr ! 3)) s2 = write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))"
           using f8 f7 by simp
         then have "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2))))))"
           using f3 f2 a1 by (metis (no_types) prod.sel(1) prod.sel(2) write_reg_low_equal)
         then show "low_equal (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s1))))))))) (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (get_curr_win () s2)))))))))"
           using f9 f6 by (metis (no_types) sub_instr_sub1_low_equal)
       qed      
     qed
   next
     case False
     then have f3: "\<not> get_operand_w5 (snd instr ! 3) \<noteq> 0" by auto
     then show ?thesis
     proof (cases "fst instr = arith_type SUB \<or> fst instr = arith_type SUBcc")
       case True
       then show ?thesis
       using f1 f3 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         assume "t1 = snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))"
         assume "t2 = snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))"
         have f2: "\<forall>is. get_operand2 is s1 = get_operand2 is s2"
           using a1 get_operand2_low_equal by blast
         have f3: "fst (fst (get_curr_win () s1)) = fst (fst (get_curr_win () s2))"
           using a1 by (meson get_curr_win_low_equal)
         have "\<forall>w wa. user_reg_val wa w (snd (fst (get_curr_win () s1))) = user_reg_val wa w (snd (fst (get_curr_win () s2)))"
           using a1 by (metis (no_types) get_curr_win2_low_equal user_reg_val_low_equal)
         then show "low_equal (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
           using f3 f2 a1 by (metis (no_types) get_curr_win2_low_equal sub_instr_sub1_low_equal write_reg_low_equal)
       qed      
     next
       case False
       then show ?thesis
       using f1 f3 apply clarsimp
       proof -
         assume a1: "low_equal s1 s2"
         have f2: "\<forall>s sa sb w wa wb sc. (\<not> low_equal s sa \<or> sb \<noteq> snd (fst (write_reg w (wa::'a word) wb s)) \<or> sc \<noteq> snd (fst (write_reg w wa wb sa))) \<or> low_equal sb sc"
           by (meson write_reg_low_equal)
         have "((ucast (get_CWP (cpu_reg_val PSR s1)), s1), False) = get_curr_win () s1"
           by (simp add: get_curr_win_def simpler_gets_def)
         then have f3: "ucast (get_CWP (cpu_reg_val PSR s1)) = fst (fst (get_curr_win () s1)) \<and> s1 = snd (fst (get_curr_win () s1))"
           by (metis (no_types) prod.collapse prod.simps(1))
         have "((ucast (get_CWP (cpu_reg_val PSR s2)), s2), False) = get_curr_win () s2"
           by (simp add: get_curr_win_def simpler_gets_def)
         then have f4: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2)) \<and> s2 = snd (fst (get_curr_win () s2))"
           by (metis (no_types) prod.collapse prod.simps(1))
         have f5: "\<forall>s sa sb sc w wa wb sd. (\<not> low_equal (s::'a sparc_state) sa \<or> sb \<noteq> snd (fst (sub_instr_sub1 sc w wa wb s)) \<or> sd \<noteq> snd (fst (sub_instr_sub1 sc w wa wb sa))) \<or> low_equal sb sd"
           by (meson sub_instr_sub1_low_equal)
         have "low_equal (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))"
           using f4 f3 f2 a1 by (simp add: cpu_reg_val_low_equal user_reg_val_low_equal)
         then show "low_equal (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) - get_operand2 (snd instr) s1 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))))) (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) (get_operand2 (snd instr) s1) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (sub_instr_sub1 (fst instr) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) - get_operand2 (snd instr) s2 - ucast (get_icc_C (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))))) (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) (get_operand2 (snd instr) s2) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))))))))"
           using f5 f4 f3 a1 by (simp add: cpu_reg_val_low_equal get_operand2_low_equal user_reg_val_low_equal)
       qed      
     qed
   qed
 qed
 
 lemma mul_instr_sub1_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (mul_instr_sub1 instr_name result s1)) \<and>
 t2 = snd (fst (mul_instr_sub1 instr_name result s2))"
 shows "low_equal t1 t2"
 proof (cases "instr_name \<in> {arith_type SMULcc,arith_type UMULcc}")
   case True
   then show ?thesis using a1
   apply (simp add: mul_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (clarsimp simp add: cpu_reg_val_low_equal)
   using write_cpu_low_equal by blast
 next
   case False
   then show ?thesis using a1
   apply (simp add: mul_instr_sub1_def)
   by (simp add: return_def)
 qed
 
 lemma mul_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (mul_instr instr s1)) \<and> t2 = snd (fst (mul_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: mul_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 proof -
   assume a1: "low_equal s1 s2 \<and> t1 = snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) \<noteq> 0 then ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) else user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))))) \<and> t2 = snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) \<noteq> 0 then ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) else user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))"
   have f2: "\<forall>s sa sb sc w sd. \<not> low_equal (s::'a sparc_state) sa \<or> sb \<noteq> snd (fst (mul_instr_sub1 sc w s)) \<or> sd \<noteq> snd (fst (mul_instr_sub1 sc w sa)) \<or> low_equal sb sd"
     using mul_instr_sub1_low_equal by blast
   have f3: "\<forall>s sa sb w wa wb sc. \<not> low_equal s sa \<or> sb \<noteq> snd (fst (write_reg w (wa::'a word) wb s)) \<or> sc \<noteq> snd (fst (write_reg w wa wb sa)) \<or> low_equal sb sc"
     by (meson write_reg_low_equal)
   have f4: "\<forall>s sa sb w c sc. \<not> low_equal (s::'a sparc_state) sa \<or> sb \<noteq> snd (fst (write_cpu w c s)) \<or> sc \<noteq> snd (fst (write_cpu w c sa)) \<or> low_equal sb sc"
     by (meson write_cpu_low_equal)
   have f5: "low_equal s1 s2 \<and> t1 = snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))))) \<and> t2 = snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))"
     using a1 by presburger
   have f6: "((ucast (get_CWP (cpu_reg_val PSR s1)), s1), False) = (fst (get_curr_win () s1), snd (get_curr_win () s1))"
     by (simp add: get_curr_win_def simpler_gets_def)
   have f7: "fst (fst (get_curr_win () s1)) = fst (fst (get_curr_win () s2))"
     using f5 by (meson get_curr_win_low_equal)
   have "((ucast (get_CWP (cpu_reg_val PSR s2)), s2), False) = (fst (get_curr_win () s2), snd (get_curr_win () s2))"
     by (simp add: get_curr_win_def simpler_gets_def)
   then have f8: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2)) \<and> s2 = snd (fst (get_curr_win () s2))"
     by (metis prod.collapse prod.simps(1))
   then have f9: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
     using f6 f5 by (metis (no_types) prod.collapse prod.simps(1))
   have f10: "\<forall>s sa w wa. \<not> low_equal s sa \<or> user_reg_val (w::'a word) wa s = user_reg_val w wa sa"
     using user_reg_val_low_equal by blast
   have f11: "get_operand2 (snd instr) s1 = get_operand2 (snd instr) (snd (fst (get_curr_win () s2)))"
     using f9 f6 by (metis (no_types) get_operand2_low_equal prod.collapse prod.simps(1))
   then have f12: "uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2) = uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)"
     using f10 f9 f8 f7 by presburger
   then have f13: "(word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) \<noteq> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<or> (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) \<noteq> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) \<or> low_equal (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))"
     using f9 f4 by presburger
   have "get_operand_w5 (snd instr ! 3) = 0 \<and> low_equal (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<longrightarrow> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) = write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))"
     using f10 f7 by force
   then have f14: "get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> low_equal (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))) \<or> \<not> low_equal (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))"
     using f3 by metis 
   then have f15: "low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<or> fst instr \<noteq> arith_type UMULcc \<or> get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) \<noteq> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<or> (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) \<noteq> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))"
     using f13 f12 f2 by fastforce
   have f16: "user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) = user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))"
     using f10 f9 f7 by presburger
   { assume "fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
     moreover
     { assume "\<not> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
       moreover
       { assume "low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<noteq> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
         moreover
         { assume "mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))))) \<noteq> mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))"
           then have "write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<or> fst instr \<noteq> arith_type UMULcc"
             by fastforce }
         moreover
         { assume "mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))) \<noteq> mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))"
           then have "write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<or> fst instr \<noteq> arith_type UMULcc"
             by fastforce }
         ultimately have "write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<or> write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<or> fst instr \<noteq> arith_type UMULcc"
           by force }
       ultimately have "write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<or> write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<or> \<not> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<or> fst instr \<noteq> arith_type UMULcc"
         by fastforce }
     ultimately have "fst instr = arith_type UMULcc \<and> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<and> write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))) = write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) \<and> write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))) = write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))"
       by blast }
   moreover
   { assume "\<not> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
     moreover
     { assume "\<not> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<and> snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))))) = snd (fst (mul_instr_sub1 (arith_type UMULcc) (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))))) \<and> snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))) = snd (fst (mul_instr_sub1 (arith_type UMULcc) (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))"
       then have "\<not> low_equal (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))"
         using f2 by blast
       moreover
       { assume "(if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) \<noteq> (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))))"
         moreover
         { assume "(if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) \<noteq> ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))"
           then have "(if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) = (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
             by (metis f11 f16 f8) }
         ultimately have "(if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) = (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
           by fastforce }
       ultimately have "fst instr = arith_type UMULcc \<and> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) = (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
         using f13 f7 f3 by fastforce }
     moreover
     { assume "mul_instr_sub1 (arith_type UMULcc) (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))) \<noteq> mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))"
       moreover
       { assume "(if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) \<noteq> ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))"
         then have "(if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) = (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
           by (metis f11 f16 f8) }
       ultimately have "fst instr = arith_type UMULcc \<and> (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) = (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1)) else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
         by fastforce }
     ultimately have "fst instr = arith_type UMULcc \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
       using f12 by fastforce }
   moreover
   { assume "write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))) \<noteq> write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))"
     then have "fst instr = arith_type UMULcc \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0"
       by presburger }
   ultimately have "fst instr = arith_type UMULcc \<longrightarrow> get_operand_w5 (snd instr ! 3) = 0 \<or> get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))"
     by force
   moreover
   { assume "fst instr \<noteq> arith_type UMULcc"
     { assume "fst instr \<noteq> arith_type UMULcc \<and> low_equal (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))"
       moreover
       { assume "fst instr \<noteq> arith_type UMULcc \<and> low_equal (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1))))))))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))) \<and> snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))) = snd (fst (mul_instr_sub1 (arith_type UMUL) (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))"
         then have "(fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> fst instr \<noteq> arith_type UMUL \<and> fst instr \<noteq> arith_type UMULcc \<or> (get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<or> get_operand_w5 (snd instr ! 3) = 0"
           using f2 by presburger }
       ultimately have "fst instr \<noteq> arith_type UMULcc \<and> (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) \<noteq> ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) \<or> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> fst instr \<noteq> arith_type UMUL \<and> fst instr \<noteq> arith_type UMULcc \<or> (get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<or> get_operand_w5 (snd instr ! 3) = 0"
         by fastforce }
     then have "(get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<or> get_operand_w5 (snd instr ! 3) = 0"
       using f16 f11 f9 f8 f7 f4 f3 f2 by force }
   moreover
   { assume "get_operand_w5 (snd instr ! 3) = 0"
     moreover
     { assume "(fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0"
       moreover
       { assume "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> \<not> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
         moreover
         { assume "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<noteq> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))"
           then have "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> arith_type UMUL \<noteq> arith_type UMULcc \<or> fst instr \<noteq> arith_type UMULcc \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0"
             by fastforce
           then have "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<or> fst instr \<noteq> arith_type UMULcc \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0"
             by force }
         ultimately have "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<or> ((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> \<not> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<or> fst instr \<noteq> arith_type UMULcc \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0"
           by simp }
       ultimately have "((fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0) \<and> \<not> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1)))) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (snd (fst (write_reg (if get_operand_w5 (snd instr ! 3) = 0 then user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))) else ucast (if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((if fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc then word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64 else word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))) \<or> fst instr \<noteq> arith_type UMULcc \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0 \<or> (get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<and> (get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))))"
         by auto
       then have "fst instr \<noteq> arith_type UMULcc \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc) \<and> get_operand_w5 (snd instr ! 3) = 0 \<or> (get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<and> (get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))))"
         using f15 by presburger
       then have "(get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<and> (get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))))"
         using f14 f13 f12 f2 by force }
     ultimately have "(get_operand_w5 (snd instr ! 3) = 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<and> (get_operand_w5 (snd instr ! 3) \<noteq> 0 \<or> (fst instr \<noteq> arith_type UMUL \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMUL \<or> fst instr = arith_type UMULcc \<or> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))))"
       using f16 f14 f11 f9 f8 f4 f2 by fastforce }
   ultimately show "(get_operand_w5 (snd instr ! 3) \<noteq> 0 \<longrightarrow> (fst instr = arith_type UMUL \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMULcc \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMUL \<and> fst instr \<noteq> arith_type UMULcc \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3)) (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2)))))))))))))) \<and> (get_operand_w5 (snd instr ! 3) = 0 \<longrightarrow> (fst instr = arith_type UMUL \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMUL) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr = arith_type UMULcc \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * uint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (arith_type UMULcc) (ucast (word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (uint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * uint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))) \<and> (fst instr \<noteq> arith_type UMUL \<and> fst instr \<noteq> arith_type UMULcc \<longrightarrow> low_equal (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1))))))) (fst (fst (get_curr_win () s1))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s1))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))) * sint (get_operand2 (snd instr) s1))::word64) >> 32)) Y (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (mul_instr_sub1 (fst instr) (ucast (word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64)) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (write_cpu (ucast ((word_of_int (sint (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))) * sint (get_operand2 (snd instr) s2))::word64) >> 32)) Y (snd (fst (get_curr_win () s2))))))))))))))"
     by blast
 qed
 
 lemma div_write_new_val_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (div_write_new_val i result temp_V s1)) \<and>
 t2 = snd (fst (div_write_new_val i result temp_V s2))"
 shows "low_equal t1 t2"
 proof (cases "(fst i) \<in> {arith_type UDIVcc,arith_type SDIVcc}")
   case True
   then show ?thesis using a1
   apply (simp add: div_write_new_val_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (clarsimp simp add: cpu_reg_val_low_equal)
   using write_cpu_low_equal by blast
 next
   case False
   then show ?thesis using a1
   apply (simp add: div_write_new_val_def)
   by (simp add: return_def)
 qed
 
 lemma div_comp_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (div_comp instr rs1 rd operand2 s1)) \<and>
 t2 = snd (fst (div_comp instr rs1 rd operand2 s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: div_comp_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (clarsimp simp add: get_curr_win_low_equal)
 proof -
   assume a1: "low_equal s1 s2"
   have f2: "\<forall>s sa sb w wa wb sc. \<not> low_equal s sa \<or> sb \<noteq> snd (fst (write_reg w (wa::'a word) wb s)) \<or> sc \<noteq> snd (fst (write_reg w wa wb sa)) \<or> low_equal sb sc"
     by (meson write_reg_low_equal)
   have f3: "gets (\<lambda>s. ucast (get_CWP (cpu_reg_val PSR s))::'a word) = get_curr_win ()"
     by (simp add: get_curr_win_def)
   then have "((ucast (get_CWP (cpu_reg_val PSR s1)), s1), False) = (fst (get_curr_win () s1), snd (get_curr_win () s1))"
     by (metis (no_types) prod.collapse simpler_gets_def)
   then have f4: "ucast (get_CWP (cpu_reg_val PSR s1)) = fst (fst (get_curr_win () s1)) \<and> s1 = snd (fst (get_curr_win () s1))"
     by (metis prod.collapse prod.simps(1))
   have "((ucast (get_CWP (cpu_reg_val PSR s2)), s2), False) = (fst (get_curr_win () s2), snd (get_curr_win () s2))"
     using f3 by (metis (no_types) prod.collapse simpler_gets_def)
   then have f5: "ucast (get_CWP (cpu_reg_val PSR s2)) = fst (fst (get_curr_win () s2)) \<and> s2 = snd (fst (get_curr_win () s2))"
     by (metis (no_types) prod.collapse prod.simps(1))
   then have f6: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
     using f4 a1 by presburger
   have f7: "\<forall>s sa sb p w wa sc. \<not> low_equal (s::'a sparc_state) sa \<or> sb \<noteq> snd (fst (div_write_new_val p w wa s)) \<or> sc \<noteq> snd (fst (div_write_new_val p w wa sa)) \<or> low_equal sb sc"
     by (meson div_write_new_val_low_equal)
   have f8: "cpu_reg_val PSR s2 = cpu_reg_val PSR s1"
     using a1 by (simp add: cpu_reg_val_def low_equal_def)
   then have "fst (fst (get_curr_win () s2)) = ucast (get_CWP (cpu_reg_val PSR s1))"
     using f5 by presburger
   then have f9: "fst (fst (get_curr_win () s2)) = fst (fst (get_curr_win () s1))"
     using f4 by presburger
   have f10: "fst (fst (get_curr_win () s1)) = fst (fst (get_curr_win () s2))"
     using f8 f5 f4 by presburger
   have f11: "(word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))::word64) = word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))"
     using f5 f4 a1 by (metis (no_types) cpu_reg_val_def low_equal_def user_reg_val_low_equal)
   have f12: "ucast (get_CWP (cpu_reg_val PSR s1)) = fst (fst (get_curr_win () s2))"
     using f8 f5 by presburger
   then have "rd = 0 \<longrightarrow> (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) = user_reg_val (ucast (get_CWP (cpu_reg_val PSR s1))) 0 (snd (fst (get_curr_win () s1)))"
     using f6 user_reg_val_low_equal by fastforce
   then have f13: "rd = 0 \<longrightarrow> write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) 0 (snd (fst (get_curr_win () s1))) = write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1)))"
     using f12 f10 by presburger
   have f14: "write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) rd (snd (fst (get_curr_win () s2))) = write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))"
     using f12 f11 by auto
   have "write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) rd (snd (fst (get_curr_win () s1))) = write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))) \<and> write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) rd (snd (fst (get_curr_win () s2))) = write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) \<longrightarrow> low_equal (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))))))"
     using f6 f2 by metis
   moreover
   { assume "low_equal (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))))))"
     then have "low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))"
       using f11 f9 f7 by metis 
     moreover
     { assume "low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))))))))) \<noteq> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))"
       then have "div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2) = (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) \<longrightarrow> rd = 0"
         by fastforce }
     ultimately have "div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2) = (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) \<longrightarrow> rd = 0 \<or> (rd \<noteq> 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))) \<and> (rd = 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))))"
       by fastforce }
   moreover
   { assume "write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) rd (snd (fst (get_curr_win () s1))) \<noteq> write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1)))"
     then have "div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2) \<noteq> (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2))"
       using f12 f9 by fastforce }
   moreover
   { assume "write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (ucast (get_CWP (cpu_reg_val PSR s1))) rd (snd (fst (get_curr_win () s2))) \<noteq> write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))"
     then have "rd = 0"
       using f14 by presburger }
   moreover
   { assume "rd = 0"
     then have "rd = 0 \<and> low_equal (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))))))"
       using f13 f12 f6 f2 by metis 
     then have "rd = 0 \<and> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s1))) rd (snd (fst (get_curr_win () s1))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s1))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (if rd = 0 then user_reg_val (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2))) else div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))"
       using f11 f9 f7 by metis 
     then have "(rd \<noteq> 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))) \<and> (rd = 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))))"
       using f10 by fastforce }
   ultimately show "(rd \<noteq> 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (fst (fst (get_curr_win () s2))) rd (snd (fst (get_curr_win () s2)))))))))) \<and> (rd = 0 \<longrightarrow> low_equal (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s1))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s1))))))))) (snd (fst (div_write_new_val instr (div_comp_result instr (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2)) (div_comp_temp_V instr (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 32)) (ucast (div_comp_temp_64bit instr (word_cat (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (user_reg_val (fst (fst (get_curr_win () s2))) rs1 (snd (fst (get_curr_win () s2))))) operand2 >> 31))) (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0 (snd (fst (get_curr_win () s2))))))))))"
     using f9 by fastforce
 qed
 
 lemma div_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (div_instr instr s1)) \<and> t2 = snd (fst (div_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: div_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp add: return_def)
 apply (auto simp add: get_operand2_low_equal)
  apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
  apply (auto simp add: traps_low_equal)
  apply (blast intro: mod_trap_low_equal)
 using div_comp_low_equal by blast
 
 lemma get_curr_win_traps_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "low_equal
 (snd (fst (get_curr_win () s1))
   \<lparr>traps := insert some_trap (traps (snd (fst (get_curr_win () s1))))\<rparr>)
 (snd (fst (get_curr_win () s2))
   \<lparr>traps := insert some_trap (traps (snd (fst (get_curr_win () s2))))\<rparr>)"
 proof -
   from a1 have f1: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
     using get_curr_win2_low_equal by auto
   then have f2: "(traps (snd (fst (get_curr_win () s1)))) = 
     (traps (snd (fst (get_curr_win () s2))))"
     using traps_low_equal by auto
   then show ?thesis using f1 f2 mod_trap_low_equal
   by fastforce
 qed
 
 lemma save_restore_instr_sub1_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (save_retore_sub1 result new_cwp rd s1)) \<and> 
 t2 = snd (fst (save_retore_sub1 result new_cwp rd s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: save_retore_sub1_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (auto simp add: cpu_reg_val_low_equal)
 using write_cpu_low_equal write_reg_low_equal
 by fastforce
 
 lemma get_WIM_bit_low_equal: 
 assumes a1: "low_equal s1 s2"
 shows "get_WIM_bit (unat (((word_of_int ((uint (fst (fst (get_curr_win () s1))) - 1) mod NWINDOWS)))::word5))
  (cpu_reg_val WIM (snd (fst (get_curr_win () s1)))) =
 get_WIM_bit (unat (((word_of_int ((uint (fst (fst (get_curr_win () s2))) -1) mod NWINDOWS)))::word5))
   (cpu_reg_val WIM (snd (fst (get_curr_win () s2))))"
 proof -
   from a1 have f1: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
   using get_curr_win2_low_equal by blast
   then have f2: "(cpu_reg_val WIM (snd (fst (get_curr_win () s1)))) =
     (cpu_reg_val WIM (snd (fst (get_curr_win () s2))))"
   using cpu_reg_val_low_equal by auto
   from a1 have "(fst (fst (get_curr_win () s1))) = (fst (fst (get_curr_win () s2)))"
   using get_curr_win_low_equal by auto
   then show ?thesis using f1 f2
   by auto 
 qed
 
 lemma get_WIM_bit_low_equal2: 
 assumes a1: "low_equal s1 s2"
 shows "get_WIM_bit (unat (((word_of_int ((uint (fst (fst (get_curr_win () s1))) + 1) mod NWINDOWS)))::word5))
  (cpu_reg_val WIM (snd (fst (get_curr_win () s1)))) =
 get_WIM_bit (unat (((word_of_int ((uint (fst (fst (get_curr_win () s2))) + 1) mod NWINDOWS)))::word5))
   (cpu_reg_val WIM (snd (fst (get_curr_win () s2))))"
 proof -
   from a1 have f1: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
   using get_curr_win2_low_equal by blast
   then have f2: "(cpu_reg_val WIM (snd (fst (get_curr_win () s1)))) =
     (cpu_reg_val WIM (snd (fst (get_curr_win () s2))))"
   using cpu_reg_val_low_equal by auto
   from a1 have "(fst (fst (get_curr_win () s1))) = (fst (fst (get_curr_win () s2)))"
   using get_curr_win_low_equal by auto
   then show ?thesis using f1 f2
   by auto 
 qed
 
 lemma save_restore_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (save_restore_instr instr s1)) \<and> t2 = snd (fst (save_restore_instr instr s2))"
 shows "low_equal t1 t2"
 proof (cases "fst instr = ctrl_type SAVE")
   case True
   then have f1: "fst instr = ctrl_type SAVE" by auto
   then show ?thesis using a1
   apply (simp add: save_restore_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply auto
      apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
      apply (simp add: get_curr_win_traps_low_equal)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply (simp add: get_WIM_bit_low_equal)
    apply (simp add: get_WIM_bit_low_equal)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: get_curr_win_low_equal)
   using get_curr_win2_low_equal save_restore_instr_sub1_low_equal get_addr2_low_equal
   by metis 
 next
   case False
   then show ?thesis using a1
   apply (simp add: save_restore_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply auto
      apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
      apply (simp add: get_curr_win_traps_low_equal)
     apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
     apply (simp add: get_WIM_bit_low_equal2)
    apply (simp add: get_WIM_bit_low_equal2)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: get_curr_win_low_equal)
   using get_curr_win2_low_equal save_restore_instr_sub1_low_equal get_addr2_low_equal
   by metis 
 qed
 
 lemma call_instr_low_equal: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (call_instr instr s1)) \<and> t2 = snd (fst (call_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: call_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (auto simp add: get_curr_win_low_equal)
 using cpu_reg_val_low_equal get_curr_win2_low_equal
 write_cpu_low_equal write_reg_low_equal
 proof -
   assume a1: "low_equal s1 s2"
   assume "t1 = snd (fst (write_cpu (cpu_reg_val PC (snd (fst (get_curr_win () s1))) + (ucast (get_operand_w30 (snd instr ! 0)) << 2)) nPC (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (get_curr_win () s1)))) PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 15 (snd (fst (get_curr_win () s1)))))))))))"
   assume "t2 = snd (fst (write_cpu (cpu_reg_val PC (snd (fst (get_curr_win () s2))) + (ucast (get_operand_w30 (snd instr ! 0)) << 2)) nPC (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (get_curr_win () s2)))) PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 15 (snd (fst (get_curr_win () s2)))))))))))"
   have "\<forall>c. cpu_reg_val c (snd (fst (get_curr_win () s1))) = cpu_reg_val c (snd (fst (get_curr_win () s2)))"
     using a1 by (meson cpu_reg_val_low_equal get_curr_win2_low_equal)
   then show "low_equal (snd (fst (write_cpu (cpu_reg_val PC (snd (fst (get_curr_win () s1))) + (ucast (get_operand_w30 (snd instr ! 0)) << 2)) nPC (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (get_curr_win () s1)))) PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 15 (snd (fst (get_curr_win () s1)))))))))))) (snd (fst (write_cpu (cpu_reg_val PC (snd (fst (get_curr_win () s2))) + (ucast (get_operand_w30 (snd instr ! 0)) << 2)) nPC (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (get_curr_win () s2)))) PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 15 (snd (fst (get_curr_win () s2))))))))))))"
     using a1 by (metis (no_types) get_curr_win2_low_equal write_cpu_low_equal write_reg_low_equal)
 qed
 
 lemma jmpl_instr_low_equal_sub1: 
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (write_cpu (get_addr (snd instr) (snd (fst (get_curr_win () s2)))) nPC
   (snd (fst (write_cpu (cpu_reg_val nPC 
   (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
   (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
   (snd (fst (get_curr_win () s1)))))))
   PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
   (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
   (snd (fst (get_curr_win () s1))))))))))) \<and>
 t2 = snd (fst (write_cpu (get_addr (snd instr) (snd (fst (get_curr_win () s2)))) nPC
   (snd (fst (write_cpu (cpu_reg_val nPC
   (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
   (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
   (snd (fst (get_curr_win () s2)))))))
   PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
   (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
   (snd (fst (get_curr_win () s2)))))))))))"
 shows "low_equal t1 t2"
 proof -
   from a1 have f1: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
   using get_curr_win2_low_equal by blast
   then have f2: "(cpu_reg_val PC (snd (fst (get_curr_win () s1)))) =
     (cpu_reg_val PC (snd (fst (get_curr_win () s2))))"
   using cpu_reg_val_low_equal by blast
   then have f3: "low_equal 
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s1))))))
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s2))))))"
   using f1 write_reg_low_equal by fastforce
   then have "(cpu_reg_val nPC 
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s1))))))) =
     (cpu_reg_val nPC
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s2)))))))"
   using cpu_reg_val_low_equal by auto
   then have f4: "low_equal
     (snd (fst (write_cpu (cpu_reg_val nPC 
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s1)))))))
     PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s1))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s1)))))))))
     (snd (fst (write_cpu (cpu_reg_val nPC
     (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s2)))))))
     PC (snd (fst (write_reg (cpu_reg_val PC (snd (fst (get_curr_win () s2))))
     (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! 3))
     (snd (fst (get_curr_win () s2)))))))))"
   using f3 write_cpu_low_equal by fastforce
   then show ?thesis using write_cpu_low_equal
   using assms by blast  
 qed
 
 lemma jmpl_instr_low_equal_sub2:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (write_cpu (get_addr (snd instr) (snd (fst (get_curr_win () s2)))) nPC
   (snd (fst (write_cpu (cpu_reg_val nPC
   (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s1))))))) PC (snd (fst (write_reg
   (user_reg_val (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s1))))))))))) \<and>
 t2 = snd (fst (write_cpu (get_addr (snd instr) (snd (fst (get_curr_win () s2)))) nPC
   (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (write_reg
   (user_reg_val (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s2))))))) PC (snd (fst (write_reg
   (user_reg_val (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
   (snd (fst (get_curr_win () s2)))))))))))"
 shows "low_equal t1 t2"
 proof -
   from a1 have f1: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
   using get_curr_win2_low_equal by blast
   then have f2: "(user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))) = 
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2))))"
   using user_reg_val_low_equal by blast
   then have f3: "low_equal 
     (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1))))))
     (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2))))))"
   using f1 write_reg_low_equal by fastforce
   then have "(cpu_reg_val nPC
     (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1))))))) = 
     (cpu_reg_val nPC (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))))))"
   using cpu_reg_val_low_equal by blast
   then have "low_equal 
     (snd (fst (write_cpu (cpu_reg_val nPC
     (snd (fst (write_reg (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1))))))) PC (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s1)))))))))
     (snd (fst (write_cpu (cpu_reg_val nPC (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2))))))) PC (snd (fst (write_reg
     (user_reg_val (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) 0
     (snd (fst (get_curr_win () s2)))))))))"
   using f1 f2 f3 write_cpu_low_equal by fastforce
   then show ?thesis 
   using write_cpu_low_equal
   using assms by blast 
 qed
 
 lemma jmpl_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (jmpl_instr instr s1)) \<and> t2 = snd (fst (jmpl_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: jmpl_instr_def)
 apply (simp add: Let_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply auto
    apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
    apply (simp add: get_curr_win_traps_low_equal)
   apply (simp add: get_addr2_low_equal)
  apply (simp add: get_addr2_low_equal)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (simp_all add: get_addr2_low_equal)
 apply (simp_all add: get_curr_win_low_equal)
 apply (case_tac "get_operand_w5 (snd instr ! 3) \<noteq> 0")
 apply auto
  using jmpl_instr_low_equal_sub1 apply blast
 apply (simp_all add: get_curr_win_low_equal)
 using jmpl_instr_low_equal_sub2 by blast
 
 lemma rett_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 \<not> snd (rett_instr instr s1) \<and>
 \<not> snd (rett_instr instr s2) \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 t1 = snd (fst (rett_instr instr s1)) \<and> t2 = snd (fst (rett_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: rett_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
 apply auto
    apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
    apply (simp add: return_def)
    using mod_trap_low_equal traps_low_equal apply fastforce
   using cpu_reg_val_low_equal apply fastforce
  using cpu_reg_val_low_equal apply fastforce
 apply (simp add: bind_def h1_def h2_def Let_def)
 by (simp add: case_prod_unfold fail_def)
 
 lemma read_state_reg_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 t1 = snd (fst (read_state_reg_instr instr s1)) \<and> 
 t2 = snd (fst (read_state_reg_instr instr s2))"
 shows "low_equal t1 t2"
 proof (cases "(fst instr \<in> {sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR} \<or> 
         (fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 ((snd instr)!0))))")
   case True   
   then have "(fst instr \<in> {sreg_type RDPSR,sreg_type RDWIM,sreg_type RDTBR} \<or> 
         (fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 ((snd instr)!0))))
-        \<and> ((ucast (get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s1))))))::word1) = 0
-        \<and> ((ucast (get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))))::word1) = 0"
+        \<and> (((get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s1))))))::word1) = 0
+        \<and> (((get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))))::word1) = 0"
     by (metis assms get_curr_win_privilege)
   then show ?thesis using a1
   apply (simp add: read_state_reg_instr_def)
   apply (simp add: Let_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (simp add: case_prod_unfold)
   apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
   apply clarsimp
   using get_curr_win_traps_low_equal
   by auto  
 next
   case False
   then have f1: "\<not>((fst instr = sreg_type RDPSR \<or>
                     fst instr = sreg_type RDWIM \<or>
                     fst instr = sreg_type RDTBR \<or>
                     fst instr = sreg_type RDASR \<and> privileged_ASR (get_operand_w5 (snd instr ! 0))))"
     by blast 
   then show ?thesis 
   proof (cases "illegal_instruction_ASR (get_operand_w5 ((snd instr)!0))")
     case True
     then show ?thesis using a1 f1
     apply read_state_reg_instr_privilege_proof
     by (simp add: illegal_instruction_ASR_def)    
   next
     case False
     then have f2: "\<not>(illegal_instruction_ASR (get_operand_w5 ((snd instr)!0)))" 
       by auto
     then show ?thesis 
     proof (cases "(get_operand_w5 ((snd instr)!1)) \<noteq> 0")
       case True
       then have f3: "(get_operand_w5 ((snd instr)!1)) \<noteq> 0" 
         by auto
       then show ?thesis 
       proof (cases "fst instr = sreg_type RDY")
         case True
         then show ?thesis using a1 f1 f2 f3
         apply (simp add: read_state_reg_instr_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         apply (auto simp add: get_curr_win_low_equal)
         using cpu_reg_val_low_equal get_curr_win2_low_equal write_reg_low_equal
         proof -
           assume "low_equal s1 s2"
           then have "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
             by (meson get_curr_win2_low_equal)
           then show "low_equal (snd (fst (write_reg (cpu_reg_val Y (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (cpu_reg_val Y (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))))))"
             using cpu_reg_val_low_equal write_reg_low_equal by fastforce
         qed
       next
         case False
         then have f4: "\<not>(fst instr = sreg_type RDY)" by auto
         then show ?thesis 
         proof (cases "fst instr = sreg_type RDASR")
           case True
           then show ?thesis using a1 f1 f2 f3 f4
           apply read_state_reg_instr_privilege_proof
           apply (clarsimp simp add: get_curr_win_low_equal)
           using cpu_reg_val_low_equal get_curr_win2_low_equal write_reg_low_equal
           proof -
             assume a1: "low_equal s1 s2"
             then have "cpu_reg_val (ASR (get_operand_w5 (snd instr ! 0))) (snd (fst (get_curr_win () s1))) = cpu_reg_val (ASR (get_operand_w5 (snd instr ! 0))) (snd (fst (get_curr_win () s2)))"
               by (meson cpu_reg_val_low_equal get_curr_win2_low_equal)
             then show "low_equal (snd (fst (write_reg (cpu_reg_val (ASR (get_operand_w5 (snd instr ! 0))) (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (cpu_reg_val (ASR (get_operand_w5 (snd instr ! 0))) (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))))))"
               using a1 by (metis (no_types) get_curr_win2_low_equal write_reg_low_equal)
           qed
         next
           case False
           then have f5: "\<not>(fst instr = sreg_type RDASR)" by auto
           then show ?thesis using a1 f1 f2 f3 f4 f5
           apply read_state_reg_instr_privilege_proof
           apply (clarsimp simp add: get_curr_win_low_equal)
           using cpu_reg_val_low_equal get_curr_win2_low_equal write_reg_low_equal
           proof -
             assume a1: "low_equal s1 s2"
             assume a2: "t1 = snd (fst (write_reg (cpu_reg_val TBR (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))))"
             assume "t2 = snd (fst (write_reg (cpu_reg_val TBR (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2)))))"
             have "\<forall>s. \<not> low_equal (snd (fst (get_curr_win () s1))) s \<or> snd (fst (write_reg (cpu_reg_val TBR s) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))))) = t1"
               using a2 by (simp add: cpu_reg_val_low_equal)
             then show "low_equal (snd (fst (write_reg (cpu_reg_val TBR (snd (fst (get_curr_win () s1)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1)))))) (snd (fst (write_reg (cpu_reg_val TBR (snd (fst (get_curr_win () s2)))) (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))))))"
               using a2 a1 by (metis (no_types) get_curr_win2_low_equal write_reg_low_equal)
           qed
         qed
       qed
     next
       case False
       then show ?thesis using a1 f1 f2
       apply (simp add: read_state_reg_instr_def)
       apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
       apply (simp add: return_def) 
       apply clarsimp
       apply (simp add: case_prod_unfold)
       using get_curr_win2_low_equal by auto
     qed
   qed
 qed
 
 lemma get_s_get_curr_win:
 assumes a1: "low_equal s1 s2"
 shows "get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))) =
 get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2))))"
 proof - 
   from a1 have "low_equal (snd (fst (get_curr_win () s1))) 
     (snd (fst (get_curr_win () s2)))"
   using get_curr_win2_low_equal by blast
   then show ?thesis
   using cpu_reg_val_low_equal
   by fastforce  
 qed
 
 lemma write_state_reg_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 t1 = snd (fst (write_state_reg_instr instr s1)) \<and>
 t2 = snd (fst (write_state_reg_instr instr s2))"
 shows "low_equal t1 t2"
 proof (cases "fst instr = sreg_type WRY")
   case True
   then show ?thesis using a1
   apply write_state_reg_instr_privilege_proof
   apply (simp add: simpler_modify_def)
   apply (simp add: delayed_pool_add_def DELAYNUM_def)
   apply (auto simp add: get_curr_win_low_equal)
   using get_curr_win2_low_equal cpu_reg_mod_low_equal
   user_reg_val_low_equal get_operand2_low_equal
   proof -
     assume a1: "low_equal s1 s2"
     assume "t2 = cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s2)))) Y (snd (fst (get_curr_win () s2)))"
     assume "t1 = cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s1)))) Y (snd (fst (get_curr_win () s1)))"
     have f2: "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
       using a1 by (meson get_curr_win2_low_equal)
     then have f3: "\<And>w wa. user_reg_val w wa (snd (fst (get_curr_win () s2))) = user_reg_val w wa (snd (fst (get_curr_win () s1)))"
       by (simp add: user_reg_val_low_equal)
     have "\<And>is. get_operand2 is (snd (fst (get_curr_win () s2))) = get_operand2 is (snd (fst (get_curr_win () s1)))"
       using f2 by (simp add: get_operand2_low_equal)
     then show "low_equal (cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s1)))) Y (snd (fst (get_curr_win () s1)))) (cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s2)))) Y (snd (fst (get_curr_win () s2))))"
       using f3 f2 by (metis cpu_reg_mod_low_equal)
   qed
 next
   case False
   then have f1: "\<not>(fst instr = sreg_type WRY)" by auto
   then show ?thesis
   proof (cases "fst instr = sreg_type WRASR")
     case True
     then have f1_1: "fst instr = sreg_type WRASR" by auto
     then show ?thesis
     proof (cases "privileged_ASR (get_operand_w5 (snd instr ! 3)) \<and>
                   get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))) = 0")
       case True
       then show ?thesis using a1 f1 f1_1
       apply write_state_reg_instr_privilege_proof
       apply (clarsimp simp add: get_s_get_curr_win)
       apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
       apply (clarsimp simp add: get_curr_win3_low_equal)
       using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
       by fastforce
     next
       case False
       then have f1_2: "\<not> (privileged_ASR (get_operand_w5 (snd instr ! 3)) \<and>
       get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))) = 0)"
       by auto
       then show ?thesis
       proof (cases "illegal_instruction_ASR (get_operand_w5 (snd instr ! 3))")
         case True
         then show ?thesis using a1 f1 f1_1 f1_2
         apply write_state_reg_instr_privilege_proof
         apply (clarsimp simp add: get_s_get_curr_win)
         apply auto
          apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
          apply (clarsimp simp add: get_curr_win3_low_equal)
          using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
          apply fastforce
         apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
         apply (clarsimp simp add: get_curr_win3_low_equal)
         using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
         by fastforce
       next
         case False
         then show ?thesis using a1 f1 f1_1 f1_2
         apply write_state_reg_instr_privilege_proof
         apply (clarsimp simp add: get_s_get_curr_win)
         apply auto
          apply (simp add: simpler_modify_def)
          apply (simp add: delayed_pool_add_def DELAYNUM_def)
          apply (auto simp add: get_curr_win_low_equal)      
          using get_curr_win2_low_equal cpu_reg_mod_low_equal
          user_reg_val_low_equal get_operand2_low_equal
          proof -
            assume a1: "low_equal s1 s2"
            assume "t2 = cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s2)))) (ASR (get_operand_w5 (snd instr ! 3))) (snd (fst (get_curr_win () s2)))"
            assume "t1 = cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s1)))) (ASR (get_operand_w5 (snd instr ! 3))) (snd (fst (get_curr_win () s1)))"
            have "low_equal (snd (fst (get_curr_win () s1))) (snd (fst (get_curr_win () s2)))"
             using a1 by (meson get_curr_win2_low_equal)
            then show "low_equal (cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s1))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s1)))) (ASR (get_operand_w5 (snd instr ! 3))) (snd (fst (get_curr_win () s1)))) (cpu_reg_mod (user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0)) (snd (fst (get_curr_win () s2))) XOR get_operand2 (snd instr) (snd (fst (get_curr_win () s2)))) (ASR (get_operand_w5 (snd instr ! 3))) (snd (fst (get_curr_win () s2))))"
             using cpu_reg_mod_low_equal get_operand2_low_equal user_reg_val_low_equal by fastforce
          next
            assume f1: "\<not> illegal_instruction_ASR (get_operand_w5 (snd instr ! 3))"
            assume f2: "fst instr = sreg_type WRASR"
            assume f3: "snd (fst (write_state_reg_instr instr s1)) =
     snd (fst (modify
                (delayed_pool_add
                  (DELAYNUM,
                   user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s1))) XOR
                   get_operand2 (snd instr) (snd (fst (get_curr_win () s1))),
                   ASR (get_operand_w5 (snd instr ! 3))))
                (snd (fst (get_curr_win () s1))))) "
            assume f4: "snd (fst (write_state_reg_instr instr s2)) =
     snd (fst (modify
                (delayed_pool_add
                  (DELAYNUM,
                   user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                    (snd (fst (get_curr_win () s2))) XOR
                   get_operand2 (snd instr) (snd (fst (get_curr_win () s2))),
                   ASR (get_operand_w5 (snd instr ! 3))))
                (snd (fst (get_curr_win () s2)))))"
            assume f5: "low_equal s1 s2"
-           assume f6: "ucast (get_S (cpu_reg_val PSR s1)) = 0"
-           assume f7: "ucast (get_S (cpu_reg_val PSR s2)) = 0"
+           assume f6: "(get_S (cpu_reg_val PSR s1)) = 0"
+           assume f7: "(get_S (cpu_reg_val PSR s2)) = 0"
            assume f8: "t1 = snd (fst (modify
                     (delayed_pool_add
                       (DELAYNUM,
                        user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                         (snd (fst (get_curr_win () s1))) XOR
                        get_operand2 (snd instr) (snd (fst (get_curr_win () s1))),
                        ASR (get_operand_w5 (snd instr ! 3))))
                     (snd (fst (get_curr_win () s1)))))"
            assume f9: "t2 = snd (fst (modify
                     (delayed_pool_add
                       (DELAYNUM,
                        user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                         (snd (fst (get_curr_win () s2))) XOR
                        get_operand2 (snd instr) (snd (fst (get_curr_win () s2))),
                        ASR (get_operand_w5 (snd instr ! 3))))
                     (snd (fst (get_curr_win () s2)))))"
            assume f10: "get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))) \<noteq> 0"
            assume f11: "(\<And>s1 s2 t1 t2.
             low_equal s1 s2 \<Longrightarrow>
             t1 = snd (fst (get_curr_win () s1)) \<Longrightarrow> t2 = snd (fst (get_curr_win () s2)) \<Longrightarrow> low_equal t1 t2)"
            assume f12: "(\<And>s1 s2 t1 w cr t2.
             low_equal s1 s2 \<and> t1 = cpu_reg_mod w cr s1 \<and> t2 = cpu_reg_mod w cr s2 \<Longrightarrow> low_equal t1 t2)"
            assume f13: "(\<And>s1 s2 win ur. low_equal s1 s2 \<Longrightarrow> user_reg_val win ur s1 = user_reg_val win ur s2)"
            assume f14: "(\<And>s1 s2 op_list. low_equal s1 s2 \<Longrightarrow> get_operand2 op_list s1 = get_operand2 op_list s2)"
            show "low_equal
      (snd (fst (modify
                  (delayed_pool_add
                    (DELAYNUM,
                     user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                      (snd (fst (get_curr_win () s1))) XOR
                     get_operand2 (snd instr) (snd (fst (get_curr_win () s1))),
                     ASR (get_operand_w5 (snd instr ! 3))))
                  (snd (fst (get_curr_win () s1))))))
      (snd (fst (modify
                  (delayed_pool_add
                    (DELAYNUM,
                     user_reg_val (fst (fst (get_curr_win () s2))) (get_operand_w5 (snd instr ! Suc 0))
                      (snd (fst (get_curr_win () s2))) XOR
                     get_operand2 (snd instr) (snd (fst (get_curr_win () s2))),
                     ASR (get_operand_w5 (snd instr ! 3))))
                  (snd (fst (get_curr_win () s2))))))"
            using f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14
            using Sparc_Properties.ucast_0 assms get_curr_win_privilege by blast            
          qed
       qed
     qed
   next
     case False
     then have f2: "\<not>(fst instr = sreg_type WRASR)" by auto
     have f3: "get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s1)))) = 0 \<and>
       get_S (cpu_reg_val PSR (snd (fst (get_curr_win () s2)))) = 0"
       using get_curr_win_privilege a1 by (metis ucast_id)
     then show ?thesis 
     proof (cases "fst instr = sreg_type WRPSR")
       case True
       then show ?thesis using a1 f1 f2 f3
       apply write_state_reg_instr_privilege_proof
       apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
       apply (clarsimp simp add: get_curr_win3_low_equal)
       using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
       by fastforce      
     next
       case False
       then have f4: "\<not>(fst instr = sreg_type WRPSR)" by auto
       then show ?thesis 
       proof (cases "fst instr = sreg_type WRWIM")  
         case True
         then show ?thesis using a1 f1 f2 f3 f4
         apply write_state_reg_instr_privilege_proof
         apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
         apply (clarsimp simp add: get_curr_win3_low_equal)
         using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
         by fastforce 
       next
         case False
         then have f5: "\<not>(fst instr = sreg_type WRWIM)" by auto
         then show ?thesis using a1 f1 f2 f3 f4 f5
         apply write_state_reg_instr_privilege_proof
         apply (simp add: raise_trap_def add_trap_set_def simpler_modify_def)
         apply (clarsimp simp add: get_curr_win3_low_equal)
         using traps_low_equal mod_trap_low_equal get_curr_win2_low_equal
         by fastforce        
       qed
     qed
   qed
 qed
 
 lemma flush_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (flush_instr instr s1)) \<and>
 t2 = snd (fst (flush_instr instr s2))"
 shows "low_equal t1 t2"
 using a1
 apply (simp add: flush_instr_def)
 apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def simpler_modify_def)
 apply (simp add: flush_cache_all_def)
 apply (simp add: low_equal_def)
 apply (simp add: user_accessible_def)
 apply (simp add: mem_equal_def)
 by auto
 
 lemma branch_instr_sub1_low_equal:
 assumes a1: "low_equal s1 s2"
 shows "branch_instr_sub1 instr_name s1 = branch_instr_sub1 instr_name s2"
 using a1 apply (simp add: branch_instr_sub1_def)
 by (simp add: low_equal_def)
 
 lemma set_annul_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (set_annul True s1)) \<and>
 t2 = snd (fst (set_annul True s2))"
 shows "low_equal t1 t2"
 using a1 apply (simp add: set_annul_def)
 apply (simp add: simpler_modify_def annul_mod_def)
 using state_var2_low_equal state_var_low_equal 
 by fastforce
 
 lemma branch_instr_low_equal_sub0:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (write_cpu (cpu_reg_val PC s2 +
   sign_ext24 (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
   nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1))))) \<and>
 t2 = snd (fst (write_cpu (cpu_reg_val PC s2 +
   sign_ext24 (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
   nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2)))))"
 shows "low_equal t1 t2"
 proof -
   from a1 have "low_equal
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1)))
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2)))"
   using write_cpu_low_equal by blast
   then show ?thesis
   using a1 write_cpu_low_equal by blast
 qed
 
 lemma branch_instr_low_equal_sub1:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (set_annul True (snd (fst (write_cpu
   (cpu_reg_val PC s2 + sign_ext24
   (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
   nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1)))))))) \<and>
 t2 = snd (fst (set_annul True (snd (fst (write_cpu
   (cpu_reg_val PC s2 + sign_ext24
   (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
   nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2))))))))"
 shows "low_equal t1 t2"
 proof -
   from a1 have "low_equal 
     (snd (fst (write_cpu
     (cpu_reg_val PC s2 + sign_ext24
     (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
     nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1))))))
     (snd (fst (write_cpu
     (cpu_reg_val PC s2 + sign_ext24
     (ucast (get_operand_w22 (snd instr ! Suc 0)) << 2))
     nPC (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2))))))"
   using branch_instr_low_equal_sub0 by blast  
   then show ?thesis using a1
   using set_annul_low_equal by blast  
 qed
 
 lemma branch_instr_low_equal_sub2:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (set_annul True
   (snd (fst (write_cpu (cpu_reg_val nPC s2 + 4) nPC
   (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1)))))))) \<and>
 t2 = snd (fst (set_annul True
   (snd (fst (write_cpu (cpu_reg_val nPC s2 + 4) nPC
    (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2))))))))"
 shows "low_equal t1 t2"
 proof -
   from a1 have "low_equal
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1)))
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2)))"
   using write_cpu_low_equal by blast
   then have "low_equal 
     (snd (fst (write_cpu (cpu_reg_val nPC s2 + 4) nPC
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s1))))))
     (snd (fst (write_cpu (cpu_reg_val nPC s2 + 4) nPC
     (snd (fst (write_cpu (cpu_reg_val nPC s2) PC s2))))))"
   using write_cpu_low_equal by blast
   then show ?thesis using a1
   using set_annul_low_equal by blast
 qed
 
 lemma branch_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 t1 = snd (fst (branch_instr instr s1)) \<and>
 t2 = snd (fst (branch_instr instr s2))"
 shows "low_equal t1 t2"
 using a1 
 apply (simp add: branch_instr_def)
 apply (simp add: Let_def simpler_gets_def bind_def h1_def h2_def)
 apply (simp add: case_prod_unfold return_def)
 apply clarsimp
 apply (simp add: branch_instr_sub1_low_equal)
 apply (simp_all add: cpu_reg_val_low_equal)
 apply (cases "branch_instr_sub1 (fst instr) s2 = 1")
  apply clarsimp
  apply (simp add: bind_def h1_def h2_def Let_def)
  apply (simp_all add: cpu_reg_val_low_equal)
  apply (simp add: case_prod_unfold)
  apply (cases "fst instr = bicc_type BA \<and> get_operand_flag (snd instr ! 0) = 1")
   apply clarsimp
   using branch_instr_low_equal_sub1 apply blast
  apply clarsimp
  apply (simp add: return_def)
  using branch_instr_low_equal_sub0 apply fastforce
 apply (simp add: bind_def h1_def h2_def Let_def)
 apply (simp add: case_prod_unfold)
 apply (cases "get_operand_flag (snd instr ! 0) = 1")
  apply clarsimp
  apply (simp_all add: cpu_reg_val_low_equal)
  using branch_instr_low_equal_sub2 apply metis
 apply (simp add: return_def)
 using write_cpu_low_equal by metis
 
 lemma dispath_instr_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
-((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 \<not> snd (dispatch_instruction instr s1) \<and>
 \<not> snd (dispatch_instruction instr s2) \<and>
 t1 = (snd (fst (dispatch_instruction instr s1))) \<and>
 t2 = (snd (fst (dispatch_instruction instr s2)))"
 shows "low_equal t1 t2"
 proof (cases "get_trap_set s1 = {}")
   case True
   then have f_no_traps: "get_trap_set s1 = {} \<and> get_trap_set s2 = {}"
     using a1 by (simp add: low_equal_def get_trap_set_def)
   then show ?thesis
   proof (cases "fst instr \<in> {load_store_type LDSB,load_store_type LDUB,
         load_store_type LDUBA,load_store_type LDUH,load_store_type LD,
         load_store_type LDA,load_store_type LDD}")
     case True
     then show ?thesis using a1 f_no_traps
     apply dispath_instr_privilege_proof
     by (blast intro: load_instr_low_equal)
   next
     case False
     then have f1: "fst instr \<notin> {load_store_type LDSB, load_store_type LDUB, 
       load_store_type LDUBA, load_store_type LDUH,
       load_store_type LD, load_store_type LDA, load_store_type LDD}" 
       by auto
     then show ?thesis 
     proof (cases "fst instr \<in> {load_store_type STB,load_store_type STH,
         load_store_type ST,load_store_type STA,load_store_type STD}")
       case True
       then show ?thesis using a1 f_no_traps f1
       apply dispath_instr_privilege_proof
       using store_instr_low_equal by blast      
     next
       case False
       then have f2: "\<not>(fst instr \<in> {load_store_type STB,load_store_type STH,
         load_store_type ST,load_store_type STA,load_store_type STD})"
         by auto
       then show ?thesis 
       proof (cases "fst instr \<in> {sethi_type SETHI}")
         case True
         then show ?thesis using a1 f_no_traps f1 f2
         apply dispath_instr_privilege_proof
         by (auto intro: sethi_low_equal)        
       next
         case False
         then have f3: "\<not>(fst instr \<in> {sethi_type SETHI})"
           by auto
         then show ?thesis 
         proof (cases "fst instr \<in> {nop_type NOP}")
           case True
           then show ?thesis using a1 f_no_traps f1 f2 f3
           apply dispath_instr_privilege_proof
           by (auto intro: nop_low_equal)
         next
           case False
           then have f4: "\<not>(fst instr \<in> {nop_type NOP})" 
             by auto
           then show ?thesis 
           proof (cases "fst instr \<in> {logic_type ANDs,logic_type ANDcc,logic_type ANDN,
             logic_type ANDNcc,logic_type ORs,logic_type ORcc,logic_type ORN,
             logic_type XORs,logic_type XNOR}")
             case True
             then show ?thesis using a1 f_no_traps f1 f2 f3 f4
             apply dispath_instr_privilege_proof
             using logical_instr_low_equal by blast
           next
             case False
             then have f5: "\<not>(fst instr \<in> {logic_type ANDs,logic_type ANDcc,logic_type ANDN,
             logic_type ANDNcc,logic_type ORs,logic_type ORcc,logic_type ORN,
             logic_type XORs,logic_type XNOR})"
               by auto
             then show ?thesis 
             proof (cases "fst instr \<in> {shift_type SLL,shift_type SRL,shift_type SRA}")
               case True
               then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 
               apply dispath_instr_privilege_proof
               using shift_instr_low_equal by blast
             next
               case False
               then have f6: "\<not>(fst instr \<in> {shift_type SLL,shift_type SRL,shift_type SRA})"
                 by auto
               then show ?thesis 
               proof (cases "fst instr \<in> {arith_type ADD,arith_type ADDcc,arith_type ADDX}")
                 case True
                 then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6
                 apply dispath_instr_privilege_proof
                 using add_instr_low_equal by blast
               next
                 case False
                 then have f7: "\<not>(fst instr \<in> {arith_type ADD,arith_type ADDcc,arith_type ADDX})"
                   by auto
                 then show ?thesis
                 proof (cases "fst instr \<in> {arith_type SUB,arith_type SUBcc,arith_type SUBX}")
                   case True
                   then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 
                   apply dispath_instr_privilege_proof
                   using sub_instr_low_equal by blast
                 next
                   case False
                   then have f8: "\<not>(fst instr \<in> {arith_type SUB,arith_type SUBcc,arith_type SUBX})"
                     by auto
                   then show ?thesis
                   proof (cases "fst instr \<in> {arith_type UMUL,arith_type SMUL,arith_type SMULcc}")
                     case True
                     then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8
                     apply dispath_instr_privilege_proof
                     using mul_instr_low_equal by blast
                   next
                     case False
                     then have f9: "\<not>(fst instr \<in> {arith_type UMUL,arith_type SMUL,
                       arith_type SMULcc})"
                       by auto
                     then show ?thesis 
                     proof (cases "fst instr \<in> {arith_type UDIV,arith_type UDIVcc,arith_type SDIV}")
                       case True
                       then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9
                       apply dispath_instr_privilege_proof
                       using div_instr_low_equal by blast
                     next
                       case False
                       then have f10: "\<not>(fst instr \<in> {arith_type UDIV,
                         arith_type UDIVcc,arith_type SDIV})"
                         by auto
                       then show ?thesis 
                       proof (cases "fst instr \<in> {ctrl_type SAVE,ctrl_type RESTORE}")
                         case True
                         then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 f10
                         apply dispath_instr_privilege_proof
                         using save_restore_instr_low_equal by blast
                       next
                         case False
                         then have f11: "\<not>(fst instr \<in> {ctrl_type SAVE,ctrl_type RESTORE})"
                           by auto
                         then show ?thesis 
                         proof (cases "fst instr \<in> {call_type CALL}")
                           case True
                           then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11
                           apply dispath_instr_privilege_proof
                           using call_instr_low_equal by blast                          
                         next
                           case False
                           then have f12: "\<not>(fst instr \<in> {call_type CALL})" by auto
                           then show ?thesis
                           proof (cases "fst instr \<in> {ctrl_type JMPL}")
                             case True
                             then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
                             apply dispath_instr_privilege_proof
                             using jmpl_instr_low_equal by blast
                           next
                             case False
                             then have f13: "\<not>(fst instr \<in> {ctrl_type JMPL})" by auto
                             then show ?thesis 
                             proof (cases "fst instr \<in> {ctrl_type RETT}")
                               case True
                               then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 
                                 f11 f12 f13
                               apply dispath_instr_privilege_proof
                               using rett_instr_low_equal by blast
                             next
                               case False
                               then have f14: "\<not>(fst instr \<in> {ctrl_type RETT})" by auto
                               then show ?thesis 
                               proof (cases "fst instr \<in> {sreg_type RDY,sreg_type RDPSR,
                                 sreg_type RDWIM, sreg_type RDTBR}")
                                 case True
                                 then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 
                                   f11 f12 f13 f14
                                 apply dispath_instr_privilege_proof
                                 using read_state_reg_low_equal by blast
                               next
                                 case False
                                 then have f15: "\<not>(fst instr \<in> {sreg_type RDY,sreg_type RDPSR,
                                 sreg_type RDWIM, sreg_type RDTBR})" by auto
                                 then show ?thesis
                                 proof (cases "fst instr \<in> {sreg_type WRY,sreg_type WRPSR,
                                   sreg_type WRWIM, sreg_type WRTBR}")
                                   case True
                                   then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 
                                     f10 f11 f12 f13 f14 f15 
                                   apply dispath_instr_privilege_proof
                                   using write_state_reg_low_equal by blast
                                 next
                                   case False
                                   then have f16: "\<not>(fst instr \<in> {sreg_type WRY,sreg_type WRPSR,
                                   sreg_type WRWIM, sreg_type WRTBR})" by auto
                                   then show ?thesis
                                   proof (cases "fst instr \<in> {load_store_type FLUSH}")
                                     case True
                                     then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 f9 
                                       f10 f11 f12 f13 f14 f15 f16 
                                     apply dispath_instr_privilege_proof
                                     using flush_instr_low_equal by blast
                                   next
                                     case False
                                     then have f17: "\<not>(fst instr \<in> {load_store_type FLUSH})" by auto
                                     then show ?thesis 
                                     proof (cases "fst instr \<in> {bicc_type BE,bicc_type BNE,
                                       bicc_type BGU,bicc_type BLE,bicc_type BL,bicc_type BGE,
                                       bicc_type BNEG,bicc_type BG,bicc_type BCS,bicc_type BLEU,
                                       bicc_type BCC,bicc_type BA,bicc_type BN}")
                                       case True
                                       then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 
                                         f9 f10 f11 f12 f13 f14 f15 f16 f17
                                       apply dispath_instr_privilege_proof
                                       using branch_instr_low_equal by blast
                                     next
                                       case False
                                       then show ?thesis using a1 f_no_traps f1 f2 f3 f4 f5 f6 f7 f8 
                                         f9 f10 f11 f12 f13 f14 f15 f16 f17
                                       apply dispath_instr_privilege_proof
                                       by (simp add: fail_def)
                                     qed
                                   qed
                                 qed
                               qed
                             qed
                           qed
                         qed
                       qed
                     qed
                   qed
                 qed
               qed
             qed
           qed
         qed
       qed
     qed
   qed
 next
   case False
   then have "get_trap_set s1 \<noteq> {} \<and> get_trap_set s2 \<noteq> {}" 
     using a1 by (simp add: low_equal_def get_trap_set_def)
   then show ?thesis using a1
   apply (simp add: dispatch_instruction_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def)
   apply (simp add: Let_def)
   by (simp add: return_def)
 qed
 
 lemma execute_instr_sub1_low_equal:
 assumes a1: "low_equal s1 s2 \<and>
 \<not> snd (execute_instr_sub1 instr s1) \<and>
 \<not> snd (execute_instr_sub1 instr s2) \<and>
 t1 = (snd (fst (execute_instr_sub1 instr s1))) \<and>
 t2 = (snd (fst (execute_instr_sub1 instr s2)))"
 shows "low_equal t1 t2"
 proof (cases "get_trap_set s1 = {}")
   case True
   then have "get_trap_set s1 = {} \<and> get_trap_set s2 = {}"
     using a1 by (simp add: low_equal_def get_trap_set_def)
   then show ?thesis using a1
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   apply (case_tac "fst instr \<noteq> call_type CALL \<and>
                 fst instr \<noteq> ctrl_type RETT \<and>
                 fst instr \<noteq> ctrl_type JMPL \<and>
                 fst instr \<noteq> bicc_type BE \<and>
                 fst instr \<noteq> bicc_type BNE \<and>
                 fst instr \<noteq> bicc_type BGU \<and>
                 fst instr \<noteq> bicc_type BLE \<and>
                 fst instr \<noteq> bicc_type BL \<and>
                 fst instr \<noteq> bicc_type BGE \<and>
                 fst instr \<noteq> bicc_type BNEG \<and>
                 fst instr \<noteq> bicc_type BG \<and>
                 fst instr \<noteq> bicc_type BCS \<and>
                 fst instr \<noteq> bicc_type BLEU \<and>
                 fst instr \<noteq> bicc_type BCC \<and>
                 fst instr \<noteq> bicc_type BA \<and> fst instr \<noteq> bicc_type BN")
    apply clarsimp
    apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
    apply (simp add: case_prod_unfold)
    apply (simp add: low_equal_def)
    apply (simp add: cpu_reg_val_def write_cpu_def cpu_reg_mod_def)
    apply (simp add: simpler_modify_def return_def)
    apply (simp add: user_accessible_mod_cpu_reg mem_equal_mod_cpu_reg)
    apply clarsimp
   by (auto simp add: return_def)
 next
   case False
   then have "get_trap_set s1 \<noteq> {} \<and> get_trap_set s2 \<noteq> {}" 
     using a1 by (simp add: low_equal_def get_trap_set_def)
   then show ?thesis using a1
   apply (simp add: execute_instr_sub1_def)
   apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
   by (simp add: return_def)
 qed
 
 theorem non_interference_step: 
-assumes a1: "((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+assumes a1: "(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
 good_context s1 \<and>
 get_delayed_pool s1 = [] \<and> get_trap_set s1 = {} \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 get_delayed_pool s2 = [] \<and> get_trap_set s2 = {} \<and>
 good_context s2 \<and>
 low_equal s1 s2"
 shows "\<exists>t1 t2. Some t1 = NEXT s1 \<and> Some t2 = NEXT s2 \<and> 
-((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
 low_equal t1 t2"
 proof -
   from a1 have "good_context s1 \<and> good_context s2" by auto
   then have "NEXT s1 = Some (snd (fst (execute_instruction () s1))) \<and>
              NEXT s2 = Some (snd (fst (execute_instruction () s2)))"
        by (simp add: single_step)
   then have "\<exists>t1 t2. Some t1 = NEXT s1 \<and> Some t2 = NEXT s2" 
        by auto
   then have f0: "snd (execute_instruction() s1) = False \<and>
              snd (execute_instruction() s2) = False"
        by (auto simp add: NEXT_def case_prod_unfold)
   then have f1: "\<exists>t1 t2. Some t1 = NEXT s1 \<and>
       Some t2 = NEXT s2 \<and>
-      ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-      ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0"
+      (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+      (((get_S (cpu_reg_val PSR t2)))::word1) = 0"
       using a1
       apply (auto simp add: NEXT_def case_prod_unfold)
        by (auto simp add: safe_privilege)
   then show ?thesis 
   proof (cases "exe_mode_val s1")
     case True
     then have f_exe0: "exe_mode_val s1" by auto
     then have f_exe: "exe_mode_val s1 \<and> exe_mode_val s2"
       proof -
         have "low_equal s1 s2" using a1 by auto
         then have "state_var s1 = state_var s2" by (simp add: low_equal_def)
         then have "exe_mode_val s1 = exe_mode_val s2" by (simp add: exe_mode_val_def)
         then show ?thesis using f_exe0 by auto
       qed
     then show ?thesis
     proof (cases "\<exists>e. fetch_instruction (delayed_pool_write s1) = Inl e")
       case True
       then have f_fetch_error: "\<exists>e. fetch_instruction (delayed_pool_write s1) = Inl e" by auto
       then have f_fetch_error2: "(\<exists>e. fetch_instruction (delayed_pool_write s1) = Inl e) \<and> 
                  (\<exists>e. fetch_instruction (delayed_pool_write s2) = Inl e)"
         proof -
           have "cpu_reg s1 = cpu_reg s2" 
             using a1 by (simp add: low_equal_def)
           then have "cpu_reg_val PC s1 = cpu_reg_val PC s2" 
             by (simp add: cpu_reg_val_def)
           then have "cpu_reg_val PC s1 = cpu_reg_val PC s2 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR (delayed_pool_write s1))))::word1) = 0 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR (delayed_pool_write s2))))::word1) = 0"
+                     (((get_S (cpu_reg_val PSR (delayed_pool_write s1))))::word1) = 0 \<and>
+                     (((get_S (cpu_reg_val PSR (delayed_pool_write s2))))::word1) = 0"
             using a1 
             by (auto simp add: empty_delayed_pool_write_privilege)  
           then show ?thesis using a1 f_fetch_error
           apply (simp add: fetch_instruction_def)
           apply (simp add: Let_def ucast_def)         
           apply clarsimp
           apply (case_tac "uint (3 AND cpu_reg_val PC (delayed_pool_write s1)) = 0")
            apply auto
            apply (case_tac "fst (memory_read 8 (cpu_reg_val PC (delayed_pool_write s1)) 
            (delayed_pool_write s1)) = None")
             apply auto
             apply (simp add: case_prod_unfold)
             using a1 apply (auto simp add: mem_read_delayed_write_low_equal)
            apply (simp add: case_prod_unfold)
            using a1 apply (auto simp add: mem_read_delayed_write_low_equal)
           apply (simp add: delayed_pool_write_def)
           by (simp add: Let_def get_delayed_write_def)
         qed
       then show ?thesis 
       proof (cases "exe_mode_val s1")
         case True
         then have "exe_mode_val s1 \<and> exe_mode_val s2" using exe_mode_low_equal a1 by auto
         then show ?thesis using f1
         apply (simp add: NEXT_def execute_instruction_def)
         apply (simp add: bind_def h1_def h2_def Let_def simpler_gets_def)
         using a1 apply clarsimp
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: simpler_modify_def)
         using f_fetch_error2 apply clarsimp
         apply (simp add: raise_trap_def simpler_modify_def return_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: return_def simpler_modify_def)
         apply (simp add: raise_trap_def simpler_modify_def return_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: return_def)
         apply (simp add: delayed_pool_write_def get_delayed_write_def Let_def)
         apply (simp add: low_equal_def)
         apply (simp add: add_trap_set_def)
         apply (simp add: cpu_reg_val_def)
         apply clarsimp
         by (simp add: mem_equal_mod_trap user_accessible_mod_trap)       
       next
         case False
         then have "\<not> (exe_mode_val s1) \<and> \<not> (exe_mode_val s2)" 
           using exe_mode_low_equal a1 by auto
         then show ?thesis using f1
         apply (simp add: NEXT_def execute_instruction_def)
         apply (simp add: bind_def h1_def h2_def Let_def simpler_gets_def)
         using a1 apply clarsimp
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         by (simp add: return_def)
       qed
     next
       case False
       then have f_fetch_suc: "(\<exists>v. fetch_instruction (delayed_pool_write s1) = Inr v)" 
         using fetch_instr_result_1 by auto
       then have "(\<exists>v. fetch_instruction (delayed_pool_write s1) = Inr v \<and>
                       fetch_instruction (delayed_pool_write s2) = Inr v)"
         proof -
           have "cpu_reg s1 = cpu_reg s2" 
             using a1 by (simp add: low_equal_def)
           then have "cpu_reg_val PC s1 = cpu_reg_val PC s2" 
             by (simp add: cpu_reg_val_def)
           then have "cpu_reg_val PC s1 = cpu_reg_val PC s2 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR (delayed_pool_write s1))))::word1) = 0 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR (delayed_pool_write s2))))::word1) = 0"
+                     (((get_S (cpu_reg_val PSR (delayed_pool_write s1))))::word1) = 0 \<and>
+                     (((get_S (cpu_reg_val PSR (delayed_pool_write s2))))::word1) = 0"
             using a1 
             by (auto simp add: empty_delayed_pool_write_privilege)  
           then show ?thesis using a1 f_fetch_suc
           apply (simp add: fetch_instruction_def)
           apply (simp add: Let_def ucast_def) 
           apply clarsimp
           apply (case_tac "uint (3 AND cpu_reg_val PC (delayed_pool_write s1)) = 0")
            apply auto
            apply (case_tac "fst (memory_read 8 (cpu_reg_val PC (delayed_pool_write s1)) 
            (delayed_pool_write s1)) = None")
             apply auto
             apply (simp add: case_prod_unfold)
            using a1 apply (auto simp add: mem_read_delayed_write_low_equal)
            apply (simp add: case_prod_unfold)
            using a1 apply (auto simp add: mem_read_delayed_write_low_equal)
           apply (simp add: delayed_pool_write_def)
           by (simp add: Let_def get_delayed_write_def)
         qed
       then have "(\<exists>v. fetch_instruction (delayed_pool_write s1) = Inr v \<and>
                       fetch_instruction (delayed_pool_write s2) = Inr v \<and>
                       \<not> (\<exists>e. (decode_instruction v) = Inl e))"
         using dispatch_fail f0 a1 f_exe by auto
       then have f_fetch_dec: "(\<exists>v. fetch_instruction (delayed_pool_write s1) = Inr v \<and>
                       fetch_instruction (delayed_pool_write s2) = Inr v \<and>
                       (\<exists>v1. (decode_instruction v) = Inr v1))"
         using decode_instr_result_4 by auto      
       then show ?thesis 
       proof (cases "annul_val (delayed_pool_write s1)")
         case True
         then have "annul_val (delayed_pool_write s1) \<and> annul_val (delayed_pool_write s2)"
           using a1 
           apply (simp add: low_equal_def)
           by (simp add: delayed_pool_write_def get_delayed_write_def annul_val_def)
         then show ?thesis using a1 f1 f_exe f_fetch_dec
         apply (simp add: NEXT_def execute_instruction_def)
         apply (simp add: exec_gets return_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: simpler_modify_def)
         apply clarsimp
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         apply (simp add: write_cpu_def cpu_reg_val_def set_annul_def)
         apply (simp add: simpler_modify_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: write_cpu_def cpu_reg_val_def set_annul_def)
         apply (simp add: simpler_modify_def)
         apply (simp add: cpu_reg_mod_def annul_mod_def)
         apply (simp add: delayed_pool_write_def get_delayed_write_def)
         apply (simp add: write_annul_def)
         apply clarsimp
         apply (simp add: low_equal_def)
         apply (simp add: user_accessible_annul mem_equal_annul)
         by (metis)        
       next
         case False
         then have "\<not> annul_val (delayed_pool_write s1) \<and>
           \<not> annul_val (delayed_pool_write s2)"
           using a1 apply (simp add: low_equal_def)
           apply (simp add: delayed_pool_write_def get_delayed_write_def)
           by (simp add: annul_val_def)
         then show ?thesis using a1 f1 f_exe f_fetch_dec
         apply (simp add: NEXT_def execute_instruction_def)
         apply (simp add: exec_gets return_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: simpler_modify_def)
         apply clarsimp
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         apply (case_tac "snd (execute_instr_sub1 (a, b)
                    (snd (fst (dispatch_instruction (a, b)
                                (delayed_pool_write s1))))) \<or>
              snd (dispatch_instruction (a, b) (delayed_pool_write s1))")
          apply auto
         apply (case_tac "snd (execute_instr_sub1 (a, b)
                    (snd (fst (dispatch_instruction (a, b)
                                (delayed_pool_write s2))))) \<or>
              snd (dispatch_instruction (a, b) (delayed_pool_write s2))")
          apply auto
         apply (simp add: simpler_modify_def)
         apply (simp add: simpler_gets_def bind_def h1_def h2_def Let_def)
         apply (simp add: case_prod_unfold)
         apply (simp add: delayed_pool_write_def get_delayed_write_def)
         by (meson dispath_instr_low_equal dispath_instr_privilege execute_instr_sub1_low_equal)        
       qed
     qed
   next
     case False
     then have f_non_exe: "exe_mode_val s1 = False" by auto
     then have "exe_mode_val s1 = False \<and> exe_mode_val s2 = False"        
       proof -
         have "low_equal s1 s2" using a1 by auto
         then have "state_var s1 = state_var s2" by (simp add: low_equal_def)
         then have "exe_mode_val s1 = exe_mode_val s2" by (simp add: exe_mode_val_def)
         then show ?thesis using f_non_exe by auto
       qed
     then show ?thesis using f1 a1    
     apply (simp add: NEXT_def execute_instruction_def)
     by (simp add: simpler_gets_def bind_def h1_def h2_def Let_def return_def)
   qed
 qed
 
 function (sequential) SEQ:: "nat \<Rightarrow> ('a::len) sparc_state \<Rightarrow> ('a) sparc_state option"
 where "SEQ 0 s = Some s"
 |"SEQ n s = (
   case SEQ (n-1) s of None \<Rightarrow> None
   | Some t \<Rightarrow> NEXT t
 )"
 by pat_completeness auto
 termination by lexicographic_order
 
 lemma SEQ_suc: "SEQ n s = Some t \<Longrightarrow> SEQ (Suc n) s = NEXT t"
 apply (induction n)
  apply clarsimp
 by (simp add: option.case_eq_if)
 
 definition user_seq_exe:: "nat \<Rightarrow> ('a::len) sparc_state \<Rightarrow> bool" where
 "user_seq_exe n s \<equiv> \<forall>i t. (i \<le> n \<and> SEQ i s = Some t) \<longrightarrow>
   (good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {})"
 
 text \<open>NIA is short for non-interference assumption.\<close>
 definition "NIA t1 t2 \<equiv> 
-    ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
     good_context t1 \<and> get_delayed_pool t1 = [] \<and> get_trap_set t1 = {} \<and>
     good_context t2 \<and> get_delayed_pool t2 = [] \<and> get_trap_set t2 = {} \<and>
     low_equal t1 t2"
 
 text \<open>NIC is short for non-interference conclusion.\<close>
 definition "NIC t1 t2 \<equiv> (\<exists>u1 u2. Some u1 = NEXT t1 \<and> Some u2 = NEXT t2 \<and> 
-    ((ucast (get_S (cpu_reg_val PSR u1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR u2)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR u1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR u2)))::word1) = 0 \<and>
     low_equal u1 u2)"
 
 lemma NIS_short: "\<forall>t1 t2. NIA t1 t2 \<longrightarrow> NIC t1 t2"
 apply (simp add: NIA_def NIC_def)
 using non_interference_step by auto
 
 lemma non_interference_induct_case_sub1:
 assumes a1: "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
     NIA t1 t2))"
 shows "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
     NIA t1 t2 \<and>
     NIC t1 t2))"
 using NIS_short
 using assms by auto 
 
 lemma non_interference_induct_case: 
 assumes a1: 
 "((\<forall>i t. i \<le> n \<and> SEQ i s1 = Some t \<longrightarrow>
                  good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {}) \<and>
           (\<forall>i t. i \<le> n \<and> SEQ i s2 = Some t \<longrightarrow>
                  good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {}) \<longrightarrow>
           (\<exists>t1. Some t1 = SEQ n s1 \<and>
                (\<exists>t2. Some t2 = SEQ n s2 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2))) \<and>
+                     (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2))) \<and>
 (\<forall>i t. i \<le> Suc n \<and> SEQ i s1 = Some t \<longrightarrow>
                good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {}) \<and>
          (\<forall>i t. i \<le> Suc n \<and> SEQ i s2 = Some t \<longrightarrow>
                good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {})"
 shows "\<exists>t1. Some t1 = (case SEQ n s1 of None \<Rightarrow> None | Some x \<Rightarrow> NEXT x) \<and>
               (\<exists>t2. Some t2 = (case SEQ n s2 of None \<Rightarrow> None | Some x \<Rightarrow> NEXT x) \<and>
-                    ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2)"
+                    (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2)"
 proof -
   from a1 have f1: "((\<forall>i t. i \<le> n \<and> SEQ i s1 = Some t \<longrightarrow>
   good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {}) \<and>
   (\<forall>i t. i \<le> n \<and> SEQ i s2 = Some t \<longrightarrow>
   good_context t \<and> get_delayed_pool t = [] \<and> get_trap_set t = {}))"
   by (metis le_SucI)
   then have f2: "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
     low_equal t1 t2))"
   using a1 by auto
   then have f3: "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
     NIA t1 t2))"
   using f1 NIA_def by (metis (full_types) dual_order.refl)  
   then have "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
     NIA t1 t2 \<and>
     NIC t1 t2))"
   using non_interference_induct_case_sub1 by blast
   then have "(\<exists>t1. Some t1 = SEQ n s1 \<and>
     (\<exists>t2. Some t2 = SEQ n s2 \<and>
-    (((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
+    ((((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
     good_context t1 \<and> get_delayed_pool t1 = [] \<and> get_trap_set t1 = {} \<and>
     good_context t2 \<and> get_delayed_pool t2 = [] \<and> get_trap_set t2 = {} \<and>
     low_equal t1 t2) \<and>
     (\<exists>u1 u2. Some u1 = NEXT t1 \<and> Some u2 = NEXT t2 \<and> 
-    ((ucast (get_S (cpu_reg_val PSR u1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR u2)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR u1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR u2)))::word1) = 0 \<and>
     low_equal u1 u2)))"
   using NIA_def NIC_def by fastforce
   then show ?thesis
   by (metis option.simps(5))
 qed
 
 lemma non_interference_induct_case_sub2: 
 assumes a1: 
 "(user_seq_exe n s1 \<and>
           user_seq_exe n s2 \<longrightarrow>
           (\<exists>t1. Some t1 = SEQ n s1 \<and>
                (\<exists>t2. Some t2 = SEQ n s2 \<and>
-                     ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2))) \<and>
+                     (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2))) \<and>
 user_seq_exe (Suc n) s1 \<and>
          user_seq_exe (Suc n) s2"
 shows "\<exists>t1. Some t1 = (case SEQ n s1 of None \<Rightarrow> None | Some x \<Rightarrow> NEXT x) \<and>
               (\<exists>t2. Some t2 = (case SEQ n s2 of None \<Rightarrow> None | Some x \<Rightarrow> NEXT x) \<and>
-                    ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-    ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2)"
+                    (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+    (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and> low_equal t1 t2)"
 using a1
 by (simp add: non_interference_induct_case user_seq_exe_def)
 
 theorem non_interference:
 assumes a1: 
-"((ucast (get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
+"(((get_S (cpu_reg_val PSR s1)))::word1) = 0 \<and>
 good_context s1 \<and>
 get_delayed_pool s1 = [] \<and> get_trap_set s1 = {} \<and>
-((ucast (get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
+(((get_S (cpu_reg_val PSR s2)))::word1) = 0 \<and>
 get_delayed_pool s2 = [] \<and> get_trap_set s2 = {} \<and>
 good_context s2 \<and>
 user_seq_exe n s1 \<and> user_seq_exe n s2 \<and>
 low_equal s1 s2"
 shows "(\<exists>t1 t2. Some t1 = SEQ n s1 \<and> Some t2 = SEQ n s2 \<and>
-  ((ucast (get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
-  ((ucast (get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
+  (((get_S (cpu_reg_val PSR t1)))::word1) = 0 \<and>
+  (((get_S (cpu_reg_val PSR t2)))::word1) = 0 \<and>
   low_equal t1 t2)"
 using a1
 apply (induction n)
  apply (simp add: user_seq_exe_def)
 apply clarsimp
 by (simp add: non_interference_induct_case_sub2)
 
 end
diff --git a/thys/Word_Lib/Aligned.thy b/thys/Word_Lib/Aligned.thy
--- a/thys/Word_Lib/Aligned.thy
+++ b/thys/Word_Lib/Aligned.thy
@@ -1,894 +1,911 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Word Alignment"
 
 theory Aligned
 imports
   Word_Lib
   HOL_Lemmas
   More_Divides
 begin
 
+lift_definition is_aligned :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> bool\<close>
+  is \<open>\<lambda>k n. take_bit (min LENGTH('a) n) k = 0\<close>
+  by (simp only: ac_simps flip: take_bit_take_bit)
 
-definition
-  is_aligned :: "'a :: len word \<Rightarrow> nat \<Rightarrow> bool" where
-  "is_aligned ptr n \<equiv> 2^n dvd unat ptr"
+lemma is_aligned_iff_dvd_int:
+  \<open>is_aligned ptr n \<longleftrightarrow> 2 ^ n dvd uint ptr\<close>
+  by transfer (simp add: take_bit_eq_mod dvd_eq_mod_eq_0 mod_exp_eq)
 
+lemma is_aligned_iff_dvd_nat:
+  \<open>is_aligned ptr n \<longleftrightarrow> 2 ^ n dvd unat ptr\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
+proof -
+  have \<open>unat ptr = nat \<bar>uint ptr\<bar>\<close>
+    by transfer simp
+  then have \<open>2 ^ n dvd unat ptr \<longleftrightarrow> 2 ^ n dvd uint ptr\<close>
+    by (simp only: dvd_nat_abs_iff) simp
+  then show ?thesis
+    by (simp add: is_aligned_iff_dvd_int)
+qed
 
-lemma is_aligned_mask: "(is_aligned w n) = (w && mask n = 0)"
-  unfolding is_aligned_def by (rule and_mask_dvd_nat)
-
+lemma is_aligned_mask:
+  \<open>is_aligned w n \<longleftrightarrow> w && mask n = 0\<close>
+  by transfer (simp flip: take_bit_eq_mask)
 
 lemma is_aligned_to_bl:
   "is_aligned (w :: 'a :: len word) n = (True \<notin> set (drop (size w - n) (to_bl w)))"
   apply (simp add: is_aligned_mask eq_zero_set_bl)
   apply (clarsimp simp: in_set_conv_nth word_size)
   apply (simp add: to_bl_nth word_size cong: conj_cong)
   apply (simp add: diff_diff_less)
   apply safe
    apply (case_tac "n \<le> LENGTH('a)")
     prefer 2
     apply (rule_tac x=i in exI)
     apply clarsimp
    apply (subgoal_tac "\<exists>j < LENGTH('a). j < n \<and> LENGTH('a) - n + j = i")
     apply (erule exE)
     apply (rule_tac x=j in exI)
     apply clarsimp
    apply (thin_tac "w !! t" for t)
    apply (rule_tac x="i + n - LENGTH('a)" in exI)
    apply clarsimp
    apply arith
   apply (rule_tac x="LENGTH('a) - n + i" in exI)
   apply clarsimp
   apply arith
   done
 
 lemma unat_power_lower [simp]:
   assumes nv: "n < LENGTH('a::len)"
   shows "unat ((2::'a::len word) ^ n) = 2 ^ n"
-  by (simp add: assms nat_power_eq uint_2p_alt unat_def)
+  using assms by transfer simp
 
 lemma power_overflow:
   "n \<ge> LENGTH('a) \<Longrightarrow> 2 ^ n = (0 :: 'a::len word)"
   by simp
 
 lemma is_alignedI [intro?]:
   fixes x::"'a::len word"
   assumes xv: "x = 2 ^ n * k"
   shows   "is_aligned x n"
 proof cases
   assume nv: "n < LENGTH('a)"
   show ?thesis
-    unfolding is_aligned_def
+    unfolding is_aligned_iff_dvd_nat
   proof (rule dvdI [where k = "unat k mod 2 ^ (LENGTH('a) - n)"])
     from xv
     have "unat x = (unat (2::word32) ^ n * unat k) mod 2 ^ LENGTH('a)"
       using nv
       by (subst (asm) word_unat.Rep_inject [symmetric], simp,
           subst unat_word_ariths, simp)
 
     also have "\<dots> =  2 ^ n * (unat k mod 2 ^ (LENGTH('a) - n))" using nv
       by (simp add: mult_mod_right power_add [symmetric] add_diff_inverse)
 
     finally show "unat x = 2 ^ n * (unat k mod 2 ^ (LENGTH('a) - n))" .
   qed
 next
   assume "\<not> n < LENGTH('a)"
   with xv
-  show ?thesis by (simp add: not_less power_overflow is_aligned_def)
+  show ?thesis
+    by (simp add: not_less power_overflow is_aligned_iff_dvd_nat)
 qed
 
 lemma is_aligned_weaken:
   "\<lbrakk> is_aligned w x; x \<ge> y \<rbrakk> \<Longrightarrow> is_aligned w y"
-  unfolding is_aligned_def
+  unfolding is_aligned_iff_dvd_nat
   by (erule dvd_trans [rotated]) (simp add: le_imp_power_dvd)
 
 lemma nat_power_less_diff:
   assumes lt: "(2::nat) ^ n * q < 2 ^ m"
   shows "q < 2 ^ (m - n)"
   using lt
 proof (induct n arbitrary: m)
   case 0
   then show ?case by simp
 next
   case (Suc n)
 
   have ih: "\<And>m. 2 ^ n * q < 2 ^ m \<Longrightarrow> q < 2 ^ (m - n)"
     and prem: "2 ^ Suc n * q < 2 ^ m" by fact+
 
   show ?case
   proof (cases m)
     case 0
     then show ?thesis using Suc by simp
   next
     case (Suc m')
     then show ?thesis using prem
       by (simp add: ac_simps ih)
   qed
 qed
 
 lemma is_alignedE_pre:
   fixes w::"'a::len word"
   assumes aligned: "is_aligned w n"
   shows        rl: "\<exists>q. w = 2 ^ n * (of_nat q) \<and> q < 2 ^ (LENGTH('a) - n)"
 proof -
   from aligned obtain q where wv: "unat w = 2 ^ n * q"
-    unfolding is_aligned_def ..
+    unfolding is_aligned_iff_dvd_nat ..
 
   show ?thesis
   proof (rule exI, intro conjI)
     show "q < 2 ^ (LENGTH('a) - n)"
     proof (rule nat_power_less_diff)
       have "unat w < 2 ^ size w" unfolding word_size ..
       then have "unat w < 2 ^ LENGTH('a)" by simp
       with wv show "2 ^ n * q < 2 ^ LENGTH('a)" by simp
     qed
 
     have r: "of_nat (2 ^ n) = (2::word32) ^ n"
       by (induct n) simp+
 
     from wv have "of_nat (unat w) = of_nat (2 ^ n * q)" by simp
     then have "w = of_nat (2 ^ n * q)" by (subst word_unat.Rep_inverse [symmetric])
     then show "w = 2 ^ n * (of_nat q)" by (simp add: r)
   qed
 qed
 
 lemma is_alignedE:
   "\<lbrakk>is_aligned (w::'a::len word) n;
     \<And>q. \<lbrakk>w = 2 ^ n * (of_nat q); q < 2 ^ (LENGTH('a) - n)\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
   by (auto dest: is_alignedE_pre)
 
 lemma is_aligned_replicate:
   fixes w::"'a::len word"
   assumes aligned: "is_aligned w n"
   and          nv: "n \<le> LENGTH('a)"
   shows   "to_bl w = (take (LENGTH('a) - n) (to_bl w)) @ replicate n False"
 proof -
   from nv have rl: "\<And>q. q < 2 ^ (LENGTH('a) - n) \<Longrightarrow>
       to_bl (2 ^ n * (of_nat q :: 'a word)) =
       drop n (to_bl (of_nat q :: 'a word)) @ replicate n False"
     by (metis bl_shiftl le_antisym min_def shiftl_t2n wsst_TYs(3))
   show ?thesis using aligned
     by (auto simp: rl elim: is_alignedE)
 qed
 
 lemma is_aligned_drop:
   fixes w::"'a::len word"
   assumes "is_aligned w n" "n \<le> LENGTH('a)"
   shows "drop (LENGTH('a) - n) (to_bl w) = replicate n False"
 proof -
   have "to_bl w = take (LENGTH('a) - n) (to_bl w) @ replicate n False"
     by (rule is_aligned_replicate) fact+
   then have "drop (LENGTH('a) - n) (to_bl w) = drop (LENGTH('a) - n) \<dots>" by simp
   also have "\<dots> = replicate n False" by simp
   finally show ?thesis .
 qed
 
 lemma less_is_drop_replicate:
   fixes x::"'a::len word"
   assumes lt: "x < 2 ^ n"
   shows   "to_bl x = replicate (LENGTH('a) - n) False @ drop (LENGTH('a) - n) (to_bl x)"
   by (metis assms bl_and_mask' less_mask_eq)
 
 lemma is_aligned_add_conv:
   fixes off::"'a::len word"
   assumes aligned: "is_aligned w n"
   and        offv: "off < 2 ^ n"
   shows    "to_bl (w + off) =
    (take (LENGTH('a) - n) (to_bl w)) @ (drop (LENGTH('a) - n) (to_bl off))"
 proof cases
   assume nv: "n \<le> LENGTH('a)"
   show ?thesis
   proof (subst aligned_bl_add_size, simp_all only: word_size)
     show "drop (LENGTH('a) - n) (to_bl w) = replicate n False"
       by (subst is_aligned_replicate [OF aligned nv]) (simp add: word_size)
 
     from offv show "take (LENGTH('a) - n) (to_bl off) =
                     replicate (LENGTH('a) - n) False"
       by (subst less_is_drop_replicate, assumption) simp
   qed fact
 next
   assume "\<not> n \<le> LENGTH('a)"
   with offv show ?thesis by (simp add: power_overflow)
 qed
 
 lemma aligned_add_aligned:
   fixes x::"'a::len word"
   assumes aligned1: "is_aligned x n"
   and     aligned2: "is_aligned y m"
   and           lt: "m \<le> n"
   shows   "is_aligned (x + y) m"
 proof cases
   assume nlt: "n < LENGTH('a)"
   show ?thesis
-    unfolding is_aligned_def dvd_def
+    unfolding is_aligned_iff_dvd_nat dvd_def
   proof -
     from aligned2 obtain q2 where yv: "y = 2 ^ m * of_nat q2"
       and q2v: "q2 < 2 ^ (LENGTH('a) - m)"
       by (auto elim: is_alignedE)
 
     from lt obtain k where kv: "m + k = n" by (auto simp: le_iff_add)
     with aligned1 obtain q1 where xv: "x = 2 ^ (m + k) * of_nat q1"
       and q1v: "q1 < 2 ^ (LENGTH('a) - (m + k))"
       by (auto elim: is_alignedE)
 
     have l1: "2 ^ (m + k) * q1 < 2 ^ LENGTH('a)"
       by (rule nat_less_power_trans [OF q1v])
          (subst kv, rule order_less_imp_le [OF nlt])
 
     have l2: "2 ^ m * q2 < 2 ^ LENGTH('a)"
       by (rule nat_less_power_trans [OF q2v],
           rule order_less_imp_le [OF order_le_less_trans])
          fact+
 
     have "x = of_nat (2 ^ (m + k) *  q1)" using xv
       by simp
 
     moreover have "y = of_nat (2 ^ m * q2)" using yv
       by simp
 
     ultimately have upls: "unat x + unat y = 2 ^ m * (2 ^ k * q1 + q2)"
     proof -
       have f1: "unat x = 2 ^ (m + k) * q1"
         by (metis (no_types) \<open>x = of_nat (2 ^ (m + k) * q1)\<close> l1 nat_mod_lem word_unat.inverse_norm
                              zero_less_numeral zero_less_power)
       have "unat y = 2 ^ m * q2"
         by (metis (no_types) \<open>y = of_nat (2 ^ m * q2)\<close> l2 nat_mod_lem word_unat.inverse_norm
                              zero_less_numeral zero_less_power)
       then show ?thesis
         using f1 by (simp add: power_add semiring_normalization_rules(34))
     qed
 
     (* (2 ^ k * q1 + q2) *)
     show "\<exists>d. unat (x + y) = 2 ^ m * d"
     proof (cases "unat x + unat y < 2 ^ LENGTH('a)")
       case True
 
       have "unat (x + y) = unat x + unat y"
         by (subst unat_plus_if', rule if_P) fact
 
       also have "\<dots> = 2 ^ m * (2 ^ k * q1 + q2)" by (rule upls)
       finally show ?thesis ..
     next
       case False
       then have "unat (x + y) = (unat x + unat y) mod 2 ^ LENGTH('a)"
         by (subst unat_word_ariths(1)) simp
 
       also have "\<dots> = (2 ^ m * (2 ^ k * q1 + q2)) mod 2 ^ LENGTH('a)"
         by (subst upls, rule refl)
 
       also
       have "\<dots> = 2 ^ m * ((2 ^ k * q1 +  q2) mod 2 ^ (LENGTH('a) - m))"
       proof -
         have "m \<le> len_of (TYPE('a))"
           by (meson le_trans less_imp_le_nat lt nlt)
         then show ?thesis
           by (metis mult_mod_right ordered_cancel_comm_monoid_diff_class.add_diff_inverse power_add)
       qed
 
       finally show ?thesis ..
     qed
   qed
 next
   assume "\<not> n < LENGTH('a)"
   with assms
-  show ?thesis by (simp add: not_less power_overflow is_aligned_mask mask_def)
+  show ?thesis
+    by (simp add: is_aligned_mask not_less mask_eq_mask take_bit_eq_mod power_overflow word_arith_nat_defs(7) flip: take_bit_eq_mask)
 qed
 
 corollary aligned_sub_aligned:
   "\<lbrakk>is_aligned (x::'a::len word) n; is_aligned y m; m \<le> n\<rbrakk>
    \<Longrightarrow> is_aligned (x - y) m"
   apply (simp del: add_uminus_conv_diff add:diff_conv_add_uminus)
   apply (erule aligned_add_aligned, simp_all)
   apply (erule is_alignedE)
   apply (rule_tac k="- of_nat q" in is_alignedI)
   apply simp
   done
 
 lemma is_aligned_shift:
   fixes k::"'a::len word"
   shows "is_aligned (k << m) m"
 proof cases
   assume mv: "m < LENGTH('a)"
   from mv obtain q where mq: "m + q = LENGTH('a)" and "0 < q"
     by (auto dest: less_imp_add_positive)
 
   have "(2::nat) ^ m dvd unat (k << m)"
   proof
     have kv: "(unat k div 2 ^ q) * 2 ^ q + unat k mod 2 ^ q = unat k"
       by (rule div_mult_mod_eq)
 
     have "unat (k << m) = unat (2 ^ m * k)" by (simp add: shiftl_t2n)
     also have "\<dots> = (2 ^ m * unat k) mod (2 ^ LENGTH('a))" using mv
       by (subst unat_word_ariths(2))+ simp
     also have "\<dots> = 2 ^ m * (unat k mod 2 ^ q)"
       by (subst mq [symmetric], subst power_add, subst mod_mult2_eq) simp
     finally show "unat (k << m) = 2 ^ m * (unat k mod 2 ^ q)" .
   qed
 
-  then show ?thesis by (unfold is_aligned_def)
+  then show ?thesis by (unfold is_aligned_iff_dvd_nat)
 next
   assume "\<not> m < LENGTH('a)"
   then show ?thesis
     by (simp add: not_less power_overflow is_aligned_mask mask_def
                   shiftl_zero_size word_size)
 qed
 
 lemma word_mod_by_0: "k mod (0::'a::len word) = k"
   by (simp add: word_arith_nat_mod)
 
 lemma aligned_mod_eq_0:
   fixes p::"'a::len word"
   assumes al: "is_aligned p sz"
   shows   "p mod 2 ^ sz = 0"
 proof cases
   assume szv: "sz < LENGTH('a)"
   with al
   show ?thesis
-    unfolding is_aligned_def
+    unfolding is_aligned_iff_dvd_nat
     by (simp add: and_mask_dvd_nat p2_gt_0 word_mod_2p_is_mask)
 next
   assume "\<not> sz < LENGTH('a)"
   with al show ?thesis
-    by (simp add: not_less power_overflow is_aligned_mask mask_def word_mod_by_0)
+    by (simp add: is_aligned_mask mask_eq_mask flip: take_bit_eq_mask take_bit_eq_mod)
 qed
 
 lemma is_aligned_triv: "is_aligned (2 ^ n ::'a::len word) n"
   by (rule is_alignedI [where k = 1], simp)
 
 lemma is_aligned_mult_triv1: "is_aligned (2 ^ n * x  ::'a::len word) n"
   by (rule is_alignedI [OF refl])
 
 lemma is_aligned_mult_triv2: "is_aligned (x * 2 ^ n ::'a::len word) n"
   by (subst mult.commute, simp add: is_aligned_mult_triv1)
 
 lemma word_power_less_0_is_0:
   fixes x :: "'a::len word"
   shows "x < a ^ 0 \<Longrightarrow> x = 0" by simp
 
 lemma nat_add_offset_less:
   fixes x :: nat
   assumes yv: "y < 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y < 2 ^ sz"
 proof (subst mn)
   from yv obtain qy where "y + qy = 2 ^ n" and "0 < qy"
     by (auto dest: less_imp_add_positive)
 
   have "x * 2 ^ n + y < x * 2 ^ n + 2 ^ n" by simp fact+
   also have "\<dots> = (x + 1) * 2 ^ n" by simp
   also have "\<dots> \<le> 2 ^ (m + n)" using xv
     by (subst power_add) (rule mult_le_mono1, simp)
   finally show "x * 2 ^ n + y < 2 ^ (m + n)" .
 qed
 
 lemma is_aligned_no_wrap:
   fixes off :: "'a::len word"
   fixes ptr :: "'a::len word"
   assumes al: "is_aligned ptr sz"
   and    off: "off < 2 ^ sz"
   shows  "unat ptr + unat off < 2 ^ LENGTH('a)"
 proof -
   have szv: "sz < LENGTH('a)"
   using off p2_gt_0 word_neq_0_conv by fastforce
 
   from al obtain q where ptrq: "ptr = 2 ^ sz * of_nat q" and
     qv: "q < 2 ^ (LENGTH('a) - sz)" by (auto elim: is_alignedE)
 
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using off ptrq qv by clarsimp
   next
     case False
     then have sne: "0 < sz" ..
 
     show ?thesis
     proof -
       have uq: "unat (of_nat q ::'a::len word) = q"
         apply (subst unat_of_nat)
         apply (rule mod_less)
         apply (rule order_less_trans [OF qv])
         apply (rule power_strict_increasing [OF diff_less [OF sne]])
          apply (simp_all)
         done
 
       have uptr: "unat ptr = 2 ^ sz * q"
         apply (subst ptrq)
         apply (subst iffD1 [OF unat_mult_lem])
          apply (subst unat_power_lower [OF szv])
          apply (subst uq)
          apply (rule nat_less_power_trans [OF qv order_less_imp_le [OF szv]])
         apply (subst uq)
         apply (subst unat_power_lower [OF szv])
         apply simp
         done
 
       show "unat ptr + unat off < 2 ^ LENGTH('a)" using szv
         apply (subst uptr)
         apply (subst mult.commute, rule nat_add_offset_less [OF _ qv])
         apply (rule order_less_le_trans [OF unat_mono [OF off] order_eq_refl])
          apply simp_all
         done
     qed
   qed
 qed
 
 lemma is_aligned_no_wrap':
   fixes ptr :: "'a::len word"
   assumes al: "is_aligned ptr sz"
   and    off: "off < 2 ^ sz"
   shows  "ptr \<le> ptr + off"
   by (subst no_plus_overflow_unat_size, subst word_size, rule is_aligned_no_wrap) fact+
 
 lemma is_aligned_no_overflow':
   fixes p :: "'a::len word"
   assumes al: "is_aligned p n"
   shows "p \<le> p + (2 ^ n - 1)"
 proof cases
   assume "n<LENGTH('a)"
   with al
   have "2^n - (1::'a::len word) < 2^n"
     by (simp add: word_less_nat_alt unat_sub_if_size)
   with al
   show ?thesis by (rule is_aligned_no_wrap')
 next
   assume "\<not> n<LENGTH('a)"
   with al
   show ?thesis
   by (simp add: not_less power_overflow is_aligned_mask mask_2pm1)
 qed
 
 lemma is_aligned_no_overflow:
   "is_aligned ptr sz \<Longrightarrow> ptr \<le> ptr + 2^sz - 1"
   by (drule is_aligned_no_overflow') (simp add: field_simps)
 
 lemma replicate_not_True:
   "\<And>n. xs = replicate n False \<Longrightarrow> True \<notin> set xs"
   by (induct xs) auto
 
 lemma is_aligned_replicateI:
   "to_bl p = addr @ replicate n False \<Longrightarrow> is_aligned (p::'a::len word) n"
   apply (simp add: is_aligned_to_bl word_size)
   apply (subgoal_tac "length addr = LENGTH('a) - n")
    apply (simp add: replicate_not_True)
   apply (drule arg_cong [where f=length])
   apply simp
   done
 
 lemma to_bl_2p:
   "n < LENGTH('a) \<Longrightarrow>
    to_bl ((2::'a::len word) ^ n) =
    replicate (LENGTH('a) - Suc n) False @ True # replicate n False"
   apply (subst shiftl_1 [symmetric])
   apply (subst bl_shiftl)
   apply (simp add: to_bl_1 min_def word_size)
   done
 
 lemma map_zip_replicate_False_xor:
   "n = length xs \<Longrightarrow> map (\<lambda>(x, y). x = (\<not> y)) (zip xs (replicate n False)) = xs"
   by (induct xs arbitrary: n, auto)
 
 lemma drop_minus_lem:
   "\<lbrakk> n \<le> length xs; 0 < n; n' = length xs \<rbrakk> \<Longrightarrow> drop (n' - n) xs = rev xs ! (n - 1)  # drop (Suc (n' - n)) xs"
 proof (induct xs arbitrary: n n')
   case Nil then show ?case by simp
 next
   case (Cons y ys)
   from Cons.prems
   show ?case
     apply simp
     apply (cases "n = Suc (length ys)")
      apply (simp add: nth_append)
     apply (simp add: Suc_diff_le Cons.hyps nth_append)
     apply clarsimp
     apply arith
     done
 qed
 
 lemma drop_minus:
   "\<lbrakk> n < length xs; n' = length xs \<rbrakk> \<Longrightarrow> drop (n' - Suc n) xs = rev xs ! n  # drop (n' - n) xs"
   apply (subst drop_minus_lem)
      apply simp
     apply simp
    apply simp
   apply simp
   apply (cases "length xs", simp)
   apply (simp add: Suc_diff_le)
   done
 
 lemma xor_2p_to_bl:
   fixes x::"'a::len word"
   shows "to_bl (x xor 2^n) =
   (if n < LENGTH('a)
    then take (LENGTH('a)-Suc n) (to_bl x) @ (\<not>rev (to_bl x)!n) # drop (LENGTH('a)-n) (to_bl x)
    else to_bl x)"
 proof -
   have x: "to_bl x = take (LENGTH('a)-Suc n) (to_bl x) @ drop (LENGTH('a)-Suc n) (to_bl x)"
     by simp
 
   show ?thesis
   apply simp
   apply (rule conjI)
    apply (clarsimp simp: word_size)
    apply (simp add: bl_word_xor to_bl_2p)
    apply (subst x)
    apply (subst zip_append)
     apply simp
    apply (simp add: map_zip_replicate_False_xor drop_minus)
   apply (auto simp add: word_size nth_w2p intro!: word_eqI)
   done
 qed
 
 lemma aligned_add_xor:
   assumes al: "is_aligned (x::'a::len word) n'" and le: "n < n'"
   shows "(x + 2^n) xor 2^n = x"
 proof cases
   assume "n' < LENGTH('a)"
   with assms show ?thesis
   apply -
   apply (rule word_bl.Rep_eqD)
   apply (subst xor_2p_to_bl)
   apply simp
   apply (subst is_aligned_add_conv, simp, simp add: word_less_nat_alt)+
   apply (simp add: to_bl_2p nth_append)
   apply (cases "n' = Suc n")
    apply simp
    apply (subst is_aligned_replicate [where n="Suc n", simplified, symmetric]; simp)
   apply (subgoal_tac "\<not> LENGTH('a) - Suc n \<le> LENGTH('a) - n'")
    prefer 2
    apply arith
   apply (subst replicate_Suc [symmetric])
   apply (subst replicate_add [symmetric])
   apply (simp add: is_aligned_replicate [simplified, symmetric])
   done
 next
   assume "\<not> n' < LENGTH('a)"
-  with al show ?thesis
-    by (simp add: is_aligned_mask mask_def not_less power_overflow)
+  show ?thesis
+    using al apply (rule is_alignedE)
+    using \<open>\<not> n' < LENGTH('a)\<close> by auto
 qed
 
 lemma is_aligned_0 [simp]:
   "is_aligned p 0"
-  by (simp add: is_aligned_def)
+  by (simp add: is_aligned_iff_dvd_nat)
 
 lemma is_aligned_replicateD:
   "\<lbrakk> is_aligned (w::'a::len word) n; n \<le> LENGTH('a) \<rbrakk>
      \<Longrightarrow> \<exists>xs. to_bl w = xs @ replicate n False
                \<and> length xs = size w - n"
   apply (subst is_aligned_replicate, assumption+)
   apply (rule exI, rule conjI, rule refl)
   apply (simp add: word_size)
   done
 
 lemma is_aligned_add_mult_multI:
   fixes p :: "'a::len word"
   shows "\<lbrakk>is_aligned p m; n \<le> m; n' = n\<rbrakk> \<Longrightarrow> is_aligned (p + x * 2 ^ n * z) n'"
   apply (erule aligned_add_aligned)
   apply (auto intro: is_alignedI [where k="x*z"])
   done
 
 lemma is_aligned_add_multI:
   fixes p :: "'a::len word"
   shows "\<lbrakk>is_aligned p m; n \<le> m; n' = n\<rbrakk> \<Longrightarrow> is_aligned (p + x * 2 ^ n) n'"
   apply (erule aligned_add_aligned)
   apply (auto intro: is_alignedI [where k="x"])
   done
 
 lemma unat_of_nat_len:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> unat (of_nat x :: 'a::len word) = x"
   by (simp add: word_size unat_of_nat)
 
 lemma is_aligned_no_wrap''':
   fixes ptr :: "'a::len word"
   shows"\<lbrakk> is_aligned ptr sz; sz < LENGTH('a); off < 2 ^ sz \<rbrakk>
          \<Longrightarrow> unat ptr + off < 2 ^ LENGTH('a)"
   apply (drule is_aligned_no_wrap[where off="of_nat off"])
    apply (simp add: word_less_nat_alt)
    apply (erule order_le_less_trans[rotated])
    apply (subst unat_of_nat)
    apply (rule mod_less_eq_dividend)
   apply (subst(asm) unat_of_nat_len)
    apply (erule order_less_trans)
    apply (erule power_strict_increasing)
    apply simp
   apply assumption
   done
 
 lemma is_aligned_get_word_bits:
   fixes p :: "'a::len word"
   shows "\<lbrakk> is_aligned p n; \<lbrakk> is_aligned p n; n < LENGTH('a) \<rbrakk> \<Longrightarrow> P;
            \<lbrakk> p = 0; n \<ge> LENGTH('a) \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   apply (cases "n < LENGTH('a)")
    apply simp
   apply simp
   apply (erule meta_mp)
-  apply (clarsimp simp: is_aligned_mask mask_def power_add
-                        power_overflow)
+  apply (simp add: is_aligned_mask power_add power_overflow not_less
+    mask_eq_mask flip: take_bit_eq_mask)
+  apply (metis take_bit_length_eq take_bit_of_0 take_bit_tightened)
   done
 
 lemma aligned_small_is_0:
   "\<lbrakk> is_aligned x n; x < 2 ^ n \<rbrakk> \<Longrightarrow> x = 0"
   apply (erule is_aligned_get_word_bits)
    apply (frule is_aligned_add_conv [rotated, where w=0])
-    apply (simp add: is_aligned_def)
+    apply (simp add: is_aligned_iff_dvd_nat)
    apply simp
    apply (drule is_aligned_replicateD)
     apply simp
    apply (clarsimp simp: word_size)
    apply (subst (asm) replicate_add [symmetric])
    apply (drule arg_cong[where f="of_bl :: bool list \<Rightarrow> 'a::len word"])
    apply simp
   apply (simp only: replicate.simps[symmetric, where x=False]
                     drop_replicate)
   done
 
 corollary is_aligned_less_sz:
   "\<lbrakk>is_aligned a sz; a \<noteq> 0\<rbrakk> \<Longrightarrow> \<not> a < 2 ^ sz"
   by (rule notI, drule(1) aligned_small_is_0, erule(1) notE)
 
 lemma aligned_at_least_t2n_diff:
   "\<lbrakk>is_aligned x n; is_aligned y n; x < y\<rbrakk> \<Longrightarrow> x \<le> y - 2 ^ n"
   apply (erule is_aligned_get_word_bits[where p=y])
    apply (rule ccontr)
    apply (clarsimp simp: linorder_not_le)
    apply (subgoal_tac "y - x = 0")
     apply clarsimp
    apply (rule aligned_small_is_0)
     apply (erule(1) aligned_sub_aligned)
     apply simp
    apply unat_arith
   apply simp
   done
 
 lemma word_sub_1_le:
   "x \<noteq> 0 \<Longrightarrow> x - 1 \<le> (x :: ('a :: len) word)"
   apply (subst no_ulen_sub)
   apply simp
   apply (cases "uint x = 0")
    apply (simp add: uint_0_iff)
   apply (insert uint_ge_0[where x=x])
   apply arith
   done
 
 lemma is_aligned_no_overflow'':
   "\<lbrakk>is_aligned x n; x + 2 ^ n \<noteq> 0\<rbrakk> \<Longrightarrow> x \<le> x + 2 ^ n"
   apply (frule is_aligned_no_overflow')
   apply (erule order_trans)
   apply (simp add: field_simps)
   apply (erule word_sub_1_le)
   done
 
 lemma is_aligned_nth:
   "is_aligned p m = (\<forall>n < m. \<not>p !! n)"
   apply (clarsimp simp: is_aligned_mask bang_eq word_size)
   apply (rule iffI)
    apply clarsimp
    apply (case_tac "n < size p")
     apply (simp add: word_size)
    apply (drule test_bit_size)
    apply simp
   apply clarsimp
   done
 
 lemma range_inter:
   "({a..b} \<inter> {c..d} = {}) = (\<forall>x. \<not>(a \<le> x \<and> x \<le> b \<and> c \<le> x \<and> x \<le> d))"
   by auto
 
 lemma aligned_inter_non_empty:
   "\<lbrakk> {p..p + (2 ^ n - 1)} \<inter> {p..p + 2 ^ m - 1} = {};
      is_aligned p n; is_aligned p m\<rbrakk> \<Longrightarrow> False"
   apply (clarsimp simp only: range_inter)
   apply (erule_tac x=p in allE)
   apply simp
   apply (erule impE)
    apply (erule is_aligned_no_overflow')
   apply (erule notE)
   apply (erule is_aligned_no_overflow)
   done
 
 lemma not_aligned_mod_nz:
   assumes al: "\<not> is_aligned a n"
   shows "a mod 2 ^ n \<noteq> 0"
 proof cases
   assume "n < LENGTH('a)"
   with al
   show ?thesis
-    apply (simp add: is_aligned_def dvd_eq_mod_eq_0 word_arith_nat_mod)
+    apply (simp add: is_aligned_iff_dvd_nat dvd_eq_mod_eq_0 word_arith_nat_mod)
     apply (erule of_nat_neq_0)
     apply (rule order_less_trans)
      apply (rule mod_less_divisor)
      apply simp
     apply simp
     done
 next
   assume "\<not> n < LENGTH('a)"
   with al
   show ?thesis
-    by (simp add: is_aligned_mask mask_def not_less power_overflow
-                  word_less_nat_alt word_mod_by_0)
+    by transfer simp
 qed
 
 lemma nat_add_offset_le:
   fixes x :: nat
   assumes yv: "y \<le> 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y \<le> 2 ^ sz"
 proof (subst mn)
   from yv obtain qy where "y + qy = 2 ^ n"
     by (auto simp: le_iff_add)
 
   have "x * 2 ^ n + y \<le> x * 2 ^ n + 2 ^ n"
     using yv xv by simp
   also have "\<dots> = (x + 1) * 2 ^ n" by simp
   also have "\<dots> \<le> 2 ^ (m + n)" using xv
     by (subst power_add) (rule mult_le_mono1, simp)
   finally show "x * 2 ^ n + y \<le> 2 ^ (m + n)" .
 qed
 
 lemma is_aligned_no_wrap_le:
   fixes ptr::"'a::len word"
   assumes al: "is_aligned ptr sz"
   and    szv: "sz < LENGTH('a)"
   and    off: "off \<le> 2 ^ sz"
   shows  "unat ptr + off \<le> 2 ^ LENGTH('a)"
 proof -
   from al obtain q where ptrq: "ptr = 2 ^ sz * of_nat q" and
     qv: "q < 2 ^ (LENGTH('a) - sz)" by (auto elim: is_alignedE)
 
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using off ptrq qv
       apply (clarsimp)
       apply (erule le_SucE)
        apply (simp add: unat_of_nat)
       apply (simp add: less_eq_Suc_le [symmetric] unat_of_nat)
       done
   next
     case False
     then have sne: "0 < sz" ..
 
     show ?thesis
     proof -
       have uq: "unat (of_nat q :: 'a word) = q"
         apply (subst unat_of_nat)
         apply (rule mod_less)
         apply (rule order_less_trans [OF qv])
         apply (rule power_strict_increasing [OF diff_less [OF sne]])
         apply simp_all
         done
 
       have uptr: "unat ptr = 2 ^ sz * q"
         apply (subst ptrq)
         apply (subst iffD1 [OF unat_mult_lem])
         apply (subst unat_power_lower [OF szv])
         apply (subst uq)
         apply (rule nat_less_power_trans [OF qv order_less_imp_le [OF szv]])
         apply (subst uq)
         apply (subst unat_power_lower [OF szv])
         apply simp
         done
 
       show "unat ptr + off \<le> 2 ^ LENGTH('a)" using szv
         apply (subst uptr)
         apply (subst mult.commute, rule nat_add_offset_le [OF off qv])
         apply simp
         done
     qed
   qed
 qed
 
 lemma is_aligned_neg_mask:
   "m \<le> n \<Longrightarrow> is_aligned (x && ~~ (mask n)) m"
   by (metis and_not_mask is_aligned_shift is_aligned_weaken)
 
 lemma unat_minus:
   "unat (- (x :: 'a :: len word)) = (if x = 0 then 0 else 2 ^ size x - unat x)"
   using unat_sub_if_size[where x="2 ^ size x" and y=x]
   by (simp add: unat_eq_0 word_size)
 
 lemma is_aligned_minus:
   "is_aligned p n \<Longrightarrow> is_aligned (- p) n"
-  apply (clarsimp simp: is_aligned_def unat_minus word_size word_neq_0_conv)
+  apply (clarsimp simp: is_aligned_iff_dvd_nat unat_minus word_size word_neq_0_conv)
   apply (rule dvd_diff_nat, simp_all)
   apply (rule le_imp_power_dvd)
-  apply (fold is_aligned_def)
+  apply (fold is_aligned_iff_dvd_nat)
   apply (erule_tac Q="0<p" in contrapos_pp)
-  apply (clarsimp simp add: is_aligned_mask mask_def power_overflow)
+  apply transfer
+  apply simp
   done
 
 lemma add_mask_lower_bits:
   "\<lbrakk>is_aligned (x :: 'a :: len word) n;
     \<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'\<rbrakk> \<Longrightarrow> x + p && ~~ (mask n) = x"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI)
    apply (clarsimp simp: word_size is_aligned_nth)
    apply (erule_tac x=na in allE)+
    apply simp
   apply (rule word_eqI)
   apply (clarsimp simp: word_size is_aligned_nth word_ops_nth_size le_def)
   apply blast
   done
 
 lemma is_aligned_andI1:
   "is_aligned x n \<Longrightarrow> is_aligned (x && y) n"
   by (simp add: is_aligned_nth)
 
 lemma is_aligned_andI2:
   "is_aligned y n \<Longrightarrow> is_aligned (x && y) n"
   by (simp add: is_aligned_nth)
 
 lemma is_aligned_shiftl:
   "is_aligned w (n - m) \<Longrightarrow> is_aligned (w << m) n"
   by (simp add: is_aligned_nth nth_shiftl)
 
 lemma is_aligned_shiftr:
   "is_aligned w (n + m) \<Longrightarrow> is_aligned (w >> m) n"
   by (simp add: is_aligned_nth nth_shiftr)
 
 lemma is_aligned_shiftl_self:
   "is_aligned (p << n) n"
   by (rule is_aligned_shift)
 
 lemma is_aligned_neg_mask_eq:
   "is_aligned p n \<Longrightarrow> p && ~~ (mask n) = p"
   by (metis add.left_neutral is_aligned_mask word_plus_and_or_coroll2)
 
 lemma is_aligned_shiftr_shiftl:
   "is_aligned w n \<Longrightarrow> w >> n << n = w"
   by (metis and_not_mask is_aligned_neg_mask_eq)
 
 lemma aligned_shiftr_mask_shiftl:
   "is_aligned x n \<Longrightarrow> ((x >> n) && mask v) << n = x && mask (v + n)"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftl nth_shiftr)
   apply (subgoal_tac "\<forall>m. x !! m \<longrightarrow> m \<ge> n")
    apply auto[1]
   apply (clarsimp simp: is_aligned_mask)
   apply (drule_tac x=m in word_eqD)
   apply (frule test_bit_size)
   apply (simp add: word_size)
   done
 
 lemma mask_zero:
   "is_aligned x a \<Longrightarrow> x && mask a = 0"
   by (metis is_aligned_mask)
 
 lemma is_aligned_neg_mask_eq_concrete:
   "\<lbrakk> is_aligned p n; msk && ~~(mask n) = ~~(mask n) \<rbrakk>
    \<Longrightarrow> p && msk = p"
   by (metis word_bw_assocs(1) word_bw_comms(1) is_aligned_neg_mask_eq)
 
 lemma is_aligned_and_not_zero:
   "\<lbrakk> is_aligned n k; n \<noteq> 0 \<rbrakk> \<Longrightarrow> 2 ^ k \<le> n"
   using is_aligned_less_sz leI by blast
 
 lemma is_aligned_and_2_to_k:
   "(n && 2 ^ k - 1) = 0 \<Longrightarrow> is_aligned (n :: 'a :: len word) k"
-  by (simp add: is_aligned_mask mask_def)
+  by (simp add: is_aligned_mask mask_eq_decr_exp)
 
 lemma is_aligned_power2:
   "b \<le> a \<Longrightarrow> is_aligned (2 ^ a) b"
   by (metis is_aligned_triv is_aligned_weaken)
 
 lemma aligned_sub_aligned':
   "\<lbrakk> is_aligned (a :: 'a :: len word) n; is_aligned b n; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> is_aligned (a - b) n"
   by (simp add: aligned_sub_aligned)
 
 lemma is_aligned_neg_mask_weaken:
   "\<lbrakk> is_aligned p n; m \<le> n \<rbrakk> \<Longrightarrow> p && ~~(mask m) = p"
    using is_aligned_neg_mask_eq is_aligned_weaken by blast
 
 lemma is_aligned_neg_mask2[simp]:
   "is_aligned (a && ~~(mask n)) n"
   by (simp add: and_not_mask is_aligned_shift)
 
 end
diff --git a/thys/Word_Lib/Bitwise.thy b/thys/Word_Lib/Bitwise.thy
--- a/thys/Word_Lib/Bitwise.thy
+++ b/thys/Word_Lib/Bitwise.thy
@@ -1,525 +1,527 @@
 (*  Authors:    Thomas Sewell, NICTA and Sascha Boehme, TU Muenchen
 *)
 
 theory Bitwise
   imports "HOL-Word.Word" "HOL-Word.Misc_Arithmetic" "HOL-Word.Misc_msb"
 begin
 
 text \<open>Helper constants used in defining addition\<close>
 
 definition xor3 :: "bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool"
   where "xor3 a b c = (a = (b = c))"
 
 definition carry :: "bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool"
   where "carry a b c = ((a \<and> (b \<or> c)) \<or> (b \<and> c))"
 
 lemma carry_simps:
   "carry True a b = (a \<or> b)"
   "carry a True b = (a \<or> b)"
   "carry a b True = (a \<or> b)"
   "carry False a b = (a \<and> b)"
   "carry a False b = (a \<and> b)"
   "carry a b False = (a \<and> b)"
   by (auto simp add: carry_def)
 
 lemma xor3_simps:
   "xor3 True a b = (a = b)"
   "xor3 a True b = (a = b)"
   "xor3 a b True = (a = b)"
   "xor3 False a b = (a \<noteq> b)"
   "xor3 a False b = (a \<noteq> b)"
   "xor3 a b False = (a \<noteq> b)"
   by (simp_all add: xor3_def)
 
 text \<open>Breaking up word equalities into equalities on their
   bit lists. Equalities are generated and manipulated in the
   reverse order to \<^const>\<open>to_bl\<close>.\<close>
 
 lemma bl_word_sub: "to_bl (x - y) = to_bl (x + (- y))"
   by simp
 
 lemma rbl_word_1: "rev (to_bl (1 :: 'a::len word)) = takefill False (LENGTH('a)) [True]"
   apply (rule_tac s="rev (to_bl (word_succ (0 :: 'a word)))" in trans)
    apply simp
   apply (simp only: rtb_rbl_ariths(1)[OF refl])
   apply simp
   apply (case_tac "LENGTH('a)")
    apply simp
   apply (simp add: takefill_alt)
   done
 
 lemma rbl_word_if: "rev (to_bl (if P then x else y)) = map2 (If P) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: split_def)
 
 lemma rbl_add_carry_Cons:
   "(if car then rbl_succ else id) (rbl_add (x # xs) (y # ys)) =
     xor3 x y car # (if carry x y car then rbl_succ else id) (rbl_add xs ys)"
   by (simp add: carry_def xor3_def)
 
 lemma rbl_add_suc_carry_fold:
   "length xs = length ys \<Longrightarrow>
     \<forall>car. (if car then rbl_succ else id) (rbl_add xs ys) =
       (foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car)) (zip xs ys) (\<lambda>_. [])) car"
   apply (erule list_induct2)
    apply simp
   apply (simp only: rbl_add_carry_Cons)
   apply simp
   done
 
 lemma to_bl_plus_carry:
   "to_bl (x + y) =
     rev (foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car))
       (rev (zip (to_bl x) (to_bl y))) (\<lambda>_. []) False)"
   using rbl_add_suc_carry_fold[where xs="rev (to_bl x)" and ys="rev (to_bl y)"]
   apply (simp add: word_add_rbl[OF refl refl])
   apply (drule_tac x=False in spec)
   apply (simp add: zip_rev)
   done
 
 definition "rbl_plus cin xs ys =
   foldr (\<lambda>(x, y) res car. xor3 x y car # res (carry x y car)) (zip xs ys) (\<lambda>_. []) cin"
 
 lemma rbl_plus_simps:
   "rbl_plus cin (x # xs) (y # ys) = xor3 x y cin # rbl_plus (carry x y cin) xs ys"
   "rbl_plus cin [] ys = []"
   "rbl_plus cin xs [] = []"
   by (simp_all add: rbl_plus_def)
 
 lemma rbl_word_plus: "rev (to_bl (x + y)) = rbl_plus False (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: rbl_plus_def to_bl_plus_carry zip_rev)
 
 definition "rbl_succ2 b xs = (if b then rbl_succ xs else xs)"
 
 lemma rbl_succ2_simps:
   "rbl_succ2 b [] = []"
   "rbl_succ2 b (x # xs) = (b \<noteq> x) # rbl_succ2 (x \<and> b) xs"
   by (simp_all add: rbl_succ2_def)
 
 lemma twos_complement: "- x = word_succ (NOT x)"
   using arg_cong[OF word_add_not[where x=x], where f="\<lambda>a. a - x + 1"]
   by (simp add: word_succ_p1 word_sp_01[unfolded word_succ_p1] del: word_add_not)
 
 lemma rbl_word_neg: "rev (to_bl (- x)) = rbl_succ2 True (map Not (rev (to_bl x)))"
   for x :: \<open>'a::len word\<close>
   by (simp add: twos_complement word_succ_rbl[OF refl] bl_word_not rev_map rbl_succ2_def)
 
 lemma rbl_word_cat:
   "rev (to_bl (word_cat x y :: 'a::len word)) =
     takefill False (LENGTH('a)) (rev (to_bl y) @ rev (to_bl x))"
   by (simp add: word_cat_bl word_rev_tf)
 
 lemma rbl_word_slice:
   "rev (to_bl (slice n w :: 'a::len word)) =
     takefill False (LENGTH('a)) (drop n (rev (to_bl w)))"
   apply (simp add: slice_take word_rev_tf rev_take)
   apply (cases "n < LENGTH('b)", simp_all)
   done
 
 lemma rbl_word_ucast:
   "rev (to_bl (ucast x :: 'a::len word)) = takefill False (LENGTH('a)) (rev (to_bl x))"
   apply (simp add: to_bl_ucast takefill_alt)
   apply (simp add: rev_drop)
   apply (cases "LENGTH('a) < LENGTH('b)")
    apply simp_all
   done
 
 lemma rbl_shiftl:
   "rev (to_bl (w << n)) = takefill False (size w) (replicate n False @ rev (to_bl w))"
   by (simp add: bl_shiftl takefill_alt word_size rev_drop)
 
 lemma rbl_shiftr:
   "rev (to_bl (w >> n)) = takefill False (size w) (drop n (rev (to_bl w)))"
   by (simp add: shiftr_slice rbl_word_slice word_size)
 
 definition "drop_nonempty v n xs = (if n < length xs then drop n xs else [last (v # xs)])"
 
 lemma drop_nonempty_simps:
   "drop_nonempty v (Suc n) (x # xs) = drop_nonempty x n xs"
   "drop_nonempty v 0 (x # xs) = (x # xs)"
   "drop_nonempty v n [] = [v]"
   by (simp_all add: drop_nonempty_def)
 
 definition "takefill_last x n xs = takefill (last (x # xs)) n xs"
 
 lemma takefill_last_simps:
   "takefill_last z (Suc n) (x # xs) = x # takefill_last x n xs"
   "takefill_last z 0 xs = []"
   "takefill_last z n [] = replicate n z"
   by (simp_all add: takefill_last_def) (simp_all add: takefill_alt)
 
 lemma rbl_sshiftr:
   "rev (to_bl (w >>> n)) = takefill_last False (size w) (drop_nonempty False n (rev (to_bl w)))"
   apply (cases "n < size w")
    apply (simp add: bl_sshiftr takefill_last_def word_size
       takefill_alt rev_take last_rev
       drop_nonempty_def)
   apply (subgoal_tac "(w >>> n) = of_bl (replicate (size w) (msb w))")
    apply (simp add: word_size takefill_last_def takefill_alt
       last_rev word_msb_alt word_rev_tf
       drop_nonempty_def take_Cons')
    apply (case_tac "LENGTH('a)", simp_all)
   apply (rule word_eqI)
   apply (simp add: nth_sshiftr word_size test_bit_of_bl
       msb_nth)
   done
 
 lemma nth_word_of_int:
   "(word_of_int x :: 'a::len word) !! n = (n < LENGTH('a) \<and> bin_nth x n)"
   apply (simp add: test_bit_bl word_size to_bl_of_bin)
   apply (subst conj_cong[OF refl], erule bin_nth_bl)
   apply auto
   done
 
 lemma nth_scast:
   "(scast (x :: 'a::len word) :: 'b::len word) !! n =
     (n < LENGTH('b) \<and>
     (if n < LENGTH('a) - 1 then x !! n
      else x !! (LENGTH('a) - 1)))"
-  by (simp add: scast_def nth_sint)
+  apply transfer
+  apply (auto simp add: bit_signed_take_bit_iff min_def)
+  done
 
 lemma rbl_word_scast:
   "rev (to_bl (scast x :: 'a::len word)) = takefill_last False (LENGTH('a)) (rev (to_bl x))"
   apply (rule nth_equalityI)
    apply (simp add: word_size takefill_last_def)
   apply (clarsimp simp: nth_scast takefill_last_def
       nth_takefill word_size rev_nth to_bl_nth)
   apply (cases "LENGTH('b)")
    apply simp
   apply (clarsimp simp: less_Suc_eq_le linorder_not_less
       last_rev word_msb_alt[symmetric]
       msb_nth)
   done
 
 definition rbl_mul :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where "rbl_mul xs ys = foldr (\<lambda>x sm. rbl_plus False (map ((\<and>) x) ys) (False # sm)) xs []"
 
 lemma rbl_mul_simps:
   "rbl_mul (x # xs) ys = rbl_plus False (map ((\<and>) x) ys) (False # rbl_mul xs ys)"
   "rbl_mul [] ys = []"
   by (simp_all add: rbl_mul_def)
 
 lemma takefill_le2: "length xs \<le> n \<Longrightarrow> takefill x m (takefill x n xs) = takefill x m xs"
   by (simp add: takefill_alt replicate_add[symmetric])
 
 lemma take_rbl_plus: "\<forall>n b. take n (rbl_plus b xs ys) = rbl_plus b (take n xs) (take n ys)"
   apply (simp add: rbl_plus_def take_zip[symmetric])
   apply (rule_tac list="zip xs ys" in list.induct)
    apply simp
   apply (clarsimp simp: split_def)
   apply (case_tac n, simp_all)
   done
 
 lemma word_rbl_mul_induct:
   "length xs \<le> size y \<Longrightarrow>
     rbl_mul xs (rev (to_bl y)) = take (length xs) (rev (to_bl (of_bl (rev xs) * y)))"
   for y :: "'a::len word"
 proof (induct xs)
   case Nil
   show ?case by (simp add: rbl_mul_simps)
 next
   case (Cons z zs)
 
   have rbl_word_plus': "to_bl (x + y) = rev (rbl_plus False (rev (to_bl x)) (rev (to_bl y)))"
     for x y :: "'a word"
     by (simp add: rbl_word_plus[symmetric])
 
   have mult_bit: "to_bl (of_bl [z] * y) = map ((\<and>) z) (to_bl y)"
     by (cases z) (simp cong: map_cong, simp add: map_replicate_const cong: map_cong)
 
   have shiftl: "of_bl xs * 2 * y = (of_bl xs * y) << 1" for xs
     by (simp add: shiftl_t2n)
 
   have zip_take_triv: "\<And>xs ys n. n = length ys \<Longrightarrow> zip (take n xs) ys = zip xs ys"
     by (rule nth_equalityI) simp_all
 
   from Cons show ?case
     apply (simp add: trans [OF of_bl_append add.commute]
         rbl_mul_simps rbl_word_plus' distrib_right mult_bit shiftl rbl_shiftl)
     apply (simp add: takefill_alt word_size rev_map take_rbl_plus min_def)
     apply (simp add: rbl_plus_def zip_take_triv)
     done
 qed
 
 lemma rbl_word_mul: "rev (to_bl (x * y)) = rbl_mul (rev (to_bl x)) (rev (to_bl y))"
   for x :: "'a::len word"
   using word_rbl_mul_induct[where xs="rev (to_bl x)" and y=y] by (simp add: word_size)
 
 text \<open>Breaking up inequalities into bitlist properties.\<close>
 
 definition
   "rev_bl_order F xs ys =
      (length xs = length ys \<and>
        ((xs = ys \<and> F)
           \<or> (\<exists>n < length xs. drop (Suc n) xs = drop (Suc n) ys
                    \<and> \<not> xs ! n \<and> ys ! n)))"
 
 lemma rev_bl_order_simps:
   "rev_bl_order F [] [] = F"
   "rev_bl_order F (x # xs) (y # ys) = rev_bl_order ((y \<and> \<not> x) \<or> ((y \<or> \<not> x) \<and> F)) xs ys"
    apply (simp_all add: rev_bl_order_def)
   apply (rule conj_cong[OF refl])
   apply (cases "xs = ys")
    apply (simp add: nth_Cons')
    apply blast
   apply (simp add: nth_Cons')
   apply safe
    apply (rule_tac x="n - 1" in exI)
    apply simp
   apply (rule_tac x="Suc n" in exI)
   apply simp
   done
 
 lemma rev_bl_order_rev_simp:
   "length xs = length ys \<Longrightarrow>
    rev_bl_order F (xs @ [x]) (ys @ [y]) = ((y \<and> \<not> x) \<or> ((y \<or> \<not> x) \<and> rev_bl_order F xs ys))"
   by (induct arbitrary: F rule: list_induct2) (auto simp: rev_bl_order_simps)
 
 lemma rev_bl_order_bl_to_bin:
   "length xs = length ys \<Longrightarrow>
     rev_bl_order True xs ys = (bl_to_bin (rev xs) \<le> bl_to_bin (rev ys)) \<and>
     rev_bl_order False xs ys = (bl_to_bin (rev xs) < bl_to_bin (rev ys))"
   apply (induct xs ys rule: list_induct2)
    apply (simp_all add: rev_bl_order_simps bl_to_bin_app_cat concat_bit_Suc)
   apply (auto simp add: bl_to_bin_def add1_zle_eq)
   done
 
 lemma word_le_rbl: "x \<le> y \<longleftrightarrow> rev_bl_order True (rev (to_bl x)) (rev (to_bl y))"
   for x y :: "'a::len word"
   by (simp add: rev_bl_order_bl_to_bin word_le_def)
 
 lemma word_less_rbl: "x < y \<longleftrightarrow> rev_bl_order False (rev (to_bl x)) (rev (to_bl y))"
   for x y :: "'a::len word"
   by (simp add: word_less_alt rev_bl_order_bl_to_bin)
 
 lemma word_sint_msb_eq: "sint x = uint x - (if msb x then 2 ^ size x else 0)"
   apply (cases "msb x")
    apply (rule word_sint.Abs_eqD[where 'a='a], simp_all)
     apply (simp add: word_size wi_hom_syms word_of_int_2p_len)
    apply (simp add: sints_num word_size)
    apply (rule conjI)
     apply (simp add: le_diff_eq')
     apply (rule order_trans[where y="2 ^ (LENGTH('a) - 1)"])
      apply (simp add: power_Suc[symmetric])
     apply (simp add: linorder_not_less[symmetric] mask_eq_iff[symmetric])
     apply (rule notI, drule word_eqD[where x="size x - 1"])
     apply (simp add: msb_nth word_ops_nth_size word_size)
    apply (simp add: order_less_le_trans[where y=0])
   apply (rule word_uint.Abs_eqD[where 'a='a], simp_all)
   apply (simp add: linorder_not_less uints_num word_msb_sint)
   apply (rule order_less_le_trans[OF sint_lt])
   apply simp
   done
 
 lemma word_sle_msb_le: "x <=s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x \<le> y)"
-  apply (simp add: word_sle_def word_sint_msb_eq word_size word_le_def)
+  apply (simp add: word_sle_eq word_sint_msb_eq word_size word_le_def)
   apply safe
    apply (rule order_trans[OF _ uint_ge_0])
    apply (simp add: order_less_imp_le)
   apply (erule notE[OF leD])
   apply (rule order_less_le_trans[OF _ uint_ge_0])
   apply simp
   done
 
 lemma word_sless_msb_less: "x <s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x < y)"
-  by (auto simp add: word_sless_def word_sle_msb_le)
+  by (auto simp add: word_sless_eq word_sle_msb_le)
 
 definition "map_last f xs = (if xs = [] then [] else butlast xs @ [f (last xs)])"
 
 lemma map_last_simps:
   "map_last f [] = []"
   "map_last f [x] = [f x]"
   "map_last f (x # y # zs) = x # map_last f (y # zs)"
   by (simp_all add: map_last_def)
 
 lemma word_sle_rbl:
   "x <=s y \<longleftrightarrow> rev_bl_order True (map_last Not (rev (to_bl x))) (map_last Not (rev (to_bl y)))"
   using word_msb_alt[where w=x] word_msb_alt[where w=y]
   apply (simp add: word_sle_msb_le word_le_rbl)
   apply (subgoal_tac "length (to_bl x) = length (to_bl y)")
    apply (cases "to_bl x", simp)
    apply (cases "to_bl y", simp)
    apply (clarsimp simp: map_last_def rev_bl_order_rev_simp)
    apply auto
   done
 
 lemma word_sless_rbl:
   "x <s y \<longleftrightarrow> rev_bl_order False (map_last Not (rev (to_bl x))) (map_last Not (rev (to_bl y)))"
   using word_msb_alt[where w=x] word_msb_alt[where w=y]
   apply (simp add: word_sless_msb_less word_less_rbl)
   apply (subgoal_tac "length (to_bl x) = length (to_bl y)")
    apply (cases "to_bl x", simp)
    apply (cases "to_bl y", simp)
    apply (clarsimp simp: map_last_def rev_bl_order_rev_simp)
    apply auto
   done
 
 text \<open>Lemmas for unpacking \<^term>\<open>rev (to_bl n)\<close> for numerals n and also
   for irreducible values and expressions.\<close>
 
 lemma rev_bin_to_bl_simps:
   "rev (bin_to_bl 0 x) = []"
   "rev (bin_to_bl (Suc n) (numeral (num.Bit0 nm))) = False # rev (bin_to_bl n (numeral nm))"
   "rev (bin_to_bl (Suc n) (numeral (num.Bit1 nm))) = True # rev (bin_to_bl n (numeral nm))"
   "rev (bin_to_bl (Suc n) (numeral (num.One))) = True # replicate n False"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm))) = False # rev (bin_to_bl n (- numeral nm))"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm))) =
     True # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.One))) = True # replicate n True"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit0 nm + num.One))) =
     True # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.Bit1 nm + num.One))) =
     False # rev (bin_to_bl n (- numeral (nm + num.One)))"
   "rev (bin_to_bl (Suc n) (- numeral (num.One + num.One))) =
     False # rev (bin_to_bl n (- numeral num.One))"
   by (simp_all add: bin_to_bl_aux_append bin_to_bl_zero_aux bin_to_bl_minus1_aux replicate_append_same)
 
 lemma to_bl_upt: "to_bl x = rev (map ((!!) x) [0 ..< size x])"
   apply (rule nth_equalityI)
    apply (simp add: word_size)
   apply (auto simp: to_bl_nth word_size rev_nth)
   done
 
 lemma rev_to_bl_upt: "rev (to_bl x) = map ((!!) x) [0 ..< size x]"
   by (simp add: to_bl_upt)
 
 lemma upt_eq_list_intros:
   "j \<le> i \<Longrightarrow> [i ..< j] = []"
   "i = x \<Longrightarrow> x < j \<Longrightarrow> [x + 1 ..< j] = xs \<Longrightarrow> [i ..< j] = (x # xs)"
   by (simp_all add: upt_eq_Cons_conv)
 
 
 subsection \<open>Tactic definition\<close>
 
 ML \<open>
 structure Word_Bitwise_Tac =
 struct
 
 val word_ss = simpset_of \<^theory_context>\<open>Word\<close>;
 
 fun mk_nat_clist ns =
   fold_rev (Thm.mk_binop \<^cterm>\<open>Cons :: nat \<Rightarrow> _\<close>)
     ns \<^cterm>\<open>[] :: nat list\<close>;
 
 fun upt_conv ctxt ct =
   case Thm.term_of ct of
     (\<^const>\<open>upt\<close> $ n $ m) =>
       let
         val (i, j) = apply2 (snd o HOLogic.dest_number) (n, m);
         val ns = map (Numeral.mk_cnumber \<^ctyp>\<open>nat\<close>) (i upto (j - 1))
           |> mk_nat_clist;
         val prop =
           Thm.mk_binop \<^cterm>\<open>(=) :: nat list \<Rightarrow> _\<close> ct ns
           |> Thm.apply \<^cterm>\<open>Trueprop\<close>;
       in
         try (fn () =>
           Goal.prove_internal ctxt [] prop
             (K (REPEAT_DETERM (resolve_tac ctxt @{thms upt_eq_list_intros} 1
                 ORELSE simp_tac (put_simpset word_ss ctxt) 1))) |> mk_meta_eq) ()
       end
   | _ => NONE;
 
 val expand_upt_simproc =
   Simplifier.make_simproc \<^context> "expand_upt"
    {lhss = [\<^term>\<open>upt x y\<close>], proc = K upt_conv};
 
 fun word_len_simproc_fn ctxt ct =
   (case Thm.term_of ct of
     Const (\<^const_name>\<open>len_of\<close>, _) $ t =>
      (let
         val T = fastype_of t |> dest_Type |> snd |> the_single
         val n = Numeral.mk_cnumber \<^ctyp>\<open>nat\<close> (Word_Lib.dest_binT T);
         val prop =
           Thm.mk_binop \<^cterm>\<open>(=) :: nat \<Rightarrow> _\<close> ct n
           |> Thm.apply \<^cterm>\<open>Trueprop\<close>;
       in
         Goal.prove_internal ctxt [] prop (K (simp_tac (put_simpset word_ss ctxt) 1))
         |> mk_meta_eq |> SOME
       end handle TERM _ => NONE | TYPE _ => NONE)
   | _ => NONE);
 
 val word_len_simproc =
   Simplifier.make_simproc \<^context> "word_len"
    {lhss = [\<^term>\<open>len_of x\<close>], proc = K word_len_simproc_fn};
 
 (* convert 5 or nat 5 to Suc 4 when n_sucs = 1, Suc (Suc 4) when n_sucs = 2,
    or just 5 (discarding nat) when n_sucs = 0 *)
 
 fun nat_get_Suc_simproc_fn n_sucs ctxt ct =
   let
     val (f $ arg) = Thm.term_of ct;
     val n =
       (case arg of \<^term>\<open>nat\<close> $ n => n | n => n)
       |> HOLogic.dest_number |> snd;
     val (i, j) = if n > n_sucs then (n_sucs, n - n_sucs) else (n, 0);
     val arg' = funpow i HOLogic.mk_Suc (HOLogic.mk_number \<^typ>\<open>nat\<close> j);
     val _ = if arg = arg' then raise TERM ("", []) else ();
     fun propfn g =
       HOLogic.mk_eq (g arg, g arg')
       |> HOLogic.mk_Trueprop |> Thm.cterm_of ctxt;
     val eq1 =
       Goal.prove_internal ctxt [] (propfn I)
         (K (simp_tac (put_simpset word_ss ctxt) 1));
   in
     Goal.prove_internal ctxt [] (propfn (curry (op $) f))
       (K (simp_tac (put_simpset HOL_ss ctxt addsimps [eq1]) 1))
     |> mk_meta_eq |> SOME
   end handle TERM _ => NONE;
 
 fun nat_get_Suc_simproc n_sucs ts =
   Simplifier.make_simproc \<^context> "nat_get_Suc"
    {lhss = map (fn t => t $ \<^term>\<open>n :: nat\<close>) ts,
     proc = K (nat_get_Suc_simproc_fn n_sucs)};
 
 val no_split_ss =
   simpset_of (put_simpset HOL_ss \<^context>
     |> Splitter.del_split @{thm if_split});
 
 val expand_word_eq_sss =
   (simpset_of (put_simpset HOL_basic_ss \<^context> addsimps
        @{thms word_eq_rbl_eq word_le_rbl word_less_rbl word_sle_rbl word_sless_rbl}),
   map simpset_of [
    put_simpset no_split_ss \<^context> addsimps
     @{thms rbl_word_plus rbl_word_and rbl_word_or rbl_word_not
                                 rbl_word_neg bl_word_sub rbl_word_xor
                                 rbl_word_cat rbl_word_slice rbl_word_scast
                                 rbl_word_ucast rbl_shiftl rbl_shiftr rbl_sshiftr
                                 rbl_word_if},
    put_simpset no_split_ss \<^context> addsimps
     @{thms to_bl_numeral to_bl_neg_numeral to_bl_0 rbl_word_1},
    put_simpset no_split_ss \<^context> addsimps
     @{thms rev_rev_ident rev_replicate rev_map to_bl_upt word_size}
           addsimprocs [word_len_simproc],
    put_simpset no_split_ss \<^context> addsimps
     @{thms list.simps split_conv replicate.simps list.map
                                 zip_Cons_Cons zip_Nil drop_Suc_Cons drop_0 drop_Nil
                                 foldr.simps list.map zip.simps(1) zip_Nil zip_Cons_Cons takefill_Suc_Cons
                                 takefill_Suc_Nil takefill.Z rbl_succ2_simps
                                 rbl_plus_simps rev_bin_to_bl_simps append.simps
                                 takefill_last_simps drop_nonempty_simps
                                 rev_bl_order_simps}
           addsimprocs [expand_upt_simproc,
                        nat_get_Suc_simproc 4
                          [\<^term>\<open>replicate\<close>, \<^term>\<open>takefill x\<close>,
                           \<^term>\<open>drop\<close>, \<^term>\<open>bin_to_bl\<close>,
                           \<^term>\<open>takefill_last x\<close>,
                           \<^term>\<open>drop_nonempty x\<close>]],
     put_simpset no_split_ss \<^context> addsimps @{thms xor3_simps carry_simps if_bool_simps}
   ])
 
 fun tac ctxt =
   let
     val (ss, sss) = expand_word_eq_sss;
   in
     foldr1 (op THEN_ALL_NEW)
       ((CHANGED o safe_full_simp_tac (put_simpset ss ctxt)) ::
         map (fn ss => safe_full_simp_tac (put_simpset ss ctxt)) sss)
   end;
 
 end
 \<close>
 
 method_setup word_bitwise =
   \<open>Scan.succeed (fn ctxt => Method.SIMPLE_METHOD (Word_Bitwise_Tac.tac ctxt 1))\<close>
   "decomposer for word equalities and inequalities into bit propositions"
 
 end
diff --git a/thys/Word_Lib/Word_EqI.thy b/thys/Word_Lib/Word_EqI.thy
--- a/thys/Word_Lib/Word_EqI.thy
+++ b/thys/Word_Lib/Word_EqI.thy
@@ -1,184 +1,184 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Solving Word Equalities"
 
 theory Word_EqI
   imports
     Word_Next
     "HOL-Eisbach.Eisbach_Tools"
 begin
 
 text \<open>
   Some word equalities can be solved by considering the problem bitwise for all
   @{prop "n < LENGTH('a::len)"}, which is different to running @{text word_bitwise}
   and expanding into an explicit list of bits.
 \<close>
 
 lemma word_or_zero:
   "(a || b = 0) = (a = 0 \<and> b = 0)"
   by (safe; rule word_eqI, drule_tac x=n in word_eqD, simp)
 
 lemma test_bit_over:
   "n \<ge> size (x::'a::len word) \<Longrightarrow> (x !! n) = False"
   by (simp add: test_bit_bl word_size)
 
 lemma neg_mask_test_bit:
   "(~~(mask n) :: 'a :: len word) !! m = (n \<le> m \<and> m < LENGTH('a))"
   by (metis not_le nth_mask test_bit_bin word_ops_nth_size word_size)
 
 lemma word_2p_mult_inc:
   assumes x: "2 * 2 ^ n < (2::'a::len word) * 2 ^ m"
   assumes suc_n: "Suc n < LENGTH('a::len)"
   shows "2^n < (2::'a::len word)^m"
   by (smt suc_n le_less_trans lessI nat_less_le nat_mult_less_cancel_disj p2_gt_0
           power_Suc power_Suc unat_power_lower word_less_nat_alt x)
 
 lemma word_power_increasing:
   assumes x: "2 ^ x < (2 ^ y::'a::len word)" "x < LENGTH('a::len)" "y < LENGTH('a::len)"
   shows "x < y" using x
   apply (induct x arbitrary: y)
    apply (case_tac y; simp)
   apply (case_tac y; clarsimp simp: word_2p_mult_inc)
   apply (subst (asm) power_Suc [symmetric])
   apply (subst (asm) p2_eq_0)
   apply simp
   done
 
 lemma upper_bits_unset_is_l2p:
   "n < LENGTH('a) \<Longrightarrow>
    (\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n') = (p < 2 ^ n)" for p :: "'a :: len word"
   apply (cases "Suc 0 < LENGTH('a)")
    prefer 2
    apply (subgoal_tac "LENGTH('a) = 1", auto simp: word_eq_iff)[1]
   apply (rule iffI)
    apply (subst mask_eq_iff_w2p [symmetric])
     apply (clarsimp simp: word_size)
    apply (rule word_eqI, rename_tac n')
    apply (case_tac "n' < n"; simp add: word_size)
   by (meson bang_is_le le_less_trans not_le word_power_increasing)
 
 lemma less_2p_is_upper_bits_unset:
   "p < 2 ^ n \<longleftrightarrow> n < LENGTH('a) \<and> (\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n')" for p :: "'a :: len word"
   by (meson le_less_trans le_mask_iff_lt_2n upper_bits_unset_is_l2p word_zero_le)
 
 lemma word_le_minus_one_leq:
   "x < y \<Longrightarrow> x \<le> y - 1" for x :: "'a :: len word"
   by (simp add: plus_one_helper)
 
 lemma word_less_sub_le[simp]:
   fixes x :: "'a :: len word"
   assumes nv: "n < LENGTH('a)"
   shows "(x \<le> 2 ^ n - 1) = (x < 2 ^ n)"
   using le_less_trans word_le_minus_one_leq nv power_2_ge_iff by blast
 
 lemma not_greatest_aligned:
   "\<lbrakk> x < y; is_aligned x n; is_aligned y n \<rbrakk> \<Longrightarrow> x + 2 ^ n \<noteq> 0"
   by (metis NOT_mask add_diff_cancel_right' diff_0 is_aligned_neg_mask_eq not_le word_and_le1)
 
 lemma neg_mask_mono_le:
   "x \<le> y \<Longrightarrow> x && ~~(mask n) \<le> y && ~~(mask n)" for x :: "'a :: len word"
 proof (rule ccontr, simp add: linorder_not_le, cases "n < LENGTH('a)")
   case False
   then show "y && ~~(mask n) < x && ~~(mask n) \<Longrightarrow> False"
-    by (simp add: mask_def linorder_not_less power_overflow)
+    by (simp add: mask_eq_decr_exp linorder_not_less power_overflow)
 next
   case True
   assume a: "x \<le> y" and b: "y && ~~(mask n) < x && ~~(mask n)"
   have word_bits: "n < LENGTH('a)" by fact
   have "y \<le> (y && ~~(mask n)) + (y && mask n)"
     by (simp add: word_plus_and_or_coroll2 add.commute)
   also have "\<dots> \<le> (y && ~~(mask n)) + 2 ^ n"
     apply (rule word_plus_mono_right)
      apply (rule order_less_imp_le, rule and_mask_less_size)
      apply (simp add: word_size word_bits)
     apply (rule is_aligned_no_overflow'', simp add: is_aligned_neg_mask word_bits)
     apply (rule not_greatest_aligned, rule b; simp add: is_aligned_neg_mask)
     done
   also have "\<dots> \<le> x && ~~(mask n)"
     using b
     apply (subst add.commute)
     apply (rule le_plus)
      apply (rule aligned_at_least_t2n_diff; simp add: is_aligned_neg_mask)
     apply (rule ccontr, simp add: linorder_not_le)
     apply (drule aligned_small_is_0[rotated]; simp add: is_aligned_neg_mask)
     done
   also have "\<dots> \<le> x" by (rule word_and_le2)
   also have "x \<le> y" by fact
   finally
   show "False" using b by simp
 qed
 
 lemma and_neg_mask_eq_iff_not_mask_le:
   "w && ~~(mask n) = ~~(mask n) \<longleftrightarrow> ~~(mask n) \<le> w"
   by (metis eq_iff neg_mask_mono_le word_and_le1 word_and_le2 word_bw_same(1))
 
 lemma le_mask_high_bits:
   "w \<le> mask n \<longleftrightarrow> (\<forall>i \<in> {n ..< size w}. \<not> w !! i)"
   by (auto simp: word_size and_mask_eq_iff_le_mask[symmetric] word_eq_iff)
 
 lemma neg_mask_le_high_bits:
   "~~(mask n) \<le> w \<longleftrightarrow> (\<forall>i \<in> {n ..< size w}. w !! i)"
   by (auto simp: word_size and_neg_mask_eq_iff_not_mask_le[symmetric] word_eq_iff neg_mask_test_bit)
 
 lemma test_bit_conj_lt:
   "(x !! m \<and> m < LENGTH('a)) = x !! m" for x :: "'a :: len word"
   using test_bit_bin by blast
 
 lemma neg_test_bit:
   "(~~ x) !! n = (\<not> x !! n \<and> n < LENGTH('a))" for x :: "'a::len word"
   by (cases "n < LENGTH('a)") (auto simp add: test_bit_over word_ops_nth_size word_size)
 
 named_theorems word_eqI_simps
 
 lemmas [word_eqI_simps] =
   word_ops_nth_size
   word_size
   word_or_zero
   neg_mask_test_bit
   nth_ucast
   is_aligned_nth
   nth_w2p nth_shiftl
   nth_shiftr
   less_2p_is_upper_bits_unset
   le_mask_high_bits
   neg_mask_le_high_bits
   bang_eq
   neg_test_bit
   is_up
   is_down
 
 lemmas word_eqI_rule = word_eqI[rule_format]
 
 lemma test_bit_lenD:
   "x !! n \<Longrightarrow> n < LENGTH('a) \<and> x !! n" for x :: "'a :: len word"
   by (fastforce dest: test_bit_size simp: word_size)
 
 method word_eqI uses simp simp_del split split_del cong flip =
   ((* reduce conclusion to test_bit: *)
    rule word_eqI_rule,
    (* make sure we're in clarsimp normal form: *)
    (clarsimp simp: simp simp del: simp_del simp flip: flip split: split split del: split_del cong: cong)?,
    (* turn x < 2^n assumptions into mask equations: *)
    ((drule less_mask_eq)+)?,
    (* expand and distribute test_bit everywhere: *)
    (clarsimp simp: word_eqI_simps simp simp del: simp_del simp flip: flip
              split: split split del: split_del cong: cong)?,
    (* add any additional word size constraints to new indices: *)
    ((drule test_bit_lenD)+)?,
    (* try to make progress (can't use +, would loop): *)
    (clarsimp simp: word_eqI_simps simp simp del: simp_del simp flip: flip
              split: split split del: split_del cong: cong)?,
    (* helps sometimes, rarely: *)
    (simp add: simp test_bit_conj_lt del: simp_del flip: flip split: split split del: split_del cong: cong)?)
 
 method word_eqI_solve uses simp simp_del split split_del cong flip =
   solves \<open>word_eqI simp: simp simp_del: simp_del split: split split_del: split_del
                    cong: cong simp flip: flip;
           (fastforce dest: test_bit_size simp: word_eqI_simps simp flip: flip
                      simp: simp simp del: simp_del split: split split del: split_del cong: cong)?\<close>
 
 end
diff --git a/thys/Word_Lib/Word_Lemmas.thy b/thys/Word_Lib/Word_Lemmas.thy
--- a/thys/Word_Lib/Word_Lemmas.thy
+++ b/thys/Word_Lib/Word_Lemmas.thy
@@ -1,6182 +1,6176 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Lemmas with Generic Word Length"
 
 theory Word_Lemmas
   imports
     "HOL-Word.Misc_lsb"
     Word_EqI
     Word_Enum
     "HOL-Library.Sublist"
 begin
 
+lemmas is_aligned_def = is_aligned_iff_dvd_nat
+
 lemma word_plus_mono_left:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>y \<le> z; x \<le> x + z\<rbrakk> \<Longrightarrow> y + x \<le> z + x"
   by unat_arith
 
 lemma word_shiftl_add_distrib:
   fixes x :: "'a :: len word"
   shows "(x + y) << n = (x << n) + (y << n)"
   by (simp add: shiftl_t2n ring_distribs)
 
 lemma less_Suc_unat_less_bound:
   "n < Suc (unat (x :: 'a :: len word)) \<Longrightarrow> n < 2 ^ LENGTH('a)"
   by (auto elim!: order_less_le_trans intro: Suc_leI)
 
 lemma up_ucast_inj:
   "\<lbrakk> ucast x = (ucast y::'b::len word); LENGTH('a) \<le> len_of TYPE ('b) \<rbrakk> \<Longrightarrow> x = (y::'a::len word)"
   by (subst (asm) bang_eq) (fastforce simp: nth_ucast word_size intro: word_eqI)
 
 lemmas ucast_up_inj = up_ucast_inj
 
 lemma up_ucast_inj_eq:
   "LENGTH('a) \<le> len_of TYPE ('b) \<Longrightarrow> (ucast x = (ucast y::'b::len word)) = (x = (y::'a::len word))"
   by (fastforce dest: up_ucast_inj)
 
 lemma no_plus_overflow_neg:
   "(x :: 'a :: len word) < -y \<Longrightarrow> x \<le> x + y"
   by (metis diff_minus_eq_add less_imp_le sub_wrap_lt)
 
 lemma ucast_ucast_eq:
   "\<lbrakk> ucast x = (ucast (ucast y::'a word)::'c::len word); LENGTH('a) \<le> LENGTH('b);
      LENGTH('b) \<le> LENGTH('c) \<rbrakk> \<Longrightarrow>
    x = ucast y" for x :: "'a::len word" and y :: "'b::len word"
   by (fastforce intro: word_eqI simp: bang_eq nth_ucast word_size)
 
 lemma ucast_0_I:
   "x = 0 \<Longrightarrow> ucast x = 0"
   by simp
 
 text \<open>right-padding a word to a certain length\<close>
 
 definition
   "bl_pad_to bl sz \<equiv> bl @ (replicate (sz - length bl) False)"
 
 lemma bl_pad_to_length:
   assumes lbl: "length bl \<le> sz"
   shows   "length (bl_pad_to bl sz) = sz"
   using lbl by (simp add: bl_pad_to_def)
 
 lemma bl_pad_to_prefix:
   "prefix bl (bl_pad_to bl sz)"
   by (simp add: bl_pad_to_def)
 
 lemma same_length_is_parallel:
   assumes len: "\<forall>y \<in> set as. length y = x"
   shows  "\<forall>x \<in> set as. \<forall>y \<in> set as - {x}. x \<parallel> y"
 proof (rule, rule)
   fix x y
   assume xi: "x \<in> set as" and yi: "y \<in> set as - {x}"
   from len obtain q where len': "\<forall>y \<in> set as. length y = q" ..
 
   show "x \<parallel> y"
   proof (rule not_equal_is_parallel)
     from xi yi show "x \<noteq> y" by auto
     from xi yi len' show "length x = length y" by (auto dest: bspec)
   qed
 qed
 
 text \<open>Lemmas about words\<close>
 
 lemmas and_bang = word_and_nth
 
 lemma of_drop_to_bl:
   "of_bl (drop n (to_bl x)) = (x && mask (size x - n))"
   by (simp add: of_bl_drop word_size_bl)
 
 lemma word_add_offset_less:
   fixes x :: "'a :: len word"
   assumes yv: "y < 2 ^ n"
   and     xv: "x < 2 ^ m"
   and     mnv: "sz < LENGTH('a :: len)"
   and    xv': "x < 2 ^ (LENGTH('a :: len) - n)"
   and     mn: "sz = m + n"
   shows   "x * 2 ^ n + y < 2 ^ sz"
 proof (subst mn)
   from mnv mn have nv: "n < LENGTH('a)" and mv: "m < LENGTH('a)"  by auto
 
   have uy: "unat y < 2 ^ n"
     by (rule order_less_le_trans [OF unat_mono [OF yv] order_eq_refl],
         rule unat_power_lower[OF nv])
 
   have ux: "unat x < 2 ^ m"
     by (rule order_less_le_trans [OF unat_mono [OF xv] order_eq_refl],
         rule unat_power_lower[OF mv])
 
   then show "x * 2 ^ n + y < 2 ^ (m + n)" using ux uy nv mnv xv'
     apply (subst word_less_nat_alt)
     apply (subst unat_word_ariths)+
     apply (subst mod_less)
      apply simp
      apply (subst mult.commute)
      apply (rule nat_less_power_trans [OF _ order_less_imp_le [OF nv]])
      apply (rule order_less_le_trans [OF unat_mono [OF xv']])
      apply (cases "n = 0"; simp)
     apply (subst unat_power_lower[OF nv])
     apply (subst mod_less)
      apply (erule order_less_le_trans [OF nat_add_offset_less], assumption)
       apply (rule mn)
      apply simp
     apply (simp add: mn mnv)
     apply (erule nat_add_offset_less; simp)
     done
 qed
 
 lemma word_less_power_trans:
   fixes n :: "'a :: len word"
   assumes nv: "n < 2 ^ (m - k)"
   and     kv: "k \<le> m"
   and     mv: "m < len_of TYPE ('a)"
   shows "2 ^ k * n < 2 ^ m"
   using nv kv mv
   apply -
   apply (subst word_less_nat_alt)
   apply (subst unat_word_ariths)
   apply (subst mod_less)
    apply simp
    apply (rule nat_less_power_trans)
     apply (erule order_less_trans [OF unat_mono])
     apply simp
    apply simp
   apply simp
   apply (rule nat_less_power_trans)
    apply (subst unat_power_lower[where 'a = 'a, symmetric])
     apply simp
    apply (erule unat_mono)
   apply simp
   done
 
 lemma Suc_unat_diff_1:
   fixes x :: "'a :: len word"
   assumes lt: "1 \<le> x"
   shows "Suc (unat (x - 1)) = unat x"
 proof -
   have "0 < unat x"
     by (rule order_less_le_trans [where y = 1], simp, subst unat_1 [symmetric],
         rule iffD1 [OF word_le_nat_alt lt])
 
   then show ?thesis
     by ((subst unat_sub [OF lt])+, simp only:  unat_1)
 qed
 
 lemma word_div_sub:
   fixes x :: "'a :: len word"
   assumes yx: "y \<le> x"
   and     y0: "0 < y"
   shows "(x - y) div y = x div y - 1"
   apply (rule word_unat.Rep_eqD)
   apply (subst unat_div)
   apply (subst unat_sub [OF yx])
   apply (subst unat_sub)
    apply (subst word_le_nat_alt)
    apply (subst unat_div)
    apply (subst le_div_geq)
      apply (rule order_le_less_trans [OF _ unat_mono [OF y0]])
      apply simp
     apply (subst word_le_nat_alt [symmetric], rule yx)
    apply simp
   apply (subst unat_div)
   apply (subst le_div_geq [OF _ iffD1 [OF word_le_nat_alt yx]])
    apply (rule order_le_less_trans [OF _ unat_mono [OF y0]])
    apply simp
   apply simp
   done
 
 lemma word_mult_less_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i < j"
   and    knz: "0 < k"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i * k < j * k"
 proof -
   from ij ujk knz have jk: "unat i * unat k < 2 ^ len_of TYPE ('a)"
     by (auto intro: order_less_subst2 simp: word_less_nat_alt elim: mult_less_mono1)
 
   then show ?thesis using ujk knz ij
     by (auto simp: word_less_nat_alt iffD1 [OF unat_mult_lem])
 qed
 
 lemma word_mult_less_dest:
   fixes i :: "'a :: len word"
   assumes ij: "i * k < j * k"
   and    uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i < j"
   using uik ujk ij
   by (auto simp: word_less_nat_alt iffD1 [OF unat_mult_lem] elim: mult_less_mono1)
 
 lemma word_mult_less_cancel:
   fixes k :: "'a :: len word"
   assumes knz: "0 < k"
   and    uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows "(i * k < j * k) = (i < j)"
   by (rule iffI [OF word_mult_less_dest [OF _ uik ujk] word_mult_less_mono1 [OF _ knz ujk]])
 
 lemma Suc_div_unat_helper:
   assumes szv: "sz < LENGTH('a :: len)"
   and   usszv: "us \<le> sz"
   shows "2 ^ (sz - us) = Suc (unat (((2::'a :: len word) ^ sz - 1) div 2 ^ us))"
 proof -
   note usv = order_le_less_trans [OF usszv szv]
 
   from usszv obtain q where qv: "sz = us + q" by (auto simp: le_iff_add)
 
   have "Suc (unat (((2:: 'a word) ^ sz - 1) div 2 ^ us)) =
     (2 ^ us + unat ((2:: 'a word) ^ sz - 1)) div 2 ^ us"
     apply (subst unat_div unat_power_lower[OF usv])+
     apply (subst div_add_self1, simp+)
     done
 
   also have "\<dots> = ((2 ^ us - 1) + 2 ^ sz) div 2 ^ us" using szv
     by (simp add: unat_minus_one)
 
   also have "\<dots> = 2 ^ q + ((2 ^ us - 1) div 2 ^ us)"
     apply (subst qv)
     apply (subst power_add)
     apply (subst div_mult_self2; simp)
     done
 
   also have "\<dots> = 2 ^ (sz - us)" using qv by simp
 
   finally show ?thesis ..
 qed
 
 
 lemma set_enum_word8_def:
   "(set enum::word8 set) = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
                             20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36,
                             37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53,
                             54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
                             71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87,
                             88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103,
                             104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117,
                             118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131,
                             132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145,
                             146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159,
                             160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173,
                             174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187,
                             188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201,
                             202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215,
                             216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229,
                             230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243,
                             244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255}"
   by eval
 
 lemma set_strip_insert: "\<lbrakk> x \<in> insert a S; x \<noteq> a \<rbrakk> \<Longrightarrow> x \<in> S"
   by simp
 
 lemma word8_exhaust:
   fixes x :: word8
   shows "\<lbrakk>x \<noteq> 0; x \<noteq> 1; x \<noteq> 2; x \<noteq> 3; x \<noteq> 4; x \<noteq> 5; x \<noteq> 6; x \<noteq> 7; x \<noteq> 8; x \<noteq> 9; x \<noteq> 10; x \<noteq> 11; x \<noteq>
           12; x \<noteq> 13; x \<noteq> 14; x \<noteq> 15; x \<noteq> 16; x \<noteq> 17; x \<noteq> 18; x \<noteq> 19; x \<noteq> 20; x \<noteq> 21; x \<noteq> 22; x \<noteq>
           23; x \<noteq> 24; x \<noteq> 25; x \<noteq> 26; x \<noteq> 27; x \<noteq> 28; x \<noteq> 29; x \<noteq> 30; x \<noteq> 31; x \<noteq> 32; x \<noteq> 33; x \<noteq>
           34; x \<noteq> 35; x \<noteq> 36; x \<noteq> 37; x \<noteq> 38; x \<noteq> 39; x \<noteq> 40; x \<noteq> 41; x \<noteq> 42; x \<noteq> 43; x \<noteq> 44; x \<noteq>
           45; x \<noteq> 46; x \<noteq> 47; x \<noteq> 48; x \<noteq> 49; x \<noteq> 50; x \<noteq> 51; x \<noteq> 52; x \<noteq> 53; x \<noteq> 54; x \<noteq> 55; x \<noteq>
           56; x \<noteq> 57; x \<noteq> 58; x \<noteq> 59; x \<noteq> 60; x \<noteq> 61; x \<noteq> 62; x \<noteq> 63; x \<noteq> 64; x \<noteq> 65; x \<noteq> 66; x \<noteq>
           67; x \<noteq> 68; x \<noteq> 69; x \<noteq> 70; x \<noteq> 71; x \<noteq> 72; x \<noteq> 73; x \<noteq> 74; x \<noteq> 75; x \<noteq> 76; x \<noteq> 77; x \<noteq>
           78; x \<noteq> 79; x \<noteq> 80; x \<noteq> 81; x \<noteq> 82; x \<noteq> 83; x \<noteq> 84; x \<noteq> 85; x \<noteq> 86; x \<noteq> 87; x \<noteq> 88; x \<noteq>
           89; x \<noteq> 90; x \<noteq> 91; x \<noteq> 92; x \<noteq> 93; x \<noteq> 94; x \<noteq> 95; x \<noteq> 96; x \<noteq> 97; x \<noteq> 98; x \<noteq> 99; x \<noteq>
           100; x \<noteq> 101; x \<noteq> 102; x \<noteq> 103; x \<noteq> 104; x \<noteq> 105; x \<noteq> 106; x \<noteq> 107; x \<noteq> 108; x \<noteq> 109; x \<noteq>
           110; x \<noteq> 111; x \<noteq> 112; x \<noteq> 113; x \<noteq> 114; x \<noteq> 115; x \<noteq> 116; x \<noteq> 117; x \<noteq> 118; x \<noteq> 119; x \<noteq>
           120; x \<noteq> 121; x \<noteq> 122; x \<noteq> 123; x \<noteq> 124; x \<noteq> 125; x \<noteq> 126; x \<noteq> 127; x \<noteq> 128; x \<noteq> 129; x \<noteq>
           130; x \<noteq> 131; x \<noteq> 132; x \<noteq> 133; x \<noteq> 134; x \<noteq> 135; x \<noteq> 136; x \<noteq> 137; x \<noteq> 138; x \<noteq> 139; x \<noteq>
           140; x \<noteq> 141; x \<noteq> 142; x \<noteq> 143; x \<noteq> 144; x \<noteq> 145; x \<noteq> 146; x \<noteq> 147; x \<noteq> 148; x \<noteq> 149; x \<noteq>
           150; x \<noteq> 151; x \<noteq> 152; x \<noteq> 153; x \<noteq> 154; x \<noteq> 155; x \<noteq> 156; x \<noteq> 157; x \<noteq> 158; x \<noteq> 159; x \<noteq>
           160; x \<noteq> 161; x \<noteq> 162; x \<noteq> 163; x \<noteq> 164; x \<noteq> 165; x \<noteq> 166; x \<noteq> 167; x \<noteq> 168; x \<noteq> 169; x \<noteq>
           170; x \<noteq> 171; x \<noteq> 172; x \<noteq> 173; x \<noteq> 174; x \<noteq> 175; x \<noteq> 176; x \<noteq> 177; x \<noteq> 178; x \<noteq> 179; x \<noteq>
           180; x \<noteq> 181; x \<noteq> 182; x \<noteq> 183; x \<noteq> 184; x \<noteq> 185; x \<noteq> 186; x \<noteq> 187; x \<noteq> 188; x \<noteq> 189; x \<noteq>
           190; x \<noteq> 191; x \<noteq> 192; x \<noteq> 193; x \<noteq> 194; x \<noteq> 195; x \<noteq> 196; x \<noteq> 197; x \<noteq> 198; x \<noteq> 199; x \<noteq>
           200; x \<noteq> 201; x \<noteq> 202; x \<noteq> 203; x \<noteq> 204; x \<noteq> 205; x \<noteq> 206; x \<noteq> 207; x \<noteq> 208; x \<noteq> 209; x \<noteq>
           210; x \<noteq> 211; x \<noteq> 212; x \<noteq> 213; x \<noteq> 214; x \<noteq> 215; x \<noteq> 216; x \<noteq> 217; x \<noteq> 218; x \<noteq> 219; x \<noteq>
           220; x \<noteq> 221; x \<noteq> 222; x \<noteq> 223; x \<noteq> 224; x \<noteq> 225; x \<noteq> 226; x \<noteq> 227; x \<noteq> 228; x \<noteq> 229; x \<noteq>
           230; x \<noteq> 231; x \<noteq> 232; x \<noteq> 233; x \<noteq> 234; x \<noteq> 235; x \<noteq> 236; x \<noteq> 237; x \<noteq> 238; x \<noteq> 239; x \<noteq>
           240; x \<noteq> 241; x \<noteq> 242; x \<noteq> 243; x \<noteq> 244; x \<noteq> 245; x \<noteq> 246; x \<noteq> 247; x \<noteq> 248; x \<noteq> 249; x \<noteq>
           250; x \<noteq> 251; x \<noteq> 252; x \<noteq> 253; x \<noteq> 254; x \<noteq> 255\<rbrakk> \<Longrightarrow> P"
   apply (subgoal_tac "x \<in> set enum", subst (asm) set_enum_word8_def)
     apply (drule set_strip_insert, assumption)+
    apply (erule emptyE)
   apply (subst enum_UNIV, rule UNIV_I)
   done
 
 lemma upto_enum_red':
   assumes lt: "1 \<le> X"
   shows "[(0::'a :: len word) .e. X - 1] =  map of_nat [0 ..< unat X]"
 proof -
   have lt': "unat X < 2 ^ LENGTH('a)"
     by (rule unat_lt2p)
 
   show ?thesis
     apply (subst upto_enum_red)
     apply (simp del: upt.simps)
     apply (subst Suc_unat_diff_1 [OF lt])
     apply (rule map_cong [OF refl])
     apply (rule toEnum_of_nat)
     apply simp
     apply (erule order_less_trans [OF _ lt'])
     done
 qed
 
 lemma upto_enum_red2:
   assumes szv: "sz < LENGTH('a :: len)"
   shows "[(0:: 'a :: len word) .e. 2 ^ sz - 1] =
   map of_nat [0 ..< 2 ^ sz]" using szv
   apply (subst unat_power_lower[OF szv, symmetric])
   apply (rule upto_enum_red')
   apply (subst word_le_nat_alt, simp)
   done
 
 lemma upto_enum_step_red:
   assumes szv: "sz < LENGTH('a)"
   and   usszv: "us \<le> sz"
   shows "[0 :: 'a :: len word , 2 ^ us .e. 2 ^ sz - 1] =
   map (\<lambda>x. of_nat x * 2 ^ us) [0 ..< 2 ^ (sz - us)]" using szv
   unfolding upto_enum_step_def
   apply (subst if_not_P)
    apply (rule leD)
    apply (subst word_le_nat_alt)
    apply (subst unat_minus_one)
     apply simp
    apply simp
   apply simp
   apply (subst upto_enum_red)
   apply (simp del: upt.simps)
   apply (subst Suc_div_unat_helper [where 'a = 'a, OF szv usszv, symmetric])
   apply clarsimp
   apply (subst toEnum_of_nat)
    apply (erule order_less_trans)
    using szv
    apply simp
   apply simp
   done
 
 lemma upto_enum_word:
   "[x .e. y] = map of_nat [unat x ..< Suc (unat y)]"
   apply (subst upto_enum_red)
   apply clarsimp
   apply (subst toEnum_of_nat)
    prefer 2
    apply (rule refl)
   apply (erule disjE, simp)
   apply clarsimp
   apply (erule order_less_trans)
   apply simp
   done
 
 lemma word_upto_Cons_eq:
   "x < y \<Longrightarrow> [x::'a::len word .e. y] = x # [x + 1 .e. y]"
   apply (subst upto_enum_red)
   apply (subst upt_conv_Cons, unat_arith)
   apply (simp only: list.map list.inject upto_enum_red to_from_enum simp_thms)
   apply (rule map_cong[OF _ refl])
   apply (rule arg_cong2[where f = "\<lambda>x y. [x ..< y]"], unat_arith)
   apply (rule refl)
   done
 
 lemma distinct_enum_upto:
   "distinct [(0 :: 'a::len word) .e. b]"
 proof -
   have "\<And>(b::'a word). [0 .e. b] = nths enum {..< Suc (fromEnum b)}"
     apply (subst upto_enum_red)
     apply (subst nths_upt_eq_take)
     apply (subst enum_word_def)
     apply (subst take_map)
     apply (subst take_upt)
      apply (simp only: add_0 fromEnum_unat)
      apply (rule order_trans [OF _ order_eq_refl])
       apply (rule Suc_leI [OF unat_lt2p])
      apply simp
     apply clarsimp
     apply (rule toEnum_of_nat)
     apply (erule order_less_trans [OF _ unat_lt2p])
     done
 
   then show ?thesis
     by (rule ssubst) (rule distinct_nthsI, simp)
 qed
 
 lemma upto_enum_set_conv [simp]:
   fixes a :: "'a :: len word"
   shows "set [a .e. b] = {x. a \<le> x \<and> x \<le> b}"
   apply (subst upto_enum_red)
   apply (subst set_map)
   apply safe
     apply simp
     apply clarsimp
     apply (erule disjE)
      apply simp
      apply (erule iffD2 [OF word_le_nat_alt])
     apply clarsimp
     apply (erule word_unat.Rep_cases [OF unat_le [OF order_less_imp_le]])
     apply simp
     apply (erule iffD2 [OF word_le_nat_alt])
    apply simp
 
    apply clarsimp
    apply (erule disjE)
     apply simp
    apply clarsimp
    apply (rule word_unat.Rep_cases [OF unat_le  [OF order_less_imp_le]])
     apply assumption
    apply simp
    apply (erule order_less_imp_le [OF iffD2 [OF word_less_nat_alt]])
   apply clarsimp
   apply (rule_tac x="fromEnum x" in image_eqI)
    apply clarsimp
   apply clarsimp
   apply (rule conjI)
    apply (subst word_le_nat_alt [symmetric])
    apply simp
   apply safe
    apply (simp add: word_le_nat_alt [symmetric])
   apply (simp add: word_less_nat_alt [symmetric])
   done
 
 lemma upto_enum_less:
   assumes xin: "x \<in> set [(a::'a::len word).e.2 ^ n - 1]"
   and     nv:  "n < LENGTH('a::len)"
   shows   "x < 2 ^ n"
 proof (cases n)
   case 0
   then show ?thesis using xin by simp
 next
   case (Suc m)
   show ?thesis using xin nv by simp
 qed
 
 lemma upto_enum_len_less:
   "\<lbrakk> n \<le> length [a, b .e. c]; n \<noteq> 0 \<rbrakk> \<Longrightarrow> a \<le> c"
   unfolding upto_enum_step_def
   by (simp split: if_split_asm)
 
 lemma length_upto_enum_step:
   fixes x :: "'a :: len word"
   shows "x \<le> z \<Longrightarrow> length [x , y .e. z] = (unat ((z - x) div (y - x))) + 1"
   unfolding upto_enum_step_def
   by (simp add: upto_enum_red)
 
 lemma map_length_unfold_one:
   fixes x :: "'a::len word"
   assumes xv: "Suc (unat x) < 2 ^ LENGTH('a)"
   and     ax: "a < x"
   shows   "map f [a .e. x] = f a # map f [a + 1 .e. x]"
   by (subst word_upto_Cons_eq, auto, fact+)
 
 lemma upto_enum_set_conv2:
   fixes a :: "'a::len word"
   shows "set [a .e. b] = {a .. b}"
   by auto
 
 lemma of_nat_unat [simp]:
   "of_nat \<circ> unat = id"
   by (rule ext, simp)
 
 lemma Suc_unat_minus_one [simp]:
   "x \<noteq> 0 \<Longrightarrow> Suc (unat (x - 1)) = unat x"
   by (metis Suc_diff_1 unat_gt_0 unat_minus_one)
 
 lemma word_add_le_dest:
   fixes i :: "'a :: len word"
   assumes le: "i + k \<le> j + k"
   and    uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i \<le> j"
   using uik ujk le
   by (auto simp: word_le_nat_alt iffD1 [OF unat_add_lem] elim: add_le_mono1)
 
 lemma mask_shift:
   "(x && ~~ (mask y)) >> y = x >> y"
   by word_eqI
 
 lemma word_add_le_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i \<le> j"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i + k \<le> j + k"
 proof -
   from ij ujk have jk: "unat i + unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_le_nat_alt elim: add_le_mono1)
 
   then show ?thesis using ujk ij
     by (auto simp: word_le_nat_alt iffD1 [OF unat_add_lem])
 qed
 
 lemma word_add_le_mono2:
   fixes i :: "'a :: len word"
   shows "\<lbrakk>i \<le> j; unat j + unat k < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow> k + i \<le> k + j"
   by (subst field_simps, subst field_simps, erule (1) word_add_le_mono1)
 
 lemma word_add_le_iff:
   fixes i :: "'a :: len word"
   assumes uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i + k \<le> j + k) = (i \<le> j)"
 proof
   assume "i \<le> j"
   show "i + k \<le> j + k" by (rule word_add_le_mono1) fact+
 next
   assume "i + k \<le> j + k"
   show "i \<le> j" by (rule word_add_le_dest) fact+
 qed
 
 lemma word_add_less_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i < j"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i + k < j + k"
 proof -
   from ij ujk have jk: "unat i + unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_less_nat_alt elim: add_less_mono1)
 
   then show ?thesis using ujk ij
     by (auto simp: word_less_nat_alt iffD1 [OF unat_add_lem])
 qed
 
 lemma word_add_less_dest:
   fixes i :: "'a :: len word"
   assumes le: "i + k < j + k"
   and    uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and    ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "i < j"
   using uik ujk le
   by (auto simp: word_less_nat_alt iffD1 [OF unat_add_lem] elim: add_less_mono1)
 
 lemma word_add_less_iff:
   fixes i :: "'a :: len word"
   assumes uik: "unat i + unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j + unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i + k < j + k) = (i < j)"
 proof
   assume "i < j"
   show "i + k < j + k" by (rule word_add_less_mono1) fact+
 next
   assume "i + k < j + k"
   show "i < j" by (rule word_add_less_dest) fact+
 qed
 
 lemma shiftr_div_2n':
   "unat (w >> n) = unat w div 2 ^ n"
-  apply (unfold unat_def)
+  apply (unfold unat_eq_nat_uint)
   apply (subst shiftr_div_2n)
   apply (subst nat_div_distrib)
    apply simp
   apply (simp add: nat_power_eq)
   done
 
 lemma shiftl_shiftr_id:
   assumes nv: "n < LENGTH('a)"
   and     xv: "x < 2 ^ (LENGTH('a) - n)"
   shows "x << n >> n = (x::'a::len word)"
   apply (simp add: shiftl_t2n)
   apply (rule word_unat.Rep_eqD)
   apply (subst shiftr_div_2n')
   apply (cases n)
    apply simp
   apply (subst iffD1 [OF unat_mult_lem])+
    apply (subst unat_power_lower[OF nv])
    apply (rule nat_less_power_trans [OF _ order_less_imp_le [OF nv]])
    apply (rule order_less_le_trans [OF unat_mono [OF xv] order_eq_refl])
    apply (rule unat_power_lower)
    apply simp
   apply (subst unat_power_lower[OF nv])
   apply simp
   done
 
 lemma ucast_shiftl_eq_0:
   fixes w :: "'a :: len word"
   shows "\<lbrakk> n \<ge> LENGTH('b) \<rbrakk> \<Longrightarrow> ucast (w << n) = (0 :: 'b :: len word)"
   by (case_tac "size w \<le> n", clarsimp simp: shiftl_zero_size)
      (clarsimp simp: not_le ucast_bl bl_shiftl bang_eq test_bit_of_bl rev_nth nth_append)
 
 lemma word_mult_less_iff:
   fixes i :: "'a :: len word"
   assumes knz: "0 < k"
   and     uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i * k < j * k) = (i < j)"
   using assms by (rule word_mult_less_cancel)
 
 lemma word_le_imp_diff_le:
   fixes n :: "'a::len word"
   shows "\<lbrakk>k \<le> n; n \<le> m\<rbrakk> \<Longrightarrow> n - k \<le> m"
   by (auto simp: unat_sub word_le_nat_alt)
 
 lemma word_less_imp_diff_less:
   fixes n :: "'a::len word"
   shows "\<lbrakk>k \<le> n; n < m\<rbrakk> \<Longrightarrow> n - k < m"
   by (clarsimp simp: unat_sub word_less_nat_alt
              intro!: less_imp_diff_less)
 
 lemma word_mult_le_mono1:
   fixes i :: "'a :: len word"
   assumes ij: "i \<le> j"
   and    knz: "0 < k"
   and    ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "i * k \<le> j * k"
 proof -
   from ij ujk knz have jk: "unat i * unat k < 2 ^ len_of TYPE ('a)"
     by (auto elim: order_le_less_subst2 simp: word_le_nat_alt elim: mult_le_mono1)
 
   then show ?thesis using ujk knz ij
     by (auto simp: word_le_nat_alt iffD1 [OF unat_mult_lem])
 qed
 
 lemma word_mult_le_iff:
   fixes i :: "'a :: len word"
   assumes knz: "0 < k"
   and     uik: "unat i * unat k < 2 ^ len_of TYPE ('a)"
   and     ujk: "unat j * unat k < 2 ^ len_of TYPE ('a)"
   shows  "(i * k \<le> j * k) = (i \<le> j)"
 proof
   assume "i \<le> j"
   show "i * k \<le> j * k" by (rule word_mult_le_mono1) fact+
 next
   assume p: "i * k \<le> j * k"
 
   have "0 < unat k" using knz by (simp add: word_less_nat_alt)
   then show "i \<le> j" using p
     by (clarsimp simp: word_le_nat_alt iffD1 [OF unat_mult_lem uik]
       iffD1 [OF unat_mult_lem ujk])
 qed
 
 lemma word_diff_less:
   fixes n :: "'a :: len word"
   shows "\<lbrakk>0 < n; 0 < m; n \<le> m\<rbrakk> \<Longrightarrow> m - n < m"
   apply (subst word_less_nat_alt)
   apply (subst unat_sub)
    apply assumption
   apply (rule diff_less)
    apply (simp_all add: word_less_nat_alt)
    done
 
 lemma MinI:
   assumes fa: "finite A"
   and     ne: "A \<noteq> {}"
   and     xv: "m \<in> A"
   and    min: "\<forall>y \<in> A. m \<le> y"
   shows "Min A = m" using fa ne xv min
 proof (induct A arbitrary: m rule: finite_ne_induct)
   case singleton then show ?case by simp
 next
   case (insert y F)
 
   from insert.prems have yx: "m \<le> y" and fx: "\<forall>y \<in> F. m \<le> y" by auto
   have "m \<in> insert y F" by fact
   then show ?case
   proof
     assume mv: "m = y"
 
     have mlt: "m \<le> Min F"
       by (rule iffD2 [OF Min_ge_iff [OF insert.hyps(1) insert.hyps(2)] fx])
 
     show ?case
       apply (subst Min_insert [OF insert.hyps(1) insert.hyps(2)])
       apply (subst mv [symmetric])
       apply (auto simp: min_def mlt)
       done
   next
     assume "m \<in> F"
     then have mf: "Min F = m"
       by (rule insert.hyps(4) [OF _ fx])
 
     show ?case
       apply (subst Min_insert [OF insert.hyps(1) insert.hyps(2)])
       apply (subst mf)
       apply (rule iffD2 [OF _ yx])
       apply (auto simp: min_def)
       done
   qed
 qed
 
 lemma length_upto_enum [simp]:
   fixes a :: "'a :: len word"
   shows "length [a .e. b] = Suc (unat b) - unat a"
   apply (simp add: word_le_nat_alt upto_enum_red)
   apply (clarsimp simp: Suc_diff_le)
   done
 
 lemma length_upto_enum_cases:
   fixes a :: "'a::len word"
   shows "length [a .e. b] = (if a \<le> b then Suc (unat b) - unat a else 0)"
   apply (case_tac "a \<le> b")
    apply (clarsimp)
   apply (clarsimp simp: upto_enum_def)
   apply unat_arith
   done
 
 lemma length_upto_enum_less_one:
   "\<lbrakk>a \<le> b; b \<noteq> 0\<rbrakk>
   \<Longrightarrow> length [a .e. b - 1] = unat (b - a)"
   apply clarsimp
   apply (subst unat_sub[symmetric], assumption)
   apply clarsimp
   done
 
 lemma drop_upto_enum:
   "drop (unat n) [0 .e. m] = [n .e. m]"
   apply (clarsimp simp: upto_enum_def)
   apply (induct m, simp)
   by (metis drop_map drop_upt plus_nat.add_0)
 
 lemma distinct_enum_upto' [simp]:
   "distinct [a::'a::len word .e. b]"
   apply (subst drop_upto_enum [symmetric])
   apply (rule distinct_drop)
   apply (rule distinct_enum_upto)
   done
 
 lemma length_interval:
   "\<lbrakk>set xs = {x. (a::'a::len word) \<le> x \<and> x \<le> b}; distinct xs\<rbrakk>
   \<Longrightarrow> length xs = Suc (unat b) - unat a"
   apply (frule distinct_card)
   apply (subgoal_tac "set xs = set [a .e. b]")
    apply (cut_tac distinct_card [where xs="[a .e. b]"])
     apply (subst (asm) length_upto_enum)
     apply clarsimp
    apply (rule distinct_enum_upto')
   apply simp
   done
 
 lemma not_empty_eq:
   "(S \<noteq> {}) = (\<exists>x. x \<in> S)"
   by auto
 
 lemma range_subset_lower:
   fixes c :: "'a ::linorder"
   shows "\<lbrakk> {a..b} \<subseteq> {c..d}; x \<in> {a..b} \<rbrakk> \<Longrightarrow> c \<le> a"
   apply (frule (1) subsetD)
   apply (rule classical)
   apply clarsimp
   done
 
 lemma range_subset_upper:
   fixes c :: "'a ::linorder"
   shows "\<lbrakk> {a..b} \<subseteq> {c..d}; x \<in> {a..b} \<rbrakk> \<Longrightarrow> b \<le> d"
   apply (frule (1) subsetD)
   apply (rule classical)
   apply clarsimp
   done
 
 lemma range_subset_eq:
   fixes a::"'a::linorder"
   assumes non_empty: "a \<le> b"
   shows "({a..b} \<subseteq> {c..d}) = (c \<le> a \<and> b \<le> d)"
   apply (insert non_empty)
   apply (rule iffI)
    apply (frule range_subset_lower [where x=a], simp)
    apply (drule range_subset_upper [where x=a], simp)
    apply simp
   apply auto
   done
 
 lemma range_eq:
   fixes a::"'a::linorder"
   assumes non_empty: "a \<le> b"
   shows "({a..b} = {c..d}) = (a = c \<and> b = d)"
   by (metis atLeastatMost_subset_iff eq_iff non_empty)
 
 lemma range_strict_subset_eq:
   fixes a::"'a::linorder"
   assumes non_empty: "a \<le> b"
   shows "({a..b} \<subset> {c..d}) = (c \<le> a \<and> b \<le> d \<and> (a = c \<longrightarrow> b \<noteq> d))"
   apply (insert non_empty)
   apply (subst psubset_eq)
   apply (subst range_subset_eq, assumption+)
   apply (subst range_eq, assumption+)
   apply simp
   done
 
 lemma range_subsetI:
   fixes x :: "'a :: order"
   assumes xX: "X \<le> x"
   and     yY: "y \<le> Y"
   shows   "{x .. y} \<subseteq> {X .. Y}"
   using xX yY by auto
 
 lemma set_False [simp]:
   "(set bs \<subseteq> {False}) = (True \<notin> set bs)" by auto
 
 declare of_nat_power [simp del]
 
 (* TODO: move to word *)
 lemma unat_of_bl_length:
   "unat (of_bl xs :: 'a::len word) < 2 ^ (length xs)"
 proof (cases "length xs < LENGTH('a)")
   case True
   then have "(of_bl xs::'a::len word) < 2 ^ length xs"
     by (simp add: of_bl_length_less)
   with True
   show ?thesis
     by (simp add: word_less_nat_alt word_unat_power unat_of_nat)
 next
   case False
   have "unat (of_bl xs::'a::len word) < 2 ^ LENGTH('a)"
     by (simp split: unat_split)
   also
   from False
   have "LENGTH('a) \<le> length xs" by simp
   then have "2 ^ LENGTH('a) \<le> (2::nat) ^ length xs"
     by (rule power_increasing) simp
   finally
   show ?thesis .
 qed
 
 lemma is_aligned_0'[simp]:
   "is_aligned 0 n"
   by (simp add: is_aligned_def)
 
 lemma p_assoc_help:
   fixes p :: "'a::{ring,power,numeral,one}"
   shows "p + 2^sz - 1 = p + (2^sz - 1)"
   by simp
 
 lemma word_add_increasing:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> p + w \<le> x; p \<le> p + w \<rbrakk> \<Longrightarrow> p \<le> x"
   by unat_arith
 
 lemma word_random:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> p \<le> p + x'; x \<le> x' \<rbrakk> \<Longrightarrow> p \<le> p + x"
   by unat_arith
 
 lemma word_sub_mono:
   "\<lbrakk> a \<le> c; d \<le> b; a - b \<le> a; c - d \<le> c \<rbrakk>
     \<Longrightarrow> (a - b) \<le> (c - d :: 'a :: len word)"
   by unat_arith
 
 lemma power_not_zero:
   "n < LENGTH('a::len) \<Longrightarrow> (2 :: 'a word) ^ n \<noteq> 0"
   by (metis p2_gt_0 word_neq_0_conv)
 
 lemma word_gt_a_gt_0:
   "a < n \<Longrightarrow> (0 :: 'a::len word) < n"
   apply (case_tac "n = 0")
    apply clarsimp
   apply (clarsimp simp: word_neq_0_conv)
   done
 
 lemma word_shift_nonzero:
   "\<lbrakk> (x::'a::len word) \<le> 2 ^ m; m + n < LENGTH('a::len); x \<noteq> 0\<rbrakk>
    \<Longrightarrow> x << n \<noteq> 0"
   apply (simp only: word_neq_0_conv word_less_nat_alt
                     shiftl_t2n mod_0 unat_word_ariths
                     unat_power_lower word_le_nat_alt)
   apply (subst mod_less)
    apply (rule order_le_less_trans)
     apply (erule mult_le_mono2)
    apply (subst power_add[symmetric])
    apply (rule power_strict_increasing)
     apply simp
    apply simp
   apply simp
   done
 
 lemma word_power_less_1 [simp]:
   "sz < LENGTH('a::len) \<Longrightarrow> (2::'a word) ^ sz - 1 < 2 ^ sz"
   apply (simp add: word_less_nat_alt)
   apply (subst unat_minus_one)
   apply (simp add: word_unat.Rep_inject [symmetric])
   apply simp
   done
 
 lemma nasty_split_lt:
   "\<lbrakk> (x :: 'a:: len word) < 2 ^ (m - n); n \<le> m; m < LENGTH('a::len) \<rbrakk>
      \<Longrightarrow> x * 2 ^ n + (2 ^ n - 1) \<le> 2 ^ m - 1"
   apply (simp only: add_diff_eq)
   apply (subst mult_1[symmetric], subst distrib_right[symmetric])
   apply (rule word_sub_mono)
      apply (rule order_trans)
       apply (rule word_mult_le_mono1)
         apply (rule inc_le)
         apply assumption
        apply (subst word_neq_0_conv[symmetric])
        apply (rule power_not_zero)
        apply simp
       apply (subst unat_power_lower, simp)+
       apply (subst power_add[symmetric])
       apply (rule power_strict_increasing)
        apply simp
       apply simp
      apply (subst power_add[symmetric])
      apply simp
     apply simp
    apply (rule word_sub_1_le)
    apply (subst mult.commute)
    apply (subst shiftl_t2n[symmetric])
    apply (rule word_shift_nonzero)
      apply (erule inc_le)
     apply simp
    apply (unat_arith)
   apply (drule word_power_less_1)
   apply simp
   done
 
 lemma nasty_split_less:
   "\<lbrakk>m \<le> n; n \<le> nm; nm < LENGTH('a::len); x < 2 ^ (nm - n)\<rbrakk>
    \<Longrightarrow> (x :: 'a word) * 2 ^ n + (2 ^ m - 1) < 2 ^ nm"
   apply (simp only: word_less_sub_le[symmetric])
   apply (rule order_trans [OF _ nasty_split_lt])
      apply (rule word_plus_mono_right)
       apply (rule word_sub_mono)
          apply (simp add: word_le_nat_alt)
         apply simp
        apply (simp add: word_sub_1_le[OF power_not_zero])
       apply (simp add: word_sub_1_le[OF power_not_zero])
      apply (rule is_aligned_no_wrap')
       apply (rule is_aligned_mult_triv2)
      apply simp
     apply (erule order_le_less_trans, simp)
    apply simp+
   done
 
 lemma int_not_emptyD:
   "A \<inter> B \<noteq> {} \<Longrightarrow> \<exists>x. x \<in> A \<and> x \<in> B"
   by (erule contrapos_np, clarsimp simp: disjoint_iff_not_equal)
 
 lemma unat_less_power:
   fixes k :: "'a::len word"
   assumes szv: "sz < LENGTH('a)"
   and     kv:  "k < 2 ^ sz"
   shows   "unat k < 2 ^ sz"
   using szv unat_mono [OF kv] by simp
 
 lemma unat_mult_power_lem:
   assumes kv: "k < 2 ^ (LENGTH('a::len) - sz)"
   shows "unat (2 ^ sz * of_nat k :: (('a::len) word)) = 2 ^ sz * k"
 proof cases
   assume szv: "sz < LENGTH('a::len)"
   show ?thesis
   proof (cases "sz = 0")
     case True
     then show ?thesis using kv szv
      by (simp add: unat_of_nat)
   next
     case False
     then have sne: "0 < sz" ..
 
     have uk: "unat (of_nat k :: 'a word) = k"
       apply (subst unat_of_nat)
       apply (simp add: nat_mod_eq less_trans[OF kv] sne)
       done
 
     show ?thesis using szv
       apply (subst iffD1 [OF unat_mult_lem])
       apply (simp add: uk nat_less_power_trans[OF kv order_less_imp_le [OF szv]])+
       done
   qed
 next
   assume "\<not> sz < LENGTH('a)"
   with kv show ?thesis by (simp add: not_less power_overflow)
 qed
 
 lemma aligned_add_offset_no_wrap:
   fixes off :: "('a::len) word"
   and     x :: "'a word"
   assumes al: "is_aligned x sz"
   and   offv: "off < 2 ^ sz"
   shows  "unat x + unat off < 2 ^ LENGTH('a)"
 proof cases
   assume szv: "sz < LENGTH('a)"
   from al obtain k where xv: "x = 2 ^ sz * (of_nat k)"
     and kl: "k < 2 ^ (LENGTH('a) - sz)"
     by (auto elim: is_alignedE)
 
   show ?thesis using szv
     apply (subst xv)
     apply (subst unat_mult_power_lem[OF kl])
     apply (subst mult.commute, rule nat_add_offset_less)
       apply (rule less_le_trans[OF unat_mono[OF offv, simplified]])
       apply (erule eq_imp_le[OF unat_power_lower])
      apply (rule kl)
     apply simp
    done
 next
   assume "\<not> sz < LENGTH('a)"
   with offv show ?thesis by (simp add: not_less power_overflow )
 qed
 
 lemma aligned_add_offset_mod:
   fixes x :: "('a::len) word"
   assumes al: "is_aligned x sz"
   and     kv: "k < 2 ^ sz"
   shows   "(x + k) mod 2 ^ sz = k"
 proof cases
   assume szv: "sz < LENGTH('a)"
 
   have ux: "unat x + unat k < 2 ^ LENGTH('a)"
     by (rule aligned_add_offset_no_wrap) fact+
 
   show ?thesis using al szv
     apply -
     apply (erule is_alignedE)
     apply (subst word_unat.Rep_inject [symmetric])
     apply (subst unat_mod)
     apply (subst iffD1 [OF unat_add_lem], rule ux)
     apply simp
     apply (subst unat_mult_power_lem, assumption+)
     apply (simp)
     apply (rule mod_less[OF less_le_trans[OF unat_mono], OF kv])
     apply (erule eq_imp_le[OF unat_power_lower])
     done
 next
   assume "\<not> sz < LENGTH('a)"
   with al show ?thesis
-    by (simp add: not_less power_overflow is_aligned_mask mask_def
+    by (simp add: not_less power_overflow is_aligned_mask mask_eq_decr_exp
                   word_mod_by_0)
 qed
 
 lemma word_plus_mcs_4:
   "\<lbrakk>v + x \<le> w + x; x \<le> v + x\<rbrakk> \<Longrightarrow> v \<le> (w::'a::len word)"
   by uint_arith
 
 lemma word_plus_mcs_3:
   "\<lbrakk>v \<le> w; x \<le> w + x\<rbrakk> \<Longrightarrow> v + x \<le> w + (x::'a::len word)"
   by unat_arith
 
 lemma aligned_neq_into_no_overlap:
   fixes x :: "'a::len word"
   assumes neq: "x \<noteq> y"
   and     alx: "is_aligned x sz"
   and     aly: "is_aligned y sz"
   shows  "{x .. x + (2 ^ sz - 1)} \<inter> {y .. y + (2 ^ sz - 1)} = {}"
 proof cases
   assume szv: "sz < LENGTH('a)"
   show ?thesis
   proof (rule equals0I, clarsimp)
     fix z
     assume xb: "x \<le> z" and xt: "z \<le> x + (2 ^ sz - 1)"
       and yb: "y \<le> z" and yt: "z \<le> y + (2 ^ sz - 1)"
 
     have rl: "\<And>(p::'a word) k w. \<lbrakk>uint p + uint k < 2 ^ LENGTH('a); w = p + k; w \<le> p + (2 ^ sz - 1) \<rbrakk>
       \<Longrightarrow> k < 2 ^ sz"
       apply -
       apply simp
       apply (subst (asm) add.commute, subst (asm) add.commute, drule word_plus_mcs_4)
       apply (subst add.commute, subst no_plus_overflow_uint_size)
       apply (simp add: word_size_bl)
       apply (erule iffD1 [OF word_less_sub_le[OF szv]])
       done
 
     from xb obtain kx where
       kx: "z = x + kx" and
       kxl: "uint x + uint kx < 2 ^ LENGTH('a)"
       by (clarsimp dest!: word_le_exists')
 
     from yb obtain ky where
       ky: "z = y + ky" and
       kyl: "uint y + uint ky < 2 ^ LENGTH('a)"
       by (clarsimp dest!: word_le_exists')
 
     have "x = y"
     proof -
       have "kx = z mod 2 ^ sz"
       proof (subst kx, rule sym, rule aligned_add_offset_mod)
         show "kx < 2 ^ sz" by (rule rl) fact+
       qed fact+
 
       also have "\<dots> = ky"
       proof (subst ky, rule aligned_add_offset_mod)
         show "ky < 2 ^ sz"
           using kyl ky yt by (rule rl)
       qed fact+
 
       finally have kxky: "kx = ky" .
       moreover have "x + kx = y + ky" by (simp add: kx [symmetric] ky [symmetric])
       ultimately show ?thesis by simp
     qed
 
     then show False using neq by simp
   qed
 next
   assume "\<not> sz < LENGTH('a)"
   with neq alx aly
-  have False by (simp add: is_aligned_mask mask_def power_overflow)
+  have False by (simp add: is_aligned_mask mask_eq_decr_exp power_overflow)
   then show ?thesis ..
 qed
 
 lemma less_two_pow_divD:
   "\<lbrakk> (x :: nat) < 2 ^ n div 2 ^ m \<rbrakk>
     \<Longrightarrow> n \<ge> m \<and> (x < 2 ^ (n - m))"
   apply (rule context_conjI)
    apply (rule ccontr)
    apply (simp add: power_strict_increasing)
   apply (simp add: power_sub)
   done
 
 lemma less_two_pow_divI:
   "\<lbrakk> (x :: nat) < 2 ^ (n - m); m \<le> n \<rbrakk> \<Longrightarrow> x < 2 ^ n div 2 ^ m"
   by (simp add: power_sub)
 
 lemma word_less_two_pow_divI:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ (n - m); m \<le> n; n < LENGTH('a) \<rbrakk> \<Longrightarrow> x < 2 ^ n div 2 ^ m"
   apply (simp add: word_less_nat_alt)
   apply (subst unat_word_ariths)
   apply (subst mod_less)
    apply (rule order_le_less_trans [OF div_le_dividend])
    apply (rule unat_lt2p)
   apply (simp add: power_sub)
   done
 
 lemma word_less_two_pow_divD:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ n div 2 ^ m \<rbrakk>
      \<Longrightarrow> n \<ge> m \<and> (x < 2 ^ (n - m))"
   apply (cases "n < LENGTH('a)")
    apply (cases "m < LENGTH('a)")
     apply (simp add: word_less_nat_alt)
     apply (subst(asm) unat_word_ariths)
     apply (subst(asm) mod_less)
      apply (rule order_le_less_trans [OF div_le_dividend])
      apply (rule unat_lt2p)
     apply (clarsimp dest!: less_two_pow_divD)
    apply (simp add: power_overflow)
    apply (simp add: word_div_def)
   apply (simp add: power_overflow word_div_def)
   done
 
 lemma of_nat_less_two_pow_div_set:
   "\<lbrakk> n < LENGTH('a) \<rbrakk> \<Longrightarrow>
    {x. x < (2 ^ n div 2 ^ m :: 'a::len word)}
       = of_nat ` {k. k < 2 ^ n div 2 ^ m}"
   apply (simp add: image_def)
   apply (safe dest!: word_less_two_pow_divD less_two_pow_divD
              intro!: word_less_two_pow_divI)
    apply (rule_tac x="unat x" in exI)
    apply (simp add: power_sub[symmetric])
    apply (subst unat_power_lower[symmetric, where 'a='a])
     apply simp
    apply (erule unat_mono)
   apply (subst word_unat_power)
   apply (rule of_nat_mono_maybe)
    apply (rule power_strict_increasing)
     apply simp
    apply simp
   apply assumption
   done
 
 lemma  word_less_power_trans2:
   fixes n :: "'a::len word"
   shows "\<lbrakk>n < 2 ^ (m - k); k \<le> m; m < LENGTH('a)\<rbrakk> \<Longrightarrow> n * 2 ^ k < 2 ^ m"
   by (subst field_simps, rule word_less_power_trans)
 
 (* shadows the slightly weaker Word.nth_ucast *)
 lemma nth_ucast:
   "(ucast (w::'a::len word)::'b::len word) !! n =
    (w !! n \<and> n < min LENGTH('a) LENGTH('b))"
-  by (simp add: ucast_def test_bit_bin word_ubin.eq_norm nth_bintr word_size)
+  by (simp add: ucast_eq test_bit_bin word_ubin.eq_norm nth_bintr word_size)
      (fast elim!: bin_nth_uint_imp)
 
 lemma ucast_less:
   "LENGTH('b) < LENGTH('a) \<Longrightarrow>
    (ucast (x :: 'b :: len word) :: ('a :: len word)) < 2 ^ LENGTH('b)"
   by (meson Word.nth_ucast test_bit_conj_lt le_def upper_bits_unset_is_l2p)
 
 lemma ucast_range_less:
   "LENGTH('a :: len) < LENGTH('b :: len) \<Longrightarrow>
    range (ucast :: 'a word \<Rightarrow> 'b word) = {x. x < 2 ^ len_of TYPE ('a)}"
   apply safe
    apply (erule ucast_less)
   apply (simp add: image_def)
   apply (rule_tac x="ucast x" in exI)
   by word_eqI_solve
 
 lemma word_power_less_diff:
   "\<lbrakk>2 ^ n * q < (2::'a::len word) ^ m; q < 2 ^ (LENGTH('a) - n)\<rbrakk> \<Longrightarrow> q < 2 ^ (m - n)"
   apply (case_tac "m \<ge> LENGTH('a)")
    apply (simp add: power_overflow)
   apply (case_tac "n \<ge> LENGTH('a)")
    apply (simp add: power_overflow)
   apply (cases "n = 0")
    apply simp
   apply (subst word_less_nat_alt)
   apply (subst unat_power_lower)
    apply simp
   apply (rule nat_power_less_diff)
   apply (simp add: word_less_nat_alt)
   apply (subst (asm) iffD1 [OF unat_mult_lem])
    apply (simp add:nat_less_power_trans)
   apply simp
   done
 
 lemmas word_diff_ls'' = word_diff_ls [where xa=x and x=x for x]
 lemmas word_diff_ls' = word_diff_ls'' [simplified]
 
 lemmas word_l_diffs' = word_l_diffs [where xa=x and x=x for x]
 lemmas word_l_diffs = word_l_diffs' [simplified]
 
 lemma is_aligned_diff:
   fixes m :: "'a::len word"
   assumes alm: "is_aligned m s1"
   and     aln: "is_aligned n s2"
   and    s2wb: "s2 < LENGTH('a)"
   and      nm: "m \<in> {n .. n + (2 ^ s2 - 1)}"
   and    s1s2: "s1 \<le> s2"
   and     s10: "0 < s1" (* Probably can be folded into the proof \<dots> *)
   shows  "\<exists>q. m - n = of_nat q * 2 ^ s1 \<and> q < 2 ^ (s2 - s1)"
 proof -
   have rl: "\<And>m s. \<lbrakk> m < 2 ^ (LENGTH('a) - s); s < LENGTH('a) \<rbrakk> \<Longrightarrow> unat ((2::'a word) ^ s * of_nat m) = 2 ^ s * m"
   proof -
     fix m :: nat and  s
     assume m: "m < 2 ^ (LENGTH('a) - s)" and s: "s < LENGTH('a)"
     then have "unat ((of_nat m) :: 'a word) = m"
       apply (subst unat_of_nat)
       apply (subst mod_less)
        apply (erule order_less_le_trans)
        apply (rule power_increasing)
         apply simp_all
       done
 
     then show "?thesis m s" using s m
       apply (subst iffD1 [OF unat_mult_lem])
       apply (simp add: nat_less_power_trans)+
       done
   qed
   have s1wb: "s1 < LENGTH('a)" using s2wb s1s2 by simp
   from alm obtain mq where mmq: "m = 2 ^ s1 * of_nat mq" and mq: "mq < 2 ^ (LENGTH('a) - s1)"
     by (auto elim: is_alignedE simp: field_simps)
   from aln obtain nq where nnq: "n = 2 ^ s2 * of_nat nq" and nq: "nq < 2 ^ (LENGTH('a) - s2)"
     by (auto elim: is_alignedE simp: field_simps)
   from s1s2 obtain sq where sq: "s2 = s1 + sq" by (auto simp: le_iff_add)
 
   note us1 = rl [OF mq s1wb]
   note us2 = rl [OF nq s2wb]
 
   from nm have "n \<le> m" by clarsimp
   then have "(2::'a word) ^ s2 * of_nat nq \<le> 2 ^ s1 * of_nat mq" using nnq mmq by simp
   then have "2 ^ s2 * nq \<le> 2 ^ s1 * mq" using s1wb s2wb
     by (simp add: word_le_nat_alt us1 us2)
   then have nqmq: "2 ^ sq * nq \<le> mq" using sq by (simp add: power_add)
 
   have "m - n = 2 ^ s1 * of_nat mq - 2 ^ s2 * of_nat nq" using mmq nnq by simp
   also have "\<dots> = 2 ^ s1 * of_nat mq - 2 ^ s1 * 2 ^ sq * of_nat nq" using sq by (simp add: power_add)
   also have "\<dots> = 2 ^ s1 * (of_nat mq - 2 ^ sq * of_nat nq)" by (simp add: field_simps)
   also have "\<dots> = 2 ^ s1 * of_nat (mq - 2 ^ sq * nq)" using s1wb s2wb us1 us2 nqmq
     by (simp add:  word_unat_power)
   finally have mn: "m - n = of_nat (mq - 2 ^ sq * nq) * 2 ^ s1" by simp
   moreover
   from nm have "m - n \<le> 2 ^ s2 - 1"
     by - (rule word_diff_ls', (simp add: field_simps)+)
   then have "(2::'a word) ^ s1 * of_nat (mq - 2 ^ sq * nq) < 2 ^ s2" using mn s2wb by (simp add: field_simps)
   then have "of_nat (mq - 2 ^ sq * nq) < (2::'a word) ^ (s2 - s1)"
   proof (rule word_power_less_diff)
     have mm: "mq - 2 ^ sq * nq < 2 ^ (LENGTH('a) - s1)" using mq by simp
     moreover from s10 have "LENGTH('a) - s1 < LENGTH('a)"
       by (rule diff_less, simp)
     ultimately show "of_nat (mq - 2 ^ sq * nq) < (2::'a word) ^ (LENGTH('a) - s1)"
       apply (simp add: word_less_nat_alt)
       apply (subst unat_of_nat)
       apply (subst mod_less)
        apply (erule order_less_le_trans)
        apply simp+
       done
   qed
   then have "mq - 2 ^ sq * nq < 2 ^ (s2 - s1)" using mq s2wb
     apply (simp add: word_less_nat_alt)
     apply (subst (asm) unat_of_nat)
     apply (subst (asm) mod_less)
     apply (rule order_le_less_trans)
     apply (rule diff_le_self)
     apply (erule order_less_le_trans)
     apply simp
     apply assumption
     done
   ultimately show ?thesis by auto
 qed
 
 lemma word_less_sub_1:
   "x < (y :: 'a :: len word) \<Longrightarrow> x \<le> y - 1"
   apply (erule udvd_minus_le')
    apply (simp add: udvd_def)+
   done
 
 lemma word_sub_mono2:
   "\<lbrakk> a + b \<le> c + d; c \<le> a; b \<le> a + b; d \<le> c + d \<rbrakk>
     \<Longrightarrow> b \<le> (d :: 'a :: len word)"
   apply (drule(1) word_sub_mono)
     apply simp
    apply simp
   apply simp
   done
 
 lemma word_not_le:
   "(\<not> x \<le> (y :: 'a :: len word)) = (y < x)"
   by fastforce
 
 lemma word_subset_less:
   "\<lbrakk> {x .. x + r - 1} \<subseteq> {y .. y + s - 1};
      x \<le> x + r - 1; y \<le> y + (s :: 'a :: len word) - 1;
      s \<noteq> 0 \<rbrakk>
      \<Longrightarrow> r \<le> s"
   apply (frule subsetD[where c=x])
    apply simp
   apply (drule subsetD[where c="x + r - 1"])
    apply simp
   apply (clarsimp simp: add_diff_eq[symmetric])
   apply (drule(1) word_sub_mono2)
     apply (simp_all add: olen_add_eqv[symmetric])
   apply (erule word_le_minus_cancel)
   apply (rule ccontr)
   apply (simp add: word_not_le)
   done
 
 lemma uint_power_lower:
   "n < LENGTH('a) \<Longrightarrow> uint (2 ^ n :: 'a :: len word) = (2 ^ n :: int)"
   by (rule uint_2p_alt)
 
 lemma power_le_mono:
   "\<lbrakk>2 ^ n \<le> (2::'a::len word) ^ m; n < LENGTH('a); m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> n \<le> m"
   apply (clarsimp simp add: le_less)
   apply safe
   apply (simp add: word_less_nat_alt)
   apply (simp only: uint_arith_simps(3))
   apply (drule uint_power_lower)+
   apply simp
   done
 
 lemma sublist_equal_part:
   "prefix xs ys \<Longrightarrow> take (length xs) ys = xs"
   by (clarsimp simp: prefix_def)
 
 lemma two_power_eq:
   "\<lbrakk>n < LENGTH('a); m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> ((2::'a::len word) ^ n = 2 ^ m) = (n = m)"
   apply safe
   apply (rule order_antisym)
    apply (simp add: power_le_mono[where 'a='a])+
   done
 
 lemma prefix_length_less:
   "strict_prefix xs ys \<Longrightarrow> length xs < length ys"
   apply (clarsimp simp: strict_prefix_def)
   apply (frule prefix_length_le)
   apply (rule ccontr, simp)
   apply (clarsimp simp: prefix_def)
   done
 
 lemmas take_less = take_strict_prefix
 
 lemma not_prefix_longer:
   "\<lbrakk> length xs > length ys \<rbrakk> \<Longrightarrow> \<not> prefix xs ys"
   by (clarsimp dest!: prefix_length_le)
 
 lemma of_bl_length:
   "length xs < LENGTH('a) \<Longrightarrow> of_bl xs < (2 :: 'a::len word) ^ length xs"
   by (simp add: of_bl_length_less)
 
 lemma unat_of_nat_eq:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> unat (of_nat x ::'a::len word) = x"
   by (rule unat_of_nat_len)
 
 lemma unat_eq_of_nat:
   "n < 2 ^ LENGTH('a) \<Longrightarrow> (unat (x :: 'a::len word) = n) = (x = of_nat n)"
   by (subst unat_of_nat_eq[where x=n, symmetric], simp+)
 
 lemma unat_less_helper:
   "x < of_nat n \<Longrightarrow> unat x < n"
   apply (simp add: word_less_nat_alt)
   apply (erule order_less_le_trans)
   apply (simp add: unat_of_nat)
   done
 
 lemma nat_uint_less_helper:
   "nat (uint y) = z \<Longrightarrow> x < y \<Longrightarrow> nat (uint x) < z"
   apply (erule subst)
-  apply (subst unat_def [symmetric])
-  apply (subst unat_def [symmetric])
+  apply (subst unat_eq_nat_uint [symmetric])
+  apply (subst unat_eq_nat_uint [symmetric])
   by (simp add: unat_mono)
 
 lemma of_nat_0:
   "\<lbrakk>of_nat n = (0::'a::len word); n < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow> n = 0"
   by (drule unat_of_nat_eq, simp)
 
 lemma word_leq_le_minus_one:
   "\<lbrakk> x \<le> y; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x - 1 < (y :: 'a :: len word)"
   apply (simp add: word_less_nat_alt word_le_nat_alt)
   apply (subst unat_minus_one)
    apply assumption
   apply (cases "unat x")
    apply (simp add: unat_eq_zero)
   apply arith
   done
 
 lemma of_nat_inj:
   "\<lbrakk>x < 2 ^ LENGTH('a); y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow>
    (of_nat x = (of_nat y :: 'a :: len word)) = (x = y)"
   by (simp add: word_unat.norm_eq_iff [symmetric])
 
 lemma map_prefixI:
   "prefix xs ys \<Longrightarrow> prefix (map f xs) (map f ys)"
   by (clarsimp simp: prefix_def)
 
 lemma if_Some_None_eq_None:
   "((if P then Some v else None) = None) = (\<not> P)"
   by simp
 
 lemma CollectPairFalse [iff]:
   "{(a,b). False} = {}"
   by (simp add: split_def)
 
 lemma if_conj_dist:
   "((if b then w else x) \<and> (if b then y else z) \<and> X) =
   ((if b then w \<and> y else x \<and> z) \<and> X)"
   by simp
 
 lemma if_P_True1:
   "Q \<Longrightarrow> (if P then True else Q)"
   by simp
 
 lemma if_P_True2:
   "Q \<Longrightarrow> (if P then Q else True)"
   by simp
 
 lemma list_all2_induct [consumes 1, case_names Nil Cons]:
   assumes lall: "list_all2 Q xs ys"
   and     nilr: "P [] []"
   and    consr: "\<And>x xs y ys. \<lbrakk>list_all2 Q xs ys; Q x y; P xs ys\<rbrakk> \<Longrightarrow> P (x # xs) (y # ys)"
   shows  "P xs ys"
   using lall
 proof (induct rule: list_induct2 [OF list_all2_lengthD [OF lall]])
   case 1 then show ?case by auto fact+
 next
   case (2 x xs y ys)
 
   show ?case
   proof (rule consr)
     from "2.prems" show "list_all2 Q xs ys" and "Q x y" by simp_all
     then show "P xs ys" by (intro "2.hyps")
   qed
 qed
 
 lemma list_all2_induct_suffixeq [consumes 1, case_names Nil Cons]:
   assumes lall: "list_all2 Q as bs"
   and     nilr: "P [] []"
   and    consr: "\<And>x xs y ys.
   \<lbrakk>list_all2 Q xs ys; Q x y; P xs ys; suffix (x # xs) as; suffix (y # ys) bs\<rbrakk>
   \<Longrightarrow> P (x # xs) (y # ys)"
   shows  "P as bs"
 proof -
   define as' where "as' == as"
   define bs' where "bs' == bs"
 
   have "suffix as as' \<and> suffix bs bs'" unfolding as'_def bs'_def by simp
   then show ?thesis using lall
   proof (induct rule: list_induct2 [OF list_all2_lengthD [OF lall]])
     case 1 show ?case by fact
   next
     case (2 x xs y ys)
 
     show ?case
     proof (rule consr)
       from "2.prems" show "list_all2 Q xs ys" and "Q x y" by simp_all
       then show "P xs ys" using "2.hyps" "2.prems" by (auto dest: suffix_ConsD)
       from "2.prems" show "suffix (x # xs) as" and "suffix (y # ys) bs"
       by (auto simp: as'_def bs'_def)
     qed
   qed
 qed
 
 lemma upto_enum_step_shift:
   "\<lbrakk> is_aligned p n \<rbrakk> \<Longrightarrow>
   ([p , p + 2 ^ m .e. p + 2 ^ n - 1])
       = map ((+) p) [0, 2 ^ m .e. 2 ^ n - 1]"
   apply (erule is_aligned_get_word_bits)
    prefer 2
    apply (simp add: map_idI)
   apply (clarsimp simp: upto_enum_step_def)
   apply (frule is_aligned_no_overflow)
   apply (simp add: linorder_not_le [symmetric])
   done
 
 lemma upto_enum_step_shift_red:
   "\<lbrakk> is_aligned p sz; sz < LENGTH('a); us \<le> sz \<rbrakk>
      \<Longrightarrow> [p :: 'a :: len word, p + 2 ^ us .e. p + 2 ^ sz - 1]
           = map (\<lambda>x. p + of_nat x * 2 ^ us) [0 ..< 2 ^ (sz - us)]"
   apply (subst upto_enum_step_shift, assumption)
   apply (simp add: upto_enum_step_red)
   done
 
 lemma div_to_mult_word_lt:
   "\<lbrakk> (x :: 'a :: len word) \<le> y div z \<rbrakk> \<Longrightarrow> x * z \<le> y"
   apply (cases "z = 0")
    apply simp
   apply (simp add: word_neq_0_conv)
   apply (rule order_trans)
    apply (erule(1) word_mult_le_mono1)
    apply (simp add: unat_div)
    apply (rule order_le_less_trans [OF div_mult_le])
    apply simp
   apply (rule word_div_mult_le)
   done
 
 lemma upto_enum_step_subset:
   "set [x, y .e. z] \<subseteq> {x .. z}"
   apply (clarsimp simp: upto_enum_step_def linorder_not_less)
   apply (drule div_to_mult_word_lt)
   apply (rule conjI)
    apply (erule word_random[rotated])
    apply simp
   apply (rule order_trans)
    apply (erule word_plus_mono_right)
    apply simp
   apply simp
   done
 
 lemma shiftr_less_t2n':
   "\<lbrakk> x && mask (n + m) = x; m < LENGTH('a) \<rbrakk> \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
   apply (simp add: word_size mask_eq_iff_w2p[symmetric])
   apply word_eqI
   apply (erule_tac x="na + n" in allE)
   apply fastforce
   done
 
 lemma shiftr_less_t2n:
   "x < 2 ^ (n + m) \<Longrightarrow> x >> n < 2 ^ m" for x :: "'a :: len word"
   apply (rule shiftr_less_t2n')
    apply (erule less_mask_eq)
   apply (rule ccontr)
   apply (simp add: not_less)
   apply (subst (asm) p2_eq_0[symmetric])
   apply (simp add: power_add)
   done
 
 lemma shiftr_eq_0:
   "n \<ge> LENGTH('a) \<Longrightarrow> ((w::'a::len word) >> n) = 0"
   apply (cut_tac shiftr_less_t2n'[of w n 0], simp)
    apply (simp add: mask_eq_iff)
   apply (simp add: lt2p_lem)
   apply simp
   done
 
 lemma shiftr_not_mask_0:
   "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) && ~~ (mask m) = 0"
   apply (simp add: and_not_mask shiftr_less_t2n shiftr_shiftr)
   apply (subgoal_tac "w >> n + m = 0", simp)
-  apply (simp add: le_mask_iff[symmetric] mask_def le_def)
+  apply (simp add: le_mask_iff[symmetric] mask_eq_decr_exp le_def)
   apply (subst (asm) p2_gt_0[symmetric])
   apply (simp add: power_add not_less)
   done
 
 lemma shiftl_less_t2n:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> x < (2 ^ (m - n)); m < LENGTH('a) \<rbrakk> \<Longrightarrow> (x << n) < 2 ^ m"
   apply (simp add: word_size mask_eq_iff_w2p[symmetric])
   apply word_eqI
   apply (erule_tac x="na - n" in allE)
   apply auto
   done
 
 lemma shiftl_less_t2n':
   "(x::'a::len word) < 2 ^ m \<Longrightarrow> m+n < LENGTH('a) \<Longrightarrow> x << n < 2 ^ (m + n)"
   by (rule shiftl_less_t2n) simp_all
 
 lemma ucast_ucast_mask:
   "(ucast :: 'a :: len word \<Rightarrow> 'b :: len word) (ucast x) = x && mask (len_of TYPE ('a))"
   by word_eqI
 
 lemma ucast_ucast_len:
   "\<lbrakk> x < 2 ^ LENGTH('b) \<rbrakk> \<Longrightarrow> ucast (ucast x::'b::len word) = (x::'a::len word)"
   apply (subst ucast_ucast_mask)
   apply (erule less_mask_eq)
   done
 
 lemma ucast_ucast_id:
   "LENGTH('a) < LENGTH('b) \<Longrightarrow> ucast (ucast (x::'a::len word)::'b::len word) = x"
   by (auto intro: ucast_up_ucast_id simp: is_up_def source_size_def target_size_def word_size)
 
 lemma unat_ucast:
   "unat (ucast x :: ('a :: len) word) = unat x mod 2 ^ (LENGTH('a))"
-  apply (simp add: unat_def ucast_def)
-  apply (subst word_uint.eq_norm)
-  apply (subst nat_mod_distrib)
-    apply simp
-   apply simp
-  apply (subst nat_power_eq)
-   apply simp
-  apply simp
-  done
+proof -
+  have \<open>2 ^ LENGTH('a) = nat (2 ^ LENGTH('a))\<close>
+    by simp
+  moreover have \<open>unat (UCAST('b \<rightarrow> 'a) x) = unat x mod nat (2 ^ LENGTH('a))\<close>
+    by transfer (simp flip: nat_mod_distrib take_bit_eq_mod)
+  ultimately show ?thesis
+    by (simp only:)
+qed
 
 lemma ucast_less_ucast:
   "LENGTH('a) \<le> LENGTH('b) \<Longrightarrow>
    (ucast x < ((ucast (y :: 'a::len word)) :: 'b::len word)) = (x < y)"
   apply (simp add: word_less_nat_alt unat_ucast)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply (subst mod_less)
    apply(rule less_le_trans[OF unat_lt2p], simp)
   apply simp
   done
 
 \<comment> \<open>This weaker version was previously called @{text ucast_less_ucast}. We retain it to
     support existing proofs.\<close>
 lemmas ucast_less_ucast_weak = ucast_less_ucast[OF order.strict_implies_order]
 
 lemma sints_subset:
   "m \<le> n \<Longrightarrow> sints m \<subseteq> sints n"
   apply (simp add: sints_num)
   apply clarsimp
   apply (rule conjI)
    apply (erule order_trans[rotated])
    apply simp
   apply (erule order_less_le_trans)
   apply simp
   done
 
 lemma up_scast_inj:
       "\<lbrakk> scast x = (scast y :: 'b :: len word); size x \<le> LENGTH('b) \<rbrakk>
          \<Longrightarrow> x = y"
-  apply (simp add: scast_def)
+  apply (simp add: scast_eq)
   apply (subst(asm) word_sint.Abs_inject)
     apply (erule subsetD [OF sints_subset])
     apply (simp add: word_size)
    apply (erule subsetD [OF sints_subset])
    apply (simp add: word_size)
   apply simp
   done
 
 lemma up_scast_inj_eq:
   "LENGTH('a) \<le> len_of TYPE ('b) \<Longrightarrow>
   (scast x = (scast y::'b::len word)) = (x = (y::'a::len word))"
   by (fastforce dest: up_scast_inj simp: word_size)
 
 lemma nth_bounded:
   "\<lbrakk>(x :: 'a :: len word) !! n; x < 2 ^ m; m \<le> len_of TYPE ('a)\<rbrakk> \<Longrightarrow> n < m"
   apply (frule test_bit_size)
   apply (clarsimp simp: test_bit_bl word_size)
   apply (simp add: rev_nth)
   apply (subst(asm) is_aligned_add_conv[OF is_aligned_0',
                                         simplified add_0_left, rotated])
    apply assumption+
   apply (simp only: to_bl_0)
   apply (simp add: nth_append split: if_split_asm)
   done
 
 lemma is_aligned_add_or:
   "\<lbrakk>is_aligned p n; d < 2 ^ n\<rbrakk> \<Longrightarrow> p + d = p || d"
   by (rule word_plus_and_or_coroll, word_eqI) blast
 
 lemma two_power_increasing:
   "\<lbrakk> n \<le> m; m < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ n \<le> 2 ^ m"
   by (simp add: word_le_nat_alt)
 
 lemma is_aligned_add_less_t2n:
   "\<lbrakk>is_aligned (p::'a::len word) n; d < 2^n; n \<le> m; p < 2^m\<rbrakk> \<Longrightarrow> p + d < 2^m"
   apply (case_tac "m < LENGTH('a)")
    apply (subst mask_eq_iff_w2p[symmetric])
     apply (simp add: word_size)
    apply (simp add: is_aligned_add_or word_ao_dist less_mask_eq)
    apply (subst less_mask_eq)
     apply (erule order_less_le_trans)
     apply (erule(1) two_power_increasing)
    apply simp
   apply (simp add: power_overflow)
   done
 
 
 lemma aligned_offset_non_zero:
   "\<lbrakk> is_aligned x n; y < 2 ^ n; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x + y \<noteq> 0"
   apply (cases "y = 0")
    apply simp
   apply (subst word_neq_0_conv)
   apply (subst gt0_iff_gem1)
   apply (erule is_aligned_get_word_bits)
    apply (subst field_simps[symmetric], subst plus_le_left_cancel_nowrap)
      apply (rule is_aligned_no_wrap')
       apply simp
      apply (rule word_leq_le_minus_one)
       apply simp
      apply assumption
     apply (erule (1) is_aligned_no_wrap')
    apply (simp add: gt0_iff_gem1 [symmetric] word_neq_0_conv)
   apply simp
   done
 
 lemmas mask_inner_mask = mask_eqs(1)
 
 lemma mask_add_aligned:
   "is_aligned p n \<Longrightarrow> (p + q) && mask n = q && mask n"
   apply (simp add: is_aligned_mask)
   apply (subst mask_inner_mask [symmetric])
   apply simp
   done
 
 lemma take_prefix:
   "(take (length xs) ys = xs) = prefix xs ys"
 proof (induct xs arbitrary: ys)
   case Nil then show ?case by simp
 next
   case Cons then show ?case by (cases ys) auto
 qed
 
 lemma cart_singleton_empty:
   "(S \<times> {e} = {}) = (S = {})"
   by blast
 
 lemma word_div_1:
   "(n :: 'a :: len word) div 1 = n"
   by (simp add: word_div_def)
 
 lemma word_minus_one_le:
   "-1 \<le> (x :: 'a :: len word) = (x = -1)"
   apply (insert word_n1_ge[where y=x])
   apply safe
   apply (erule(1) order_antisym)
   done
 
 lemma mask_out_sub_mask:
   "(x && ~~ (mask n)) = x - (x && (mask n))"
   by (simp add: field_simps word_plus_and_or_coroll2)
 
 lemma is_aligned_addD1:
   assumes al1: "is_aligned (x + y) n"
   and     al2: "is_aligned (x::'a::len word) n"
   shows "is_aligned y n"
   using al2
 proof (rule is_aligned_get_word_bits)
   assume "x = 0" then show ?thesis using al1 by simp
 next
   assume nv: "n < LENGTH('a)"
   from al1 obtain q1
     where xy: "x + y = 2 ^ n * of_nat q1" and "q1 < 2 ^ (LENGTH('a) - n)"
     by (rule is_alignedE)
   moreover from al2 obtain q2
     where x: "x = 2 ^ n * of_nat q2" and "q2 < 2 ^ (LENGTH('a) - n)"
     by (rule is_alignedE)
   ultimately have "y = 2 ^ n * (of_nat q1 - of_nat q2)"
     by (simp add: field_simps)
   then show ?thesis using nv by (simp add: is_aligned_mult_triv1)
 qed
 
 lemmas is_aligned_addD2 =
        is_aligned_addD1[OF subst[OF add.commute,
                                  of "%x. is_aligned x n" for n]]
 
 lemma is_aligned_add:
   "\<lbrakk>is_aligned p n; is_aligned q n\<rbrakk> \<Longrightarrow> is_aligned (p + q) n"
   by (simp add: is_aligned_mask mask_add_aligned)
 
 lemma word_le_add:
   fixes x :: "'a :: len word"
   shows "x \<le> y \<Longrightarrow> \<exists>n. y = x + of_nat n"
   by (rule exI [where x = "unat (y - x)"]) simp
 
 lemma word_plus_mcs_4':
   fixes x :: "'a :: len word"
   shows "\<lbrakk>x + v \<le> x + w; x \<le> x + v\<rbrakk> \<Longrightarrow> v \<le> w"
   apply (rule word_plus_mcs_4)
    apply (simp add: add.commute)
   apply (simp add: add.commute)
   done
 
 lemma shiftl_mask_is_0[simp]:
   "(x << n) && mask n = 0"
   apply (rule iffD1 [OF is_aligned_mask])
   apply (rule is_aligned_shiftl_self)
   done
 
 definition
   sum_map :: "('a \<Rightarrow> 'b) \<Rightarrow> ('c \<Rightarrow> 'd) \<Rightarrow> 'a + 'c \<Rightarrow> 'b + 'd" where
  "sum_map f g x \<equiv> case x of Inl v \<Rightarrow> Inl (f v) | Inr v' \<Rightarrow> Inr (g v')"
 
 lemma sum_map_simps[simp]:
   "sum_map f g (Inl v) = Inl (f v)"
   "sum_map f g (Inr w) = Inr (g w)"
   by (simp add: sum_map_def)+
 
 lemma if_and_helper:
   "(If x v v') && v'' = If x (v && v'') (v' && v'')"
   by (rule if_distrib)
 
 lemma unat_Suc2:
   fixes n :: "'a :: len word"
   shows
   "n \<noteq> -1 \<Longrightarrow> unat (n + 1) = Suc (unat n)"
   apply (subst add.commute, rule unatSuc)
   apply (subst eq_diff_eq[symmetric], simp add: minus_equation_iff)
   done
 
 lemmas word_unat_Rep_inject1 = word_unat.Rep_inject[where y=1]
 lemmas unat_eq_1 = unat_eq_0 word_unat_Rep_inject1[simplified]
 
 
 lemma rshift_sub_mask_eq:
   "(a >> (size a - b)) && mask b = a >> (size a - b)"
   using shiftl_shiftr2[where a=a and b=0 and c="size a - b"]
   apply (cases "b < size a")
    apply simp
-  apply (simp add: linorder_not_less mask_def word_size
+  apply (simp add: linorder_not_less mask_eq_decr_exp word_size
                    p2_eq_0[THEN iffD2])
   done
 
 lemma shiftl_shiftr3:
   "b \<le> c \<Longrightarrow> a << b >> c = (a >> c - b) && mask (size a - c)"
   apply (cases "b = c")
    apply (simp add: shiftl_shiftr1)
   apply (simp add: shiftl_shiftr2)
   done
 
 lemma and_mask_shiftr_comm:
   "m\<le>size w \<Longrightarrow> (w && mask m) >> n = (w >> n) && mask (m-n)"
   by (simp add: and_mask shiftr_shiftr) (simp add: word_size shiftl_shiftr3)
 
 lemma and_mask_shiftl_comm:
   "m+n \<le> size w \<Longrightarrow> (w && mask m) << n = (w << n) && mask (m+n)"
   by (simp add: and_mask word_size shiftl_shiftl) (simp add: shiftl_shiftr1)
 
 lemma le_mask_shiftl_le_mask: "s = m + n \<Longrightarrow> x \<le> mask n \<Longrightarrow> x << m \<le> mask s"
   by (simp add: le_mask_iff shiftl_shiftr3)
 
 lemma and_not_mask_twice:
   "(w && ~~ (mask n)) && ~~ (mask m) = w && ~~ (mask (max m n))"
   apply (simp add: and_not_mask)
   apply (case_tac "n<m";
          simp add: shiftl_shiftr2 shiftl_shiftr1 not_less max_def shiftr_shiftr shiftl_shiftl)
    apply (cut_tac and_mask_shiftr_comm [where w=w and m="size w" and n=m, simplified,symmetric])
-   apply (simp add: word_size mask_def)
+   apply (simp add: word_size mask_eq_decr_exp)
   apply (cut_tac and_mask_shiftr_comm [where w=w and m="size w" and n=n, simplified,symmetric])
-  apply (simp add: word_size mask_def)
+  apply (simp add: word_size mask_eq_decr_exp)
   done
 
 lemma word_less_cases:
   "x < y \<Longrightarrow> x = y - 1 \<or> x < y - (1 ::'a::len word)"
   apply (drule word_less_sub_1)
   apply (drule order_le_imp_less_or_eq)
   apply auto
   done
 
 lemma eq_eqI:
   "a = b \<Longrightarrow> (a = x) = (b = x)"
   by simp
 
 lemma mask_and_mask:
   "mask a && mask b = mask (min a b)"
   by word_eqI
 
 lemma mask_eq_0_eq_x:
   "(x && w = 0) = (x && ~~ w = x)"
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 lemma mask_eq_x_eq_0:
   "(x && w = x) = (x && ~~ w = 0)"
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 definition
   "limited_and (x :: 'a :: len word) y = (x && y = x)"
 
 lemma limited_and_eq_0:
   "\<lbrakk> limited_and x z; y && ~~ z = y \<rbrakk> \<Longrightarrow> x && y = 0"
   unfolding limited_and_def
   apply (subst arg_cong2[where f="(&&)"])
     apply (erule sym)+
   apply (simp(no_asm) add: word_bw_assocs word_bw_comms word_bw_lcs)
   done
 
 lemma limited_and_eq_id:
   "\<lbrakk> limited_and x z; y && z = z \<rbrakk> \<Longrightarrow> x && y = x"
   unfolding limited_and_def
   by (erule subst, fastforce simp: word_bw_lcs word_bw_assocs word_bw_comms)
 
 lemma lshift_limited_and:
   "limited_and x z \<Longrightarrow> limited_and (x << n) (z << n)"
   unfolding limited_and_def
   by (simp add: shiftl_over_and_dist[symmetric])
 
 lemma rshift_limited_and:
   "limited_and x z \<Longrightarrow> limited_and (x >> n) (z >> n)"
   unfolding limited_and_def
   by (simp add: shiftr_over_and_dist[symmetric])
 
 lemmas limited_and_simps1 = limited_and_eq_0 limited_and_eq_id
 
 lemmas is_aligned_limited_and
-    = is_aligned_neg_mask_eq[unfolded mask_def, folded limited_and_def]
+    = is_aligned_neg_mask_eq[unfolded mask_eq_decr_exp, folded limited_and_def]
 
 lemma compl_of_1: "~~ 1 = (-2 :: 'a :: len word)"
   by simp
 
 lemmas limited_and_simps = limited_and_simps1
        limited_and_simps1[OF is_aligned_limited_and]
        limited_and_simps1[OF lshift_limited_and]
        limited_and_simps1[OF rshift_limited_and]
        limited_and_simps1[OF rshift_limited_and, OF is_aligned_limited_and]
-       compl_of_1 shiftl_shiftr1[unfolded word_size mask_def]
-       shiftl_shiftr2[unfolded word_size mask_def]
+       compl_of_1 shiftl_shiftr1[unfolded word_size mask_eq_decr_exp]
+       shiftl_shiftr2[unfolded word_size mask_eq_decr_exp]
 
 lemma split_word_eq_on_mask:
   "(x = y) = (x && m = y && m \<and> x && ~~ m = y && ~~ m)"
   by safe word_eqI_solve
 
 lemma map2_Cons_2_3:
   "(map2 f xs (y # ys) = (z # zs)) = (\<exists>x xs'. xs = x # xs' \<and> f x y = z \<and> map2 f xs' ys = zs)"
   by (case_tac xs, simp_all)
 
 lemma map2_xor_replicate_False:
   "map2 (\<lambda>x y. x \<longleftrightarrow> \<not> y) xs (replicate n False) = take n xs"
   apply (induct xs arbitrary: n, simp)
   apply (case_tac n; simp)
   done
 
 lemma word_and_1_shiftl:
   "x && (1 << n) = (if x !! n then (1 << n) else 0)" for x :: "'a :: len word"
   by word_eqI_solve
 
 lemmas word_and_1_shiftls'
     = word_and_1_shiftl[where n=0]
       word_and_1_shiftl[where n=1]
       word_and_1_shiftl[where n=2]
 
 lemmas word_and_1_shiftls = word_and_1_shiftls' [simplified]
 
 lemma word_and_mask_shiftl:
   "x && (mask n << m) = ((x >> m) && mask n) << m"
   by word_eqI_solve
 
 lemma plus_Collect_helper:
   "(+) x ` {xa. P (xa :: 'a :: len word)} = {xa. P (xa - x)}"
   by (fastforce simp add: image_def)
 
 lemma plus_Collect_helper2:
   "(+) (- x) ` {xa. P (xa :: 'a :: len word)} = {xa. P (x + xa)}"
   using plus_Collect_helper [of "- x" P] by (simp add: ac_simps)
 
 lemma word_FF_is_mask:
   "0xFF = mask 8"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma word_1FF_is_mask:
   "0x1FF = mask 9"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma ucast_of_nat_small:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> ucast (of_nat x :: 'a :: len word) = (of_nat x :: 'b :: len word)"
   apply (rule sym, subst word_unat.inverse_norm)
-  apply (simp add: ucast_def word_of_int[symmetric]
-                   of_nat_nat[symmetric] unat_def[symmetric])
+  apply (simp add: ucast_eq word_of_int[symmetric]
+                   of_nat_nat[symmetric])
   apply (simp add: unat_of_nat)
   done
 
 lemma word_le_make_less:
   fixes x :: "'a :: len word"
   shows "y \<noteq> -1 \<Longrightarrow> (x \<le> y) = (x < (y + 1))"
   apply safe
   apply (erule plus_one_helper2)
   apply (simp add: eq_diff_eq[symmetric])
   done
 
 lemmas finite_word = finite [where 'a="'a::len word"]
 
 lemma word_to_1_set:
   "{0 ..< (1 :: 'a :: len word)} = {0}"
   by fastforce
 
 lemma range_subset_eq2:
   "{a :: 'a :: len word .. b} \<noteq> {} \<Longrightarrow> ({a .. b} \<subseteq> {c .. d}) = (c \<le> a \<and> b \<le> d)"
   by simp
 
 lemma word_leq_minus_one_le:
   fixes x :: "'a::len word"
   shows "\<lbrakk>y \<noteq> 0; x \<le> y - 1 \<rbrakk> \<Longrightarrow> x < y"
   using le_m1_iff_lt word_neq_0_conv by blast
 
 lemma word_count_from_top:
   "n \<noteq> 0 \<Longrightarrow> {0 ..< n :: 'a :: len word} = {0 ..< n - 1} \<union> {n - 1}"
   apply (rule set_eqI, rule iffI)
    apply simp
    apply (drule word_le_minus_one_leq)
    apply (rule disjCI)
    apply simp
   apply simp
   apply (erule word_leq_minus_one_le)
   apply fastforce
   done
 
 lemma word_minus_one_le_leq:
   "\<lbrakk> x - 1 < y \<rbrakk> \<Longrightarrow> x \<le> (y :: 'a :: len word)"
   apply (cases "x = 0")
    apply simp
   apply (simp add: word_less_nat_alt word_le_nat_alt)
   apply (subst(asm) unat_minus_one)
    apply (simp add: word_less_nat_alt)
   apply (cases "unat x")
    apply (simp add: unat_eq_zero)
   apply arith
   done
 
 lemma mod_mod_power:
   fixes k :: nat
   shows "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ (min m n)"
 proof (cases "m \<le> n")
   case True
 
   then have "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ m"
     apply -
     apply (subst mod_less [where n = "2 ^ n"])
     apply (rule order_less_le_trans [OF mod_less_divisor])
     apply simp+
     done
   also have "\<dots> = k mod  2 ^ (min m n)" using True by simp
   finally show ?thesis .
 next
   case False
   then have "n < m" by simp
   then obtain d where md: "m = n + d"
     by (auto dest: less_imp_add_positive)
   then have "k mod 2 ^ m = 2 ^ n * (k div 2 ^ n mod 2 ^ d) + k mod 2 ^ n"
     by (simp add: mod_mult2_eq power_add)
   then have "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ n"
     by (simp add: mod_add_left_eq)
   then show ?thesis using False
     by simp
 qed
 
 lemma word_div_less:
   "m < n \<Longrightarrow> m div n = 0" for m :: "'a :: len word"
   by (simp add: unat_mono word_arith_nat_defs(6))
 
 lemma word_must_wrap:
   "\<lbrakk> x \<le> n - 1; n \<le> x \<rbrakk> \<Longrightarrow> n = (0 :: 'a :: len word)"
   using dual_order.trans sub_wrap word_less_1 by blast
 
 lemma range_subset_card:
   "\<lbrakk> {a :: 'a :: len word .. b} \<subseteq> {c .. d}; b \<ge> a \<rbrakk> \<Longrightarrow> d \<ge> c \<and> d - c \<ge> b - a"
   using word_sub_le word_sub_mono by fastforce
 
 lemma less_1_simp:
   "n - 1 < m = (n \<le> (m :: 'a :: len word) \<and> n \<noteq> 0)"
   by unat_arith
 
 lemma alignUp_div_helper:
   fixes a :: "'a::len word"
   assumes kv: "k < 2 ^ (LENGTH('a) - n)"
   and     xk: "x = 2 ^ n * of_nat k"
   and    le: "a \<le> x"
   and    sz: "n < LENGTH('a)"
   and   anz: "a mod 2 ^ n \<noteq> 0"
   shows "a div 2 ^ n < of_nat k"
 proof -
   have kn: "unat (of_nat k :: 'a word) * unat ((2::'a word) ^ n) < 2 ^ LENGTH('a)"
     using xk kv sz
     apply (subst unat_of_nat_eq)
      apply (erule order_less_le_trans)
      apply simp
     apply (subst unat_power_lower, simp)
     apply (subst mult.commute)
     apply (rule nat_less_power_trans)
      apply simp
     apply simp
     done
 
   have "unat a div 2 ^ n * 2 ^ n \<noteq> unat a"
   proof -
     have "unat a = unat a div 2 ^ n * 2 ^ n + unat a mod 2 ^ n"
       by (simp add: div_mult_mod_eq)
     also have "\<dots> \<noteq> unat a div 2 ^ n * 2 ^ n" using sz anz
       by (simp add: unat_arith_simps)
     finally show ?thesis ..
   qed
 
   then have "a div 2 ^ n * 2 ^ n < a" using sz anz
     apply (subst word_less_nat_alt)
     apply (subst unat_word_ariths)
     apply (subst unat_div)
     apply simp
     apply (rule order_le_less_trans [OF mod_less_eq_dividend])
     apply (erule order_le_neq_trans [OF div_mult_le])
     done
 
   also from xk le have "\<dots> \<le> of_nat k * 2 ^ n" by (simp add: field_simps)
   finally show ?thesis using sz kv
     apply -
     apply (erule word_mult_less_dest [OF _ _ kn])
     apply (simp add: unat_div)
     apply (rule order_le_less_trans [OF div_mult_le])
     apply (rule unat_lt2p)
     done
 qed
 
 lemma nat_mod_power_lem:
   fixes a :: nat
   shows "1 < a \<Longrightarrow> a ^ n mod a ^ m = (if m \<le> n then 0 else a ^ n)"
   apply (clarsimp)
   apply (clarsimp simp add: le_iff_add power_add)
   done
 
 lemma power_mod_div:
   fixes x :: "nat"
   shows "x mod 2 ^ n div 2 ^ m = x div 2 ^ m mod 2 ^ (n - m)" (is "?LHS = ?RHS")
 proof (cases "n \<le> m")
   case True
   then have "?LHS = 0"
     apply -
     apply (rule div_less)
     apply (rule order_less_le_trans [OF mod_less_divisor]; simp)
     done
   also have "\<dots> = ?RHS" using True
     by simp
   finally show ?thesis .
 next
   case False
   then have lt: "m < n" by simp
   then obtain q where nv: "n = m + q" and "0 < q"
     by (auto dest: less_imp_Suc_add)
 
   then have "x mod 2 ^ n = 2 ^ m * (x div 2 ^ m mod 2 ^ q) + x mod 2 ^ m"
     by (simp add: power_add mod_mult2_eq)
 
   then have "?LHS = x div 2 ^ m mod 2 ^ q"
     by (simp add: div_add1_eq)
 
   also have "\<dots> = ?RHS" using nv
     by simp
 
   finally show ?thesis .
 qed
 
 lemma word_power_mod_div:
   fixes x :: "'a::len word"
   shows "\<lbrakk> n < LENGTH('a); m < LENGTH('a)\<rbrakk>
   \<Longrightarrow> x mod 2 ^ n div 2 ^ m = x div 2 ^ m mod 2 ^ (n - m)"
   apply (simp add: word_arith_nat_div unat_mod power_mod_div)
   apply (subst unat_arith_simps(3))
   apply (subst unat_mod)
   apply (subst unat_of_nat)+
   apply (simp add: mod_mod_power min.commute)
   done
 
 lemma word_range_minus_1':
   fixes a :: "'a :: len word"
   shows "a \<noteq> 0 \<Longrightarrow> {a - 1<..b} = {a..b}"
   by (simp add: greaterThanAtMost_def atLeastAtMost_def greaterThan_def atLeast_def less_1_simp)
 
 lemma word_range_minus_1:
   fixes a :: "'a :: len word"
   shows "b \<noteq> 0 \<Longrightarrow> {a..b - 1} = {a..<b}"
   apply (simp add: atLeastLessThan_def atLeastAtMost_def atMost_def lessThan_def)
   apply (rule arg_cong [where f = "\<lambda>x. {a..} \<inter> x"])
   apply rule
    apply clarsimp
    apply (erule contrapos_pp)
    apply (simp add: linorder_not_less linorder_not_le word_must_wrap)
   apply (clarsimp)
   apply (drule word_le_minus_one_leq)
   apply (auto simp: word_less_sub_1)
   done
 
 lemma ucast_nat_def:
   "of_nat (unat x) = (ucast :: 'a :: len word \<Rightarrow> 'b :: len word) x"
-  by (simp add: ucast_def word_of_int_nat unat_def)
+  by transfer simp
 
 lemmas if_fun_split = if_apply_def2
 
 lemma i_hate_words_helper:
   "i \<le> (j - k :: nat) \<Longrightarrow> i \<le> j"
   by simp
 
 lemma i_hate_words:
   "unat (a :: 'a word) \<le> unat (b :: 'a :: len word) - Suc 0
     \<Longrightarrow> a \<noteq> -1"
   apply (frule i_hate_words_helper)
   apply (subst(asm) word_le_nat_alt[symmetric])
   apply (clarsimp simp only: word_minus_one_le)
   apply (simp only: linorder_not_less[symmetric])
   apply (erule notE)
   apply (rule diff_Suc_less)
   apply (subst neq0_conv[symmetric])
   apply (subst unat_eq_0)
   apply (rule notI, drule arg_cong[where f="(+) 1"])
   apply simp
   done
 
 lemma overflow_plus_one_self:
   "(1 + p \<le> p) = (p = (-1 :: 'a :: len word))"
   apply rule
   apply (rule ccontr)
    apply (drule plus_one_helper2)
    apply (rule notI)
    apply (drule arg_cong[where f="\<lambda>x. x - 1"])
    apply simp
    apply (simp add: field_simps)
   apply simp
   done
 
 lemma plus_1_less:
   "(x + 1 \<le> (x :: 'a :: len word)) = (x = -1)"
   apply (rule iffI)
    apply (rule ccontr)
    apply (cut_tac plus_one_helper2[where x=x, OF order_refl])
     apply simp
    apply clarsimp
    apply (drule arg_cong[where f="\<lambda>x. x - 1"])
    apply simp
   apply simp
   done
 
 lemma pos_mult_pos_ge:
   "[|x > (0::int); n>=0 |] ==> n * x >= n*1"
   apply (simp only: mult_left_mono)
   done
 
 lemma If_eq_obvious:
   "x \<noteq> z \<Longrightarrow> ((if P then x else y) = z) = (\<not> P \<and> y = z)"
   by simp
 
 lemma Some_to_the:
   "v = Some x \<Longrightarrow> x = the v"
   by simp
 
 lemma dom_if_Some:
   "dom (\<lambda>x. if P x then Some (f x) else g x) = {x. P x} \<union> dom g"
   by fastforce
 
 lemma dom_insert_absorb:
   "x \<in> dom f \<Longrightarrow> insert x (dom f) = dom f" by auto
 
 lemma emptyE2:
   "\<lbrakk> S = {}; x \<in> S \<rbrakk> \<Longrightarrow> P"
   by simp
 
 lemma mod_div_equality_div_eq:
   "a div b * b = (a - (a mod b) :: int)"
   by (simp add: field_simps)
 
 lemma zmod_helper:
   "n mod m = k \<Longrightarrow> ((n :: int) + a) mod m = (k + a) mod m"
   by (metis add.commute mod_add_right_eq)
 
 lemma int_div_sub_1:
   "\<lbrakk> m \<ge> 1 \<rbrakk> \<Longrightarrow> (n - (1 :: int)) div m = (if m dvd n then (n div m) - 1 else n div m)"
   apply (subgoal_tac "m = 0 \<or> (n - (1 :: int)) div m = (if m dvd n then (n div m) - 1 else n div m)")
    apply fastforce
   apply (subst mult_cancel_right[symmetric])
   apply (simp only: left_diff_distrib split: if_split)
   apply (simp only: mod_div_equality_div_eq)
   apply (clarsimp simp: field_simps)
   apply (clarsimp simp: dvd_eq_mod_eq_0)
   apply (cases "m = 1")
    apply simp
   apply (subst mod_diff_eq[symmetric], simp add: zmod_minus1)
   apply clarsimp
   apply (subst diff_add_cancel[where b=1, symmetric])
   apply (subst mod_add_eq[symmetric])
   apply (simp add: field_simps)
   apply (rule mod_pos_pos_trivial)
    apply (subst add_0_right[where a=0, symmetric])
    apply (rule add_mono)
     apply simp
    apply simp
   apply (cases "(n - 1) mod m = m - 1")
    apply (drule zmod_helper[where a=1])
    apply simp
   apply (subgoal_tac "1 + (n - 1) mod m \<le> m")
    apply simp
   apply (subst field_simps, rule zless_imp_add1_zle)
   apply simp
   done
 
 lemma ptr_add_image_multI:
   "\<lbrakk> \<And>x y. (x * val = y * val') = (x * val'' = y); x * val'' \<in> S \<rbrakk> \<Longrightarrow>
      ptr_add ptr (x * val) \<in> (\<lambda>p. ptr_add ptr (p * val')) ` S"
   apply (simp add: image_def)
   apply (erule rev_bexI)
   apply (rule arg_cong[where f="ptr_add ptr"])
   apply simp
   done
 
 lemma shift_times_fold:
   "(x :: 'a :: len word) * (2 ^ n) << m = x << (m + n)"
   by (simp add: shiftl_t2n ac_simps power_add)
 
 lemma word_plus_strict_mono_right:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>y < z; x \<le> x + z\<rbrakk> \<Longrightarrow> x + y < x + z"
   by unat_arith
 
 lemma replicate_minus:
   "k < n \<Longrightarrow> replicate n False = replicate (n - k) False @ replicate k False"
   by (subst replicate_add [symmetric]) simp
 
 lemmas map_prod_split_imageI'
   = map_prod_imageI[where f="case_prod f" and g="case_prod g"
                     and a="(a, b)" and b="(c, d)" for a b c d f g]
 lemmas map_prod_split_imageI = map_prod_split_imageI'[simplified]
 
 lemma word_div_mult:
   "0 < c \<Longrightarrow> a < b * c \<Longrightarrow> a div c < b" for a b c :: "'a::len word"
   by (rule classical)
      (use div_to_mult_word_lt [of b a c] in
       \<open>auto simp add: word_less_nat_alt word_le_nat_alt unat_div\<close>)
 
 lemma word_less_power_trans_ofnat:
   "\<lbrakk>n < 2 ^ (m - k); k \<le> m; m < LENGTH('a)\<rbrakk>
    \<Longrightarrow> of_nat n * 2 ^ k < (2::'a::len word) ^ m"
   apply (subst mult.commute)
   apply (rule word_less_power_trans)
     apply (simp add: word_less_nat_alt)
     apply (subst unat_of_nat_eq)
      apply (erule order_less_trans)
      apply simp+
     done
 
 lemma word_1_le_power:
   "n < LENGTH('a) \<Longrightarrow> (1 :: 'a :: len word) \<le> 2 ^ n"
   by (rule inc_le[where i=0, simplified], erule iffD2[OF p2_gt_0])
 
 lemma enum_word_div:
   fixes v :: "'a :: len word" shows
   "\<exists>xs ys. enum = xs @ [v] @ ys
              \<and> (\<forall>x \<in> set xs. x < v)
              \<and> (\<forall>y \<in> set ys. v < y)"
   apply (simp only: enum_word_def)
   apply (subst upt_add_eq_append'[where j="unat v"])
     apply simp
    apply (rule order_less_imp_le, simp)
   apply (simp add: upt_conv_Cons)
   apply (intro exI conjI)
     apply fastforce
    apply clarsimp
    apply (drule of_nat_mono_maybe[rotated, where 'a='a])
     apply simp
    apply simp
   apply (clarsimp simp: Suc_le_eq)
   apply (drule of_nat_mono_maybe[rotated, where 'a='a])
    apply simp
   apply simp
   done
 
 lemma of_bool_nth:
   "of_bool (x !! v) = (x >> v) && 1"
   by (simp add: test_bit_word_eq shiftr_word_eq bit_eq_iff)
     (auto simp add: bit_1_iff bit_and_iff bit_drop_bit_eq intro: ccontr)
 
 lemma unat_1_0:
   "1 \<le> (x::'a::len word) = (0 < unat x)"
   by (auto simp add: word_le_nat_alt)
 
 lemma x_less_2_0_1':
   fixes x :: "'a::len word"
   shows "\<lbrakk>LENGTH('a) \<noteq> 1; x < 2\<rbrakk> \<Longrightarrow> x = 0 \<or> x = 1"
   apply (induct x)
    apply clarsimp+
   by (metis Suc_eq_plus1 add_lessD1 less_irrefl one_add_one unatSuc word_less_nat_alt)
 
 lemmas word_add_le_iff2 = word_add_le_iff [folded no_olen_add_nat]
 
 lemma of_nat_power:
   shows "\<lbrakk> p < 2 ^ x; x < len_of TYPE ('a) \<rbrakk> \<Longrightarrow> of_nat p < (2 :: 'a :: len word) ^ x"
   apply (rule order_less_le_trans)
    apply (rule of_nat_mono_maybe)
     apply (erule power_strict_increasing)
     apply simp
    apply assumption
   apply (simp add: word_unat_power)
   done
 
 lemma of_nat_n_less_equal_power_2:
   "n < LENGTH('a::len) \<Longrightarrow> ((of_nat n)::'a word) < 2 ^ n"
   apply (induct n)
    apply clarsimp
   apply clarsimp
   apply (metis of_nat_power n_less_equal_power_2 of_nat_Suc power_Suc)
   done
 
 lemma eq_mask_less:
   fixes w :: "'a::len word"
   assumes eqm: "w = w && mask n"
   and      sz: "n < len_of TYPE ('a)"
   shows "w < (2::'a word) ^ n"
   by (subst eqm, rule and_mask_less' [OF sz])
 
 lemma of_nat_mono_maybe':
   fixes Y :: "nat"
   assumes xlt: "x < 2 ^ len_of TYPE ('a)"
   assumes ylt: "y < 2 ^ len_of TYPE ('a)"
   shows   "(y < x) = (of_nat y < (of_nat x :: 'a :: len word))"
   apply (subst word_less_nat_alt)
   apply (subst unat_of_nat)+
   apply (subst mod_less)
    apply (rule ylt)
   apply (subst mod_less)
    apply (rule xlt)
   apply simp
   done
 
 lemma shiftr_mask_eq:
   "(x >> n) && mask (size x - n) = x >> n" for x :: "'a :: len word"
   by word_eqI_solve
 
 lemma shiftr_mask_eq':
   "m = (size x - n) \<Longrightarrow> (x >> n) && mask m = x >> n" for x :: "'a :: len word"
   by (simp add: shiftr_mask_eq)
 
 lemma dom_if:
   "dom (\<lambda>a. if a \<in> addrs then Some (f a) else g a)  = addrs \<union> dom g"
   by (auto simp: dom_def split: if_split)
 
 lemma less_is_non_zero_p1:
   fixes a :: "'a :: len word"
   shows "a < k \<Longrightarrow> a + 1 \<noteq> 0"
   apply (erule contrapos_pn)
   apply (drule max_word_wrap)
   apply (simp add: not_less)
   done
 
 lemma of_nat_mono_maybe_le:
   "\<lbrakk>x < 2 ^ LENGTH('a); y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow>
   (y \<le> x) = ((of_nat y :: 'a :: len word) \<le> of_nat x)"
   apply (clarsimp simp: le_less)
   apply (rule disj_cong)
    apply (rule of_nat_mono_maybe', assumption+)
   apply (simp add: word_unat.norm_eq_iff [symmetric])
   done
 
 lemma mask_AND_NOT_mask:
   "(w && ~~ (mask n)) && mask n = 0"
   by word_eqI
 
 lemma AND_NOT_mask_plus_AND_mask_eq:
   "(w && ~~ (mask n)) + (w && mask n) = w"
   by (subst word_plus_and_or_coroll; word_eqI_solve)
 
 lemma mask_eqI:
   fixes x :: "'a :: len word"
   assumes m1: "x && mask n = y && mask n"
   and     m2: "x && ~~ (mask n) = y && ~~ (mask n)"
   shows "x = y"
 proof (subst bang_eq, rule allI)
   fix m
 
   show "x !! m = y !! m"
   proof (cases "m < n")
     case True
     then have "x !! m = ((x && mask n) !! m)"
       by (simp add: word_size test_bit_conj_lt)
     also have "\<dots> = ((y && mask n) !! m)" using m1 by simp
     also have "\<dots> = y !! m" using True
       by (simp add: word_size test_bit_conj_lt)
     finally show ?thesis .
   next
     case False
     then have "x !! m = ((x && ~~ (mask n)) !! m)"
       by (simp add: neg_mask_test_bit test_bit_conj_lt)
     also have "\<dots> = ((y && ~~ (mask n)) !! m)" using m2 by simp
     also have "\<dots> = y !! m" using False
       by (simp add: neg_mask_test_bit test_bit_conj_lt)
     finally show ?thesis .
   qed
 qed
 
 lemma nat_less_power_trans2:
   fixes n :: nat
   shows "\<lbrakk>n < 2 ^ (m - k); k \<le> m\<rbrakk> \<Longrightarrow> n * 2 ^ k  < 2 ^ m"
   by (subst mult.commute, erule (1) nat_less_power_trans)
 
 lemma nat_move_sub_le: "(a::nat) + b \<le> c \<Longrightarrow> a \<le> c - b" by arith
 
 lemma neq_0_no_wrap:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> x \<le> x + y; x \<noteq> 0 \<rbrakk> \<Longrightarrow> x + y \<noteq> 0"
   by clarsimp
 
 lemma plus_minus_one_rewrite:
   "v + (- 1 :: ('a :: {ring, one, uminus})) \<equiv> v - 1"
   by (simp add: field_simps)
 
 lemma power_minus_is_div:
   "b \<le> a \<Longrightarrow> (2 :: nat) ^ (a - b) = 2 ^ a div 2 ^ b"
   apply (induct a arbitrary: b)
    apply simp
   apply (erule le_SucE)
    apply (clarsimp simp:Suc_diff_le le_iff_add power_add)
   apply simp
   done
 
 lemma two_pow_div_gt_le:
   "v < 2 ^ n div (2 ^ m :: nat) \<Longrightarrow> m \<le> n"
   by (clarsimp dest!: less_two_pow_divD)
 
 lemma unatSuc2:
   fixes n :: "'a :: len word"
   shows "n + 1 \<noteq> 0 \<Longrightarrow> unat (n + 1) = Suc (unat n)"
   by (simp add: add.commute unatSuc)
 
 lemma word_of_nat_less:
   "\<lbrakk> n < unat x \<rbrakk> \<Longrightarrow> of_nat n < x"
   apply (simp add: word_less_nat_alt)
   apply (erule order_le_less_trans[rotated])
   apply (simp add: unat_of_nat)
   done
 
 lemma word_of_nat_le:
   "n \<le> unat x \<Longrightarrow> of_nat n \<le> x"
   apply (simp add: word_le_nat_alt unat_of_nat)
   apply (erule order_trans[rotated])
   apply simp
   done
 
 lemma word_unat_less_le:
    "a \<le> of_nat b \<Longrightarrow> unat a \<le> b"
    by (metis eq_iff le_cases le_unat_uoi word_of_nat_le)
 
 lemma and_eq_0_is_nth:
   fixes x :: "'a :: len word"
   shows "y = 1 << n \<Longrightarrow> ((x && y) = 0) = (\<not> (x !! n))"
   apply safe
    apply (drule_tac u="(x && (1 << n))" and x=n in word_eqD)
    apply (simp add: nth_w2p)
    apply (simp add: test_bit_bin)
   apply word_eqI
   done
 
 lemmas arg_cong_Not = arg_cong [where f=Not]
 lemmas and_neq_0_is_nth = arg_cong_Not [OF and_eq_0_is_nth, simplified]
 
 lemma nth_is_and_neq_0:
   "(x::'a::len word) !! n = (x && 2 ^ n \<noteq> 0)"
   by (subst and_neq_0_is_nth; rule refl)
 
 lemma mask_Suc_0 : "mask (Suc 0) = 1"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma ucast_ucast_add:
   fixes x :: "'a :: len word"
   fixes y :: "'b :: len word"
   shows
   "LENGTH('b) \<ge> LENGTH('a) \<Longrightarrow>
     ucast (ucast x + y) = x + ucast y"
   apply (rule word_unat.Rep_eqD)
   apply (simp add: unat_ucast unat_word_ariths mod_mod_power
                    min.absorb2 unat_of_nat)
   apply (subst mod_add_left_eq[symmetric])
   apply (simp add: mod_mod_power min.absorb2)
   apply (subst mod_add_right_eq)
   apply simp
   done
 
 lemma word_shift_zero:
   "\<lbrakk> x << n = 0; x \<le> 2^m; m + n < LENGTH('a)\<rbrakk> \<Longrightarrow> (x::'a::len word) = 0"
   apply (rule ccontr)
   apply (drule (2) word_shift_nonzero)
   apply simp
   done
 
 lemma bool_mask':
   fixes x :: "'a :: len word"
   shows "2 < LENGTH('a) \<Longrightarrow> (0 < x && 1) = (x && 1 = 1)"
   by (simp add: and_one_eq mod_2_eq_odd)
 
 lemma sint_eq_uint:
   "\<not> msb x \<Longrightarrow> sint x = uint x"
   apply (rule word_uint.Abs_eqD, subst word_sint.Rep_inverse)
     apply simp_all
   apply (cut_tac x=x in word_sint.Rep)
   apply (clarsimp simp add: uints_num sints_num)
   apply (rule conjI)
    apply (rule ccontr)
    apply (simp add: linorder_not_le word_msb_sint[symmetric])
   apply (erule order_less_le_trans)
   apply simp
   done
 
 lemma scast_eq_ucast:
   "\<not> msb x \<Longrightarrow> scast x = ucast x"
-  by (simp add: scast_def ucast_def sint_eq_uint)
+  by (simp add: scast_eq ucast_eq sint_eq_uint)
 
 lemma lt1_neq0:
   fixes x :: "'a :: len word"
   shows "(1 \<le> x) = (x \<noteq> 0)" by unat_arith
 
 lemma word_plus_one_nonzero:
   fixes x :: "'a :: len word"
   shows "\<lbrakk>x \<le> x + y; y \<noteq> 0\<rbrakk> \<Longrightarrow> x + 1 \<noteq> 0"
   apply (subst lt1_neq0 [symmetric])
   apply (subst olen_add_eqv [symmetric])
   apply (erule word_random)
   apply (simp add: lt1_neq0)
   done
 
 lemma word_sub_plus_one_nonzero:
   fixes n :: "'a :: len word"
   shows "\<lbrakk>n' \<le> n; n' \<noteq> 0\<rbrakk> \<Longrightarrow> (n - n') + 1 \<noteq> 0"
   apply (subst lt1_neq0 [symmetric])
   apply (subst olen_add_eqv [symmetric])
   apply (rule word_random [where x' = n'])
    apply simp
    apply (erule word_sub_le)
   apply (simp add: lt1_neq0)
   done
 
 lemma word_le_minus_mono_right:
   fixes x :: "'a :: len word"
   shows "\<lbrakk> z \<le> y; y \<le> x; z \<le> x \<rbrakk> \<Longrightarrow> x - y \<le> x - z"
   apply (rule word_sub_mono)
      apply simp
     apply assumption
    apply (erule word_sub_le)
   apply (erule word_sub_le)
   done
 
 lemma drop_append_miracle:
   "n = length xs \<Longrightarrow> drop n (xs @ ys) = ys"
   by simp
 
 lemma foldr_does_nothing_to_xf:
   "\<lbrakk> \<And>x s. x \<in> set xs \<Longrightarrow> xf (f x s) = xf s \<rbrakk> \<Longrightarrow> xf (foldr f xs s) = xf s"
   by (induct xs, simp_all)
 
 lemma nat_less_mult_monoish: "\<lbrakk> a < b; c < (d :: nat) \<rbrakk> \<Longrightarrow> (a + 1) * (c + 1) <= b * d"
   apply (drule Suc_leI)+
   apply (drule(1) mult_le_mono)
   apply simp
   done
 
 lemma word_0_sle_from_less[unfolded word_size]:
   "\<lbrakk> x < 2 ^ (size x - 1) \<rbrakk>  \<Longrightarrow> 0 <=s x"
   apply (clarsimp simp: word_sle_msb_le)
   apply (simp add: word_msb_nth)
   apply (subst (asm) word_test_bit_def [symmetric])
   apply (drule less_mask_eq)
   apply (drule_tac x="size x - 1" in word_eqD)
   apply (simp add: word_size)
   done
 
 lemma not_msb_from_less:
   "(v :: 'a word) < 2 ^ (LENGTH('a :: len) - 1) \<Longrightarrow> \<not> msb v"
   apply (clarsimp simp add: msb_nth)
   apply (drule less_mask_eq)
   apply (drule word_eqD, drule(1) iffD2)
   apply simp
   done
 
 lemma distinct_lemma: "f x \<noteq> f y \<Longrightarrow> x \<noteq> y" by auto
 
 
 lemma ucast_sub_ucast:
   fixes x :: "'a::len word"
   assumes "y \<le> x"
   assumes T: "LENGTH('a) \<le> LENGTH('b)"
   shows "ucast (x - y) = (ucast x - ucast y :: 'b::len word)"
 proof -
   from T
   have P: "unat x < 2 ^ LENGTH('b)" "unat y < 2 ^ LENGTH('b)"
     by (fastforce intro!: less_le_trans[OF unat_lt2p])+
   then show ?thesis
     by (simp add: unat_arith_simps unat_ucast assms[simplified unat_arith_simps])
 qed
 
 lemma word_1_0:
   "\<lbrakk>a + (1::('a::len) word) \<le> b; a < of_nat x\<rbrakk> \<Longrightarrow> a < b"
   by unat_arith
 
 lemma unat_of_nat_less:"\<lbrakk> a < b; unat b = c \<rbrakk> \<Longrightarrow> a < of_nat c"
   by fastforce
 
 lemma word_le_plus_1: "\<lbrakk> (y::('a::len) word) < y + n; a < n \<rbrakk> \<Longrightarrow> y + a \<le> y + a + 1"
   by unat_arith
 
 lemma word_le_plus:"\<lbrakk>(a::('a::len) word) < a + b; c < b\<rbrakk> \<Longrightarrow> a \<le> a + c"
 by (metis order_less_imp_le word_random)
 
 (*
  * Basic signed arithemetic properties.
  *)
 
 lemma sint_minus1 [simp]: "(sint x = -1) = (x = -1)"
   by (metis sint_n1 word_sint.Rep_inverse')
 
 lemma sint_0 [simp]: "(sint x = 0) = (x = 0)"
   by (metis sint_0 word_sint.Rep_inverse')
 
 (* It is not always that case that "sint 1 = 1", because of 1-bit word sizes.
  * This lemma produces the different cases. *)
 lemma sint_1_cases:
   "\<lbrakk> \<lbrakk> len_of TYPE ('a::len) = 1; (a::'a word) = 0; sint a = 0 \<rbrakk> \<Longrightarrow> P;
      \<lbrakk> len_of TYPE ('a) = 1; a = 1; sint (1 :: 'a word) = -1 \<rbrakk> \<Longrightarrow> P;
       \<lbrakk> len_of TYPE ('a) > 1; sint (1 :: 'a word) = 1 \<rbrakk> \<Longrightarrow> P \<rbrakk>
                 \<Longrightarrow> P"
    apply atomize_elim
   apply (case_tac "len_of TYPE ('a) = 1")
    apply clarsimp
    apply (subgoal_tac "(UNIV :: 'a word set) = {0, 1}")
     apply (metis UNIV_I insert_iff singletonE)
    apply (subst word_unat.univ)
    apply (clarsimp simp: unats_def image_def)
    apply (rule set_eqI, rule iffI)
     apply clarsimp
     apply (metis One_nat_def less_2_cases of_nat_1 semiring_1_class.of_nat_0)
    apply clarsimp
    apply (metis Abs_fnat_hom_0 Suc_1 lessI of_nat_1 zero_less_Suc)
   apply clarsimp
   apply (metis One_nat_def arith_is_1 le_def len_gt_0)
   done
 
 lemma sint_int_min:
   "sint (- (2 ^ (LENGTH('a) - Suc 0)) :: ('a::len) word) = - (2 ^ (LENGTH('a) - Suc 0))"
   apply (subst word_sint.Abs_inverse' [where r="- (2 ^ (LENGTH('a) - Suc 0))"])
     apply (clarsimp simp: sints_num)
    apply (clarsimp simp: wi_hom_syms word_of_int_2p)
   apply clarsimp
   done
 
 lemma sint_int_max_plus_1:
   "sint (2 ^ (LENGTH('a) - Suc 0) :: ('a::len) word) = - (2 ^ (LENGTH('a) - Suc 0))"
+  apply (cases \<open>LENGTH('a)\<close>)
+   apply simp_all
   apply (subst word_of_int_2p [symmetric])
   apply (subst int_word_sint)
-  apply clarsimp
-  apply (metis Suc_pred int_word_uint len_gt_0 power_Suc uint_eq_0 word_of_int_2p word_pow_0)
+  apply simp
   done
 
 lemma sbintrunc_eq_in_range:
   "(sbintrunc n x = x) = (x \<in> range (sbintrunc n))"
   "(x = sbintrunc n x) = (x \<in> range (sbintrunc n))"
   apply (simp_all add: image_def)
   apply (metis sbintrunc_sbintrunc)+
   done
 
 lemma sbintrunc_If:
   "- 3 * (2 ^ n) \<le> x \<and> x < 3 * (2 ^ n)
     \<Longrightarrow> sbintrunc n x = (if x < - (2 ^ n) then x + 2 * (2 ^ n)
         else if x \<ge> 2 ^ n then x - 2 * (2 ^ n) else x)"
   apply (simp add: no_sbintr_alt2, safe)
    apply (simp add: mod_pos_geq)
   apply (subst mod_add_self1[symmetric], simp)
   done
 
 lemma signed_arith_eq_checks_to_ord:
   "(sint a + sint b = sint (a + b ))
     = ((a <=s a + b) = (0 <=s b))"
   "(sint a - sint b = sint (a - b ))
     = ((0 <=s a - b) = (b <=s a))"
   "(- sint a = sint (- a)) = (0 <=s (- a) = (a <=s 0))"
   using sint_range'[where x=a] sint_range'[where x=b]
-  by (simp_all add: sint_word_ariths word_sle_def word_sless_alt sbintrunc_If)
+  by (simp_all add: sint_word_ariths word_sle_eq word_sless_alt sbintrunc_If)
 
 (* Basic proofs that signed word div/mod operations are
  * truncations of their integer counterparts. *)
 
 lemma signed_div_arith:
     "sint ((a::('a::len) word) sdiv b) = sbintrunc (LENGTH('a) - 1) (sint a sdiv sint b)"
   apply (subst word_sbin.norm_Rep [symmetric])
   apply (subst bin_sbin_eq_iff' [symmetric])
    apply simp
   apply (subst uint_sint [symmetric])
   apply (clarsimp simp: sdiv_int_def sdiv_word_def)
   apply (metis word_ubin.eq_norm)
   done
 
 lemma signed_mod_arith:
     "sint ((a::('a::len) word) smod b) = sbintrunc (LENGTH('a) - 1) (sint a smod sint b)"
   apply (subst word_sbin.norm_Rep [symmetric])
   apply (subst bin_sbin_eq_iff' [symmetric])
    apply simp
   apply (subst uint_sint [symmetric])
   apply (clarsimp simp: smod_int_def smod_word_def)
   apply (metis word_ubin.eq_norm)
   done
 
 (* Signed word arithmetic overflow constraints. *)
 
 lemma signed_arith_ineq_checks_to_eq:
   "((- (2 ^ (size a - 1)) \<le> (sint a + sint b)) \<and> (sint a + sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a + sint b = sint (a + b ))"
   "((- (2 ^ (size a - 1)) \<le> (sint a - sint b)) \<and> (sint a - sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a - sint b = sint (a - b))"
   "((- (2 ^ (size a - 1)) \<le> (- sint a)) \<and> (- sint a) \<le> (2 ^ (size a - 1) - 1))
     = ((- sint a) = sint (- a))"
   "((- (2 ^ (size a - 1)) \<le> (sint a * sint b)) \<and> (sint a * sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a * sint b = sint (a * b))"
   "((- (2 ^ (size a - 1)) \<le> (sint a sdiv sint b)) \<and> (sint a sdiv sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a sdiv sint b = sint (a sdiv b))"
   "((- (2 ^ (size a - 1)) \<le> (sint a smod sint b)) \<and> (sint a smod sint b \<le> (2 ^ (size a - 1) - 1)))
     = (sint a smod sint b = sint (a smod b))"
   by (auto simp: sint_word_ariths word_size signed_div_arith signed_mod_arith
                     sbintrunc_eq_in_range range_sbintrunc)
 
 lemma signed_arith_sint:
   "((- (2 ^ (size a - 1)) \<le> (sint a + sint b)) \<and> (sint a + sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a + b) = (sint a + sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a - sint b)) \<and> (sint a - sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a - b) = (sint a - sint b)"
   "((- (2 ^ (size a - 1)) \<le> (- sint a)) \<and> (- sint a) \<le> (2 ^ (size a - 1) - 1))
     \<Longrightarrow> sint (- a) = (- sint a)"
   "((- (2 ^ (size a - 1)) \<le> (sint a * sint b)) \<and> (sint a * sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a * b) = (sint a * sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a sdiv sint b)) \<and> (sint a sdiv sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a sdiv b) = (sint a sdiv sint b)"
   "((- (2 ^ (size a - 1)) \<le> (sint a smod sint b)) \<and> (sint a smod sint b \<le> (2 ^ (size a - 1) - 1)))
     \<Longrightarrow> sint (a smod b) = (sint a smod sint b)"
   by (subst (asm) signed_arith_ineq_checks_to_eq; simp)+
 
 lemma signed_mult_eq_checks_double_size:
   assumes mult_le: "(2 ^ (len_of TYPE ('a) - 1) + 1) ^ 2 \<le> (2 :: int) ^ (len_of TYPE ('b) - 1)"
            and le: "2 ^ (LENGTH('a) - 1) \<le> (2 :: int) ^ (len_of TYPE ('b) - 1)"
   shows "(sint (a :: 'a :: len word) * sint b = sint (a * b))
        = (scast a * scast b = (scast (a * b) :: 'b :: len word))"
 proof -
   have P: "sbintrunc (size a - 1) (sint a * sint b) \<in> range (sbintrunc (size a - 1))"
     by simp
 
   have abs: "!! x :: 'a word. abs (sint x) < 2 ^ (size a - 1) + 1"
     apply (cut_tac x=x in sint_range')
     apply (simp add: abs_le_iff word_size)
     done
   have abs_ab: "abs (sint a * sint b) < 2 ^ (LENGTH('b) - 1)"
     using abs_mult_less[OF abs[where x=a] abs[where x=b]] mult_le
     by (simp add: abs_mult power2_eq_square word_size)
   show ?thesis
     using P[unfolded range_sbintrunc] abs_ab le
-    apply (simp add: sint_word_ariths scast_def)
+    apply (simp add: sint_word_ariths scast_eq)
     apply (simp add: wi_hom_mult)
     apply (subst word_sint.Abs_inject, simp_all)
      apply (simp add: sints_def range_sbintrunc abs_less_iff)
     apply clarsimp
     apply (simp add: sints_def range_sbintrunc word_size)
     apply (auto elim: order_less_le_trans order_trans[rotated])
     done
 qed
 
 (* Properties about signed division. *)
 
 lemma int_sdiv_simps [simp]:
     "(a :: int) sdiv 1 = a"
     "(a :: int) sdiv 0 = 0"
     "(a :: int) sdiv -1 = -a"
   apply (auto simp: sdiv_int_def sgn_if)
   done
 
 lemma sgn_div_eq_sgn_mult:
     "a div b \<noteq> 0 \<Longrightarrow> sgn ((a :: int) div b) = sgn (a * b)"
   apply (clarsimp simp: sgn_if zero_le_mult_iff neg_imp_zdiv_nonneg_iff not_less)
   apply (metis less_le mult_le_0_iff neg_imp_zdiv_neg_iff not_less pos_imp_zdiv_neg_iff zdiv_eq_0_iff)
   done
 
 lemma sgn_sdiv_eq_sgn_mult:
   "a sdiv b \<noteq> 0 \<Longrightarrow> sgn ((a :: int) sdiv b) = sgn (a * b)"
   by (auto simp: sdiv_int_def sgn_div_eq_sgn_mult sgn_mult)
 
 lemma int_sdiv_same_is_1 [simp]:
     "a \<noteq> 0 \<Longrightarrow> ((a :: int) sdiv b = a) = (b = 1)"
   apply (rule iffI)
    apply (clarsimp simp: sdiv_int_def)
    apply (subgoal_tac "b > 0")
     apply (case_tac "a > 0")
      apply (clarsimp simp: sgn_if)
     apply (clarsimp simp: algebra_split_simps not_less)
     apply (metis int_div_same_is_1 le_neq_trans minus_minus neg_0_le_iff_le neg_equal_0_iff_equal)
    apply (case_tac "a > 0")
     apply (case_tac "b = 0")
      apply clarsimp
     apply (rule classical)
     apply (clarsimp simp: sgn_mult not_less)
     apply (metis le_less neg_0_less_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
    apply (rule classical)
    apply (clarsimp simp: algebra_split_simps sgn_mult not_less sgn_if split: if_splits)
    apply (metis antisym less_le neg_imp_zdiv_nonneg_iff)
   apply (clarsimp simp: sdiv_int_def sgn_if)
   done
 
 lemma int_sdiv_negated_is_minus1 [simp]:
     "a \<noteq> 0 \<Longrightarrow> ((a :: int) sdiv b = - a) = (b = -1)"
   apply (clarsimp simp: sdiv_int_def)
   apply (rule iffI)
    apply (subgoal_tac "b < 0")
     apply (case_tac "a > 0")
      apply (clarsimp simp: sgn_if algebra_split_simps not_less)
     apply (case_tac "sgn (a * b) = -1")
      apply (clarsimp simp: not_less algebra_split_simps)
     apply (clarsimp simp: algebra_split_simps not_less)
    apply (rule classical)
    apply (case_tac "b = 0")
     apply (clarsimp simp: not_less sgn_mult)
    apply (case_tac "a > 0")
     apply (clarsimp simp: not_less sgn_mult)
     apply (metis less_le neg_less_0_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
    apply (clarsimp simp: not_less sgn_mult)
    apply (metis antisym_conv div_minus_right neg_imp_zdiv_nonneg_iff neg_le_0_iff_le not_less)
   apply (clarsimp simp: sgn_if)
   done
 
 lemma sdiv_int_range:
     "(a :: int) sdiv b \<in> { - (abs a) .. (abs a) }"
   apply (unfold sdiv_int_def)
   apply (subgoal_tac "(abs a) div (abs b) \<le> (abs a)")
    apply (clarsimp simp: sgn_if)
    apply (meson abs_ge_zero neg_le_0_iff_le nonneg_mod_div order_trans)
   apply (metis abs_eq_0 abs_ge_zero div_by_0 zdiv_le_dividend zero_less_abs_iff)
   done
 
 lemma word_sdiv_div1 [simp]:
     "(a :: ('a::len) word) sdiv 1 = a"
   apply (rule sint_1_cases [where a=a])
     apply (clarsimp simp: sdiv_word_def sdiv_int_def)
    apply (clarsimp simp: sdiv_word_def sdiv_int_def simp del: sint_minus1)
   apply (clarsimp simp: sdiv_word_def)
   done
 
 lemma sdiv_int_div_0 [simp]:
   "(x :: int) sdiv 0 = 0"
   by (clarsimp simp: sdiv_int_def)
 
 lemma sdiv_int_0_div [simp]:
   "0 sdiv (x :: int) = 0"
   by (clarsimp simp: sdiv_int_def)
 
 lemma word_sdiv_div0 [simp]:
     "(a :: ('a::len) word) sdiv 0 = 0"
   apply (auto simp: sdiv_word_def sdiv_int_def sgn_if)
   done
 
 lemma word_sdiv_div_minus1 [simp]:
     "(a :: ('a::len) word) sdiv -1 = -a"
   apply (auto simp: sdiv_word_def sdiv_int_def sgn_if)
   apply (metis wi_hom_neg word_sint.Rep_inverse')
   done
 
 lemmas word_sdiv_0 = word_sdiv_div0
 
 lemma sdiv_word_min:
     "- (2 ^ (size a - 1)) \<le> sint (a :: ('a::len) word) sdiv sint (b :: ('a::len) word)"
   apply (clarsimp simp: word_size)
   apply (cut_tac sint_range' [where x=a])
   apply (cut_tac sint_range' [where x=b])
   apply clarsimp
   apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: max_def abs_if split: if_split_asm)
   done
 
 lemma sdiv_word_max:
     "(sint (a :: ('a::len) word) sdiv sint (b :: ('a::len) word) < (2 ^ (size a - 1))) =
           ((a \<noteq> - (2 ^ (size a - 1)) \<or> (b \<noteq> -1)))"
     (is "?lhs = (\<not> ?a_int_min \<or> \<not> ?b_minus1)")
 proof (rule classical)
   assume not_thesis: "\<not> ?thesis"
 
   have not_zero: "b \<noteq> 0"
     using not_thesis
     by (clarsimp)
 
   have result_range: "sint a sdiv sint b \<in> (sints (size a)) \<union> {2 ^ (size a - 1)}"
     apply (cut_tac sdiv_int_range [where a="sint a" and b="sint b"])
     apply (erule rev_subsetD)
     using sint_range' [where x=a]  sint_range' [where x=b]
     apply (auto simp: max_def abs_if word_size sints_num)
     done
 
   have result_range_overflow: "(sint a sdiv sint b = 2 ^ (size a - 1)) = (?a_int_min \<and> ?b_minus1)"
     apply (rule iffI [rotated])
      apply (clarsimp simp: sdiv_int_def sgn_if word_size sint_int_min)
     apply (rule classical)
     apply (case_tac "?a_int_min")
      apply (clarsimp simp: word_size sint_int_min)
      apply (metis diff_0_right
               int_sdiv_negated_is_minus1 minus_diff_eq minus_int_code(2)
               power_eq_0_iff sint_minus1 zero_neq_numeral)
     apply (subgoal_tac "abs (sint a) < 2 ^ (size a - 1)")
      apply (insert sdiv_int_range [where a="sint a" and b="sint b"])[1]
      apply (clarsimp simp: word_size)
     apply (insert sdiv_int_range [where a="sint a" and b="sint b"])[1]
     apply (insert word_sint.Rep [where x="a"])[1]
     apply (clarsimp simp: minus_le_iff word_size abs_if sints_num split: if_split_asm)
     apply (metis minus_minus sint_int_min word_sint.Rep_inject)
     done
 
   have result_range_simple: "(sint a sdiv sint b \<in> (sints (size a))) \<Longrightarrow> ?thesis"
     apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
     apply (clarsimp simp: word_size sints_num sint_int_min)
     done
 
   show ?thesis
     apply (rule UnE [OF result_range result_range_simple])
      apply simp
     apply (clarsimp simp: word_size)
     using result_range_overflow
     apply (clarsimp simp: word_size)
     done
 qed
 
 lemmas sdiv_word_min' = sdiv_word_min [simplified word_size, simplified]
 lemmas sdiv_word_max' = sdiv_word_max [simplified word_size, simplified]
 
 lemmas word_sdiv_numerals_lhs = sdiv_word_def[where a="numeral x" for x]
     sdiv_word_def[where a=0] sdiv_word_def[where a=1]
 
 lemmas word_sdiv_numerals = word_sdiv_numerals_lhs[where b="numeral y" for y]
     word_sdiv_numerals_lhs[where b=0] word_sdiv_numerals_lhs[where b=1]
 
 (*
  * Signed modulo properties.
  *)
 
 lemma smod_int_alt_def:
      "(a::int) smod b = sgn (a) * (abs a mod abs b)"
   apply (clarsimp simp: smod_int_def sdiv_int_def)
   apply (clarsimp simp: minus_div_mult_eq_mod [symmetric] abs_sgn sgn_mult sgn_if algebra_split_simps)
   done
 
 lemma smod_int_range:
   "b \<noteq> 0 \<Longrightarrow> (a::int) smod b \<in> { - abs b + 1 .. abs b - 1 }"
   apply (case_tac  "b > 0")
    apply (insert pos_mod_conj [where a=a and b=b])[1]
    apply (insert pos_mod_conj [where a="-a" and b=b])[1]
    apply (auto simp: smod_int_alt_def algebra_simps sgn_if
               abs_if not_less add1_zle_eq [simplified add.commute])[1]
     apply (metis add_nonneg_nonneg int_one_le_iff_zero_less le_less less_add_same_cancel2 not_le pos_mod_conj)
   apply (metis (full_types) add.inverse_inverse eucl_rel_int eucl_rel_int_iff le_less_trans neg_0_le_iff_le)
   apply (insert neg_mod_conj [where a=a and b="b"])[1]
   apply (insert neg_mod_conj [where a="-a" and b="b"])[1]
   apply (clarsimp simp: smod_int_alt_def algebra_simps sgn_if
             abs_if not_less add1_zle_eq [simplified add.commute])
   apply (metis neg_0_less_iff_less neg_mod_conj not_le not_less_iff_gr_or_eq order_trans pos_mod_conj)
   done
 
 lemma smod_int_compares:
    "\<lbrakk> 0 \<le> a; 0 < b \<rbrakk> \<Longrightarrow> (a :: int) smod b < b"
    "\<lbrakk> 0 \<le> a; 0 < b \<rbrakk> \<Longrightarrow> 0 \<le> (a :: int) smod b"
    "\<lbrakk> a \<le> 0; 0 < b \<rbrakk> \<Longrightarrow> -b < (a :: int) smod b"
    "\<lbrakk> a \<le> 0; 0 < b \<rbrakk> \<Longrightarrow> (a :: int) smod b \<le> 0"
    "\<lbrakk> 0 \<le> a; b < 0 \<rbrakk> \<Longrightarrow> (a :: int) smod b < - b"
    "\<lbrakk> 0 \<le> a; b < 0 \<rbrakk> \<Longrightarrow> 0 \<le> (a :: int) smod b"
    "\<lbrakk> a \<le> 0; b < 0 \<rbrakk> \<Longrightarrow> (a :: int) smod b \<le> 0"
    "\<lbrakk> a \<le> 0; b < 0 \<rbrakk> \<Longrightarrow> b \<le> (a :: int) smod b"
   apply (insert smod_int_range [where a=a and b=b])
   apply (auto simp: add1_zle_eq smod_int_alt_def sgn_if)
   done
 
 lemma smod_int_mod_0 [simp]:
   "x smod (0 :: int) = x"
   by (clarsimp simp: smod_int_def)
 
 lemma smod_int_0_mod [simp]:
   "0 smod (x :: int) = 0"
   by (clarsimp simp: smod_int_alt_def)
 
 lemma smod_word_mod_0 [simp]:
   "x smod (0 :: ('a::len) word) = x"
   by (clarsimp simp: smod_word_def)
 
 lemma smod_word_0_mod [simp]:
   "0 smod (x :: ('a::len) word) = 0"
   by (clarsimp simp: smod_word_def)
 
 lemma smod_word_max:
     "sint (a::'a word) smod sint (b::'a word) < 2 ^ (LENGTH('a::len) - Suc 0)"
   apply (case_tac "b = 0")
    apply (insert word_sint.Rep [where x=a, simplified sints_num])[1]
    apply (clarsimp)
   apply (insert word_sint.Rep [where x="b", simplified sints_num])[1]
   apply (insert smod_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: abs_if split: if_split_asm)
   done
 
 lemma smod_word_min:
     "- (2 ^ (LENGTH('a::len) - Suc 0)) \<le> sint (a::'a word) smod sint (b::'a word)"
   apply (case_tac "b = 0")
    apply (insert word_sint.Rep [where x=a, simplified sints_num])[1]
    apply clarsimp
   apply (insert word_sint.Rep [where x=b, simplified sints_num])[1]
   apply (insert smod_int_range [where a="sint a" and b="sint b"])
   apply (clarsimp simp: abs_if add1_zle_eq split: if_split_asm)
   done
 
 lemma smod_word_alt_def:
   "(a :: ('a::len) word) smod b = a - (a sdiv b) * b"
   apply (case_tac "a \<noteq> - (2 ^ (LENGTH('a) - 1)) \<or> b \<noteq> -1")
    apply (clarsimp simp: smod_word_def sdiv_word_def smod_int_def
              minus_word.abs_eq [symmetric] times_word.abs_eq [symmetric])
   apply (clarsimp simp: smod_word_def smod_int_def)
   done
 
 lemmas word_smod_numerals_lhs = smod_word_def[where a="numeral x" for x]
     smod_word_def[where a=0] smod_word_def[where a=1]
 
 lemmas word_smod_numerals = word_smod_numerals_lhs[where b="numeral y" for y]
     word_smod_numerals_lhs[where b=0] word_smod_numerals_lhs[where b=1]
 
 lemma sint_of_int_eq:
   "\<lbrakk> - (2 ^ (LENGTH('a) - 1)) \<le> x; x < 2 ^ (LENGTH('a) - 1) \<rbrakk> \<Longrightarrow> sint (of_int x :: ('a::len) word) = x"
   apply (clarsimp simp: word_of_int int_word_sint)
   apply (subst int_mod_eq')
     apply simp
    apply (subst (2) power_minus_simp)
     apply clarsimp
    apply clarsimp
   apply clarsimp
   done
 
 lemma of_int_sint [simp]:
     "of_int (sint a) = a"
   apply (insert word_sint.Rep [where x=a])
   apply (clarsimp simp: word_of_int)
   done
 
 lemma nth_w2p_scast [simp]:
   "((scast ((2::'a::len signed word) ^ n) :: 'a word) !! m)
          \<longleftrightarrow> ((((2::'a::len  word) ^ n) :: 'a word) !! m)"
   apply (subst nth_w2p)
   apply (case_tac "n \<ge> LENGTH('a)")
    apply (subst power_overflow, simp)
    apply clarsimp
-  apply (metis nth_w2p scast_def test_bit_conj_lt
+  apply (metis nth_w2p scast_eq test_bit_conj_lt
                len_signed nth_word_of_int word_sint.Rep_inverse)
   done
 
 lemma scast_2_power [simp]: "scast ((2 :: 'a::len signed word) ^ x) = ((2 :: 'a word) ^ x)"
   by (clarsimp simp: word_eq_iff)
 
 lemma scast_bit_test [simp]:
     "scast ((1 :: 'a::len signed word) << n) = (1 :: 'a word) << n"
   by (clarsimp simp: word_eq_iff)
 
 lemma ucast_nat_def':
   "of_nat (unat x) = (ucast :: 'a :: len word \<Rightarrow> ('b :: len) signed word) x"
-  by (simp add: ucast_def word_of_int_nat unat_def)
+  by (fact ucast_nat_def)
 
 lemma mod_mod_power_int:
   fixes k :: int
   shows "k mod 2 ^ m mod 2 ^ n = k mod 2 ^ (min m n)"
   by (metis bintrunc_bintrunc_min bintrunc_mod2p min.commute)
 
 (* Normalise combinations of scast and ucast. *)
 
 lemma ucast_distrib:
   fixes M :: "'a::len word \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word"
   fixes M' :: "'b::len word \<Rightarrow> 'b::len word \<Rightarrow> 'b::len word"
   fixes L :: "int \<Rightarrow> int \<Rightarrow> int"
   assumes lift_M: "\<And>x y. uint (M x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('a)"
   assumes lift_M': "\<And>x y. uint (M' x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('b)"
   assumes distrib: "\<And>x y. (L (x mod (2 ^ LENGTH('b))) (y mod (2 ^ LENGTH('b)))) mod (2 ^ LENGTH('b))
                                = (L x y) mod (2 ^ LENGTH('b))"
   assumes is_down: "is_down (ucast :: 'a word \<Rightarrow> 'b word)"
   shows "ucast (M a b) = M' (ucast a) (ucast b)"
-  apply (clarsimp simp: word_of_int ucast_def)
+  apply (clarsimp simp: word_of_int ucast_eq)
   apply (subst lift_M)
   apply (subst of_int_uint [symmetric], subst lift_M')
   apply (subst (1 2) int_word_uint)
   apply (subst word_of_int)
   apply (subst word.abs_eq_iff)
   apply (subst (1 2) bintrunc_mod2p)
   apply (insert is_down)
   apply (unfold is_down_def)
   apply (clarsimp simp: target_size source_size)
   apply (clarsimp simp: mod_mod_power_int min_def)
   apply (rule distrib [symmetric])
   done
 
 lemma ucast_down_add:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) + b) = (ucast a + ucast b :: 'b::len word)"
   by (rule ucast_distrib [where L="(+)"], (clarsimp simp: uint_word_ariths)+, presburger, simp)
 
 lemma ucast_down_minus:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) - b) = (ucast a - ucast b :: 'b::len word)"
   apply (rule ucast_distrib [where L="(-)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_diff_left_eq mod_diff_right_eq)
   apply simp
   done
 
 lemma ucast_down_mult:
     "is_down (ucast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  ucast ((a :: 'a::len word) * b) = (ucast a * ucast b :: 'b::len word)"
   apply (rule ucast_distrib [where L="(*)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_mult_eq)
   apply simp
   done
 
 lemma scast_distrib:
   fixes M :: "'a::len word \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word"
   fixes M' :: "'b::len word \<Rightarrow> 'b::len word \<Rightarrow> 'b::len word"
   fixes L :: "int \<Rightarrow> int \<Rightarrow> int"
   assumes lift_M: "\<And>x y. uint (M x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('a)"
   assumes lift_M': "\<And>x y. uint (M' x y) = L (uint x) (uint y)  mod 2 ^ LENGTH('b)"
   assumes distrib: "\<And>x y. (L (x mod (2 ^ LENGTH('b))) (y mod (2 ^ LENGTH('b)))) mod (2 ^ LENGTH('b))
                                = (L x y) mod (2 ^ LENGTH('b))"
   assumes is_down: "is_down (scast :: 'a word \<Rightarrow> 'b word)"
   shows "scast (M a b) = M' (scast a) (scast b)"
   apply (subst (1 2 3) down_cast_same [symmetric])
    apply (insert is_down)
    apply (clarsimp simp: is_down_def target_size source_size is_down)
   apply (rule ucast_distrib [where L=L, OF lift_M lift_M' distrib])
   apply (insert is_down)
   apply (clarsimp simp: is_down_def target_size source_size is_down)
   done
 
 lemma scast_down_add:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) + b) = (scast a + scast b :: 'b::len word)"
   by (rule scast_distrib [where L="(+)"], (clarsimp simp: uint_word_ariths)+, presburger, simp)
 
 lemma scast_down_minus:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) - b) = (scast a - scast b :: 'b::len word)"
   apply (rule scast_distrib [where L="(-)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_diff_left_eq mod_diff_right_eq)
   apply simp
   done
 
 lemma scast_down_mult:
     "is_down (scast:: 'a word \<Rightarrow> 'b word) \<Longrightarrow>  scast ((a :: 'a::len word) * b) = (scast a * scast b :: 'b::len word)"
   apply (rule scast_distrib [where L="(*)"], (clarsimp simp: uint_word_ariths)+)
   apply (metis mod_mult_eq)
   apply simp
   done
 
 lemma scast_ucast_1:
   "\<lbrakk> is_down (ucast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
-  by (metis down_cast_same ucast_def ucast_down_wi)
+  by (metis down_cast_same ucast_eq ucast_down_wi)
 
 lemma scast_ucast_3:
   "\<lbrakk> is_down (ucast :: 'a word \<Rightarrow> 'c word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
-  by (metis down_cast_same ucast_def ucast_down_wi)
+  by (metis down_cast_same ucast_eq ucast_down_wi)
 
 lemma scast_ucast_4:
   "\<lbrakk> is_up (ucast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
          (scast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
-  by (metis down_cast_same ucast_def ucast_down_wi)
+  by (metis down_cast_same ucast_eq ucast_down_wi)
 
 lemma scast_scast_b:
   "\<lbrakk> is_up (scast :: 'a word \<Rightarrow> 'b word) \<rbrakk> \<Longrightarrow>
      (scast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
-  by (metis scast_def sint_up_scast)
+  by (metis scast_eq sint_up_scast)
 
 lemma ucast_scast_1:
   "\<lbrakk> is_down (scast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
             (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
-  by (metis scast_def ucast_down_wi)
+  by (metis scast_eq ucast_down_wi)
 
 lemma ucast_scast_3:
   "\<lbrakk> is_down (scast :: 'a word \<Rightarrow> 'c word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
      (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
-  by (metis scast_def ucast_down_wi)
+  by (metis scast_eq ucast_down_wi)
 
 lemma ucast_scast_4:
   "\<lbrakk> is_up (scast :: 'a word \<Rightarrow> 'b word); is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
      (ucast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
-  by (metis down_cast_same scast_def sint_up_scast)
+  by (metis down_cast_same scast_eq sint_up_scast)
 
 lemma ucast_ucast_a:
   "\<lbrakk> is_down (ucast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
         (ucast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
-  by (metis down_cast_same ucast_def ucast_down_wi)
+  by (metis down_cast_same ucast_eq ucast_down_wi)
 
 lemma ucast_ucast_b:
   "\<lbrakk> is_up (ucast :: 'a word \<Rightarrow> 'b word) \<rbrakk> \<Longrightarrow>
      (ucast (ucast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = ucast a"
   by (metis ucast_up_ucast)
 
 lemma scast_scast_a:
   "\<lbrakk> is_down (scast :: 'b word \<Rightarrow> 'c word) \<rbrakk> \<Longrightarrow>
             (scast (scast (a :: 'a::len word) :: 'b::len word) :: 'c::len word) = scast a"
-  apply (clarsimp simp: scast_def)
-  apply (metis down_cast_same is_up_down scast_def ucast_down_wi)
+  apply (clarsimp simp: scast_eq)
+  apply (metis down_cast_same is_up_down scast_eq ucast_down_wi)
   done
 
 lemma scast_down_wi [OF refl]:
   "uc = scast \<Longrightarrow> is_down uc \<Longrightarrow> uc (word_of_int x) = word_of_int x"
   by (metis down_cast_same is_up_down ucast_down_wi)
 
 lemmas cast_simps =
   is_down is_up
   scast_down_add scast_down_minus scast_down_mult
   ucast_down_add ucast_down_minus ucast_down_mult
   scast_ucast_1 scast_ucast_3 scast_ucast_4
   ucast_scast_1 ucast_scast_3 ucast_scast_4
   ucast_ucast_a ucast_ucast_b
   scast_scast_a scast_scast_b
   ucast_down_bl
   ucast_down_wi scast_down_wi
   ucast_of_nat scast_of_nat
   uint_up_ucast sint_up_scast
   up_scast_surj up_ucast_surj
 
 lemma smod_mod_positive:
     "\<lbrakk> 0 \<le> (a :: int); 0 \<le> b \<rbrakk> \<Longrightarrow> a smod b = a mod b"
   by (clarsimp simp: smod_int_alt_def zsgn_def)
 
 lemma nat_mult_power_less_eq:
   "b > 0 \<Longrightarrow> (a * b ^ n < (b :: nat) ^ m) = (a < b ^ (m - n))"
   using mult_less_cancel2[where m = a and k = "b ^ n" and n="b ^ (m - n)"]
         mult_less_cancel2[where m="a * b ^ (n - m)" and k="b ^ m" and n=1]
   apply (simp only: power_add[symmetric] nat_minus_add_max)
   apply (simp only: power_add[symmetric] nat_minus_add_max ac_simps)
   apply (simp add: max_def split: if_split_asm)
   done
 
 lemma signed_shift_guard_to_word:
   "\<lbrakk> n < len_of TYPE ('a); n > 0 \<rbrakk>
     \<Longrightarrow> (unat (x :: 'a :: len word) * 2 ^ y < 2 ^ n)
     = (x = 0 \<or> x < (1 << n >> y))"
   apply (simp only: nat_mult_power_less_eq)
   apply (cases "y \<le> n")
    apply (simp only: shiftl_shiftr1)
    apply (subst less_mask_eq)
     apply (simp add: word_less_nat_alt word_size)
     apply (rule order_less_le_trans[rotated], rule power_increasing[where n=1])
       apply simp
      apply simp
     apply simp
    apply (simp add: nat_mult_power_less_eq word_less_nat_alt word_size)
    apply auto[1]
   apply (simp only: shiftl_shiftr2, simp add: unat_eq_0)
   done
 
 lemma sint_ucast_eq_uint:
     "\<lbrakk> \<not> is_down (ucast :: ('a::len word \<Rightarrow> 'b::len word)) \<rbrakk>
             \<Longrightarrow> sint ((ucast :: ('a::len word \<Rightarrow> 'b::len word)) x) = uint x"
   apply (subst sint_eq_uint)
    apply (clarsimp simp: msb_nth nth_ucast is_down)
    apply (metis Suc_leI Suc_pred len_gt_0)
   apply (clarsimp simp: uint_up_ucast is_up is_down)
   done
 
 lemma word_less_nowrapI':
   "(x :: 'a :: len word) \<le> z - k \<Longrightarrow> k \<le> z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k"
   by uint_arith
 
 lemma mask_plus_1:
   "mask n + 1 = 2 ^ n"
-  by (clarsimp simp: mask_def)
+  by (clarsimp simp: mask_eq_decr_exp)
 
 lemma unat_inj: "inj unat"
   by (metis eq_iff injI word_le_nat_alt)
 
 lemma unat_ucast_upcast:
   "is_up (ucast :: 'b word \<Rightarrow> 'a word)
       \<Longrightarrow> unat (ucast x :: ('a::len) word) = unat (x :: ('b::len) word)"
-  unfolding ucast_def unat_def
+  unfolding ucast_eq unat_eq_nat_uint
   apply (subst int_word_uint)
   apply (subst mod_pos_pos_trivial)
     apply simp
    apply (rule lt2p_lem)
    apply (clarsimp simp: is_up)
   apply simp
   done
 
 lemma ucast_mono:
   "\<lbrakk> (x :: 'b :: len word) < y; y < 2 ^ LENGTH('a) \<rbrakk>
    \<Longrightarrow> ucast x < ((ucast y) :: 'a :: len word)"
   apply (simp add: ucast_nat_def [symmetric])
   apply (rule of_nat_mono_maybe)
   apply (rule unat_less_helper)
   apply (simp add: Power.of_nat_power)
   apply (simp add: word_less_nat_alt)
   done
 
 lemma ucast_mono_le:
   "\<lbrakk>x \<le> y; y < 2 ^ LENGTH('b)\<rbrakk> \<Longrightarrow> (ucast (x :: 'a :: len word) :: 'b :: len word) \<le> ucast y"
   apply (simp add: ucast_nat_def [symmetric])
   apply (subst of_nat_mono_maybe_le[symmetric])
     apply (rule unat_less_helper)
     apply (simp add: Power.of_nat_power)
    apply (rule unat_less_helper)
    apply (erule le_less_trans)
    apply (simp add: Power.of_nat_power)
   apply (simp add: word_le_nat_alt)
   done
 
 lemma ucast_mono_le':
   "\<lbrakk> unat y < 2 ^ LENGTH('b); LENGTH('b::len) < LENGTH('a::len); x \<le> y \<rbrakk>
    \<Longrightarrow> UCAST('a \<rightarrow> 'b) x \<le> UCAST('a \<rightarrow> 'b) y"
   by (auto simp: word_less_nat_alt intro: ucast_mono_le)
 
 lemma zero_sle_ucast_up:
   "\<not> is_down (ucast :: 'a word \<Rightarrow> 'b signed word) \<Longrightarrow>
           (0 <=s ((ucast (b::('a::len) word)) :: ('b::len) signed word))"
   apply (subgoal_tac "\<not> msb (ucast b :: 'b signed word)")
    apply (clarsimp simp: word_sle_msb_le)
   apply (clarsimp simp: is_down not_le msb_nth nth_ucast)
   apply (subst (asm) test_bit_conj_lt [symmetric])
   apply clarsimp
   apply arith
   done
 
 lemma word_le_ucast_sless:
   "\<lbrakk> x \<le> y; y \<noteq> -1; LENGTH('a) < LENGTH('b) \<rbrakk> \<Longrightarrow>
     UCAST (('a :: len) \<rightarrow> ('b :: len) signed) x <s ucast (y + 1)"
   by (clarsimp simp: word_le_make_less word_sless_alt sint_ucast_eq_uint is_down word_less_def)
 
 lemma msb_ucast_eq:
     "LENGTH('a) = LENGTH('b) \<Longrightarrow>
          msb (ucast x :: ('a::len) word) = msb (x :: ('b::len) word)"
   apply (clarsimp simp: word_msb_alt)
   apply (subst ucast_down_drop [where n=0])
    apply (clarsimp simp: source_size_def target_size_def word_size)
   apply clarsimp
   done
 
 lemma msb_big:
      "msb (a :: ('a::len) word) = (a \<ge> 2 ^ (LENGTH('a)  - Suc 0))"
   apply (rule iffI)
    apply (clarsimp simp: msb_nth)
    apply (drule bang_is_le)
    apply simp
   apply (rule ccontr)
   apply (subgoal_tac "a = a && mask (LENGTH('a) - Suc 0)")
    apply (cut_tac and_mask_less' [where w=a and n="LENGTH('a) - Suc 0"])
     apply (clarsimp simp: word_not_le [symmetric])
    apply clarsimp
   apply (rule sym, subst and_mask_eq_iff_shiftr_0)
   apply (clarsimp simp: msb_shift)
   done
 
 lemma zero_sle_ucast:
   "(0 <=s ((ucast (b::('a::len) word)) :: ('a::len) signed word))
                 = (uint b < 2 ^ (LENGTH('a) - 1))"
   apply (case_tac "msb b")
    apply (clarsimp simp: word_sle_msb_le not_less msb_ucast_eq del: notI)
    apply (clarsimp simp: msb_big word_le_def uint_2p_alt)
   apply (clarsimp simp: word_sle_msb_le not_less msb_ucast_eq del: notI)
   apply (clarsimp simp: msb_big word_le_def uint_2p_alt)
   done
 
 
 (* to_bool / from_bool. *)
 
 definition
   from_bool :: "bool \<Rightarrow> 'a::len word" where
   "from_bool b \<equiv> case b of True \<Rightarrow> of_nat 1
                          | False \<Rightarrow> of_nat 0"
 
 lemma from_bool_0:
   "(from_bool x = 0) = (\<not> x)"
   by (simp add: from_bool_def split: bool.split)
 
 definition
   to_bool :: "'a::len word \<Rightarrow> bool" where
   "to_bool \<equiv> (\<noteq>) 0"
 
 lemma to_bool_and_1:
   "to_bool (x && 1) = (x !! 0)"
   by (simp add: test_bit_word_eq to_bool_def and_one_eq mod_2_eq_odd)
 
 lemma to_bool_from_bool [simp]:
   "to_bool (from_bool r) = r"
   unfolding from_bool_def to_bool_def
   by (simp split: bool.splits)
 
 lemma from_bool_neq_0 [simp]:
   "(from_bool b \<noteq> 0) = b"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma from_bool_mask_simp [simp]:
   "(from_bool r :: 'a::len word) && 1 = from_bool r"
   unfolding from_bool_def
   by (clarsimp split: bool.splits)
 
 lemma from_bool_1 [simp]:
   "(from_bool P = 1) = P"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma ge_0_from_bool [simp]:
   "(0 < from_bool P) = P"
   by (simp add: from_bool_def split: bool.splits)
 
 lemma limited_and_from_bool:
   "limited_and (from_bool b) 1"
   by (simp add: from_bool_def limited_and_def split: bool.split)
 
 lemma to_bool_1 [simp]: "to_bool 1" by (simp add: to_bool_def)
 lemma to_bool_0 [simp]: "\<not>to_bool 0" by (simp add: to_bool_def)
 
 lemma from_bool_eq_if:
   "(from_bool Q = (if P then 1 else 0)) = (P = Q)"
   by (simp add: case_bool_If from_bool_def split: if_split)
 
 lemma to_bool_eq_0:
   "(\<not> to_bool x) = (x = 0)"
   by (simp add: to_bool_def)
 
 lemma to_bool_neq_0:
   "(to_bool x) = (x \<noteq> 0)"
   by (simp add: to_bool_def)
 
 lemma from_bool_all_helper:
   "(\<forall>bool. from_bool bool = val \<longrightarrow> P bool)
       = ((\<exists>bool. from_bool bool = val) \<longrightarrow> P (val \<noteq> 0))"
   by (auto simp: from_bool_0)
 
 lemma from_bool_to_bool_iff:
   "w = from_bool b \<longleftrightarrow> to_bool w = b \<and> (w = 0 \<or> w = 1)"
   by (cases b) (auto simp: from_bool_def to_bool_def)
 
 lemma from_bool_eqI:
   "from_bool x = from_bool y \<Longrightarrow> x = y"
   unfolding from_bool_def
   by (auto split: bool.splits)
 
 lemma word_rsplit_upt:
   "\<lbrakk> size x = LENGTH('a :: len) * n; n \<noteq> 0 \<rbrakk>
     \<Longrightarrow> word_rsplit x = map (\<lambda>i. ucast (x >> i * len_of TYPE ('a)) :: 'a word) (rev [0 ..< n])"
   apply (subgoal_tac "length (word_rsplit x :: 'a word list) = n")
    apply (rule nth_equalityI, simp)
    apply (intro allI word_eqI impI)
    apply (simp add: test_bit_rsplit_alt word_size)
    apply (simp add: nth_ucast nth_shiftr rev_nth field_simps)
   apply (simp add: length_word_rsplit_exp_size)
   apply (metis mult.commute given_quot_alt word_size word_size_gt_0)
   done
 
 lemma aligned_shift:
   "\<lbrakk>x < 2 ^ n; is_aligned (y :: 'a :: len word) n;n \<le> LENGTH('a)\<rbrakk>
    \<Longrightarrow> x + y >> n = y >> n"
   by (subst word_plus_and_or_coroll; word_eqI, blast)
 
 lemma aligned_shift':
   "\<lbrakk>x < 2 ^ n; is_aligned (y :: 'a :: len word) n;n \<le> LENGTH('a)\<rbrakk>
    \<Longrightarrow> y + x >> n = y >> n"
   by (subst word_plus_and_or_coroll; word_eqI, blast)
 
 lemma neg_mask_add_mask:
   "((x:: 'a :: len word) && ~~ (mask n)) + (2 ^ n - 1) = x || mask n"
   unfolding mask_2pm1[symmetric]
   by (subst word_plus_and_or_coroll; word_eqI_solve)
 
 lemma subtract_mask:
   "p - (p && mask n) = (p && ~~ (mask n))"
   "p - (p && ~~ (mask n)) = (p && mask n)"
   by (simp add: field_simps word_plus_and_or_coroll2)+
 
 lemma and_neg_mask_plus_mask_mono: "(p && ~~ (mask n)) + mask n \<ge> p"
   apply (rule word_le_minus_cancel[where x = "p && ~~ (mask n)"])
    apply (clarsimp simp: subtract_mask)
    using word_and_le1[where a = "mask n" and y = p]
-   apply (clarsimp simp: mask_def word_le_less_eq)
+   apply (clarsimp simp: mask_eq_decr_exp word_le_less_eq)
   apply (rule is_aligned_no_overflow'[folded mask_2pm1])
   apply (clarsimp simp: is_aligned_neg_mask)
   done
 
 lemma word_neg_and_le:
   "ptr \<le> (ptr && ~~ (mask n)) + (2 ^ n - 1)"
   by (simp add: and_neg_mask_plus_mask_mono mask_2pm1[symmetric])
 
 lemma aligned_less_plus_1:
   "\<lbrakk> is_aligned x n; n > 0 \<rbrakk> \<Longrightarrow> x < x + 1"
   apply (rule plus_one_helper2)
    apply (rule order_refl)
   apply (clarsimp simp: field_simps)
   apply (drule arg_cong[where f="\<lambda>x. x - 1"])
   apply (clarsimp simp: is_aligned_mask)
   apply (drule word_eqD[where x=0])
   apply simp
   done
 
 lemma aligned_add_offset_less:
   "\<lbrakk>is_aligned x n; is_aligned y n; x < y; z < 2 ^ n\<rbrakk> \<Longrightarrow> x + z < y"
   apply (cases "y = 0")
    apply simp
   apply (erule is_aligned_get_word_bits[where p=y], simp_all)
   apply (cases "z = 0", simp_all)
   apply (drule(2) aligned_at_least_t2n_diff[rotated -1])
   apply (drule plus_one_helper2)
    apply (rule less_is_non_zero_p1)
    apply (rule aligned_less_plus_1)
     apply (erule aligned_sub_aligned[OF _ _ order_refl],
            simp_all add: is_aligned_triv)[1]
    apply (cases n, simp_all)[1]
   apply (simp only: trans[OF diff_add_eq diff_diff_eq2[symmetric]])
   apply (drule word_less_add_right)
    apply (rule ccontr, simp add: linorder_not_le)
    apply (drule aligned_small_is_0, erule order_less_trans)
     apply (clarsimp simp: power_overflow)
    apply simp
   apply (erule order_le_less_trans[rotated],
          rule word_plus_mono_right)
    apply (erule word_le_minus_one_leq)
   apply (simp add: is_aligned_no_wrap' is_aligned_no_overflow field_simps)
   done
 
 lemma is_aligned_add_helper:
   "\<lbrakk> is_aligned p n; d < 2 ^ n \<rbrakk>
      \<Longrightarrow> (p + d && mask n = d) \<and> (p + d && (~~ (mask n)) = p)"
   apply (subst(asm) is_aligned_mask)
   apply (drule less_mask_eq)
   apply (rule context_conjI)
    apply (subst word_plus_and_or_coroll; word_eqI; blast)
   using word_plus_and_or_coroll2[where x="p + d" and w="mask n"] by simp
 
 lemma is_aligned_sub_helper:
   "\<lbrakk> is_aligned (p - d) n; d < 2 ^ n \<rbrakk>
      \<Longrightarrow> (p && mask n = d) \<and> (p && (~~ (mask n)) = p - d)"
   by (drule(1) is_aligned_add_helper, simp)
 
 lemma mask_twice:
   "(x && mask n) && mask m = x && mask (min m n)"
   by word_eqI_solve
 
 lemma is_aligned_after_mask:
   "\<lbrakk>is_aligned k m;m\<le> n\<rbrakk> \<Longrightarrow> is_aligned (k && mask n) m"
   by (rule is_aligned_andI1)
 
 lemma and_mask_plus:
   "\<lbrakk>is_aligned ptr m; m \<le> n; a < 2 ^ m\<rbrakk>
    \<Longrightarrow> ptr + a && mask n = (ptr && mask n) + a"
   apply (rule mask_eqI[where n = m])
    apply (simp add:mask_twice min_def)
     apply (simp add:is_aligned_add_helper)
     apply (subst is_aligned_add_helper[THEN conjunct1])
       apply (erule is_aligned_after_mask)
      apply simp
     apply simp
    apply simp
   apply (subgoal_tac "(ptr + a && mask n) && ~~ (mask m)
      = (ptr + a && ~~ (mask m) ) && mask n")
    apply (simp add:is_aligned_add_helper)
    apply (subst is_aligned_add_helper[THEN conjunct2])
      apply (simp add:is_aligned_after_mask)
     apply simp
    apply simp
   apply (simp add:word_bw_comms word_bw_lcs)
   done
 
 lemma le_step_down_word:"\<lbrakk>(i::('a::len) word) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by unat_arith
 
 lemma le_step_down_word_2:
   fixes x :: "'a::len word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (subst (asm) word_le_less_eq,
       clarsimp,
       simp add: word_le_minus_one_leq)
 
 lemma NOT_mask_AND_mask[simp]: "(w && mask n) && ~~ (mask n) = 0"
-  by (clarsimp simp add: mask_def Parity.bit_eq_iff bit_and_iff bit_not_iff bit_mask_iff)
+  by (clarsimp simp add: mask_eq_decr_exp Parity.bit_eq_iff bit_and_iff bit_not_iff bit_mask_iff)
 
 lemma and_and_not[simp]:"(a && b) && ~~ b = 0"
   apply (subst word_bw_assocs(1))
   apply clarsimp
   done
 
 lemma mask_shift_and_negate[simp]:"(w && mask n << m) && ~~ (mask n << m) = 0"
-  by (clarsimp simp add: mask_def Parity.bit_eq_iff bit_and_iff bit_not_iff shiftl_word_eq bit_push_bit_iff)
+  by (clarsimp simp add: mask_eq_decr_exp Parity.bit_eq_iff bit_and_iff bit_not_iff shiftl_word_eq bit_push_bit_iff)
 
 lemma le_step_down_nat:"\<lbrakk>(i::nat) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by arith
 
 lemma le_step_down_int:"\<lbrakk>(i::int) \<le> n; i = n \<longrightarrow> P; i \<le> n - 1 \<longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by arith
 
 lemma ex_mask_1[simp]: "(\<exists>x. mask x = 1)"
   apply (rule_tac x=1 in exI)
-  apply (simp add:mask_def)
+  apply (simp add:mask_eq_decr_exp)
   done
 
 lemma not_switch:"~~ a = x \<Longrightarrow> a = ~~ x"
   by auto
 
 (* The seL4 bitfield generator produces functions containing mask and shift operations, such that
  * invoking two of them consecutively can produce something like the following.
  *)
 lemma bitfield_op_twice:
   "(x && ~~ (mask n << m) || ((y && mask n) << m)) && ~~ (mask n << m) = x && ~~ (mask n << m)"
   by (induct n arbitrary: m) (auto simp: word_ao_dist)
 
 lemma bitfield_op_twice'':
   "\<lbrakk>~~ a = b << c; \<exists>x. b = mask x\<rbrakk> \<Longrightarrow> (x && a || (y && b << c)) && a = x && a"
   apply clarsimp
   apply (cut_tac n=xa and m=c and x=x and y=y in bitfield_op_twice)
-  apply (clarsimp simp:mask_def)
+  apply (clarsimp simp:mask_eq_decr_exp)
   apply (drule not_switch)
   apply clarsimp
   done
 
 lemma bit_twiddle_min:
   "(y::'a::len word) xor (((x::'a::len word) xor y) && (if x < y then -1 else 0)) = min x y"
   by (auto simp add: Parity.bit_eq_iff bit_xor_iff min_def)
 
 lemma bit_twiddle_max:
   "(x::'a::len word) xor (((x::'a::len word) xor y) && (if x < y then -1 else 0)) = max x y"
   by (auto simp add: Parity.bit_eq_iff bit_xor_iff max_def)
 
 lemma swap_with_xor:
   "\<lbrakk>(x::'a::len word) = a xor b; y = b xor x; z = x xor y\<rbrakk> \<Longrightarrow> z = b \<and> y = a"
   by (auto simp add: Parity.bit_eq_iff bit_xor_iff max_def)
 
 lemma scast_nop1:
   "((scast ((of_int x)::('a::len) word))::'a sword) = of_int x"
-  apply (clarsimp simp:scast_def word_of_int)
+  apply (clarsimp simp:scast_eq word_of_int)
   by (metis len_signed sint_sbintrunc' word_sint.Rep_inverse)
 
 lemma scast_nop2:
   "((scast ((of_int x)::('a::len) sword))::'a word) = of_int x"
-  apply (clarsimp simp:scast_def word_of_int)
+  apply (clarsimp simp:scast_eq word_of_int)
   by (metis len_signed sint_sbintrunc' word_sint.Rep_inverse)
 
 lemmas scast_nop[simp] = scast_nop1 scast_nop2 scast_id
 
 lemma le_mask_imp_and_mask:
   "(x::'a::len word) \<le> mask n \<Longrightarrow> x && mask n = x"
   by (metis and_mask_eq_iff_le_mask)
 
 lemma or_not_mask_nop:
   "((x::'a::len word) || ~~ (mask n)) && mask n = x && mask n"
   by (metis word_and_not word_ao_dist2 word_bw_comms(1) word_log_esimps(3))
 
 lemma mask_subsume:
   "\<lbrakk>n \<le> m\<rbrakk> \<Longrightarrow> ((x::'a::len word) || y && mask n) && ~~ (mask m) = x && ~~ (mask m)"
   by (auto simp add: Parity.bit_eq_iff bit_not_iff bit_or_iff bit_and_iff mask_eq_mask bit_mask_iff)
 
 lemma and_mask_0_iff_le_mask:
   fixes w :: "'a::len word"
   shows "(w && ~~(mask n) = 0) = (w \<le> mask n)"
   by (simp add: mask_eq_0_eq_x le_mask_imp_and_mask and_mask_eq_iff_le_mask)
 
 lemma mask_twice2:
   "n \<le> m \<Longrightarrow> ((x::'a::len word) && mask m) && mask n = x && mask n"
   by (metis mask_twice min_def)
 
 lemma uint_2_id:
   "LENGTH('a) \<ge> 2 \<Longrightarrow> uint (2::('a::len) word) = 2"
   by simp
 
 lemma bintrunc_id:
   "\<lbrakk>m \<le> of_nat n; 0 < m\<rbrakk> \<Longrightarrow> bintrunc n m = m"
   by (simp add: bintrunc_mod2p le_less_trans)
 
 lemma shiftr1_unfold: "shiftr1 x = x >> 1"
   by (metis One_nat_def comp_apply funpow.simps(1) funpow.simps(2) id_apply shiftr_def)
 
 lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
-proof (cases \<open>2 \<le> LENGTH('a)\<close>)
-  case False
-  then have *: \<open>LENGTH('a) = 1\<close>
-    by simp
-  then have \<open>x = 0 \<or> x = 1\<close>
-    by (metis One_nat_def less_irrefl_nat sint_1_cases)
-  then show ?thesis
-    by (auto simp add: word_arith_nat_defs(6) *)
-next
-  case True
-  then show ?thesis
-    using shiftr1_unfold [symmetric, of x] uint_2_id [where ?'a = 'a]
-    by (simp add: shiftr1_def word_div_def)
-qed
+  by transfer (simp add: drop_bit_Suc)
 
 lemma shiftl1_is_mult: "(x << 1) = (x :: 'a::len word) * 2"
   by (metis One_nat_def mult_2 mult_2_right one_add_one
         power_0 power_Suc shiftl_t2n)
 
 lemma div_of_0_id[simp]:"(0::('a::len) word) div n = 0"
   by (simp add: word_div_def)
 
 lemma degenerate_word:"LENGTH('a) = 1 \<Longrightarrow> (x::('a::len) word) = 0 \<or> x = 1"
   by (metis One_nat_def less_irrefl_nat sint_1_cases)
 
 lemma div_by_0_word:"(x::('a::len) word) div 0 = 0"
   by (metis div_0 div_by_0 unat_0 word_arith_nat_defs(6) word_div_1)
 
 lemma div_less_dividend_word:"\<lbrakk>x \<noteq> 0; n \<noteq> 1\<rbrakk> \<Longrightarrow> (x::('a::len) word) div n < x"
   apply (cases \<open>n = 0\<close>)
    apply clarsimp
    apply (simp add:word_neq_0_conv)
   apply (subst word_arith_nat_div)
   apply (rule word_of_nat_less)
   apply (rule div_less_dividend)
   using unat_eq_zero word_unat_Rep_inject1 apply force
   apply (simp add:unat_gt_0)
   done
 
 lemma shiftr1_lt:"x \<noteq> 0 \<Longrightarrow> (x::('a::len) word) >> 1 < x"
   apply (subst shiftr1_is_div_2)
   apply (rule div_less_dividend_word)
    apply simp+
   done
 
 lemma word_less_div:
   fixes x :: "('a::len) word"
     and y :: "('a::len) word"
   shows "x div y = 0 \<Longrightarrow> y = 0 \<or> x < y"
   apply (case_tac "y = 0", clarsimp+)
   by (metis One_nat_def Suc_le_mono le0 le_div_geq not_less unat_0 unat_div unat_gt_0 word_less_nat_alt zero_less_one)
 
 lemma not_degenerate_imp_2_neq_0:"LENGTH('a) > 1 \<Longrightarrow> (2::('a::len) word) \<noteq> 0"
   by (metis numerals(1) power_not_zero power_zero_numeral)
 
 lemma shiftr1_0_or_1:"(x::('a::len) word) >> 1 = 0 \<Longrightarrow> x = 0 \<or> x = 1"
   apply (subst (asm) shiftr1_is_div_2)
   apply (drule word_less_div)
   apply (case_tac "LENGTH('a) = 1")
    apply (simp add:degenerate_word)
   apply (erule disjE)
    apply (subgoal_tac "(2::'a word) \<noteq> 0")
     apply simp
    apply (rule not_degenerate_imp_2_neq_0)
    apply (subgoal_tac "LENGTH('a) \<noteq> 0")
     apply arith
    apply simp
   apply (rule x_less_2_0_1', simp+)
   done
 
 lemma word_overflow:"(x::('a::len) word) + 1 > x \<or> x + 1 = 0"
   apply clarsimp
   by (metis diff_0 eq_diff_eq less_x_plus_1)
 
 lemma word_overflow_unat:"unat ((x::('a::len) word) + 1) = unat x + 1 \<or> x + 1 = 0"
   by (metis Suc_eq_plus1 add.commute unatSuc)
 
 lemma even_word_imp_odd_next:"even (unat (x::('a::len) word)) \<Longrightarrow> x + 1 = 0 \<or> odd (unat (x + 1))"
   apply (cut_tac x=x in word_overflow_unat)
   apply clarsimp
   done
 
 lemma odd_word_imp_even_next:"odd (unat (x::('a::len) word)) \<Longrightarrow> x + 1 = 0 \<or> even (unat (x + 1))"
   apply (cut_tac x=x in word_overflow_unat)
   apply clarsimp
   done
 
 lemma overflow_imp_lsb:"(x::('a::len) word) + 1 = 0 \<Longrightarrow> x !! 0"
   using even_plus_one_iff [of x] by (simp add: test_bit_word_eq)
 
 lemma word_lsb_nat:"lsb w = (unat w mod 2 = 1)"
-  unfolding word_lsb_def bin_last_def
-  by (metis (no_types, hide_lams) nat_mod_distrib nat_numeral not_mod_2_eq_1_eq_0 numeral_One uint_eq_0 uint_nonnegative unat_0 unat_def zero_le_numeral)
+  apply (simp add: word_lsb_def Groebner_Basis.algebra(31))
+  apply transfer
+  apply (simp add: even_nat_iff)
+  done
 
 lemma odd_iff_lsb:"odd (unat (x::('a::len) word)) = x !! 0"
   apply (simp add:even_iff_mod_2_eq_zero)
   apply (subst word_lsb_nat[unfolded One_nat_def, symmetric])
   apply (rule word_lsb_alt)
   done
 
 lemma of_nat_neq_iff_word:
       "x mod 2 ^ LENGTH('a) \<noteq> y mod 2 ^ LENGTH('a) \<Longrightarrow>
          (((of_nat x)::('a::len) word) \<noteq> of_nat y) = (x \<noteq> y)"
   apply (rule iffI)
    apply (case_tac "x = y")
    apply (subst (asm) of_nat_eq_iff[symmetric])
    apply simp+
   apply (case_tac "((of_nat x)::('a::len) word) = of_nat y")
    apply (subst (asm) word_unat.norm_eq_iff[symmetric])
    apply simp+
   done
 
 lemma shiftr1_irrelevant_lsb:"(x::('a::len) word) !! 0 \<or> x >> 1 = (x + 1) >> 1"
   using word_overflow_unat [of x]
   apply (simp only: shiftr1_is_div_2 flip: odd_iff_lsb)
   apply (cases \<open>2 \<le> LENGTH('a)\<close>)
    apply (auto simp add: test_bit_def' uint_nat word_arith_nat_div dest: overflow_imp_lsb)
   done
 
 lemma shiftr1_0_imp_only_lsb:"((x::('a::len) word) + 1) >> 1 = 0 \<Longrightarrow> x = 0 \<or> x + 1 = 0"
   by (metis One_nat_def shiftr1_0_or_1 word_less_1 word_overflow)
 
 lemma shiftr1_irrelevant_lsb':"\<not>((x::('a::len) word) !! 0) \<Longrightarrow> x >> 1 = (x + 1) >> 1"
   by (metis shiftr1_irrelevant_lsb)
 
 lemma lsb_this_or_next:"\<not>(((x::('a::len) word) + 1) !! 0) \<Longrightarrow> x !! 0"
   by (metis (poly_guards_query) even_word_imp_odd_next odd_iff_lsb overflow_imp_lsb)
 
 (* Perhaps this one should be a simp lemma, but it seems a little dangerous. *)
 lemma cast_chunk_assemble_id:
   "\<lbrakk>n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m\<rbrakk> \<Longrightarrow>
   (((ucast ((ucast (x::'b word))::'a word))::'b word) || (((ucast ((ucast (x >> n))::'a word))::'b word) << n)) = x"
   apply (subgoal_tac "((ucast ((ucast (x >> n))::'a word))::'b word) = x >> n")
    apply clarsimp
    apply (subst and_not_mask[symmetric])
    apply (subst ucast_ucast_mask)
    apply (subst word_ao_dist2[symmetric])
    apply clarsimp
   apply (rule ucast_ucast_len)
   apply (rule shiftr_less_t2n')
    apply (subst and_mask_eq_iff_le_mask)
-   apply (simp_all add: mask_def flip: mult_2_right)
+   apply (simp_all add: mask_eq_decr_exp flip: mult_2_right)
   apply (metis add_diff_cancel_left' len_gt_0 mult_2_right zero_less_diff)
   done
 
 lemma cast_chunk_scast_assemble_id:
   "\<lbrakk>n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m\<rbrakk> \<Longrightarrow>
   (((ucast ((scast (x::'b word))::'a word))::'b word) ||
    (((ucast ((scast (x >> n))::'a word))::'b word) << n)) = x"
   apply (subgoal_tac "((scast x)::'a word) = ((ucast x)::'a word)")
    apply (subgoal_tac "((scast (x >> n))::'a word) = ((ucast (x >> n))::'a word)")
     apply (simp add:cast_chunk_assemble_id)
    apply (subst down_cast_same[symmetric], subst is_down, arith, simp)+
   done
 
 lemma mask_or_not_mask:
   "x && mask n || x && ~~ (mask n) = x"
   apply (subst word_oa_dist, simp)
   apply (subst word_oa_dist2, simp)
   done
 
 lemma is_aligned_add_not_aligned:
   "\<lbrakk>is_aligned (p::'a::len word) n; \<not> is_aligned (q::'a::len word) n\<rbrakk> \<Longrightarrow> \<not> is_aligned (p + q) n"
   by (metis is_aligned_addD1)
 
 lemma word_gr0_conv_Suc: "(m::'a::len word) > 0 \<Longrightarrow> \<exists>n. m = n + 1"
   by (metis add.commute add_minus_cancel)
 
 lemma neg_mask_add_aligned:
   "\<lbrakk> is_aligned p n; q < 2 ^ n \<rbrakk> \<Longrightarrow> (p + q) && ~~ (mask n) = p && ~~ (mask n)"
   by (metis is_aligned_add_helper is_aligned_neg_mask_eq)
 
 lemma word_sless_sint_le:"x <s y \<Longrightarrow> sint x \<le> sint y - 1"
   by (metis word_sless_alt zle_diff1_eq)
 
 
 lemma upper_trivial:
   fixes x :: "'a::len word"
   shows "x \<noteq> 2 ^ LENGTH('a) - 1 \<Longrightarrow> x < 2 ^ LENGTH('a) - 1"
   by (simp add: less_le)
 
 lemma constraint_expand:
   fixes x :: "'a::len word"
   shows "x \<in> {y. lower \<le> y \<and> y \<le> upper} = (lower \<le> x \<and> x \<le> upper)"
   by (rule mem_Collect_eq)
 
 lemma card_map_elide:
   "card ((of_nat :: nat \<Rightarrow> 'a::len word) ` {0..<n}) = card {0..<n}"
     if "n \<le> CARD('a::len word)"
 proof -
   let ?of_nat = "of_nat :: nat \<Rightarrow> 'a word"
   from word_unat.Abs_inj_on
   have "inj_on ?of_nat {i. i < CARD('a word)}"
     by (simp add: unats_def card_word)
   moreover have "{0..<n} \<subseteq> {i. i < CARD('a word)}"
     using that by auto
   ultimately have "inj_on ?of_nat {0..<n}"
     by (rule inj_on_subset)
   then show ?thesis
     by (simp add: card_image)
 qed
 
 lemma card_map_elide2:
   "n \<le> CARD('a::len word) \<Longrightarrow> card ((of_nat::nat \<Rightarrow> 'a::len word) ` {0..<n}) = n"
   by (subst card_map_elide) clarsimp+
 
 lemma le_max_word_ucast_id:
   \<open>UCAST('b \<rightarrow> 'a) (UCAST('a \<rightarrow> 'b) x) = x\<close>
     if \<open>x \<le> UCAST('b::len \<rightarrow> 'a) (- 1)\<close>
     for x :: \<open>'a::len word\<close>
 proof -
   from that have a1: \<open>x \<le> word_of_int (uint (word_of_int (2 ^ LENGTH('b) - 1) :: 'b word))\<close>
-    by (simp add: ucast_def word_of_int_minus)
+    by (simp add: ucast_eq word_of_int_minus)
   have f2: "((\<exists>i ia. (0::int) \<le> i \<and> \<not> 0 \<le> i + - 1 * ia \<and> i mod ia \<noteq> i) \<or>
             \<not> (0::int) \<le> - 1 + 2 ^ LENGTH('b) \<or> (0::int) \<le> - 1 + 2 ^ LENGTH('b) + - 1 * 2 ^ LENGTH('b) \<or>
             (- (1::int) + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b) =
               - 1 + 2 ^ LENGTH('b)) = ((\<exists>i ia. (0::int) \<le> i \<and> \<not> 0 \<le> i + - 1 * ia \<and> i mod ia \<noteq> i) \<or>
             \<not> (1::int) \<le> 2 ^ LENGTH('b) \<or>
             2 ^ LENGTH('b) + - (1::int) * ((- 1 + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b)) = 1)"
     by force
   have f3: "\<forall>i ia. \<not> (0::int) \<le> i \<or> 0 \<le> i + - 1 * ia \<or> i mod ia = i"
     using mod_pos_pos_trivial by force
   have "(1::int) \<le> 2 ^ LENGTH('b)"
     by simp
   then have "2 ^ LENGTH('b) + - (1::int) * ((- 1 + 2 ^ LENGTH('b)) mod 2 ^ len_of TYPE ('b)) = 1"
     using f3 f2 by blast
   then have f4: "- (1::int) + 2 ^ LENGTH('b) = (- 1 + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b)"
     by linarith
   have f5: "x \<le> word_of_int (uint (word_of_int (- 1 + 2 ^ LENGTH('b))::'b word))"
     using a1 by force
   have f6: "2 ^ LENGTH('b) + - (1::int) = - 1 + 2 ^ LENGTH('b)"
     by force
   have f7: "- (1::int) * 1 = - 1"
     by auto
   have "\<forall>x0 x1. (x1::int) - x0 = x1 + - 1 * x0"
     by force
   then have "x \<le> 2 ^ LENGTH('b) - 1"
     using f7 f6 f5 f4 by (metis uint_word_of_int wi_homs(2) word_arith_wis(8) word_of_int_2p)
   then have \<open>uint x \<le> uint (2 ^ LENGTH('b) - (1 :: 'a word))\<close>
     by (simp add: word_le_def)
   then have \<open>uint x \<le> 2 ^ LENGTH('b) - 1\<close>
     by (simp add: uint_word_ariths)
       (metis \<open>1 \<le> 2 ^ LENGTH('b)\<close> \<open>uint x \<le> uint (2 ^ LENGTH('b) - 1)\<close> linorder_not_less lt2p_lem uint_1 uint_minus_simple_alt uint_power_lower word_le_def zle_diff1_eq)
   then show ?thesis
-    by (simp add: ucast_def word_ubin.eq_norm bintrunc_mod2p)
+    by (simp add: ucast_eq word_ubin.eq_norm bintrunc_mod2p)
 qed
 
 lemma remdups_enum_upto:
   fixes s::"'a::len word"
   shows "remdups [s .e. e] = [s .e. e]"
   by simp
 
 lemma card_enum_upto:
   fixes s::"'a::len word"
   shows "card (set [s .e. e]) = Suc (unat e) - unat s"
   by (subst List.card_set) (simp add: remdups_enum_upto)
 
 lemma unat_mask:
   "unat (mask n :: 'a :: len word) = 2 ^ (min n (LENGTH('a))) - 1"
   apply (subst min.commute)
-  apply (simp add: mask_def not_less min_def  split: if_split_asm)
+  apply (simp add: mask_eq_decr_exp not_less min_def  split: if_split_asm)
   apply (intro conjI impI)
    apply (simp add: unat_sub_if_size)
    apply (simp add: power_overflow word_size)
   apply (simp add: unat_sub_if_size)
   done
 
 lemma word_shiftr_lt:
   fixes w :: "'a::len word"
   shows "unat (w >> n) < (2 ^ (LENGTH('a) - n))"
   apply (subst shiftr_div_2n')
   by (metis nat_mod_lem nat_zero_less_power_iff power_mod_div
       word_unat.Rep_inverse word_unat.eq_norm zero_less_numeral)
 
 lemma complement_nth_w2p:
   shows "n' < LENGTH('a) \<Longrightarrow> (~~ (2 ^ n :: 'a::len word)) !! n' = (n' \<noteq> n)"
   by (fastforce simp: word_ops_nth_size word_size nth_w2p)
 
 lemma word_unat_and_lt:
   "unat x < n \<or> unat y < n \<Longrightarrow> unat (x && y) < n"
   by (meson le_less_trans word_and_le1 word_and_le2 word_le_nat_alt)
 
 lemma word_unat_mask_lt:
   "m \<le> size w \<Longrightarrow> unat ((w::'a::len word) && mask m) < 2 ^ m"
   by (rule word_unat_and_lt) (simp add: unat_mask word_size)
 
 lemma unat_shiftr_less_t2n:
   fixes x :: "'a :: len word"
   shows "unat x < 2 ^ (n + m) \<Longrightarrow> unat (x >> n) < 2 ^ m"
   by (simp add: shiftr_div_2n' power_add mult.commute td_gal_lt)
 
 lemma le_or_mask:
   "w \<le> w' \<Longrightarrow> w || mask x \<le> w' || mask x"
   by (metis neg_mask_add_mask add.commute le_word_or1 mask_2pm1 neg_mask_mono_le word_plus_mono_left)
 
 lemma le_shiftr1':
   "\<lbrakk> shiftr1 u \<le> shiftr1 v ; shiftr1 u \<noteq> shiftr1 v \<rbrakk> \<Longrightarrow> u \<le> v"
-  apply (simp add: shiftr1_def)
   apply transfer
   apply simp
   done
 
 lemma le_shiftr':
   "\<lbrakk> u >> n \<le> v >> n ; u >> n \<noteq> v >> n \<rbrakk> \<Longrightarrow> (u::'a::len word) \<le> v"
   apply (induct n; simp add: shiftr_def)
   apply (case_tac "(shiftr1 ^^ n) u = (shiftr1 ^^ n) v", simp)
   apply (fastforce dest: le_shiftr1')
   done
 
 lemma word_log2_nth_same:
   "w \<noteq> 0 \<Longrightarrow> w !! word_log2 w"
   unfolding word_log2_def
   using nth_length_takeWhile[where P=Not and xs="to_bl w"]
   apply (simp add: word_clz_def word_size to_bl_nth)
   apply (fastforce simp: linorder_not_less eq_zero_set_bl
                    dest: takeWhile_take_has_property)
   done
 
 lemma word_log2_nth_not_set:
   "\<lbrakk> word_log2 w < i ; i < size w \<rbrakk> \<Longrightarrow> \<not> w !! i"
   unfolding word_log2_def word_clz_def
   using takeWhile_take_has_property_nth[where P=Not and xs="to_bl w" and n="size w - Suc i"]
   by (fastforce simp add: to_bl_nth word_size)
 
 lemma word_log2_highest:
   assumes a: "w !! i"
   shows "i \<le> word_log2 w"
 proof -
   from a have "i < size w" by - (rule test_bit_size)
   with a show ?thesis
     by - (rule ccontr, simp add: word_log2_nth_not_set)
 qed
 
 lemma word_log2_max:
   "word_log2 w < size w"
   unfolding word_log2_def word_clz_def
   by simp
 
 lemma word_clz_0[simp]:
   "word_clz (0::'a::len word) = LENGTH('a)"
   unfolding word_clz_def
   by (simp add: takeWhile_replicate)
 
 lemma word_clz_minus_one[simp]:
   "word_clz (-1::'a::len word) = 0"
   unfolding word_clz_def
   by (simp add: takeWhile_replicate)
 
 lemma word_add_no_overflow:"(x::'a::len word) < max_word \<Longrightarrow> x < x + 1"
   using less_x_plus_1 order_less_le by blast
 
 lemma lt_plus_1_le_word:
   fixes x :: "'a::len word"
   assumes bound:"n < unat (maxBound::'a word)"
   shows "x < 1 + of_nat n = (x \<le> of_nat n)"
   by (metis add.commute bound max_word_max word_Suc_leq word_not_le word_of_nat_less)
 
 lemma unat_ucast_up_simp:
   fixes x :: "'a::len word"
   assumes "LENGTH('a) \<le> LENGTH('b)"
   shows "unat (ucast x :: 'b::len word) = unat x"
-  unfolding ucast_def unat_def
+  unfolding ucast_eq unat_eq_nat_uint
   apply (subst int_word_uint)
   apply (subst mod_pos_pos_trivial; simp?)
   apply (rule lt2p_lem)
   apply (simp add: assms)
   done
 
 lemma unat_ucast_less_no_overflow:
   "\<lbrakk>n < 2 ^ LENGTH('a); unat f < n\<rbrakk> \<Longrightarrow> (f::('a::len) word) < of_nat n"
   by (erule (1)  order_le_less_trans[OF _ of_nat_mono_maybe,rotated]) simp
 
 lemma unat_ucast_less_no_overflow_simp:
   "n < 2 ^ LENGTH('a) \<Longrightarrow> (unat f < n) = ((f::('a::len) word) < of_nat n)"
   using unat_less_helper unat_ucast_less_no_overflow by blast
 
 lemma unat_ucast_no_overflow_le:
   assumes no_overflow: "unat b < (2 :: nat) ^ LENGTH('a)"
   and upward_cast: "LENGTH('a) < LENGTH('b)"
   shows "(ucast (f::'a::len word) < (b :: 'b :: len word)) = (unat f < unat b)"
 proof -
   have LR: "ucast f < b \<Longrightarrow> unat f < unat b"
     apply (rule unat_less_helper)
     apply (simp add:ucast_nat_def)
     apply (rule_tac 'b1 = 'b in  ucast_less_ucast[OF order.strict_implies_order, THEN iffD1])
      apply (rule upward_cast)
     apply (simp add: ucast_ucast_mask less_mask_eq word_less_nat_alt
                      unat_power_lower[OF upward_cast] no_overflow)
     done
   have RL: "unat f < unat b \<Longrightarrow> ucast f < b"
   proof-
     assume ineq: "unat f < unat b"
     have "ucast (f::'a::len word) < ((ucast (ucast b ::'a::len word)) :: 'b :: len word)"
       apply (simp add: ucast_less_ucast[OF order.strict_implies_order] upward_cast)
       apply (simp add: ucast_nat_def[symmetric])
       apply (rule unat_ucast_less_no_overflow[OF no_overflow ineq])
       done
     then show ?thesis
       apply (rule order_less_le_trans)
       apply (simp add:ucast_ucast_mask word_and_le2)
       done
   qed
   then show ?thesis by (simp add:RL LR iffI)
 qed
 
 lemmas ucast_up_mono = ucast_less_ucast[THEN iffD2]
 
 (* casting a long word to a shorter word and casting back to the long word
    is equal to the original long word -- if the word is small enough.
   'l is the longer word.
   's is the shorter word.
 *)
 lemma bl_cast_long_short_long_ingoreLeadingZero_generic:
   "\<lbrakk> length (dropWhile Not (to_bl w)) \<le> LENGTH('s); LENGTH('s) \<le> LENGTH('l) \<rbrakk> \<Longrightarrow>
    (of_bl :: _ \<Rightarrow> 'l::len word) (to_bl ((of_bl::_ \<Rightarrow> 's::len word) (to_bl w))) = w"
   by (rule word_uint_eqI) (simp add: uint_of_bl_is_bl_to_bin uint_of_bl_is_bl_to_bin_drop)
 
 (*
  Casting between longer and shorter word.
   'l is the longer word.
   's is the shorter word.
  For example: 'l::len word is 128 word (full ipv6 address)
               's::len word is 16 word (address piece of ipv6 address in colon-text-representation)
 *)
 corollary ucast_short_ucast_long_ingoreLeadingZero:
   "\<lbrakk> length (dropWhile Not (to_bl w)) \<le> LENGTH('s); LENGTH('s) \<le> LENGTH('l) \<rbrakk> \<Longrightarrow>
    (ucast:: 's::len word \<Rightarrow> 'l::len word) ((ucast:: 'l::len word \<Rightarrow> 's::len word) w) = w"
   apply (subst Word.ucast_bl)+
   apply (rule bl_cast_long_short_long_ingoreLeadingZero_generic; simp)
   done
 
 lemma length_drop_mask:
   fixes w::"'a::len word"
   shows "length (dropWhile Not (to_bl (w AND mask n))) \<le> n"
 proof -
   have "length (takeWhile Not (replicate n False @ ls)) = n + length (takeWhile Not ls)"
     for ls n by(subst takeWhile_append2) simp+
   then show ?thesis
     unfolding bl_and_mask by (simp add: dropWhile_eq_drop)
 qed
 
 lemma minus_one_word:
   "(-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by simp
 
 lemma mask_exceed:
   "n \<ge> LENGTH('a) \<Longrightarrow> (x::'a::len word) && ~~ (mask n) = 0"
   by (simp add: and_not_mask shiftr_eq_0)
 
 lemma two_power_strict_part_mono:
   "strict_part_mono {..LENGTH('a) - 1} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
 proof -
   { fix n
     have "n < LENGTH('a) \<Longrightarrow> strict_part_mono {..n} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
     proof (induct n)
       case 0 then show ?case by simp
     next
       case (Suc n)
       from Suc.prems
       have "2 ^ n < (2 :: 'a :: len word) ^ Suc n"
         using power_strict_increasing unat_power_lower word_less_nat_alt by fastforce
       with Suc
       show ?case by (subst strict_part_mono_by_steps) simp
     qed
   }
   then show ?thesis by simp
 qed
 
 lemma word_shift_by_2:
   "x * 4 = (x::'a::len word) << 2"
   by (simp add: shiftl_t2n)
 
 lemma le_2p_upper_bits:
   "\<lbrakk> (p::'a::len word) \<le> 2^n - 1; n < LENGTH('a) \<rbrakk> \<Longrightarrow>
   \<forall>n'\<ge>n. n' < LENGTH('a) \<longrightarrow> \<not> p !! n'"
   by (subst upper_bits_unset_is_l2p; simp)
 
 lemma le2p_bits_unset:
   "p \<le> 2 ^ n - 1 \<Longrightarrow> \<forall>n'\<ge>n. n' < LENGTH('a) \<longrightarrow> \<not> (p::'a::len word) !! n'"
   using upper_bits_unset_is_l2p [where p=p]
   by (cases "n < LENGTH('a)") auto
 
 lemma ucast_less_shiftl_helper:
   "\<lbrakk> LENGTH('b) + 2 < LENGTH('a); 2 ^ (LENGTH('b) + 2) \<le> n\<rbrakk>
     \<Longrightarrow> (ucast (x :: 'b::len word) << 2) < (n :: 'a::len word)"
   apply (erule order_less_le_trans[rotated])
   using ucast_less[where x=x and 'a='a]
   apply (simp only: shiftl_t2n field_simps)
   apply (rule word_less_power_trans2; simp)
   done
 
 lemma word_power_nonzero:
   "\<lbrakk> (x :: 'a::len word) < 2 ^ (LENGTH('a) - n); n < LENGTH('a); x \<noteq> 0 \<rbrakk>
   \<Longrightarrow> x * 2 ^ n \<noteq> 0"
   by (metis and_mask_eq_iff_shiftr_0 less_mask_eq p2_gt_0 semiring_normalization_rules(7)
             shiftl_shiftr_id shiftl_t2n)
 
 lemma less_1_helper:
   "n \<le> m \<Longrightarrow> (n - 1 :: int) < m"
   by arith
 
 lemma div_power_helper:
   "\<lbrakk> x \<le> y; y < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 ^ y - 1) div (2 ^ x :: 'a::len word) = 2 ^ (y - x) - 1"
   apply (rule word_uint.Rep_eqD)
   apply (simp only: uint_word_ariths uint_div uint_power_lower)
   apply (subst mod_pos_pos_trivial, fastforce, fastforce)+
   apply (subst mod_pos_pos_trivial)
     apply (simp add: le_diff_eq uint_2p_alt)
    apply (rule less_1_helper)
    apply (rule power_increasing; simp)
   apply (subst mod_pos_pos_trivial)
     apply (simp add: uint_2p_alt)
    apply (rule less_1_helper)
    apply (rule power_increasing; simp)
   apply (subst int_div_sub_1; simp add: uint_2p_alt)
   apply (subst power_0[symmetric])
   apply (simp add: uint_2p_alt le_imp_power_dvd power_sub_int)
   done
 
 
 lemma word_add_power_off:
   fixes a :: "'a :: len word"
   assumes ak: "a < k"
   and kw: "k < 2 ^ (LENGTH('a) - m)"
   and mw: "m < LENGTH('a)"
   and off: "off < 2 ^ m"
   shows "(a * 2 ^ m) + off < k * 2 ^ m"
 proof (cases "m = 0")
   case True
   then show ?thesis using off ak by simp
 next
   case False
 
   from ak have ak1: "a + 1 \<le> k" by (rule inc_le)
   then have "(a + 1) * 2 ^ m \<noteq> 0"
     apply -
     apply (rule word_power_nonzero)
     apply (erule order_le_less_trans  [OF _ kw])
     apply (rule mw)
     apply (rule less_is_non_zero_p1 [OF ak])
     done
   then have "(a * 2 ^ m) + off < ((a + 1) * 2 ^ m)" using kw mw
     apply -
     apply (simp add: distrib_right)
     apply (rule word_plus_strict_mono_right [OF off])
     apply (rule is_aligned_no_overflow'')
     apply (rule is_aligned_mult_triv2)
     apply assumption
     done
   also have "\<dots> \<le> k * 2 ^ m" using ak1 mw kw False
     apply -
     apply (erule word_mult_le_mono1)
     apply (simp add: p2_gt_0)
     apply (simp add: word_less_nat_alt)
     apply (rule nat_less_power_trans2[simplified])
     apply (simp add: word_less_nat_alt)
     apply simp
     done
   finally show ?thesis .
 qed
 
 lemma offset_not_aligned:
   "\<lbrakk> is_aligned (p::'a::len word) n; i > 0; i < 2 ^ n; n < LENGTH('a)\<rbrakk> \<Longrightarrow>
    \<not> is_aligned (p + of_nat i) n"
   apply (erule is_aligned_add_not_aligned)
   unfolding is_aligned_def
   by (metis le_unat_uoi nat_dvd_not_less order_less_imp_le unat_power_lower)
 
 lemma length_upto_enum_one:
   fixes x :: "'a :: len word"
   assumes lt1: "x < y" and lt2: "z < y" and lt3: "x \<le> z"
   shows "[x , y .e. z] = [x]"
   unfolding upto_enum_step_def
 proof (subst upto_enum_red, subst if_not_P [OF leD [OF lt3]], clarsimp, rule conjI)
   show "unat ((z - x) div (y - x)) = 0"
   proof (subst unat_div, rule div_less)
     have syx: "unat (y - x) = unat y - unat x"
       by (rule unat_sub [OF order_less_imp_le]) fact
     moreover have "unat (z - x) = unat z - unat x"
       by (rule unat_sub) fact
 
     ultimately show "unat (z - x) < unat (y - x)"
       using lt2 lt3 unat_mono word_less_minus_mono_left by blast
   qed
 
   then show "(z - x) div (y - x) * (y - x) = 0"
     by (metis mult_zero_left unat_0 word_unat.Rep_eqD)
 qed
 
 lemma max_word_mask:
   "(max_word :: 'a::len word) = mask LENGTH('a)"
-  unfolding mask_def by simp
+  unfolding mask_eq_decr_exp by simp
 
 lemmas mask_len_max = max_word_mask[symmetric]
 
 lemma is_aligned_alignUp[simp]:
   "is_aligned (alignUp p n) n"
-  by (simp add: alignUp_def complement_def is_aligned_mask mask_def word_bw_assocs)
+  by (simp add: alignUp_def complement_def is_aligned_mask mask_eq_decr_exp word_bw_assocs)
 
 lemma alignUp_le[simp]:
   "alignUp p n \<le> p + 2 ^ n - 1"
   unfolding alignUp_def by (rule word_and_le2)
 
 lemma complement_mask:
   "complement (2 ^ n - 1) = ~~ (mask n)"
-  unfolding complement_def mask_def by simp
+  unfolding complement_def mask_eq_decr_exp by simp
 
 lemma alignUp_idem:
   fixes a :: "'a::len word"
   assumes "is_aligned a n" "n < LENGTH('a)"
   shows "alignUp a n = a"
   using assms unfolding alignUp_def
   by (metis complement_mask is_aligned_add_helper p_assoc_help power_2_ge_iff)
 
 lemma alignUp_not_aligned_eq:
   fixes a :: "'a :: len word"
   assumes al: "\<not> is_aligned a n"
   and     sz: "n < LENGTH('a)"
   shows   "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
 proof -
   have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz) fact+
 
   then have um: "unat (a mod 2 ^ n - 1) div 2 ^ n = 0" using sz
     by (meson Euclidean_Division.div_eq_0_iff le_m1_iff_lt measure_unat order_less_trans
               unat_less_power word_less_sub_le word_mod_less_divisor)
 
   have "a + 2 ^ n - 1 = (a div 2 ^ n) * 2 ^ n + (a mod 2 ^ n) + 2 ^ n - 1"
     by (simp add: word_mod_div_equality)
   also have "\<dots> = (a mod 2 ^ n - 1) + (a div 2 ^ n + 1) * 2 ^ n"
     by (simp add: field_simps)
   finally show "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n" using sz
     unfolding alignUp_def
     apply (subst complement_mask)
     apply (erule ssubst)
     apply (subst neg_mask_is_div)
     apply (simp add: word_arith_nat_div)
     apply (subst unat_word_ariths(1) unat_word_ariths(2))+
     apply (subst uno_simps)
     apply (subst unat_1)
     apply (subst mod_add_right_eq)
     apply simp
     apply (subst power_mod_div)
     apply (subst div_mult_self1)
      apply simp
     apply (subst um)
     apply simp
     apply (subst mod_mod_power)
     apply simp
     apply (subst word_unat_power, subst Abs_fnat_hom_mult)
     apply (subst mult_mod_left)
     apply (subst power_add [symmetric])
     apply simp
     apply (subst Abs_fnat_hom_1)
     apply (subst Abs_fnat_hom_add)
     apply (subst word_unat_power, subst Abs_fnat_hom_mult)
     apply (subst word_unat.Rep_inverse[symmetric], subst Abs_fnat_hom_mult)
     apply simp
     done
 qed
 
 lemma alignUp_ge:
   fixes a :: "'a :: len word"
   assumes sz: "n < LENGTH('a)"
   and nowrap: "alignUp a n \<noteq> 0"
   shows "a \<le> alignUp a n"
 proof (cases "is_aligned a n")
   case True
   then show ?thesis using sz
     by (subst alignUp_idem, simp_all)
 next
   case False
 
   have lt0: "unat a div 2 ^ n < 2 ^ (LENGTH('a) - n)" using sz
     by (metis shiftr_div_2n' word_shiftr_lt)
 
   have"2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
     by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right lt0 nat_le_power_trans nat_less_le)
   moreover have "2 ^ n * (unat a div 2 ^ n + 1) \<noteq> 2 ^ LENGTH('a)" using nowrap sz
     apply -
     apply (erule contrapos_nn)
     apply (subst alignUp_not_aligned_eq [OF False sz])
     apply (subst unat_arith_simps)
     apply (subst unat_word_ariths)
     apply (subst unat_word_ariths)
     apply simp
     apply (subst mult_mod_left)
     apply (simp add: unat_div field_simps power_add[symmetric] mod_mod_power min.absorb2)
     done
   ultimately have lt: "2 ^ n * (unat a div 2 ^ n + 1) < 2 ^ LENGTH('a)" by simp
 
   have "a = a div 2 ^ n * 2 ^ n + a mod 2 ^ n" by (rule word_mod_div_equality [symmetric])
   also have "\<dots> < (a div 2 ^ n + 1) * 2 ^ n" using sz lt
     apply (simp add: field_simps)
     apply (rule word_add_less_mono1)
     apply (rule word_mod_less_divisor)
     apply (simp add: word_less_nat_alt)
     apply (subst unat_word_ariths)
     apply (simp add: unat_div)
     done
   also have "\<dots> =  alignUp a n"
     by (rule alignUp_not_aligned_eq [symmetric]) fact+
   finally show ?thesis by (rule order_less_imp_le)
 qed
 
 lemma alignUp_le_greater_al:
   fixes x :: "'a :: len word"
   assumes le: "a \<le> x"
   and     sz: "n < LENGTH('a)"
   and     al: "is_aligned x n"
   shows   "alignUp a n \<le> x"
 proof (cases "is_aligned a n")
   case True
   then show ?thesis using sz le by (simp add: alignUp_idem)
 next
   case False
 
   then have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz)
 
   from al obtain k where xk: "x = 2 ^ n * of_nat k" and kv: "k < 2 ^ (LENGTH('a) - n)"
     by (auto elim!: is_alignedE)
 
   then have kn: "unat (of_nat k :: 'a word) * unat ((2::'a word) ^ n) < 2 ^ LENGTH('a)"
     using sz
     apply (subst unat_of_nat_eq)
      apply (erule order_less_le_trans)
      apply simp
     apply (subst mult.commute)
     apply simp
     apply (rule nat_less_power_trans)
      apply simp
     apply simp
     done
 
   have au: "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
     by (rule alignUp_not_aligned_eq) fact+
   also have "\<dots> \<le> of_nat k * 2 ^ n"
   proof (rule word_mult_le_mono1 [OF inc_le _ kn])
     show "a div 2 ^ n < of_nat k" using kv xk le sz anz
       by (simp add: alignUp_div_helper)
 
     show "(0:: 'a word) < 2 ^ n" using sz by (simp add: p2_gt_0 sz)
   qed
 
   finally show ?thesis using xk by (simp add: field_simps)
 qed
 
 lemma alignUp_is_aligned_nz:
   fixes a :: "'a :: len word"
   assumes al: "is_aligned x n"
   and     sz: "n < LENGTH('a)"
   and     ax: "a \<le> x"
   and     az: "a \<noteq> 0"
   shows   "alignUp (a::'a :: len word) n \<noteq> 0"
 proof (cases "is_aligned a n")
   case True
   then have "alignUp a n = a" using sz by (simp add: alignUp_idem)
   then show ?thesis using az by simp
 next
   case False
   then have anz: "a mod 2 ^ n \<noteq> 0"
     by (rule not_aligned_mod_nz)
 
   {
     assume asm: "alignUp a n = 0"
 
     have lt0: "unat a div 2 ^ n < 2 ^ (LENGTH('a) - n)" using sz
       by (metis shiftr_div_2n' word_shiftr_lt)
 
     have leq: "2 ^ n * (unat a div 2 ^ n + 1) \<le> 2 ^ LENGTH('a)" using sz
       by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right lt0 nat_le_power_trans
                 order_less_imp_le)
 
     from al obtain k where  kv: "k < 2 ^ (LENGTH('a) - n)" and xk: "x = 2 ^ n * of_nat k"
       by (auto elim!: is_alignedE)
 
     then have "a div 2 ^ n < of_nat k" using ax sz anz
       by (rule alignUp_div_helper)
 
     then have r: "unat a div 2 ^ n < k" using sz
       by (metis unat_div unat_less_helper unat_power_lower)
 
     have "alignUp a n = (a div 2 ^ n + 1) * 2 ^ n"
       by (rule alignUp_not_aligned_eq) fact+
 
     then have "\<dots> = 0" using asm by simp
     then have "2 ^ LENGTH('a) dvd 2 ^ n * (unat a div 2 ^ n + 1)"
       using sz by (simp add: unat_arith_simps ac_simps)
                   (simp add: unat_word_ariths mod_simps mod_eq_0_iff_dvd)
     with leq have "2 ^ n * (unat a div 2 ^ n + 1) = 2 ^ LENGTH('a)"
       by (force elim!: le_SucE)
     then have "unat a div 2 ^ n = 2 ^ LENGTH('a) div 2 ^ n - 1"
       by (metis (no_types, hide_lams) Groups.add_ac(2) add.right_neutral
                 add_diff_cancel_left' div_le_dividend div_mult_self4 gr_implies_not0
-                le_neq_implies_less power_eq_0_iff unat_def zero_neq_numeral)
+                le_neq_implies_less power_eq_0_iff unat_eq_nat_uint zero_neq_numeral)
     then have "unat a div 2 ^ n = 2 ^ (LENGTH('a) - n) - 1"
       using sz by (simp add: power_sub)
     then have "2 ^ (LENGTH('a) - n) - 1 < k" using r
       by simp
     then have False using kv by simp
   } then show ?thesis by clarsimp
 qed
 
 lemma alignUp_ar_helper:
   fixes a :: "'a :: len word"
   assumes al: "is_aligned x n"
   and     sz: "n < LENGTH('a)"
   and    sub: "{x..x + 2 ^ n - 1} \<subseteq> {a..b}"
   and    anz: "a \<noteq> 0"
   shows "a \<le> alignUp a n \<and> alignUp a n + 2 ^ n - 1 \<le> b"
 proof
   from al have xl: "x \<le> x + 2 ^ n - 1" by (simp add: is_aligned_no_overflow)
 
   from xl sub have ax: "a \<le> x"
     by (clarsimp elim!: range_subset_lower [where x = x])
 
   show "a \<le> alignUp a n"
   proof (rule alignUp_ge)
     show "alignUp a n \<noteq> 0" using al sz ax anz
       by (rule alignUp_is_aligned_nz)
   qed fact+
 
   show "alignUp a n + 2 ^ n - 1 \<le> b"
   proof (rule order_trans)
     from xl show tp: "x + 2 ^ n - 1 \<le> b" using sub
       by (clarsimp elim!: range_subset_upper [where x = x])
 
     from ax have "alignUp a n \<le> x"
       by (rule alignUp_le_greater_al) fact+
     then have "alignUp a n + (2 ^ n - 1) \<le> x + (2 ^ n - 1)"
       using xl al is_aligned_no_overflow' olen_add_eqv word_plus_mcs_3 by blast
     then show "alignUp a n + 2 ^ n - 1 \<le> x + 2 ^ n - 1"
       by (simp add: field_simps)
   qed
 qed
 
 lemma alignUp_def2:
   "alignUp a sz = a + 2 ^ sz - 1 && ~~ (mask sz)"
   unfolding alignUp_def[unfolded complement_def]
-  by (simp add:mask_def[symmetric,unfolded shiftl_t2n,simplified])
+  by (simp add:mask_eq_decr_exp[symmetric,unfolded shiftl_t2n,simplified])
 
 lemma mask_out_first_mask_some:
   "\<lbrakk> x && ~~ (mask n) = y; n \<le> m \<rbrakk> \<Longrightarrow> x && ~~ (mask m) = y && ~~ (mask m)"
   by word_eqI_solve
 
 lemma gap_between_aligned:
   "\<lbrakk>a < (b :: 'a ::len word); is_aligned a n; is_aligned b n; n < LENGTH('a) \<rbrakk>
   \<Longrightarrow> a + (2^n - 1) < b"
   by (simp add: aligned_add_offset_less)
 
 lemma mask_out_add_aligned:
   assumes al: "is_aligned p n"
   shows "p + (q && ~~ (mask n)) = (p + q) && ~~ (mask n)"
   using mask_add_aligned [OF al]
   by (simp add: mask_out_sub_mask)
 
 lemma alignUp_def3:
   "alignUp a sz = 2^ sz + (a - 1 && ~~ (mask sz))"
   by (simp add: alignUp_def2 is_aligned_triv field_simps mask_out_add_aligned)
 
 lemma  alignUp_plus:
   "is_aligned w us \<Longrightarrow> alignUp (w + a) us  = w + alignUp a us"
   by (clarsimp simp: alignUp_def2 mask_out_add_aligned field_simps)
 
 lemma mask_lower_twice:
   "n \<le> m \<Longrightarrow> (x && ~~ (mask n)) && ~~ (mask m) = x && ~~ (mask m)"
   by word_eqI_solve
 
 lemma mask_lower_twice2:
   "(a && ~~ (mask n)) && ~~ (mask m) = a && ~~ (mask (max n m))"
   by word_eqI_solve
 
 lemma ucast_and_neg_mask:
   "ucast (x && ~~ (mask n)) = ucast x && ~~ (mask n)"
   by word_eqI_solve
 
 lemma ucast_and_mask:
   "ucast (x && mask n) = ucast x && mask n"
   by word_eqI_solve
 
 lemma ucast_mask_drop:
   "LENGTH('a :: len) \<le> n \<Longrightarrow> (ucast (x && mask n) :: 'a word) = ucast x"
   by word_eqI
 
 lemma alignUp_distance:
   "alignUp (q :: 'a :: len word) sz - q \<le> mask sz"
   by (metis (no_types) add.commute add_diff_cancel_left alignUp_def2 diff_add_cancel
                        mask_2pm1 subtract_mask(2) word_and_le1 word_sub_le_iff)
 
 lemma is_aligned_diff_neg_mask:
   "is_aligned p sz \<Longrightarrow> (p - q && ~~ (mask sz)) = (p - ((alignUp q sz) && ~~ (mask sz)))"
   apply (clarsimp simp only:word_and_le2 diff_conv_add_uminus)
   apply (subst mask_out_add_aligned[symmetric]; simp)
   apply (rule sum_to_zero)
   apply (subst add.commute)
   by (simp add: alignUp_distance and_mask_0_iff_le_mask is_aligned_neg_mask_eq mask_out_add_aligned)
 
 lemma map_bits_rev_to_bl:
   "map ((!!) x) [0..<size x] = rev (to_bl x)"
   by (auto simp: list_eq_iff_nth_eq test_bit_bl word_size)
 
 (* negating a mask which has been shifted to the very left *)
 lemma NOT_mask_shifted_lenword:
   "~~ (mask len << (LENGTH('a) - len) ::'a::len word) = mask (LENGTH('a) - len)"
   by (rule bit_word_eqI)
     (auto simp add: mask_eq_mask shiftl_word_eq word_size bit_not_iff bit_push_bit_iff bit_mask_iff)
 
 (* Comparisons between different word sizes. *)
 
 lemma eq_ucast_ucast_eq:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> x = ucast y \<Longrightarrow> ucast x = y"
   for x :: "'a::len word" and y :: "'b::len word"
-  by (simp add: is_down ucast_id ucast_ucast_a)
+  by (simp add: is_down ucast_ucast_a)
 
 lemma le_ucast_ucast_le:
   "x \<le> ucast y \<Longrightarrow> ucast x \<le> y"
   for x :: "'a::len word" and y :: "'b::len word"
   by (smt le_unat_uoi linorder_not_less order_less_imp_le ucast_nat_def unat_arith_simps(1))
 
 lemma less_ucast_ucast_less:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> x < ucast y \<Longrightarrow> ucast x < y"
   for x :: "'a::len word" and y :: "'b::len word"
   by (metis ucast_nat_def unat_mono unat_ucast_up_simp word_of_nat_less)
 
 lemma ucast_le_ucast:
   "LENGTH('a) \<le> LENGTH('b) \<Longrightarrow> (ucast x \<le> (ucast y::'b::len word)) = (x \<le> y)"
   for x :: "'a::len word"
   by (simp add: unat_arith_simps(1) unat_ucast_up_simp)
 
 lemmas ucast_up_mono_le = ucast_le_ucast[THEN iffD2]
 
 lemma ucast_le_ucast_eq:
   fixes x y :: "'a::len word"
   assumes x: "x < 2 ^ n"
   assumes y: "y < 2 ^ n"
   assumes n: "n = LENGTH('b::len)"
   shows "(UCAST('a \<rightarrow> 'b) x \<le> UCAST('a \<rightarrow> 'b) y) = (x \<le> y)"
   apply (rule iffI)
    apply (cases "LENGTH('b) < LENGTH('a)")
     apply (subst less_mask_eq[OF x, symmetric])
     apply (subst less_mask_eq[OF y, symmetric])
     apply (unfold n)
     apply (subst ucast_ucast_mask[symmetric])+
     apply (simp add: ucast_le_ucast)+
   apply (erule ucast_mono_le[OF _ y[unfolded n]])
   done
 
 lemma word_le_not_less:
   "((b::'a::len word) \<le> a) = (\<not>(a < b))"
   by fastforce
 
 lemma ucast_or_distrib:
   fixes x :: "'a::len word"
   fixes y :: "'a::len word"
   shows "(ucast (x || y) :: ('b::len) word) = ucast x || ucast y"
-  by (simp add: ucast_def uint_or flip: or_word.abs_eq)
+  by (simp add: ucast_eq uint_or flip: or_word.abs_eq)
 
 lemma shiftr_less:
   "(w::'a::len word) < k \<Longrightarrow> w >> n < k"
   by (metis div_le_dividend le_less_trans shiftr_div_2n' unat_arith_simps(2))
 
 lemma word_and_notzeroD:
   "w && w' \<noteq> 0 \<Longrightarrow> w \<noteq> 0 \<and> w' \<noteq> 0"
   by auto
 
 lemma word_clz_max:
   "word_clz w \<le> size (w::'a::len word)"
   unfolding word_clz_def
   by (metis length_takeWhile_le word_size_bl)
 
 lemma word_clz_nonzero_max:
   fixes w :: "'a::len word"
   assumes nz: "w \<noteq> 0"
   shows "word_clz w < size (w::'a::len word)"
 proof -
   {
     assume a: "word_clz w = size (w::'a::len word)"
     hence "length (takeWhile Not (to_bl w)) = length (to_bl w)"
       by (simp add: word_clz_def word_size)
     hence allj: "\<forall>j\<in>set(to_bl w). \<not> j"
       by (metis a length_takeWhile_less less_irrefl_nat word_clz_def)
     hence "to_bl w = replicate (length (to_bl w)) False"
       by (fastforce intro!: list_of_false)
     hence "w = 0"
       by (metis to_bl_0 word_bl.Rep_eqD word_bl_Rep')
     with nz have False by simp
   }
   thus ?thesis using word_clz_max
     by (fastforce intro: le_neq_trans)
 qed
 
 lemma unat_add_lem':
   "(unat x + unat y < 2 ^ LENGTH('a)) \<Longrightarrow>
     (unat (x + y :: 'a :: len word) = unat x + unat y)"
   by (subst unat_add_lem[symmetric], assumption)
 
 lemma from_bool_eq_if':
   "((if P then 1 else 0) = from_bool Q) = (P = Q)"
   by (simp add: case_bool_If from_bool_def split: if_split)
 
 lemma word_exists_nth:
   "(w::'a::len word) \<noteq> 0 \<Longrightarrow> \<exists>i. w !! i"
   using word_log2_nth_same by blast
 
 lemma shiftr_le_0:
   "unat (w::'a::len word) < 2 ^ n \<Longrightarrow> w >> n = (0::'a::len word)"
   by (rule word_unat.Rep_eqD) (simp add: shiftr_div_2n')
 
 lemma of_nat_shiftl:
   "(of_nat x << n) = (of_nat (x * 2 ^ n) :: ('a::len) word)"
 proof -
   have "(of_nat x::'a word) << n = of_nat (2 ^ n) * of_nat x"
     using shiftl_t2n by (metis word_unat_power)
   thus ?thesis by simp
 qed
 
 lemma shiftl_1_not_0:
   "n < LENGTH('a) \<Longrightarrow> (1::'a::len word) << n \<noteq> 0"
   by (simp add: shiftl_t2n)
 
 lemma max_word_not_0 [simp]:
   "- 1 \<noteq> (0 :: 'a::len word)"
   by simp
 
 lemma ucast_zero_is_aligned:
   "UCAST('a::len \<rightarrow> 'b::len) w = 0 \<Longrightarrow> n \<le> LENGTH('b) \<Longrightarrow> is_aligned w n"
   by (clarsimp simp: is_aligned_mask word_eq_iff word_size nth_ucast)
 
 lemma unat_ucast_eq_unat_and_mask:
   "unat (UCAST('b::len \<rightarrow> 'a::len) w) = unat (w && mask LENGTH('a))"
   proof -
     have "unat (UCAST('b \<rightarrow> 'a) w) = unat (UCAST('a \<rightarrow> 'b) (UCAST('b \<rightarrow> 'a) w))"
       by (cases "LENGTH('a) < LENGTH('b)"; simp add: is_down ucast_ucast_a unat_ucast_up_simp)
     thus ?thesis using ucast_ucast_mask by simp
   qed
 
 lemma unat_max_word_pos[simp]: "0 < unat (- 1 :: 'a::len word)"
   using unat_gt_0 [of \<open>- 1 :: 'a::len word\<close>] by simp
 
 
 (* Miscellaneous conditional injectivity rules. *)
 
 lemma mult_pow2_inj:
   assumes ws: "m + n \<le> LENGTH('a)"
   assumes le: "x \<le> mask m" "y \<le> mask m"
   assumes eq: "x * 2^n = y * (2^n::'a::len word)"
   shows "x = y"
 proof (cases n)
   case 0 thus ?thesis using eq by simp
 next
   case (Suc n')
   have m_lt: "m < LENGTH('a)" using Suc ws by simp
   have xylt: "x < 2^m" "y < 2^m" using le m_lt unfolding mask_2pm1 by auto
   have lenm: "n \<le> LENGTH('a) - m" using ws by simp
   show ?thesis
     using eq xylt
     apply (fold shiftl_t2n[where n=n, simplified mult.commute])
     apply (simp only: word_bl.Rep_inject[symmetric] bl_shiftl)
     apply (erule ssubst[OF less_is_drop_replicate])+
     apply (clarsimp elim!: drop_eq_mono[OF lenm])
     done
 qed
 
 lemma word_of_nat_inj:
   assumes bounded: "x < 2 ^ LENGTH('a)" "y < 2 ^ LENGTH('a)"
   assumes of_nats: "of_nat x = (of_nat y :: 'a::len word)"
   shows "x = y"
   by (rule contrapos_pp[OF of_nats]; cases "x < y"; cases "y < x")
      (auto dest: bounded[THEN of_nat_mono_maybe])
 
 (* Sign extension from bit n. *)
 
 lemma sign_extend_bitwise_if:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> (if i < e then w !! i else w !! e)"
   by (simp add: sign_extend_def neg_mask_test_bit word_size)
 
 lemma sign_extend_bitwise_disj:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> i \<le> e \<and> w !! i \<or> e \<le> i \<and> w !! e"
   by (auto simp: sign_extend_bitwise_if)
 
 lemma sign_extend_bitwise_cases:
   "i < size w \<Longrightarrow> sign_extend e w !! i \<longleftrightarrow> (i \<le> e \<longrightarrow> w !! i) \<and> (e \<le> i \<longrightarrow> w !! e)"
   by (auto simp: sign_extend_bitwise_if)
 
 lemmas sign_extend_bitwise_if'[word_eqI_simps] = sign_extend_bitwise_if[simplified word_size]
 lemmas sign_extend_bitwise_disj' = sign_extend_bitwise_disj[simplified word_size]
 lemmas sign_extend_bitwise_cases' = sign_extend_bitwise_cases[simplified word_size]
 
 (* Often, it is easier to reason about an operation which does not overwrite
    the bit which determines which mask operation to apply. *)
 lemma sign_extend_def':
   "sign_extend n w = (if w !! n then w || ~~ (mask (Suc n)) else w && mask (Suc n))"
   by word_eqI (auto dest: less_antisym)
 
 lemma sign_extended_sign_extend:
   "sign_extended n (sign_extend n w)"
   by (clarsimp simp: sign_extended_def word_size sign_extend_bitwise_if')
 
 lemma sign_extended_iff_sign_extend:
   "sign_extended n w \<longleftrightarrow> sign_extend n w = w"
   apply (rule iffI)
    apply (word_eqI, rename_tac i)
    apply (case_tac "n < i"; simp add: sign_extended_def word_size)
   apply (erule subst, rule sign_extended_sign_extend)
   done
 
 lemma sign_extended_weaken:
   "sign_extended n w \<Longrightarrow> n \<le> m \<Longrightarrow> sign_extended m w"
   unfolding sign_extended_def by (cases "n < m") auto
 
 lemma sign_extend_sign_extend_eq:
   "sign_extend m (sign_extend n w) = sign_extend (min m n) w"
   by word_eqI
 
 lemma sign_extended_high_bits:
   "\<lbrakk> sign_extended e p; j < size p; e \<le> i; i < j \<rbrakk> \<Longrightarrow> p !! i = p !! j"
   by (drule (1) sign_extended_weaken; simp add: sign_extended_def)
 
 lemma sign_extend_eq:
   "w && mask (Suc n) = v && mask (Suc n) \<Longrightarrow> sign_extend n w = sign_extend n v"
   by word_eqI_solve
 
 lemma sign_extended_add:
   assumes p: "is_aligned p n"
   assumes f: "f < 2 ^ n"
   assumes e: "n \<le> e"
   assumes "sign_extended e p"
   shows "sign_extended e (p + f)"
 proof (cases "e < size p")
   case True
   note and_or = is_aligned_add_or[OF p f]
   have "\<not> f !! e"
     using True e less_2p_is_upper_bits_unset[THEN iffD1, OF f]
     by (fastforce simp: word_size)
   hence i: "(p + f) !! e = p !! e"
     by (simp add: and_or)
   have fm: "f && mask e = f"
     by (fastforce intro: subst[where P="\<lambda>f. f && mask e = f", OF less_mask_eq[OF f]]
                   simp: mask_twice e)
   show ?thesis
     using assms
      apply (simp add: sign_extended_iff_sign_extend sign_extend_def i)
      apply (simp add: and_or word_bw_comms[of p f])
      apply (clarsimp simp: word_ao_dist fm word_bw_assocs split: if_splits)
     done
 next
   case False thus ?thesis
     by (simp add: sign_extended_def word_size)
 qed
 
 lemma sign_extended_neq_mask:
   "\<lbrakk>sign_extended n ptr; m \<le> n\<rbrakk> \<Longrightarrow> sign_extended n (ptr && ~~ (mask m))"
   by (fastforce simp: sign_extended_def word_size neg_mask_test_bit)
 
 (* Uints *)
 
 lemma uints_mono_iff: "uints l \<subseteq> uints m \<longleftrightarrow> l \<le> m"
   using power_increasing_iff[of "2::int" l m]
   apply (auto simp: uints_num subset_iff simp del: power_increasing_iff)
   by (meson less_irrefl not_less zle2p)
 
 lemmas uints_monoI = uints_mono_iff[THEN iffD2]
 
 lemma Bit_in_uints_Suc: "of_bool c + 2 * w \<in> uints (Suc m)" if "w \<in> uints m"
   using that
   by (auto simp: uints_num)
 
 lemma Bit_in_uintsI: "of_bool c + 2 * w \<in> uints m" if "w \<in> uints (m - 1)" "m > 0"
   using Bit_in_uints_Suc[OF that(1)] that(2)
   by auto
 
 lemma bin_cat_in_uintsI:
   \<open>bin_cat a n b \<in> uints m\<close> if \<open>a \<in> uints l\<close> \<open>m \<ge> l + n\<close>
 proof -
   from \<open>m \<ge> l + n\<close> obtain q where \<open>m = l + n + q\<close>
     using le_Suc_ex by blast
   then have \<open>(2::int) ^ m = 2 ^ n * 2 ^ (l + q)\<close>
     by (simp add: ac_simps power_add)
   moreover have \<open>a mod 2 ^ (l + q) = a\<close>
     using \<open>a \<in> uints l\<close>
     by (auto simp add: uints_def take_bit_eq_mod power_add Divides.mod_mult2_eq)
   ultimately have \<open>concat_bit n b a = take_bit m (concat_bit n b a)\<close>
     by (simp add: concat_bit_eq take_bit_eq_mod push_bit_eq_mult Divides.mod_mult2_eq)
   then show ?thesis
     by (simp add: uints_def)
 qed
 
 lemma bin_cat_cong: "bin_cat a n b = bin_cat c m d"
   if "n = m" "a = c" "bintrunc m b = bintrunc m d"
   using that(3) unfolding that(1,2) by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma bin_cat_eqD1: "bin_cat a n b = bin_cat c n d \<Longrightarrow> a = c"
   by (metis drop_bit_bin_cat_eq)
 
 lemma bin_cat_eqD2: "bin_cat a n b = bin_cat c n d \<Longrightarrow> bintrunc n b = bintrunc n d"
   by (metis take_bit_bin_cat_eq)
   
 lemma bin_cat_inj: "(bin_cat a n b) = bin_cat c n d \<longleftrightarrow> a = c \<and> bintrunc n b = bintrunc n d"
   by (auto intro: bin_cat_cong bin_cat_eqD1 bin_cat_eqD2)
 
 lemma word_of_int_bin_cat_eq_iff:
   "(word_of_int (bin_cat (uint a) LENGTH('b) (uint b))::'c::len word) =
   word_of_int (bin_cat (uint c) LENGTH('b) (uint d)) \<longleftrightarrow> b = d \<and> a = c"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len word" and b::"'b::len word"
   by (subst word_uint.Abs_inject)
      (auto simp: bin_cat_inj intro!: that bin_cat_in_uintsI)
 
 lemma word_cat_inj: "(word_cat a b::'c::len word) = word_cat c d \<longleftrightarrow> a = c \<and> b = d"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len word" and b::"'b::len word"
-  by (auto simp: word_cat_def word_uint.Abs_inject word_of_int_bin_cat_eq_iff that)
+  using word_of_int_bin_cat_eq_iff [OF that, of b a d c]
+  by transfer auto
 
 lemma p2_eq_1: "2 ^ n = (1::'a::len word) \<longleftrightarrow> n = 0"
 proof -
   have "2 ^ n = (1::'a word) \<Longrightarrow> n = 0"
     by (metis One_nat_def not_less one_less_numeral_iff p2_eq_0 p2_gt_0 power_0 power_0
         power_inject_exp semiring_norm(76) unat_power_lower zero_neq_one)
   then show ?thesis by auto
 qed
 
 (* usually: x,y = (len_of TYPE ('a)) *)
 lemma bitmagic_zeroLast_leq_or1Last:
   "(a::('a::len) word) AND (mask len << x - len) \<le> a OR mask (y - len)"
   by (meson le_word_or2 order_trans word_and_le2)
 
 
 lemma zero_base_lsb_imp_set_eq_as_bit_operation:
   fixes base ::"'a::len word"
   assumes valid_prefix: "mask (LENGTH('a) - len) AND base = 0"
   shows "(base = NOT (mask (LENGTH('a) - len)) AND a) \<longleftrightarrow>
          (a \<in> {base .. base OR mask (LENGTH('a) - len)})"
 proof
   have helper3: "x OR y = x OR y AND NOT x" for x y ::"'a::len word" by (simp add: word_oa_dist2)
   from assms show "base = NOT (mask (LENGTH('a) - len)) AND a \<Longrightarrow>
                     a \<in> {base..base OR mask (LENGTH('a) - len)}"
     apply(simp add: word_and_le1)
     apply(metis helper3 le_word_or2 word_bw_comms(1) word_bw_comms(2))
   done
 next
   assume "a \<in> {base..base OR mask (LENGTH('a) - len)}"
   hence a: "base \<le> a \<and> a \<le> base OR mask (LENGTH('a) - len)" by simp
   show "base = NOT (mask (LENGTH('a) - len)) AND a"
   proof -
     have f2: "\<forall>x\<^sub>0. base AND NOT (mask x\<^sub>0) \<le> a AND NOT (mask x\<^sub>0)"
       using a neg_mask_mono_le by blast
     have f3: "\<forall>x\<^sub>0. a AND NOT (mask x\<^sub>0) \<le> (base OR mask (LENGTH('a) - len)) AND NOT (mask x\<^sub>0)"
       using a neg_mask_mono_le by blast
     have f4: "base = base AND NOT (mask (LENGTH('a) - len))"
       using valid_prefix by (metis mask_eq_0_eq_x word_bw_comms(1))
     hence f5: "\<forall>x\<^sub>6. (base OR x\<^sub>6) AND NOT (mask (LENGTH('a) - len)) =
                       base OR x\<^sub>6 AND NOT (mask (LENGTH('a) - len))"
       using word_ao_dist by (metis)
     have f6: "\<forall>x\<^sub>2 x\<^sub>3. a AND NOT (mask x\<^sub>2) \<le> x\<^sub>3 \<or>
                       \<not> (base OR mask (LENGTH('a) - len)) AND NOT (mask x\<^sub>2) \<le> x\<^sub>3"
       using f3 dual_order.trans by auto
     have "base = (base OR mask (LENGTH('a) - len)) AND NOT (mask (LENGTH('a) - len))"
       using f5 by auto
     hence "base = a AND NOT (mask (LENGTH('a) - len))"
       using f2 f4 f6 by (metis eq_iff)
     thus "base = NOT (mask (LENGTH('a) - len)) AND a"
       by (metis word_bw_comms(1))
   qed
 qed
 
 lemma unat_minus_one_word:
   "unat (-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by (subst minus_one_word)
      (subst unat_sub_if', clarsimp)
 
 lemma of_nat_eq_signed_scast:
   "(of_nat x = (y :: ('a::len) signed word))
    = (of_nat x = (scast y :: 'a word))"
   by (metis scast_of_nat scast_scast_id(2))
 
 lemma word_ctz_le:
   "word_ctz (w :: ('a::len word)) \<le> LENGTH('a)"
   apply (clarsimp simp: word_ctz_def)
   apply (rule nat_le_Suc_less_imp[where y="LENGTH('a) + 1" , simplified])
   apply (rule order_le_less_trans[OF List.length_takeWhile_le])
   apply simp
   done
 
 lemma word_ctz_less:
   "w \<noteq> 0 \<Longrightarrow> word_ctz (w :: ('a::len word)) < LENGTH('a)"
   apply (clarsimp simp: word_ctz_def eq_zero_set_bl)
   apply (rule order_less_le_trans[OF length_takeWhile_less])
    apply fastforce+
   done
 
 lemma word_ctz_not_minus_1:
   "1 < LENGTH('a) \<Longrightarrow> of_nat (word_ctz (w :: 'a :: len word)) \<noteq> (- 1 :: 'a::len word)"
   by (metis (mono_tags) One_nat_def add.right_neutral add_Suc_right le_diff_conv le_less_trans
                         n_less_equal_power_2 not_le suc_le_pow_2 unat_minus_one_word unat_of_nat_len
                         word_ctz_le)
 
 lemma word_aligned_add_no_wrap_bounded:
   "\<lbrakk> w + 2^n \<le> x; w + 2^n \<noteq> 0; is_aligned w n \<rbrakk> \<Longrightarrow> (w::'a::len word) < x"
   by (blast dest: is_aligned_no_overflow le_less_trans word_leq_le_minus_one)
 
 lemma mask_Suc:
   "mask (Suc n) = 2^n + mask n"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma is_aligned_no_overflow_mask:
   "is_aligned x n \<Longrightarrow> x \<le> x + mask n"
-  by (simp add: mask_def) (erule is_aligned_no_overflow')
+  by (simp add: mask_eq_decr_exp) (erule is_aligned_no_overflow')
 
 lemma is_aligned_mask_offset_unat:
   fixes off :: "('a::len) word"
   and     x :: "'a word"
   assumes al: "is_aligned x sz"
   and   offv: "off \<le> mask sz"
   shows  "unat x + unat off < 2 ^ LENGTH('a)"
 proof cases
   assume szv: "sz < LENGTH('a)"
   from al obtain k where xv: "x = 2 ^ sz * (of_nat k)"
     and kl: "k < 2 ^ (LENGTH('a) - sz)"
     by (auto elim: is_alignedE)
 
   from offv szv have offv': "unat off < 2 ^ sz"
     by (simp add: mask_2pm1 unat_less_power)
 
   show ?thesis using szv
     using al is_aligned_no_wrap''' offv' by blast
 next
   assume "\<not> sz < LENGTH('a)"
   with al have "x = 0" by - word_eqI
   thus ?thesis by simp
 qed
 
 lemma of_bl_max:
   "(of_bl xs :: 'a::len word) \<le> mask (length xs)"
   apply (induct xs)
    apply simp
   apply (simp add: of_bl_Cons mask_Suc)
   apply (rule conjI; clarsimp)
    apply (erule word_plus_mono_right)
    apply (rule is_aligned_no_overflow_mask)
    apply (rule is_aligned_triv)
   apply (simp add: word_le_nat_alt)
   apply (subst unat_add_lem')
    apply (rule is_aligned_mask_offset_unat)
     apply (rule is_aligned_triv)
-   apply (simp add: mask_def)
+   apply (simp add: mask_eq_decr_exp)
   apply simp
   done
 
 lemma mask_over_length:
   "LENGTH('a) \<le> n \<Longrightarrow> mask n = (-1::'a::len word)"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma is_aligned_over_length:
   "\<lbrakk> is_aligned p n; LENGTH('a) \<le> n \<rbrakk> \<Longrightarrow> (p::'a::len word) = 0"
   by (simp add: is_aligned_mask mask_over_length)
 
 lemma Suc_2p_unat_mask:
   "n < LENGTH('a) \<Longrightarrow> Suc (2 ^ n * k + unat (mask n :: 'a::len word)) = 2 ^ n * (k+1)"
   by (simp add: unat_mask)
 
 lemma is_aligned_add_step_le:
   "\<lbrakk> is_aligned (a::'a::len word) n; is_aligned b n; a < b; b \<le> a + mask n \<rbrakk> \<Longrightarrow> False"
   apply (simp flip: not_le)
   apply (erule notE)
   apply (cases "LENGTH('a) \<le> n")
    apply (drule (1) is_aligned_over_length)+
    apply (drule mask_over_length)
    apply clarsimp
   apply (clarsimp simp: word_le_nat_alt not_less)
   apply (subst (asm) unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)
   apply (clarsimp simp: is_aligned_def dvd_def word_le_nat_alt)
   apply (drule le_imp_less_Suc)
   apply (simp add: Suc_2p_unat_mask)
   by (metis Groups.mult_ac(2) Suc_leI linorder_not_less mult_le_mono order_refl times_nat.simps(2))
 
 lemma power_2_mult_step_le:
   "\<lbrakk>n' \<le> n; 2 ^ n' * k' < 2 ^ n * k\<rbrakk> \<Longrightarrow> 2 ^ n' * (k' + 1) \<le> 2 ^ n * (k::nat)"
   apply (cases "n'=n", simp)
    apply (metis Suc_leI le_refl mult_Suc_right mult_le_mono semiring_normalization_rules(7))
   apply (drule (1) le_neq_trans)
   apply clarsimp
   apply (subgoal_tac "\<exists>m. n = n' + m")
    prefer 2
    apply (simp add: le_Suc_ex)
   apply (clarsimp simp: power_add)
   by (metis Suc_leI mult.assoc mult_Suc_right nat_mult_le_cancel_disj)
 
 lemma aligned_mask_step:
   "\<lbrakk> n' \<le> n; p' \<le> p + mask n; is_aligned p n; is_aligned p' n' \<rbrakk> \<Longrightarrow>
    (p'::'a::len word) + mask n' \<le> p + mask n"
   apply (cases "LENGTH('a) \<le> n")
    apply (frule (1) is_aligned_over_length)
    apply (drule mask_over_length)
    apply clarsimp
   apply (simp add: not_le)
   apply (simp add: word_le_nat_alt unat_plus_simple)
   apply (subst unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)+
   apply (subst (asm) unat_plus_simple[THEN iffD1], erule is_aligned_no_overflow_mask)
   apply (clarsimp simp: is_aligned_def dvd_def)
   apply (rename_tac k k')
   apply (thin_tac "unat p = x" for p x)+
   apply (subst Suc_le_mono[symmetric])
   apply (simp only: Suc_2p_unat_mask)
   apply (drule le_imp_less_Suc, subst (asm) Suc_2p_unat_mask, assumption)
   apply (erule (1) power_2_mult_step_le)
   done
 
 lemma mask_mono:
   "sz' \<le> sz \<Longrightarrow> mask sz' \<le> (mask sz :: 'a::len word)"
   by (simp add: le_mask_iff shiftr_mask_le)
 
 lemma aligned_mask_disjoint:
   "\<lbrakk> is_aligned (a :: 'a :: len word) n; b \<le> mask n \<rbrakk> \<Longrightarrow> a && b = 0"
   by word_eqI_solve
 
 lemma word_and_or_mask_aligned:
   "\<lbrakk> is_aligned a n; b \<le> mask n \<rbrakk> \<Longrightarrow> a + b = a || b"
   by (simp add: aligned_mask_disjoint word_plus_and_or_coroll)
 
 lemma word_and_or_mask_aligned2:
   \<open>is_aligned b n \<Longrightarrow> a \<le> mask n \<Longrightarrow> a + b = a || b\<close>
   using word_and_or_mask_aligned [of b n a] by (simp add: ac_simps)
   
 lemma is_aligned_ucastI:
   "is_aligned w n \<Longrightarrow> is_aligned (ucast w) n"
   by (clarsimp simp: word_eqI_simps)
 
 lemma ucast_le_maskI:
   "a \<le> mask n \<Longrightarrow> UCAST('a::len \<rightarrow> 'b::len) a \<le> mask n"
   by (metis and_mask_eq_iff_le_mask ucast_and_mask)
 
 lemma ucast_add_mask_aligned:
   "\<lbrakk> a \<le> mask n; is_aligned b n \<rbrakk> \<Longrightarrow> UCAST ('a::len \<rightarrow> 'b::len) (a + b) = ucast a + ucast b"
   by (metis add.commute is_aligned_ucastI ucast_le_maskI ucast_or_distrib word_and_or_mask_aligned)
 
 lemma ucast_shiftl:
   "LENGTH('b) \<le> LENGTH ('a) \<Longrightarrow> UCAST ('a::len \<rightarrow> 'b::len) x << n = ucast (x << n)"
   by word_eqI_solve
 
 lemma ucast_leq_mask:
   "LENGTH('a) \<le> n \<Longrightarrow> ucast (x::'a::len word) \<le> mask n"
   by (clarsimp simp: le_mask_high_bits word_size nth_ucast)
 
 lemma shiftl_inj:
   "\<lbrakk> x << n = y << n; x \<le> mask (LENGTH('a)-n); y \<le> mask (LENGTH('a)-n) \<rbrakk> \<Longrightarrow>
    x = (y :: 'a :: len word)"
   apply word_eqI
   apply (rename_tac n')
   apply (case_tac "LENGTH('a) - n \<le> n'", simp)
   by (metis add.commute add.right_neutral diff_add_inverse le_diff_conv linorder_not_less zero_order(1))
 
 lemma distinct_word_add_ucast_shift_inj:
   "\<lbrakk> p + (UCAST('a::len \<rightarrow> 'b::len) off << n) = p' + (ucast off' << n);
      is_aligned p n'; is_aligned p' n'; n' = n + LENGTH('a); n' < LENGTH('b) \<rbrakk>
    \<Longrightarrow> p' = p \<and> off' = off"
   apply (simp add: word_and_or_mask_aligned le_mask_shiftl_le_mask[where n="LENGTH('a)"]
                    ucast_leq_mask)
   apply (simp add: is_aligned_nth)
   apply (rule conjI; word_eqI)
    apply (metis add.commute test_bit_conj_lt diff_add_inverse le_diff_conv nat_less_le)
   apply (rename_tac i)
   apply (erule_tac x="i+n" in allE)
   apply simp
   done
 
 lemma aligned_add_mask_lessD:
   "\<lbrakk> x + mask n < y; is_aligned x n \<rbrakk> \<Longrightarrow> x < y" for y::"'a::len word"
   by (metis is_aligned_no_overflow' mask_2pm1 order_le_less_trans)
 
 lemma aligned_add_mask_less_eq:
   "\<lbrakk> is_aligned x n; is_aligned y n;  n < LENGTH('a) \<rbrakk> \<Longrightarrow> (x + mask n < y) = (x < y)"
   for y::"'a::len word"
   using aligned_add_mask_lessD is_aligned_add_step_le word_le_not_less by blast
 
 lemma word_upto_Nil:
   "y < x \<Longrightarrow> [x .e. y ::'a::len word] = []"
   by (simp add: upto_enum_red not_le word_less_nat_alt)
 
 lemma word_enum_decomp_elem:
   assumes "[x .e. (y ::'a::len word)] = as @ a # bs"
   shows "x \<le> a \<and> a \<le> y"
 proof -
   have "set as \<subseteq> set [x .e. y] \<and> a \<in> set [x .e. y]"
     using assms by (auto dest: arg_cong[where f=set])
   then show ?thesis by auto
 qed
 
 lemma max_word_not_less[simp]:
    "\<not> max_word < x"
   by (simp add: not_less)
 
 lemma word_enum_prefix:
   "[x .e. (y ::'a::len word)] = as @ a # bs \<Longrightarrow> as = (if x < a then [x .e. a - 1] else [])"
   apply (induct as arbitrary: x; clarsimp)
    apply (case_tac "x < y")
     prefer 2
     apply (case_tac "x = y", simp)
     apply (simp add: not_less)
     apply (drule (1) dual_order.not_eq_order_implies_strict)
     apply (simp add: word_upto_Nil)
    apply (simp add: word_upto_Cons_eq)
   apply (case_tac "x < y")
    prefer 2
    apply (case_tac "x = y", simp)
    apply (simp add: not_less)
    apply (drule (1) dual_order.not_eq_order_implies_strict)
    apply (simp add: word_upto_Nil)
   apply (clarsimp simp: word_upto_Cons_eq)
   apply (frule word_enum_decomp_elem)
   apply clarsimp
   apply (rule conjI)
    prefer 2
    apply (subst word_Suc_le[symmetric]; clarsimp)
   apply (drule meta_spec)
   apply (drule (1) meta_mp)
   apply clarsimp
   apply (rule conjI; clarsimp)
   apply (subst (2) word_upto_Cons_eq)
    apply unat_arith
   apply simp
   done
 
 lemma word_enum_decomp_set:
   "[x .e. (y ::'a::len word)] = as @ a # bs \<Longrightarrow> a \<notin> set as"
   by (metis distinct_append distinct_enum_upto' not_distinct_conv_prefix)
 
 lemma word_enum_decomp:
   assumes "[x .e. (y ::'a::len word)] = as @ a # bs"
   shows "x \<le> a \<and> a \<le> y \<and> a \<notin> set as \<and> (\<forall>z \<in> set as. x \<le> z \<and> z \<le> y)"
 proof -
   from assms
   have "set as \<subseteq> set [x .e. y] \<and> a \<in> set [x .e. y]"
     by (auto dest: arg_cong[where f=set])
   with word_enum_decomp_set[OF assms]
   show ?thesis by auto
 qed
 
 lemma of_nat_unat_le_mask_ucast:
   "\<lbrakk>of_nat (unat t) = w; t \<le> mask LENGTH('a)\<rbrakk> \<Longrightarrow> t = UCAST('a::len \<rightarrow> 'b::len) w"
   by (clarsimp simp: ucast_nat_def ucast_ucast_mask simp flip: and_mask_eq_iff_le_mask)
 
 lemma fold_eq_0_to_bool:
   "(v = 0) = (\<not> to_bool v)"
   by (simp add: to_bool_def)
 
 lemma less_diff_gt0:
   "a < b \<Longrightarrow> (0 :: 'a :: len word) < b - a"
   by unat_arith
 
 lemma unat_plus_gt:
   "unat ((a :: 'a :: len word) + b) \<le> unat a + unat b"
   by (clarsimp simp: unat_plus_if_size)
 
 lemma const_less:
   "\<lbrakk> (a :: 'a :: len word) - 1 < b; a \<noteq> b \<rbrakk> \<Longrightarrow> a < b"
   by (metis less_1_simp word_le_less_eq)
 
 lemma add_mult_aligned_neg_mask:
-  "m && (2 ^ n - 1) = 0 \<Longrightarrow> (x + y * m) && ~~(mask n) = (x && ~~(mask n)) + y * m"
-  by (metis Groups.add_ac(2) is_aligned_mask mask_def mask_eqs(5) mask_out_add_aligned
-            mult_zero_right shiftl_1 word_bw_comms(1) word_log_esimps(1))
+  \<open>(x + y * m) && ~~(mask n) = (x && ~~(mask n)) + y * m\<close>
+  if \<open>m && (2 ^ n - 1) = 0\<close>
+  by (metis (no_types, hide_lams)
+    add.assoc add.commute add.right_neutral add_uminus_conv_diff
+   mask_eq_decr_exp mask_eqs(2) mask_eqs(6) mult.commute mult_zero_left
+   subtract_mask(1) that)
 
 lemma unat_of_nat_minus_1:
   "\<lbrakk> n < 2 ^ LENGTH('a); n \<noteq> 0 \<rbrakk> \<Longrightarrow> unat ((of_nat n:: 'a :: len word) - 1) = n - 1"
   by (simp add: unat_eq_of_nat)
 
 lemma word_eq_zeroI:
   "a \<le> a - 1 \<Longrightarrow> a = 0" for a :: "'a :: len word"
   by (simp add: word_must_wrap)
 
 lemma word_add_format:
   "(-1 :: 'a :: len  word) + b + c = b + (c - 1)"
   by simp
 
 lemma upto_enum_word_nth:
   "\<lbrakk> i \<le> j; k \<le> unat (j - i) \<rbrakk> \<Longrightarrow> [i .e. j] ! k = i + of_nat k"
   apply (clarsimp simp: upto_enum_def nth_append)
   apply (clarsimp simp: word_le_nat_alt[symmetric])
   apply (rule conjI, clarsimp)
    apply (subst toEnum_of_nat, unat_arith)
    apply unat_arith
   apply (clarsimp simp: not_less unat_sub[symmetric])
   apply unat_arith
   done
 
 lemma upto_enum_step_nth:
   "\<lbrakk> a \<le> c; n \<le> unat ((c - a) div (b - a)) \<rbrakk>
    \<Longrightarrow> [a, b .e. c] ! n = a + of_nat n * (b - a)"
   by (clarsimp simp: upto_enum_step_def not_less[symmetric] upto_enum_word_nth)
 
 lemma upto_enum_inc_1_len:
   "a < - 1 \<Longrightarrow> [(0 :: 'a :: len word) .e. 1 + a] = [0 .e. a] @ [1 + a]"
   apply (simp add: upto_enum_word)
   apply (subgoal_tac "unat (1+a) = 1 + unat a")
    apply simp
   apply (subst unat_plus_simple[THEN iffD1])
    apply (metis add.commute no_plus_overflow_neg olen_add_eqv)
   apply unat_arith
   done
 
 lemma neg_mask_add:
   "y && mask n = 0 \<Longrightarrow> x + y && ~~(mask n) = (x && ~~(mask n)) + y"
   by (clarsimp simp: mask_out_sub_mask mask_eqs(7)[symmetric] mask_twice)
 
 lemma shiftr_shiftl_shiftr[simp]:
   "(x :: 'a :: len word)  >> a << a >> a = x >> a"
   by word_eqI_solve
 
 lemma add_right_shift:
   "\<lbrakk> x && mask n = 0; y && mask n = 0; x \<le> x + y \<rbrakk>
    \<Longrightarrow> (x + y :: ('a :: len) word) >> n = (x >> n) + (y >> n)"
   apply (simp add: no_olen_add_nat is_aligned_mask[symmetric])
   apply (simp add: unat_arith_simps shiftr_div_2n' split del: if_split)
   apply (subst if_P)
    apply (erule order_le_less_trans[rotated])
    apply (simp add: add_mono)
   apply (simp add: shiftr_div_2n' is_aligned_def)
   done
 
 lemma sub_right_shift:
   "\<lbrakk> x && mask n = 0; y && mask n = 0; y \<le> x \<rbrakk>
    \<Longrightarrow> (x - y) >> n = (x >> n :: 'a :: len word) - (y >> n)"
   using add_right_shift[where x="x - y" and y=y and n=n]
   by (simp add: aligned_sub_aligned is_aligned_mask[symmetric] word_sub_le)
 
 lemma and_and_mask_simple:
   "y && mask n = mask n \<Longrightarrow> (x && y) && mask n = x && mask n"
   by (simp add: ac_simps)
 
 lemma and_and_mask_simple_not:
   "y && mask n = 0 \<Longrightarrow> (x && y) && mask n = 0"
   by (simp add: ac_simps)
 
 lemma word_and_le':
   "b \<le> c \<Longrightarrow> (a :: 'a :: len word) && b \<le> c"
   by (metis word_and_le1 order_trans)
 
 lemma word_and_less':
   "b < c \<Longrightarrow> (a :: 'a :: len word) && b < c"
   by (metis word_and_le1 xtr7)
 
 lemma shiftr_w2p:
   "x < LENGTH('a) \<Longrightarrow> 2 ^ x = (2 ^ (LENGTH('a) - 1) >> (LENGTH('a) - 1 - x) :: 'a :: len word)"
   by word_eqI_solve
 
 lemma t2p_shiftr:
   "\<lbrakk> b \<le> a; a < LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ a >> b = 2 ^ (a - b)"
   by word_eqI_solve
 
 lemma scast_1[simp]:
   "scast (1 :: 'a :: len signed word) = (1 :: 'a word)"
   by simp
 
 lemma ucast_ucast_mask_eq:
   "\<lbrakk> UCAST('a::len \<rightarrow> 'b::len) x = y; x && mask LENGTH('b) = x \<rbrakk> \<Longrightarrow> x = ucast y"
   by word_eqI_solve
 
 lemma ucast_up_eq:
   "\<lbrakk> ucast x = (ucast y::'b::len word); LENGTH('a) \<le> LENGTH ('b) \<rbrakk>
    \<Longrightarrow> ucast x = (ucast y::'a::len word)"
   by word_eqI_solve
 
 lemma ucast_up_neq:
   "\<lbrakk> ucast x \<noteq> (ucast y::'b::len word); LENGTH('b) \<le> LENGTH ('a) \<rbrakk>
    \<Longrightarrow> ucast x \<noteq> (ucast y::'a::len word)"
   by (fastforce dest: ucast_up_eq)
 
 lemma mask_AND_less_0:
   "\<lbrakk> x && mask n = 0; m \<le> n \<rbrakk> \<Longrightarrow> x && mask m = 0"
   by (metis mask_twice2 word_and_notzeroD)
 
 lemma mask_len_id [simp]:
   "(x :: 'a :: len word) && mask LENGTH('a) = x"
   using uint_lt2p [of x] by (simp add: mask_eq_iff)
 
 lemma scast_ucast_down_same:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow> SCAST('a \<rightarrow> 'b) = UCAST('a::len \<rightarrow> 'b::len)"
   by (simp add: down_cast_same is_down)
 
 lemma word_aligned_0_sum:
   "\<lbrakk> a + b = 0; is_aligned (a :: 'a :: len word) n; b \<le> mask n; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> a = 0 \<and> b = 0"
   by (simp add: word_plus_and_or_coroll aligned_mask_disjoint word_or_zero)
 
 lemma mask_eq1_nochoice:
   "\<lbrakk> LENGTH('a) > 1; (x :: 'a :: len word) && 1 = x \<rbrakk> \<Longrightarrow> x = 0 \<or> x = 1"
   by (metis word_and_1)
 
 lemma pow_mono_leq_imp_lt:
   "x \<le> y \<Longrightarrow> x < 2 ^ y"
   by (simp add: le_less_trans)
 
 lemma unat_of_nat_ctz_mw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len word) = word_ctz w"
   using word_ctz_le[where w=w, simplified] unat_of_nat_eq[where x="word_ctz w" and 'a="'a"]
         pow_mono_leq_imp_lt
   by simp
 
 lemma unat_of_nat_ctz_smw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len sword) = word_ctz w"
   using word_ctz_le[where w=w, simplified] unat_of_nat_eq[where x="word_ctz w" and 'a="'a"]
         pow_mono_leq_imp_lt
   by (metis le_unat_uoi le_unat_uoi linorder_neqE_nat nat_less_le scast_of_nat
             word_unat.Rep_inverse)
 
 lemma shiftr_and_eq_shiftl:
   "(w >> n) && x = y \<Longrightarrow> w && (x << n) = (y << n)" for y :: "'a:: len word"
   by (metis (no_types, lifting) and_not_mask bit.conj_ac(1) bit.conj_ac(2) mask_eq_0_eq_x shiftl_mask_is_0 shiftl_over_and_dist)
 
 lemma neg_mask_combine:
   "~~(mask a) && ~~(mask b) = ~~(mask (max a b))"
   by (auto simp: word_ops_nth_size word_size intro!: word_eqI)
 
 lemma neg_mask_twice:
   "x && ~~(mask n) && ~~(mask m) = x && ~~(mask (max n m))"
   by (metis neg_mask_combine)
 
 lemma multiple_mask_trivia:
   "n \<ge> m \<Longrightarrow> (x && ~~(mask n)) + (x && mask n && ~~(mask m)) = x && ~~(mask m)"
   apply (rule trans[rotated], rule_tac w="mask n" in word_plus_and_or_coroll2)
   apply (simp add: word_bw_assocs word_bw_comms word_bw_lcs neg_mask_twice
                    max_absorb2)
   done
 
 lemma add_mask_lower_bits':
   "\<lbrakk> len = LENGTH('a); is_aligned (x :: 'a :: len word) n;
      \<forall>n' \<ge> n. n' < len \<longrightarrow> \<not> p !! n' \<rbrakk>
    \<Longrightarrow> x + p && ~~(mask n) = x"
   using add_mask_lower_bits by auto
 
 lemma neg_mask_in_mask_range:
   "is_aligned ptr bits \<Longrightarrow> (ptr' && ~~(mask bits) = ptr) = (ptr' \<in> mask_range ptr bits)"
   apply (erule is_aligned_get_word_bits)
    apply (rule iffI)
     apply (drule sym)
     apply (simp add: word_and_le2)
     apply (subst word_plus_and_or_coroll, word_eqI_solve)
     apply (metis le_word_or2 neg_mask_add_mask and.right_idem)
    apply clarsimp
    apply (smt add.right_neutral eq_iff is_aligned_neg_mask_eq mask_out_add_aligned neg_mask_mono_le
               word_and_not)
-  apply (simp add: power_overflow mask_def)
+  apply (simp add: power_overflow mask_eq_decr_exp)
   done
 
 lemma aligned_offset_in_range:
   "\<lbrakk> is_aligned (x :: 'a :: len word) m; y < 2 ^ m; is_aligned p n; n \<ge> m; n < LENGTH('a) \<rbrakk>
    \<Longrightarrow> (x + y \<in> {p .. p + mask n}) = (x \<in> mask_range p n)"
   apply (simp only: is_aligned_add_or flip: neg_mask_in_mask_range)
   by (metis less_mask_eq mask_subsume)
 
 lemma mask_range_to_bl':
   "\<lbrakk> is_aligned (ptr :: 'a :: len word) bits; bits < LENGTH('a) \<rbrakk>
    \<Longrightarrow> mask_range ptr bits
        = {x. take (LENGTH('a) - bits) (to_bl x) = take (LENGTH('a) - bits) (to_bl ptr)}"
   apply (rule set_eqI, rule iffI)
    apply clarsimp
    apply (subgoal_tac "\<exists>y. x = ptr + y \<and> y < 2 ^ bits")
     apply clarsimp
     apply (subst is_aligned_add_conv)
        apply assumption
       apply simp
     apply simp
    apply (rule_tac x="x - ptr" in exI)
    apply (simp add: add_diff_eq[symmetric])
    apply (simp only: word_less_sub_le[symmetric])
    apply (rule word_diff_ls')
-    apply (simp add: field_simps mask_def)
+    apply (simp add: field_simps mask_eq_decr_exp)
    apply assumption
   apply simp
   apply (subgoal_tac "\<exists>y. y < 2 ^ bits \<and> to_bl (ptr + y) = to_bl x")
    apply clarsimp
    apply (rule conjI)
     apply (erule(1) is_aligned_no_wrap')
-   apply (simp only: add_diff_eq[symmetric] mask_def)
+   apply (simp only: add_diff_eq[symmetric] mask_eq_decr_exp)
    apply (rule word_plus_mono_right)
     apply simp
    apply (erule is_aligned_no_wrap')
    apply simp
   apply (rule_tac x="of_bl (drop (LENGTH('a) - bits) (to_bl x))" in exI)
   apply (rule context_conjI)
    apply (rule order_less_le_trans [OF of_bl_length])
     apply simp
    apply simp
   apply (subst is_aligned_add_conv)
      apply assumption
     apply simp
   apply (drule sym)
   apply (simp add: word_rep_drop)
   done
 
 lemma mask_range_to_bl:
   "is_aligned (ptr :: 'a :: len word) bits
    \<Longrightarrow> mask_range ptr bits
         = {x. take (LENGTH('a) - bits) (to_bl x) = take (LENGTH('a) - bits) (to_bl ptr)}"
   apply (erule is_aligned_get_word_bits)
    apply (erule(1) mask_range_to_bl')
   apply (rule set_eqI)
-  apply (simp add: power_overflow mask_def)
+  apply (simp add: power_overflow mask_eq_decr_exp)
   done
 
 lemma aligned_mask_range_cases:
   "\<lbrakk> is_aligned (p :: 'a :: len word) n; is_aligned (p' :: 'a :: len word) n' \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range p' n' = {} \<or>
        mask_range p n \<subseteq> mask_range p' n' \<or>
        mask_range p n \<supseteq> mask_range p' n'"
   apply (simp add: mask_range_to_bl)
   apply (rule Meson.disj_comm, rule disjCI)
   apply (erule nonemptyE)
   apply simp
   apply (subgoal_tac "(\<exists>n''. LENGTH('a) - n = (LENGTH('a) - n') + n'')
                     \<or> (\<exists>n''. LENGTH('a) - n' = (LENGTH('a) - n) + n'')")
    apply (fastforce simp: take_add)
   apply arith
   done
 
 lemma aligned_mask_range_offset_subset:
   assumes al: "is_aligned (ptr :: 'a :: len word) sz" and al': "is_aligned x sz'"
   and szv: "sz' \<le> sz"
   and xsz: "x < 2 ^ sz"
   shows "mask_range (ptr+x) sz' \<subseteq> mask_range ptr sz"
   using al
 proof (rule is_aligned_get_word_bits)
   assume p0: "ptr = 0" and szv': "LENGTH ('a) \<le> sz"
   then have "(2 ::'a word) ^ sz = 0" by simp
   show ?thesis using p0
-    by (simp add: \<open>2 ^ sz = 0\<close> mask_def)
+    by (simp add: \<open>2 ^ sz = 0\<close> mask_eq_decr_exp)
 next
   assume szv': "sz < LENGTH('a)"
 
   hence blah: "2 ^ (sz - sz') < (2 :: nat) ^ LENGTH('a)"
     using szv by auto
   show ?thesis using szv szv'
     apply (intro range_subsetI)
      apply (rule is_aligned_no_wrap' [OF al xsz])
     apply (simp only: flip: add_diff_eq add_mask_fold)
     apply (subst add.assoc, rule word_plus_mono_right)
      using al' is_aligned_add_less_t2n xsz
      apply fastforce
     apply (simp add: field_simps szv al is_aligned_no_overflow)
     done
 qed
 
 lemma aligned_mask_diff:
   "\<lbrakk> is_aligned (dest :: 'a :: len word) bits; is_aligned (ptr :: 'a :: len word) sz;
      bits \<le> sz; sz < LENGTH('a); dest < ptr \<rbrakk>
    \<Longrightarrow> mask bits + dest < ptr"
   apply (frule_tac p' = ptr in aligned_mask_range_cases, assumption)
   apply (elim disjE)
     apply (drule_tac is_aligned_no_overflow_mask, simp)+
     apply (simp add: algebra_split_simps word_le_not_less)
    apply (drule is_aligned_no_overflow_mask; fastforce)
   by (simp add: aligned_add_mask_less_eq is_aligned_weaken algebra_split_simps)
 
 lemma aligned_mask_ranges_disjoint:
   "\<lbrakk> is_aligned (p :: 'a :: len word) n; is_aligned (p' :: 'a :: len word) n';
      p && ~~(mask n') \<noteq> p'; p' && ~~(mask n) \<noteq> p \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range p' n' = {}"
   using aligned_mask_range_cases
   by (auto simp: neg_mask_in_mask_range)
 
 lemma aligned_mask_ranges_disjoint2:
   "\<lbrakk> is_aligned p n; is_aligned ptr bits; n \<ge> m; n < size p; m \<le> bits;
      (\<forall>y < 2 ^ (n - m). p + (y << m) \<notin> mask_range ptr bits) \<rbrakk>
    \<Longrightarrow> mask_range p n \<inter> mask_range ptr bits = {}"
   apply safe
   apply (simp only: flip: neg_mask_in_mask_range)
   apply (drule_tac x="x && mask n >> m" in spec)
   apply (clarsimp simp: shiftr_less_t2n and_mask_less_size wsst_TYs multiple_mask_trivia
                         word_bw_assocs neg_mask_twice max_absorb2 shiftr_shiftl1)
   done
 
 lemma leq_mask_shift:
   "(x :: 'a :: len word) \<le> mask (low_bits + high_bits) \<Longrightarrow> (x >> low_bits) \<le> mask high_bits"
   by (simp add: le_mask_iff shiftr_shiftr)
 
 lemma ucast_ucast_eq_mask_shift:
   "(x :: 'a :: len word) \<le> mask (low_bits + LENGTH('b))
    \<Longrightarrow> ucast((ucast (x >> low_bits)) :: 'b :: len word) = x >> low_bits"
   by (meson and_mask_eq_iff_le_mask eq_ucast_ucast_eq not_le_imp_less shiftr_less_t2n'
             ucast_ucast_len)
 
 lemma const_le_unat:
   "\<lbrakk> b < 2 ^ LENGTH('a); of_nat b \<le> a \<rbrakk> \<Longrightarrow> b \<le> unat (a :: 'a :: len word)"
   by (clarsimp simp: word_le_def uint_nat of_nat_inverse)
 
 lemma upt_enum_offset_trivial:
   "\<lbrakk> x < 2 ^ LENGTH('a) - 1 ; n \<le> unat x \<rbrakk>
    \<Longrightarrow> ([(0 :: 'a :: len word) .e. x] ! n) = of_nat n"
   apply (induct x arbitrary: n)
     apply simp
   by (simp add: upto_enum_word_nth)
 
 lemma word_le_mask_out_plus_2sz:
   "x \<le> (x && ~~(mask sz)) + 2 ^ sz - 1"
   by (metis add_diff_eq word_neg_and_le)
 
 lemma ucast_add:
   "ucast (a + (b :: 'a :: len word)) = ucast a + (ucast b :: ('a signed word))"
   apply (case_tac "LENGTH('a) = 1")
-   apply (clarsimp simp: ucast_def)
+   apply (clarsimp simp: ucast_eq)
    apply (metis (hide_lams, mono_tags) One_nat_def len_signed plus_word.abs_eq
                                        uint_word_arith_bintrs(1) word_ubin.Abs_norm)
-  apply (clarsimp simp: ucast_def)
+  apply (clarsimp simp: ucast_eq)
   apply (metis le_refl len_signed plus_word.abs_eq uint_word_arith_bintrs(1) wi_bintr)
   done
 
 lemma ucast_minus:
   "ucast (a - (b :: 'a :: len word)) = ucast a - (ucast b :: ('a signed word))"
   apply (insert ucast_add[where a=a and b="-b"])
   apply (metis (no_types, hide_lams) add_diff_eq diff_add_cancel ucast_add)
   done
 
 lemma scast_ucast_add_one [simp]:
   "scast (ucast (x :: 'a::len word) + (1 :: 'a signed word)) = x + 1"
   apply (subst ucast_1[symmetric])
   apply (subst ucast_add[symmetric])
   apply clarsimp
   done
 
 lemma word_and_le_plus_one:
   "a > 0 \<Longrightarrow> (x :: 'a :: len word) && (a - 1) < a"
   by (simp add: gt0_iff_gem1 word_and_less')
 
 lemma unat_of_ucast_then_shift_eq_unat_of_shift[simp]:
   "LENGTH('b) \<ge> LENGTH('a)
    \<Longrightarrow> unat ((ucast (x :: 'a :: len word) :: 'b :: len word) >> n) = unat (x >> n)"
   by (simp add: shiftr_div_2n' unat_ucast_up_simp)
 
 lemma unat_of_ucast_then_mask_eq_unat_of_mask[simp]:
   "LENGTH('b) \<ge> LENGTH('a)
    \<Longrightarrow> unat ((ucast (x :: 'a :: len word) :: 'b :: len word) && mask m) = unat (x && mask m)"
   by (metis ucast_and_mask unat_ucast_up_simp)
 
 lemma small_powers_of_2:
   "x \<ge> 3 \<Longrightarrow> x < 2 ^ (x - 1)"
   by (induct x; simp add: suc_le_pow_2)
 
 lemma word_clz_sint_upper[simp]:
   "LENGTH('a) \<ge> 3 \<Longrightarrow> sint (of_nat (word_clz (w :: 'a :: len word)) :: 'a sword) \<le> int (LENGTH('a))"
   using small_powers_of_2
   by (smt One_nat_def diff_less le_less_trans len_gt_0 len_signed lessI n_less_equal_power_2
            not_msb_from_less of_nat_mono sint_eq_uint uint_nat unat_of_nat_eq unat_power_lower
            word_clz_max word_of_nat_less wsst_TYs(3))
 
 lemma word_clz_sint_lower[simp]:
   "LENGTH('a) \<ge> 3
    \<Longrightarrow> - sint (of_nat (word_clz (w :: 'a :: len word)) :: 'a signed word) \<le> int (LENGTH('a))"
   apply (subst sint_eq_uint)
    using small_powers_of_2 uint_nat
    apply (simp add: order_le_less_trans[OF word_clz_max] not_msb_from_less word_of_nat_less
                     word_size)
   by (simp add: uint_nat)
 
 lemma shiftr_less_t2n3:
   "\<lbrakk> (2 :: 'a word) ^ (n + m) = 0; m < LENGTH('a) \<rbrakk>
    \<Longrightarrow> (x :: 'a :: len word) >> n < 2 ^ m"
-  by (fastforce intro: shiftr_less_t2n' simp: mask_def power_overflow)
+  by (fastforce intro: shiftr_less_t2n' simp: mask_eq_decr_exp power_overflow)
 
 lemma unat_shiftr_le_bound:
   "\<lbrakk> 2 ^ (LENGTH('a :: len) - n) - 1 \<le> bnd; 0 < n \<rbrakk>
    \<Longrightarrow> unat ((x :: 'a word) >> n) \<le> bnd"
   using less_not_refl3 le_step_down_nat le_trans less_or_eq_imp_le word_shiftr_lt
   by (metis (no_types, lifting))
 
 lemma shiftr_eqD:
   "\<lbrakk> x >> n = y >> n; is_aligned x n; is_aligned y n \<rbrakk>
    \<Longrightarrow> x = y"
   by (metis is_aligned_shiftr_shiftl)
 
 lemma word_shiftr_shiftl_shiftr_eq_shiftr:
   "a \<ge> b \<Longrightarrow> (x :: 'a :: len word) >> a << b >> b = x >> a"
   by (simp add: mask_shift multi_shift_simps(5) shiftr_shiftr)
 
 lemma of_int_uint_ucast:
    "of_int (uint (x :: 'a::len word)) = (ucast x :: 'b::len word)"
-  by (simp add: ucast_def word_of_int)
+  by (simp add: ucast_eq word_of_int)
 
 lemma mod_mask_drop:
   "\<lbrakk> m = 2 ^ n; 0 < m; mask n && msk = mask n \<rbrakk>
    \<Longrightarrow> (x mod m) && msk = x mod m"
   by (simp add: word_mod_2p_is_mask word_bw_assocs)
 
 lemma mask_eq_ucast_eq:
   "\<lbrakk> x && mask LENGTH('a) = (x :: ('c :: len word));
      LENGTH('a) \<le> LENGTH('b)\<rbrakk>
     \<Longrightarrow> ucast (ucast x :: ('a :: len word)) = (ucast x :: ('b :: len word))"
   by (metis ucast_and_mask ucast_id ucast_ucast_mask ucast_up_eq)
 
 lemma of_nat_less_t2n:
   "of_nat i < (2 :: ('a :: len) word) ^ n \<Longrightarrow> n < LENGTH('a) \<and> unat (of_nat i :: 'a word) < 2 ^ n"
   by (metis order_less_trans p2_gt_0 unat_less_power word_neq_0_conv)
 
 lemma two_power_increasing_less_1:
   "\<lbrakk> n \<le> m; m \<le> LENGTH('a) \<rbrakk> \<Longrightarrow> (2 :: 'a :: len word) ^ n - 1 \<le> 2 ^ m - 1"
   by (metis diff_diff_cancel le_m1_iff_lt less_imp_diff_less p2_gt_0 two_power_increasing
             word_1_le_power word_le_minus_mono_left word_less_sub_1)
 
 lemma word_sub_mono4:
   "\<lbrakk> y + x \<le> z + x; y \<le> y + x; z \<le> z + x \<rbrakk> \<Longrightarrow> y \<le> z" for y :: "'a :: len word"
   by (simp add: word_add_le_iff2)
 
 lemma eq_or_less_helperD:
   "\<lbrakk> n = unat (2 ^ m - 1 :: 'a :: len word) \<or> n < unat (2 ^ m - 1 :: 'a word); m < LENGTH('a) \<rbrakk>
    \<Longrightarrow> n < 2 ^ m"
   by (meson le_less_trans nat_less_le unat_less_power word_power_less_1)
 
 lemma mask_sub:
   "n \<le> m \<Longrightarrow> mask m - mask n = mask m && ~~(mask n)"
   by (metis (full_types) and_mask_eq_iff_shiftr_0 mask_out_sub_mask shiftr_mask_le word_bw_comms(1))
 
 lemma neg_mask_diff_bound:
   "sz'\<le> sz \<Longrightarrow> (ptr && ~~(mask sz')) - (ptr && ~~(mask sz)) \<le> 2 ^ sz - 2 ^ sz'"
   (is "_ \<Longrightarrow> ?lhs \<le> ?rhs")
 proof -
   assume lt: "sz' \<le> sz"
   hence "?lhs = ptr && (mask sz && ~~(mask sz'))"
     by (metis add_diff_cancel_left' multiple_mask_trivia)
   also have "\<dots> \<le> ?rhs" using lt
     by (metis (mono_tags) add_diff_eq diff_eq_eq eq_iff mask_2pm1 mask_sub word_and_le')
   finally show ?thesis by simp
 qed
 
 lemma mask_range_subsetD:
   "\<lbrakk> p' \<in> mask_range p n; x' \<in> mask_range p' n'; n' \<le> n; is_aligned p n; is_aligned p' n' \<rbrakk> \<Longrightarrow>
    x' \<in> mask_range p n"
   using aligned_mask_step by fastforce
 
 lemma add_mult_in_mask_range:
   "\<lbrakk> is_aligned (base :: 'a :: len word) n; n < LENGTH('a); bits \<le> n; x < 2 ^ (n - bits) \<rbrakk>
    \<Longrightarrow> base + x * 2^bits \<in> mask_range base n"
   by (simp add: is_aligned_no_wrap' mask_2pm1 nasty_split_lt word_less_power_trans2
                 word_plus_mono_right)
 
 lemma of_bl_length2:
   "length xs + c < LENGTH('a) \<Longrightarrow> of_bl xs * 2^c < (2::'a::len word) ^ (length xs + c)"
   by (simp add: of_bl_length word_less_power_trans2)
 
 lemma mask_out_eq_0:
   "\<lbrakk> idx < 2 ^ sz; sz < LENGTH('a) \<rbrakk> \<Longrightarrow> (of_nat idx :: 'a :: len word) && ~~(mask sz) = 0"
   by (simp add: Word_Lemmas.of_nat_power less_mask_eq mask_eq_0_eq_x)
 
 lemma is_aligned_neg_mask_eq':
   "is_aligned ptr sz = (ptr && ~~(mask sz) = ptr)"
   using is_aligned_mask mask_eq_0_eq_x by blast
 
 lemma neg_mask_mask_unat:
   "sz < LENGTH('a)
    \<Longrightarrow> unat ((ptr :: 'a :: len word) && ~~(mask sz)) + unat (ptr && mask sz) = unat ptr"
   by (metis AND_NOT_mask_plus_AND_mask_eq unat_plus_simple word_and_le2)
 
 lemma unat_pow_le_intro:
   "LENGTH('a) \<le> n \<Longrightarrow> unat (x :: 'a :: len word) < 2 ^ n"
   by (metis lt2p_lem not_le of_nat_le_iff of_nat_numeral semiring_1_class.of_nat_power uint_nat)
 
 lemma unat_shiftl_less_t2n:
   "\<lbrakk> unat (x :: 'a :: len word) < 2 ^ (m - n); m < LENGTH('a) \<rbrakk> \<Longrightarrow> unat (x << n) < 2 ^ m"
   by (metis (no_types) Word_Lemmas.of_nat_power diff_le_self le_less_trans shiftl_less_t2n
                        unat_less_power word_unat.Rep_inverse)
 
 lemma unat_is_aligned_add:
   "\<lbrakk> is_aligned p n; unat d < 2 ^ n \<rbrakk>
    \<Longrightarrow> unat (p + d && mask n) = unat d \<and> unat (p + d && ~~(mask n)) = unat p"
   by (metis add.right_neutral and_mask_eq_iff_le_mask and_not_mask le_mask_iff mask_add_aligned
             mask_out_add_aligned mult_zero_right shiftl_t2n shiftr_le_0)
 
 lemma unat_shiftr_shiftl_mask_zero:
   "\<lbrakk> c + a \<ge> LENGTH('a) + b ; c < LENGTH('a) \<rbrakk>
    \<Longrightarrow> unat (((q :: 'a :: len word) >> a << b) && ~~(mask c)) = 0"
   by (fastforce intro: unat_is_aligned_add[where p=0 and n=c, simplified, THEN conjunct2]
                        unat_shiftl_less_t2n unat_shiftr_less_t2n unat_pow_le_intro)
 
 lemmas of_nat_ucast = ucast_of_nat[symmetric]
 
 lemma shift_then_mask_eq_shift_low_bits:
   "x \<le> mask (low_bits + high_bits) \<Longrightarrow> (x >> low_bits) && mask high_bits = x >> low_bits"
   by (simp add: leq_mask_shift le_mask_imp_and_mask)
 
 lemma leq_low_bits_iff_zero:
   "\<lbrakk> x \<le> mask (low bits + high bits); x >> low_bits = 0 \<rbrakk> \<Longrightarrow> (x && mask low_bits = 0) = (x = 0)"
   using and_mask_eq_iff_shiftr_0 by force
 
 lemma unat_less_iff:
   "\<lbrakk> unat (a :: 'a :: len word) = b; c < 2 ^ LENGTH('a) \<rbrakk> \<Longrightarrow> (a < of_nat c) = (b < c)"
   using unat_ucast_less_no_overflow_simp by blast
 
 lemma is_aligned_no_overflow3:
  "\<lbrakk> is_aligned (a :: 'a :: len word) n; n < LENGTH('a); b < 2 ^ n; c \<le> 2 ^ n; b < c \<rbrakk>
   \<Longrightarrow> a + b \<le> a + (c - 1)"
   by (meson is_aligned_no_wrap' le_m1_iff_lt not_le word_less_sub_1 word_plus_mono_right)
 
 lemma mask_add_aligned_right:
   "is_aligned p n \<Longrightarrow> (q + p) && mask n = q && mask n"
   by (simp add: mask_add_aligned add.commute)
 
 lemma leq_high_bits_shiftr_low_bits_leq_bits_mask:
   "x \<le> mask high_bits \<Longrightarrow> (x :: 'a :: len word) << low_bits \<le> mask (low_bits + high_bits)"
   by (metis le_mask_shiftl_le_mask)
 
 lemma from_to_bool_last_bit:
   "from_bool (to_bool (x && 1)) = x && 1"
   by (metis from_bool_to_bool_iff word_and_1)
 
 lemma word_two_power_neg_ineq:
   "2 ^ m \<noteq> (0 :: 'a word) \<Longrightarrow> 2 ^ n \<le> - (2 ^ m :: 'a :: len word)"
   apply (cases "n < LENGTH('a)"; simp add: power_overflow)
   apply (cases "m < LENGTH('a)"; simp add: power_overflow)
   apply (simp add: word_le_nat_alt unat_minus word_size)
   apply (cases "LENGTH('a)"; simp)
   apply (simp add: less_Suc_eq_le)
   apply (drule power_increasing[where a=2 and n=n] power_increasing[where a=2 and n=m], simp)+
   apply (drule(1) add_le_mono)
   apply simp
   done
 
 lemma unat_shiftl_absorb:
   "\<lbrakk> x \<le> 2 ^ p; p + k < LENGTH('a) \<rbrakk> \<Longrightarrow> unat (x :: 'a :: len word) * 2 ^ k = unat (x * 2 ^ k)"
   by (smt add_diff_cancel_right' add_lessD1 le_add2 le_less_trans mult.commute nat_le_power_trans
           unat_lt2p unat_mult_lem unat_power_lower word_le_nat_alt)
 
 lemma word_plus_mono_right_split:
   "\<lbrakk> unat ((x :: 'a :: len word) && mask sz) + unat z < 2 ^ sz; sz < LENGTH('a) \<rbrakk>
    \<Longrightarrow> x \<le> x + z"
   apply (subgoal_tac "(x && ~~(mask sz)) + (x && mask sz) \<le> (x && ~~(mask sz)) + ((x && mask sz) + z)")
    apply (simp add:word_plus_and_or_coroll2 field_simps)
   apply (rule word_plus_mono_right)
    apply (simp add: less_le_trans no_olen_add_nat)
   using Word_Lemmas.of_nat_power is_aligned_no_wrap' by force
 
 lemma mul_not_mask_eq_neg_shiftl:
   "~~(mask n) = -1 << n"
   by (simp add: NOT_mask shiftl_t2n)
 
 lemma shiftr_mul_not_mask_eq_and_not_mask:
   "(x >> n) * ~~(mask n) = - (x && ~~(mask n))"
   by (metis NOT_mask and_not_mask mult_minus_left semiring_normalization_rules(7) shiftl_t2n)
 
 lemma mask_eq_n1_shiftr:
   "n \<le> LENGTH('a) \<Longrightarrow> (mask n :: 'a :: len word) = -1 >> (LENGTH('a) - n)"
   by (metis diff_diff_cancel eq_refl mask_full shiftr_mask2)
 
 lemma is_aligned_mask_out_add_eq:
   "is_aligned p n \<Longrightarrow> (p + x) && ~~(mask n) = p + (x && ~~(mask n))"
   by (simp add: mask_out_sub_mask mask_add_aligned)
 
 lemmas is_aligned_mask_out_add_eq_sub
     = is_aligned_mask_out_add_eq[where x="a - b" for a b, simplified field_simps]
 
 lemma aligned_bump_down:
   "is_aligned x n \<Longrightarrow> (x - 1) && ~~(mask n) = x - 2 ^ n"
   by (drule is_aligned_mask_out_add_eq[where x="-1"]) (simp add: NOT_mask)
 
 lemma unat_2tp_if:
   "unat (2 ^ n :: ('a :: len) word) = (if n < LENGTH ('a) then 2 ^ n else 0)"
   by (split if_split, simp_all add: power_overflow)
 
 lemma mask_of_mask:
   "mask (n::nat) && mask (m::nat) = mask (min m n)"
   by word_eqI_solve
 
 lemma unat_signed_ucast_less_ucast:
   "LENGTH('a) \<le> LENGTH('b) \<Longrightarrow> unat (ucast (x :: 'a :: len word) :: 'b :: len signed word) = unat x"
   by (simp add: unat_ucast_up_simp)
 
 lemma toEnum_of_ucast:
   "LENGTH('b) \<le> LENGTH('a) \<Longrightarrow>
    (toEnum (unat (b::'b :: len word))::'a :: len word) = of_nat (unat b)"
   by (simp add: unat_pow_le_intro)
 
 lemmas unat_ucast_mask = unat_ucast_eq_unat_and_mask[where w=a for a]
 
 lemma t2n_mask_eq_if:
   "2 ^ n && mask m = (if n < m then 2 ^ n else 0)"
   by (rule word_eqI, auto simp add: word_size nth_w2p split: if_split)
 
 lemma unat_ucast_le:
   "unat (ucast (x :: 'a :: len word) :: 'b :: len word) \<le> unat x"
   by (simp add: ucast_nat_def word_unat_less_le)
 
 lemma ucast_le_up_down_iff:
   "\<lbrakk> LENGTH('a) \<le> LENGTH('b); (x :: 'b :: len word) \<le> ucast (max_word :: 'a :: len word) \<rbrakk>
    \<Longrightarrow> (ucast x \<le> (y :: 'a word)) = (x \<le> ucast y)"
   using le_max_word_ucast_id ucast_le_ucast by metis
 
 lemma ucast_ucast_mask_shift:
   "a \<le> LENGTH('a) + b
    \<Longrightarrow> ucast (ucast (p && mask a >> b) :: 'a :: len word) = p && mask a >> b"
   by (metis add.commute le_mask_iff shiftr_mask_le ucast_ucast_eq_mask_shift word_and_le')
 
 lemma unat_ucast_mask_shift:
   "a \<le> LENGTH('a) + b
    \<Longrightarrow> unat (ucast (p && mask a >> b) :: 'a :: len word) = unat (p && mask a >> b)"
   by (metis linear ucast_ucast_mask_shift unat_ucast_up_simp)
 
 lemma mask_overlap_zero:
   "a \<le> b \<Longrightarrow> (p && mask a) && ~~(mask b) = 0"
   by (metis NOT_mask_AND_mask mask_lower_twice2 max_def)
 
 lemma mask_shifl_overlap_zero:
   "a + c \<le> b \<Longrightarrow> (p && mask a << c) && ~~(mask b) = 0"
   by (metis and_mask_0_iff_le_mask mask_mono mask_shiftl_decompose order_trans shiftl_over_and_dist word_and_le' word_and_le2)
 
 lemma mask_overlap_zero':
   "a \<ge> b \<Longrightarrow> (p && ~~(mask a)) && mask b = 0"
   using mask_AND_NOT_mask mask_AND_less_0 by blast
 
 lemma mask_rshift_mult_eq_rshift_lshift:
   "((a :: 'a :: len word) >> b) * (1 << c) = (a >> b << c)"
   by (simp add: shiftl_t2n)
 
 lemma shift_alignment:
   "a \<ge> b \<Longrightarrow> is_aligned (p >> a << a) b"
   using is_aligned_shift is_aligned_weaken by blast
 
 lemma mask_split_sum_twice:
   "a \<ge> b \<Longrightarrow> (p && ~~(mask a)) + ((p && mask a) && ~~(mask b)) + (p && mask b) = p"
   by (simp add: add.commute multiple_mask_trivia word_bw_comms(1) word_bw_lcs(1) word_plus_and_or_coroll2)
 
 lemma mask_shift_eq_mask_mask:
   "(p && mask a >> b << b) = (p && mask a) && ~~(mask b)"
   by (simp add: and_not_mask)
 
 lemma mask_shift_sum:
   "\<lbrakk> a \<ge> b; unat n = unat (p && mask b) \<rbrakk>
    \<Longrightarrow> (p && ~~(mask a)) + (p && mask a >> b) * (1 << b) + n = (p :: 'a :: len word)"
   by (metis and_not_mask mask_rshift_mult_eq_rshift_lshift mask_split_sum_twice word_unat.Rep_eqD)
 
 lemma is_up_compose:
   "\<lbrakk> is_up uc; is_up uc' \<rbrakk> \<Longrightarrow> is_up (uc' \<circ> uc)"
   unfolding is_up_def by (simp add: Word.target_size Word.source_size)
 
 lemma of_int_sint_scast:
   "of_int (sint (x :: 'a :: len word)) = (scast x :: 'b :: len word)"
-  by (metis scast_def word_of_int)
+  by (metis scast_eq word_of_int)
 
 lemma scast_of_nat_to_signed [simp]:
   "scast (of_nat x :: 'a :: len word) = (of_nat x :: 'a signed word)"
   by (metis cast_simps(23) scast_scast_id(2))
 
 lemma scast_of_nat_signed_to_unsigned_add:
   "scast (of_nat x + of_nat y :: 'a :: len signed word) = (of_nat x + of_nat y :: 'a :: len word)"
   by (metis of_nat_add scast_of_nat)
 
 lemma scast_of_nat_unsigned_to_signed_add:
   "(scast (of_nat x + of_nat y :: 'a :: len word)) = (of_nat x + of_nat y :: 'a :: len signed word)"
   by (metis Abs_fnat_hom_add scast_of_nat_to_signed)
 
 lemma and_mask_cases:
   fixes x :: "'a :: len word"
   assumes len: "n < LENGTH('a)"
   shows "x && mask n \<in> of_nat ` set [0 ..< 2 ^ n]"
 proof -
   have "x && mask n \<in> {0 .. 2 ^ n - 1}"
-    by (simp add: mask_def word_and_le1)
+    by (simp add: mask_eq_decr_exp word_and_le1)
   also
   have "... = of_nat ` {0 .. 2 ^ n - 1}"
     apply (rule set_eqI, rule iffI)
      apply (clarsimp simp: image_iff)
      apply (rule_tac x="unat x" in bexI; simp)
      using len
      apply (simp add: word_le_nat_alt unat_2tp_if unat_minus_one)
     using len
     apply (clarsimp simp: word_le_nat_alt unat_2tp_if unat_minus_one)
     apply (subst unat_of_nat_eq; simp add: nat_le_Suc_less)
     apply (erule less_le_trans)
     apply simp
     done
   also have "{0::nat .. 2^n - 1} = set [0 ..< 2^n]" by (auto simp: nat_le_Suc_less)
   finally show ?thesis .
 qed
 
 lemma sint_of_nat_ge_zero:
   "x < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> sint (of_nat x :: 'a :: len word) \<ge> 0"
   by (simp add: Word_Lemmas.of_nat_power not_msb_from_less sint_eq_uint)
 
 lemma sint_eq_uint_2pl:
   "\<lbrakk> (a :: 'a :: len word) < 2 ^ (LENGTH('a) - 1) \<rbrakk>
    \<Longrightarrow> sint a = uint a"
   by (simp add: not_msb_from_less sint_eq_uint word_2p_lem word_size)
 
 lemma sint_of_nat_le:
   "\<lbrakk> b < 2 ^ (LENGTH('a) - 1); a \<le> b \<rbrakk>
    \<Longrightarrow> sint (of_nat a :: 'a :: len word) \<le> sint (of_nat b :: 'a :: len word)"
   by (smt Word_Lemmas.of_nat_power diff_less le_less_trans len_gt_0 len_of_numeral_defs(2)
           nat_power_minus_less of_nat_le_iff sint_eq_uint_2pl uint_nat unat_of_nat_len)
 
 lemma int_eq_sint:
   "x < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> sint (of_nat x :: 'a :: len word) = int x"
   by (smt Word_Lemmas.of_nat_power diff_less le_less_trans len_gt_0 len_of_numeral_defs(2)
           nat_less_le sint_eq_uint_2pl uint_nat unat_lt2p unat_of_nat_len unat_power_lower)
 
 lemma sint_ctz:
   "LENGTH('a) > 2
    \<Longrightarrow> 0 \<le> sint (of_nat (word_ctz (x :: 'a :: len word)) :: 'a signed word)
         \<and> sint (of_nat (word_ctz x) :: 'a signed word) \<le> int (LENGTH('a))"
   apply (subgoal_tac "LENGTH('a) < 2 ^ (LENGTH('a) - 1)")
    apply (rule conjI)
     apply (metis len_signed order_le_less_trans sint_of_nat_ge_zero word_ctz_le)
    apply (metis int_eq_sint len_signed sint_of_nat_le word_ctz_le)
   by (rule small_powers_of_2, simp)
 
 lemma pow_sub_less:
   "\<lbrakk> a + b \<le> LENGTH('a); unat (x :: 'a :: len word) = 2 ^ a \<rbrakk>
    \<Longrightarrow> unat (x * 2 ^ b - 1) < 2 ^ (a + b)"
   by (metis (mono_tags) eq_or_less_helperD not_less of_nat_numeral power_add
                         semiring_1_class.of_nat_power unat_pow_le_intro word_unat.Rep_inverse)
 
 lemma sle_le_2pl:
   "\<lbrakk> (b :: 'a :: len word) < 2 ^ (LENGTH('a) - 1); a \<le> b \<rbrakk> \<Longrightarrow> a <=s b"
   by (simp add: not_msb_from_less word_sle_msb_le)
 
 lemma sless_less_2pl:
   "\<lbrakk> (b :: 'a :: len word) < 2 ^ (LENGTH('a) - 1); a < b \<rbrakk> \<Longrightarrow> a <s b"
   using not_msb_from_less word_sless_msb_less by blast
 
 lemma and_mask2:
   "w << n >> n = w && mask (size w - n)"
   by (cases "n \<le> size w"; clarsimp simp: word_and_le2 and_mask shiftl_zero_size)
 
 lemma unat_of_nat_word_log2:
   "LENGTH('a) < 2 ^ LENGTH('b)
    \<Longrightarrow> unat (of_nat (word_log2 (n :: 'a :: len word)) :: 'b :: len word) = word_log2 n"
   by (metis less_trans unat_of_nat_eq word_log2_max word_size)
 
 lemma aligned_sub_aligned_simple:
   "\<lbrakk> is_aligned a n; is_aligned b n \<rbrakk> \<Longrightarrow> is_aligned (a - b) n"
   by (simp add: aligned_sub_aligned)
 
 lemma minus_one_shift:
   "- (1 << n) = (-1 << n :: 'a::len word)"
-  by (simp add: mask_def NOT_eq flip: mul_not_mask_eq_neg_shiftl)
+  by (simp add: mask_eq_decr_exp NOT_eq flip: mul_not_mask_eq_neg_shiftl)
 
 lemma ucast_eq_mask:
   "(UCAST('a::len \<rightarrow> 'b::len) x = UCAST('a \<rightarrow> 'b) y) =
    (x && mask LENGTH('b) = y && mask LENGTH('b))"
   by (rule iffI; word_eqI_solve)
 
 context
   fixes w :: "'a::len word"
 begin
 
 private lemma sbintrunc_uint_ucast:
   assumes "Suc n = LENGTH('b::len)"
   shows "sbintrunc n (uint (ucast w :: 'b word)) = sbintrunc n (uint w)"
-  by (metis assms sbintrunc_bintrunc ucast_def word_ubin.eq_norm)
+  by (metis assms sbintrunc_bintrunc ucast_eq word_ubin.eq_norm)
 
 private lemma test_bit_sbintrunc:
   assumes "i < LENGTH('a)"
   shows "(word_of_int (sbintrunc n (uint w)) :: 'a word) !! i
            = (if n < i then w !! n else w !! i)"
   using assms by (simp add: nth_sbintr)
                  (simp add: test_bit_bin)
 
 private lemma test_bit_sbintrunc_ucast:
   assumes len_a: "i < LENGTH('a)"
   shows "(word_of_int (sbintrunc (LENGTH('b) - 1) (uint (ucast w :: 'b word))) :: 'a word) !! i
           = (if LENGTH('b::len) \<le> i then w !! (LENGTH('b) - 1) else w !! i)"
   apply (subst sbintrunc_uint_ucast)
    apply simp
   apply (subst test_bit_sbintrunc)
    apply (rule len_a)
   apply (rule if_cong[OF _ refl refl])
   using leD less_linear by fastforce
 
 lemma scast_ucast_high_bits:
   "scast (ucast w :: 'b::len word) = w
      \<longleftrightarrow> (\<forall> i \<in> {LENGTH('b) ..< size w}. w !! i = w !! (LENGTH('b) - 1))"
-  unfolding scast_def sint_uint word_size
+  unfolding scast_eq sint_uint word_size
   apply (subst word_eq_iff)
   apply (rule iffI)
    apply (rule ballI)
    apply (drule_tac x=i in spec)
    apply (subst (asm) test_bit_sbintrunc_ucast; simp)
   apply (rule allI)
   apply (case_tac "n < LENGTH('a)")
    apply (subst test_bit_sbintrunc_ucast)
     apply simp
    apply (case_tac "n \<ge> LENGTH('b)")
     apply (drule_tac x=n in bspec)
   by auto
 
 lemma scast_ucast_mask_compare:
   "scast (ucast w :: 'b::len word) = w
    \<longleftrightarrow> (w \<le> mask (LENGTH('b) - 1) \<or> ~~(mask (LENGTH('b) - 1)) \<le> w)"
   apply (clarsimp simp: le_mask_high_bits neg_mask_le_high_bits scast_ucast_high_bits word_size)
   apply (rule iffI; clarsimp)
    apply (rename_tac i j; case_tac "i = LENGTH('b) - 1"; case_tac "j = LENGTH('b) - 1")
   by auto
 
 lemma ucast_less_shiftl_helper':
   "\<lbrakk> LENGTH('b) + (a::nat) < LENGTH('a); 2 ^ (LENGTH('b) + a) \<le> n\<rbrakk>
    \<Longrightarrow> (ucast (x :: 'b::len word) << a) < (n :: 'a::len word)"
   apply (erule order_less_le_trans[rotated])
   using ucast_less[where x=x and 'a='a]
   apply (simp only: shiftl_t2n field_simps)
   apply (rule word_less_power_trans2; simp)
   done
 
 end
 
 lemma ucast_ucast_mask2:
   "is_down (UCAST ('a \<rightarrow> 'b)) \<Longrightarrow>
    UCAST ('b::len \<rightarrow> 'c::len) (UCAST ('a::len \<rightarrow> 'b::len) x) = UCAST ('a \<rightarrow> 'c) (x && mask LENGTH('b))"
   by word_eqI_solve
 
 lemma ucast_NOT:
   "ucast (~~x) = ~~(ucast x) && mask (LENGTH('a))" for x::"'a::len word"
   by word_eqI
 
 lemma ucast_NOT_down:
   "is_down UCAST('a::len \<rightarrow> 'b::len) \<Longrightarrow> UCAST('a \<rightarrow> 'b) (~~x) = ~~(UCAST('a \<rightarrow> 'b) x)"
   by word_eqI
 
 lemma of_bl_mult_and_not_mask_eq:
   "\<lbrakk>is_aligned (a :: 'a::len word) n; length b + m \<le> n\<rbrakk>
    \<Longrightarrow> a + of_bl b * (2^m) && ~~(mask n) = a"
   by (smt add.left_neutral add_diff_cancel_right' add_mask_lower_bits and_mask_plus is_aligned_mask
           is_aligned_weaken le_less_trans of_bl_length2 subtract_mask(1))
 
 lemma bin_to_bl_of_bl_eq:
   "\<lbrakk>is_aligned (a::'a::len word) n; length b + c \<le> n; length b + c < LENGTH('a)\<rbrakk>
   \<Longrightarrow> bin_to_bl (length b) (uint ((a + of_bl b * 2^c) >> c)) = b"
   apply (subst word_plus_and_or_coroll)
    apply (erule is_aligned_get_word_bits)
     apply (rule is_aligned_AND_less_0)
      apply (simp add: is_aligned_mask)
     apply (rule order_less_le_trans)
      apply (rule of_bl_length2)
      apply simp
     apply (simp add: two_power_increasing)
    apply simp
   apply (rule nth_equalityI)
    apply (simp only: len_bin_to_bl)
   apply (clarsimp simp only: len_bin_to_bl nth_bin_to_bl word_test_bit_def[symmetric])
   apply (simp add: nth_shiftr nth_shiftl
                    shiftl_t2n[where n=c, simplified mult.commute, simplified, symmetric])
   apply (simp add: is_aligned_nth[THEN iffD1, rule_format] test_bit_of_bl rev_nth)
   apply arith
   done
 
 end
diff --git a/thys/Word_Lib/Word_Lemmas_32.thy b/thys/Word_Lib/Word_Lemmas_32.thy
--- a/thys/Word_Lib/Word_Lemmas_32.thy
+++ b/thys/Word_Lib/Word_Lemmas_32.thy
@@ -1,319 +1,305 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Lemmas for Word Length 32"
 
 theory Word_Lemmas_32
 imports
   Word_Lemmas
   Word_Setup_32
 begin
 
 lemma ucast_8_32_inj:
   "inj (ucast ::  8 word \<Rightarrow> 32 word)"
   by (rule down_ucast_inj) (clarsimp simp: is_down_def target_size source_size)
 
 lemma upto_2_helper:
   "{0..<2 :: 32 word} = {0, 1}"
   by (safe; simp) unat_arith
 
 lemmas upper_bits_unset_is_l2p_32 = upper_bits_unset_is_l2p [where 'a=32, folded word_bits_def]
 lemmas le_2p_upper_bits_32 = le_2p_upper_bits [where 'a=32, folded word_bits_def]
 lemmas le2p_bits_unset_32 = le2p_bits_unset[where 'a=32, folded word_bits_def]
 
 lemma word_bits_len_of:
   "len_of TYPE (32) = word_bits"
   by (simp add: word_bits_conv)
 
 lemmas unat_power_lower32' = unat_power_lower[where 'a=32]
 lemmas unat_power_lower32 [simp] = unat_power_lower32'[unfolded word_bits_len_of]
 
 lemmas word32_less_sub_le' = word_less_sub_le[where 'a = 32]
 lemmas word32_less_sub_le[simp] = word32_less_sub_le' [folded word_bits_def]
 
 lemma word_bits_size:
   "size (w::word32) = word_bits"
   by (simp add: word_bits_def word_size)
 
 lemmas word32_power_less_1' = word_power_less_1[where 'a = 32]
 lemmas word32_power_less_1[simp] = word32_power_less_1'[folded word_bits_def]
 
 lemma of_nat32_0:
   "\<lbrakk>of_nat n = (0::word32); n < 2 ^ word_bits\<rbrakk> \<Longrightarrow> n = 0"
   by (erule of_nat_0, simp add: word_bits_def)
 
 lemma unat_mask_2_less_4:
   "unat (p && mask 2 :: word32) < 4"
   apply (rule unat_less_helper)
   apply (rule order_le_less_trans, rule word_and_le1)
-  apply (simp add: mask_def)
+  apply (simp add: mask_eq)
   done
 
 lemmas unat_of_nat32' = unat_of_nat_eq[where 'a=32]
 lemmas unat_of_nat32 = unat_of_nat32'[unfolded word_bits_len_of]
 
 lemmas word_power_nonzero_32 = word_power_nonzero [where 'a=32, folded word_bits_def]
 
 lemmas unat_mult_simple = iffD1 [OF unat_mult_lem [where 'a = 32, unfolded word_bits_len_of]]
 
 lemmas div_power_helper_32 = div_power_helper [where 'a=32, folded word_bits_def]
 
 lemma n_less_word_bits:
   "(n < word_bits) = (n < 32)"
   by (simp add: word_bits_def)
 
 lemmas of_nat_less_pow_32 = of_nat_power [where 'a=32, folded word_bits_def]
 
 lemma lt_word_bits_lt_pow:
   "sz < word_bits \<Longrightarrow> sz < 2 ^ word_bits"
   by (simp add: word_bits_conv)
 
 lemma unat_less_word_bits:
   fixes y :: word32
   shows "x < unat y \<Longrightarrow> x < 2 ^ word_bits"
   unfolding word_bits_def
   by (rule order_less_trans [OF _ unat_lt2p])
 
 lemmas unat_mask_word32' = unat_mask[where 'a=32]
 lemmas unat_mask_word32 = unat_mask_word32'[folded word_bits_def]
 
 lemma unat_less_2p_word_bits:
   "unat (x :: 32 word) < 2 ^ word_bits"
   apply (simp only: word_bits_def)
   apply (rule unat_lt2p)
   done
 
 lemma Suc_unat_mask_div:
   "Suc (unat (mask sz div word_size::word32)) = 2 ^ (min sz word_bits - 2)"
   apply (case_tac "sz < word_bits")
    apply (case_tac "2\<le>sz")
-    apply (clarsimp simp: word_size_def word_bits_def min_def mask_def)
+    apply (clarsimp simp: word_size_def word_bits_def min_def mask_eq)
     apply (drule (2) Suc_div_unat_helper
            [where 'a=32 and sz=sz and us=2, simplified, symmetric])
    apply (simp add: not_le word_size_def word_bits_def)
    apply (case_tac sz, simp add: unat_word_ariths)
    apply (case_tac nat, simp add: unat_word_ariths
                                   unat_mask_word32 min_def word_bits_def)
    apply simp
   apply (simp add: unat_word_ariths
                    unat_mask_word32 min_def word_bits_def word_size_def)
   done
 
 lemmas word32_minus_one_le' = word_minus_one_le[where 'a=32]
 lemmas word32_minus_one_le = word32_minus_one_le'[simplified]
 
 lemma ucast_not_helper:
   fixes a::word8
   assumes a: "a \<noteq> 0xFF"
   shows "ucast a \<noteq> (0xFF::word32)"
 proof
   assume "ucast a = (0xFF::word32)"
   also
   have "(0xFF::word32) = ucast (0xFF::word8)" by simp
   finally
   show False using a
     apply -
     apply (drule up_ucast_inj, simp)
     apply simp
     done
 qed
 
 lemma less_4_cases:
   "(x::word32) < 4 \<Longrightarrow> x=0 \<or> x=1 \<or> x=2 \<or> x=3"
   apply clarsimp
   apply (drule word_less_cases, erule disjE, simp, simp)+
   done
 
 lemma unat_ucast_8_32:
   fixes x :: "word8"
   shows "unat (ucast x :: word32) = unat x"
-  unfolding ucast_def unat_def
-  apply (subst int_word_uint)
-  apply (subst mod_pos_pos_trivial)
-    apply simp
-   apply (rule lt2p_lem)
-   apply simp
-  apply simp
-  done
+  by transfer simp
 
 lemma if_then_1_else_0:
   "((if P then 1 else 0) = (0 :: word32)) = (\<not> P)"
   by simp
 
 lemma if_then_0_else_1:
   "((if P then 0 else 1) = (0 :: word32)) = (P)"
   by simp
 
 lemmas if_then_simps = if_then_0_else_1 if_then_1_else_0
 
 lemma ucast_le_ucast_8_32:
   "(ucast x \<le> (ucast y :: word32)) = (x \<le> (y :: word8))"
   by (simp add: ucast_le_ucast)
 
 lemma in_16_range:
   "0 \<in> S \<Longrightarrow> r \<in> (\<lambda>x. r + x * (16 :: word32)) ` S"
   "n - 1 \<in> S \<Longrightarrow> (r + (16 * n - 16)) \<in> (\<lambda>x :: word32. r + x * 16) ` S"
   by (clarsimp simp: image_def elim!: bexI[rotated])+
 
 lemma eq_2_32_0:
   "(2 ^ 32 :: word32) = 0"
   by simp
 
 lemma x_less_2_0_1:
   fixes x :: word32 shows
   "x < 2 \<Longrightarrow> x = 0 \<or> x = 1"
   by (rule x_less_2_0_1') auto
 
 lemmas mask_32_max_word  = max_word_mask [symmetric, where 'a=32, simplified]
 
 lemma of_nat32_n_less_equal_power_2:
  "n < 32 \<Longrightarrow> ((of_nat n)::32 word) < 2 ^ n"
   by (rule of_nat_n_less_equal_power_2, clarsimp simp: word_size)
 
 lemma word_rsplit_0:
   "word_rsplit (0 :: word32) = [0, 0, 0, 0 :: word8]"
   by (simp add: word_rsplit_def bin_rsplit_def)
 
 lemma unat_ucast_10_32 :
   fixes x :: "10 word"
   shows "unat (ucast x :: word32) = unat x"
-  unfolding ucast_def unat_def
-  apply (subst int_word_uint)
-  apply (subst mod_pos_pos_trivial)
-    apply simp
-   apply (rule lt2p_lem)
-   apply simp
-  apply simp
-  done
+  by transfer simp
 
 lemma bool_mask [simp]:
   fixes x :: word32
   shows "(0 < x && 1) = (x && 1 = 1)"
   by (rule bool_mask') auto
 
 lemma word32_bounds:
   "- (2 ^ (size (x :: word32) - 1)) = (-2147483648 :: int)"
   "((2 ^ (size (x :: word32) - 1)) - 1) = (2147483647 :: int)"
   "- (2 ^ (size (y :: 32 signed word) - 1)) = (-2147483648 :: int)"
   "((2 ^ (size (y :: 32 signed word) - 1)) - 1) = (2147483647 :: int)"
   by (simp_all add: word_size)
 
 lemma word_ge_min:"sint (x::32 word) \<ge> -2147483648"
   by (metis sint_ge word32_bounds(1) word_size)
 
 lemmas signed_arith_ineq_checks_to_eq_word32'
     = signed_arith_ineq_checks_to_eq[where 'a=32]
       signed_arith_ineq_checks_to_eq[where 'a="32 signed"]
 
 lemmas signed_arith_ineq_checks_to_eq_word32
     = signed_arith_ineq_checks_to_eq_word32' [unfolded word32_bounds]
 
 lemmas signed_mult_eq_checks32_to_64'
     = signed_mult_eq_checks_double_size[where 'a=32 and 'b=64]
       signed_mult_eq_checks_double_size[where 'a="32 signed" and 'b=64]
 
 lemmas signed_mult_eq_checks32_to_64 = signed_mult_eq_checks32_to_64'[simplified]
 
 lemmas sdiv_word32_max' = sdiv_word_max [where 'a=32] sdiv_word_max [where 'a="32 signed"]
 lemmas sdiv_word32_max = sdiv_word32_max'[simplified word_size, simplified]
 
 lemmas sdiv_word32_min' = sdiv_word_min [where 'a=32] sdiv_word_min [where 'a="32 signed"]
 lemmas sdiv_word32_min = sdiv_word32_min' [simplified word_size, simplified]
 
 lemmas sint32_of_int_eq' = sint_of_int_eq [where 'a=32]
 lemmas sint32_of_int_eq = sint32_of_int_eq' [simplified]
 
 lemma ucast_of_nats [simp]:
   "(ucast (of_nat x :: word32) :: sword32) = (of_nat x)"
   "(ucast (of_nat x :: word32) :: sword16) = (of_nat x)"
   "(ucast (of_nat x :: word32) :: sword8) = (of_nat x)"
   "(ucast (of_nat x :: word16) :: sword16) = (of_nat x)"
   "(ucast (of_nat x :: word16) :: sword8) = (of_nat x)"
   "(ucast (of_nat x :: word8) :: sword8) = (of_nat x)"
   by (auto simp: ucast_of_nat is_down)
 
 lemmas signed_shift_guard_simpler_32'
     = power_strict_increasing_iff[where b="2 :: nat" and y=31]
 lemmas signed_shift_guard_simpler_32 = signed_shift_guard_simpler_32'[simplified]
 
 lemma word32_31_less:
   "31 < len_of TYPE (32 signed)" "31 > (0 :: nat)"
   "31 < len_of TYPE (32)" "31 > (0 :: nat)"
   by auto
 
 lemmas signed_shift_guard_to_word_32
     = signed_shift_guard_to_word[OF word32_31_less(1-2)]
     signed_shift_guard_to_word[OF word32_31_less(3-4)]
 
 lemma le_step_down_word_3:
   fixes x :: "32 word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y; y < 2 ^ 32 - 1\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (rule le_step_down_word_2, assumption+)
 
 lemma shiftr_1:
   "(x::word32) >> 1 = 0 \<Longrightarrow> x < 2"
   by word_bitwise clarsimp
 
 lemma has_zero_byte:
   "~~ (((((v::word32) && 0x7f7f7f7f) + 0x7f7f7f7f) || v) || 0x7f7f7f7f) \<noteq> 0
     \<Longrightarrow> v && 0xff000000 = 0 \<or> v && 0xff0000 = 0 \<or> v && 0xff00 = 0 \<or> v && 0xff = 0"
   apply clarsimp
   apply word_bitwise
   by metis
 
 lemma mask_step_down_32:
   \<open>\<exists>x. mask x = b\<close> if \<open>b && 1 = 1\<close>
     and \<open>\<exists>x. x < 32 \<and> mask x = b >> 1\<close> for b :: \<open>32word\<close>
 proof -
   from \<open>b && 1 = 1\<close> have \<open>odd b\<close>
     by (auto simp add: mod_2_eq_odd and_one_eq)
   then have \<open>b mod 2 = 1\<close>
     using odd_iff_mod_2_eq_one by blast
   from \<open>\<exists>x. x < 32 \<and> mask x = b >> 1\<close> obtain x where \<open>x < 32\<close> \<open>mask x = b >> 1\<close> by blast
   then have \<open>mask x = b div 2\<close>
     using shiftr1_is_div_2 [of b] by simp
   with \<open>b mod 2 = 1\<close> have \<open>2 * mask x + 1 = 2 * (b div 2) + b mod 2\<close>
     by (simp only:) 
   also have \<open>\<dots> = b\<close>
     by (simp add: mult_div_mod_eq)
   finally have \<open>2 * mask x + 1 = b\<close> .
   moreover have \<open>mask (Suc x) = 2 * mask x + 1\<close>
     by (metis (no_types, lifting) Groups.add_ac(2) Groups.add_ac(3) diff_add_cancel mask_2pm1 mask_Suc mult_2)
   ultimately show ?thesis
     by auto
 qed
 
 lemma unat_of_int_32:
   "\<lbrakk>i \<ge> 0; i \<le>2 ^ 31\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword32)) = nat i"
-  unfolding unat_def
+  unfolding unat_eq_nat_uint
   apply (subst eq_nat_nat_iff, clarsimp+)
   apply (simp add: word_of_int uint_word_of_int)
   done
 
 lemmas word_ctz_not_minus_1_32 = word_ctz_not_minus_1[where 'a=32, simplified]
 
 (* Helper for packing then unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64[simp]:
   "(((ucast ((ucast (x::64 word))::32 word))::64 word) || (((ucast ((ucast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_assemble_id)
 
 (* Another variant of packing and unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64'[simp]:
   "(((ucast ((scast (x::64 word))::32 word))::64 word) || (((ucast ((scast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_scast_assemble_id)
 
 (* Specialisations of down_cast_same for adding to local simpsets. *)
 lemma cast_down_u64: "(scast::64 word \<Rightarrow> 32 word) = (ucast::64 word \<Rightarrow> 32 word)"
   apply (subst down_cast_same[symmetric])
    apply (simp add:is_down)+
   done
 
 lemma cast_down_s64: "(scast::64 sword \<Rightarrow> 32 word) = (ucast::64 sword \<Rightarrow> 32 word)"
   apply (subst down_cast_same[symmetric])
    apply (simp add:is_down)+
   done
 
 end
diff --git a/thys/Word_Lib/Word_Lemmas_64.thy b/thys/Word_Lib/Word_Lemmas_64.thy
--- a/thys/Word_Lib/Word_Lemmas_64.thy
+++ b/thys/Word_Lib/Word_Lemmas_64.thy
@@ -1,301 +1,294 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Lemmas for Word Length 64"
 
 theory Word_Lemmas_64
 imports
   Word_Lemmas
   Word_Setup_64
 begin
 
 lemma ucast_8_64_inj:
   "inj (ucast ::  8 word \<Rightarrow> 64 word)"
   by (rule down_ucast_inj) (clarsimp simp: is_down_def target_size source_size)
 
 lemma upto_2_helper:
   "{0..<2 :: 64 word} = {0, 1}"
   by (safe; simp) unat_arith
 
 lemmas upper_bits_unset_is_l2p_64 = upper_bits_unset_is_l2p [where 'a=64, folded word_bits_def]
 lemmas le_2p_upper_bits_64 = le_2p_upper_bits [where 'a=64, folded word_bits_def]
 lemmas le2p_bits_unset_64 = le2p_bits_unset[where 'a=64, folded word_bits_def]
 
 lemma word_bits_len_of:
   "len_of TYPE (64) = word_bits"
   by (simp add: word_bits_conv)
 
 lemmas unat_power_lower64' = unat_power_lower[where 'a=64]
 lemmas unat_power_lower64 [simp] = unat_power_lower64'[unfolded word_bits_len_of]
 
 lemmas word64_less_sub_le' = word_less_sub_le[where 'a = 64]
 lemmas word64_less_sub_le[simp] = word64_less_sub_le' [folded word_bits_def]
 
 lemma word_bits_size:
   "size (w::word64) = word_bits"
   by (simp add: word_bits_def word_size)
 
 lemmas word64_power_less_1' = word_power_less_1[where 'a = 64]
 lemmas word64_power_less_1[simp] = word64_power_less_1'[folded word_bits_def]
 
 lemma of_nat64_0:
   "\<lbrakk>of_nat n = (0::word64); n < 2 ^ word_bits\<rbrakk> \<Longrightarrow> n = 0"
   by (erule of_nat_0, simp add: word_bits_def)
 
 lemma unat_mask_2_less_4:
   "unat (p && mask 2 :: word64) < 4"
   apply (rule unat_less_helper)
   apply (rule order_le_less_trans, rule word_and_le1)
-  apply (simp add: mask_def)
+  apply (simp add: mask_eq)
   done
 
 lemmas unat_of_nat64' = unat_of_nat_eq[where 'a=64]
 lemmas unat_of_nat64 = unat_of_nat64'[unfolded word_bits_len_of]
 
 lemmas word_power_nonzero_64 = word_power_nonzero [where 'a=64, folded word_bits_def]
 
 lemmas unat_mult_simple = iffD1 [OF unat_mult_lem [where 'a = 64, unfolded word_bits_len_of]]
 
 lemmas div_power_helper_64 = div_power_helper [where 'a=64, folded word_bits_def]
 
 lemma n_less_word_bits:
   "(n < word_bits) = (n < 64)"
   by (simp add: word_bits_def)
 
 lemmas of_nat_less_pow_64 = of_nat_power [where 'a=64, folded word_bits_def]
 
 lemma lt_word_bits_lt_pow:
   "sz < word_bits \<Longrightarrow> sz < 2 ^ word_bits"
   by (simp add: word_bits_conv)
 
 lemma unat_less_word_bits:
   fixes y :: word64
   shows "x < unat y \<Longrightarrow> x < 2 ^ word_bits"
   unfolding word_bits_def
   by (rule order_less_trans [OF _ unat_lt2p])
 
 lemmas unat_mask_word64' = unat_mask[where 'a=64]
 lemmas unat_mask_word64 = unat_mask_word64'[folded word_bits_def]
 
 lemma unat_less_2p_word_bits:
   "unat (x :: 64 word) < 2 ^ word_bits"
   apply (simp only: word_bits_def)
   apply (rule unat_lt2p)
   done
 
 lemma Suc_unat_mask_div:
   "Suc (unat (mask sz div word_size::word64)) = 2 ^ (min sz word_bits - 3)"
   apply (case_tac "sz < word_bits")
    apply (case_tac "3\<le>sz")
-    apply (clarsimp simp: word_size_def word_bits_def min_def mask_def)
+    apply (clarsimp simp: word_size_def word_bits_def min_def mask_eq)
     apply (drule (2) Suc_div_unat_helper
            [where 'a=64 and sz=sz and us=3, simplified, symmetric])
    apply (simp add: not_le word_size_def word_bits_def)
    apply (case_tac sz, simp add: unat_word_ariths)
    apply (case_tac nat, simp add: unat_word_ariths
                                   unat_mask_word64 min_def word_bits_def)
    apply (case_tac nata, simp add: unat_word_ariths unat_mask_word64 word_bits_def)
    apply simp
   apply (simp add: unat_word_ariths
                    unat_mask_word64 min_def word_bits_def word_size_def)
   done
 
 lemmas word64_minus_one_le' = word_minus_one_le[where 'a=64]
 lemmas word64_minus_one_le = word64_minus_one_le'[simplified]
 
 lemma ucast_not_helper:
   fixes a::word8
   assumes a: "a \<noteq> 0xFF"
   shows "ucast a \<noteq> (0xFF::word64)"
 proof
   assume "ucast a = (0xFF::word64)"
   also
   have "(0xFF::word64) = ucast (0xFF::word8)" by simp
   finally
   show False using a
     apply -
     apply (drule up_ucast_inj, simp)
     apply simp
     done
 qed
 
 lemma less_4_cases:
   "(x::word64) < 4 \<Longrightarrow> x=0 \<or> x=1 \<or> x=2 \<or> x=3"
   apply clarsimp
   apply (drule word_less_cases, erule disjE, simp, simp)+
   done
 
 lemma if_then_1_else_0:
   "((if P then 1 else 0) = (0 :: word64)) = (\<not> P)"
   by simp
 
 lemma if_then_0_else_1:
   "((if P then 0 else 1) = (0 :: word64)) = (P)"
   by simp
 
 lemmas if_then_simps = if_then_0_else_1 if_then_1_else_0
 
 lemma ucast_le_ucast_8_64:
   "(ucast x \<le> (ucast y :: word64)) = (x \<le> (y :: word8))"
   by (simp add: ucast_le_ucast)
 
 lemma in_16_range:
   "0 \<in> S \<Longrightarrow> r \<in> (\<lambda>x. r + x * (16 :: word64)) ` S"
   "n - 1 \<in> S \<Longrightarrow> (r + (16 * n - 16)) \<in> (\<lambda>x :: word64. r + x * 16) ` S"
   by (clarsimp simp: image_def elim!: bexI[rotated])+
 
 lemma eq_2_64_0:
   "(2 ^ 64 :: word64) = 0"
   by simp
 
 lemma x_less_2_0_1:
   fixes x :: word64 shows
   "x < 2 \<Longrightarrow> x = 0 \<or> x = 1"
   by (rule x_less_2_0_1') auto
 
 lemmas mask_64_max_word  = max_word_mask [symmetric, where 'a=64, simplified]
 
 lemma of_nat64_n_less_equal_power_2:
  "n < 64 \<Longrightarrow> ((of_nat n)::64 word) < 2 ^ n"
   by (rule of_nat_n_less_equal_power_2, clarsimp simp: word_size)
 
 lemma word_rsplit_0:
   "word_rsplit (0 :: word64) = [0, 0, 0, 0, 0, 0, 0, 0 :: word8]"
   by (simp add: word_rsplit_def bin_rsplit_def)
 
 lemma unat_ucast_10_64 :
   fixes x :: "10 word"
   shows "unat (ucast x :: word64) = unat x"
-  unfolding ucast_def unat_def
-  apply (subst int_word_uint)
-  apply (subst mod_pos_pos_trivial)
-    apply simp
-   apply (rule lt2p_lem)
-   apply simp
-  apply simp
-  done
+  by transfer simp
 
 lemma bool_mask [simp]:
   fixes x :: word64
   shows "(0 < x && 1) = (x && 1 = 1)"
   by (rule bool_mask') auto
 
 lemma word64_bounds:
   "- (2 ^ (size (x :: word64) - 1)) = (-9223372036854775808 :: int)"
   "((2 ^ (size (x :: word64) - 1)) - 1) = (9223372036854775807 :: int)"
   "- (2 ^ (size (y :: 64 signed word) - 1)) = (-9223372036854775808 :: int)"
   "((2 ^ (size (y :: 64 signed word) - 1)) - 1) = (9223372036854775807 :: int)"
   by (simp_all add: word_size)
 
 lemma word_ge_min:"sint (x::64 word) \<ge> -9223372036854775808"
   by (metis sint_ge word64_bounds(1) word_size)
 
 lemmas signed_arith_ineq_checks_to_eq_word64'
     = signed_arith_ineq_checks_to_eq[where 'a=64]
       signed_arith_ineq_checks_to_eq[where 'a="64 signed"]
 
 lemmas signed_arith_ineq_checks_to_eq_word64
     = signed_arith_ineq_checks_to_eq_word64' [unfolded word64_bounds]
 
 lemmas signed_mult_eq_checks64_to_64'
     = signed_mult_eq_checks_double_size[where 'a=64 and 'b=64]
       signed_mult_eq_checks_double_size[where 'a="64 signed" and 'b=64]
 
 lemmas signed_mult_eq_checks64_to_64 = signed_mult_eq_checks64_to_64'[simplified]
 
 lemmas sdiv_word64_max' = sdiv_word_max [where 'a=64] sdiv_word_max [where 'a="64 signed"]
 lemmas sdiv_word64_max = sdiv_word64_max'[simplified word_size, simplified]
 
 lemmas sdiv_word64_min' = sdiv_word_min [where 'a=64] sdiv_word_min [where 'a="64 signed"]
 lemmas sdiv_word64_min = sdiv_word64_min' [simplified word_size, simplified]
 
 lemmas sint64_of_int_eq' = sint_of_int_eq [where 'a=64]
 lemmas sint64_of_int_eq = sint64_of_int_eq' [simplified]
 
 lemma ucast_of_nats [simp]:
   "(ucast (of_nat x :: word64) :: sword64) = (of_nat x)"
   "(ucast (of_nat x :: word64) :: sword16) = (of_nat x)"
   "(ucast (of_nat x :: word64) :: sword8) = (of_nat x)"
   "(ucast (of_nat x :: word16) :: sword16) = (of_nat x)"
   "(ucast (of_nat x :: word16) :: sword8) = (of_nat x)"
   "(ucast (of_nat x :: word8) :: sword8) = (of_nat x)"
   by (auto simp: ucast_of_nat is_down)
 
 lemmas signed_shift_guard_simpler_64'
     = power_strict_increasing_iff[where b="2 :: nat" and y=31]
 lemmas signed_shift_guard_simpler_64 = signed_shift_guard_simpler_64'[simplified]
 
 lemma word64_31_less:
   "31 < len_of TYPE (64 signed)" "31 > (0 :: nat)"
   "31 < len_of TYPE (64)" "31 > (0 :: nat)"
   by auto
 
 lemmas signed_shift_guard_to_word_64
     = signed_shift_guard_to_word[OF word64_31_less(1-2)]
     signed_shift_guard_to_word[OF word64_31_less(3-4)]
 
 lemma le_step_down_word_3:
   fixes x :: "64 word"
   shows "\<lbrakk>x \<le>  y; x \<noteq> y; y < 2 ^ 64 - 1\<rbrakk> \<Longrightarrow> x \<le> y - 1"
   by (rule le_step_down_word_2, assumption+)
 
 lemma shiftr_1:
   "(x::word64) >> 1 = 0 \<Longrightarrow> x < 2"
   by word_bitwise clarsimp
 
 lemma mask_step_down_64:
   \<open>\<exists>x. mask x = b\<close> if \<open>b && 1 = 1\<close>
     and \<open>\<exists>x. x < 64 \<and> mask x = b >> 1\<close> for b :: \<open>64word\<close>
 proof -
   from \<open>b && 1 = 1\<close> have \<open>odd b\<close>
     by (auto simp add: mod_2_eq_odd and_one_eq)
   then have \<open>b mod 2 = 1\<close>
     using odd_iff_mod_2_eq_one by blast
   from \<open>\<exists>x. x < 64 \<and> mask x = b >> 1\<close> obtain x where \<open>x < 64\<close> \<open>mask x = b >> 1\<close> by blast
   then have \<open>mask x = b div 2\<close>
     using shiftr1_is_div_2 [of b] by simp
   with \<open>b mod 2 = 1\<close> have \<open>2 * mask x + 1 = 2 * (b div 2) + b mod 2\<close>
     by (simp only:) 
   also have \<open>\<dots> = b\<close>
     by (simp add: mult_div_mod_eq)
   finally have \<open>2 * mask x + 1 = b\<close> .
   moreover have \<open>mask (Suc x) = 2 * mask x + 1\<close>
     by (metis (no_types, lifting) Groups.add_ac(2) Groups.add_ac(3) diff_add_cancel mask_2pm1 mask_Suc mult_2)
   ultimately show ?thesis
     by auto
 qed
 
 lemma unat_of_int_64:
   "\<lbrakk>i \<ge> 0; i \<le> 2 ^ 63\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword64)) = nat i"
-  unfolding unat_def
+  unfolding unat_eq_nat_uint
   apply (subst eq_nat_nat_iff, clarsimp+)
   apply (simp add: word_of_int uint_word_of_int)
   done
 
 lemmas word_ctz_not_minus_1_64 = word_ctz_not_minus_1[where 'a=64, simplified]
 
 (* Helper for packing then unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64[simp]:
   "(((ucast ((ucast (x::64 word))::32 word))::64 word) || (((ucast ((ucast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_assemble_id)
 
 (* Another variant of packing and unpacking a 64-bit variable. *)
 lemma cast_chunk_assemble_id_64'[simp]:
   "(((ucast ((scast (x::64 word))::32 word))::64 word) || (((ucast ((scast (x >> 32))::32 word))::64 word) << 32)) = x"
   by (simp add:cast_chunk_scast_assemble_id)
 
 (* Specialisations of down_cast_same for adding to local simpsets. *)
 lemma cast_down_u64: "(scast::64 word \<Rightarrow> 32 word) = (ucast::64 word \<Rightarrow> 32 word)"
   apply (subst down_cast_same[symmetric])
    apply (simp add:is_down)+
   done
 
 lemma cast_down_s64: "(scast::64 sword \<Rightarrow> 32 word) = (ucast::64 sword \<Rightarrow> 32 word)"
   apply (subst down_cast_same[symmetric])
    apply (simp add:is_down)+
   done
 
 end
diff --git a/thys/Word_Lib/Word_Lib.thy b/thys/Word_Lib/Word_Lib.thy
--- a/thys/Word_Lib/Word_Lib.thy
+++ b/thys/Word_Lib/Word_Lib.thy
@@ -1,726 +1,717 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section "Additional Word Operations"
 
 theory Word_Lib
 imports
   "HOL-Word.Misc_set_bit" Word_Syntax
 begin
 
 definition
   ptr_add :: "'a :: len word \<Rightarrow> nat \<Rightarrow> 'a word" where
   "ptr_add ptr n \<equiv> ptr + of_nat n"
 
 definition
   complement :: "'a :: len word \<Rightarrow> 'a word"  where
  "complement x \<equiv> ~~ x"
 
 definition
   alignUp :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word" where
  "alignUp x n \<equiv> x + 2 ^ n - 1 && complement (2 ^ n - 1)"
 
 (* standard notation for blocks of 2^n-1 words, usually aligned;
    abbreviation so it simplifies directly *)
 abbreviation mask_range :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word set" where
   "mask_range p n \<equiv> {p .. p + mask n}"
 
 (* Haskellish names/syntax *)
 notation (input)
   test_bit ("testBit")
 
 definition
   w2byte :: "'a :: len word \<Rightarrow> 8 word" where
   "w2byte \<equiv> ucast"
 
 
 (*
  * Signed division: when the result of a division is negative,
  * we will round towards zero instead of towards minus infinity.
  *)
 class signed_div =
   fixes sdiv :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "sdiv" 70)
   fixes smod :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "smod" 70)
 
 instantiation int :: signed_div
 begin
 definition "(a :: int) sdiv b \<equiv> sgn (a * b) * (abs a div abs b)"
 definition "(a :: int) smod b \<equiv> a - (a sdiv b) * b"
 instance ..
 end
 
 instantiation word :: (len) signed_div
 begin
 definition "(a :: ('a::len) word) sdiv b = word_of_int (sint a sdiv sint b)"
 definition "(a :: ('a::len) word) smod b = word_of_int (sint a smod sint b)"
 instance ..
 end
 
 (* Tests *)
 lemma
   "( 4 :: word32) sdiv  4 =  1"
   "(-4 :: word32) sdiv  4 = -1"
   "(-3 :: word32) sdiv  4 =  0"
   "( 3 :: word32) sdiv -4 =  0"
   "(-3 :: word32) sdiv -4 =  0"
   "(-5 :: word32) sdiv -4 =  1"
   "( 5 :: word32) sdiv -4 = -1"
   by (simp_all add: sdiv_word_def sdiv_int_def)
 
 lemma
   "( 4 :: word32) smod  4 =   0"
   "( 3 :: word32) smod  4 =   3"
   "(-3 :: word32) smod  4 =  -3"
   "( 3 :: word32) smod -4 =   3"
   "(-3 :: word32) smod -4 =  -3"
   "(-5 :: word32) smod -4 =  -1"
   "( 5 :: word32) smod -4 =   1"
   by (simp_all add: smod_word_def smod_int_def sdiv_int_def)
 
 
 (* Count leading zeros  *)
 definition
   word_clz :: "'a::len word \<Rightarrow> nat"
 where
   "word_clz w \<equiv> length (takeWhile Not (to_bl w))"
 
 (* Count trailing zeros  *)
 definition
   word_ctz :: "'a::len word \<Rightarrow> nat"
 where
   "word_ctz w \<equiv> length (takeWhile Not (rev (to_bl w)))"
 
 definition
   word_log2 :: "'a::len word \<Rightarrow> nat"
 where
   "word_log2 (w::'a::len word) \<equiv> size w - 1 - word_clz w"
 
 
 (* Bit population count. Equivalent of __builtin_popcount. *)
 definition
   pop_count :: "('a::len) word \<Rightarrow> nat"
 where
   "pop_count w \<equiv> length (filter id (to_bl w))"
 
 
 (* Sign extension from bit n *)
 
 definition
   sign_extend :: "nat \<Rightarrow> 'a::len word \<Rightarrow> 'a word"
 where
   "sign_extend n w \<equiv> if w !! n then w || ~~ (mask n) else w && mask n"
 
 definition
   sign_extended :: "nat \<Rightarrow> 'a::len word \<Rightarrow> bool"
 where
   "sign_extended n w \<equiv> \<forall>i. n < i \<longrightarrow> i < size w \<longrightarrow> w !! i = w !! n"
 
 
 lemma ptr_add_0 [simp]:
   "ptr_add ref 0 = ref "
   unfolding ptr_add_def by simp
 
 lemma shiftl_power:
   "(shiftl1 ^^ x) (y::'a::len word) = 2 ^ x * y"
   apply (induct x)
    apply simp
   apply (simp add: shiftl1_2t)
   done
 
 lemmas of_bl_reasoning = to_bl_use_of_bl of_bl_append
 
 lemma uint_of_bl_is_bl_to_bin_drop:
   "length (dropWhile Not l) \<le> LENGTH('a) \<Longrightarrow> uint (of_bl l :: 'a::len word) = bl_to_bin l"
   apply (simp add: of_bl_def)
   apply (rule word_uint.Abs_inverse)
   apply (simp add: uints_num bl_to_bin_ge0)
   apply (rule order_less_le_trans)
   apply (rule bl_to_bin_lt2p_drop)
   apply (simp)
   done
 
 corollary uint_of_bl_is_bl_to_bin:
   "length l\<le>LENGTH('a) \<Longrightarrow> uint ((of_bl::bool list\<Rightarrow> ('a :: len) word) l) = bl_to_bin l"
   apply(rule uint_of_bl_is_bl_to_bin_drop)
   using le_trans length_dropWhile_le by blast
 
 
 lemma bin_to_bl_or:
   "bin_to_bl n (a OR b) = map2 (\<or>) (bin_to_bl n a) (bin_to_bl n b)"
   using bl_or_aux_bin[where n=n and v=a and w=b and bs="[]" and cs="[]"]
   by simp
 
 lemma word_ops_nth [simp]:
   shows
   word_or_nth:  "(x || y) !! n = (x !! n \<or> y !! n)" and
   word_and_nth: "(x && y) !! n = (x !! n \<and> y !! n)" and
   word_xor_nth: "(x xor y) !! n = (x !! n \<noteq> y !! n)"
   by ((cases "n < size x",
       auto dest: test_bit_size simp: word_ops_nth_size word_size)[1])+
 
 (* simp del to avoid warning on the simp add in iff *)
 declare test_bit_1 [simp del, iff]
 
 (* test: *)
 lemma "1 < (1024::32 word) \<and> 1 \<le> (1024::32 word)" by simp
 
 lemma and_not_mask:
   "w AND NOT (mask n) = (w >> n) << n"
   apply (rule word_eqI)
   apply (simp add : word_ops_nth_size word_size)
   apply (simp add : nth_shiftr nth_shiftl)
   by auto
 
 lemma and_mask:
   "w AND mask n = (w << (size w - n)) >> (size w - n)"
   apply (rule word_eqI)
   apply (simp add : word_ops_nth_size word_size)
   apply (simp add : nth_shiftr nth_shiftl)
   by auto
 
 lemma AND_twice [simp]:
   "(w && m) && m = w && m"
   by (simp add: word_eqI)
 
 lemma word_combine_masks:
   "w && m = z \<Longrightarrow> w && m' = z' \<Longrightarrow> w && (m || m') = (z || z')"
   by (auto simp: word_eq_iff)
 
 lemma nth_w2p_same:
   "(2^n :: 'a :: len word) !! n = (n < LENGTH('a))"
   by (simp add : nth_w2p)
 
 lemma p2_gt_0:
   "(0 < (2 ^ n :: 'a :: len word)) = (n < LENGTH('a))"
   apply (simp add : word_gt_0)
   apply safe
    apply (erule swap)
    apply (rule word_eqI)
    apply (simp add : nth_w2p)
   apply (drule word_eqD)
   apply simp
   apply (erule notE)
   apply (erule nth_w2p_same [THEN iffD2])
   done
 
 lemmas uint_2p_alt = uint_2p [unfolded p2_gt_0]
 
 lemma shiftr_div_2n_w: "n < size w \<Longrightarrow> w >> n = w div (2^n :: 'a :: len word)"
   apply (unfold word_div_def)
   apply (simp add : uint_2p_alt word_size)
   apply (rule word_uint.Rep_inverse' [THEN sym])
   apply (rule shiftr_div_2n)
   done
 
 lemmas less_def = less_eq [symmetric]
 lemmas le_def = not_less [symmetric, where ?'a = nat]
 
 lemmas p2_eq_0 [simp] = trans [OF eq_commute
   iffD2 [OF Not_eq_iff p2_gt_0, folded le_def, unfolded word_gt_0 not_not]]
 
 lemma neg_mask_is_div':
   "n < size w \<Longrightarrow> w AND NOT (mask n) = ((w div (2 ^ n)) * (2 ^ n))"
   by (simp add : and_not_mask shiftr_div_2n_w shiftl_t2n word_size)
 
 lemma neg_mask_is_div:
   "w AND NOT (mask n) = (w div 2^n) * 2^n"
   apply (cases "n < size w")
    apply (erule neg_mask_is_div')
   apply (simp add: word_size)
   apply (frule p2_gt_0 [THEN Not_eq_iff [THEN iffD2], THEN iffD2])
   apply (simp add: word_gt_0  del: p2_eq_0)
   apply (rule word_eqI)
   apply (simp add: word_ops_nth_size word_size)
   done
 
 lemma and_mask_arith':
   "0 < n \<Longrightarrow> w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   by (simp add: and_mask shiftr_div_2n_w shiftl_t2n word_size mult.commute)
 
 lemmas p2len = iffD2 [OF p2_eq_0 order_refl]
 
 lemma and_mask_arith:
   "w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   apply (cases "0 < n")
    apply (auto elim!: and_mask_arith')
   apply (simp add: word_size)
   done
 
 lemma mask_2pm1: "mask n = 2 ^ n - 1"
-  by (simp add : mask_def)
+  by (fact mask_eq_decr_exp)
 
 lemma add_mask_fold:
   "x + 2 ^ n - 1 = x + mask n"
-  by (simp add: mask_def)
+  by (simp add: mask_eq_decr_exp)
 
 lemma word_and_mask_le_2pm1: "w && mask n \<le> 2 ^ n - 1"
   by (simp add: mask_2pm1[symmetric] word_and_le1)
 
 lemma is_aligned_AND_less_0:
   "u && mask n = 0 \<Longrightarrow> v < 2^n \<Longrightarrow> u && v = 0"
   apply (drule less_mask_eq)
   apply (simp add: mask_2pm1)
   apply (rule word_eqI)
   apply (clarsimp simp add: word_size)
   apply (drule_tac x=na in word_eqD)
   apply (drule_tac x=na in word_eqD)
   apply simp
   done
 
 lemma le_shiftr1:
   "u <= v \<Longrightarrow> shiftr1 u <= shiftr1 v"
-  apply (unfold word_le_def shiftr1_def word_ubin.eq_norm)
+  apply (unfold word_le_def shiftr1_eq word_ubin.eq_norm)
   apply (unfold bin_rest_trunc_i
                 trans [OF bintrunc_bintrunc_l word_ubin.norm_Rep,
                           unfolded word_ubin.norm_Rep,
                        OF order_refl [THEN le_SucI]])
   apply (case_tac "uint u" rule: bin_exhaust)
   apply (rename_tac bs bit)
   apply (case_tac "uint v" rule: bin_exhaust)
   apply (rename_tac bs' bit')
   apply (case_tac "bit")
    apply (case_tac "bit'", auto simp: less_eq_int_code)[1]
   apply (case_tac bit')
     apply (simp add: less_eq_int_code)
   apply (simp add: less_eq_int_code)
   done
 
 lemma le_shiftr:
   "u \<le> v \<Longrightarrow> u >> (n :: nat) \<le> (v :: 'a :: len word) >> n"
   apply (unfold shiftr_def)
   apply (induct_tac "n")
    apply auto
   apply (erule le_shiftr1)
   done
 
 lemma shiftr_mask_le:
   "n <= m \<Longrightarrow> mask n >> m = 0"
   apply (rule word_eqI)
   apply (simp add: word_size nth_shiftr)
   done
 
 lemmas shiftr_mask = order_refl [THEN shiftr_mask_le, simp]
 
 lemma word_leI:
   "(\<And>n.  \<lbrakk>n < size (u::'a::len word); u !! n \<rbrakk> \<Longrightarrow> (v::'a::len word) !! n) \<Longrightarrow> u <= v"
   apply (rule xtr4)
    apply (rule word_and_le2)
   apply (rule word_eqI)
   apply (simp add: word_ao_nth)
   apply safe
     apply assumption
    apply (erule_tac [2] asm_rl)
   apply (unfold word_size)
   by auto
 
 lemma le_mask_iff:
   "(w \<le> mask n) = (w >> n = 0)"
   apply safe
    apply (rule word_le_0_iff [THEN iffD1])
    apply (rule xtr3)
     apply (erule_tac [2] le_shiftr)
    apply simp
   apply (rule word_leI)
   apply (rename_tac n')
   apply (drule_tac x = "n' - n" in word_eqD)
   apply (simp add : nth_shiftr word_size)
   apply (case_tac "n <= n'")
   by auto
 
 lemma and_mask_eq_iff_shiftr_0:
   "(w AND mask n = w) = (w >> n = 0)"
   apply (unfold test_bit_eq_iff [THEN sym])
   apply (rule iffI)
    apply (rule ext)
    apply (rule_tac [2] ext)
    apply (auto simp add : word_ao_nth nth_shiftr)
     apply (drule arg_cong)
     apply (drule iffD2)
      apply assumption
     apply (simp add : word_ao_nth)
    prefer 2
    apply (simp add : word_size test_bit_bin)
   apply (drule_tac f = "%u. u !! (x - n)" in arg_cong)
   apply (simp add : nth_shiftr)
   apply (case_tac "n <= x")
    apply auto
   done
 
 lemmas and_mask_eq_iff_le_mask = trans
   [OF and_mask_eq_iff_shiftr_0 le_mask_iff [THEN sym]]
 
 lemma mask_shiftl_decompose:
   "mask m << n = mask (m + n) && ~~ (mask n)"
   by (auto intro!: word_eqI simp: and_not_mask nth_shiftl nth_shiftr word_size)
 
 lemma one_bit_shiftl: "set_bit 0 n True = (1 :: 'a :: len word) << n"
   apply (rule word_eqI)
   apply (auto simp add: test_bit_set_gen nth_shiftl word_size
               simp del: word_set_bit_0 shiftl_1)
   done
 
 lemmas one_bit_pow = trans [OF one_bit_shiftl shiftl_1]
 
 lemmas bin_sc_minus_simps =
   bin_sc_simps (2,3,4) [THEN [2] trans, OF bin_sc_minus [THEN sym]]
 
 lemma NOT_eq:
   "NOT (x :: 'a :: len word) = - x - 1"
   apply (cut_tac x = "x" in word_add_not)
   apply (drule add.commute [THEN trans])
   apply (drule eq_diff_eq [THEN iffD2])
   by simp
 
 lemma NOT_mask: "NOT (mask n) = -(2 ^ n)"
   by (simp add : NOT_eq mask_2pm1)
 
 lemma le_m1_iff_lt: "(x > (0 :: 'a :: len word)) = ((y \<le> x - 1) = (y < x))"
   by uint_arith
 
 lemmas gt0_iff_gem1 = iffD1 [OF iffD1 [OF iff_left_commute le_m1_iff_lt] order_refl]
 
 lemmas power_2_ge_iff = trans [OF gt0_iff_gem1 [THEN sym] p2_gt_0]
 
 lemma le_mask_iff_lt_2n:
   "n < len_of TYPE ('a) = (((w :: 'a :: len word) \<le> mask n) = (w < 2 ^ n))"
   unfolding mask_2pm1 by (rule trans [OF p2_gt_0 [THEN sym] le_m1_iff_lt])
 
 lemmas mask_lt_2pn =
   le_mask_iff_lt_2n [THEN iffD1, THEN iffD1, OF _ order_refl]
 
 lemma bang_eq:
   fixes x :: "'a::len word"
   shows "(x = y) = (\<forall>n. x !! n = y !! n)"
   by (subst test_bit_eq_iff[symmetric]) fastforce
 
 lemma word_unat_power:
   "(2 :: 'a :: len word) ^ n = of_nat (2 ^ n)"
   by simp
 
 lemma of_nat_mono_maybe:
   assumes xlt: "x < 2 ^ len_of TYPE ('a)"
   shows   "y < x \<Longrightarrow> of_nat y < (of_nat x :: 'a :: len word)"
   apply (subst word_less_nat_alt)
   apply (subst unat_of_nat)+
   apply (subst mod_less)
    apply (erule order_less_trans [OF _ xlt])
   apply (subst mod_less [OF xlt])
   apply assumption
   done
 
 lemma shiftl_over_and_dist:
   fixes a::"'a::len word"
   shows "(a AND b) << c = (a << c) AND (b << c)"
   apply(rule word_eqI)
   apply(simp add: word_ao_nth nth_shiftl, safe)
   done
 
 lemma shiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >> c = (a >> c) AND (b >> c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftr word_ao_nth)
   done
 
 lemma sshiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >>> c = (a >>> c) AND (b >>> c)"
   apply(rule word_eqI)
   apply(simp add:nth_sshiftr word_ao_nth word_size)
   done
 
 lemma shiftl_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b << c = (a << c) OR (b << c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftl word_ao_nth, safe)
   done
 
 lemma shiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >> c = (a >> c) OR (b >> c)"
   apply(rule word_eqI)
   apply(simp add:nth_shiftr word_ao_nth)
   done
 
 lemma sshiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >>> c = (a >>> c) OR (b >>> c)"
   apply(rule word_eqI)
   apply(simp add:nth_sshiftr word_ao_nth word_size)
   done
 
 lemmas shift_over_ao_dists =
   shiftl_over_or_dist shiftr_over_or_dist
   sshiftr_over_or_dist shiftl_over_and_dist
   shiftr_over_and_dist sshiftr_over_and_dist
 
 lemma shiftl_shiftl:
   fixes a::"'a::len word"
   shows "a << b << c = a << (b + c)"
   apply(rule word_eqI)
   apply(auto simp:word_size nth_shiftl add.commute add.left_commute)
   done
 
 lemma shiftr_shiftr:
   fixes a::"'a::len word"
   shows "a >> b >> c = a >> (b + c)"
   apply(rule word_eqI)
   apply(simp add:word_size nth_shiftr add.left_commute add.commute)
   done
 
 lemma shiftl_shiftr1:
   fixes a::"'a::len word"
   shows "c \<le> b \<Longrightarrow> a << b >> c = a AND (mask (size a - b)) << (b - c)"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ao_nth)
   done
 
 lemma shiftl_shiftr2:
   fixes a::"'a::len word"
   shows "b < c \<Longrightarrow> a << b >> c = (a >> (c - b)) AND (mask (size a - c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ao_nth)
   done
 
 lemma shiftr_shiftl1:
   fixes a::"'a::len word"
   shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT (mask c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ops_nth_size)
   done
 
 lemma shiftr_shiftl2:
   fixes a::"'a::len word"
   shows "b < c \<Longrightarrow> a >> b << c = (a << (c - b)) AND (NOT (mask c))"
   apply(rule word_eqI)
   apply(auto simp:nth_shiftr nth_shiftl word_size word_ops_nth_size)
   done
 
 lemmas multi_shift_simps =
   shiftl_shiftl shiftr_shiftr
   shiftl_shiftr1 shiftl_shiftr2
   shiftr_shiftl1 shiftr_shiftl2
 
 lemma word_and_max_word:
   fixes a::"'a::len word"
   shows "x = max_word \<Longrightarrow> a AND x = a"
   by simp
 
 lemma word_and_full_mask_simp:
   \<open>x && Bit_Operations.mask LENGTH('a) = x\<close> for x :: \<open>'a::len word\<close>
 proof (rule bit_eqI)
   fix n
   assume \<open>2 ^ n \<noteq> (0 :: 'a word)\<close>
   then have \<open>n < LENGTH('a)\<close>
     by simp
   then show \<open>bit (x && Bit_Operations.mask LENGTH('a)) n \<longleftrightarrow> bit x n\<close>
     by (simp add: bit_and_iff bit_mask_iff)
 qed
 	
 lemma word8_and_max_simp:
   \<open>x && 0xFF = x\<close> for x :: \<open>8 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 	
 lemma word16_and_max_simp:
   \<open>x && 0xFFFF = x\<close> for x :: \<open>16 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 	
 lemma word32_and_max_simp:
   \<open>x && 0xFFFFFFFF = x\<close> for x :: \<open>32 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 	
 lemma word64_and_max_simp:
   \<open>x && 0xFFFFFFFFFFFFFFFF = x\<close> for x :: \<open>64 word\<close>
   using word_and_full_mask_simp [of x]
   by (simp add: numeral_eq_Suc mask_Suc_exp)
 	
 lemmas word_and_max_simps =
   word8_and_max_simp
   word16_and_max_simp
   word32_and_max_simp
   word64_and_max_simp
 
 lemma word_and_1_bl:
   fixes x::"'a::len word"
   shows "(x AND 1) = of_bl [x !! 0]"
   by (simp add: mod_2_eq_odd test_bit_word_eq and_one_eq)
 
 lemma word_1_and_bl:
   fixes x::"'a::len word"
   shows "(1 AND x) = of_bl [x !! 0]"
   by (simp add: mod_2_eq_odd test_bit_word_eq one_and_eq)
 
 lemma scast_scast_id [simp]:
   "scast (scast x :: ('a::len) signed word) = (x :: 'a word)"
   "scast (scast y :: ('a::len) word) = (y :: 'a signed word)"
   by (auto simp: is_up scast_up_scast_id)
 
 lemma scast_ucast_id [simp]:
     "scast (ucast (x :: 'a::len word) :: 'a signed word) = x"
   by (metis down_cast_same is_down len_signed order_refl scast_scast_id(1))
 
 lemma ucast_scast_id [simp]:
     "ucast (scast (x :: 'a::len signed word) :: 'a word) = x"
   by (metis scast_scast_id(2) scast_ucast_id)
 
 lemma scast_of_nat [simp]:
     "scast (of_nat x :: 'a::len signed word) = (of_nat x :: 'a word)"
-  by (metis (hide_lams, no_types) len_signed scast_def uint_sint
-         word_of_nat word_ubin.Abs_norm word_ubin.eq_norm)
+  by transfer simp
 
 lemma ucast_of_nat:
   "is_down (ucast :: 'a :: len word \<Rightarrow> 'b :: len word)
     \<Longrightarrow> ucast (of_nat n :: 'a word) = (of_nat n :: 'b word)"
-  apply (rule sym)
-  apply (subst word_unat.inverse_norm)
-  apply (simp add: ucast_def word_of_int[symmetric]
-                   of_nat_nat[symmetric] unat_def[symmetric])
-  apply (simp add: unat_of_nat)
-  apply (rule nat_int.Rep_eqD)
-  apply (simp only: zmod_int)
-  apply (rule mod_mod_cancel)
-  by (simp add: is_down le_imp_power_dvd)
+  by transfer simp
 
 (* shortcut for some specific lengths *)
 lemma word_fixed_sint_1[simp]:
   "sint (1::8 word) = 1"
   "sint (1::16 word) = 1"
   "sint (1::32 word) = 1"
   "sint (1::64 word) = 1"
   by (auto simp: sint_word_ariths)
 
 lemma word_sint_1 [simp]:
   "sint (1::'a::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   by (cases \<open>LENGTH('a)\<close>)
     (simp_all add: not_le sint_uint le_Suc_eq sbintrunc_minus_simps)
 
 lemma scast_1':
   "(scast (1::'a::len word) :: 'b::len word) =
    (word_of_int (sbintrunc (LENGTH('a::len) - Suc 0) (1::int)))"
-  by (metis One_nat_def scast_def sint_word_ariths(8))
+  by transfer simp
 
 lemma scast_1 [simp]:
   "(scast (1::'a::len word) :: 'b::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   by (clarsimp simp: scast_1')
      (metis Suc_pred len_gt_0 nat.exhaust sbintrunc_Suc_numeral(1) uint_1 word_uint.Rep_inverse')
 
 lemma scast_eq_scast_id [simp]:
   "((scast (a :: 'a::len signed word) :: 'a word) = scast b) = (a = b)"
   by (metis ucast_scast_id)
 
 lemma ucast_eq_ucast_id [simp]:
   "((ucast (a :: 'a::len word) :: 'a signed word) = ucast b) = (a = b)"
   by (metis scast_ucast_id)
 
 lemma scast_ucast_norm [simp]:
   "(ucast (a :: 'a::len word) = (b :: 'a signed word)) = (a = scast b)"
   "((b :: 'a signed word) = ucast (a :: 'a::len word)) = (a = scast b)"
   by (metis scast_ucast_id ucast_scast_id)+
 
 lemma of_bl_drop:
   "of_bl (drop n xs) = (of_bl xs && mask (length xs - n))"
   apply (clarsimp simp: bang_eq test_bit_of_bl rev_nth cong: rev_conj_cong)
   apply (safe; simp add: word_size to_bl_nth)
   done
 
 lemma of_int_uint [simp]:
   "of_int (uint x) = x"
   by (metis word_of_int word_uint.Rep_inverse')
 
 lemma shiftr_mask2:
   "n \<le> LENGTH('a) \<Longrightarrow> (mask n >> m :: ('a :: len) word) = mask (n - m)"
   apply (rule word_eqI)
   apply (simp add: nth_shiftr word_size)
   apply arith
   done
 
 corollary word_plus_and_or_coroll:
   "x && y = 0 \<Longrightarrow> x + y = x || y"
   using word_plus_and_or[where x=x and y=y]
   by simp
 
 corollary word_plus_and_or_coroll2:
   "(x && w) + (x && ~~ w) = x"
   apply (subst word_plus_and_or_coroll)
    apply (rule word_eqI, simp add: word_size word_ops_nth_size)
   apply (rule word_eqI, simp add: word_size word_ops_nth_size)
   apply blast
   done
 
 lemma less_le_mult_nat':
   "w * c < b * c ==> 0 \<le> c ==> Suc w * c \<le> b * (c::nat)"
   apply (rule mult_right_mono)
    apply (rule Suc_leI)
    apply (erule (1) mult_right_less_imp_less)
   apply assumption
   done
 
 lemmas less_le_mult_nat = less_le_mult_nat'[simplified distrib_right, simplified]
 
 (* FIXME: these should eventually be moved to HOL/Word. *)
 lemmas extra_sle_sless_unfolds [simp] =
-    word_sle_def[where a=0 and b=1]
-    word_sle_def[where a=0 and b="numeral n"]
-    word_sle_def[where a=1 and b=0]
-    word_sle_def[where a=1 and b="numeral n"]
-    word_sle_def[where a="numeral n" and b=0]
-    word_sle_def[where a="numeral n" and b=1]
+    word_sle_eq[where a=0 and b=1]
+    word_sle_eq[where a=0 and b="numeral n"]
+    word_sle_eq[where a=1 and b=0]
+    word_sle_eq[where a=1 and b="numeral n"]
+    word_sle_eq[where a="numeral n" and b=0]
+    word_sle_eq[where a="numeral n" and b=1]
     word_sless_alt[where a=0 and b=1]
     word_sless_alt[where a=0 and b="numeral n"]
     word_sless_alt[where a=1 and b=0]
     word_sless_alt[where a=1 and b="numeral n"]
     word_sless_alt[where a="numeral n" and b=0]
     word_sless_alt[where a="numeral n" and b=1]
   for n
 
 
 lemma to_bl_1:
   "to_bl (1::'a::len word) = replicate (LENGTH('a) - 1) False @ [True]"
 proof -
   have "to_bl (1 :: 'a::len word) = to_bl (mask 1 :: 'a::len word)"
-    by (simp add: mask_def)
+    by (simp add: mask_Suc_0) 
 
   also have "\<dots> = replicate (LENGTH('a) - 1) False @ [True]"
     by (cases "LENGTH('a)"; clarsimp simp: to_bl_mask)
 
   finally show ?thesis .
 qed
 
 lemma list_of_false:
   "True \<notin> set xs \<Longrightarrow> xs = replicate (length xs) False"
   by (induct xs, simp_all)
 
 lemma eq_zero_set_bl:
   "(w = 0) = (True \<notin> set (to_bl w))"
   using list_of_false word_bl.Rep_inject by fastforce
 
 lemma diff_diff_less:
   "(i < m - (m - (n :: nat))) = (i < m \<and> i < n)"
   by auto
 
 lemma pop_count_0[simp]:
   "pop_count 0 = 0"
   by (clarsimp simp:pop_count_def)
 
 lemma pop_count_1[simp]:
   "pop_count 1 = 1"
   by (clarsimp simp:pop_count_def to_bl_1)
 
 lemma pop_count_0_imp_0:
   "(pop_count w = 0) = (w = 0)"
   apply (rule iffI)
    apply (clarsimp simp:pop_count_def)
    apply (subst (asm) filter_empty_conv)
    apply (clarsimp simp:eq_zero_set_bl)
    apply fast
   apply simp
   done
 
 end