diff --git a/thys/Native_Word/Bits_Integer.thy b/thys/Native_Word/Bits_Integer.thy
--- a/thys/Native_Word/Bits_Integer.thy
+++ b/thys/Native_Word/Bits_Integer.thy
@@ -1,680 +1,680 @@
 (*  Title:      Bits_Integer.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Bit operations for target language integers\<close>
 
 theory Bits_Integer imports
   "Word_Lib.Bit_Comprehension"
   Code_Int_Integer_Conversion
   Code_Symbolic_Bits_Int
 begin
 
 lemmas [transfer_rule] =
   identity_quotient
   fun_quotient
   Quotient_integer[folded integer.pcr_cr_eq]
 
 lemma undefined_transfer:
   assumes "Quotient R Abs Rep T"
   shows "T (Rep undefined) undefined"
 using assms unfolding Quotient_alt_def by blast
 
 bundle undefined_transfer = undefined_transfer[transfer_rule]
 
 section \<open>More lemmas about @{typ integer}s\<close>
 
 context
 includes integer.lifting
 begin
 
 lemma bitval_integer_transfer [transfer_rule]:
   "(rel_fun (=) pcr_integer) of_bool of_bool"
 by(auto simp add: of_bool_def integer.pcr_cr_eq cr_integer_def)
 
 lemma integer_of_nat_less_0_conv [simp]: "\<not> integer_of_nat n < 0"
 by(transfer) simp
 
 lemma int_of_integer_pow: "int_of_integer (x ^ n) = int_of_integer x ^ n"
 by(induct n) simp_all
 
 lemma pow_integer_transfer [transfer_rule]:
   "(rel_fun pcr_integer (rel_fun (=) pcr_integer)) (^) (^)"
 by(auto 4 3 simp add: integer.pcr_cr_eq cr_integer_def int_of_integer_pow)
 
 lemma sub1_lt_0_iff [simp]: "Code_Numeral.sub n num.One < 0 \<longleftrightarrow> False"
 by(cases n)(simp_all add: Code_Numeral.sub_code)
 
 lemma nat_of_integer_numeral [simp]: "nat_of_integer (numeral n) = numeral n"
 by transfer simp
 
 lemma nat_of_integer_sub1_conv_pred_numeral [simp]:
   "nat_of_integer (Code_Numeral.sub n num.One) = pred_numeral n"
 by(cases n)(simp_all add: Code_Numeral.sub_code)
 
 lemma nat_of_integer_1 [simp]: "nat_of_integer 1 = 1"
 by transfer simp
 
 lemma dup_1 [simp]: "Code_Numeral.dup 1 = 2"
 by transfer simp
 
 
 section \<open>Bit operations on @{typ integer}\<close>
 
 text \<open>Bit operations on @{typ integer} are the same as on @{typ int}\<close>
 
 lift_definition bin_rest_integer :: "integer \<Rightarrow> integer" is \<open>\<lambda>k . k div 2\<close> .
 lift_definition bin_last_integer :: "integer \<Rightarrow> bool" is odd .
 lift_definition Bit_integer :: "integer \<Rightarrow> bool \<Rightarrow> integer" is \<open>\<lambda>k b. of_bool b + 2 * k\<close> .
 
 end
 
 instantiation integer :: lsb begin
 context includes integer.lifting begin
 
 lift_definition lsb_integer :: "integer \<Rightarrow> bool" is lsb .
 
 instance
   by (standard; transfer) (fact lsb_odd)
 
 end
 end
 
 instantiation integer :: msb begin
 context includes integer.lifting begin
 
 lift_definition msb_integer :: "integer \<Rightarrow> bool" is msb .
 
 instance ..
 
 end
 end
 
 instantiation integer :: set_bit begin
 context includes integer.lifting begin
 
 lift_definition set_bit_integer :: "integer \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> integer" is set_bit .
 
 instance
   apply standard
   apply transfer
   apply (simp add: bit_simps)
   done
 
 end
 end
 
 abbreviation (input) wf_set_bits_integer
 where "wf_set_bits_integer \<equiv> wf_set_bits_int"
 
 
 section \<open>Target language implementations\<close>
 
 text \<open>
   Unfortunately, this is not straightforward,
   because these API functions have different signatures and preconditions on the parameters:
 
   \begin{description}
   \item[Standard ML] Shifts in IntInf are given as word, but not IntInf.
   \item[Haskell] In the Data.Bits.Bits type class, shifts and bit indices are given as Int rather than Integer.
   \end{description}
 
   Additional constants take only parameters of type @{typ integer} rather than @{typ nat}
   and check the preconditions as far as possible (e.g., being non-negative) in a portable way.
   Manual implementations inside code\_printing perform the remaining range checks and convert
   these @{typ integer}s into the right type.
 
   For normalisation by evaluation, we derive custom code equations, because NBE
   does not know these code\_printing serialisations and would otherwise loop.
 \<close>
 
 code_identifier code_module Bits_Integer \<rightharpoonup>
   (SML) Bits_Int and (OCaml) Bits_Int and (Haskell) Bits_Int and (Scala) Bits_Int
 
 code_printing code_module Bits_Integer \<rightharpoonup> (SML)
 \<open>structure Bits_Integer : sig
   val set_bit : IntInf.int -> IntInf.int -> bool -> IntInf.int
   val shiftl : IntInf.int -> IntInf.int -> IntInf.int
   val shiftr : IntInf.int -> IntInf.int -> IntInf.int
   val test_bit : IntInf.int -> IntInf.int -> bool
 end = struct
 
 val maxWord = IntInf.pow (2, Word.wordSize);
 
 fun set_bit x n b =
   if n < maxWord then
     if b then IntInf.orb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n)))
     else IntInf.andb (x, IntInf.notb (IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))))
   else raise (Fail ("Bit index too large: " ^ IntInf.toString n));
 
 fun shiftl x n =
   if n < maxWord then IntInf.<< (x, Word.fromLargeInt (IntInf.toLarge n))
   else raise (Fail ("Shift operand too large: " ^ IntInf.toString n));
 
 fun shiftr x n =
   if n < maxWord then IntInf.~>> (x, Word.fromLargeInt (IntInf.toLarge n))
   else raise (Fail ("Shift operand too large: " ^ IntInf.toString n));
 
 fun test_bit x n =
   if n < maxWord then IntInf.andb (x, IntInf.<< (1, Word.fromLargeInt (IntInf.toLarge n))) <> 0
   else raise (Fail ("Bit index too large: " ^ IntInf.toString n));
 
 end; (*struct Bits_Integer*)\<close>
 code_reserved SML Bits_Integer
 
 code_printing code_module Bits_Integer \<rightharpoonup> (OCaml)
 \<open>module Bits_Integer : sig
   val shiftl : Z.t -> Z.t -> Z.t
   val shiftr : Z.t -> Z.t -> Z.t
   val test_bit : Z.t -> Z.t -> bool
 end = struct
 
 (* We do not need an explicit range checks here,
    because Big_int.int_of_big_int raises Failure
    if the argument does not fit into an int. *)
 let shiftl x n = Z.shift_left x (Z.to_int n);;
 
 let shiftr x n = Z.shift_right x (Z.to_int n);;
 
 let test_bit x n =  Z.testbit x (Z.to_int n);;
 
 end;; (*struct Bits_Integer*)\<close>
 code_reserved OCaml Bits_Integer
 
 code_printing code_module Data_Bits \<rightharpoonup> (Haskell)
 \<open>
 module Data_Bits where {
 
 import qualified Data.Bits;
 
 {-
   The ...Bounded functions assume that the Integer argument for the shift
   or bit index fits into an Int, is non-negative and (for types of fixed bit width)
   less than bitSize
 -}
 
 infixl 7 .&.;
 infixl 6 `xor`;
 infixl 5 .|.;
 
 (.&.) :: Data.Bits.Bits a => a -> a -> a;
 (.&.) = (Data.Bits..&.);
 
 xor :: Data.Bits.Bits a => a -> a -> a;
 xor = Data.Bits.xor;
 
 (.|.) :: Data.Bits.Bits a => a -> a -> a;
 (.|.) = (Data.Bits..|.);
 
 complement :: Data.Bits.Bits a => a -> a;
 complement = Data.Bits.complement;
 
 testBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool;
 testBitUnbounded x b
   | b <= toInteger (Prelude.maxBound :: Int) = Data.Bits.testBit x (fromInteger b)
   | otherwise = error ("Bit index too large: " ++ show b)
 ;
 
 testBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool;
 testBitBounded x b = Data.Bits.testBit x (fromInteger b);
 
 setBitUnbounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a;
 setBitUnbounded x n b
   | n <= toInteger (Prelude.maxBound :: Int) =
     if b then Data.Bits.setBit x (fromInteger n) else Data.Bits.clearBit x (fromInteger n)
   | otherwise = error ("Bit index too large: " ++ show n)
 ;
 
 setBitBounded :: Data.Bits.Bits a => a -> Integer -> Bool -> a;
 setBitBounded x n True = Data.Bits.setBit x (fromInteger n);
 setBitBounded x n False = Data.Bits.clearBit x (fromInteger n);
 
 shiftlUnbounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftlUnbounded x n
   | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftL x (fromInteger n)
   | otherwise = error ("Shift operand too large: " ++ show n)
 ;
 
 shiftlBounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftlBounded x n = Data.Bits.shiftL x (fromInteger n);
 
 shiftrUnbounded :: Data.Bits.Bits a => a -> Integer -> a;
 shiftrUnbounded x n
   | n <= toInteger (Prelude.maxBound :: Int) = Data.Bits.shiftR x (fromInteger n)
   | otherwise = error ("Shift operand too large: " ++ show n)
 ;
 
 shiftrBounded :: (Ord a, Data.Bits.Bits a) => a -> Integer -> a;
 shiftrBounded x n = Data.Bits.shiftR x (fromInteger n);
 
 }\<close>
 
   and \<comment> \<open>@{theory HOL.Quickcheck_Narrowing} maps @{typ integer} to
             Haskell's Prelude.Int type instead of Integer. For compatibility
             with the Haskell target, we nevertheless provide bounded and
             unbounded functions.\<close>
   (Haskell_Quickcheck)
 \<open>
 module Data_Bits where {
 
 import qualified Data.Bits;
 
 {-
   The functions assume that the Int argument for the shift or bit index is
   non-negative and (for types of fixed bit width) less than bitSize
 -}
 
 infixl 7 .&.;
 infixl 6 `xor`;
 infixl 5 .|.;
 
 (.&.) :: Data.Bits.Bits a => a -> a -> a;
 (.&.) = (Data.Bits..&.);
 
 xor :: Data.Bits.Bits a => a -> a -> a;
 xor = Data.Bits.xor;
 
 (.|.) :: Data.Bits.Bits a => a -> a -> a;
 (.|.) = (Data.Bits..|.);
 
 complement :: Data.Bits.Bits a => a -> a;
 complement = Data.Bits.complement;
 
 testBitUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool;
 testBitUnbounded = Data.Bits.testBit;
 
 testBitBounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool;
 testBitBounded = Data.Bits.testBit;
 
 setBitUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool -> a;
 setBitUnbounded x n True = Data.Bits.setBit x n;
 setBitUnbounded x n False = Data.Bits.clearBit x n;
 
 setBitBounded :: Data.Bits.Bits a => a -> Prelude.Int -> Bool -> a;
 setBitBounded x n True = Data.Bits.setBit x n;
 setBitBounded x n False = Data.Bits.clearBit x n;
 
 shiftlUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftlUnbounded = Data.Bits.shiftL;
 
 shiftlBounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftlBounded = Data.Bits.shiftL;
 
 shiftrUnbounded :: Data.Bits.Bits a => a -> Prelude.Int -> a;
 shiftrUnbounded = Data.Bits.shiftR;
 
 shiftrBounded :: (Ord a, Data.Bits.Bits a) => a -> Prelude.Int -> a;
 shiftrBounded = Data.Bits.shiftR;
 
 }\<close>
 code_reserved Haskell Data_Bits
 
 code_printing code_module Bits_Integer \<rightharpoonup> (Scala)
 \<open>object Bits_Integer {
 
 def setBit(x: BigInt, n: BigInt, b: Boolean) : BigInt =
   if (n.isValidInt)
     if (b)
       x.setBit(n.toInt)
     else
       x.clearBit(n.toInt)
   else
     sys.error("Bit index too large: " + n.toString)
 
 def shiftl(x: BigInt, n: BigInt) : BigInt =
   if (n.isValidInt)
     x << n.toInt
   else
     sys.error("Shift index too large: " + n.toString)
 
 def shiftr(x: BigInt, n: BigInt) : BigInt =
   if (n.isValidInt)
     x << n.toInt
   else
     sys.error("Shift index too large: " + n.toString)
 
 def testBit(x: BigInt, n: BigInt) : Boolean =
   if (n.isValidInt)
     x.testBit(n.toInt)
   else
     sys.error("Bit index too large: " + n.toString)
 
 } /* object Bits_Integer */\<close>
 
 code_printing
   constant "Bit_Operations.and :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.andb ((_),/ (_))" and
   (OCaml) "Z.logand" and
   (Haskell) "((Data'_Bits..&.) :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "((Data'_Bits..&.) :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 3 "&"
 | constant "Bit_Operations.or :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.orb ((_),/ (_))" and
   (OCaml) "Z.logor" and
   (Haskell) "((Data'_Bits..|.) :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "((Data'_Bits..|.) :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 1 "|"
 | constant "Bit_Operations.xor :: integer \<Rightarrow> integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.xorb ((_),/ (_))" and
   (OCaml) "Z.logxor" and
   (Haskell) "(Data'_Bits.xor :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.xor :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) infixl 2 "^"
 | constant "Bit_Operations.not :: integer \<Rightarrow> integer" \<rightharpoonup>
   (SML) "IntInf.notb" and
   (OCaml) "Z.lognot" and
   (Haskell) "(Data'_Bits.complement :: Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.complement :: Prelude.Int -> Prelude.Int)" and
   (Scala) "_.unary'_~"
 
 code_printing constant bin_rest_integer \<rightharpoonup>
   (SML) "IntInf.div ((_), 2)" and
   (OCaml) "Z.shift'_right/ _/ 1" and
   (Haskell) "(Data'_Bits.shiftrUnbounded _ 1 :: Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftrUnbounded _ 1 :: Prelude.Int)" and
   (Scala) "_ >> 1"
 
 context
   includes integer.lifting bit_operations_syntax
 begin
 
 lemma bitNOT_integer_code [code]:
   fixes i :: integer shows
   "NOT i = - i - 1"
   by transfer (simp add: not_int_def)
 
 lemma bin_rest_integer_code [code nbe]:
   "bin_rest_integer i = i div 2"
   by transfer rule
 
 lemma bin_last_integer_code [code]:
   "bin_last_integer i \<longleftrightarrow> i AND 1 \<noteq> 0"
   by transfer (simp add: and_one_eq odd_iff_mod_2_eq_one)
 
 lemma bin_last_integer_nbe [code nbe]:
   "bin_last_integer i \<longleftrightarrow> i mod 2 \<noteq> 0"
   by transfer (simp add: odd_iff_mod_2_eq_one)
 
 lemma bitval_bin_last_integer [code_unfold]:
   "of_bool (bin_last_integer i) = i AND 1"
   by transfer (simp add: and_one_eq mod_2_eq_odd)
 
 end
 
 definition integer_test_bit :: "integer \<Rightarrow> integer \<Rightarrow> bool"
   where "integer_test_bit x n = (if n < 0 then undefined x n else bit x (nat_of_integer n))"
 
 declare [[code drop: \<open>bit :: integer \<Rightarrow> nat \<Rightarrow> bool\<close>]]
 
 lemma bit_integer_code [code]:
   "bit x n \<longleftrightarrow> integer_test_bit x (integer_of_nat n)"
   by (simp add: integer_test_bit_def)
 
 lemma integer_test_bit_code [code]:
   "integer_test_bit x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_test_bit 0 0 = False"
   "integer_test_bit 0 (Code_Numeral.Pos n) = False"
   "integer_test_bit (Code_Numeral.Pos num.One)      0 = True"
   "integer_test_bit (Code_Numeral.Pos (num.Bit0 n)) 0 = False"
   "integer_test_bit (Code_Numeral.Pos (num.Bit1 n)) 0 = True"
   "integer_test_bit (Code_Numeral.Pos num.One)      (Code_Numeral.Pos n') = False"
   "integer_test_bit (Code_Numeral.Pos (num.Bit0 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Pos n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Pos (num.Bit1 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Pos n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Neg num.One)      0 = True"
   "integer_test_bit (Code_Numeral.Neg (num.Bit0 n)) 0 = False"
   "integer_test_bit (Code_Numeral.Neg (num.Bit1 n)) 0 = True"
   "integer_test_bit (Code_Numeral.Neg num.One)      (Code_Numeral.Pos n') = True"
   "integer_test_bit (Code_Numeral.Neg (num.Bit0 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Neg n) (Code_Numeral.sub n' num.One)"
   "integer_test_bit (Code_Numeral.Neg (num.Bit1 n)) (Code_Numeral.Pos n') =
    integer_test_bit (Code_Numeral.Neg (n + num.One)) (Code_Numeral.sub n' num.One)"
-  by (simp_all add: integer_test_bit_def bit_integer_def flip: bit_not_int_iff')
+  by (simp_all add: integer_test_bit_def bit_integer_def bit_0 flip: bit_not_int_iff')
 
 code_printing constant integer_test_bit \<rightharpoonup>
   (SML) "Bits'_Integer.test'_bit" and
   (OCaml) "Bits'_Integer.test'_bit" and
   (Haskell) "(Data'_Bits.testBitUnbounded :: Integer -> Integer -> Bool)" and
   (Haskell_Quickcheck) "(Data'_Bits.testBitUnbounded :: Prelude.Int -> Prelude.Int -> Bool)" and
   (Scala) "Bits'_Integer.testBit"
 
 context
   includes integer.lifting bit_operations_syntax
 begin
 
 lemma lsb_integer_code [code]:
   fixes x :: integer shows
   "lsb x = bit x 0"
 by transfer(simp add: lsb_int_def)
 
 definition integer_set_bit :: "integer \<Rightarrow> integer \<Rightarrow> bool \<Rightarrow> integer"
 where [code del]: "integer_set_bit x n b = (if n < 0 then undefined x n b else set_bit x (nat_of_integer n) b)"
 
 lemma set_bit_integer_code [code]:
   "set_bit x i b = integer_set_bit x (integer_of_nat i) b"
 by(simp add: integer_set_bit_def)
 
 lemma set_bit_integer_conv_masks:
   fixes x :: integer shows
   "set_bit x i b = (if b then x OR (push_bit i 1) else x AND NOT (push_bit i 1))"
   by transfer (simp add: int_set_bit_False_conv_NAND int_set_bit_True_conv_OR)
 
 end
 
 code_printing constant integer_set_bit \<rightharpoonup>
   (SML) "Bits'_Integer.set'_bit" and
   (Haskell) "(Data'_Bits.setBitUnbounded :: Integer -> Integer -> Bool -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.setBitUnbounded :: Prelude.Int -> Prelude.Int -> Bool -> Prelude.Int)" and
   (Scala) "Bits'_Integer.setBit"
 
 text \<open>
   OCaml.Big\_int does not have a method for changing an individual bit, so we emulate that with masks.
   We prefer an Isabelle implementation, because this then takes care of the signs for AND and OR.
 \<close>
 
 context
   includes bit_operations_syntax
 begin
 
 lemma integer_set_bit_code [code]:
   "integer_set_bit x n b =
   (if n < 0 then undefined x n b else
    if b then x OR (push_bit (nat_of_integer n) 1)
    else x AND NOT (push_bit (nat_of_integer n) 1))"
   by (auto simp add: integer_set_bit_def not_less set_bit_eq set_bit_def unset_bit_def)
 
 end
 
 definition integer_shiftl :: "integer \<Rightarrow> integer \<Rightarrow> integer"
 where [code del]: "integer_shiftl x n = (if n < 0 then undefined x n else push_bit (nat_of_integer n) x)"
 
 declare [[code drop: \<open>push_bit :: nat \<Rightarrow> integer \<Rightarrow> integer\<close>]]
 
 lemma shiftl_integer_code [code]:
   fixes x :: integer shows
   "push_bit n x = integer_shiftl x (integer_of_nat n)"
 by(auto simp add: integer_shiftl_def)
 
 context
 includes integer.lifting
 begin
 
 lemma shiftl_integer_conv_mult_pow2:
   fixes x :: integer shows
   "push_bit n x = x * 2 ^ n"
   by (fact push_bit_eq_mult)
 
 lemma integer_shiftl_code [code]:
   "integer_shiftl x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_shiftl x 0 = x"
   "integer_shiftl x (Code_Numeral.Pos n) = integer_shiftl (Code_Numeral.dup x) (Code_Numeral.sub n num.One)"
   "integer_shiftl 0 (Code_Numeral.Pos n) = 0"
      apply (simp_all add: integer_shiftl_def numeral_eq_Suc)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 end
 
 code_printing constant integer_shiftl \<rightharpoonup>
   (SML) "Bits'_Integer.shiftl" and
   (OCaml) "Bits'_Integer.shiftl" and
   (Haskell) "(Data'_Bits.shiftlUnbounded :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftlUnbounded :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) "Bits'_Integer.shiftl"
 
 definition integer_shiftr :: "integer \<Rightarrow> integer \<Rightarrow> integer"
 where [code del]: "integer_shiftr x n = (if n < 0 then undefined x n else drop_bit (nat_of_integer n) x)"
 
 declare [[code drop: \<open>drop_bit :: nat \<Rightarrow> integer \<Rightarrow> integer\<close>]]
 
 lemma shiftr_integer_conv_div_pow2:
   includes integer.lifting fixes x :: integer shows
   "drop_bit n x = x div 2 ^ n"
   by (fact drop_bit_eq_div)
 
 lemma shiftr_integer_code [code]:
   fixes x :: integer shows
   "drop_bit n x = integer_shiftr x (integer_of_nat n)"
 by(auto simp add: integer_shiftr_def)
 
 code_printing constant integer_shiftr \<rightharpoonup>
   (SML) "Bits'_Integer.shiftr" and
   (OCaml) "Bits'_Integer.shiftr" and
   (Haskell) "(Data'_Bits.shiftrUnbounded :: Integer -> Integer -> Integer)" and
   (Haskell_Quickcheck) "(Data'_Bits.shiftrUnbounded :: Prelude.Int -> Prelude.Int -> Prelude.Int)" and
   (Scala) "Bits'_Integer.shiftr"
 
 lemma integer_shiftr_code [code]:
   includes integer.lifting
   shows
   "integer_shiftr x (Code_Numeral.Neg n) = undefined x (Code_Numeral.Neg n)"
   "integer_shiftr x 0 = x"
   "integer_shiftr 0 (Code_Numeral.Pos n) = 0"
   "integer_shiftr (Code_Numeral.Pos num.One) (Code_Numeral.Pos n) = 0"
   "integer_shiftr (Code_Numeral.Pos (num.Bit0 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Pos n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Pos (num.Bit1 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Pos n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Neg num.One) (Code_Numeral.Pos n) = -1"
   "integer_shiftr (Code_Numeral.Neg (num.Bit0 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Neg n') (Code_Numeral.sub n num.One)"
   "integer_shiftr (Code_Numeral.Neg (num.Bit1 n')) (Code_Numeral.Pos n) =
    integer_shiftr (Code_Numeral.Neg (Num.inc n')) (Code_Numeral.sub n num.One)"
           apply (simp_all add: integer_shiftr_def numeral_eq_Suc drop_bit_Suc)
     apply transfer apply simp
    apply transfer apply simp
   apply transfer apply (simp add: add_One)
   done
 
 context
 includes integer.lifting
 begin
 
 lemma Bit_integer_code [code]:
   "Bit_integer i False = push_bit 1 i"
   "Bit_integer i True = push_bit 1 i + 1"
   by (transfer; simp)+
 
 lemma msb_integer_code [code]:
   "msb (x :: integer) \<longleftrightarrow> x < 0"
   by transfer (simp add: msb_int_def)
 
 end
 
 context
   includes integer.lifting natural.lifting bit_operations_syntax
 begin
 
 lemma bitAND_integer_unfold [code]:
   "x AND y =
    (if x = 0 then 0
     else if x = - 1 then y
     else Bit_integer (bin_rest_integer x AND bin_rest_integer y) (bin_last_integer x \<and> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       and_int_rec [of _ \<open>_ * 2\<close>] and_int_rec [of \<open>_ * 2\<close>] and_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 lemma bitOR_integer_unfold [code]:
   "x OR y =
    (if x = 0 then y
     else if x = - 1 then - 1
     else Bit_integer (bin_rest_integer x OR bin_rest_integer y) (bin_last_integer x \<or> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       or_int_rec [of _ \<open>_ * 2\<close>] or_int_rec [of _ \<open>1 + _ * 2\<close>] or_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 lemma bitXOR_integer_unfold [code]:
   "x XOR y =
    (if x = 0 then y
     else if x = - 1 then NOT y
     else Bit_integer (bin_rest_integer x XOR bin_rest_integer y)
       (\<not> bin_last_integer x \<longleftrightarrow> bin_last_integer y))"
   by transfer
     (auto simp add: algebra_simps
       xor_int_rec [of _ \<open>_ * 2\<close>] xor_int_rec [of \<open>_ * 2\<close>] xor_int_rec [of \<open>1 + _ * 2\<close>]
       elim!: evenE oddE)
 
 end
 
 
 section \<open>Test code generator setup\<close>
 
 context
   includes bit_operations_syntax
 begin
 
 definition bit_integer_test :: "bool" where
   "bit_integer_test =
   (([ -1 AND 3, 1 AND -3, 3 AND 5, -3 AND (- 5)
     , -3 OR 1, 1 OR -3, 3 OR 5, -3 OR (- 5)
     , NOT 1, NOT (- 3)
     , -1 XOR 3, 1 XOR (- 3), 3 XOR 5, -5 XOR (- 3)
     , set_bit 5 4 True, set_bit (- 5) 2 True, set_bit 5 0 False, set_bit (- 5) 1 False
     , push_bit 2 1, push_bit 3 (- 1)
     , drop_bit 3 100, drop_bit 3 (- 100)] :: integer list)
   = [ 3, 1, 1, -7
     , -3, -3, 7, -1
     , -2, 2
     , -4, -4, 6, 6
     , 21, -1, 4, -7
     , 4, -8
     , 12, -13] \<and>
     [ bit (5 :: integer) 4, bit (5 :: integer) 2, bit (-5 :: integer) 4, bit (-5 :: integer) 2
     , lsb (5 :: integer), lsb (4 :: integer), lsb (-1 :: integer), lsb (-2 :: integer),
       msb (5 :: integer), msb (0 :: integer), msb (-1 :: integer), msb (-2 :: integer)]
   = [ False, True, True, False,
       True, False, True, False,
       False, False, True, True])"
 
 export_code bit_integer_test checking SML Haskell? Haskell_Quickcheck? OCaml? Scala
 
 notepad begin
 have bit_integer_test by eval
 have bit_integer_test by normalization
 have bit_integer_test by code_simp
 end
 ML_val \<open>val true = @{code bit_integer_test}\<close>
 
 lemma "x AND y = x OR (y :: integer)"
 quickcheck[random, expect=counterexample]
 quickcheck[exhaustive, expect=counterexample]
 oops
 
 lemma "(x :: integer) AND x = x OR x"
 quickcheck[narrowing, expect=no_counterexample]
 oops
 
 lemma "(f :: integer \<Rightarrow> unit) = g"
 quickcheck[narrowing, size=3, expect=no_counterexample]
 by(simp add: fun_eq_iff)
 
 end
 
 hide_const bit_integer_test
 hide_fact bit_integer_test_def
 
 end
diff --git a/thys/Native_Word/Code_Symbolic_Bits_Int.thy b/thys/Native_Word/Code_Symbolic_Bits_Int.thy
--- a/thys/Native_Word/Code_Symbolic_Bits_Int.thy
+++ b/thys/Native_Word/Code_Symbolic_Bits_Int.thy
@@ -1,130 +1,130 @@
 (*  Title:      Code_Symbolic_Bits_Int.thy
     Author:     Andreas Lochbihler, ETH Zurich
 *)
 
 chapter \<open>Symbolic implementation of bit operations on int\<close>
 
 theory Code_Symbolic_Bits_Int
 imports
   "Word_Lib.Least_significant_bit"
   "Word_Lib.Generic_set_bit"
   "Word_Lib.Bit_Comprehension"
 begin
 
 section \<open>Implementations of bit operations on \<^typ>\<open>int\<close> operating on symbolic representation\<close>
 
 context
   includes bit_operations_syntax
 begin
 
 lemma test_bit_int_code [code]:
   "bit (0::int)          n = False"
   "bit (Int.Neg num.One) n = True"
   "bit (Int.Pos num.One)      0 = True"
   "bit (Int.Pos (num.Bit0 m)) 0 = False"
   "bit (Int.Pos (num.Bit1 m)) 0 = True"
   "bit (Int.Neg (num.Bit0 m)) 0 = False"
   "bit (Int.Neg (num.Bit1 m)) 0 = True"
   "bit (Int.Pos num.One)      (Suc n) = False"
   "bit (Int.Pos (num.Bit0 m)) (Suc n) = bit (Int.Pos m) n"
   "bit (Int.Pos (num.Bit1 m)) (Suc n) = bit (Int.Pos m) n"
   "bit (Int.Neg (num.Bit0 m)) (Suc n) = bit (Int.Neg m) n"
   "bit (Int.Neg (num.Bit1 m)) (Suc n) = bit (Int.Neg (Num.inc m)) n"
-  by (simp_all add: Num.add_One bit_Suc)
+  by (simp_all add: Num.add_One bit_0 bit_Suc)
 
 lemma int_not_code [code]:
   "NOT (0 :: int) = -1"
   "NOT (Int.Pos n) = Int.Neg (Num.inc n)"
   "NOT (Int.Neg n) = Num.sub n num.One"
   by (simp_all add: Num.add_One not_int_def)
 
 lemma int_and_code [code]: fixes i j :: int shows
   "0 AND j = 0"
   "i AND 0 = 0"
   "Int.Pos n AND Int.Pos m = (case and_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
   "Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)"
   "Int.Pos n AND Int.Neg num.One = Int.Pos n"
   "Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (or_not_num_neg (Num.BitM m) n) num.One"
   "Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (or_not_num_neg (num.Bit0 m) n) num.One"
   "Int.Neg num.One AND Int.Pos m = Int.Pos m"
   "Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (or_not_num_neg (Num.BitM n) m) num.One"
   "Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (or_not_num_neg (num.Bit0 n) m) num.One"
   apply (simp_all add: and_num_eq_None_iff [where ?'a = int] and_num_eq_Some_iff [where ?'a = int]
     split: option.split)
      apply (simp_all only: sub_one_eq_not_neg numeral_or_not_num_eq minus_minus and_not_numerals
        bit.de_Morgan_disj bit.double_compl and_not_num_eq_None_iff and_not_num_eq_Some_iff ac_simps)
      apply auto
   done
 
 lemma int_or_code [code]: fixes i j :: int shows
   "0 OR j = j"
   "i OR 0 = i"
   "Int.Pos n OR Int.Pos m = Int.Pos (or_num n m)"
   "Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)"
   "Int.Pos n OR Int.Neg num.One = Int.Neg num.One"
   "Int.Pos n OR Int.Neg (num.Bit0 m) = (case and_not_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Pos n OR Int.Neg (num.Bit1 m) = (case and_not_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Neg num.One OR Int.Pos m = Int.Neg num.One"
   "Int.Neg (num.Bit0 n) OR Int.Pos m = (case and_not_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   "Int.Neg (num.Bit1 n) OR Int.Pos m = (case and_not_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))"
   apply (auto simp add: numeral_or_num_eq split: option.splits)
          apply (simp_all only: and_not_num_eq_None_iff and_not_num_eq_Some_iff and_not_numerals
            numeral_or_not_num_eq or_int_def bit.double_compl ac_simps flip: numeral_eq_iff [where ?'a = int])
          apply simp_all
   done
 
 lemma int_xor_code [code]: fixes i j :: int shows
   "0 XOR j = j"
   "i XOR 0 = i"
   "Int.Pos n XOR Int.Pos m = (case xor_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')"
   "Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One"
   "Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)"
   "Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)"
   by (simp_all add: xor_num_eq_None_iff [where ?'a = int] xor_num_eq_Some_iff [where ?'a = int] split: option.split)
 
 lemma bin_rest_code: "i div 2 = drop_bit 1 i" for i :: int
   by (simp add: drop_bit_eq_div)
   
 lemma set_bits_code [code]: 
   "set_bits = Code.abort (STR ''set_bits is unsupported on type int'') (\<lambda>_. set_bits :: _ \<Rightarrow> int)"
   by simp
 
 lemma fixes i :: int 
   shows int_set_bit_True_conv_OR [code]: "Generic_set_bit.set_bit i n True = i OR push_bit n 1"
   and int_set_bit_False_conv_NAND [code]: "Generic_set_bit.set_bit i n False = i AND NOT (push_bit n 1)"
   and int_set_bit_conv_ops: "Generic_set_bit.set_bit i n b = (if b then i OR (push_bit n 1) else i AND NOT (push_bit n 1))"
   by (simp_all add: bit_eq_iff) (auto simp add: bit_simps)
 
 declare [[code drop: \<open>drop_bit :: nat \<Rightarrow> int \<Rightarrow> int\<close>]]
 
 lemma drop_bit_int_code [code]: fixes i :: int shows
   "drop_bit 0 i = i"
   "drop_bit (Suc n) 0 = (0 :: int)"
   "drop_bit (Suc n) (Int.Pos num.One) = 0"
   "drop_bit (Suc n) (Int.Pos (num.Bit0 m)) = drop_bit n (Int.Pos m)"
   "drop_bit (Suc n) (Int.Pos (num.Bit1 m)) = drop_bit n (Int.Pos m)"
   "drop_bit (Suc n) (Int.Neg num.One) = - 1"
   "drop_bit (Suc n) (Int.Neg (num.Bit0 m)) = drop_bit n (Int.Neg m)"
   "drop_bit (Suc n) (Int.Neg (num.Bit1 m)) = drop_bit n (Int.Neg (Num.inc m))"
   by (simp_all add: drop_bit_Suc add_One)
 
 declare [[code drop: \<open>push_bit :: nat \<Rightarrow> int \<Rightarrow> int\<close>]]
 
 lemma push_bit_int_code [code]:
   "push_bit 0 i = i"
   "push_bit (Suc n) i = push_bit n (Int.dup i)"
   by (simp_all add: ac_simps)
 
 lemma int_lsb_code [code]:
   "lsb (0 :: int) = False"
   "lsb (Int.Pos num.One) = True"
   "lsb (Int.Pos (num.Bit0 w)) = False"
   "lsb (Int.Pos (num.Bit1 w)) = True"
   "lsb (Int.Neg num.One) = True"
   "lsb (Int.Neg (num.Bit0 w)) = False"
   "lsb (Int.Neg (num.Bit1 w)) = True"
   by simp_all
 
 end
 
 end
diff --git a/thys/Word_Lib/Ancient_Numeral.thy b/thys/Word_Lib/Ancient_Numeral.thy
--- a/thys/Word_Lib/Ancient_Numeral.thy
+++ b/thys/Word_Lib/Ancient_Numeral.thy
@@ -1,237 +1,237 @@
 (*
  * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 theory Ancient_Numeral
   imports Main Reversed_Bit_Lists Legacy_Aliases
 begin
 
 definition Bit :: "int \<Rightarrow> bool \<Rightarrow> int"  (infixl "BIT" 90)
   where "k BIT b = (if b then 1 else 0) + k + k"
 
 lemma Bit_B0: "k BIT False = k + k"
    by (simp add: Bit_def)
 
 lemma Bit_B1: "k BIT True = k + k + 1"
    by (simp add: Bit_def)
 
 lemma Bit_B0_2t: "k BIT False = 2 * k"
   by (rule trans, rule Bit_B0) simp
 
 lemma Bit_B1_2t: "k BIT True = 2 * k + 1"
   by (rule trans, rule Bit_B1) simp
 
 lemma uminus_Bit_eq:
   "- k BIT b = (- k - of_bool b) BIT b"
   by (cases b) (simp_all add: Bit_def)
 
 lemma power_BIT: "2 ^ Suc n - 1 = (2 ^ n - 1) BIT True"
   by (simp add: Bit_B1)
 
 lemma bin_rl_simp [simp]: "bin_rest w BIT bin_last w = w"
   by (simp add: Bit_def)
 
 lemma bin_rest_BIT [simp]: "bin_rest (x BIT b) = x"
   by (simp add: Bit_def)
 
 lemma even_BIT [simp]: "even (x BIT b) \<longleftrightarrow> \<not> b"
   by (simp add: Bit_def)
 
 lemma bin_last_BIT [simp]: "bin_last (x BIT b) = b"
   by simp
 
 lemma BIT_eq_iff [iff]: "u BIT b = v BIT c \<longleftrightarrow> u = v \<and> b = c"
   by (auto simp: Bit_def) arith+
 
 lemma BIT_bin_simps [simp]:
   "numeral k BIT False = numeral (Num.Bit0 k)"
   "numeral k BIT True = numeral (Num.Bit1 k)"
   "(- numeral k) BIT False = - numeral (Num.Bit0 k)"
   "(- numeral k) BIT True = - numeral (Num.BitM k)"
   by (simp_all only: Bit_B0 Bit_B1 numeral.simps numeral_BitM)
 
 lemma BIT_special_simps [simp]:
   shows "0 BIT False = 0"
     and "0 BIT True = 1"
     and "1 BIT False = 2"
     and "1 BIT True = 3"
     and "(- 1) BIT False = - 2"
     and "(- 1) BIT True = - 1"
   by (simp_all add: Bit_def)
 
 lemma Bit_eq_0_iff: "w BIT b = 0 \<longleftrightarrow> w = 0 \<and> \<not> b"
   by (auto simp: Bit_def) arith
 
 lemma Bit_eq_m1_iff: "w BIT b = -1 \<longleftrightarrow> w = -1 \<and> b"
   by (auto simp: Bit_def) arith
 
 lemma expand_BIT:
   "numeral (Num.Bit0 w) = numeral w BIT False"
   "numeral (Num.Bit1 w) = numeral w BIT True"
   "- numeral (Num.Bit0 w) = (- numeral w) BIT False"
   "- numeral (Num.Bit1 w) = (- numeral (w + Num.One)) BIT True"
   by (simp_all add: BitM_inc_eq add_One)
 
 lemma less_Bits: "v BIT b < w BIT c \<longleftrightarrow> v < w \<or> v \<le> w \<and> \<not> b \<and> c"
   by (auto simp: Bit_def)
 
 lemma le_Bits: "v BIT b \<le> w BIT c \<longleftrightarrow> v < w \<or> v \<le> w \<and> (\<not> b \<or> c)"
   by (auto simp: Bit_def)
 
 lemma pred_BIT_simps [simp]:
   "x BIT False - 1 = (x - 1) BIT True"
   "x BIT True - 1 = x BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma succ_BIT_simps [simp]:
   "x BIT False + 1 = x BIT True"
   "x BIT True + 1 = (x + 1) BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma add_BIT_simps [simp]:
   "x BIT False + y BIT False = (x + y) BIT False"
   "x BIT False + y BIT True = (x + y) BIT True"
   "x BIT True + y BIT False = (x + y) BIT True"
   "x BIT True + y BIT True = (x + y + 1) BIT False"
   by (simp_all add: Bit_B0_2t Bit_B1_2t)
 
 lemma mult_BIT_simps [simp]:
   "x BIT False * y = (x * y) BIT False"
   "x * y BIT False = (x * y) BIT False"
   "x BIT True * y = (x * y) BIT False + y"
   by (simp_all add: Bit_B0_2t Bit_B1_2t algebra_simps)
 
 lemma B_mod_2': "X = 2 \<Longrightarrow> (w BIT True) mod X = 1 \<and> (w BIT False) mod X = 0"
   by (simp add: Bit_B0 Bit_B1)
 
 lemma bin_ex_rl: "\<exists>w b. w BIT b = bin"
   by (metis bin_rl_simp)
 
 lemma bin_exhaust: "(\<And>x b. bin = x BIT b \<Longrightarrow> Q) \<Longrightarrow> Q"
 by (metis bin_ex_rl)
 
 lemma bin_abs_lem: "bin = (w BIT b) \<Longrightarrow> bin \<noteq> -1 \<longrightarrow> bin \<noteq> 0 \<longrightarrow> nat \<bar>w\<bar> < nat \<bar>bin\<bar>"
   apply clarsimp
   apply (unfold Bit_def)
   apply (cases b)
    apply (clarsimp, arith)
   apply (clarsimp, arith)
   done
 
 lemma bin_induct:
   assumes PPls: "P 0"
     and PMin: "P (- 1)"
     and PBit: "\<And>bin bit. P bin \<Longrightarrow> P (bin BIT bit)"
   shows "P bin"
   apply (rule_tac P=P and a=bin and f1="nat \<circ> abs" in wf_measure [THEN wf_induct])
   apply (simp add: measure_def inv_image_def)
   apply (case_tac x rule: bin_exhaust)
   apply (frule bin_abs_lem)
   apply (auto simp add : PPls PMin PBit)
   done
 
 lemma Bit_div2: "(w BIT b) div 2 = w"
   by (fact bin_rest_BIT)
 
 lemma twice_conv_BIT: "2 * x = x BIT False"
   by (simp add: Bit_def)
 
 lemma BIT_lt0 [simp]: "x BIT b < 0 \<longleftrightarrow> x < 0"
 by(cases b)(auto simp add: Bit_def)
 
 lemma BIT_ge0 [simp]: "x BIT b \<ge> 0 \<longleftrightarrow> x \<ge> 0"
 by(cases b)(auto simp add: Bit_def)
 
 lemma bin_to_bl_aux_Bit_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n (w BIT b) bl = bin_to_bl_aux (n - 1) w (b # bl)"
   by (cases n) auto
 
 lemma bl_to_bin_BIT:
   "bl_to_bin bs BIT b = bl_to_bin (bs @ [b])"
   by (simp add: bl_to_bin_append Bit_def)
 
 lemma bin_nth_0_BIT: "bin_nth (w BIT b) 0 \<longleftrightarrow> b"
-  by simp
+  by (simp add: bit_0)
 
 lemma bin_nth_Suc_BIT: "bin_nth (w BIT b) (Suc n) = bin_nth w n"
   by (simp add: bit_Suc)
 
 lemma bin_nth_minus [simp]: "0 < n \<Longrightarrow> bin_nth (w BIT b) n = bin_nth w (n - 1)"
   by (cases n) (simp_all add: bit_Suc)
 
 lemma bin_sign_simps [simp]:
   "bin_sign (w BIT b) = bin_sign w"
   by (simp add: bin_sign_def Bit_def)
 
 lemma bin_nth_Bit: "bin_nth (w BIT b) n \<longleftrightarrow> n = 0 \<and> b \<or> (\<exists>m. n = Suc m \<and> bin_nth w m)"
-  by (cases n) auto
+  by (cases n) (auto simp add: bit_0)
 
 lemmas sbintrunc_Suc_BIT [simp] =
   signed_take_bit_Suc [where a="w BIT b", simplified bin_last_BIT bin_rest_BIT] for w b
 
 lemmas sbintrunc_0_BIT_B0 [simp] =
   signed_take_bit_0 [where a="w BIT False", simplified bin_last_numeral_simps bin_rest_numeral_simps]
   for w
 
 lemmas sbintrunc_0_BIT_B1 [simp] =
   signed_take_bit_0 [where a="w BIT True", simplified bin_last_BIT bin_rest_numeral_simps]
   for w
 
 lemma sbintrunc_Suc_minus_Is:
   \<open>0 < n \<Longrightarrow>
   sbintrunc (n - 1) w = y \<Longrightarrow>
   sbintrunc n (w BIT b) = y BIT b\<close>
   by (cases n) (simp_all add: Bit_def signed_take_bit_Suc)
 
 lemma bin_cat_Suc_Bit: "bin_cat w (Suc n) (v BIT b) = bin_cat w n v BIT b"
   by (auto simp add: Bit_def concat_bit_Suc)
 
 context
   includes bit_operations_syntax
 begin
 
 lemma int_not_BIT [simp]: "NOT (w BIT b) = (NOT w) BIT (\<not> b)"
   by (simp add: not_int_def Bit_def)
 
 lemma int_and_Bits [simp]: "(x BIT b) AND (y BIT c) = (x AND y) BIT (b \<and> c)"
   using and_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 lemma int_or_Bits [simp]: "(x BIT b) OR (y BIT c) = (x OR y) BIT (b \<or> c)"
   using or_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 lemma int_xor_Bits [simp]: "(x BIT b) XOR (y BIT c) = (x XOR y) BIT ((b \<or> c) \<and> \<not> (b \<and> c))"
   using xor_int_rec [of \<open>x BIT b\<close> \<open>y BIT c\<close>] by (auto simp add: Bit_B0_2t Bit_B1_2t)
 
 end
 
 lemma mod_BIT:
   "bin BIT bit mod 2 ^ Suc n = (bin mod 2 ^ n) BIT bit" for bit
 proof -
   have "2 * (bin mod 2 ^ n) + 1 = (2 * bin mod 2 ^ Suc n) + 1"
     by (simp add: mod_mult_mult1)
   also have "\<dots> = ((2 * bin mod 2 ^ Suc n) + 1) mod 2 ^ Suc n"
     by (simp add: ac_simps pos_zmod_mult_2)
   also have "\<dots> = (2 * bin + 1) mod 2 ^ Suc n"
     by (simp only: mod_simps)
   finally show ?thesis
     by (auto simp add: Bit_def)
 qed
 
 lemma minus_BIT_0: fixes x y :: int shows "x BIT b - y BIT False = (x - y) BIT b"
 by(simp add: Bit_def)
 
 lemma int_lsb_BIT [simp]: fixes x :: int shows
   "lsb (x BIT b) \<longleftrightarrow> b"
-by(simp add: lsb_int_def)
+  by (simp add: lsb_int_def bit_0)
 
 lemma int_shiftr_BIT [simp]: fixes x :: int
   shows int_shiftr0: "drop_bit 0 x = x"
   and int_shiftr_Suc: "drop_bit (Suc n) (x BIT b) = drop_bit n x"
   by (simp_all add: drop_bit_Suc)
 
 lemma msb_BIT [simp]: "msb (x BIT b) = msb x"
 by(simp add: msb_int_def)
 
 end
\ No newline at end of file
diff --git a/thys/Word_Lib/Bit_Comprehension.thy b/thys/Word_Lib/Bit_Comprehension.thy
--- a/thys/Word_Lib/Bit_Comprehension.thy
+++ b/thys/Word_Lib/Bit_Comprehension.thy
@@ -1,251 +1,251 @@
 (*
  * Copyright Brian Huffman, PSU; Jeremy Dawson and Gerwin Klein, NICTA
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Comprehension syntax for bit expressions\<close>
 
 theory Bit_Comprehension
   imports
     "HOL-Library.Word"
 begin
 
 class bit_comprehension = ring_bit_operations +
   fixes set_bits :: \<open>(nat \<Rightarrow> bool) \<Rightarrow> 'a\<close>  (binder \<open>BITS \<close> 10)
   assumes set_bits_bit_eq: \<open>set_bits (bit a) = a\<close>
 begin
 
 lemma set_bits_False_eq [simp]:
   \<open>(BITS _. False) = 0\<close>
   using set_bits_bit_eq [of 0] by (simp add: bot_fun_def)
 
 end
 
 instantiation int :: bit_comprehension
 begin
 
 definition
   \<open>set_bits f = (
       if \<exists>n. \<forall>m\<ge>n. f m = f n then
       let n = LEAST n. \<forall>m\<ge>n. f m = f n
       in signed_take_bit n (horner_sum of_bool 2 (map f [0..<Suc n]))
      else 0 :: int)\<close>
 
 instance proof
   fix k :: int
   from int_bit_bound [of k]
   obtain n where *: \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>
     and **: \<open>n > 0 \<Longrightarrow> bit k (n - 1) \<noteq> bit k n\<close>
     by blast
   then have ***: \<open>\<exists>n. \<forall>n'\<ge>n. bit k n' \<longleftrightarrow> bit k n\<close>
     by meson
   have l: \<open>(LEAST q. \<forall>m\<ge>q. bit k m \<longleftrightarrow> bit k q) = n\<close>
     apply (rule Least_equality)
     using * apply blast
     apply (metis "**" One_nat_def Suc_pred le_cases le0 neq0_conv not_less_eq_eq)
     done
   show \<open>set_bits (bit k) = k\<close>
     apply (simp only: *** set_bits_int_def horner_sum_bit_eq_take_bit l)
     apply simp
     apply (rule bit_eqI)
     apply (simp add: bit_signed_take_bit_iff min_def)
     apply (auto simp add: not_le bit_take_bit_iff dest: *)
     done
 qed
 
 end
 
 lemma int_set_bits_K_False [simp]: "(BITS _. False) = (0 :: int)"
   by (simp add: set_bits_int_def)
 
 lemma int_set_bits_K_True [simp]: "(BITS _. True) = (-1 :: int)"
   by (simp add: set_bits_int_def)
 
 instantiation word :: (len) bit_comprehension
 begin
 
 definition word_set_bits_def:
   \<open>(BITS n. P n) = (horner_sum of_bool 2 (map P [0..<LENGTH('a)]) :: 'a word)\<close>
 
 instance by standard
   (simp add: word_set_bits_def horner_sum_bit_eq_take_bit)
 
 end
 
 lemma bit_set_bits_word_iff [bit_simps]:
   \<open>bit (set_bits P :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> P n\<close>
   by (auto simp add: word_set_bits_def bit_horner_sum_bit_word_iff)
 
 lemma set_bits_K_False [simp]:
   \<open>set_bits (\<lambda>_. False) = (0 :: 'a :: len word)\<close>
   by (rule bit_word_eqI) (simp add: bit_set_bits_word_iff)
 
 lemma set_bits_int_unfold':
   \<open>set_bits f =
     (if \<exists>n. \<forall>n'\<ge>n. \<not> f n' then
       let n = LEAST n. \<forall>n'\<ge>n. \<not> f n'
       in horner_sum of_bool 2 (map f [0..<n])
      else if \<exists>n. \<forall>n'\<ge>n. f n' then
       let n = LEAST n. \<forall>n'\<ge>n. f n'
       in signed_take_bit n (horner_sum of_bool 2 (map f [0..<n] @ [True]))
      else 0 :: int)\<close>
 proof (cases \<open>\<exists>n. \<forall>m\<ge>n. f m \<longleftrightarrow> f n\<close>)
   case True
   then obtain q where q: \<open>\<forall>m\<ge>q. f m \<longleftrightarrow> f q\<close>
     by blast
   define n where \<open>n = (LEAST n. \<forall>m\<ge>n. f m \<longleftrightarrow> f n)\<close>
   have \<open>\<forall>m\<ge>n. f m \<longleftrightarrow> f n\<close>
     unfolding n_def
     using q by (rule LeastI [of _ q])
   then have n: \<open>\<And>m. n \<le> m \<Longrightarrow> f m \<longleftrightarrow> f n\<close>
     by blast
   from n_def have n_eq: \<open>(LEAST q. \<forall>m\<ge>q. f m \<longleftrightarrow> f n) = n\<close>
     by (smt (verit, best) Least_le \<open>\<forall>m\<ge>n. f m = f n\<close> dual_order.antisym wellorder_Least_lemma(1))
   show ?thesis
   proof (cases \<open>f n\<close>)
     case False
     with n have *: \<open>\<exists>n. \<forall>n'\<ge>n. \<not> f n'\<close>
       by blast
     have **: \<open>(LEAST n. \<forall>n'\<ge>n. \<not> f n') = n\<close>
       using False n_eq by simp
     from * False show ?thesis
     apply (simp add: set_bits_int_def n_def [symmetric] ** del: upt.upt_Suc)
     apply (auto simp add: take_bit_horner_sum_bit_eq
       bit_horner_sum_bit_iff take_map
       signed_take_bit_def set_bits_int_def
       horner_sum_bit_eq_take_bit simp del: upt.upt_Suc)
     done
   next
     case True
     with n have *: \<open>\<exists>n. \<forall>n'\<ge>n. f n'\<close>
       by blast
     have ***: \<open>\<not> (\<exists>n. \<forall>n'\<ge>n. \<not> f n')\<close>
       apply (rule ccontr)
       using * nat_le_linear by auto
     have **: \<open>(LEAST n. \<forall>n'\<ge>n. f n') = n\<close>
       using True n_eq by simp
     from * *** True show ?thesis
     apply (simp add: set_bits_int_def n_def [symmetric] ** del: upt.upt_Suc)
     apply (auto simp add: take_bit_horner_sum_bit_eq
       bit_horner_sum_bit_iff take_map
       signed_take_bit_def set_bits_int_def
       horner_sum_bit_eq_take_bit nth_append simp del: upt.upt_Suc)
     done
   qed
 next
   case False
   then show ?thesis
     by (auto simp add: set_bits_int_def)
 qed
 
 inductive wf_set_bits_int :: "(nat \<Rightarrow> bool) \<Rightarrow> bool"
   for f :: "nat \<Rightarrow> bool"
 where
   zeros: "\<forall>n' \<ge> n. \<not> f n' \<Longrightarrow> wf_set_bits_int f"
 | ones: "\<forall>n' \<ge> n. f n' \<Longrightarrow> wf_set_bits_int f"
 
 lemma wf_set_bits_int_simps: "wf_set_bits_int f \<longleftrightarrow> (\<exists>n. (\<forall>n'\<ge>n. \<not> f n') \<or> (\<forall>n'\<ge>n. f n'))"
 by(auto simp add: wf_set_bits_int.simps)
 
 lemma wf_set_bits_int_const [simp]: "wf_set_bits_int (\<lambda>_. b)"
 by(cases b)(auto intro: wf_set_bits_int.intros)
 
 lemma wf_set_bits_int_fun_upd [simp]:
   "wf_set_bits_int (f(n := b)) \<longleftrightarrow> wf_set_bits_int f" (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then obtain n'
     where "(\<forall>n''\<ge>n'. \<not> (f(n := b)) n'') \<or> (\<forall>n''\<ge>n'. (f(n := b)) n'')"
     by(auto simp add: wf_set_bits_int_simps)
   hence "(\<forall>n''\<ge>max (Suc n) n'. \<not> f n'') \<or> (\<forall>n''\<ge>max (Suc n) n'. f n'')" by auto
   thus ?rhs by(auto simp only: wf_set_bits_int_simps)
 next
   assume ?rhs
   then obtain n' where "(\<forall>n''\<ge>n'. \<not> f n'') \<or> (\<forall>n''\<ge>n'. f n'')" (is "?wf f n'")
     by(auto simp add: wf_set_bits_int_simps)
   hence "?wf (f(n := b)) (max (Suc n) n')" by auto
   thus ?lhs by(auto simp only: wf_set_bits_int_simps)
 qed
 
 lemma wf_set_bits_int_Suc [simp]:
   "wf_set_bits_int (\<lambda>n. f (Suc n)) \<longleftrightarrow> wf_set_bits_int f" (is "?lhs \<longleftrightarrow> ?rhs")
 by(auto simp add: wf_set_bits_int_simps intro: le_SucI dest: Suc_le_D)
 
 context
   fixes f
   assumes wff: "wf_set_bits_int f"
 begin
 
 lemma int_set_bits_unfold_BIT:
   "set_bits f = of_bool (f 0) + (2 :: int) * set_bits (f \<circ> Suc)"
 using wff proof cases
   case (zeros n)
   show ?thesis
   proof(cases "\<forall>n. \<not> f n")
     case True
     hence "f = (\<lambda>_. False)" by auto
     thus ?thesis using True by(simp add: o_def)
   next
     case False
     then obtain n' where "f n'" by blast
     with zeros have "(LEAST n. \<forall>n'\<ge>n. \<not> f n') = Suc (LEAST n. \<forall>n'\<ge>Suc n. \<not> f n')"
       by(auto intro: Least_Suc)
     also have "(\<lambda>n. \<forall>n'\<ge>Suc n. \<not> f n') = (\<lambda>n. \<forall>n'\<ge>n. \<not> f (Suc n'))" by(auto dest: Suc_le_D)
     also from zeros have "\<forall>n'\<ge>n. \<not> f (Suc n')" by auto
     ultimately show ?thesis using zeros
       apply (simp (no_asm_simp) add: set_bits_int_unfold' exI
         del: upt.upt_Suc flip: map_map split del: if_split)
       apply (simp only: map_Suc_upt upt_conv_Cons)
       apply simp
       done
   qed
 next
   case (ones n)
   show ?thesis
   proof(cases "\<forall>n. f n")
     case True
     hence "f = (\<lambda>_. True)" by auto
     thus ?thesis using True by(simp add: o_def)
   next
     case False
     then obtain n' where "\<not> f n'" by blast
     with ones have "(LEAST n. \<forall>n'\<ge>n. f n') = Suc (LEAST n. \<forall>n'\<ge>Suc n. f n')"
       by(auto intro: Least_Suc)
     also have "(\<lambda>n. \<forall>n'\<ge>Suc n. f n') = (\<lambda>n. \<forall>n'\<ge>n. f (Suc n'))" by(auto dest: Suc_le_D)
     also from ones have "\<forall>n'\<ge>n. f (Suc n')" by auto
     moreover from ones have "(\<exists>n. \<forall>n'\<ge>n. \<not> f n') = False"
       by(auto intro!: exI[where x="max n m" for n m] simp add: max_def split: if_split_asm)
     moreover hence "(\<exists>n. \<forall>n'\<ge>n. \<not> f (Suc n')) = False"
       by(auto elim: allE[where x="Suc n" for n] dest: Suc_le_D)
     ultimately show ?thesis using ones
       apply (simp (no_asm_simp) add: set_bits_int_unfold' exI split del: if_split)
       apply (auto simp add: Let_def hd_map map_tl[symmetric] map_map[symmetric] map_Suc_upt upt_conv_Cons signed_take_bit_Suc
         not_le simp del: map_map)
       done
   qed
 qed
 
 lemma bin_last_set_bits [simp]:
   "odd (set_bits f :: int) = f 0"
   by (subst int_set_bits_unfold_BIT) simp_all
 
 lemma bin_rest_set_bits [simp]:
   "set_bits f div (2 :: int) = set_bits (f \<circ> Suc)"
   by (subst int_set_bits_unfold_BIT) simp_all
 
 lemma bin_nth_set_bits [simp]:
   "bit (set_bits f :: int) m \<longleftrightarrow> f m"
 using wff proof (induction m arbitrary: f)
   case 0
   then show ?case
-    by (simp add: Bit_Comprehension.bin_last_set_bits)
+    by (simp add: Bit_Comprehension.bin_last_set_bits bit_0)
 next
   case Suc
   from Suc.IH [of "f \<circ> Suc"] Suc.prems show ?case
     by (simp add: Bit_Comprehension.bin_rest_set_bits comp_def bit_Suc)
 qed
 
 end
 
 end
diff --git a/thys/Word_Lib/Bits_Int.thy b/thys/Word_Lib/Bits_Int.thy
--- a/thys/Word_Lib/Bits_Int.thy
+++ b/thys/Word_Lib/Bits_Int.thy
@@ -1,1572 +1,1558 @@
 (*
  * Copyright Brian Huffman, PSU; Jeremy Dawson and Gerwin Klein, NICTA
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Bitwise Operations on integers\<close>
 
 theory Bits_Int
   imports
     "Word_Lib.Most_significant_bit"
     "Word_Lib.Least_significant_bit"
     "Word_Lib.Generic_set_bit"
     "Word_Lib.Bit_Comprehension"
 begin
 
 subsection \<open>Implicit bit representation of \<^typ>\<open>int\<close>\<close>
 
 lemma bin_last_def:
   "(odd :: int \<Rightarrow> bool) w \<longleftrightarrow> w mod 2 = 1"
   by (fact odd_iff_mod_2_eq_one)
 
 lemma bin_last_numeral_simps [simp]:
   "\<not> odd (0 :: int)"
   "odd (1 :: int)"
   "odd (- 1 :: int)"
   "odd (Numeral1 :: int)"
   "\<not> odd (numeral (Num.Bit0 w) :: int)"
   "odd (numeral (Num.Bit1 w) :: int)"
   "\<not> odd (- numeral (Num.Bit0 w) :: int)"
   "odd (- numeral (Num.Bit1 w) :: int)"
   by simp_all
 
 lemma bin_rest_numeral_simps [simp]:
   "(\<lambda>k::int. k div 2) 0 = 0"
   "(\<lambda>k::int. k div 2) 1 = 0"
   "(\<lambda>k::int. k div 2) (- 1) = - 1"
   "(\<lambda>k::int. k div 2) Numeral1 = 0"
   "(\<lambda>k::int. k div 2) (numeral (Num.Bit0 w)) = numeral w"
   "(\<lambda>k::int. k div 2) (numeral (Num.Bit1 w)) = numeral w"
   "(\<lambda>k::int. k div 2) (- numeral (Num.Bit0 w)) = - numeral w"
   "(\<lambda>k::int. k div 2) (- numeral (Num.Bit1 w)) = - numeral (w + Num.One)"
   by simp_all
 
 lemma bin_rl_eqI: "\<lbrakk>(\<lambda>k::int. k div 2) x = (\<lambda>k::int. k div 2) y; odd x = odd y\<rbrakk> \<Longrightarrow> x = y"
   by (auto elim: oddE)
 
 lemma [simp]:
   shows bin_rest_lt0: "(\<lambda>k::int. k div 2) i < 0 \<longleftrightarrow> i < 0"
   and  bin_rest_ge_0: "(\<lambda>k::int. k div 2) i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
   by auto
 
 lemma bin_rest_gt_0 [simp]: "(\<lambda>k::int. k div 2) x > 0 \<longleftrightarrow> x > 1"
   by auto
 
 
 subsection \<open>Bit projection\<close>
 
 lemma bin_nth_eq_iff: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) x = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y \<longleftrightarrow> x = y"
   by (simp add: bit_eq_iff fun_eq_iff)
 
 lemma bin_eqI:
   "x = y" if "\<And>n. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   using that by (rule bit_eqI)
 
 lemma bin_eq_iff: "x = y \<longleftrightarrow> (\<forall>n. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n)"
   by (metis bit_eq_iff)
 
 lemma bin_nth_zero [simp]: "\<not> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) 0 n"
   by simp
 
 lemma bin_nth_1 [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) 1 n \<longleftrightarrow> n = 0"
   by (cases n) (simp_all add: bit_Suc)
 
 lemma bin_nth_minus1 [simp]: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (- 1) n"
   by simp
 
 lemma bin_nth_numeral: "(\<lambda>k::int. k div 2) x = y \<Longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (numeral n) = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y (pred_numeral n)"
   by (simp add: numeral_eq_Suc bit_Suc)
 
 lemmas bin_nth_numeral_simps [simp] =
   bin_nth_numeral [OF bin_rest_numeral_simps(8)]
 
 lemmas bin_nth_simps =
   bit_0 bit_Suc bin_nth_zero bin_nth_minus1
   bin_nth_numeral_simps
 
 lemma nth_2p_bin: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (2 ^ n) m = (m = n)" \<comment> \<open>for use when simplifying with \<open>bin_nth_Bit\<close>\<close>
   by (auto simp add: bit_exp_iff)
 
 lemma nth_rest_power_bin: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (((\<lambda>k::int. k div 2) ^^ k) w) n = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w (n + k)"
   apply (induct k arbitrary: n)
    apply clarsimp
   apply clarsimp
   apply (simp only: bit_Suc [symmetric] add_Suc)
   done
 
 lemma bin_nth_numeral_unfold:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (num.Bit0 x)) n \<longleftrightarrow> n > 0 \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral x) (n - 1)"
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (num.Bit1 x)) n \<longleftrightarrow> (n > 0 \<longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral x) (n - 1))"
   by (cases n; simp)+
 
 
 subsection \<open>Truncating\<close>
 
 definition bin_sign :: "int \<Rightarrow> int"
   where "bin_sign k = (if k \<ge> 0 then 0 else - 1)"
 
 lemma bin_sign_simps [simp]:
   "bin_sign 0 = 0"
   "bin_sign 1 = 0"
   "bin_sign (- 1) = - 1"
   "bin_sign (numeral k) = 0"
   "bin_sign (- numeral k) = -1"
   by (simp_all add: bin_sign_def)
 
 lemma bin_sign_rest [simp]: "bin_sign ((\<lambda>k::int. k div 2) w) = bin_sign w"
   by (simp add: bin_sign_def)
 
 lemma bintrunc_mod2p: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w = w mod 2 ^ n"
   by (fact take_bit_eq_mod)
 
 lemma sbintrunc_mod2p: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w = (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n"
   by (simp add: bintrunc_mod2p signed_take_bit_eq_take_bit_shift)
 
 lemma sbintrunc_eq_take_bit:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n\<close>
   by (fact signed_take_bit_eq_take_bit_shift)
 
 lemma sign_bintr: "bin_sign ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = 0"
   by (simp add: bin_sign_def)
 
 lemma bintrunc_n_0: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 0"
   by (fact take_bit_of_0)
 
 lemma sbintrunc_n_0: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 0"
   by (fact signed_take_bit_of_0)
 
 lemma sbintrunc_n_minus1: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = -1"
   by (fact signed_take_bit_of_minus_1)
 
 lemma bintrunc_Suc_numeral:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) 1 = 1"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- 1) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit0 w)) = 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit1 w)) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit0 w)) = 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral (w + Num.One))"
   by (simp_all add: take_bit_Suc del: take_bit_minus_one_eq_mask)
 
 lemma sbintrunc_0_numeral [simp]:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 1 = -1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (numeral (Num.Bit0 w)) = 0"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (numeral (Num.Bit1 w)) = -1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (- numeral (Num.Bit0 w)) = 0"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 0 (- numeral (Num.Bit1 w)) = -1"
   by simp_all
 
 lemma sbintrunc_Suc_numeral:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) 1 = 1"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit0 w)) = 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (numeral (Num.Bit1 w)) = 1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit0 w)) = 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- numeral (w + Num.One))"
   by (simp_all add: signed_take_bit_Suc)
 
 lemma bin_sign_lem: "(bin_sign ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = -1) = bit bin n"
   by (simp add: bin_sign_def)
 
 lemma nth_bintr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) n \<longleftrightarrow> n < m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n"
   by (fact bit_take_bit_iff)
 
 lemma nth_sbintr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) n = (if n < m then (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w m)"
   by (simp add: bit_signed_take_bit_iff min_def)
 
 lemma bin_nth_Bit0:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (Num.Bit0 w)) n \<longleftrightarrow>
     (\<exists>m. n = Suc m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral w) m)"
   using bit_double_iff [of \<open>numeral w :: int\<close> n]
   by (auto intro: exI [of _ \<open>n - 1\<close>])
 
 lemma bin_nth_Bit1:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral (Num.Bit1 w)) n \<longleftrightarrow>
     n = 0 \<or> (\<exists>m. n = Suc m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (numeral w) m)"
   using even_bit_succ_iff [of \<open>2 * numeral w :: int\<close> n]
     bit_double_iff [of \<open>numeral w :: int\<close> n]
   by auto
 
 lemma bintrunc_bintrunc_l: "n \<le> m \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by simp
 
 lemma sbintrunc_sbintrunc_l: "n \<le> m \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by simp
 
 lemma bintrunc_bintrunc_ge: "n \<le> m \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (rule bin_eqI) (auto simp: nth_bintr)
 
 lemma bintrunc_bintrunc_min [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) w"
   by (rule take_bit_take_bit)
 
 lemma sbintrunc_sbintrunc_min [simp]: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) w"
   by (rule signed_take_bit_signed_take_bit)
 
 lemmas sbintrunc_Suc_Pls =
   signed_take_bit_Suc [where a="0::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Suc_Min =
   signed_take_bit_Suc [where a="-1::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Sucs = sbintrunc_Suc_Pls sbintrunc_Suc_Min
   sbintrunc_Suc_numeral
 
 lemmas sbintrunc_Pls =
   signed_take_bit_0 [where a="0::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_Min =
   signed_take_bit_0 [where a="-1::int", simplified bin_last_numeral_simps bin_rest_numeral_simps]
 
 lemmas sbintrunc_0_simps =
   sbintrunc_Pls sbintrunc_Min
 
 lemmas sbintrunc_simps = sbintrunc_0_simps sbintrunc_Sucs
 
 lemma bintrunc_minus: "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc (n - 1)) w = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by auto
 
 lemma sbintrunc_minus: "0 < n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc (n - 1)) w = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by auto
 
 lemmas sbintrunc_minus_simps =
   sbintrunc_Sucs [THEN [2] sbintrunc_minus [symmetric, THEN trans]]
 
 lemma sbintrunc_BIT_I:
   \<open>0 < n \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) 0 = y \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n 0 = 2 * y\<close>
   by simp
 
 lemma sbintrunc_Suc_Is:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = y \<Longrightarrow>
   (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) (- 1) = 1 + 2 * y\<close>
   by auto
 
 lemma sbintrunc_Suc_lem: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) x = y \<Longrightarrow> m = Suc n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m x = y"
   by (rule ssubst)
 
 lemmas sbintrunc_Suc_Ialts =
   sbintrunc_Suc_Is [THEN sbintrunc_Suc_lem]
 
 lemma sbintrunc_bintrunc_lt: "m > n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (rule bin_eqI) (auto simp: nth_sbintr nth_bintr)
 
 lemma bintrunc_sbintrunc_le: "m \<le> Suc n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w"
   by (rule take_bit_signed_take_bit)
 
 lemmas bintrunc_sbintrunc [simp] = order_refl [THEN bintrunc_sbintrunc_le]
 lemmas sbintrunc_bintrunc [simp] = lessI [THEN sbintrunc_bintrunc_lt]
 lemmas bintrunc_bintrunc [simp] = order_refl [THEN bintrunc_bintrunc_l]
 lemmas sbintrunc_sbintrunc [simp] = order_refl [THEN sbintrunc_sbintrunc_l]
 
 lemma bintrunc_sbintrunc' [simp]: "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) w) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (cases n) simp_all
 
 lemma sbintrunc_bintrunc' [simp]: "0 < n \<Longrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) w"
   by (cases n) simp_all
 
 lemma bin_sbin_eq_iff: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) y \<longleftrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y"
   apply (rule iffI)
    apply (rule box_equals [OF _ sbintrunc_bintrunc sbintrunc_bintrunc])
    apply simp
   apply (rule box_equals [OF _ bintrunc_sbintrunc bintrunc_sbintrunc])
   apply simp
   done
 
 lemma bin_sbin_eq_iff':
   "0 < n \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y \<longleftrightarrow> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) y"
   by (cases n) (simp_all add: bin_sbin_eq_iff)
 
 lemmas bintrunc_sbintruncS0 [simp] = bintrunc_sbintrunc' [unfolded One_nat_def]
 lemmas sbintrunc_bintruncS0 [simp] = sbintrunc_bintrunc' [unfolded One_nat_def]
 
 lemmas bintrunc_bintrunc_l' = le_add1 [THEN bintrunc_bintrunc_l]
 lemmas sbintrunc_sbintrunc_l' = le_add1 [THEN sbintrunc_sbintrunc_l]
 
 (* although bintrunc_minus_simps, if added to default simpset,
   tends to get applied where it's not wanted in developing the theories,
   we get a version for when the word length is given literally *)
 
 lemmas nat_non0_gr =
   trans [OF iszero_def [THEN Not_eq_iff [THEN iffD2]] refl]
 
 lemma bintrunc_numeral:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) x = of_bool (odd x) + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (x div 2)"
   by (simp add: numeral_eq_Suc take_bit_Suc mod_2_eq_odd)
 
 lemma sbintrunc_numeral:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) x = of_bool (odd x) + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (x div 2)"
   by (simp add: numeral_eq_Suc signed_take_bit_Suc mod2_eq_if)
 
 lemma bintrunc_numeral_simps [simp]:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit0 w)) =
     2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit1 w)) =
     1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit0 w)) =
     2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral w)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit1 w)) =
     1 + 2 * (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral (w + Num.One))"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) 1 = 1"
   by (simp_all add: bintrunc_numeral)
 
 lemma sbintrunc_numeral_simps [simp]:
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit0 w)) =
     2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (numeral (Num.Bit1 w)) =
     1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit0 w)) =
     2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral w)"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) (- numeral (Num.Bit1 w)) =
     1 + 2 * (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (pred_numeral k) (- numeral (w + Num.One))"
   "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (numeral k) 1 = 1"
   by (simp_all add: sbintrunc_numeral)
 
 lemma no_bintr_alt1: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>w. w mod 2 ^ n :: int)"
   by (rule ext) (rule bintrunc_mod2p)
 
 lemma range_bintrunc: "range ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) = {i. 0 \<le> i \<and> i < 2 ^ n}"
   by (auto simp add: take_bit_eq_mod image_iff) (metis mod_pos_pos_trivial)
 
 lemma no_sbintr_alt2: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>w. (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
   by (rule ext) (simp add : sbintrunc_mod2p)
 
 lemma range_sbintrunc: "range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) = {i. - (2 ^ n) \<le> i \<and> i < 2 ^ n}"
 proof -
   have \<open>surj (\<lambda>k::int. k + 2 ^ n)\<close>
     by (rule surjI [of _ \<open>(\<lambda>k. k - 2 ^ n)\<close>]) simp
   moreover have \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = ((\<lambda>k. k - 2 ^ n) \<circ> take_bit (Suc n) \<circ> (\<lambda>k. k + 2 ^ n))\<close>
     by (simp add: sbintrunc_eq_take_bit fun_eq_iff)
   ultimately show ?thesis
     apply (simp only: fun.set_map range_bintrunc)
     apply (auto simp add: image_iff)
     apply presburger
     done
 qed
 
 lemma sbintrunc_inc:
   \<open>k + 2 ^ Suc n \<le> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k\<close> if \<open>k < - (2 ^ n)\<close>
   using that by (fact signed_take_bit_int_greater_eq)
 
 lemma sbintrunc_dec:
   \<open>(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n k \<le> k - 2 ^ (Suc n)\<close> if \<open>k \<ge> 2 ^ n\<close>
   using that by (fact signed_take_bit_int_less_eq)
 
 lemma bintr_ge0: "0 \<le> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bintrunc_mod2p)
 
 lemma bintr_lt2p: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w < 2 ^ n"
   by (simp add: bintrunc_mod2p)
 
 lemma bintr_Min: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1) = 2 ^ n - 1"
   by (simp add: stable_imp_take_bit_eq mask_eq_exp_minus_1)
 
 lemma sbintr_ge: "- (2 ^ n) \<le> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (fact signed_take_bit_int_greater_eq_minus_exp)
 
 lemma sbintr_lt: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w < 2 ^ n"
   by (fact signed_take_bit_int_less_exp)
 
 lemma sign_Pls_ge_0: "bin_sign bin = 0 \<longleftrightarrow> bin \<ge> 0"
   for bin :: int
   by (simp add: bin_sign_def)
 
 lemma sign_Min_lt_0: "bin_sign bin = -1 \<longleftrightarrow> bin < 0"
   for bin :: int
   by (simp add: bin_sign_def)
 
 lemma bin_rest_trunc: "(\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - 1) ((\<lambda>k::int. k div 2) bin)"
   by (simp add: take_bit_rec [of n bin])
 
 lemma bin_rest_power_trunc:
   "((\<lambda>k::int. k div 2) ^^ k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (n - k) (((\<lambda>k::int. k div 2) ^^ k) bin)"
   by (induct k) (auto simp: bin_rest_trunc)
 
 lemma bin_rest_trunc_i: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) bin) = (\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) bin)"
   by (auto simp add: take_bit_Suc)
 
 lemma bin_rest_strunc: "(\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (Suc n) bin) = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) bin)"
   by (simp add: signed_take_bit_Suc)
 
 lemma bintrunc_rest [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)) = (\<lambda>k::int. k div 2) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)"
   by (induct n arbitrary: bin) (simp_all add: take_bit_Suc)
 
 lemma sbintrunc_rest [simp]: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)) = (\<lambda>k::int. k div 2) ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n bin)"
   by (induct n arbitrary: bin) (simp_all add: signed_take_bit_Suc mod2_eq_if)
 
 lemma bintrunc_rest': "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n \<circ> (\<lambda>k::int. k div 2) \<circ> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>k::int. k div 2) \<circ> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n"
   by (rule ext) auto
 
 lemma sbintrunc_rest': "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n \<circ> (\<lambda>k::int. k div 2) \<circ> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n = (\<lambda>k::int. k div 2) \<circ> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n"
   by (rule ext) auto
 
 lemma rco_lem: "f \<circ> g \<circ> f = g \<circ> f \<Longrightarrow> f \<circ> (g \<circ> f) ^^ n = g ^^ n \<circ> f"
   apply (rule ext)
   apply (induct_tac n)
    apply (simp_all (no_asm))
   apply (drule fun_cong)
   apply (unfold o_def)
   apply (erule trans)
   apply simp
   done
 
 lemmas rco_bintr = bintrunc_rest'
   [THEN rco_lem [THEN fun_cong], unfolded o_def]
 lemmas rco_sbintr = sbintrunc_rest'
   [THEN rco_lem [THEN fun_cong], unfolded o_def]
 
 
 subsection \<open>Splitting and concatenation\<close>
 
 definition bin_split :: \<open>nat \<Rightarrow> int \<Rightarrow> int \<times> int\<close>
   where [simp]: \<open>bin_split n k = (drop_bit n k, take_bit n k)\<close>
 
 lemma [code]:
   "bin_split (Suc n) w = (let (w1, w2) = bin_split n (w div 2) in (w1, of_bool (odd w) + 2 * w2))"
   "bin_split 0 w = (w, 0)"
   by (simp_all add: drop_bit_Suc take_bit_Suc mod_2_eq_odd)
 
 lemma bin_cat_eq_push_bit_add_take_bit:
   \<open>concat_bit n l k = push_bit n k + take_bit n l\<close>
   by (simp add: concat_bit_eq)
 
 lemma bin_sign_cat: "bin_sign ((\<lambda>k n l. concat_bit n l k) x n y) = bin_sign x"
 proof -
   have \<open>0 \<le> x\<close> if \<open>0 \<le> x * 2 ^ n + y mod 2 ^ n\<close>
   proof -
     have \<open>y mod 2 ^ n < 2 ^ n\<close>
       using pos_mod_bound [of \<open>2 ^ n\<close> y] by simp
     then have \<open>\<not> y mod 2 ^ n \<ge> 2 ^ n\<close>
       by (simp add: less_le)
     with that have \<open>x \<noteq> - 1\<close>
       by auto
     have *: \<open>- 1 \<le> (- (y mod 2 ^ n)) div 2 ^ n\<close>
       by (simp add: zdiv_zminus1_eq_if)
     from that have \<open>- (y mod 2 ^ n) \<le> x * 2 ^ n\<close>
       by simp
     then have \<open>(- (y mod 2 ^ n)) div 2 ^ n \<le> (x * 2 ^ n) div 2 ^ n\<close>
       using zdiv_mono1 zero_less_numeral zero_less_power by blast
     with * have \<open>- 1 \<le> x * 2 ^ n div 2 ^ n\<close> by simp
     with \<open>x \<noteq> - 1\<close> show ?thesis
       by simp
   qed
   then show ?thesis
     by (simp add: bin_sign_def not_le not_less bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult take_bit_eq_mod)
 qed
 
 lemma bin_cat_assoc: "(\<lambda>k n l. concat_bit n l k) ((\<lambda>k n l. concat_bit n l k) x m y) n z = (\<lambda>k n l. concat_bit n l k) x (m + n) ((\<lambda>k n l. concat_bit n l k) y n z)"
   by (fact concat_bit_assoc)
 
 lemma bin_cat_assoc_sym: "(\<lambda>k n l. concat_bit n l k) x m ((\<lambda>k n l. concat_bit n l k) y n z) = (\<lambda>k n l. concat_bit n l k) ((\<lambda>k n l. concat_bit n l k) x (m - n) y) (min m n) z"
   by (fact concat_bit_assoc_sym)
 
 definition bin_rcat :: \<open>nat \<Rightarrow> int list \<Rightarrow> int\<close>
   where \<open>bin_rcat n = horner_sum (take_bit n) (2 ^ n) \<circ> rev\<close>
 
 lemma bin_rcat_eq_foldl:
   \<open>bin_rcat n = foldl (\<lambda>u v. (\<lambda>k n l. concat_bit n l k) u n v) 0\<close>
 proof
   fix ks :: \<open>int list\<close>
   show \<open>bin_rcat n ks = foldl (\<lambda>u v. (\<lambda>k n l. concat_bit n l k) u n v) 0 ks\<close>
     by (induction ks rule: rev_induct)
       (simp_all add: bin_rcat_def concat_bit_eq push_bit_eq_mult)
 qed
 
 fun bin_rsplit_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   where "bin_rsplit_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else
       let (a, b) = bin_split n c
       in bin_rsplit_aux n (m - n) a (b # bs))"
 
 definition bin_rsplit :: "nat \<Rightarrow> nat \<times> int \<Rightarrow> int list"
   where "bin_rsplit n w = bin_rsplit_aux n (fst w) (snd w) []"
 
 fun bin_rsplitl_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   where "bin_rsplitl_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else
       let (a, b) = bin_split (min m n) c
       in bin_rsplitl_aux n (m - n) a (b # bs))"
 
 definition bin_rsplitl :: "nat \<Rightarrow> nat \<times> int \<Rightarrow> int list"
   where "bin_rsplitl n w = bin_rsplitl_aux n (fst w) (snd w) []"
 
 declare bin_rsplit_aux.simps [simp del]
 declare bin_rsplitl_aux.simps [simp del]
 
 lemma bin_nth_cat:
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) ((\<lambda>k n l. concat_bit n l k) x k y) n =
     (if n < k then (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (n - k))"
   by (simp add: bit_concat_bit_iff)
 
 lemma bin_nth_drop_bit_iff:
   \<open>(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (drop_bit n c) k \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c (n + k)\<close>
   by (simp add: bit_drop_bit_eq)
 
 lemma bin_nth_take_bit_iff:
   \<open>(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (take_bit n c) k \<longleftrightarrow> k < n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c k\<close>
   by (fact bit_take_bit_iff)
 
 lemma bin_nth_split:
   "bin_split n c = (a, b) \<Longrightarrow>
     (\<forall>k. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) a k = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c (n + k)) \<and>
     (\<forall>k. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) b k = (k < n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) c k))"
   by (auto simp add: bin_nth_drop_bit_iff bin_nth_take_bit_iff)
 
 lemma bin_cat_zero [simp]: "(\<lambda>k n l. concat_bit n l k) 0 n w = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma bintr_cat1: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (k + n) ((\<lambda>k n l. concat_bit n l k) a n b) = (\<lambda>k n l. concat_bit n l k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) k a) n b"
   by (metis bin_cat_assoc bin_cat_zero)
 
 lemma bintr_cat: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m ((\<lambda>k n l. concat_bit n l k) a n b) =
     (\<lambda>k n l. concat_bit n l k) ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (min m n) b)"
   by (rule bin_eqI) (auto simp: bin_nth_cat nth_bintr)
 
 lemma bintr_cat_same [simp]: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((\<lambda>k n l. concat_bit n l k) a n b) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b"
   by (auto simp add : bintr_cat)
 
 lemma cat_bintr [simp]: "(\<lambda>k n l. concat_bit n l k) a n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b) = (\<lambda>k n l. concat_bit n l k) a n b"
   by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma split_bintrunc: "bin_split n c = (a, b) \<Longrightarrow> b = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n c"
   by simp
 
 lemma bin_cat_split: "bin_split n w = (u, v) \<Longrightarrow> w = (\<lambda>k n l. concat_bit n l k) u n v"
   by (auto simp add: bin_cat_eq_push_bit_add_take_bit bits_ident)
 
 lemma drop_bit_bin_cat_eq:
   \<open>drop_bit n ((\<lambda>k n l. concat_bit n l k) v n w) = v\<close>
   by (rule bit_eqI) (simp add: bit_drop_bit_eq bit_concat_bit_iff)
 
 lemma take_bit_bin_cat_eq:
   \<open>take_bit n ((\<lambda>k n l. concat_bit n l k) v n w) = take_bit n w\<close>
   by (rule bit_eqI) (simp add: bit_concat_bit_iff)
 
 lemma bin_split_cat: "bin_split n ((\<lambda>k n l. concat_bit n l k) v n w) = (v, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w)"
   by (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
 
 lemma bin_split_zero [simp]: "bin_split n 0 = (0, 0)"
   by simp
 
 lemma bin_split_minus1 [simp]:
   "bin_split n (- 1) = (- 1, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (- 1))"
   by simp
 
 lemma bin_split_trunc:
   "bin_split (min m n) c = (a, b) \<Longrightarrow>
     bin_split n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m c) = ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a, b)"
   apply (induct n arbitrary: m b c, clarsimp)
   apply (simp add: bin_rest_trunc Let_def split: prod.split_asm)
   apply (case_tac m)
    apply (auto simp: Let_def drop_bit_Suc take_bit_Suc mod_2_eq_odd split: prod.split_asm)
   done
 
 lemma bin_split_trunc1:
   "bin_split n c = (a, b) \<Longrightarrow>
     bin_split n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m c) = ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (m - n) a, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m b)"
   apply (induct n arbitrary: m b c, clarsimp)
   apply (simp add: bin_rest_trunc Let_def split: prod.split_asm)
   apply (case_tac m)
    apply (auto simp: Let_def drop_bit_Suc take_bit_Suc mod_2_eq_odd split: prod.split_asm)
   done
 
 lemma bin_cat_num: "(\<lambda>k n l. concat_bit n l k) a n b = a * 2 ^ n + (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n b"
   by (simp add: bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult)
 
 lemma bin_split_num: "bin_split n b = (b div 2 ^ n, b mod 2 ^ n)"
   by (simp add: drop_bit_eq_div take_bit_eq_mod)
 
 lemmas bin_rsplit_aux_simps = bin_rsplit_aux.simps bin_rsplitl_aux.simps
 lemmas rsplit_aux_simps = bin_rsplit_aux_simps
 
 lemmas th_if_simp1 = if_split [where P = "(=) l", THEN iffD1, THEN conjunct1, THEN mp] for l
 lemmas th_if_simp2 = if_split [where P = "(=) l", THEN iffD1, THEN conjunct2, THEN mp] for l
 
 lemmas rsplit_aux_simp1s = rsplit_aux_simps [THEN th_if_simp1]
 
 lemmas rsplit_aux_simp2ls = rsplit_aux_simps [THEN th_if_simp2]
 \<comment> \<open>these safe to \<open>[simp add]\<close> as require calculating \<open>m - n\<close>\<close>
 lemmas bin_rsplit_aux_simp2s [simp] = rsplit_aux_simp2ls [unfolded Let_def]
 lemmas rbscl = bin_rsplit_aux_simp2s (2)
 
 lemmas rsplit_aux_0_simps [simp] =
   rsplit_aux_simp1s [OF disjI1] rsplit_aux_simp1s [OF disjI2]
 
 lemma bin_rsplit_aux_append: "bin_rsplit_aux n m c (bs @ cs) = bin_rsplit_aux n m c bs @ cs"
   apply (induct n m c bs rule: bin_rsplit_aux.induct)
   apply (subst bin_rsplit_aux.simps)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp split: prod.split)
   done
 
 lemma bin_rsplitl_aux_append: "bin_rsplitl_aux n m c (bs @ cs) = bin_rsplitl_aux n m c bs @ cs"
   apply (induct n m c bs rule: bin_rsplitl_aux.induct)
   apply (subst bin_rsplitl_aux.simps)
   apply (subst bin_rsplitl_aux.simps)
   apply (clarsimp split: prod.split)
   done
 
 lemmas rsplit_aux_apps [where bs = "[]"] =
   bin_rsplit_aux_append bin_rsplitl_aux_append
 
 lemmas rsplit_def_auxs = bin_rsplit_def bin_rsplitl_def
 
 lemmas rsplit_aux_alts = rsplit_aux_apps
   [unfolded append_Nil rsplit_def_auxs [symmetric]]
 
 lemma bin_split_minus: "0 < n \<Longrightarrow> bin_split (Suc (n - 1)) w = bin_split n w"
   by auto
 
 lemma bin_split_pred_simp [simp]:
   "(0::nat) < numeral bin \<Longrightarrow>
     bin_split (numeral bin) w =
       (let (w1, w2) = bin_split (numeral bin - 1) ((\<lambda>k::int. k div 2) w)
        in (w1, of_bool (odd w) + 2 * w2))"
   by (simp add: take_bit_rec drop_bit_rec mod_2_eq_odd)
 
 lemma bin_rsplit_aux_simp_alt:
   "bin_rsplit_aux n m c bs =
     (if m = 0 \<or> n = 0 then bs
      else let (a, b) = bin_split n c in bin_rsplit n (m - n, a) @ b # bs)"
   apply (simp add: bin_rsplit_aux.simps [of n m c bs])
   apply (subst rsplit_aux_alts)
   apply (simp add: bin_rsplit_def)
   done
 
 lemmas bin_rsplit_simp_alt =
   trans [OF bin_rsplit_def bin_rsplit_aux_simp_alt]
 
 lemmas bthrs = bin_rsplit_simp_alt [THEN [2] trans]
 
 lemma bin_rsplit_size_sign' [rule_format]:
   "n > 0 \<Longrightarrow> rev sw = bin_rsplit n (nw, w) \<Longrightarrow> \<forall>v\<in>set sw. (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n v = v"
   apply (induct sw arbitrary: nw w)
    apply clarsimp
   apply clarsimp
   apply (drule bthrs)
   apply (simp (no_asm_use) add: Let_def split: prod.split_asm if_split_asm)
   apply clarify
   apply simp
   done
 
 lemmas bin_rsplit_size_sign = bin_rsplit_size_sign' [OF asm_rl
   rev_rev_ident [THEN trans] set_rev [THEN equalityD2 [THEN subsetD]]]
 
 lemma bin_nth_rsplit [rule_format] :
   "n > 0 \<Longrightarrow> m < n \<Longrightarrow>
     \<forall>w k nw.
       rev sw = bin_rsplit n (nw, w) \<longrightarrow>
       k < size sw \<longrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (sw ! k) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w (k * n + m)"
   apply (induct sw)
    apply clarsimp
   apply clarsimp
   apply (drule bthrs)
   apply (simp (no_asm_use) add: Let_def split: prod.split_asm if_split_asm)
   apply (erule allE, erule impE, erule exI)
   apply (case_tac k)
    apply clarsimp
    prefer 2
    apply clarsimp
    apply (erule allE)
    apply (erule (1) impE)
    apply (simp add: bit_drop_bit_eq ac_simps)
   apply (simp add: bit_take_bit_iff ac_simps)
   done
 
 lemma bin_rsplit_all: "0 < nw \<Longrightarrow> nw \<le> n \<Longrightarrow> bin_rsplit n (nw, w) = [(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w]"
   by (auto simp: bin_rsplit_def rsplit_aux_simp2ls split: prod.split dest!: split_bintrunc)
 
 lemma bin_rsplit_l [rule_format]:
   "\<forall>bin. bin_rsplitl n (m, bin) = bin_rsplit n (m, (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m bin)"
   apply (rule_tac a = "m" in wf_less_than [THEN wf_induct])
   apply (simp (no_asm) add: bin_rsplitl_def bin_rsplit_def)
   apply (rule allI)
   apply (subst bin_rsplitl_aux.simps)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp simp: Let_def split: prod.split)
   apply (simp add: ac_simps)
   apply (subst rsplit_aux_alts(1))
   apply (subst rsplit_aux_alts(2))
   apply clarsimp
   unfolding bin_rsplit_def bin_rsplitl_def
   apply (simp add: drop_bit_take_bit)
   apply (case_tac \<open>x < n\<close>)
   apply (simp_all add: not_less min_def)
   done
 
 lemma bin_rsplit_rcat [rule_format]:
   "n > 0 \<longrightarrow> bin_rsplit n (n * size ws, bin_rcat n ws) = map ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n) ws"
   apply (unfold bin_rsplit_def bin_rcat_eq_foldl)
   apply (rule_tac xs = ws in rev_induct)
    apply clarsimp
   apply clarsimp
   apply (subst rsplit_aux_alts)
   apply (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
   done
 
 lemma bin_rsplit_aux_len_le [rule_format] :
   "\<forall>ws m. n \<noteq> 0 \<longrightarrow> ws = bin_rsplit_aux n nw w bs \<longrightarrow>
     length ws \<le> m \<longleftrightarrow> nw + length bs * n \<le> m * n"
 proof -
   have *: R
     if d: "i \<le> j \<or> m < j'"
     and R1: "i * k \<le> j * k \<Longrightarrow> R"
     and R2: "Suc m * k' \<le> j' * k' \<Longrightarrow> R"
     for i j j' k k' m :: nat and R
     using d
     apply safe
     apply (rule R1, erule mult_le_mono1)
     apply (rule R2, erule Suc_le_eq [THEN iffD2 [THEN mult_le_mono1]])
     done
   have **: "0 < sc \<Longrightarrow> sc - n + (n + lb * n) \<le> m * n \<longleftrightarrow> sc + lb * n \<le> m * n"
     for sc m n lb :: nat
     apply safe
      apply arith
     apply (case_tac "sc \<ge> n")
      apply arith
     apply (insert linorder_le_less_linear [of m lb])
     apply (erule_tac k=n and k'=n in *)
      apply arith
     apply simp
     done
   show ?thesis
     apply (induct n nw w bs rule: bin_rsplit_aux.induct)
     apply (subst bin_rsplit_aux.simps)
     apply (simp add: ** Let_def split: prod.split)
     done
 qed
 
 lemma bin_rsplit_len_le: "n \<noteq> 0 \<longrightarrow> ws = bin_rsplit n (nw, w) \<longrightarrow> length ws \<le> m \<longleftrightarrow> nw \<le> m * n"
   by (auto simp: bin_rsplit_def bin_rsplit_aux_len_le)
 
 lemma bin_rsplit_aux_len:
   "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit_aux n nw w cs) = (nw + n - 1) div n + length cs"
   apply (induct n nw w cs rule: bin_rsplit_aux.induct)
   apply (subst bin_rsplit_aux.simps)
   apply (clarsimp simp: Let_def split: prod.split)
   apply (erule thin_rl)
   apply (case_tac m)
    apply simp
   apply (case_tac "m \<le> n")
    apply (auto simp add: div_add_self2)
   done
 
 lemma bin_rsplit_len: "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit n (nw, w)) = (nw + n - 1) div n"
   by (auto simp: bin_rsplit_def bin_rsplit_aux_len)
 
 lemma bin_rsplit_aux_len_indep:
   "n \<noteq> 0 \<Longrightarrow> length bs = length cs \<Longrightarrow>
     length (bin_rsplit_aux n nw v bs) =
     length (bin_rsplit_aux n nw w cs)"
 proof (induct n nw w cs arbitrary: v bs rule: bin_rsplit_aux.induct)
   case (1 n m w cs v bs)
   show ?case
   proof (cases "m = 0")
     case True
     with \<open>length bs = length cs\<close> show ?thesis by simp
   next
     case False
     from "1.hyps" [of \<open>bin_split n w\<close> \<open>drop_bit n w\<close> \<open>take_bit n w\<close>] \<open>m \<noteq> 0\<close> \<open>n \<noteq> 0\<close>
     have hyp: "\<And>v bs. length bs = Suc (length cs) \<Longrightarrow>
       length (bin_rsplit_aux n (m - n) v bs) =
       length (bin_rsplit_aux n (m - n) (drop_bit n w) (take_bit n w # cs))"
       using bin_rsplit_aux_len by fastforce
     from \<open>length bs = length cs\<close> \<open>n \<noteq> 0\<close> show ?thesis
       by (auto simp add: bin_rsplit_aux_simp_alt Let_def bin_rsplit_len split: prod.split)
   qed
 qed
 
 lemma bin_rsplit_len_indep:
   "n \<noteq> 0 \<Longrightarrow> length (bin_rsplit n (nw, v)) = length (bin_rsplit n (nw, w))"
   apply (unfold bin_rsplit_def)
   apply (simp (no_asm))
   apply (erule bin_rsplit_aux_len_indep)
   apply (rule refl)
   done
 
 
 subsection \<open>Logical operations\<close>
 
 abbreviation (input) bin_sc :: \<open>nat \<Rightarrow> bool \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>bin_sc n b i \<equiv> set_bit i n b\<close>
 
 lemma bin_sc_0 [simp]:
   "bin_sc 0 b w = of_bool b + 2 * (\<lambda>k::int. k div 2) w"
   by (simp add: set_bit_int_def)
 
 lemma bin_sc_Suc [simp]:
   "bin_sc (Suc n) b w = of_bool (odd w) + 2 * bin_sc n b (w div 2)"
   by (simp add: set_bit_int_def set_bit_Suc unset_bit_Suc bin_last_def)
 
 lemma bin_nth_sc [bit_simps]: "bit (bin_sc n b w) n \<longleftrightarrow> b"
   by (simp add: bit_simps)
 
 lemma bin_sc_sc_same [simp]: "bin_sc n c (bin_sc n b w) = bin_sc n c w"
   by (induction n arbitrary: w) (simp_all add: bit_Suc)
 
 lemma bin_sc_sc_diff: "m \<noteq> n \<Longrightarrow> bin_sc m c (bin_sc n b w) = bin_sc n b (bin_sc m c w)"
   apply (induct n arbitrary: w m)
    apply (case_tac [!] m)
      apply auto
   done
 
 lemma bin_nth_sc_gen: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (bin_sc n b w) m = (if m = n then b else (bit :: int \<Rightarrow> nat \<Rightarrow> bool) w m)"
-  apply (induct n arbitrary: w m)
-   apply (case_tac m; simp add: bit_Suc)
-  apply (case_tac m; simp add: bit_Suc)
-  done
+  by (simp add: bit_simps)
 
 lemma bin_sc_eq:
   \<open>bin_sc n False = unset_bit n\<close>
   \<open>bin_sc n True = Bit_Operations.set_bit n\<close>
    apply (simp_all add: fun_eq_iff bit_eq_iff)
   apply (simp_all add: bit_simps bin_nth_sc_gen)
   done
 
 lemma bin_sc_nth [simp]: "bin_sc n ((bit :: int \<Rightarrow> nat \<Rightarrow> bool) w n) w = w"
   by (rule bit_eqI) (simp add: bin_nth_sc_gen)
 
 lemma bin_sign_sc [simp]: "bin_sign (bin_sc n b w) = bin_sign w"
 proof (induction n arbitrary: w)
   case 0
   then show ?case
     by (auto simp add: bin_sign_def) (use bin_rest_ge_0 in fastforce)
 next
   case (Suc n)
   from Suc [of \<open>w div 2\<close>]
   show ?case by (auto simp add: bin_sign_def split: if_splits)
 qed
 
 lemma bin_sc_bintr [simp]:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m (bin_sc n x ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m w)) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) m (bin_sc n x w)"
   apply (rule bit_eqI)
   apply (cases x)
    apply (auto simp add: bit_simps bin_sc_eq)
   done
 
 lemma bin_clr_le: "bin_sc n False w \<le> w"
   by (simp add: set_bit_int_def unset_bit_less_eq)
 
 lemma bin_set_ge: "bin_sc n True w \<ge> w"
   by (simp add: set_bit_int_def set_bit_greater_eq)
 
 lemma bintr_bin_clr_le: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (bin_sc m False w) \<le> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: set_bit_int_def take_bit_unset_bit_eq unset_bit_less_eq)
 
 lemma bintr_bin_set_ge: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (bin_sc m True w) \<ge> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n w"
   by (simp add: set_bit_int_def take_bit_set_bit_eq set_bit_greater_eq)
 
 lemma bin_sc_FP [simp]: "bin_sc n False 0 = 0"
   by (induct n) auto
 
 lemma bin_sc_TM [simp]: "bin_sc n True (- 1) = - 1"
   by (induct n) auto
 
 lemmas bin_sc_simps = bin_sc_0 bin_sc_Suc bin_sc_TM bin_sc_FP
 
 lemma bin_sc_minus: "0 < n \<Longrightarrow> bin_sc (Suc (n - 1)) b w = bin_sc n b w"
   by auto
 
 lemmas bin_sc_Suc_minus =
   trans [OF bin_sc_minus [symmetric] bin_sc_Suc]
 
 lemma bin_sc_numeral [simp]:
   "bin_sc (numeral k) b w =
     of_bool (odd w) + 2 * bin_sc (pred_numeral k) b (w div 2)"
   by (simp add: numeral_eq_Suc)
 
 lemmas bin_sc_minus_simps =
   bin_sc_simps (2,3,4) [THEN [2] trans, OF bin_sc_minus [THEN sym]]
 
 lemma int_set_bit_0 [simp]: fixes x :: int shows
   "set_bit x 0 b = of_bool b + 2 * (x div 2)"
   by (fact bin_sc_0)
 
 lemma int_set_bit_Suc: fixes x :: int shows
   "set_bit x (Suc n) b = of_bool (odd x) + 2 * set_bit (x div 2) n b"
   by (fact bin_sc_Suc)
 
 lemma bin_last_set_bit:
   "odd (set_bit x n b :: int) = (if n > 0 then odd x else b)"
   by (cases n) (simp_all add: int_set_bit_Suc)
 
 lemma bin_rest_set_bit:
   "(set_bit x n b :: int) div 2 = (if n > 0 then set_bit (x div 2) (n - 1) b else x div 2)"
   by (cases n) (simp_all add: int_set_bit_Suc)
 
 lemma int_set_bit_numeral: fixes x :: int shows
   "set_bit x (numeral w) b = of_bool (odd x) + 2 * set_bit (x div 2) (pred_numeral w) b"
   by (fact bin_sc_numeral)
 
 lemmas int_set_bit_numerals [simp] =
   int_set_bit_numeral[where x="numeral w'"]
   int_set_bit_numeral[where x="- numeral w'"]
   int_set_bit_numeral[where x="Numeral1"]
   int_set_bit_numeral[where x="1"]
   int_set_bit_numeral[where x="0"]
   int_set_bit_Suc[where x="numeral w'"]
   int_set_bit_Suc[where x="- numeral w'"]
   int_set_bit_Suc[where x="Numeral1"]
   int_set_bit_Suc[where x="1"]
   int_set_bit_Suc[where x="0"]
   for w'
 
 lemma msb_set_bit [simp]:
   "msb (set_bit (x :: int) n b) \<longleftrightarrow> msb x"
   by (simp add: msb_int_def set_bit_int_def)
 
 lemma word_set_bit_def:
   \<open>set_bit a n x = word_of_int (bin_sc n x (uint a))\<close>
   apply (rule bit_word_eqI)
   apply (cases x)
    apply (simp_all add: bit_simps bin_sc_eq)
   done
 
 lemma set_bit_word_of_int:
   "set_bit (word_of_int x) n b = word_of_int (bin_sc n b x)"
   unfolding word_set_bit_def
   by (rule word_eqI) (simp add: word_size bin_nth_sc_gen nth_bintr bit_simps)
 
 lemma word_set_numeral [simp]:
   "set_bit (numeral bin::'a::len word) n b =
     word_of_int (bin_sc n b (numeral bin))"
   unfolding word_numeral_alt by (rule set_bit_word_of_int)
 
 lemma word_set_neg_numeral [simp]:
   "set_bit (- numeral bin::'a::len word) n b =
     word_of_int (bin_sc n b (- numeral bin))"
   unfolding word_neg_numeral_alt by (rule set_bit_word_of_int)
 
 lemma word_set_bit_0 [simp]: "set_bit 0 n b = word_of_int (bin_sc n b 0)"
   unfolding word_0_wi by (rule set_bit_word_of_int)
 
 lemma word_set_bit_1 [simp]: "set_bit 1 n b = word_of_int (bin_sc n b 1)"
   unfolding word_1_wi by (rule set_bit_word_of_int)
 
 lemmas shiftl_int_def = shiftl_eq_mult[of x for x::int]
 lemmas shiftr_int_def = shiftr_eq_div[of x for x::int]
 
 
 subsubsection \<open>Basic simplification rules\<close>
 
 context
   includes bit_operations_syntax
 begin
 
 lemmas int_not_def = not_int_def
 
 lemma int_not_simps:
   "NOT (0::int) = -1"
   "NOT (1::int) = -2"
   "NOT (- 1::int) = 0"
   "NOT (numeral w::int) = - numeral (w + Num.One)"
   "NOT (- numeral (Num.Bit0 w)::int) = numeral (Num.BitM w)"
   "NOT (- numeral (Num.Bit1 w)::int) = numeral (Num.Bit0 w)"
   by (simp_all add: not_int_def)
 
 lemma int_not_not: "NOT (NOT x) = x"
   for x :: int
   by (fact bit.double_compl)
 
 lemma int_and_0 [simp]: "0 AND x = 0"
   for x :: int
   by (fact bit.conj_zero_left)
 
 lemma int_and_m1 [simp]: "-1 AND x = x"
   for x :: int
   by (fact and.left_neutral)
 
 lemma int_or_zero [simp]: "0 OR x = x"
   for x :: int
   by (fact or.left_neutral)
 
 lemma int_or_minus1 [simp]: "-1 OR x = -1"
   for x :: int
   by (fact bit.disj_one_left)
 
 lemma int_xor_zero [simp]: "0 XOR x = x"
   for x :: int
   by (fact xor.left_neutral)
 
 
 subsubsection \<open>Binary destructors\<close>
 
 lemma bin_rest_NOT [simp]: "(\<lambda>k::int. k div 2) (NOT x) = NOT ((\<lambda>k::int. k div 2) x)"
   by (fact not_int_div_2)
 
 lemma bin_last_NOT [simp]: "(odd :: int \<Rightarrow> bool) (NOT x) \<longleftrightarrow> \<not> (odd :: int \<Rightarrow> bool) x"
   by simp
 
 lemma bin_rest_AND [simp]: "(\<lambda>k::int. k div 2) (x AND y) = (\<lambda>k::int. k div 2) x AND (\<lambda>k::int. k div 2) y"
   by (subst and_int_rec) auto
 
 lemma bin_last_AND [simp]: "(odd :: int \<Rightarrow> bool) (x AND y) \<longleftrightarrow> (odd :: int \<Rightarrow> bool) x \<and> (odd :: int \<Rightarrow> bool) y"
   by (subst and_int_rec) auto
 
 lemma bin_rest_OR [simp]: "(\<lambda>k::int. k div 2) (x OR y) = (\<lambda>k::int. k div 2) x OR (\<lambda>k::int. k div 2) y"
   by (subst or_int_rec) auto
 
 lemma bin_last_OR [simp]: "(odd :: int \<Rightarrow> bool) (x OR y) \<longleftrightarrow> (odd :: int \<Rightarrow> bool) x \<or> (odd :: int \<Rightarrow> bool) y"
   by (subst or_int_rec) auto
 
 lemma bin_rest_XOR [simp]: "(\<lambda>k::int. k div 2) (x XOR y) = (\<lambda>k::int. k div 2) x XOR (\<lambda>k::int. k div 2) y"
   by (subst xor_int_rec) auto
 
 lemma bin_last_XOR [simp]: "(odd :: int \<Rightarrow> bool) (x XOR y) \<longleftrightarrow> ((odd :: int \<Rightarrow> bool) x \<or> (odd :: int \<Rightarrow> bool) y) \<and> \<not> ((odd :: int \<Rightarrow> bool) x \<and> (odd :: int \<Rightarrow> bool) y)"
   by (subst xor_int_rec) auto
 
 lemma bin_nth_ops:
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x AND y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x OR y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<or> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x y. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (x XOR y) n \<longleftrightarrow> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<noteq> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) y n"
   "\<And>x. (bit :: int \<Rightarrow> nat \<Rightarrow> bool) (NOT x) n \<longleftrightarrow> \<not> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n"
   by (simp_all add: bit_and_iff bit_or_iff bit_xor_iff bit_not_iff)
 
 
 subsubsection \<open>Derived properties\<close>
 
 lemma int_xor_minus1 [simp]: "-1 XOR x = NOT x"
   for x :: int
   by (fact bit.xor_one_left)
 
 lemma int_xor_extra_simps [simp]:
   "w XOR 0 = w"
   "w XOR -1 = NOT w"
   for w :: int
   by simp_all
 
 lemma int_or_extra_simps [simp]:
   "w OR 0 = w"
   "w OR -1 = -1"
   for w :: int
   by simp_all
 
 lemma int_and_extra_simps [simp]:
   "w AND 0 = 0"
   "w AND -1 = w"
   for w :: int
   by simp_all
 
 text \<open>Commutativity of the above.\<close>
 lemma bin_ops_comm:
   fixes x y :: int
   shows int_and_comm: "x AND y = y AND x"
     and int_or_comm:  "x OR y = y OR x"
     and int_xor_comm: "x XOR y = y XOR x"
   by (simp_all add: ac_simps)
 
 lemma bin_ops_same [simp]:
   "x AND x = x"
   "x OR x = x"
   "x XOR x = 0"
   for x :: int
   by simp_all
 
 lemmas bin_log_esimps =
   int_and_extra_simps  int_or_extra_simps  int_xor_extra_simps
   int_and_0 int_and_m1 int_or_zero int_or_minus1 int_xor_zero int_xor_minus1
 
 
 subsubsection \<open>Basic properties of logical (bit-wise) operations\<close>
 
 lemma bbw_ao_absorb: "x AND (y OR x) = x \<and> x OR (y AND x) = x"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_ao_absorbs_other:
   "x AND (x OR y) = x \<and> (y AND x) OR x = x"
   "(y OR x) AND x = x \<and> x OR (x AND y) = x"
   "(x OR y) AND x = x \<and> (x AND y) OR x = x"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemmas bbw_ao_absorbs [simp] = bbw_ao_absorb bbw_ao_absorbs_other
 
 lemma int_xor_not: "(NOT x) XOR y = NOT (x XOR y) \<and> x XOR (NOT y) = NOT (x XOR y)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_and_assoc: "(x AND y) AND z = x AND (y AND z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_or_assoc: "(x OR y) OR z = x OR (y OR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma int_xor_assoc: "(x XOR y) XOR z = x XOR (y XOR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemmas bbw_assocs = int_and_assoc int_or_assoc int_xor_assoc
 
 (* BH: Why are these declared as simp rules??? *)
 lemma bbw_lcs [simp]:
   "y AND (x AND z) = x AND (y AND z)"
   "y OR (x OR z) = x OR (y OR z)"
   "y XOR (x XOR z) = x XOR (y XOR z)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_not_dist:
   "NOT (x OR y) = (NOT x) AND (NOT y)"
   "NOT (x AND y) = (NOT x) OR (NOT y)"
   for x y :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_oa_dist: "(x AND y) OR z = (x OR z) AND (y OR z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 lemma bbw_ao_dist: "(x OR y) AND z = (x AND z) OR (y AND z)"
   for x y z :: int
   by (auto simp add: bin_eq_iff bin_nth_ops)
 
 
 subsubsection \<open>Simplification with numerals\<close>
 
 text \<open>Cases for \<open>0\<close> and \<open>-1\<close> are already covered by other simp rules.\<close>
 
 lemma bin_rest_neg_numeral_BitM [simp]:
   "(\<lambda>k::int. k div 2) (- numeral (Num.BitM w)) = - numeral w"
   by simp
 
 lemma bin_last_neg_numeral_BitM [simp]:
   "(odd :: int \<Rightarrow> bool) (- numeral (Num.BitM w))"
   by simp
 
 
 subsubsection \<open>Interactions with arithmetic\<close>
 
 lemma le_int_or: "bin_sign y = 0 \<Longrightarrow> x \<le> x OR y"
   for x y :: int
   by (simp add: bin_sign_def or_greater_eq split: if_splits)
 
 lemmas int_and_le =
   xtrans(3) [OF bbw_ao_absorbs (2) [THEN conjunct2, symmetric] le_int_or]
 
 text \<open>Interaction between bit-wise and arithmetic: good example of \<open>bin_induction\<close>.\<close>
 lemma bin_add_not: "x + NOT x = (-1::int)"
   by (simp add: not_int_def)
 
 lemma AND_mod: "x AND (2 ^ n - 1) = x mod 2 ^ n"
   for x :: int
   by (simp flip: take_bit_eq_mod add: take_bit_eq_mask mask_eq_exp_minus_1)
 
 
 subsubsection \<open>Truncating results of bit-wise operations\<close>
 
 lemma bin_trunc_ao:
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x AND (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x AND y)"
   "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x OR (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x OR y)"
   by simp_all
 
 lemma bin_trunc_xor: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x XOR (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (x XOR y)"
   by simp
 
 lemma bin_trunc_not: "(take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (NOT ((take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x)) = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n (NOT x)"
   by (fact take_bit_not_take_bit)
 
 text \<open>Want theorems of the form of \<open>bin_trunc_xor\<close>.\<close>
 lemma bintr_bintr_i: "x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y \<Longrightarrow> (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = (take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n y"
   by auto
 
 lemmas bin_trunc_and = bin_trunc_ao(1) [THEN bintr_bintr_i]
 lemmas bin_trunc_or = bin_trunc_ao(2) [THEN bintr_bintr_i]
 
 
 subsubsection \<open>More lemmas\<close>
 
 lemma not_int_cmp_0 [simp]:
   fixes i :: int shows
   "0 < NOT i \<longleftrightarrow> i < -1"
   "0 \<le> NOT i \<longleftrightarrow> i < 0"
   "NOT i < 0 \<longleftrightarrow> i \<ge> 0"
   "NOT i \<le> 0 \<longleftrightarrow> i \<ge> -1"
 by(simp_all add: int_not_def) arith+
 
 lemma bbw_ao_dist2: "(x :: int) AND (y OR z) = x AND y OR x AND z"
   by (fact bit.conj_disj_distrib)
 
 lemmas int_and_ac = bbw_lcs(1) int_and_comm int_and_assoc
 
 lemma int_nand_same [simp]: fixes x :: int shows "x AND NOT x = 0"
   by simp
 
 lemma int_nand_same_middle: fixes x :: int shows "x AND y AND NOT x = 0"
   by (simp add: bit_eq_iff bit_and_iff bit_not_iff)
 
 lemma and_xor_dist: fixes x :: int shows
   "x AND (y XOR z) = (x AND y) XOR (x AND z)"
   by (fact bit.conj_xor_distrib)
 
 lemma int_and_lt0 [simp]:
   \<open>x AND y < 0 \<longleftrightarrow> x < 0 \<and> y < 0\<close> for x y :: int
   by (fact and_negative_int_iff)
 
 lemma int_and_ge0 [simp]:
   \<open>x AND y \<ge> 0 \<longleftrightarrow> x \<ge> 0 \<or> y \<ge> 0\<close> for x y :: int
   by (fact and_nonnegative_int_iff)
 
 lemma int_and_1: fixes x :: int shows "x AND 1 = x mod 2"
   by (fact and_one_eq)
 
 lemma int_1_and: fixes x :: int shows "1 AND x = x mod 2"
   by (fact one_and_eq)
 
 lemma int_or_lt0 [simp]:
   \<open>x OR y < 0 \<longleftrightarrow> x < 0 \<or> y < 0\<close> for x y :: int
   by (fact or_negative_int_iff)
 
 lemma int_or_ge0 [simp]:
   \<open>x OR y \<ge> 0 \<longleftrightarrow> x \<ge> 0 \<and> y \<ge> 0\<close> for x y :: int
   by (fact or_nonnegative_int_iff)
 
 lemma int_xor_lt0 [simp]:
   \<open>x XOR y < 0 \<longleftrightarrow> (x < 0) \<noteq> (y < 0)\<close> for x y :: int
   by (fact xor_negative_int_iff)
 
 lemma int_xor_ge0 [simp]:
   \<open>x XOR y \<ge> 0 \<longleftrightarrow> (x \<ge> 0 \<longleftrightarrow> y \<ge> 0)\<close> for x y :: int
   by (fact xor_nonnegative_int_iff)
 
 lemma even_conv_AND:
   \<open>even i \<longleftrightarrow> i AND 1 = 0\<close> for i :: int
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bin_last_conv_AND:
   "(odd :: int \<Rightarrow> bool) i \<longleftrightarrow> i AND 1 \<noteq> 0"
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bitval_bin_last:
   "of_bool ((odd :: int \<Rightarrow> bool) i) = i AND 1"
   by (simp add: and_one_eq mod2_eq_if)
 
 lemma bin_sign_and:
   "bin_sign (i AND j) = - (bin_sign i * bin_sign j)"
 by(simp add: bin_sign_def)
 
 lemma int_not_neg_numeral: "NOT (- numeral n) = (Num.sub n num.One :: int)"
 by(simp add: int_not_def)
 
 lemma int_neg_numeral_pOne_conv_not: "- numeral (n + num.One) = (NOT (numeral n) :: int)"
 by(simp add: int_not_def)
 
 
 subsection \<open>Setting and clearing bits\<close>
 
 lemma int_shiftl_BIT: fixes x :: int
   shows int_shiftl0: "x << 0 = x"
   and int_shiftl_Suc: "x << Suc n = 2 * x << n"
   by (auto simp add: shiftl_int_def)
 
 lemma int_0_shiftl: "push_bit n 0 = (0 :: int)"
   by (fact push_bit_of_0)
 
 lemma bin_last_shiftl: "odd (push_bit n x) \<longleftrightarrow> n = 0 \<and> (odd :: int \<Rightarrow> bool) x"
   by simp
 
 lemma bin_rest_shiftl: "(\<lambda>k::int. k div 2) (push_bit n x) = (if n > 0 then push_bit (n - 1) x else (\<lambda>k::int. k div 2) x)"
   by (cases n) (simp_all add: push_bit_eq_mult)
 
 lemma bin_nth_shiftl: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (push_bit n x) m \<longleftrightarrow> n \<le> m \<and> (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (m - n)"
   by (fact bit_push_bit_iff_int)
 
 lemma bin_last_shiftr: "odd (drop_bit n x) \<longleftrightarrow> bit x n" for x :: int
   by (simp add: bit_iff_odd_drop_bit)
 
 lemma bin_rest_shiftr: "(\<lambda>k::int. k div 2) (drop_bit n x) = drop_bit (Suc n) x"
   by (simp add: drop_bit_Suc drop_bit_half)
 
 lemma bin_nth_shiftr: "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) (drop_bit n x) m = (bit :: int \<Rightarrow> nat \<Rightarrow> bool) x (n + m)"
   by (simp add: bit_simps)
 
 lemma bin_nth_conv_AND:
   fixes x :: int shows
   "(bit :: int \<Rightarrow> nat \<Rightarrow> bool) x n \<longleftrightarrow> x AND (push_bit n 1) \<noteq> 0"
   by (fact bit_iff_and_push_bit_not_eq_0)
 
 lemma int_shiftl_numeral [simp]:
   "push_bit (numeral w') (numeral w :: int) = push_bit (pred_numeral w') (numeral (num.Bit0 w))"
   "push_bit (numeral w') (- numeral w :: int) = push_bit (pred_numeral w') (- numeral (num.Bit0 w))"
 by(simp_all add: numeral_eq_Suc shiftl_int_def)
   (metis add_One mult_inc semiring_norm(11) semiring_norm(13) semiring_norm(2) semiring_norm(6) semiring_norm(87))+
 
 lemma int_shiftl_One_numeral [simp]:
   "push_bit (numeral w) (1::int) = push_bit (pred_numeral w) 2"
   using int_shiftl_numeral [of Num.One w]
   by (simp only: numeral_eq_Suc push_bit_Suc) simp
 
 lemma shiftl_ge_0: fixes i :: int shows "push_bit n i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
   by (fact push_bit_nonnegative_int_iff)
 
 lemma shiftl_lt_0: fixes i :: int shows "push_bit n i < 0 \<longleftrightarrow> i < 0"
   by (fact push_bit_negative_int_iff)
 
 lemma int_shiftl_test_bit: "bit (push_bit i n :: int) m \<longleftrightarrow> m \<ge> i \<and> bit n (m - i)"
   by (fact bit_push_bit_iff_int)
 
 lemma int_0shiftr: "drop_bit x (0 :: int) = 0"
   by (fact drop_bit_of_0)
 
 lemma int_minus1_shiftr: "drop_bit x (-1 :: int) = -1"
   by (fact drop_bit_minus_one)
 
 lemma int_shiftr_ge_0: fixes i :: int shows "drop_bit n i \<ge> 0 \<longleftrightarrow> i \<ge> 0"
   by (fact drop_bit_nonnegative_int_iff)
 
 lemma int_shiftr_lt_0 [simp]: fixes i :: int shows "drop_bit n i < 0 \<longleftrightarrow> i < 0"
   by (fact drop_bit_negative_int_iff)
 
 lemma int_shiftr_numeral [simp]:
   "drop_bit (numeral w') (1 :: int) = 0"
   "drop_bit (numeral w') (numeral num.One :: int) = 0"
   "drop_bit (numeral w') (numeral (num.Bit0 w) :: int) = drop_bit (pred_numeral w') (numeral w)"
   "drop_bit (numeral w') (numeral (num.Bit1 w) :: int) = drop_bit (pred_numeral w') (numeral w)"
   "drop_bit (numeral w') (- numeral (num.Bit0 w) :: int) = drop_bit (pred_numeral w') (- numeral w)"
   "drop_bit (numeral w') (- numeral (num.Bit1 w) :: int) = drop_bit (pred_numeral w') (- numeral (Num.inc w))"
   by (simp_all add: numeral_eq_Suc add_One drop_bit_Suc)
 
 lemma int_shiftr_numeral_Suc0 [simp]:
   "drop_bit (Suc 0) (1 :: int) = 0"
   "drop_bit (Suc 0) (numeral num.One :: int) = 0"
   "drop_bit (Suc 0) (numeral (num.Bit0 w) :: int) = numeral w"
   "drop_bit (Suc 0) (numeral (num.Bit1 w) :: int) = numeral w"
   "drop_bit (Suc 0) (- numeral (num.Bit0 w) :: int) = - numeral w"
   "drop_bit (Suc 0) (- numeral (num.Bit1 w) :: int) = - numeral (Num.inc w)"
   by (simp_all add: drop_bit_Suc add_One)
 
 lemma bin_nth_minus_p2:
   assumes sign: "bin_sign x = 0"
-  and y: "y = push_bit n 1"
-  and m: "m < n"
-  and x: "x < y"
+    and y: "y = push_bit n 1"
+    and m: "m < n"
+    and x: "x < y"
   shows "bit (x - y) m = bit x m"
 proof -
-  from sign y x have \<open>x \<ge> 0\<close> and \<open>y = 2 ^ n\<close> and \<open>x < 2 ^ n\<close>
-    by (simp_all add: bin_sign_def push_bit_eq_mult split: if_splits)
-  from \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>m < n\<close> have \<open>bit x m \<longleftrightarrow> bit (x - 2 ^ n) m\<close>
-  proof (induction m arbitrary: x n)
-    case 0
-    then show ?case
-      by simp
-  next
-    case (Suc m)
-    moreover define q where \<open>q = n - 1\<close>
-    ultimately have n: \<open>n = Suc q\<close>
-      by simp
-    have \<open>(x - 2 ^ Suc q) div 2 = x div 2 - 2 ^ q\<close>
-      by simp
-    moreover from Suc.IH [of \<open>x div 2\<close> q] Suc.prems
-    have \<open>bit (x div 2) m \<longleftrightarrow> bit (x div 2 - 2 ^ q) m\<close>
-      by (simp add: n)
-    ultimately show ?case
-      by (simp add: bit_Suc n)
-  qed
-  with \<open>y = 2 ^ n\<close> show ?thesis
+  from \<open>bin_sign x = 0\<close> have \<open>x \<ge> 0\<close>
+    by (simp add: sign_Pls_ge_0) 
+  moreover from x y have \<open>x < 2 ^ n\<close>
     by simp
+  ultimately have \<open>q < n\<close> if \<open>bit x q\<close> for q
+    using that by (metis bit_take_bit_iff take_bit_int_eq_self)
+  then have \<open>bit (x + NOT (mask n)) m = bit x m\<close>
+    using \<open>m < n\<close> by (simp add: disjunctive_add bit_simps)
+  also have \<open>x + NOT (mask n) = x - y\<close>
+    using y by (simp flip: minus_exp_eq_not_mask)
+  finally show ?thesis .
 qed
 
 lemma bin_clr_conv_NAND:
   "bin_sc n False i = i AND NOT (push_bit n 1)"
   by (rule bit_eqI) (auto simp add: bin_sc_eq bit_simps)
 
 lemma bin_set_conv_OR:
   "bin_sc n True i = i OR (push_bit n 1)"
   by (rule bit_eqI) (auto simp add: bin_sc_eq bit_simps)
 
 end
 
 
 subsection \<open>More lemmas on words\<close>
 
 lemma msb_conv_bin_sign:
   "msb x \<longleftrightarrow> bin_sign x = -1"
   by (simp add: bin_sign_def not_le msb_int_def)
 
 lemma msb_bin_sc:
   "msb (bin_sc n b x) \<longleftrightarrow> msb x"
   by (simp add: msb_conv_bin_sign)
 
 lemma msb_word_def:
   \<open>msb a \<longleftrightarrow> bin_sign (signed_take_bit (LENGTH('a) - 1) (uint a)) = - 1\<close>
   for a :: \<open>'a::len word\<close>
   by (simp add: bin_sign_def bit_simps msb_word_iff_bit)
 
 lemma word_msb_def:
   "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
   by (simp add: msb_word_def sint_uint)
 
 lemma word_rcat_eq:
   \<open>word_rcat ws = word_of_int (bin_rcat (LENGTH('a::len)) (map uint ws))\<close>
   for ws :: \<open>'a::len word list\<close>
   apply (simp add: word_rcat_def bin_rcat_def rev_map)
   apply transfer
   apply (simp add: horner_sum_foldr foldr_map comp_def)
   done
 
 lemma sign_uint_Pls [simp]: "bin_sign (uint x) = 0"
   by (simp add: sign_Pls_ge_0)
 
 lemmas bin_log_bintrs = bin_trunc_not bin_trunc_xor bin_trunc_and bin_trunc_or
 
 \<comment> \<open>following definitions require both arithmetic and bit-wise word operations\<close>
 
 \<comment> \<open>to get \<open>word_no_log_defs\<close> from \<open>word_log_defs\<close>, using \<open>bin_log_bintrs\<close>\<close>
 lemmas wils1 = bin_log_bintrs [THEN word_of_int_eq_iff [THEN iffD2],
   folded uint_word_of_int_eq, THEN eq_reflection]
 
 \<comment> \<open>the binary operations only\<close>  (* BH: why is this needed? *)
 lemmas word_log_binary_defs =
   word_and_def word_or_def word_xor_def
 
 lemma setBit_no: "Bit_Operations.set_bit n (numeral bin) = word_of_int (bin_sc n True (numeral bin))"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 lemma clearBit_no:
   "unset_bit n (numeral bin) = word_of_int (bin_sc n False (numeral bin))"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 lemma eq_mod_iff: "0 < n \<Longrightarrow> b = b mod n \<longleftrightarrow> 0 \<le> b \<and> b < n"
   for b n :: int
   by auto (metis pos_mod_conj)+
 
 lemma split_uint_lem: "bin_split n (uint w) = (a, b) \<Longrightarrow>
     a = take_bit (LENGTH('a) - n) a \<and> b = take_bit (LENGTH('a)) b"
   for w :: "'a::len word"
   by transfer (simp add: drop_bit_take_bit ac_simps)
 
 \<comment> \<open>limited hom result\<close>
 lemma word_cat_hom:
   "LENGTH('a::len) \<le> LENGTH('b::len) + LENGTH('c::len) \<Longrightarrow>
     (word_cat (word_of_int w :: 'b word) (b :: 'c word) :: 'a word) =
     word_of_int ((\<lambda>k n l. concat_bit n l k) w (size b) (uint b))"
   by transfer (simp add: take_bit_concat_bit_eq)
 
 lemma bintrunc_shiftl:
   "take_bit n (push_bit i m) = push_bit i (take_bit (n - i) m)"
   for m :: int
   by (fact take_bit_push_bit)
 
 lemma uint_shiftl:
   "uint (push_bit i n) = take_bit (size n) (push_bit i (uint n))"
   by (simp add: unsigned_push_bit_eq word_size)
 
 lemma bin_mask_conv_pow2:
   "mask n = 2 ^ n - (1 :: int)"
   by (fact mask_eq_exp_minus_1)
 
 lemma bin_mask_ge0: "mask n \<ge> (0 :: int)"
   by (fact mask_nonnegative_int)
 
 context
   includes bit_operations_syntax
 begin
 
 lemma and_bin_mask_conv_mod: "x AND mask n = x mod 2 ^ n"
   for x :: int
   by (simp flip: take_bit_eq_mod add: take_bit_eq_mask)
 
 end
 
 lemma bin_mask_numeral:
   "mask (numeral n) = (1 :: int) + 2 * mask (pred_numeral n)"
   by (fact mask_numeral)
 
 lemma bin_nth_mask: "bit (mask n :: int) i \<longleftrightarrow> i < n"
   by (simp add: bit_mask_iff)
 
 lemma bin_sign_mask [simp]: "bin_sign (mask n) = 0"
   by (simp add: bin_sign_def bin_mask_conv_pow2)
 
 lemma bin_mask_p1_conv_shift: "mask n + 1 = push_bit n (1 :: int)"
   by (simp add: bin_mask_conv_pow2 shiftl_int_def)
 
 lemma sbintrunc_eq_in_range:
   "((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x = x) = (x \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n))"
   "(x = (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) n x) = (x \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 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> (signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) 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 sint_range':
   \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> sint x \<and> sint x < 2 ^ (LENGTH('a) - Suc 0)\<close>
   for x :: \<open>'a::len word\<close>
   apply transfer
   using sbintr_ge sbintr_lt apply auto
   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_eq word_sless_alt sbintrunc_If)
 
 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: "(signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (size a - 1) (sint a * sint b) \<in> range ((signed_take_bit :: nat \<Rightarrow> int \<Rightarrow> int) (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)
   define r s where \<open>r = LENGTH('a) - 1\<close> \<open>s = LENGTH('b) - 1\<close>
   then have \<open>LENGTH('a) = Suc r\<close> \<open>LENGTH('b) = Suc s\<close>
     \<open>size a = Suc r\<close> \<open>size b = Suc r\<close>
     by (simp_all add: word_size)
   then show ?thesis
     using P[unfolded range_sbintrunc] abs_ab le
     apply clarsimp
     apply (transfer fixing: r s)
     apply (auto simp add: signed_take_bit_int_eq_self simp flip: signed_take_bit_eq_iff_take_bit_eq)
     done
 qed
 
 lemma bintrunc_id:
   "\<lbrakk>m \<le> int n; 0 < m\<rbrakk> \<Longrightarrow> take_bit n m = m"
   by (simp add: take_bit_int_eq_self_iff le_less_trans)
 
 lemma bin_cat_cong: "concat_bit n b a = concat_bit m d c"
   if "n = m" "a = c" "take_bit m b = take_bit m d"
   using that(3) unfolding that(1,2)
   by (simp add: bin_cat_eq_push_bit_add_take_bit)
 
 lemma bin_cat_eqD1: "concat_bit n b a = concat_bit n d c \<Longrightarrow> a = c"
   by (metis drop_bit_bin_cat_eq)
 
 lemma bin_cat_eqD2: "concat_bit n b a = concat_bit n d c \<Longrightarrow> take_bit n b = take_bit n d"
   by (metis take_bit_bin_cat_eq)
 
 lemma bin_cat_inj: "(concat_bit n b a) = concat_bit n d c \<longleftrightarrow> a = c \<and> take_bit n b = take_bit n d"
   by (auto intro: bin_cat_cong bin_cat_eqD1 bin_cat_eqD2)
 
 lemma bin_sc_pos:
   "0 \<le> i \<Longrightarrow> 0 \<le> bin_sc n b i"
   by (metis bin_sign_sc sign_Pls_ge_0)
 
 code_identifier
   code_module Bits_Int \<rightharpoonup>
   (SML) Bit_Operations and (OCaml) Bit_Operations and (Haskell) Bit_Operations and (Scala) Bit_Operations
 
 end
diff --git a/thys/Word_Lib/Least_significant_bit.thy b/thys/Word_Lib/Least_significant_bit.thy
--- a/thys/Word_Lib/Least_significant_bit.thy
+++ b/thys/Word_Lib/Least_significant_bit.thy
@@ -1,94 +1,94 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Operation variant for the least significant bit\<close>
 
 theory Least_significant_bit
   imports
     "HOL-Library.Word"
     More_Word
 begin
 
 class lsb = semiring_bits +
   fixes lsb :: \<open>'a \<Rightarrow> bool\<close>
   assumes lsb_odd: \<open>lsb = odd\<close>
 
 instantiation int :: lsb
 begin
 
 definition lsb_int :: \<open>int \<Rightarrow> bool\<close>
   where \<open>lsb i = bit i 0\<close> for i :: int
 
 instance
-  by standard (simp add: fun_eq_iff lsb_int_def)
+  by standard (simp add: fun_eq_iff lsb_int_def bit_0)
 
 end
 
 lemma bin_last_conv_lsb: "odd = (lsb :: int \<Rightarrow> bool)"
   by (simp add: lsb_odd)
 
 lemma int_lsb_numeral [simp]:
   "lsb (0 :: int) = False"
   "lsb (1 :: int) = True"
   "lsb (Numeral1 :: int) = True"
   "lsb (- 1 :: int) = True"
   "lsb (- Numeral1 :: int) = True"
   "lsb (numeral (num.Bit0 w) :: int) = False"
   "lsb (numeral (num.Bit1 w) :: int) = True"
   "lsb (- numeral (num.Bit0 w) :: int) = False"
   "lsb (- numeral (num.Bit1 w) :: int) = True"
-  by (simp_all add: lsb_int_def)
+  by (simp_all add: lsb_int_def bit_0)
 
 instantiation word :: (len) lsb
 begin
 
 definition lsb_word :: \<open>'a word \<Rightarrow> bool\<close>
   where word_lsb_def: \<open>lsb a \<longleftrightarrow> odd (uint a)\<close> for a :: \<open>'a word\<close>
 
 instance
   apply standard
   apply (simp add: fun_eq_iff word_lsb_def)
   apply transfer apply simp
   done
 
 end
 
 lemma lsb_word_eq:
   \<open>lsb = (odd :: 'a word \<Rightarrow> bool)\<close> for w :: \<open>'a::len word\<close>
   by (fact lsb_odd)
 
 lemma word_lsb_alt: "lsb w = bit w 0"
   for w :: "'a::len word"
-  by (simp add: lsb_word_eq)
+  by (simp add: lsb_word_eq bit_0)
 
 lemma word_lsb_1_0 [simp]: "lsb (1::'a::len word) \<and> \<not> lsb (0::'b::len word)"
   unfolding word_lsb_def by simp
 
 lemma word_lsb_int: "lsb w \<longleftrightarrow> uint w mod 2 = 1"
   apply (simp add: lsb_odd flip: odd_iff_mod_2_eq_one)
   apply transfer
   apply simp
   done
 
 lemmas word_ops_lsb = lsb0 [unfolded word_lsb_alt]
 
 lemma word_lsb_numeral [simp]:
   "lsb (numeral bin :: 'a::len word) \<longleftrightarrow> odd (numeral bin :: int)"
   by (simp only: lsb_odd, transfer) rule
 
 lemma word_lsb_neg_numeral [simp]:
   "lsb (- numeral bin :: 'a::len word) \<longleftrightarrow> odd (- numeral bin :: int)"
   by (simp only: lsb_odd, transfer) rule
 
 lemma word_lsb_nat:"lsb w = (unat w mod 2 = 1)"
   apply (simp add: word_lsb_def Groebner_Basis.algebra(31))
   apply transfer
   apply (simp add: even_nat_iff)
   done
 
 end
diff --git a/thys/Word_Lib/More_Word.thy b/thys/Word_Lib/More_Word.thy
--- a/thys/Word_Lib/More_Word.thy
+++ b/thys/Word_Lib/More_Word.thy
@@ -1,2563 +1,2563 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Lemmas on words\<close>
 
 theory More_Word
   imports
     "HOL-Library.Word"
     More_Arithmetic
     More_Divides
 begin
 
 context unique_euclidean_semiring_with_bit_operations \<comment>\<open>TODO: move\<close>
 begin
 
 lemma possible_bit [simp]:
   \<open>possible_bit TYPE('a) n\<close>
   by (simp add: possible_bit_def)
 
 lemma drop_bit_mask_eq:
   \<open>drop_bit m (mask n) = mask (n - m)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps possible_bit_def)
 
 end
 
 context
   includes bit_operations_syntax
 begin
 
 \<comment> \<open>problem posed by TPHOLs referee:
       criterion for overflow of addition of signed integers\<close>
 
 lemma sofl_test:
   \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
     drop_bit (size x - 1) ((x + y XOR x) AND (x + y XOR y)) = 0\<close>
   for x y :: \<open>'a::len word\<close>
 proof -
   obtain n where n: \<open>LENGTH('a) = Suc n\<close>
     by (cases \<open>LENGTH('a)\<close>) simp_all
   have *: \<open>sint x + sint y + 2 ^ Suc n > signed_take_bit n (sint x + sint y) \<Longrightarrow> sint x + sint y \<ge> - (2 ^ n)\<close>
     \<open>signed_take_bit n (sint x + sint y) > sint x + sint y - 2 ^ Suc n \<Longrightarrow> 2 ^ n > sint x + sint y\<close>
     using signed_take_bit_int_greater_eq [of \<open>sint x + sint y\<close> n] signed_take_bit_int_less_eq [of n \<open>sint x + sint y\<close>]
     by (auto intro: ccontr)
   have \<open>sint x + sint y = sint (x + y) \<longleftrightarrow>
     (sint (x + y) < 0 \<longleftrightarrow> sint x < 0) \<or>
     (sint (x + y) < 0 \<longleftrightarrow> sint y < 0)\<close>
     using sint_less [of x] sint_greater_eq [of x] sint_less [of y] sint_greater_eq [of y]
     signed_take_bit_int_eq_self [of \<open>LENGTH('a) - 1\<close> \<open>sint x + sint y\<close>]
     apply (auto simp add: not_less)
        apply (unfold sint_word_ariths)
        apply (subst signed_take_bit_int_eq_self)
          prefer 4
          apply (subst signed_take_bit_int_eq_self)
            prefer 7
            apply (subst signed_take_bit_int_eq_self)
              prefer 10
              apply (subst signed_take_bit_int_eq_self)
                apply (auto simp add: signed_take_bit_int_eq_self signed_take_bit_eq_take_bit_minus take_bit_Suc_from_most n not_less intro!: *)
        apply (smt (z3) take_bit_nonnegative)
       apply (smt (z3) take_bit_int_less_exp)
      apply (smt (z3) take_bit_nonnegative)
     apply (smt (z3) take_bit_int_less_exp)
     done
   then show ?thesis
     apply (simp only: One_nat_def word_size drop_bit_eq_zero_iff_not_bit_last bit_and_iff bit_xor_iff)
     apply (simp add: bit_last_iff)
     done
 qed
 
 lemma unat_power_lower [simp]:
   "unat ((2::'a::len word) ^ n) = 2 ^ n" if "n < LENGTH('a::len)"
   using that by transfer simp
 
 lemma unat_p2: "n < LENGTH('a :: len) \<Longrightarrow> unat (2 ^ n :: 'a word) = 2 ^ n"
   by (fact unat_power_lower)
 
 lemma word_div_lt_eq_0:
   "x < y \<Longrightarrow> x div y = 0" for x :: "'a :: len word"
   by transfer simp
 
 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 word_of_nat_eq_iff flip: nat_div_eq_Suc_0_iff)
   apply (simp flip: unat_div unsigned_take_bit_eq)
   done
 
 lemma AND_twice [simp]:
   "(w AND m) AND m = w AND m"
   by (fact and.right_idem)
 
 lemma word_combine_masks:
   "w AND m = z \<Longrightarrow> w AND m' = z' \<Longrightarrow> w AND (m OR m') = (z OR z')"
   for w m m' z z' :: \<open>'a::len word\<close>
   by (simp add: bit.conj_disj_distrib)
 
 lemma p2_gt_0:
   "(0 < (2 ^ n :: 'a :: len word)) = (n < LENGTH('a))"
   by (simp add : word_gt_0 not_le)
 
 lemma uint_2p_alt:
   \<open>n < LENGTH('a::len) \<Longrightarrow> uint ((2::'a::len word) ^ n) = 2 ^ n\<close>
   using p2_gt_0 [of n, where ?'a = 'a] by (simp add: uint_2p)
 
 lemma p2_eq_0:
   \<open>(2::'a::len word) ^ n = 0 \<longleftrightarrow> LENGTH('a::len) \<le> n\<close>
   by (fact exp_eq_zero_iff)
 
 lemma p2len:
   \<open>(2 :: 'a word) ^ LENGTH('a::len) = 0\<close>
   by simp
 
 lemma neg_mask_is_div:
   "w AND NOT (mask n) = (w div 2^n) * 2^n"
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI)
     (auto simp add: bit_simps simp flip: push_bit_eq_mult drop_bit_eq_div)
 
 lemma neg_mask_is_div':
   "n < size w \<Longrightarrow> w AND NOT (mask n) = ((w div (2 ^ n)) * (2 ^ n))"
   for w :: \<open>'a::len word\<close>
   by (rule neg_mask_is_div)
 
 lemma and_mask_arith:
   "w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI)
     (auto simp add: bit_simps word_size simp flip: push_bit_eq_mult drop_bit_eq_div)
 
 lemma and_mask_arith':
   "0 < n \<Longrightarrow> w AND mask n = (w * 2^(size w - n)) div 2^(size w - n)"
   for w :: \<open>'a::len word\<close>
   by (rule and_mask_arith)
 
 lemma mask_2pm1: "mask n = 2 ^ n - (1 :: 'a::len word)"
   by (fact mask_eq_decr_exp)
 
 lemma add_mask_fold:
   "x + 2 ^ n - 1 = x + mask n"
   for x :: \<open>'a::len word\<close>
   by (simp add: mask_eq_decr_exp)
 
 lemma word_and_mask_le_2pm1: "w AND mask n \<le> 2 ^ n - 1"
   for w :: \<open>'a::len word\<close>
   by (simp add: mask_2pm1[symmetric] word_and_le1)
 
 lemma is_aligned_AND_less_0:
   "u AND mask n = 0 \<Longrightarrow> v < 2^n \<Longrightarrow> u AND v = 0"
   for u v :: \<open>'a::len word\<close>
   apply (drule less_mask_eq)
   apply (simp flip: take_bit_eq_mask)
   apply (simp add: bit_eq_iff)
   apply (auto simp add: bit_simps)
   done
 
 lemma and_mask_eq_iff_le_mask:
   \<open>w AND mask n = w \<longleftrightarrow> w \<le> mask n\<close>
   for w :: \<open>'a::len word\<close>
   apply (simp flip: take_bit_eq_mask)
   apply (cases \<open>n \<ge> LENGTH('a)\<close>; transfer)
    apply (simp_all add: not_le min_def)
    apply (simp_all add: mask_eq_exp_minus_1)
   apply auto
    apply (metis take_bit_int_less_exp)
   apply (metis min_def nat_less_le take_bit_int_eq_self_iff take_bit_take_bit)
   done
 
 lemma less_eq_mask_iff_take_bit_eq_self:
   \<open>w \<le> mask n \<longleftrightarrow> take_bit n w = w\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: and_mask_eq_iff_le_mask take_bit_eq_mask)
 
 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 :: 'a::len word) = - (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
 
 lemma gt0_iff_gem1:
   \<open>0 < x \<longleftrightarrow> x - 1 < x\<close>
   for x :: \<open>'a::len word\<close>
   by (metis add.right_neutral diff_add_cancel less_irrefl measure_unat unat_arith_simps(2) word_neq_0_conv word_sub_less_iff)
 
 lemma power_2_ge_iff:
   \<open>2 ^ n - (1 :: 'a::len word) < 2 ^ n \<longleftrightarrow> n < LENGTH('a)\<close>
   using gt0_iff_gem1 p2_gt_0 by blast
 
 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])
 
 lemma mask_lt_2pn:
   \<open>n < LENGTH('a) \<Longrightarrow> mask n < (2 :: 'a::len word) ^ n\<close>
   by (simp add: mask_eq_exp_minus_1 power_2_ge_iff)
 
 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 word_and_max_word:
   fixes a::"'a::len word"
   shows "x = - 1 \<Longrightarrow> a AND x = a"
   by simp
 
 lemma word_and_full_mask_simp:
   \<open>x AND mask LENGTH('a) = x\<close> for x :: \<open>'a::len word\<close>
   by (simp add: bit_eq_iff bit_simps)
 
 lemma of_int_uint:
   "of_int (uint x) = x"
   by (fact word_of_int_uint)
 
 corollary word_plus_and_or_coroll:
   "x AND y = 0 \<Longrightarrow> x + y = x OR y"
   for x y :: \<open>'a::len word\<close>
   using word_plus_and_or[where x=x and y=y]
   by simp
 
 corollary word_plus_and_or_coroll2:
   "(x AND w) + (x AND NOT w) = x"
   for x w :: \<open>'a::len word\<close>
   apply (subst disjunctive_add)
    apply (simp add: bit_simps)
   apply (simp flip: bit.conj_disj_distrib)
   done
 
 lemma unat_mask_eq:
   \<open>unat (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close>
   by transfer (simp add: nat_mask_eq)
 
 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 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 transfer (simp add: min_def split: if_splits)
 
 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"
   apply transfer
   apply (cases \<open>LENGTH('c) = LENGTH('a)\<close>)
    apply (auto simp add: min_def)
   done
 
 lemma ucast_0_I:
   "x = 0 \<Longrightarrow> ucast x = 0"
   by simp
 
 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  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)
 
 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_eq_unatI:
   \<open>v = w\<close> if \<open>unat v = unat w\<close>
   using that by transfer (simp add: nat_eq_iff)
 
 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_eq_unatI)
   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 enum_word_nth_eq:
   \<open>(Enum.enum :: 'a::len word list) ! n = word_of_nat n\<close>
     if \<open>n < 2 ^ LENGTH('a)\<close>
     for n
   using that by (simp add: enum_word_def)
 
 lemma length_enum_word_eq:
   \<open>length (Enum.enum :: 'a::len word list) = 2 ^ LENGTH('a)\<close>
   by (simp add: enum_word_def)
 
 lemma unat_lt2p [iff]:
   \<open>unat x < 2 ^ LENGTH('a)\<close> for x :: \<open>'a::len word\<close>
   by transfer simp
 
 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 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 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 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_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_all
   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 push_bit_word_eq_nonzero:
   \<open>push_bit n w \<noteq> 0\<close> if \<open>w < 2 ^ m\<close> \<open>m + n < LENGTH('a)\<close> \<open>w \<noteq> 0\<close>
     for w :: \<open>'a::len word\<close>
   using that
   apply (simp only: word_neq_0_conv word_less_nat_alt
                     mod_0 unat_word_ariths
                     unat_power_lower word_le_nat_alt)
   apply (metis add_diff_cancel_right' gr0I gr_implies_not0 less_or_eq_imp_le min_def push_bit_eq_0_iff take_bit_nat_eq_self_iff take_bit_push_bit take_bit_take_bit unsigned_push_bit_eq)
   done
 
 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 \<open>sz < LENGTH('a)\<close>)
   case True
   with assms show ?thesis
     by (simp add: unat_word_ariths take_bit_eq_mod mod_simps unsigned_of_nat)
       (simp add: take_bit_nat_eq_self_iff nat_less_power_trans flip: take_bit_eq_mod)
 next
   case False
   with assms show ?thesis
     by simp
 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 word_le_minus_one_leq:
   "x < y \<Longrightarrow> x \<le> y - 1" for x :: "'a :: len word"
   by transfer (metis le_less_trans less_irrefl take_bit_decr_eq take_bit_nonnegative zle_diff1_eq)
 
 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 unat_of_nat_len:
   "x < 2 ^ LENGTH('a) \<Longrightarrow> unat (of_nat x :: 'a::len word) = x"
   by (simp add: unsigned_of_nat take_bit_nat_eq_self_iff)
 
 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 transfer
     (auto simp add: take_bit_of_nat nat_eq_iff take_bit_nat_eq_self_iff intro: sym)
 
 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 mask_out_sub_mask:
   "(x AND NOT (mask n)) = x - (x AND (mask n))"
   for x :: \<open>'a::len word\<close>
   by (simp add: field_simps word_plus_and_or_coroll2)
 
 lemma subtract_mask:
   "p - (p AND mask n) = (p AND NOT (mask n))"
   "p - (p AND NOT (mask n)) = (p AND mask n)"
   for p :: \<open>'a::len word\<close>
   by (simp add: field_simps word_plus_and_or_coroll2)+
 
 lemma take_bit_word_eq_self_iff:
   \<open>take_bit n w = w \<longleftrightarrow> n \<ge> LENGTH('a) \<or> w < 2 ^ n\<close>
   for w :: \<open>'a::len word\<close>
   using take_bit_int_eq_self_iff [of n \<open>take_bit LENGTH('a) (uint w)\<close>]
   by (transfer fixing: n) auto
 
 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
   using assms by transfer simp
 
 lemma mask_twice:
   "(x AND mask n) AND mask m = x AND mask (min m n)"
   for x :: \<open>'a::len word\<close>
   by (simp flip: take_bit_eq_mask)
 
 lemma plus_one_helper[elim!]:
   "x < n + (1 :: 'a :: len word) \<Longrightarrow> x \<le> n"
   apply (simp add: word_less_nat_alt word_le_nat_alt field_simps)
   apply (case_tac "1 + n = 0")
    apply simp_all
   apply (subst(asm) unatSuc, assumption)
   apply arith
   done
 
 lemma plus_one_helper2:
   "\<lbrakk> x \<le> n; n + 1 \<noteq> 0 \<rbrakk> \<Longrightarrow> x < n + (1 :: 'a :: len word)"
   by (simp add: word_less_nat_alt word_le_nat_alt field_simps
                 unatSuc)
 
 lemma less_x_plus_1:
   fixes x :: "'a :: len word" shows
   "x \<noteq> - 1 \<Longrightarrow> (y < (x + 1)) = (y < x \<or> y = x)"
   apply (rule iffI)
    apply (rule disjCI)
    apply (drule plus_one_helper)
    apply simp
   apply (subgoal_tac "x < x + 1")
    apply (erule disjE, simp_all)
   apply (rule plus_one_helper2 [OF order_refl])
   apply (rule notI, drule max_word_wrap)
   apply simp
   done
 
 lemma word_Suc_leq:
   fixes k::"'a::len word" shows "k \<noteq> - 1 \<Longrightarrow> x < k + 1 \<longleftrightarrow> x \<le> k"
   using less_x_plus_1 word_le_less_eq by auto
 
 lemma word_Suc_le:
    fixes k::"'a::len word" shows "x \<noteq> - 1 \<Longrightarrow> x + 1 \<le> k \<longleftrightarrow> x < k"
   by (meson not_less word_Suc_leq)
 
 lemma word_lessThan_Suc_atMost:
   \<open>{..< k + 1} = {..k}\<close> if \<open>k \<noteq> - 1\<close> for k :: \<open>'a::len word\<close>
   using that by (simp add: lessThan_def atMost_def word_Suc_leq)
 
 lemma word_atLeastLessThan_Suc_atLeastAtMost:
   \<open>{l ..< u + 1} = {l..u}\<close> if \<open>u \<noteq> - 1\<close> for l :: \<open>'a::len word\<close>
   using that by (simp add: atLeastAtMost_def atLeastLessThan_def word_lessThan_Suc_atMost)
 
 lemma word_atLeastAtMost_Suc_greaterThanAtMost:
   \<open>{m<..u} = {m + 1..u}\<close> if \<open>m \<noteq> - 1\<close> for m :: \<open>'a::len word\<close>
   using that by (simp add: greaterThanAtMost_def greaterThan_def atLeastAtMost_def atLeast_def word_Suc_le)
 
 lemma word_atLeastLessThan_Suc_atLeastAtMost_union:
   fixes l::"'a::len word"
   assumes "m \<noteq> - 1" and "l \<le> m" and "m \<le> u"
   shows "{l..m} \<union> {m+1..u} = {l..u}"
   proof -
   from ivl_disj_un_two(8)[OF assms(2) assms(3)] have "{l..u} = {l..m} \<union> {m<..u}" by blast
   with assms show ?thesis by(simp add: word_atLeastAtMost_Suc_greaterThanAtMost)
   qed
 
 lemma max_word_less_eq_iff [simp]:
   \<open>- 1 \<le> w \<longleftrightarrow> w = - 1\<close> for w :: \<open>'a::len word\<close>
   by (fact word_order.extremum_unique)
 
 lemma word_or_zero:
   "(a OR b = 0) = (a = 0 \<and> b = 0)"
   for a b :: \<open>'a::len word\<close>
   by (fact or_eq_0_iff)
 
 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 power_overflow:
   "n \<ge> LENGTH('a) \<Longrightarrow> 2 ^ n = (0 :: 'a::len word)"
   by simp
 
 lemmas extra_sle_sless_unfolds [simp] =
     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 word_sint_1:
   "sint (1::'a::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   by (fact signed_1)
 
 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)"
   by transfer simp
 
 lemma scast_1':
   "(scast (1::'a::len word) :: 'b::len word) =
    (word_of_int (signed_take_bit (LENGTH('a::len) - Suc 0) (1::int)))"
   by transfer simp
 
 lemma scast_1:
   "(scast (1::'a::len word) :: 'b::len word) = (if LENGTH('a) = 1 then -1 else 1)"
   by (fact signed_1)
 
 lemma unat_minus_one_word:
   "unat (-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by (simp add: mask_eq_exp_minus_1 unsigned_minus_1_eq_mask)
 
 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 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 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 neg_mask_combine:
   "NOT(mask a) AND NOT(mask b) = NOT(mask (max a b) :: 'a::len word)"
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 lemma neg_mask_twice:
   "x AND NOT(mask n) AND NOT(mask m) = x AND NOT(mask (max n m))"
   for x :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 lemma multiple_mask_trivia:
   "n \<ge> m \<Longrightarrow> (x AND NOT(mask n)) + (x AND mask n AND NOT(mask m)) = x AND NOT(mask m)"
   for x :: \<open>'a::len word\<close>
   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 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: unsigned_of_nat take_bit_eq_mod)
   done
 
 lemma unat_mask:
   "unat (mask n :: 'a :: len word) = 2 ^ (min n (LENGTH('a))) - 1"
   apply (subst min.commute)
   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 mask_over_length:
   "LENGTH('a) \<le> n \<Longrightarrow> mask n = (-1::'a::len word)"
   by (simp add: mask_eq_decr_exp)
 
 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 sint_of_nat_ge_zero:
   "x < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> sint (of_nat x :: 'a :: len word) \<ge> 0"
   by (simp add: bit_iff_odd signed_of_nat)
 
 lemma int_eq_sint:
   "x < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> sint (of_nat x :: 'a :: len word) = int x"
   apply transfer
   apply (rule signed_take_bit_int_eq_self)
    apply simp_all
   apply (metis negative_zle numeral_power_eq_of_nat_cancel_iff)
   done
 
 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)"
   apply (cases \<open>LENGTH('a)\<close>)
   apply simp_all
   apply transfer
   apply (subst signed_take_bit_eq_if_positive)
    apply (simp add: bit_simps)
   apply (metis bit_take_bit_iff nat_less_le order_less_le_trans take_bit_nat_eq_self_iff)
   apply (subst signed_take_bit_eq_if_positive)
     apply (simp add: bit_simps)
   apply (metis bit_take_bit_iff nat_less_le take_bit_nat_eq_self_iff)
     apply (simp flip: of_nat_take_bit add: take_bit_nat_eq_self)
   done
 
 lemma word_le_not_less:
   "((b::'a::len word) \<le> a) = (\<not>(a < b))"
   by fastforce
 
 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 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 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 ucast_less:
   "LENGTH('b) < LENGTH('a) \<Longrightarrow>
    (ucast (x :: 'b :: len word) :: ('a :: len word)) < 2 ^ LENGTH('b)"
   by transfer simp
 
 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)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   apply (metis bit_take_bit_iff take_bit_word_eq_self_iff)
   done
 
 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
 
 lemma word_less_sub_1:
   "x < (y :: 'a :: len word) \<Longrightarrow> x \<le> y - 1"
   by (fact word_le_minus_one_leq)
 
 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 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 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: take_bit_eq_mod unsigned_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_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 (auto simp add: word_of_nat_eq_0_iff)
 
 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 (metis unat_of_nat_len)
 
 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 ucast_ucast_mask:
   "(ucast :: 'a :: len word \<Rightarrow> 'b :: len word) (ucast x) = x AND mask (len_of TYPE ('a))"
   apply (simp flip: take_bit_eq_mask)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 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))"
 proof -
   have \<open>2 ^ LENGTH('a) = nat (2 ^ LENGTH('a))\<close>
     by simp
   moreover have \<open>unat (ucast x :: 'a word) = 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 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
 
 lemma word_div_1:
   "(n :: 'a :: len word) div 1 = n"
   by (fact bits_div_by_1)
 
 lemma word_minus_one_le:
   "-1 \<le> (x :: 'a :: len word) = (x = -1)"
   by (fact word_order.extremum_unique)
 
 lemma up_scast_inj:
       "\<lbrakk> scast x = (scast y :: 'b :: len word); size x \<le> LENGTH('b) \<rbrakk>
          \<Longrightarrow> x = y"
   apply transfer
   apply (cases \<open>LENGTH('a)\<close>)
   apply simp_all
   apply (metis order_refl take_bit_signed_take_bit take_bit_tightened)
   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 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 unat_eq_1:
   \<open>unat x = Suc 0 \<longleftrightarrow> x = 1\<close>
   by (auto intro!: unsigned_word_eqI [where ?'a = nat])
 
 lemma word_unat_Rep_inject1:
   \<open>unat x = unat 1 \<longleftrightarrow> x = 1\<close>
   by (simp add: unat_eq_1)
 
 lemma and_not_mask_twice:
   "(w AND NOT (mask n)) AND NOT (mask m) = w AND NOT (mask (max m n))"
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 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 mask_and_mask:
   "mask a AND mask b = (mask (min a b) :: 'a::len word)"
   by (simp flip: take_bit_eq_mask ac_simps)
 
 lemma mask_eq_0_eq_x:
   "(x AND w = 0) = (x AND NOT w = x)"
   for x w :: \<open>'a::len word\<close>
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 lemma mask_eq_x_eq_0:
   "(x AND w = x) = (x AND NOT w = 0)"
   for x w :: \<open>'a::len word\<close>
   using word_plus_and_or_coroll2[where x=x and w=w]
   by auto
 
 lemma compl_of_1: "NOT 1 = (-2 :: 'a :: len word)"
   by (fact not_one_eq)
 
 lemma split_word_eq_on_mask:
   "(x = y) = (x AND m = y AND m \<and> x AND NOT m = y AND NOT m)"
   for x y m :: \<open>'a::len word\<close>
   apply transfer
   apply (simp add: bit_eq_iff)
   apply (auto simp add: bit_simps ac_simps)
   done
 
 lemma word_FF_is_mask:
   "0xFF = (mask 8 :: 'a::len word)"
   by (simp add: mask_eq_decr_exp)
 
 lemma word_1FF_is_mask:
   "0x1FF = (mask 9 :: 'a::len word)"
   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 transfer
   apply (auto simp add: take_bit_of_nat min_def not_le)
   apply (metis linorder_not_less min_def take_bit_nat_eq_self take_bit_take_bit)
   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 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 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 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 transfer simp
 
 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 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 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_all add: word_less_nat_alt unsigned_of_nat)
   using take_bit_nat_less_eq_self
   apply (rule le_less_trans)
   apply assumption
   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 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 (cases \<open>2 \<le> LENGTH('a)\<close>)
   apply simp_all
   apply transfer
   apply auto
   apply (metis add.commute add.right_neutral even_two_times_div_two mod_div_trivial mod_pos_pos_trivial mult.commute mult_zero_left not_less not_take_bit_negative odd_two_times_div_two_succ)
   done
 
 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 del: of_nat_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 AND 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 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 auto
   using of_nat_inj apply blast
   done
 
 lemma mask_AND_NOT_mask:
   "(w AND NOT (mask n)) AND mask n = 0"
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 lemma AND_NOT_mask_plus_AND_mask_eq:
   "(w AND NOT (mask n)) + (w AND mask n) = w"
   for w :: \<open>'a::len word\<close>
   apply (subst disjunctive_add)
   apply (auto simp add: bit_simps)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   done
 
 lemma mask_eqI:
   fixes x :: "'a :: len word"
   assumes m1: "x AND mask n = y AND mask n"
   and     m2: "x AND NOT (mask n) = y AND NOT (mask n)"
   shows "x = y"
 proof -
   have *: \<open>x = x AND mask n OR x AND NOT (mask n)\<close> for x :: \<open>'a word\<close>
     by (rule bit_word_eqI) (auto simp add: bit_simps)
   from assms * [of x] * [of y] show ?thesis
     by simp
 qed
 
 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 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_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 add: take_bit_eq_mod)
   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 mask_Suc_0 : "mask (Suc 0) = (1 :: 'a::len word)"
   by (simp add: mask_eq_decr_exp)
 
 lemma bool_mask':
   fixes x :: "'a :: len word"
   shows "2 < LENGTH('a) \<Longrightarrow> (0 < x AND 1) = (x AND 1 = 1)"
   by (simp add: and_one_eq mod_2_eq_odd)
 
 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 transfer
   apply simp
   apply (subst (2) take_bit_add [symmetric])
   apply (subst take_bit_add [symmetric])
   apply simp
   done
 
 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 word_0_sle_from_less:
   \<open>0 \<le>s x\<close> if \<open>x < 2 ^ (LENGTH('a) - 1)\<close> for x :: \<open>'a::len word\<close>
   using that
   apply transfer
   apply (cases \<open>LENGTH('a)\<close>)
    apply simp_all
   apply (metis bit_take_bit_iff min_def nat_less_le not_less_eq take_bit_int_eq_self_iff take_bit_take_bit)
   done
 
 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"
   apply transfer
   apply (subst (asm) take_bit_incr_eq)
    apply (auto simp add: diff_less_eq)
   using take_bit_int_less_exp le_less_trans by blast
 
 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)
 
 lemma sint_minus1 [simp]: "(sint x = -1) = (x = -1)"
   apply (cases \<open>LENGTH('a)\<close>)
    apply simp_all
   apply transfer
   apply (simp only: flip: signed_take_bit_eq_iff_take_bit_eq)
   apply simp
   done
 
 lemma sint_0 [simp]: "(sint x = 0) = (x = 0)"
   by (fact signed_eq_0_iff)
 
 (* 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:
   P if \<open>\<lbrakk> len_of TYPE ('a::len) = 1; (a::'a word) = 0; sint a = 0 \<rbrakk> \<Longrightarrow> P\<close>
      \<open>\<lbrakk> len_of TYPE ('a) = 1; a = 1; sint (1 :: 'a word) = -1 \<rbrakk> \<Longrightarrow> P\<close>
      \<open>\<lbrakk> len_of TYPE ('a) > 1; sint (1 :: 'a word) = 1 \<rbrakk> \<Longrightarrow> P\<close>
 proof (cases \<open>LENGTH('a) = 1\<close>)
   case True
   then have \<open>a = 0 \<or> a = 1\<close>
     by transfer auto
   with True that show ?thesis
     by auto
 next
   case False
   with that show ?thesis
     by (simp add: less_le Suc_le_eq)
 qed
 
 lemma sint_int_min:
   "sint (- (2 ^ (LENGTH('a) - Suc 0)) :: ('a::len) word) = - (2 ^ (LENGTH('a) - Suc 0))"
   apply (cases \<open>LENGTH('a)\<close>)
    apply simp_all
   apply transfer
   apply (simp add: signed_take_bit_int_eq_self)
   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 simp
   done
 
 lemma uint_range':
   \<open>0 \<le> uint x \<and> uint x < 2 ^ LENGTH('a)\<close>
   for x :: \<open>'a::len word\<close>
   by transfer simp
 
 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"
   by (simp add: signed_take_bit_int_eq_self signed_of_int)
 
 lemma of_int_sint:
   "of_int (sint a) = a"
   by simp
 
 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 transfer
   apply (simp add: signed_take_bit_take_bit)
   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 :: 'a::len word)"
   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_eq unat_eq_nat_uint
   apply transfer
   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 only: flip: ucast_nat_def)
   apply (rule of_nat_mono_maybe)
   apply (rule unat_less_helper)
   apply simp
   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 only: flip: ucast_nat_def)
   apply (subst of_nat_mono_maybe_le[symmetric])
     apply (rule unat_less_helper)
     apply simp
    apply (rule unat_less_helper)
    apply (erule le_less_trans)
   apply (simp_all 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 x \<le> (ucast y :: 'b word)" for x y :: \<open>'a::len word\<close>
   by (auto simp: word_less_nat_alt intro: ucast_mono_le)
 
 lemma neg_mask_add_mask:
   "((x:: 'a :: len word) AND NOT (mask n)) + (2 ^ n - 1) = x OR mask n"
   unfolding mask_2pm1 [symmetric]
   apply (subst word_plus_and_or_coroll; rule bit_word_eqI)
    apply (auto simp add: bit_simps)
   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 AND mask n) AND NOT (mask n) = 0"
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma and_and_not[simp]:"(a AND b) AND NOT b = 0"
   for a b :: \<open>'a::len word\<close>
   apply (subst word_bw_assocs(1))
   apply clarsimp
   done
 
 lemma ex_mask_1[simp]: "(\<exists>x. mask x = (1 :: 'a::len word))"
   apply (rule_tac x=1 in exI)
   apply (simp add:mask_eq_decr_exp)
   done
 
 lemma not_switch:"NOT a = x \<Longrightarrow> a = NOT x"
   by auto
 
 lemma test_bit_eq_iff: "bit u = bit v \<longleftrightarrow> u = v"
   for u v :: "'a::len word"
   by (auto intro: bit_eqI simp add: fun_eq_iff)
 
 lemma test_bit_size: "bit w n \<Longrightarrow> n < size w"
   for w :: "'a::len word"
   by transfer simp
 
 lemma word_eq_iff: "x = y \<longleftrightarrow> (\<forall>n<LENGTH('a). bit x n = bit y n)" (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for x y :: "'a::len word"
   by transfer (auto simp add: bit_eq_iff bit_take_bit_iff)
 
 lemma word_eqI: "(\<And>n. n < size u \<longrightarrow> bit u n = bit v n) \<Longrightarrow> u = v"
   for u :: "'a::len word"
   by (simp add: word_size word_eq_iff)
 
 lemma word_eqD: "u = v \<Longrightarrow> bit u x = bit v x"
   for u v :: "'a::len word"
   by simp
 
 lemma test_bit_bin': "bit w n \<longleftrightarrow> n < size w \<and> bit (uint w) n"
   by transfer (simp add: bit_take_bit_iff)
 
 lemmas test_bit_bin = test_bit_bin' [unfolded word_size]
 
 lemma word_test_bit_def:
   \<open>bit a = bit (uint a)\<close>
   by transfer (simp add: fun_eq_iff bit_take_bit_iff)
 
 lemmas test_bit_def' = word_test_bit_def [THEN fun_cong]
 
 lemma word_test_bit_transfer [transfer_rule]:
   "(rel_fun pcr_word (rel_fun (=) (=)))
     (\<lambda>x n. n < LENGTH('a) \<and> bit x n) (bit :: 'a::len word \<Rightarrow> _)"
   by transfer_prover
 
 lemma test_bit_wi:
   "bit (word_of_int x :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> bit x n"
   by transfer simp
 
 lemma word_ops_nth_size:
   "n < size x \<Longrightarrow>
     bit (x OR y) n = (bit x n | bit y n) \<and>
     bit (x AND y) n = (bit x n \<and> bit y n) \<and>
     bit (x XOR y) n = (bit x n \<noteq> bit y n) \<and>
     bit (NOT x) n = (\<not> bit x n)"
   for x :: "'a::len word"
   by transfer (simp add: bit_or_iff bit_and_iff bit_xor_iff bit_not_iff)
 
 lemma word_ao_nth:
   "bit (x OR y) n = (bit x n | bit y n) \<and>
     bit (x AND y) n = (bit x n \<and> bit y n)"
   for x :: "'a::len word"
   by transfer (auto simp add: bit_or_iff bit_and_iff)
 
 lemmas lsb0 = len_gt_0 [THEN word_ops_nth_size [unfolded word_size]]
 
 lemma nth_sint:
   fixes w :: "'a::len word"
   defines "l \<equiv> LENGTH('a)"
   shows "bit (sint w) n = (if n < l - 1 then bit w n else bit w (l - 1))"
   unfolding sint_uint l_def
   by (auto simp: bit_signed_take_bit_iff word_test_bit_def not_less min_def)
 
 lemma test_bit_2p: "bit (word_of_int (2 ^ n)::'a::len word) m \<longleftrightarrow> m = n \<and> m < LENGTH('a)"
   by transfer (auto simp add: bit_exp_iff)
 
 lemma nth_w2p: "bit ((2::'a::len word) ^ n) m \<longleftrightarrow> m = n \<and> m < LENGTH('a::len)"
   by transfer (auto simp add: bit_exp_iff)
 
 lemma bang_is_le: "bit x m \<Longrightarrow> 2 ^ m \<le> x"
   for x :: "'a::len word"
   apply (rule xtrans(3))
    apply (rule_tac [2] y = "x" in le_word_or2)
   apply (rule word_eqI)
   apply (auto simp add: word_ao_nth nth_w2p word_size)
   done
 
 lemmas msb0 = len_gt_0 [THEN diff_Suc_less, THEN word_ops_nth_size [unfolded word_size]]
 lemmas msb1 = msb0 [where i = 0]
 
 lemma test_bit_1 [iff]: "bit (1 :: 'a::len word) n \<longleftrightarrow> n = 0"
   by transfer (auto simp add: bit_1_iff)
 
 lemma nth_0: "\<not> bit (0 :: 'a::len word) n"
   by transfer simp
 
 lemma nth_minus1: "bit (-1 :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a)"
   by transfer simp
 
 lemma nth_ucast:
   "bit (ucast w::'a::len word) n = (bit w n \<and> n < LENGTH('a))"
   by transfer (simp add: bit_take_bit_iff ac_simps)
 
 lemma drop_bit_numeral_bit0_1 [simp]:
   \<open>drop_bit (Suc 0) (numeral k) =
     (word_of_int (drop_bit (Suc 0) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
   by (metis Word_eq_word_of_int drop_bit_word.abs_eq of_int_numeral)
 
 lemma nth_mask:
   \<open>bit (mask n :: 'a::len word) i \<longleftrightarrow> i < n \<and> i < size (mask n :: 'a word)\<close>
   by (auto simp add: word_size Word.bit_mask_iff)
 
 lemma nth_slice: "bit (slice n w :: 'a::len word) m = (bit w (m + n) \<and> m < LENGTH('a))"
   apply (auto simp add: bit_simps less_diff_conv dest: bit_imp_le_length)
   using bit_imp_le_length
   apply fastforce
   done
 
 lemma test_bit_cat [OF refl]:
   "wc = word_cat a b \<Longrightarrow> bit wc n = (n < size wc \<and>
     (if n < size b then bit b n else bit a (n - size b)))"
   apply (simp add: word_size not_less; transfer)
        apply (auto simp add: bit_concat_bit_iff bit_take_bit_iff)
   done
 
 \<comment> \<open>keep quantifiers for use in simplification\<close>
 lemma test_bit_split':
   "word_split c = (a, b) \<longrightarrow>
     (\<forall>n m.
       bit b n = (n < size b \<and> bit c n) \<and>
       bit a m = (m < size a \<and> bit c (m + size b)))"
   by (auto simp add: word_split_bin' bit_unsigned_iff word_size bit_drop_bit_eq ac_simps
            dest: bit_imp_le_length)
 
 lemma test_bit_split:
   "word_split c = (a, b) \<Longrightarrow>
     (\<forall>n::nat. bit b n \<longleftrightarrow> n < size b \<and> bit c n) \<and>
     (\<forall>m::nat. bit a m \<longleftrightarrow> m < size a \<and> bit c (m + size b))"
   by (simp add: test_bit_split')
 
 lemma test_bit_split_eq:
   "word_split c = (a, b) \<longleftrightarrow>
     ((\<forall>n::nat. bit b n = (n < size b \<and> bit c n)) \<and>
      (\<forall>m::nat. bit a m = (m < size a \<and> bit c (m + size b))))"
   apply (rule_tac iffI)
    apply (rule_tac conjI)
     apply (erule test_bit_split [THEN conjunct1])
    apply (erule test_bit_split [THEN conjunct2])
   apply (case_tac "word_split c")
   apply (frule test_bit_split)
   apply (erule trans)
   apply (fastforce intro!: word_eqI simp add: word_size)
   done
 
 lemma test_bit_rcat:
   "sw = size (hd wl) \<Longrightarrow> rc = word_rcat wl \<Longrightarrow> bit rc n =
     (n < size rc \<and> n div sw < size wl \<and> bit ((rev wl) ! (n div sw)) (n mod sw))"
   for wl :: "'a::len word list"
   by (simp add: word_size word_rcat_def rev_map bit_horner_sum_uint_exp_iff bit_simps not_le)
 
 lemmas test_bit_cong = arg_cong [where f = "bit", THEN fun_cong]
 
 lemma max_test_bit: "bit (- 1::'a::len word) n \<longleftrightarrow> n < LENGTH('a)"
   by (fact nth_minus1)
 
 lemma map_nth_0 [simp]: "map (bit (0::'a::len word)) xs = replicate (length xs) False"
   by (simp flip: map_replicate_const)
 
 lemma word_and_1:
   "n AND 1 = (if bit n 0 then 1 else 0)" for n :: "_ word"
   by (rule bit_word_eqI) (auto simp add: bit_and_iff bit_1_iff intro: gr0I)
 
 lemma test_bit_1':
   "bit (1 :: 'a :: len word) n \<longleftrightarrow> 0 < LENGTH('a) \<and> n = 0"
   by simp
 
 lemma nth_w2p_same:
   "bit (2^n :: 'a :: len word) n = (n < LENGTH('a))"
   by (simp add: nth_w2p)
 
 lemma word_leI:
   "(\<And>n.  \<lbrakk>n < size (u::'a::len word); bit u n \<rbrakk> \<Longrightarrow> bit (v::'a::len word) n) \<Longrightarrow> u <= v"
   apply (rule order_trans [of u \<open>u AND v\<close> v])
    apply (rule eq_refl)
    apply (rule bit_word_eqI)
    apply (auto simp add: bit_simps word_and_le1 word_size)
   done
 
 lemma bang_eq:
   fixes x :: "'a::len word"
   shows "(x = y) = (\<forall>n. bit x n = bit y n)"
   by (auto intro!: bit_eqI)
 
 lemma neg_mask_test_bit:
   "bit (NOT(mask n) :: 'a :: len word) m = (n \<le> m \<and> m < LENGTH('a))"
   by (auto simp add: bit_simps)
 
 lemma upper_bits_unset_is_l2p:
   \<open>(\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> bit p n') \<longleftrightarrow> (p < 2 ^ n)\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
     if \<open>n < LENGTH('a)\<close>
     for p :: "'a :: len word"
 proof
   assume ?Q
   then show ?P
     by (meson bang_is_le le_less_trans not_le word_power_increasing)
 next
   assume ?P
   have \<open>take_bit n p = p\<close>
   proof (rule bit_word_eqI)
     fix q
     assume \<open>q < LENGTH('a)\<close>
     show \<open>bit (take_bit n p) q \<longleftrightarrow> bit p q\<close>
     proof (cases \<open>q < n\<close>)
       case True
       then show ?thesis
         by (auto simp add: bit_simps)
     next
       case False
       then have \<open>n \<le> q\<close>
         by simp
       with \<open>?P\<close> \<open>q < LENGTH('a)\<close> have \<open>\<not> bit p q\<close>
         by simp
       then show ?thesis
         by (simp add: bit_simps)
     qed
   qed
   with that show ?Q
     using take_bit_word_eq_self_iff [of n p] by auto
 qed
 
 lemma less_2p_is_upper_bits_unset:
   "p < 2 ^ n \<longleftrightarrow> n < LENGTH('a) \<and> (\<forall>n' \<ge> n. n' < LENGTH('a) \<longrightarrow> \<not> bit 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 test_bit_over:
   "n \<ge> size (x::'a::len word) \<Longrightarrow> (bit x n) = False"
   by transfer auto
 
 lemma le_mask_high_bits:
   "w \<le> mask n \<longleftrightarrow> (\<forall>i \<in> {n ..< size w}. \<not> bit w i)"
   for w :: \<open>'a::len word\<close>
   apply (auto simp add: bit_simps word_size less_eq_mask_iff_take_bit_eq_self)
    apply (metis bit_take_bit_iff leD)
   apply (metis atLeastLessThan_iff leI take_bit_word_eq_self_iff upper_bits_unset_is_l2p)
   done
 
 lemma test_bit_conj_lt:
   "(bit x m \<and> m < LENGTH('a)) = bit x m" for x :: "'a :: len word"
   using test_bit_bin by blast
 
 lemma neg_test_bit:
   "bit (NOT x) n = (\<not> bit 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)
 
 lemma nth_bounded:
   "\<lbrakk>bit (x :: 'a :: len word) n; x < 2 ^ m; m \<le> len_of TYPE ('a)\<rbrakk> \<Longrightarrow> n < m"
   apply (rule ccontr)
   apply (auto simp add: not_less)
   apply (meson bit_imp_le_length bit_uint_iff less_2p_is_upper_bits_unset test_bit_bin)
   done
 
 lemma and_neq_0_is_nth:
   \<open>x AND y \<noteq> 0 \<longleftrightarrow> bit x n\<close> if \<open>y = 2 ^ n\<close> for x y :: \<open>'a::len word\<close>
   apply (simp add: bit_eq_iff bit_simps)
   using that apply (simp add: bit_simps not_le)
   apply transfer
   apply auto
   done
 
 lemma nth_is_and_neq_0:
   "bit (x::'a::len word) n = (x AND 2 ^ n \<noteq> 0)"
   by (subst and_neq_0_is_nth; rule refl)
 
 lemma max_word_not_less [simp]:
    "\<not> - 1 < x" for x :: \<open>'a::len word\<close>
   by (fact word_order.extremum_strict)
 
 lemma bit_twiddle_min:
   "(y::'a::len word) XOR (((x::'a::len word) XOR y) AND (if x < y then -1 else 0)) = min x y"
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma bit_twiddle_max:
   "(x::'a::len word) XOR (((x::'a::len word) XOR y) AND (if x < y then -1 else 0)) = max x y"
   by (rule bit_eqI) (auto simp add: bit_simps 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 intro: bit_word_eqI simp add: bit_simps)
 
 lemma le_mask_imp_and_mask:
   "(x::'a::len word) \<le> mask n \<Longrightarrow> x AND mask n = x"
   by (metis and_mask_eq_iff_le_mask)
 
 lemma or_not_mask_nop:
   "((x::'a::len word) OR NOT (mask n)) AND mask n = x AND 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) OR y AND mask n) AND NOT (mask m) = x AND NOT (mask m)"
   by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
 
 lemma and_mask_0_iff_le_mask:
   fixes w :: "'a::len word"
   shows "(w AND NOT(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) AND mask m) AND mask n = x AND 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 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 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 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> bit x 0"
-  using even_plus_one_iff [of x] by simp
+  using even_plus_one_iff [of x] by (simp add: bit_0)
 
 lemma odd_iff_lsb:"odd (unat (x::('a::len) word)) = bit x 0"
-  by transfer (simp add: even_nat_iff)
+  by transfer (simp add: even_nat_iff bit_0)
 
 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 auto
   apply (case_tac "((of_nat x)::('a::len) word) = of_nat y")
   apply auto
    apply (metis unat_of_nat)
   done
 
 lemma lsb_this_or_next: "\<not> (bit ((x::('a::len) word) + 1) 0) \<Longrightarrow> bit x 0"
-  by simp
+  by (simp add: bit_0)
 
 lemma mask_or_not_mask:
   "x AND mask n OR x AND NOT (mask n) = x"
   for x :: \<open>'a::len word\<close>
   apply (subst word_oa_dist, simp)
   apply (subst word_oa_dist2, simp)
   done
 
 lemma word_gr0_conv_Suc: "(m::'a::len word) > 0 \<Longrightarrow> \<exists>n. m = n + 1"
   by (metis add.commute add_minus_cancel)
 
 lemma revcast_down_us [OF refl]:
   "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (signed_drop_bit n w)"
   for w :: "'a::len word"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps ac_simps)
   done
 
 lemma revcast_down_ss [OF refl]:
   "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (signed_drop_bit n w)"
   for w :: "'a::len word"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps ac_simps)
   done
 
 lemma revcast_down_uu [OF refl]:
   "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (drop_bit n w)"
   for w :: "'a::len word"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps ac_simps)
   done
 
 lemma revcast_down_su [OF refl]:
   "rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (drop_bit n w)"
   for w :: "'a::len word"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps ac_simps)
   done
 
 lemma cast_down_rev [OF refl]:
   "uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> uc w = revcast (push_bit n w)"
   for w :: "'a::len word"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps)
   done
 
 lemma revcast_up [OF refl]:
   "rc = revcast \<Longrightarrow> source_size rc + n = target_size rc \<Longrightarrow>
     rc w = push_bit n (ucast w :: 'a::len word)"
   apply (simp add: source_size_def target_size_def)
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps)
   apply auto
   apply (metis add.commute add_diff_cancel_right)
   apply (metis diff_add_inverse2 diff_diff_add)
   done
 
 lemmas rc1 = revcast_up [THEN
   revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
 lemmas rc2 = revcast_down_uu [THEN
   revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]]
 
 lemma word_ops_nth:
   fixes x y :: \<open>'a::len word\<close>
   shows
   word_or_nth:  "bit (x OR y) n = (bit x n \<or> bit y n)" and
   word_and_nth: "bit (x AND y) n = (bit x n \<and> bit y n)" and
   word_xor_nth: "bit (x XOR y) n = (bit x n \<noteq> bit y n)"
   by (simp_all add: bit_simps)
 
 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 gr_implies_not0 mult_eq_0_iff nat_mult_power_less_eq numeral_2_eq_2
-    p2_gt_0 unat_eq_zero unat_less_power unat_mult_lem unat_power_lower word_gt_a_gt_0 zero_less_Suc)
+  by (metis Word.word_div_mult bits_div_0 len_gt_0 len_of_finite_2_def nat_mult_power_less_eq
+    p2_gt_0 unat_mono unat_power_lower word_gt_a_gt_0)
 
 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 (simp flip: mask_eq_exp_minus_1 drop_bit_eq_div)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps not_le)
   done
 
 lemma max_word_mask:
   "(- 1 :: 'a::len word) = mask LENGTH('a)"
   by (fact minus_1_eq_mask)
 
 lemmas mask_len_max = max_word_mask[symmetric]
 
 lemma mask_out_first_mask_some:
   "\<lbrakk> x AND NOT (mask n) = y; n \<le> m \<rbrakk> \<Longrightarrow> x AND NOT (mask m) = y AND NOT (mask m)"
   for x y :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
 
 lemma mask_lower_twice:
   "n \<le> m \<Longrightarrow> (x AND NOT (mask n)) AND NOT (mask m) = x AND NOT (mask m)"
   for x :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps word_size)
 
 lemma mask_lower_twice2:
   "(a AND NOT (mask n)) AND NOT (mask m) = a AND NOT (mask (max n m))"
   for a :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps)
 
 lemma ucast_and_neg_mask:
   "ucast (x AND NOT (mask n)) = ucast x AND NOT (mask n)"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma ucast_and_mask:
   "ucast (x AND mask n) = ucast x AND mask n"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma ucast_mask_drop:
   "LENGTH('a :: len) \<le> n \<Longrightarrow> (ucast (x AND mask n) :: 'a word) = ucast x"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma mask_exceed:
   "n \<ge> LENGTH('a) \<Longrightarrow> (x::'a::len word) AND NOT (mask n) = 0"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 lemma word_add_no_overflow:"(x::'a::len word) < - 1 \<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"
   apply (rule bit_eqI)
   using assms apply (auto simp add: bit_simps dest: bit_imp_le_length)
   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 only: flip: ucast_nat_def)
       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]
 
 lemma minus_one_word:
   "(-1 :: 'a :: len word) = 2 ^ LENGTH('a) - 1"
   by simp
 
 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> bit 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> bit (p::'a::len word) n'"
   using upper_bits_unset_is_l2p [where p=p]
   by (cases "n < LENGTH('a)") auto
 
 lemma complement_nth_w2p:
   shows "n' < LENGTH('a) \<Longrightarrow> bit (NOT (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 AND 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) AND mask m) < 2 ^ m"
   by (rule word_unat_and_lt) (simp add: unat_mask word_size)
 
 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"
   have "inj_on ?of_nat {i. i < CARD('a word)}"
     by (rule inj_onI) (simp add: card_word of_nat_inj)
   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 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 transfer simp
 
 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_or_distrib:
   fixes x :: "'a::len word"
   fixes y :: "'a::len word"
   shows "(ucast (x OR y) :: ('b::len) word) = ucast x OR ucast y"
   by (fact unsigned_or_eq)
 
 lemma word_exists_nth:
   "(w::'a::len word) \<noteq> 0 \<Longrightarrow> \<exists>i. bit w i"
   by (auto simp add: bit_eq_iff)
 
 lemma max_word_not_0 [simp]:
   "- 1 \<noteq> (0 :: 'a::len word)"
   by simp
 
 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 (rule bit_word_eqI)
   fix q
   assume \<open>q < LENGTH('a)\<close>
   from eq have \<open>push_bit n x = push_bit n y\<close>
     by (simp add: push_bit_eq_mult)
   moreover from le have \<open>take_bit m x = x\<close> \<open>take_bit m y = y\<close>
     by (simp_all add: less_eq_mask_iff_take_bit_eq_self)
   ultimately have \<open>push_bit n (take_bit m x) = push_bit n (take_bit m y)\<close>
     by simp_all
   with \<open>q < LENGTH('a)\<close> ws show \<open>bit x q \<longleftrightarrow> bit y q\<close>
     apply (simp add: push_bit_take_bit)
     unfolding bit_eq_iff
     apply (simp add: bit_simps not_le)
     apply (metis (full_types) \<open>take_bit m x = x\<close> \<open>take_bit m y = y\<close> add.commute add_diff_cancel_right' add_less_cancel_right bit_take_bit_iff le_add2 less_le_trans)
     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])
 
 lemma word_of_int_bin_cat_eq_iff:
   "(word_of_int (concat_bit LENGTH('b) (uint b) (uint a))::'c::len word) =
   word_of_int (concat_bit LENGTH('b) (uint d) (uint c)) \<longleftrightarrow> b = d \<and> a = c"
   if "LENGTH('a) + LENGTH('b) \<le> LENGTH('c)"
   for a::"'a::len word" and b::"'b::len word"
 proof -
   from that show ?thesis
   using that concat_bit_eq_iff [of \<open>LENGTH('b)\<close> \<open>uint b\<close> \<open>uint a\<close> \<open>uint d\<close> \<open>uint c\<close>]
   apply (simp add: word_of_int_eq_iff take_bit_int_eq_self flip: word_eq_iff_unsigned)
   apply (simp add: concat_bit_def take_bit_int_eq_self bintr_uint take_bit_push_bit)
   done
 qed
 
 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"
   using word_of_int_bin_cat_eq_iff [OF that, of b a d c]
   by (simp add: word_cat_eq' ac_simps)
 
 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
 
 end
 
 lemmas word_div_less = div_word_less
 
 (* FIXME: move to Word distribution? *)
 lemma bin_nth_minus_Bit0[simp]:
   "0 < n \<Longrightarrow> bit (numeral (num.Bit0 w) :: int) n = bit (numeral w :: int) (n - 1)"
   by (cases n; simp)
 
 lemma bin_nth_minus_Bit1[simp]:
   "0 < n \<Longrightarrow> bit (numeral (num.Bit1 w) :: int) n = bit (numeral w :: int) (n - 1)"
   by (cases n; simp)
 
 lemma word_mod_by_0: "k mod (0::'a::len word) = k"
   by (simp add: word_arith_nat_mod)
 
 end
diff --git a/thys/Word_Lib/More_Word_Operations.thy b/thys/Word_Lib/More_Word_Operations.thy
--- a/thys/Word_Lib/More_Word_Operations.thy
+++ b/thys/Word_Lib/More_Word_Operations.thy
@@ -1,1015 +1,1015 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 section \<open>Misc word operations\<close>
 
 theory More_Word_Operations
   imports
     "HOL-Library.Word"
     Aligned
     Reversed_Bit_Lists
     More_Misc
     Signed_Words
     Word_Lemmas
     Word_EqI
 begin
 
 context
   includes bit_operations_syntax
 begin
 
 definition
   ptr_add :: "'a :: len word \<Rightarrow> nat \<Rightarrow> 'a word" where
   "ptr_add ptr n \<equiv> ptr + of_nat n"
 
 definition
   alignUp :: "'a::len word \<Rightarrow> nat \<Rightarrow> 'a word" where
  "alignUp x n \<equiv> x + 2 ^ n - 1 AND NOT (2 ^ n - 1)"
 
 lemma alignUp_unfold:
   \<open>alignUp w n = (w + mask n) AND NOT (mask n)\<close>
   by (simp add: alignUp_def mask_eq_exp_minus_1 add_mask_fold)
 
 (* 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}"
 
 definition
   w2byte :: "'a :: len word \<Rightarrow> 8 word" where
   "w2byte \<equiv> ucast"
 
 (* 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)))"
 
 lemma word_ctz_unfold:
   \<open>word_ctz w = length (takeWhile (Not \<circ> bit w) [0..<LENGTH('a)])\<close> for w :: \<open>'a::len word\<close>
   by (simp add: word_ctz_def rev_to_bl_eq takeWhile_map)
 
 lemma word_ctz_unfold':
   \<open>word_ctz w = Min (insert LENGTH('a) {n. bit w n})\<close> for w :: \<open>'a::len word\<close>
 proof (cases \<open>\<exists>n. bit w n\<close>)
   case True
   then obtain n where \<open>bit w n\<close> ..
   from \<open>bit w n\<close> show ?thesis
     apply (simp add: word_ctz_unfold)
     apply (subst Min_eq_length_takeWhile [symmetric])
       apply (auto simp add: bit_imp_le_length)
     apply (subst Min_insert)
       apply auto
     apply (subst min.absorb2)
      apply (subst Min_le_iff)
        apply auto
     apply (meson bit_imp_le_length order_less_le)
     done
 next
   case False
   then have \<open>bit w = bot\<close>
     by auto
   then have \<open>word_ctz w = LENGTH('a)\<close>
     by (simp add: word_ctz_def rev_to_bl_eq bot_fun_def map_replicate_const)
   with \<open>bit w = bot\<close> show ?thesis
     by simp
 qed
 
 lemma word_ctz_le:
   "word_ctz (w :: ('a::len word)) \<le> LENGTH('a)"
   apply (clarsimp simp: word_ctz_def)
   using length_takeWhile_le apply (rule order_trans)
   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)
   using length_takeWhile_less apply (rule less_le_trans)
   apply auto
   done
 
 lemma take_bit_word_ctz_eq [simp]:
   \<open>take_bit LENGTH('a) (word_ctz w) = word_ctz w\<close>
   for w :: \<open>'a::len word\<close>
   apply (simp add: take_bit_nat_eq_self_iff word_ctz_def to_bl_unfold)
   using length_takeWhile_le apply (rule le_less_trans)
   apply simp
   done
 
 lemma word_ctz_not_minus_1:
   \<open>word_of_nat (word_ctz (w :: 'a :: len word)) \<noteq> (- 1 :: 'a::len word)\<close> if \<open>1 < LENGTH('a)\<close>
 proof -
   note word_ctz_le
   also from that have \<open>LENGTH('a) < mask LENGTH('a)\<close>
     by (simp add: less_mask)
   finally have \<open>word_ctz w < mask LENGTH('a)\<close> .
   then have \<open>word_of_nat (word_ctz w) < (word_of_nat (mask LENGTH('a)) :: 'a word)\<close>
     by (simp add: of_nat_word_less_iff)
   also have \<open>\<dots> = - 1\<close>
     by (rule bit_word_eqI) (simp add: bit_simps)
   finally show ?thesis
     by simp
 qed
 
 lemma unat_of_nat_ctz_mw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len word) = word_ctz w"
   by (simp add: unsigned_of_nat)
 
 lemma unat_of_nat_ctz_smw:
   "unat (of_nat (word_ctz (w :: 'a :: len word)) :: 'a :: len signed word) = word_ctz w"
   by (simp add: unsigned_of_nat)
 
 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 bit w n then w OR NOT (mask n) else w AND mask n"
 
 lemma sign_extend_eq_signed_take_bit:
   \<open>sign_extend = signed_take_bit\<close>
 proof (rule ext)+
   fix n and w :: \<open>'a::len word\<close>
   show \<open>sign_extend n w = signed_take_bit n w\<close>
   proof (rule bit_word_eqI)
     fix q
     assume \<open>q < LENGTH('a)\<close>
     then show \<open>bit (sign_extend n w) q \<longleftrightarrow> bit (signed_take_bit n w) q\<close>
       by (auto simp add: bit_signed_take_bit_iff
         sign_extend_def bit_and_iff bit_or_iff bit_not_iff bit_mask_iff not_less
         exp_eq_0_imp_not_bit not_le min_def)
   qed
 qed
 
 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> bit w i = bit w n"
 
 lemma ptr_add_0 [simp]:
   "ptr_add ref 0 = ref "
   unfolding ptr_add_def by simp
 
 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
 
 lemma word_log2_zero_eq [simp]:
   \<open>word_log2 0 = 0\<close>
   by (simp add: word_log2_def word_clz_def word_size)
 
 lemma word_log2_unfold:
   \<open>word_log2 w = (if w = 0 then 0 else Max {n. bit w n})\<close>
   for w :: \<open>'a::len word\<close>
 proof (cases \<open>w = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then obtain r where \<open>bit w r\<close>
     by (auto simp add: bit_eq_iff)
   then have \<open>Max {m. bit w m} = LENGTH('a) - Suc (length
     (takeWhile (Not \<circ> bit w) (rev [0..<LENGTH('a)])))\<close>
     by (subst Max_eq_length_takeWhile [of _ \<open>LENGTH('a)\<close>])
       (auto simp add: bit_imp_le_length)
   then have \<open>word_log2 w = Max {x. bit w x}\<close>
     by (simp add: word_log2_def word_clz_def word_size to_bl_unfold rev_map takeWhile_map)
   with \<open>w \<noteq> 0\<close> show ?thesis
     by simp
 qed
 
 lemma word_log2_eqI:
   \<open>word_log2 w = n\<close>
   if \<open>w \<noteq> 0\<close> \<open>bit w n\<close> \<open>\<And>m. bit w m \<Longrightarrow> m \<le> n\<close>
   for w :: \<open>'a::len word\<close>
 proof -
   from \<open>w \<noteq> 0\<close> have \<open>word_log2 w = Max {n. bit w n}\<close>
     by (simp add: word_log2_unfold)
   also have \<open>Max {n. bit w n} = n\<close>
     using that by (auto intro: Max_eqI)
   finally show ?thesis .
 qed
 
 lemma bit_word_log2:
   \<open>bit w (word_log2 w)\<close> if \<open>w \<noteq> 0\<close>
 proof -
   from \<open>w \<noteq> 0\<close> have \<open>\<exists>r. bit w r\<close>
     by (auto intro: bit_eqI)
   then obtain r where \<open>bit w r\<close> ..
   from \<open>w \<noteq> 0\<close> have \<open>word_log2 w = Max {n. bit w n}\<close>
     by (simp add: word_log2_unfold)
   also have \<open>Max {n. bit w n} \<in> {n. bit w n}\<close>
     using \<open>bit w r\<close> by (subst Max_in) auto
   finally show ?thesis
     by simp
 qed
 
 lemma word_log2_maximum:
   \<open>n \<le> word_log2 w\<close> if \<open>bit w n\<close>
 proof -
   have \<open>n \<le> Max {n. bit w n}\<close>
     using that by (auto intro: Max_ge)
   also from that have \<open>w \<noteq> 0\<close>
     by force
   then have \<open>Max {n. bit w n} = word_log2 w\<close>
     by (simp add: word_log2_unfold)
   finally show ?thesis .
 qed
 
 lemma word_log2_nth_same:
   "w \<noteq> 0 \<Longrightarrow> bit w (word_log2 w)"
   by (drule bit_word_log2) simp
 
 lemma word_log2_nth_not_set:
   "\<lbrakk> word_log2 w < i ; i < size w \<rbrakk> \<Longrightarrow> \<not> bit w i"
   using word_log2_maximum [of w i] by auto
 
 lemma word_log2_highest:
   assumes a: "bit w i"
   shows "i \<le> word_log2 w"
   using a by (simp add: word_log2_maximum)
 
 lemma word_log2_max:
   "word_log2 w < size w"
   apply (cases \<open>w = 0\<close>)
    apply (simp_all add: word_size)
   apply (drule bit_word_log2)
   apply (fact bit_imp_le_length)
   done
 
 lemma word_clz_0[simp]:
   "word_clz (0::'a::len word) = LENGTH('a)"
   unfolding word_clz_def by simp
 
 lemma word_clz_minus_one[simp]:
   "word_clz (-1::'a::len word) = 0"
   unfolding word_clz_def by simp
 
 lemma is_aligned_alignUp[simp]:
   "is_aligned (alignUp p n) n"
   by (simp add: alignUp_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 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 add_cancel_right_right add_diff_eq and_mask_eq_iff_le_mask mask_eq_decr_exp mask_out_add_aligned order_refl word_plus_and_or_coroll2)
 
 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 mask_eq_decr_exp [symmetric])
     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 le_add_diff_inverse2 less_mult_imp_div_less order_less_imp_le power_add unsigned_less)
 
   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)
     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 le_add_diff_inverse2 less_mult_imp_div_less order_less_imp_le power_add unsigned_less)
 
     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 (simp flip: drop_bit_eq_div unat_drop_bit_eq) (metis leI le_unat_uoi unat_mono)
 
     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, opaque_lifting) 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 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 auto
 
   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 auto
 
     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 AND NOT (mask sz)"
   by (simp add: alignUp_def flip: mask_eq_decr_exp)
 
 lemma alignUp_def3:
   "alignUp a sz = 2^ sz + (a - 1 AND NOT (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 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 AND NOT (mask sz)) = (p - ((alignUp q sz) AND NOT (mask sz)))"
   apply (clarsimp simp only:word_and_le2 diff_conv_add_uminus)
   apply (subst mask_out_add_aligned[symmetric]; simp)
   apply (simp add: eq_neg_iff_add_eq_0)
   apply (subst add.commute)
   apply (simp add: alignUp_distance is_aligned_neg_mask_eq mask_out_add_aligned and_mask_eq_iff_le_mask flip: mask_eq_x_eq_0)
   done
 
 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"
       using eq_zero_set_bl nz by fastforce
     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
 
 (* Sign extension from bit n. *)
 
 lemma bin_sign_extend_iff [bit_simps]:
   \<open>bit (sign_extend e w) i \<longleftrightarrow> bit w (min e i)\<close>
   if \<open>i < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: sign_extend_def bit_simps min_def)
 
 lemma sign_extend_bitwise_if:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (if i < e then bit w i else bit w e)"
   by (simp add: word_size bit_simps)
 
 lemma sign_extend_bitwise_if'  [word_eqI_simps]:
   \<open>i < LENGTH('a) \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (if i < e then bit w i else bit w e)\<close>
   for w :: \<open>'a::len word\<close>
   using sign_extend_bitwise_if [of i w e] by (simp add: word_size)
 
 lemma sign_extend_bitwise_disj:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> i \<le> e \<and> bit w i \<or> e \<le> i \<and> bit w e"
   by (auto simp: sign_extend_bitwise_if)
 
 lemma sign_extend_bitwise_cases:
   "i < size w \<Longrightarrow> bit (sign_extend e w) i \<longleftrightarrow> (i \<le> e \<longrightarrow> bit w i) \<and> (e \<le> i \<longrightarrow> bit w e)"
   by (auto simp: sign_extend_bitwise_if)
 
 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 bit w n then w OR NOT (mask (Suc n)) else w AND mask (Suc n))"
   by (rule bit_word_eqI) (auto simp add: bit_simps sign_extend_eq_signed_take_bit min_def less_Suc_eq_le)
 
 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 auto
    apply (auto simp add: bit_eq_iff)
     apply (simp_all add: bit_simps sign_extend_eq_signed_take_bit not_le min_def sign_extended_def word_size split: if_splits)
   using le_imp_less_or_eq apply auto
   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 (rule bit_word_eqI) (simp add: sign_extend_eq_signed_take_bit bit_simps)
 
 lemma sign_extended_high_bits:
   "\<lbrakk> sign_extended e p; j < size p; e \<le> i; i < j \<rbrakk> \<Longrightarrow> bit p i = bit p j"
   by (drule (1) sign_extended_weaken; simp add: sign_extended_def)
 
 lemma sign_extend_eq:
   "w AND mask (Suc n) = v AND mask (Suc n) \<Longrightarrow> sign_extend n w = sign_extend n v"
   by (simp flip: take_bit_eq_mask add: sign_extend_eq_signed_take_bit signed_take_bit_eq_iff_take_bit_eq)
 
 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> bit f e"
     using True e less_2p_is_upper_bits_unset[THEN iffD1, OF f]
     by (fastforce simp: word_size)
   hence i: "bit (p + f) e = bit p e"
     by (simp add: and_or bit_simps)
   have fm: "f AND mask e = f"
     by (fastforce intro: subst[where P="\<lambda>f. f AND 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 AND NOT (mask m))"
   by (fastforce simp: sign_extended_def word_size neg_mask_test_bit bit_simps)
 
 definition
   "limited_and (x :: 'a :: len word) y \<longleftrightarrow> (x AND y = x)"
 
 lemma limited_and_eq_0:
   "\<lbrakk> limited_and x z; y AND NOT z = y \<rbrakk> \<Longrightarrow> x AND y = 0"
   unfolding limited_and_def
   apply (subst arg_cong2[where f="(AND)"])
     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 AND z = z \<rbrakk> \<Longrightarrow> x AND 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)"
   using push_bit_and [of n x z] by (simp add: limited_and_def shiftl_def)
 
 lemma rshift_limited_and:
   "limited_and x z \<Longrightarrow> limited_and (x >> n) (z >> n)"
   using drop_bit_and [of n x z] by (simp add: limited_and_def shiftr_def)
 
 lemmas limited_and_simps1 = limited_and_eq_0 limited_and_eq_id
 
 lemmas is_aligned_limited_and
     = is_aligned_neg_mask_eq[unfolded mask_eq_decr_exp, folded limited_and_def]
 
 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]
        not_one_eq
 
 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_eq:
   \<open>from_bool = of_bool\<close>
   by (simp add: fun_eq_iff from_bool_def)
 
 lemma from_bool_0:
   "(from_bool x = 0) = (\<not> x)"
   by (simp add: from_bool_def split: bool.split)
 
 lemma from_bool_eq_if':
   "((if P then 1 else 0) = from_bool Q) = (P = Q)"
   by (cases Q) (simp_all add: from_bool_def)
 
 definition
   to_bool :: "'a::len word \<Rightarrow> bool" where
   "to_bool \<equiv> (\<noteq>) 0"
 
 lemma to_bool_and_1:
   "to_bool (x AND 1) \<longleftrightarrow> bit x 0"
-  by (simp add: to_bool_def and_one_eq mod_2_eq_odd)
+  by (simp add: to_bool_def word_and_1)
 
 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) AND 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 (cases Q) (simp_all add: from_bool_def)
 
 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 fold_eq_0_to_bool:
   "(v = 0) = (\<not> to_bool v)"
   by (simp add: to_bool_def)
 
 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 neg_mask_in_mask_range:
   "is_aligned ptr bits \<Longrightarrow> (ptr' AND NOT(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 bit.disj_ac(2) bit.disj_conj_distrib2 le_word_or2 word_and_max word_or_not)
    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_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 (subst disjunctive_add)
    apply (simp add: bit_simps)
   apply (erule is_alignedE')
    apply (auto simp add: bit_simps not_le)[1]
    apply (metis less_2p_is_upper_bits_unset)
   apply (simp only: is_aligned_add_or word_ao_dist flip: neg_mask_in_mask_range)
   apply (subgoal_tac \<open>y AND NOT (mask n) = 0\<close>)
    apply simp
   apply (metis (full_types) is_aligned_mask is_aligned_neg_mask less_mask_eq word_bw_comms(1) word_bw_lcs(1))
   done
 
 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_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_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_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 auto
   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_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 auto
     using al assms(4) is_aligned_no_wrap' apply blast
     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_ranges_disjoint:
   "\<lbrakk> is_aligned (p :: 'a :: len word) n; is_aligned (p' :: 'a :: len word) n';
      p AND NOT(mask n') \<noteq> p'; p' AND NOT(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 AND mask n >> m" in spec)
   apply (erule notE[OF mp])
    apply (simp flip: take_bit_eq_mask add: shiftr_def drop_bit_take_bit)
    apply transfer
   apply simp
    apply (simp add: word_size and_mask_less_size)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps word_size intro!: bit_eqI)
   done
 
 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 word_clz_max [of w]
   apply (simp add: word_size signed_of_nat)
   apply (subst signed_take_bit_int_eq_self)
     apply simp_all
    apply (metis negative_zle of_nat_numeral semiring_1_class.of_nat_power)
   apply (drule small_powers_of_2)
   apply (erule le_less_trans)
   apply simp
   done
 
 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 word_clz_max [of w]
    apply (simp_all add: word_size unsigned_of_nat)
   apply (rule not_msb_from_less)
   apply (simp add: word_less_nat_alt unsigned_of_nat)
   apply (subst take_bit_nat_eq_self)
    apply (simp add: le_less_trans)
   apply (drule small_powers_of_2)
   apply (erule le_less_trans)
   apply simp
   done
 
 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 from_to_bool_last_bit:
   "from_bool (to_bool (x AND 1)) = x AND 1"
   by (metis from_bool_to_bool_iff word_and_1)
 
 lemma sint_ctz:
   \<open>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))\<close> (is \<open>?P \<and> ?Q\<close>)
   if \<open>LENGTH('a) > 2\<close>
 proof
   have *: \<open>word_ctz x < 2 ^ (LENGTH('a) - Suc 0)\<close>
     using word_ctz_le apply (rule le_less_trans)
     using that small_powers_of_2 [of \<open>LENGTH('a)\<close>] apply simp
     done
   have \<open>int (word_ctz x) div 2 ^ (LENGTH('a) - Suc 0) = 0\<close>
     apply (rule div_pos_pos_trivial)
      apply (simp_all add: *)
     done
   then show ?P by (simp add: signed_of_nat bit_iff_odd)
   show ?Q
     apply (auto simp add: signed_of_nat)
     apply (subst signed_take_bit_int_eq_self)
       apply (auto simp add: word_ctz_le * minus_le_iff [of _ \<open>int (word_ctz x)\<close>])
     apply (rule order.trans [of _ 0])
      apply simp_all
     done
 qed
 
 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_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)
   apply (simp add: is_aligned_weaken algebra_split_simps)
   apply (auto simp add: not_le)
   using is_aligned_no_overflow_mask leD apply blast
   apply (meson aligned_add_mask_less_eq is_aligned_weaken le_less_trans)
   done
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Word_Lib/Reversed_Bit_Lists.thy b/thys/Word_Lib/Reversed_Bit_Lists.thy
--- a/thys/Word_Lib/Reversed_Bit_Lists.thy
+++ b/thys/Word_Lib/Reversed_Bit_Lists.thy
@@ -1,2240 +1,2232 @@
 (*
  * Copyright Data61, CSIRO (ABN 41 687 119 230)
  *
  * SPDX-License-Identifier: BSD-2-Clause
  *)
 
 (* Author: Jeremy Dawson, NICTA *)
 
 section \<open>Bit values as reversed lists of bools\<close>
 
 theory Reversed_Bit_Lists
   imports
     "HOL-Library.Word"
     Typedef_Morphisms
     Least_significant_bit
     Most_significant_bit
     Even_More_List
     "HOL-Library.Sublist"
     Aligned
     Singleton_Bit_Shifts
     Legacy_Aliases
 begin
 
 context
   includes bit_operations_syntax
 begin
 
 lemma horner_sum_of_bool_2_concat:
   \<open>horner_sum of_bool 2 (concat (map (\<lambda>x. map (bit x) [0..<LENGTH('a)]) ws)) = horner_sum uint (2 ^ LENGTH('a)) ws\<close>
   for ws :: \<open>'a::len word list\<close>
 proof (induction ws)
   case Nil
   then show ?case
     by simp
 next
   case (Cons w ws)
   moreover have \<open>horner_sum of_bool 2 (map (bit w) [0..<LENGTH('a)]) = uint w\<close>
   proof transfer
     fix k :: int
     have \<open>map (\<lambda>n. n < LENGTH('a) \<and> bit k n) [0..<LENGTH('a)]
       = map (bit k) [0..<LENGTH('a)]\<close>
       by simp
     then show \<open>horner_sum of_bool 2 (map (\<lambda>n. n < LENGTH('a) \<and> bit k n) [0..<LENGTH('a)])
       = take_bit LENGTH('a) k\<close>
       by (simp only: horner_sum_bit_eq_take_bit)
   qed
   ultimately show ?case
     by (simp add: horner_sum_append)
 qed
 
 
 subsection \<open>Implicit augmentation of list prefixes\<close>
 
 primrec takefill :: "'a \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
     Z: "takefill fill 0 xs = []"
   | Suc: "takefill fill (Suc n) xs =
       (case xs of
         [] \<Rightarrow> fill # takefill fill n xs
       | y # ys \<Rightarrow> y # takefill fill n ys)"
 
 lemma nth_takefill: "m < n \<Longrightarrow> takefill fill n l ! m = (if m < length l then l ! m else fill)"
   apply (induct n arbitrary: m l)
    apply clarsimp
   apply clarsimp
   apply (case_tac m)
    apply (simp split: list.split)
   apply (simp split: list.split)
   done
 
 lemma takefill_alt: "takefill fill n l = take n l @ replicate (n - length l) fill"
   by (induct n arbitrary: l) (auto split: list.split)
 
 lemma takefill_replicate [simp]: "takefill fill n (replicate m fill) = replicate n fill"
   by (simp add: takefill_alt replicate_add [symmetric])
 
 lemma takefill_le': "n = m + k \<Longrightarrow> takefill x m (takefill x n l) = takefill x m l"
   by (induct m arbitrary: l n) (auto split: list.split)
 
 lemma length_takefill [simp]: "length (takefill fill n l) = n"
   by (simp add: takefill_alt)
 
 lemma take_takefill': "n = k + m \<Longrightarrow> take k (takefill fill n w) = takefill fill k w"
   by (induct k arbitrary: w n) (auto split: list.split)
 
 lemma drop_takefill: "drop k (takefill fill (m + k) w) = takefill fill m (drop k w)"
   by (induct k arbitrary: w) (auto split: list.split)
 
 lemma takefill_le [simp]: "m \<le> n \<Longrightarrow> takefill x m (takefill x n l) = takefill x m l"
   by (auto simp: le_iff_add takefill_le')
 
 lemma take_takefill [simp]: "m \<le> n \<Longrightarrow> take m (takefill fill n w) = takefill fill m w"
   by (auto simp: le_iff_add take_takefill')
 
 lemma takefill_append: "takefill fill (m + length xs) (xs @ w) = xs @ (takefill fill m w)"
   by (induct xs) auto
 
 lemma takefill_same': "l = length xs \<Longrightarrow> takefill fill l xs = xs"
   by (induct xs arbitrary: l) auto
 
 lemmas takefill_same [simp] = takefill_same' [OF refl]
 
 lemma tf_rev:
   "n + k = m + length bl \<Longrightarrow> takefill x m (rev (takefill y n bl)) =
     rev (takefill y m (rev (takefill x k (rev bl))))"
   apply (rule nth_equalityI)
    apply (auto simp add: nth_takefill rev_nth)
   apply (rule_tac f = "\<lambda>n. bl ! n" in arg_cong)
   apply arith
   done
 
 lemma takefill_minus: "0 < n \<Longrightarrow> takefill fill (Suc (n - 1)) w = takefill fill n w"
   by auto
 
 lemmas takefill_Suc_cases =
   list.cases [THEN takefill.Suc [THEN trans]]
 
 lemmas takefill_Suc_Nil = takefill_Suc_cases (1)
 lemmas takefill_Suc_Cons = takefill_Suc_cases (2)
 
 lemmas takefill_minus_simps = takefill_Suc_cases [THEN [2]
   takefill_minus [symmetric, THEN trans]]
 
 lemma takefill_numeral_Nil [simp]:
   "takefill fill (numeral k) [] = fill # takefill fill (pred_numeral k) []"
   by (simp add: numeral_eq_Suc)
 
 lemma takefill_numeral_Cons [simp]:
   "takefill fill (numeral k) (x # xs) = x # takefill fill (pred_numeral k) xs"
   by (simp add: numeral_eq_Suc)
 
 
 subsection \<open>Range projection\<close>
 
 definition bl_of_nth :: "nat \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'a list"
   where "bl_of_nth n f = map f (rev [0..<n])"
 
 lemma bl_of_nth_simps [simp, code]:
   "bl_of_nth 0 f = []"
   "bl_of_nth (Suc n) f = f n # bl_of_nth n f"
   by (simp_all add: bl_of_nth_def)
 
 lemma length_bl_of_nth [simp]: "length (bl_of_nth n f) = n"
   by (simp add: bl_of_nth_def)
 
 lemma nth_bl_of_nth [simp]: "m < n \<Longrightarrow> rev (bl_of_nth n f) ! m = f m"
   by (simp add: bl_of_nth_def rev_map)
 
 lemma bl_of_nth_inj: "(\<And>k. k < n \<Longrightarrow> f k = g k) \<Longrightarrow> bl_of_nth n f = bl_of_nth n g"
   by (simp add: bl_of_nth_def)
 
 lemma bl_of_nth_nth_le: "n \<le> length xs \<Longrightarrow> bl_of_nth n (nth (rev xs)) = drop (length xs - n) xs"
   apply (induct n arbitrary: xs)
    apply clarsimp
   apply clarsimp
   apply (rule trans [OF _ hd_Cons_tl])
    apply (frule Suc_le_lessD)
    apply (simp add: rev_nth trans [OF drop_Suc drop_tl, symmetric])
    apply (subst hd_drop_conv_nth)
     apply force
    apply simp_all
   apply (rule_tac f = "\<lambda>n. drop n xs" in arg_cong)
   apply simp
   done
 
 lemma bl_of_nth_nth [simp]: "bl_of_nth (length xs) ((!) (rev xs)) = xs"
   by (simp add: bl_of_nth_nth_le)
 
 
 subsection \<open>More\<close>
 
 definition rotater1 :: "'a list \<Rightarrow> 'a list"
   where "rotater1 ys =
     (case ys of [] \<Rightarrow> [] | x # xs \<Rightarrow> last ys # butlast ys)"
 
 definition rotater :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where "rotater n = rotater1 ^^ n"
 
 lemmas rotater_0' [simp] = rotater_def [where n = "0", simplified]
 
 lemma rotate1_rl': "rotater1 (l @ [a]) = a # l"
   by (cases l) (auto simp: rotater1_def)
 
 lemma rotate1_rl [simp] : "rotater1 (rotate1 l) = l"
   apply (unfold rotater1_def)
   apply (cases "l")
    apply (case_tac [2] "list")
     apply auto
   done
 
 lemma rotate1_lr [simp] : "rotate1 (rotater1 l) = l"
   by (cases l) (auto simp: rotater1_def)
 
 lemma rotater1_rev': "rotater1 (rev xs) = rev (rotate1 xs)"
   by (cases "xs") (simp add: rotater1_def, simp add: rotate1_rl')
 
 lemma rotater_rev': "rotater n (rev xs) = rev (rotate n xs)"
   by (induct n) (auto simp: rotater_def intro: rotater1_rev')
 
 lemma rotater_rev: "rotater n ys = rev (rotate n (rev ys))"
   using rotater_rev' [where xs = "rev ys"] by simp
 
 lemma rotater_drop_take:
   "rotater n xs =
     drop (length xs - n mod length xs) xs @
     take (length xs - n mod length xs) xs"
   by (auto simp: rotater_rev rotate_drop_take rev_take rev_drop)
 
 lemma rotater_Suc [simp]: "rotater (Suc n) xs = rotater1 (rotater n xs)"
   unfolding rotater_def by auto
 
 lemma nth_rotater:
   \<open>rotater m xs ! n = xs ! ((n + (length xs - m mod length xs)) mod length xs)\<close> if \<open>n < length xs\<close>
   using that by (simp add: rotater_drop_take nth_append not_less less_diff_conv ac_simps le_mod_geq)
 
 lemma nth_rotater1:
   \<open>rotater1 xs ! n = xs ! ((n + (length xs - 1)) mod length xs)\<close> if \<open>n < length xs\<close>
   using that nth_rotater [of n xs 1] by simp
 
 lemma rotate_inv_plus [rule_format]:
   "\<forall>k. k = m + n \<longrightarrow> rotater k (rotate n xs) = rotater m xs \<and>
     rotate k (rotater n xs) = rotate m xs \<and>
     rotater n (rotate k xs) = rotate m xs \<and>
     rotate n (rotater k xs) = rotater m xs"
   by (induct n) (auto simp: rotater_def rotate_def intro: funpow_swap1 [THEN trans])
 
 lemmas rotate_inv_rel = le_add_diff_inverse2 [symmetric, THEN rotate_inv_plus]
 
 lemmas rotate_inv_eq = order_refl [THEN rotate_inv_rel, simplified]
 
 lemmas rotate_lr [simp] = rotate_inv_eq [THEN conjunct1]
 lemmas rotate_rl [simp] = rotate_inv_eq [THEN conjunct2, THEN conjunct1]
 
 lemma rotate_gal: "rotater n xs = ys \<longleftrightarrow> rotate n ys = xs"
   by auto
 
 lemma rotate_gal': "ys = rotater n xs \<longleftrightarrow> xs = rotate n ys"
   by auto
 
 lemma length_rotater [simp]: "length (rotater n xs) = length xs"
   by (simp add : rotater_rev)
 
 lemma rotate_eq_mod: "m mod length xs = n mod length xs \<Longrightarrow> rotate m xs = rotate n xs"
   apply (rule box_equals)
     defer
     apply (rule rotate_conv_mod [symmetric])+
   apply simp
   done
 
 lemma restrict_to_left: "x = y \<Longrightarrow> x = z \<longleftrightarrow> y = z"
   by simp
 
 lemmas rotate_eqs =
   trans [OF rotate0 [THEN fun_cong] id_apply]
   rotate_rotate [symmetric]
   rotate_id
   rotate_conv_mod
   rotate_eq_mod
 
 lemmas rrs0 = rotate_eqs [THEN restrict_to_left,
   simplified rotate_gal [symmetric] rotate_gal' [symmetric]]
 lemmas rrs1 = rrs0 [THEN refl [THEN rev_iffD1]]
 lemmas rotater_eqs = rrs1 [simplified length_rotater]
 lemmas rotater_0 = rotater_eqs (1)
 lemmas rotater_add = rotater_eqs (2)
 
 lemma butlast_map: "xs \<noteq> [] \<Longrightarrow> butlast (map f xs) = map f (butlast xs)"
   by (induct xs) auto
 
 lemma rotater1_map: "rotater1 (map f xs) = map f (rotater1 xs)"
   by (cases xs) (auto simp: rotater1_def last_map butlast_map)
 
 lemma rotater_map: "rotater n (map f xs) = map f (rotater n xs)"
   by (induct n) (auto simp: rotater_def rotater1_map)
 
 lemma but_last_zip [rule_format] :
   "\<forall>ys. length xs = length ys \<longrightarrow> xs \<noteq> [] \<longrightarrow>
     last (zip xs ys) = (last xs, last ys) \<and>
     butlast (zip xs ys) = zip (butlast xs) (butlast ys)"
   apply (induct xs)
    apply auto
      apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+
   done
 
 lemma but_last_map2 [rule_format] :
   "\<forall>ys. length xs = length ys \<longrightarrow> xs \<noteq> [] \<longrightarrow>
     last (map2 f xs ys) = f (last xs) (last ys) \<and>
     butlast (map2 f xs ys) = map2 f (butlast xs) (butlast ys)"
   apply (induct xs)
    apply auto
      apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+
   done
 
 lemma rotater1_zip:
   "length xs = length ys \<Longrightarrow>
     rotater1 (zip xs ys) = zip (rotater1 xs) (rotater1 ys)"
   apply (unfold rotater1_def)
   apply (cases xs)
    apply auto
    apply ((case_tac ys, auto simp: neq_Nil_conv but_last_zip)[1])+
   done
 
 lemma rotater1_map2:
   "length xs = length ys \<Longrightarrow>
     rotater1 (map2 f xs ys) = map2 f (rotater1 xs) (rotater1 ys)"
   by (simp add: rotater1_map rotater1_zip)
 
 lemmas lrth =
   box_equals [OF asm_rl length_rotater [symmetric]
                  length_rotater [symmetric],
               THEN rotater1_map2]
 
 lemma rotater_map2:
   "length xs = length ys \<Longrightarrow>
     rotater n (map2 f xs ys) = map2 f (rotater n xs) (rotater n ys)"
   by (induct n) (auto intro!: lrth)
 
 lemma rotate1_map2:
   "length xs = length ys \<Longrightarrow>
     rotate1 (map2 f xs ys) = map2 f (rotate1 xs) (rotate1 ys)"
   by (cases xs; cases ys) auto
 
 lemmas lth = box_equals [OF asm_rl length_rotate [symmetric]
   length_rotate [symmetric], THEN rotate1_map2]
 
 lemma rotate_map2:
   "length xs = length ys \<Longrightarrow>
     rotate n (map2 f xs ys) = map2 f (rotate n xs) (rotate n ys)"
   by (induct n) (auto intro!: lth)
 
 
 subsection \<open>Explicit bit representation of \<^typ>\<open>int\<close>\<close>
 
 primrec bl_to_bin_aux :: "bool list \<Rightarrow> int \<Rightarrow> int"
   where
     Nil: "bl_to_bin_aux [] w = w"
   | Cons: "bl_to_bin_aux (b # bs) w = bl_to_bin_aux bs (of_bool b + 2 * w)"
 
 definition bl_to_bin :: "bool list \<Rightarrow> int"
   where "bl_to_bin bs = bl_to_bin_aux bs 0"
 
 primrec bin_to_bl_aux :: "nat \<Rightarrow> int \<Rightarrow> bool list \<Rightarrow> bool list"
   where
     Z: "bin_to_bl_aux 0 w bl = bl"
   | Suc: "bin_to_bl_aux (Suc n) w bl = bin_to_bl_aux n (w div 2) (odd w # bl)"
 
 definition bin_to_bl :: "nat \<Rightarrow> int \<Rightarrow> bool list"
   where "bin_to_bl n w = bin_to_bl_aux n w []"
 
 lemma bin_to_bl_aux_zero_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n 0 bl = bin_to_bl_aux (n - 1) 0 (False # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_minus1_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n (- 1) bl = bin_to_bl_aux (n - 1) (- 1) (True # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_one_minus_simp [simp]:
   "0 < n \<Longrightarrow> bin_to_bl_aux n 1 bl = bin_to_bl_aux (n - 1) 0 (True # bl)"
   by (cases n) auto
 
 lemma bin_to_bl_aux_Bit0_minus_simp [simp]:
   "0 < n \<Longrightarrow>
     bin_to_bl_aux n (numeral (Num.Bit0 w)) bl = bin_to_bl_aux (n - 1) (numeral w) (False # bl)"
   by (cases n) simp_all
 
 lemma bin_to_bl_aux_Bit1_minus_simp [simp]:
   "0 < n \<Longrightarrow>
     bin_to_bl_aux n (numeral (Num.Bit1 w)) bl = bin_to_bl_aux (n - 1) (numeral w) (True # bl)"
   by (cases n) simp_all
 
 lemma bl_to_bin_aux_append: "bl_to_bin_aux (bs @ cs) w = bl_to_bin_aux cs (bl_to_bin_aux bs w)"
   by (induct bs arbitrary: w) auto
 
 lemma bin_to_bl_aux_append: "bin_to_bl_aux n w bs @ cs = bin_to_bl_aux n w (bs @ cs)"
   by (induct n arbitrary: w bs) auto
 
 lemma bl_to_bin_append: "bl_to_bin (bs @ cs) = bl_to_bin_aux cs (bl_to_bin bs)"
   unfolding bl_to_bin_def by (rule bl_to_bin_aux_append)
 
 lemma bin_to_bl_aux_alt: "bin_to_bl_aux n w bs = bin_to_bl n w @ bs"
   by (simp add: bin_to_bl_def bin_to_bl_aux_append)
 
 lemma bin_to_bl_0 [simp]: "bin_to_bl 0 bs = []"
   by (auto simp: bin_to_bl_def)
 
 lemma size_bin_to_bl_aux: "length (bin_to_bl_aux n w bs) = n + length bs"
   by (induct n arbitrary: w bs) auto
 
 lemma size_bin_to_bl [simp]: "length (bin_to_bl n w) = n"
   by (simp add: bin_to_bl_def size_bin_to_bl_aux)
 
 lemma bl_bin_bl': "bin_to_bl (n + length bs) (bl_to_bin_aux bs w) = bin_to_bl_aux n w bs"
   apply (induct bs arbitrary: w n)
    apply auto
     apply (simp_all only: add_Suc [symmetric])
     apply (auto simp add: bin_to_bl_def)
   done
 
 lemma bl_bin_bl [simp]: "bin_to_bl (length bs) (bl_to_bin bs) = bs"
   unfolding bl_to_bin_def
   apply (rule box_equals)
     apply (rule bl_bin_bl')
    prefer 2
    apply (rule bin_to_bl_aux.Z)
   apply simp
   done
 
 lemma bl_to_bin_inj: "bl_to_bin bs = bl_to_bin cs \<Longrightarrow> length bs = length cs \<Longrightarrow> bs = cs"
   apply (rule_tac box_equals)
     defer
     apply (rule bl_bin_bl)
    apply (rule bl_bin_bl)
   apply simp
   done
 
 lemma bl_to_bin_False [simp]: "bl_to_bin (False # bl) = bl_to_bin bl"
   by (auto simp: bl_to_bin_def)
 
 lemma bl_to_bin_Nil [simp]: "bl_to_bin [] = 0"
   by (auto simp: bl_to_bin_def)
 
 lemma bin_to_bl_zero_aux: "bin_to_bl_aux n 0 bl = replicate n False @ bl"
   by (induct n arbitrary: bl) (auto simp: replicate_app_Cons_same)
 
 lemma bin_to_bl_zero: "bin_to_bl n 0 = replicate n False"
   by (simp add: bin_to_bl_def bin_to_bl_zero_aux)
 
 lemma bin_to_bl_minus1_aux: "bin_to_bl_aux n (- 1) bl = replicate n True @ bl"
   by (induct n arbitrary: bl) (auto simp: replicate_app_Cons_same)
 
 lemma bin_to_bl_minus1: "bin_to_bl n (- 1) = replicate n True"
   by (simp add: bin_to_bl_def bin_to_bl_minus1_aux)
 
 
 subsection \<open>Semantic interpretation of \<^typ>\<open>bool list\<close> as \<^typ>\<open>int\<close>\<close>
 
 lemma bin_bl_bin': "bl_to_bin (bin_to_bl_aux n w bs) = bl_to_bin_aux bs (take_bit n w)"
   by (induct n arbitrary: w bs) (auto simp: bl_to_bin_def take_bit_Suc ac_simps mod_2_eq_odd)
 
 lemma bin_bl_bin [simp]: "bl_to_bin (bin_to_bl n w) = take_bit n w"
   by (auto simp: bin_to_bl_def bin_bl_bin')
 
 lemma bl_to_bin_rep_F: "bl_to_bin (replicate n False @ bl) = bl_to_bin bl"
   by (simp add: bin_to_bl_zero_aux [symmetric] bin_bl_bin') (simp add: bl_to_bin_def)
 
 lemma bin_to_bl_trunc [simp]: "n \<le> m \<Longrightarrow> bin_to_bl n (take_bit m w) = bin_to_bl n w"
   by (auto intro: bl_to_bin_inj)
 
 lemma bin_to_bl_aux_bintr:
   "bin_to_bl_aux n (take_bit m bin) bl =
     replicate (n - m) False @ bin_to_bl_aux (min n m) bin bl"
   apply (induct n arbitrary: m bin bl)
    apply clarsimp
   apply clarsimp
   apply (case_tac "m")
    apply (clarsimp simp: bin_to_bl_zero_aux)
    apply (erule thin_rl)
    apply (induct_tac n)
     apply (auto simp add: take_bit_Suc)
   done
 
 lemma bin_to_bl_bintr:
   "bin_to_bl n (take_bit m bin) = replicate (n - m) False @ bin_to_bl (min n m) bin"
   unfolding bin_to_bl_def by (rule bin_to_bl_aux_bintr)
 
 lemma bl_to_bin_rep_False: "bl_to_bin (replicate n False) = 0"
   by (induct n) auto
 
 lemma len_bin_to_bl_aux: "length (bin_to_bl_aux n w bs) = n + length bs"
   by (fact size_bin_to_bl_aux)
 
 lemma len_bin_to_bl: "length (bin_to_bl n w) = n"
   by (fact size_bin_to_bl) (* FIXME: duplicate *)
 
 lemma sign_bl_bin': "bin_sign (bl_to_bin_aux bs w) = bin_sign w"
   by (induction bs arbitrary: w) (simp_all add: bin_sign_def)
 
 lemma sign_bl_bin: "bin_sign (bl_to_bin bs) = 0"
   by (simp add: bl_to_bin_def sign_bl_bin')
 
 lemma bl_sbin_sign_aux: "hd (bin_to_bl_aux (Suc n) w bs) = (bin_sign (signed_take_bit n w) = -1)"
   by (induction n arbitrary: w bs) (auto simp add: bin_sign_def even_iff_mod_2_eq_zero bit_Suc)
 
 lemma bl_sbin_sign: "hd (bin_to_bl (Suc n) w) = (bin_sign (signed_take_bit n w) = -1)"
   unfolding bin_to_bl_def by (rule bl_sbin_sign_aux)
 
 lemma bin_nth_of_bl_aux:
   "bit (bl_to_bin_aux bl w) n =
     (n < size bl \<and> rev bl ! n \<or> n \<ge> length bl \<and> bit w (n - size bl))"
   apply (induction bl arbitrary: w)
    apply simp_all
   apply safe
                       apply (simp_all add: not_le nth_append bit_double_iff even_bit_succ_iff split: if_splits)
   done
 
 lemma bin_nth_of_bl: "bit (bl_to_bin bl) n = (n < length bl \<and> rev bl ! n)"
   by (simp add: bl_to_bin_def bin_nth_of_bl_aux)
 
 lemma bin_nth_bl: "n < m \<Longrightarrow> bit w n = nth (rev (bin_to_bl m w)) n"
-  apply (induct n arbitrary: m w)
-   apply clarsimp
-   apply (case_tac m, clarsimp)
-   apply (clarsimp simp: bin_to_bl_def)
-   apply (simp add: bin_to_bl_aux_alt)
-  apply (case_tac m, clarsimp)
-  apply (clarsimp simp: bin_to_bl_def)
-  apply (simp add: bin_to_bl_aux_alt bit_Suc)
-  done
+  by (metis bin_bl_bin bin_nth_of_bl nth_bintr size_bin_to_bl)
 
 lemma nth_bin_to_bl_aux:
   "n < m + length bl \<Longrightarrow> (bin_to_bl_aux m w bl) ! n =
     (if n < m then bit w (m - 1 - n) else bl ! (n - m))"
   apply (induction bl arbitrary: w)
    apply simp_all
    apply (simp add: bin_nth_bl [of \<open>m - Suc n\<close> m] rev_nth flip: bin_to_bl_def)
    apply (metis One_nat_def Suc_pred add_diff_cancel_left'
      add_diff_cancel_right' bin_to_bl_aux_alt bin_to_bl_def
      diff_Suc_Suc diff_is_0_eq diff_zero less_Suc_eq_0_disj
      less_antisym less_imp_Suc_add list.size(3) nat_less_le nth_append size_bin_to_bl_aux)
   done
 
 lemma nth_bin_to_bl: "n < m \<Longrightarrow> (bin_to_bl m w) ! n = bit w (m - Suc n)"
   by (simp add: bin_to_bl_def nth_bin_to_bl_aux)
 
 lemma takefill_bintrunc: "takefill False n bl = rev (bin_to_bl n (bl_to_bin (rev bl)))"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp: nth_takefill rev_nth nth_bin_to_bl bin_nth_of_bl)
   done
 
 lemma bl_bin_bl_rtf: "bin_to_bl n (bl_to_bin bl) = rev (takefill False n (rev bl))"
   by (simp add: takefill_bintrunc)
 
 lemma bl_to_bin_lt2p_aux: "bl_to_bin_aux bs w < (w + 1) * (2 ^ length bs)"
 proof (induction bs arbitrary: w)
   case Nil
   then show ?case
     by simp
 next
   case (Cons b bs)
   from Cons.IH [of \<open>1 + 2 * w\<close>] Cons.IH [of \<open>2 * w\<close>]
   show ?case
     apply (auto simp add: algebra_simps)
     apply (subst mult_2 [of \<open>2 ^ length bs\<close>])
     apply (simp only: add.assoc)
     apply (rule pos_add_strict)
      apply simp_all
     done
 qed
 
 lemma bl_to_bin_lt2p_drop: "bl_to_bin bs < 2 ^ length (dropWhile Not bs)"
 proof (induct bs)
   case Nil
   then show ?case by simp
 next
   case (Cons b bs)
   with bl_to_bin_lt2p_aux[where w=1] show ?case
     by (simp add: bl_to_bin_def)
 qed
 
 lemma bl_to_bin_lt2p: "bl_to_bin bs < 2 ^ length bs"
   by (metis bin_bl_bin bintr_lt2p bl_bin_bl)
 
 lemma bl_to_bin_ge2p_aux: "bl_to_bin_aux bs w \<ge> w * (2 ^ length bs)"
 proof (induction bs arbitrary: w)
   case Nil
   then show ?case
     by simp
 next
   case (Cons b bs)
   from Cons.IH [of \<open>1 + 2 * w\<close>] Cons.IH [of \<open>2 * w\<close>]
   show ?case
     apply (auto simp add: algebra_simps)
     apply (rule add_le_imp_le_left [of \<open>2 ^ length bs\<close>])
     apply (rule add_increasing)
     apply simp_all
     done
 qed
 
 lemma bl_to_bin_ge0: "bl_to_bin bs \<ge> 0"
   apply (unfold bl_to_bin_def)
   apply (rule xtrans(4))
    apply (rule bl_to_bin_ge2p_aux)
   apply simp
   done
 
 lemma butlast_rest_bin: "butlast (bin_to_bl n w) = bin_to_bl (n - 1) (w div 2)"
   apply (unfold bin_to_bl_def)
   apply (cases n, clarsimp)
   apply clarsimp
   apply (auto simp add: bin_to_bl_aux_alt)
   done
 
 lemma butlast_bin_rest: "butlast bl = bin_to_bl (length bl - Suc 0) (bl_to_bin bl div 2)"
   using butlast_rest_bin [where w="bl_to_bin bl" and n="length bl"] by simp
 
 lemma butlast_rest_bl2bin_aux:
   "bl \<noteq> [] \<Longrightarrow> bl_to_bin_aux (butlast bl) w = bl_to_bin_aux bl w div 2"
   by (induct bl arbitrary: w) auto
 
 lemma butlast_rest_bl2bin: "bl_to_bin (butlast bl) = bl_to_bin bl div 2"
   by (cases bl) (auto simp: bl_to_bin_def butlast_rest_bl2bin_aux)
 
 lemma trunc_bl2bin_aux:
   "take_bit m (bl_to_bin_aux bl w) =
     bl_to_bin_aux (drop (length bl - m) bl) (take_bit (m - length bl) w)"
 proof (induct bl arbitrary: w)
   case Nil
   show ?case by simp
 next
   case (Cons b bl)
   show ?case
   proof (cases "m - length bl")
     case 0
     then have "Suc (length bl) - m = Suc (length bl - m)" by simp
     with Cons show ?thesis by simp
   next
     case (Suc n)
     then have "m - Suc (length bl) = n" by simp
     with Cons Suc show ?thesis by (simp add: take_bit_Suc ac_simps)
   qed
 qed
 
 lemma trunc_bl2bin: "take_bit m (bl_to_bin bl) = bl_to_bin (drop (length bl - m) bl)"
   by (simp add: bl_to_bin_def trunc_bl2bin_aux)
 
 lemma trunc_bl2bin_len [simp]: "take_bit (length bl) (bl_to_bin bl) = bl_to_bin bl"
   by (simp add: trunc_bl2bin)
 
 lemma bl2bin_drop: "bl_to_bin (drop k bl) = take_bit (length bl - k) (bl_to_bin bl)"
   apply (rule trans)
    prefer 2
    apply (rule trunc_bl2bin [symmetric])
   apply (cases "k \<le> length bl")
    apply auto
   done
 
 lemma take_rest_power_bin: "m \<le> n \<Longrightarrow> take m (bin_to_bl n w) = bin_to_bl m (((\<lambda>w. w div 2) ^^ (n - m)) w)"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp add: nth_bin_to_bl nth_rest_power_bin)
   done
 
 lemma last_bin_last': "size xs > 0 \<Longrightarrow> last xs \<longleftrightarrow> odd (bl_to_bin_aux xs w)"
   by (induct xs arbitrary: w) auto
 
 lemma last_bin_last: "size xs > 0 \<Longrightarrow> last xs \<longleftrightarrow> odd (bl_to_bin xs)"
   unfolding bl_to_bin_def by (erule last_bin_last')
 
 lemma bin_last_last: "odd w \<longleftrightarrow> last (bin_to_bl (Suc n) w)"
   by (simp add: bin_to_bl_def) (auto simp: bin_to_bl_aux_alt)
 
 lemma drop_bin2bl_aux:
   "drop m (bin_to_bl_aux n bin bs) =
     bin_to_bl_aux (n - m) bin (drop (m - n) bs)"
   apply (induction n arbitrary: m bin bs)
    apply auto
   apply (case_tac "m \<le> n")
    apply (auto simp add: not_le Suc_diff_le)
   apply (case_tac "m - n")
    apply auto
   apply (use Suc_diff_Suc in fastforce)
   done
 
 lemma drop_bin2bl: "drop m (bin_to_bl n bin) = bin_to_bl (n - m) bin"
   by (simp add: bin_to_bl_def drop_bin2bl_aux)
 
 lemma take_bin2bl_lem1: "take m (bin_to_bl_aux m w bs) = bin_to_bl m w"
   apply (induct m arbitrary: w bs)
    apply clarsimp
   apply clarsimp
   apply (simp add: bin_to_bl_aux_alt)
   apply (simp add: bin_to_bl_def)
   apply (simp add: bin_to_bl_aux_alt)
   done
 
 lemma take_bin2bl_lem: "take m (bin_to_bl_aux (m + n) w bs) = take m (bin_to_bl (m + n) w)"
   by (induct n arbitrary: w bs) (simp_all (no_asm) add: bin_to_bl_def take_bin2bl_lem1, simp)
 
 lemma bin_split_take: "bin_split n c = (a, b) \<Longrightarrow> bin_to_bl m a = take m (bin_to_bl (m + n) c)"
   apply (induct n arbitrary: b c)
    apply clarsimp
   apply (clarsimp simp: Let_def split: prod.split_asm)
   apply (simp add: bin_to_bl_def)
   apply (simp add: take_bin2bl_lem drop_bit_Suc)
   done
 
 lemma bin_to_bl_drop_bit:
   "k = m + n \<Longrightarrow> bin_to_bl m (drop_bit n c) = take m (bin_to_bl k c)"
   using bin_split_take by simp
 
 lemma bin_split_take1:
   "k = m + n \<Longrightarrow> bin_split n c = (a, b) \<Longrightarrow> bin_to_bl m a = take m (bin_to_bl k c)"
   using bin_split_take by simp
 
 lemma bl_bin_bl_rep_drop:
   "bin_to_bl n (bl_to_bin bl) =
     replicate (n - length bl) False @ drop (length bl - n) bl"
   by (simp add: bl_to_bin_inj bl_to_bin_rep_F trunc_bl2bin)
 
 lemma bl_to_bin_aux_cat:
   "bl_to_bin_aux bs (concat_bit nv v w) =
     concat_bit (nv + length bs) (bl_to_bin_aux bs v) w"
   by (rule bit_eqI)
     (auto simp add: bin_nth_of_bl_aux bin_nth_cat algebra_simps)
 
 lemma bin_to_bl_aux_cat:
   "bin_to_bl_aux (nv + nw) (concat_bit nw w v) bs =
     bin_to_bl_aux nv v (bin_to_bl_aux nw w bs)"
   by (induction nw arbitrary: w bs) (simp_all add: concat_bit_Suc)
 
 lemma bl_to_bin_aux_alt: "bl_to_bin_aux bs w = concat_bit (length bs) (bl_to_bin bs) w"
   using bl_to_bin_aux_cat [where nv = "0" and v = "0"]
   by (simp add: bl_to_bin_def [symmetric])
 
 lemma bin_to_bl_cat:
   "bin_to_bl (nv + nw) (concat_bit nw w v) =
     bin_to_bl_aux nv v (bin_to_bl nw w)"
   by (simp add: bin_to_bl_def bin_to_bl_aux_cat)
 
 lemmas bl_to_bin_aux_app_cat =
   trans [OF bl_to_bin_aux_append bl_to_bin_aux_alt]
 
 lemmas bin_to_bl_aux_cat_app =
   trans [OF bin_to_bl_aux_cat bin_to_bl_aux_alt]
 
 lemma bl_to_bin_app_cat:
   "bl_to_bin (bsa @ bs) = concat_bit (length bs) (bl_to_bin bs) (bl_to_bin bsa)"
   by (simp only: bl_to_bin_aux_app_cat bl_to_bin_def)
 
 lemma bin_to_bl_cat_app:
   "bin_to_bl (n + nw) (concat_bit nw wa w) = bin_to_bl n w @ bin_to_bl nw wa"
   by (simp only: bin_to_bl_def bin_to_bl_aux_cat_app)
 
 text \<open>\<open>bl_to_bin_app_cat_alt\<close> and \<open>bl_to_bin_app_cat\<close> are easily interderivable.\<close>
 lemma bl_to_bin_app_cat_alt: "concat_bit n w (bl_to_bin cs) = bl_to_bin (cs @ bin_to_bl n w)"
   by (simp add: bl_to_bin_app_cat)
 
 lemma mask_lem: "(bl_to_bin (True # replicate n False)) = bl_to_bin (replicate n True) + 1"
   apply (unfold bl_to_bin_def)
   apply (induct n)
    apply simp
   apply (simp only: Suc_eq_plus1 replicate_add append_Cons [symmetric] bl_to_bin_aux_append)
   apply simp
   done
 
 lemma bin_exhaust:
   "(\<And>x b. bin = of_bool b + 2 * x \<Longrightarrow> Q) \<Longrightarrow> Q" for bin :: int
   apply (cases \<open>even bin\<close>)
    apply (auto elim!: evenE oddE)
    apply fastforce
   apply fastforce
   done
 
 primrec rbl_succ :: "bool list \<Rightarrow> bool list"
   where
     Nil: "rbl_succ Nil = Nil"
   | Cons: "rbl_succ (x # xs) = (if x then False # rbl_succ xs else True # xs)"
 
 primrec rbl_pred :: "bool list \<Rightarrow> bool list"
   where
     Nil: "rbl_pred Nil = Nil"
   | Cons: "rbl_pred (x # xs) = (if x then False # xs else True # rbl_pred xs)"
 
 primrec rbl_add :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where \<comment> \<open>result is length of first arg, second arg may be longer\<close>
     Nil: "rbl_add Nil x = Nil"
   | Cons: "rbl_add (y # ys) x =
       (let ws = rbl_add ys (tl x)
        in (y \<noteq> hd x) # (if hd x \<and> y then rbl_succ ws else ws))"
 
 primrec rbl_mult :: "bool list \<Rightarrow> bool list \<Rightarrow> bool list"
   where \<comment> \<open>result is length of first arg, second arg may be longer\<close>
     Nil: "rbl_mult Nil x = Nil"
   | Cons: "rbl_mult (y # ys) x =
       (let ws = False # rbl_mult ys x
        in if y then rbl_add ws x else ws)"
 
 lemma size_rbl_pred: "length (rbl_pred bl) = length bl"
   by (induct bl) auto
 
 lemma size_rbl_succ: "length (rbl_succ bl) = length bl"
   by (induct bl) auto
 
 lemma size_rbl_add: "length (rbl_add bl cl) = length bl"
   by (induct bl arbitrary: cl) (auto simp: Let_def size_rbl_succ)
 
 lemma size_rbl_mult: "length (rbl_mult bl cl) = length bl"
   by (induct bl arbitrary: cl) (auto simp add: Let_def size_rbl_add)
 
 lemmas rbl_sizes [simp] =
   size_rbl_pred size_rbl_succ size_rbl_add size_rbl_mult
 
 lemmas rbl_Nils =
   rbl_pred.Nil rbl_succ.Nil rbl_add.Nil rbl_mult.Nil
 
 lemma rbl_add_app2: "length blb \<ge> length bla \<Longrightarrow> rbl_add bla (blb @ blc) = rbl_add bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def)
   done
 
 lemma rbl_add_take2:
   "length blb \<ge> length bla \<Longrightarrow> rbl_add bla (take (length bla) blb) = rbl_add bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def)
   done
 
 lemma rbl_mult_app2: "length blb \<ge> length bla \<Longrightarrow> rbl_mult bla (blb @ blc) = rbl_mult bla blb"
   apply (induct bla arbitrary: blb)
    apply simp
   apply clarsimp
   apply (case_tac blb, clarsimp)
   apply (clarsimp simp: Let_def rbl_add_app2)
   done
 
 lemma rbl_mult_take2:
   "length blb \<ge> length bla \<Longrightarrow> rbl_mult bla (take (length bla) blb) = rbl_mult bla blb"
   apply (rule trans)
    apply (rule rbl_mult_app2 [symmetric])
    apply simp
   apply (rule_tac f = "rbl_mult bla" in arg_cong)
   apply (rule append_take_drop_id)
   done
 
 lemma rbl_add_split:
   "P (rbl_add (y # ys) (x # xs)) =
     (\<forall>ws. length ws = length ys \<longrightarrow> ws = rbl_add ys xs \<longrightarrow>
       (y \<longrightarrow> ((x \<longrightarrow> P (False # rbl_succ ws)) \<and> (\<not> x \<longrightarrow> P (True # ws)))) \<and>
       (\<not> y \<longrightarrow> P (x # ws)))"
   by (cases y) (auto simp: Let_def)
 
 lemma rbl_mult_split:
   "P (rbl_mult (y # ys) xs) =
     (\<forall>ws. length ws = Suc (length ys) \<longrightarrow> ws = False # rbl_mult ys xs \<longrightarrow>
       (y \<longrightarrow> P (rbl_add ws xs)) \<and> (\<not> y \<longrightarrow> P ws))"
   by (auto simp: Let_def)
 
 lemma rbl_pred: "rbl_pred (rev (bin_to_bl n bin)) = rev (bin_to_bl n (bin - 1))"
 proof (unfold bin_to_bl_def, induction n arbitrary: bin)
   case 0
   then show ?case
     by simp
 next
   case (Suc n)
   obtain b k where \<open>bin = of_bool b + 2 * k\<close>
     using bin_exhaust by blast
   moreover have \<open>(2 * k - 1) div 2 = k - 1\<close>
     using even_succ_div_2 [of \<open>2 * (k - 1)\<close>]
     by simp
   ultimately show ?case
     using Suc [of \<open>bin div 2\<close>]
     by simp (auto simp add: bin_to_bl_aux_alt)
 qed
 
 lemma rbl_succ: "rbl_succ (rev (bin_to_bl n bin)) = rev (bin_to_bl n (bin + 1))"
   apply (unfold bin_to_bl_def)
   apply (induction n arbitrary: bin)
    apply simp_all
   apply (case_tac bin rule: bin_exhaust)
    apply (simp_all add: bin_to_bl_aux_alt ac_simps)
   done
 
 lemma rbl_add:
   "\<And>bina binb. rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
     rev (bin_to_bl n (bina + binb))"
   apply (unfold bin_to_bl_def)
   apply (induct n)
    apply simp
   apply clarsimp
   apply (case_tac bina rule: bin_exhaust)
   apply (case_tac binb rule: bin_exhaust)
   apply (case_tac b)
    apply (case_tac [!] "ba")
      apply (auto simp: rbl_succ bin_to_bl_aux_alt Let_def ac_simps)
   done
 
 lemma rbl_add_long:
   "m \<ge> n \<Longrightarrow> rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
     rev (bin_to_bl n (bina + binb))"
   apply (rule box_equals [OF _ rbl_add_take2 rbl_add])
    apply (rule_tac f = "rbl_add (rev (bin_to_bl n bina))" in arg_cong)
    apply (rule rev_swap [THEN iffD1])
    apply (simp add: rev_take drop_bin2bl)
   apply simp
   done
 
 lemma rbl_mult_gt1:
   "m \<ge> length bl \<Longrightarrow>
     rbl_mult bl (rev (bin_to_bl m binb)) =
     rbl_mult bl (rev (bin_to_bl (length bl) binb))"
   apply (rule trans)
    apply (rule rbl_mult_take2 [symmetric])
    apply simp_all
   apply (rule_tac f = "rbl_mult bl" in arg_cong)
   apply (rule rev_swap [THEN iffD1])
   apply (simp add: rev_take drop_bin2bl)
   done
 
 lemma rbl_mult_gt:
   "m > n \<Longrightarrow>
     rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
     rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb))"
   by (auto intro: trans [OF rbl_mult_gt1])
 
 lemmas rbl_mult_Suc = lessI [THEN rbl_mult_gt]
 
 lemma rbbl_Cons: "b # rev (bin_to_bl n x) = rev (bin_to_bl (Suc n) (of_bool b + 2 * x))"
   by (simp add: bin_to_bl_def) (simp add: bin_to_bl_aux_alt)
 
 lemma rbl_mult:
   "rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
     rev (bin_to_bl n (bina * binb))"
   apply (induct n arbitrary: bina binb)
    apply simp_all
   apply (unfold bin_to_bl_def)
   apply clarsimp
   apply (case_tac bina rule: bin_exhaust)
   apply (case_tac binb rule: bin_exhaust)
   apply (simp_all add: bin_to_bl_aux_alt)
   apply (simp_all add: rbbl_Cons rbl_mult_Suc rbl_add algebra_simps)
   done
 
 lemma sclem: "size (concat (map (bin_to_bl n) xs)) = length xs * n"
   by (simp add: length_concat comp_def sum_list_triv)
 
 lemma bin_cat_foldl_lem:
   "foldl (\<lambda>u k. concat_bit n k u) x xs =
     concat_bit (size xs * n) (foldl (\<lambda>u k. concat_bit n k u) y xs) x"
   apply (induct xs arbitrary: x)
    apply simp
   apply (simp (no_asm))
   apply (frule asm_rl)
   apply (drule meta_spec)
   apply (erule trans)
   apply (drule_tac x = "concat_bit n a y" in meta_spec)
   apply (simp add: bin_cat_assoc_sym)
   done
 
 lemma bin_rcat_bl: "bin_rcat n wl = bl_to_bin (concat (map (bin_to_bl n) wl))"
   apply (unfold bin_rcat_eq_foldl)
   apply (rule sym)
   apply (induct wl)
    apply (auto simp add: bl_to_bin_append)
   apply (simp add: bl_to_bin_aux_alt sclem)
   apply (simp add: bin_cat_foldl_lem [symmetric])
   done
 
 lemma bin_last_bl_to_bin: "odd (bl_to_bin bs) \<longleftrightarrow> bs \<noteq> [] \<and> last bs"
 by(cases "bs = []")(auto simp add: bl_to_bin_def last_bin_last'[where w=0])
 
 lemma bin_rest_bl_to_bin: "bl_to_bin bs div 2 = bl_to_bin (butlast bs)"
 by(cases "bs = []")(simp_all add: bl_to_bin_def butlast_rest_bl2bin_aux)
 
 lemma bl_xor_aux_bin:
   "map2 (\<lambda>x y. x \<noteq> y) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v XOR w) (map2 (\<lambda>x y. x \<noteq> y) bs cs)"
   apply (induction n arbitrary: v w bs cs)
    apply auto
   apply (case_tac v rule: bin_exhaust)
   apply (case_tac w rule: bin_exhaust)
   apply clarsimp
   done
 
 lemma bl_or_aux_bin:
   "map2 (\<or>) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v OR w) (map2 (\<or>) bs cs)"
   by (induct n arbitrary: v w bs cs) simp_all
 
 lemma bl_and_aux_bin:
   "map2 (\<and>) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
     bin_to_bl_aux n (v AND w) (map2 (\<and>) bs cs)"
   by (induction n arbitrary: v w bs cs) simp_all
 
 lemma bl_not_aux_bin: "map Not (bin_to_bl_aux n w cs) = bin_to_bl_aux n (NOT w) (map Not cs)"
   by (induct n arbitrary: w cs) auto
 
 lemma bl_not_bin: "map Not (bin_to_bl n w) = bin_to_bl n (NOT w)"
   by (simp add: bin_to_bl_def bl_not_aux_bin)
 
 lemma bl_and_bin: "map2 (\<and>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v AND w)"
   by (simp add: bin_to_bl_def bl_and_aux_bin)
 
 lemma bl_or_bin: "map2 (\<or>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v OR w)"
   by (simp add: bin_to_bl_def bl_or_aux_bin)
 
 lemma bl_xor_bin: "map2 (\<noteq>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v XOR w)"
   using bl_xor_aux_bin by (simp add: bin_to_bl_def)
 
 
 subsection \<open>Type \<^typ>\<open>'a word\<close>\<close>
 
 lift_definition of_bl :: \<open>bool list \<Rightarrow> 'a::len word\<close>
   is bl_to_bin .
 
 lift_definition to_bl :: \<open>'a::len word \<Rightarrow> bool list\<close>
   is \<open>bin_to_bl LENGTH('a)\<close>
   by (simp add: bl_to_bin_inj)
 
 lemma to_bl_eq:
   \<open>to_bl w = bin_to_bl (LENGTH('a)) (uint w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma bit_of_bl_iff [bit_simps]:
   \<open>bit (of_bl bs :: 'a word) n \<longleftrightarrow> rev bs ! n \<and> n < LENGTH('a::len) \<and> n < length bs\<close>
   by transfer (simp add: bin_nth_of_bl ac_simps)
 
 lemma rev_to_bl_eq:
   \<open>rev (to_bl w) = map (bit w) [0..<LENGTH('a)]\<close>
   for w :: \<open>'a::len word\<close>
   apply (rule nth_equalityI)
    apply (simp add: to_bl.rep_eq)
   apply (simp add: bin_nth_bl bit_word.rep_eq to_bl.rep_eq)
   done
 
 lemma to_bl_eq_rev:
   \<open>to_bl w = map (bit w) (rev [0..<LENGTH('a)])\<close>
   for w :: \<open>'a::len word\<close>
   using rev_to_bl_eq [of w]
   apply (subst rev_is_rev_conv [symmetric])
   apply (simp add: rev_map)
   done
 
 lemma of_bl_rev_eq:
   \<open>of_bl (rev bs) = horner_sum of_bool 2 bs\<close>
   apply (rule bit_word_eqI)
   apply (simp add: bit_of_bl_iff)
   apply transfer
   apply (simp add: bit_horner_sum_bit_iff ac_simps)
   done
 
 lemma of_bl_eq:
   \<open>of_bl bs = horner_sum of_bool 2 (rev bs)\<close>
   using of_bl_rev_eq [of \<open>rev bs\<close>] by simp
 
 lemma bshiftr1_eq:
   \<open>bshiftr1 b w = of_bl (b # butlast (to_bl w))\<close>
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps to_bl_eq_rev nth_append rev_nth nth_butlast not_less simp flip: bit_Suc)
   apply (metis Suc_pred len_gt_0 less_eq_decr_length_iff not_bit_length verit_la_disequality)
   done
 
 lemma length_to_bl_eq:
   \<open>length (to_bl w) = LENGTH('a)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma word_rotr_eq:
   \<open>word_rotr n w = of_bl (rotater n (to_bl w))\<close>
   apply (rule bit_word_eqI)
   subgoal for n
     apply (cases \<open>n < LENGTH('a)\<close>)
      apply (simp_all add: bit_word_rotr_iff bit_of_bl_iff rotater_rev length_to_bl_eq nth_rotate rev_to_bl_eq ac_simps)
     done
   done
 
 lemma word_rotl_eq:
   \<open>word_rotl n w = of_bl (rotate n (to_bl w))\<close>
 proof -
   have \<open>rotate n (to_bl w) = rev (rotater n (rev (to_bl w)))\<close>
     by (simp add: rotater_rev')
   then show ?thesis
     apply (simp add: word_rotl_eq_word_rotr bit_of_bl_iff length_to_bl_eq rev_to_bl_eq)
     apply (rule bit_word_eqI)
     subgoal for n
       apply (cases \<open>n < LENGTH('a)\<close>)
        apply (simp_all add: bit_word_rotr_iff bit_of_bl_iff nth_rotater)
       done
     done
 qed
 
 lemma to_bl_def': "(to_bl :: 'a::len word \<Rightarrow> bool list) = bin_to_bl (LENGTH('a)) \<circ> uint"
   by transfer (simp add: fun_eq_iff)
 
 \<comment> \<open>type definitions theorem for in terms of equivalent bool list\<close>
 lemma td_bl:
   "type_definition
     (to_bl :: 'a::len word \<Rightarrow> bool list)
     of_bl
     {bl. length bl = LENGTH('a)}"
   apply (standard; transfer)
   apply (auto dest: sym)
   done
 
 global_interpretation word_bl:
   type_definition
     "to_bl :: 'a::len word \<Rightarrow> bool list"
     of_bl
     "{bl. length bl = LENGTH('a::len)}"
   by (fact td_bl)
 
 lemmas word_bl_Rep' = word_bl.Rep [unfolded mem_Collect_eq, iff]
 
 lemma word_size_bl: "size w = size (to_bl w)"
   by (auto simp: word_size)
 
 lemma to_bl_use_of_bl: "to_bl w = bl \<longleftrightarrow> w = of_bl bl \<and> length bl = length (to_bl w)"
   by (fastforce elim!: word_bl.Abs_inverse [unfolded mem_Collect_eq])
 
 lemma length_bl_gt_0 [iff]: "0 < length (to_bl x)"
   for x :: "'a::len word"
   unfolding word_bl_Rep' by (rule len_gt_0)
 
 lemma bl_not_Nil [iff]: "to_bl x \<noteq> []"
   for x :: "'a::len word"
   by (fact length_bl_gt_0 [unfolded length_greater_0_conv])
 
 lemma length_bl_neq_0 [iff]: "length (to_bl x) \<noteq> 0"
   for x :: "'a::len word"
   by (fact length_bl_gt_0 [THEN gr_implies_not0])
 
 lemma hd_to_bl_iff:
   \<open>hd (to_bl w) \<longleftrightarrow> bit w (LENGTH('a) - 1)\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: to_bl_eq_rev hd_map hd_rev)
 
 lemma hd_bl_sign_sint: "hd (to_bl w) = (bin_sign (sint w) = -1)"
   by (simp add: hd_to_bl_iff bit_last_iff bin_sign_def)
 
 lemma of_bl_drop':
   "lend = length bl - LENGTH('a::len) \<Longrightarrow>
     of_bl (drop lend bl) = (of_bl bl :: 'a word)"
   by transfer (simp flip: trunc_bl2bin)
 
 lemma test_bit_of_bl:
   "bit (of_bl bl::'a::len word) n = (rev bl ! n \<and> n < LENGTH('a) \<and> n < length bl)"
   by transfer (simp add: bin_nth_of_bl ac_simps)
 
 lemma no_of_bl: "(numeral bin ::'a::len word) = of_bl (bin_to_bl (LENGTH('a)) (numeral bin))"
   by transfer simp
 
 lemma uint_bl: "to_bl w = bin_to_bl (size w) (uint w)"
   by transfer simp
 
 lemma to_bl_bin: "bl_to_bin (to_bl w) = uint w"
   by (simp add: uint_bl word_size)
 
 lemma to_bl_of_bin: "to_bl (word_of_int bin::'a::len word) = bin_to_bl (LENGTH('a)) bin"
   by (auto simp: uint_bl word_ubin.eq_norm word_size)
 
 lemma to_bl_numeral [simp]:
   "to_bl (numeral bin::'a::len word) =
     bin_to_bl (LENGTH('a)) (numeral bin)"
   unfolding word_numeral_alt by (rule to_bl_of_bin)
 
 lemma to_bl_neg_numeral [simp]:
   "to_bl (- numeral bin::'a::len word) =
     bin_to_bl (LENGTH('a)) (- numeral bin)"
   unfolding word_neg_numeral_alt by (rule to_bl_of_bin)
 
 lemma to_bl_to_bin [simp] : "bl_to_bin (to_bl w) = uint w"
   by (simp add: uint_bl word_size)
 
 lemma uint_bl_bin: "bl_to_bin (bin_to_bl (LENGTH('a)) (uint x)) = uint x"
   for x :: "'a::len word"
   by (rule trans [OF bin_bl_bin word_ubin.norm_Rep])
 
 lemma ucast_bl: "ucast w = of_bl (to_bl w)"
   by transfer simp
 
 lemma ucast_down_bl:
   \<open>(ucast :: 'a::len word \<Rightarrow> 'b::len word) (of_bl bl) = of_bl bl\<close>
     if \<open>is_down (ucast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
   using that by transfer simp
 
 lemma of_bl_append_same: "of_bl (X @ to_bl w) = w"
   by transfer (simp add: bl_to_bin_app_cat)
 
 lemma ucast_of_bl_up:
   \<open>ucast (of_bl bl :: 'a::len word) = of_bl bl\<close>
   if \<open>size bl \<le> size (of_bl bl :: 'a::len word)\<close>
   using that
   apply transfer
   apply (rule bit_eqI)
   apply (auto simp add: bit_take_bit_iff)
   apply (subst (asm) trunc_bl2bin_len [symmetric])
   apply (auto simp only: bit_take_bit_iff)
   done
 
 lemma word_rev_tf:
   "to_bl (of_bl bl::'a::len word) =
     rev (takefill False (LENGTH('a)) (rev bl))"
   by transfer (simp add: bl_bin_bl_rtf)
 
 lemma word_rep_drop:
   "to_bl (of_bl bl::'a::len word) =
     replicate (LENGTH('a) - length bl) False @
     drop (length bl - LENGTH('a)) bl"
   by (simp add: word_rev_tf takefill_alt rev_take)
 
 lemma to_bl_ucast:
   "to_bl (ucast (w::'b::len word) ::'a::len word) =
     replicate (LENGTH('a) - LENGTH('b)) False @
     drop (LENGTH('b) - LENGTH('a)) (to_bl w)"
   apply (unfold ucast_bl)
   apply (rule trans)
    apply (rule word_rep_drop)
   apply simp
   done
 
 lemma ucast_up_app:
   \<open>to_bl (ucast w :: 'b::len word) = replicate n False @ (to_bl w)\<close>
     if \<open>source_size (ucast :: 'a word \<Rightarrow> 'b word) + n = target_size (ucast :: 'a word \<Rightarrow> 'b word)\<close>
     for w :: \<open>'a::len word\<close>
   using that
   by (auto simp add : source_size target_size to_bl_ucast)
 
 lemma ucast_down_drop [OF refl]:
   "uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow>
     to_bl (uc w) = drop n (to_bl w)"
   by (auto simp add : source_size target_size to_bl_ucast)
 
 lemma scast_down_drop [OF refl]:
   "sc = scast \<Longrightarrow> source_size sc = target_size sc + n \<Longrightarrow>
     to_bl (sc w) = drop n (to_bl w)"
   apply (subgoal_tac "sc = ucast")
    apply safe
    apply simp
    apply (erule ucast_down_drop)
   apply (rule down_cast_same [symmetric])
   apply (simp add : source_size target_size is_down)
   done
 
 lemma word_0_bl [simp]: "of_bl [] = 0"
   by transfer simp
 
 lemma word_1_bl: "of_bl [True] = 1"
   by transfer (simp add: bl_to_bin_def)
 
 lemma of_bl_0 [simp]: "of_bl (replicate n False) = 0"
   by transfer (simp add: bl_to_bin_rep_False)
 
 lemma to_bl_0 [simp]: "to_bl (0::'a::len word) = replicate (LENGTH('a)) False"
   by (simp add: uint_bl word_size bin_to_bl_zero)
 
 \<comment> \<open>links with \<open>rbl\<close> operations\<close>
 lemma word_succ_rbl: "to_bl w = bl \<Longrightarrow> to_bl (word_succ w) = rev (rbl_succ (rev bl))"
   by transfer (simp add: rbl_succ)
 
 lemma word_pred_rbl: "to_bl w = bl \<Longrightarrow> to_bl (word_pred w) = rev (rbl_pred (rev bl))"
   by transfer (simp add: rbl_pred)
 
 lemma word_add_rbl:
   "to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow>
     to_bl (v + w) = rev (rbl_add (rev vbl) (rev wbl))"
   apply transfer
   apply (drule sym)
   apply (drule sym)
   apply (simp add: rbl_add)
   done
 
 lemma word_mult_rbl:
   "to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow>
     to_bl (v * w) = rev (rbl_mult (rev vbl) (rev wbl))"
   apply transfer
   apply (drule sym)
   apply (drule sym)
   apply (simp add: rbl_mult)
   done
 
 lemma rtb_rbl_ariths:
   "rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_succ w)) = rbl_succ ys"
   "rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_pred w)) = rbl_pred ys"
   "rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v * w)) = rbl_mult ys xs"
   "rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v + w)) = rbl_add ys xs"
   by (auto simp: rev_swap [symmetric] word_succ_rbl word_pred_rbl word_mult_rbl word_add_rbl)
 
 lemma of_bl_length_less:
   \<open>(of_bl x :: 'a::len word) < 2 ^ k\<close>
     if \<open>length x = k\<close> \<open>k < LENGTH('a)\<close>
 proof -
   from that have \<open>length x < LENGTH('a)\<close>
     by simp
   then have \<open>(of_bl x :: 'a::len word) < 2 ^ length x\<close>
     apply (simp add: of_bl_eq)
     apply transfer
     apply (simp add: take_bit_horner_sum_bit_eq)
     apply (subst length_rev [symmetric])
     apply (simp only: horner_sum_of_bool_2_less)
     done
   with that show ?thesis
     by simp
 qed
 
 lemma word_eq_rbl_eq: "x = y \<longleftrightarrow> rev (to_bl x) = rev (to_bl y)"
   by simp
 
 lemma bl_word_not: "to_bl (NOT w) = map Not (to_bl w)"
   by transfer (simp add: bl_not_bin)
 
 lemma bl_word_xor: "to_bl (v XOR w) = map2 (\<noteq>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_xor_bin)
 
 lemma bl_word_or: "to_bl (v OR w) = map2 (\<or>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_or_bin)
 
 lemma bl_word_and: "to_bl (v AND w) = map2 (\<and>) (to_bl v) (to_bl w)"
   by transfer (simp flip: bl_and_bin)
 
 lemma bin_nth_uint': "bit (uint w) n \<longleftrightarrow> rev (bin_to_bl (size w) (uint w)) ! n \<and> n < size w"
   apply (unfold word_size)
   apply (safe elim!: bin_nth_uint_imp)
    apply (frule bin_nth_uint_imp)
    apply (fast dest!: bin_nth_bl)+
   done
 
 lemmas bin_nth_uint = bin_nth_uint' [unfolded word_size]
 
 lemma test_bit_bl: "bit w n \<longleftrightarrow> rev (to_bl w) ! n \<and> n < size w"
   by transfer (auto simp add: bin_nth_bl)
 
 lemma to_bl_nth: "n < size w \<Longrightarrow> to_bl w ! n = bit w (size w - Suc n)"
   by (simp add: word_size rev_nth test_bit_bl)
 
 lemma map_bit_interval_eq:
   \<open>map (bit w) [0..<n] = takefill False n (rev (to_bl w))\<close> for w :: \<open>'a::len word\<close>
 proof (rule nth_equalityI)
   show \<open>length (map (bit w) [0..<n]) =
     length (takefill False n (rev (to_bl w)))\<close>
     by simp
   fix m
   assume \<open>m < length (map (bit w) [0..<n])\<close>
   then have \<open>m < n\<close>
     by simp
   then have \<open>bit w m \<longleftrightarrow> takefill False n (rev (to_bl w)) ! m\<close>
     by (auto simp add: nth_takefill not_less rev_nth to_bl_nth word_size dest: bit_imp_le_length)
   with \<open>m < n \<close>show \<open>map (bit w) [0..<n] ! m \<longleftrightarrow> takefill False n (rev (to_bl w)) ! m\<close>
     by simp
 qed
 
 lemma to_bl_unfold:
   \<open>to_bl w = rev (map (bit w) [0..<LENGTH('a)])\<close> for w :: \<open>'a::len word\<close>
   by (simp add: map_bit_interval_eq takefill_bintrunc to_bl_def flip: bin_to_bl_def)
 
 lemma nth_rev_to_bl:
   \<open>rev (to_bl w) ! n \<longleftrightarrow> bit w n\<close>
   if \<open>n < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: to_bl_unfold)
 
 lemma nth_to_bl:
   \<open>to_bl w ! n \<longleftrightarrow> bit w (LENGTH('a) - Suc n)\<close>
   if \<open>n < LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   using that by (simp add: to_bl_unfold rev_nth)
 
 lemma of_bl_rep_False: "of_bl (replicate n False @ bs) = of_bl bs"
   by (auto simp: of_bl_def bl_to_bin_rep_F)
 
 lemma [code abstract]:
   \<open>Word.the_int (of_bl bs :: 'a word) = horner_sum of_bool 2 (take LENGTH('a::len) (rev bs))\<close>
   apply (simp add: of_bl_eq flip: take_bit_horner_sum_bit_eq)
   apply transfer
   apply simp
   done
 
 lemma [code]:
   \<open>to_bl w = map (bit w) (rev [0..<LENGTH('a::len)])\<close>
   for w :: \<open>'a::len word\<close>
   by (fact to_bl_eq_rev)
 
 lemma word_reverse_eq_of_bl_rev_to_bl:
   \<open>word_reverse w = of_bl (rev (to_bl w))\<close>
   by (rule bit_word_eqI)
     (auto simp add: bit_word_reverse_iff bit_of_bl_iff nth_to_bl)
 
 lemmas word_reverse_no_def [simp] =
   word_reverse_eq_of_bl_rev_to_bl [of "numeral w"] for w
 
 lemma to_bl_word_rev: "to_bl (word_reverse w) = rev (to_bl w)"
   by (rule nth_equalityI) (simp_all add: nth_rev_to_bl word_reverse_def word_rep_drop flip: of_bl_eq)
 
 lemma to_bl_n1 [simp]: "to_bl (-1::'a::len word) = replicate (LENGTH('a)) True"
   apply (rule word_bl.Abs_inverse')
    apply simp
   apply (rule word_eqI)
   apply (clarsimp simp add: word_size)
   apply (auto simp add: word_bl.Abs_inverse test_bit_bl word_size)
   done
 
 lemma rbl_word_or: "rev (to_bl (x OR y)) = map2 (\<or>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_or rev_map)
 
 lemma rbl_word_and: "rev (to_bl (x AND y)) = map2 (\<and>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_and rev_map)
 
 lemma rbl_word_xor: "rev (to_bl (x XOR y)) = map2 (\<noteq>) (rev (to_bl x)) (rev (to_bl y))"
   by (simp add: zip_rev bl_word_xor rev_map)
 
 lemma rbl_word_not: "rev (to_bl (NOT x)) = map Not (rev (to_bl x))"
   by (simp add: bl_word_not rev_map)
 
 lemma bshiftr1_numeral [simp]:
   \<open>bshiftr1 b (numeral w :: 'a word) = of_bl (b # butlast (bin_to_bl LENGTH('a::len) (numeral w)))\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps rev_nth nth_append nth_butlast nth_bin_to_bl simp flip: bit_Suc)
 
 lemma bshiftr1_bl: "to_bl (bshiftr1 b w) = b # butlast (to_bl w)"
   unfolding bshiftr1_eq by (rule word_bl.Abs_inverse) simp
 
 lemma shiftl1_of_bl: "shiftl1 (of_bl bl) = of_bl (bl @ [False])"
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps)
   subgoal for n
     apply (cases n)
      apply simp_all
     done
   done
 
 lemma shiftl1_bl: "shiftl1 w = of_bl (to_bl w @ [False])"
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps)
   subgoal for n
     apply (cases n)
      apply (simp_all add: nth_rev_to_bl)
     done
   done
 
 lemma bl_shiftl1: "to_bl (shiftl1 w) = tl (to_bl w) @ [False]"
   for w :: "'a::len word"
   by (simp add: shiftl1_bl word_rep_drop drop_Suc drop_Cons') (fast intro!: Suc_leI)
 
 lemma to_bl_double_eq:
   \<open>to_bl (2 * w) = tl (to_bl w) @ [False]\<close>
   using bl_shiftl1 [of w] by (simp add: shiftl1_def ac_simps)
 
 \<comment> \<open>Generalized version of \<open>bl_shiftl1\<close>. Maybe this one should replace it?\<close>
 lemma bl_shiftl1': "to_bl (shiftl1 w) = tl (to_bl w @ [False])"
   by (simp add: shiftl1_bl word_rep_drop drop_Suc del: drop_append)
 
 lemma shiftr1_bl:
   \<open>shiftr1 w = of_bl (butlast (to_bl w))\<close>
 proof (rule bit_word_eqI)
   fix n
   assume \<open>n < LENGTH('a)\<close>
   show \<open>bit (shiftr1 w) n \<longleftrightarrow> bit (of_bl (butlast (to_bl w)) :: 'a word) n\<close>
   proof (cases \<open>n = LENGTH('a) - 1\<close>)
     case True
     then show ?thesis
       by (simp add: bit_shiftr1_iff bit_of_bl_iff)
   next
     case False
     with \<open>n < LENGTH('a)\<close>
     have \<open>n < LENGTH('a) - 1\<close>
       by simp
     with \<open>n < LENGTH('a)\<close> show ?thesis
       by (simp add: bit_shiftr1_iff bit_of_bl_iff rev_nth nth_butlast
         word_size to_bl_nth)
   qed
 qed
 
 lemma bl_shiftr1: "to_bl (shiftr1 w) = False # butlast (to_bl w)"
   for w :: "'a::len word"
   by (simp add: shiftr1_bl word_rep_drop len_gt_0 [THEN Suc_leI])
 
 \<comment> \<open>Generalized version of \<open>bl_shiftr1\<close>. Maybe this one should replace it?\<close>
 lemma bl_shiftr1': "to_bl (shiftr1 w) = butlast (False # to_bl w)"
   apply (rule word_bl.Abs_inverse')
    apply (simp del: butlast.simps)
   apply (simp add: shiftr1_bl of_bl_def)
   done
 
 lemma bl_sshiftr1: "to_bl (sshiftr1 w) = hd (to_bl w) # butlast (to_bl w)"
   for w :: "'a::len word"
 proof (rule nth_equalityI)
   fix n
   assume \<open>n < length (to_bl (sshiftr1 w))\<close>
   then have \<open>n < LENGTH('a)\<close>
     by simp
   then show \<open>to_bl (sshiftr1 w) ! n \<longleftrightarrow> (hd (to_bl w) # butlast (to_bl w)) ! n\<close>
     apply (cases n)
      apply (simp_all add: to_bl_nth word_size hd_conv_nth bit_sshiftr1_iff nth_butlast Suc_diff_Suc nth_to_bl)
     done
 qed simp
 
 lemma drop_shiftr: "drop n (to_bl (w >> n)) = take (size w - n) (to_bl w)"
   for w :: "'a::len word"
   apply (rule nth_equalityI)
    apply (simp_all add: word_size to_bl_nth bit_simps)
   done
 
 lemma drop_sshiftr: "drop n (to_bl (w >>> n)) = take (size w - n) (to_bl w)"
   for w :: "'a::len word"
   apply (rule nth_equalityI)
    apply (simp_all add: word_size nth_to_bl bit_simps)
   done
 
 lemma take_shiftr: "n \<le> size w \<Longrightarrow> take n (to_bl (w >> n)) = replicate n False"
   apply (rule nth_equalityI)
    apply (auto simp add: word_size to_bl_nth bit_simps dest: bit_imp_le_length)
   done
 
 lemma take_sshiftr':
   "n \<le> size w \<Longrightarrow> hd (to_bl (w >>> n)) = hd (to_bl w) \<and>
     take n (to_bl (w >>> n)) = replicate n (hd (to_bl w))"
   for w :: "'a::len word"
   apply (cases n)
    apply (auto simp add: hd_to_bl_iff bit_simps not_less word_size)
   apply (rule nth_equalityI)
    apply (auto simp add: nth_to_bl bit_simps nth_Cons split: nat.split)
   done
 
 lemmas hd_sshiftr = take_sshiftr' [THEN conjunct1]
 lemmas take_sshiftr = take_sshiftr' [THEN conjunct2]
 
 lemma atd_lem: "take n xs = t \<Longrightarrow> drop n xs = d \<Longrightarrow> xs = t @ d"
   by (auto intro: append_take_drop_id [symmetric])
 
 lemmas bl_shiftr = atd_lem [OF take_shiftr drop_shiftr]
 lemmas bl_sshiftr = atd_lem [OF take_sshiftr drop_sshiftr]
 
 lemma shiftl_of_bl: "of_bl bl << n = of_bl (bl @ replicate n False)"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps nth_append)
   done
 
 lemma shiftl_bl: "w << n = of_bl (to_bl w @ replicate n False)"
   for w :: "'a::len word"
   by (simp flip: shiftl_of_bl)
 
 lemma bl_shiftl: "to_bl (w << n) = drop n (to_bl w) @ replicate (min (size w) n) False"
   by (simp add: shiftl_bl word_rep_drop word_size)
 
 lemma shiftr1_bl_of:
   "length bl \<le> LENGTH('a) \<Longrightarrow>
     shiftr1 (of_bl bl::'a::len word) = of_bl (butlast bl)"
   apply (rule bit_word_eqI)
   apply (simp add: bit_simps)
   apply (cases bl rule: rev_cases)
   apply auto
   done
 
 lemma shiftr_bl_of:
   "length bl \<le> LENGTH('a) \<Longrightarrow>
      (of_bl bl::'a::len word) >> n = of_bl (take (length bl - n) bl)"
   by (rule bit_word_eqI) (auto simp add: bit_simps rev_nth)
 
 lemma shiftr_bl: "x >> n \<equiv> of_bl (take (LENGTH('a) - n) (to_bl x))"
   for x :: "'a::len word"
   using shiftr_bl_of [where 'a='a, of "to_bl x"] by simp
 
 lemma aligned_bl_add_size [OF refl]:
   "size x - n = m \<Longrightarrow> n \<le> size x \<Longrightarrow> drop m (to_bl x) = replicate n False \<Longrightarrow>
     take m (to_bl y) = replicate m False \<Longrightarrow>
     to_bl (x + y) = take m (to_bl x) @ drop m (to_bl y)" for x :: \<open>'a::len word\<close>
   apply (subgoal_tac "x AND y = 0")
    prefer 2
    apply (rule word_bl.Rep_eqD)
    apply (simp add: bl_word_and)
    apply (rule align_lem_and [THEN trans])
        apply (simp_all add: word_size)[5]
    apply simp
   apply (subst word_plus_and_or [symmetric])
   apply (simp add : bl_word_or)
   apply (rule align_lem_or)
      apply (simp_all add: word_size)
   done
 
 lemma mask_bl: "mask n = of_bl (replicate n True)"
   by (auto simp add: bit_simps intro!: word_eqI)
 
 lemma bl_and_mask':
   "to_bl (w AND mask n :: 'a::len word) =
     replicate (LENGTH('a) - n) False @
     drop (LENGTH('a) - n) (to_bl w)"
   apply (rule nth_equalityI)
    apply simp
   apply (clarsimp simp add: to_bl_nth word_size bit_simps)
   apply (auto simp add: word_size test_bit_bl nth_append rev_nth)
   done
 
 lemma slice1_eq_of_bl:
   \<open>(slice1 n w :: 'b::len word) = of_bl (takefill False n (to_bl w))\<close>
   for w :: \<open>'a::len word\<close>
 proof (rule bit_word_eqI)
   fix m
   assume \<open>m < LENGTH('b)\<close>
   show \<open>bit (slice1 n w :: 'b::len word) m \<longleftrightarrow> bit (of_bl (takefill False n (to_bl w)) :: 'b word) m\<close>
     by (cases \<open>m \<ge> n\<close>; cases \<open>LENGTH('a) \<ge> n\<close>)
       (auto simp add: bit_slice1_iff bit_of_bl_iff not_less rev_nth not_le nth_takefill nth_to_bl algebra_simps)
 qed
 
 lemma slice1_no_bin [simp]:
   "slice1 n (numeral w :: 'b word) = of_bl (takefill False n (bin_to_bl (LENGTH('b::len)) (numeral w)))"
   by (simp add: slice1_eq_of_bl) (* TODO: neg_numeral *)
 
 lemma slice_no_bin [simp]:
   "slice n (numeral w :: 'b word) = of_bl (takefill False (LENGTH('b::len) - n)
     (bin_to_bl (LENGTH('b::len)) (numeral w)))"
   by (simp add: slice_def) (* TODO: neg_numeral *)
 
 lemma slice_take': "slice n w = of_bl (take (size w - n) (to_bl w))"
   by (simp add: slice_def word_size slice1_eq_of_bl takefill_alt)
 
 lemmas slice_take = slice_take' [unfolded word_size]
 
 \<comment> \<open>shiftr to a word of the same size is just slice,
     slice is just shiftr then ucast\<close>
 lemmas shiftr_slice = trans [OF shiftr_bl [THEN meta_eq_to_obj_eq] slice_take [symmetric]]
 
 lemma slice1_down_alt':
   "sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs + k = n \<Longrightarrow>
     to_bl sl = takefill False fs (drop k (to_bl w))"
   apply (simp add: slice1_eq_of_bl)
   apply transfer
   apply (simp add: bl_bin_bl_rep_drop)
   using drop_takefill
   apply force
   done
 
 lemma slice1_up_alt':
   "sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs = n + k \<Longrightarrow>
     to_bl sl = takefill False fs (replicate k False @ (to_bl w))"
   apply (simp add: slice1_eq_of_bl)
   apply transfer
   apply (simp add: bl_bin_bl_rep_drop flip: takefill_append)
   apply (metis diff_add_inverse)
   done
 
 lemmas sd1 = slice1_down_alt' [OF refl refl, unfolded word_size]
 lemmas su1 = slice1_up_alt' [OF refl refl, unfolded word_size]
 lemmas slice1_down_alt = le_add_diff_inverse [THEN sd1]
 lemmas slice1_up_alts =
   le_add_diff_inverse [symmetric, THEN su1]
   le_add_diff_inverse2 [symmetric, THEN su1]
 
 lemma slice1_tf_tf':
   "to_bl (slice1 n w :: 'a::len word) =
     rev (takefill False (LENGTH('a)) (rev (takefill False n (to_bl w))))"
   unfolding slice1_eq_of_bl by (rule word_rev_tf)
 
 lemmas slice1_tf_tf = slice1_tf_tf' [THEN word_bl.Rep_inverse', symmetric]
 
 lemma revcast_eq_of_bl:
   \<open>(revcast w :: 'b::len word) = of_bl (takefill False (LENGTH('b)) (to_bl w))\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: revcast_def slice1_eq_of_bl)
 
 lemmas revcast_no_def [simp] = revcast_eq_of_bl [where w="numeral w", unfolded word_size] for w
 
 lemma to_bl_revcast:
   "to_bl (revcast w :: 'a::len word) = takefill False (LENGTH('a)) (to_bl w)"
   apply (rule nth_equalityI)
   apply simp
   apply (cases \<open>LENGTH('a) \<le> LENGTH('b)\<close>)
    apply (auto simp add: nth_to_bl nth_takefill bit_revcast_iff)
   done
 
 lemma word_cat_bl: "word_cat a b = of_bl (to_bl a @ to_bl b)"
   apply (rule bit_word_eqI)
   apply (simp add: bit_word_cat_iff bit_of_bl_iff nth_append not_less nth_rev_to_bl)
   apply (meson bit_word.rep_eq less_diff_conv2 nth_rev_to_bl)
   done
 
 lemma of_bl_append:
   "(of_bl (xs @ ys) :: 'a::len word) = of_bl xs * 2^(length ys) + of_bl ys"
   apply transfer
   apply (simp add: bl_to_bin_app_cat bin_cat_num)
   done
 
 lemma of_bl_False [simp]: "of_bl (False#xs) = of_bl xs"
   by (rule word_eqI) (auto simp: test_bit_of_bl nth_append)
 
 lemma of_bl_True [simp]: "(of_bl (True # xs) :: 'a::len word) = 2^length xs + of_bl xs"
   by (subst of_bl_append [where xs="[True]", simplified]) (simp add: word_1_bl)
 
 lemma of_bl_Cons: "of_bl (x#xs) = of_bool x * 2^length xs + of_bl xs"
   by (cases x) simp_all
 
 lemma word_split_bl':
   "std = size c - size b \<Longrightarrow> (word_split c = (a, b)) \<Longrightarrow>
     (a = of_bl (take std (to_bl c)) \<and> b = of_bl (drop std (to_bl c)))"
   apply (simp add: word_split_def)
   apply transfer
   apply (cases \<open>LENGTH('b) \<le> LENGTH('a)\<close>)
    apply (auto simp add: drop_bit_take_bit drop_bin2bl bin_to_bl_drop_bit [symmetric, of \<open>LENGTH('a)\<close> \<open>LENGTH('a) - LENGTH('b)\<close> \<open>LENGTH('b)\<close>] min_absorb2)
   done
 
 lemma word_split_bl: "std = size c - size b \<Longrightarrow>
     (a = of_bl (take std (to_bl c)) \<and> b = of_bl (drop std (to_bl c))) \<longleftrightarrow>
     word_split c = (a, b)"
   apply (rule iffI)
    defer
    apply (erule (1) word_split_bl')
   apply (case_tac "word_split c")
   apply (auto simp add: word_size)
   apply (frule word_split_bl' [rotated])
    apply (auto simp add: word_size)
   done
 
 lemma word_split_bl_eq:
   "(word_split c :: ('c::len word \<times> 'd::len word)) =
     (of_bl (take (LENGTH('a::len) - LENGTH('d::len)) (to_bl c)),
      of_bl (drop (LENGTH('a) - LENGTH('d)) (to_bl c)))"
   for c :: "'a::len word"
   apply (rule word_split_bl [THEN iffD1])
    apply (unfold word_size)
    apply (rule refl conjI)+
   done
 
 lemma word_rcat_bl:
   \<open>word_rcat wl = of_bl (concat (map to_bl wl))\<close>
 proof -
   define ws where \<open>ws = rev wl\<close>
   moreover have \<open>word_rcat (rev ws) = of_bl (concat (map to_bl (rev ws)))\<close>
     apply (simp add: word_rcat_def of_bl_eq rev_concat rev_map comp_def rev_to_bl_eq flip: horner_sum_of_bool_2_concat)
     apply transfer
     apply simp
     done
   ultimately show ?thesis
     by simp
 qed
 
 lemma size_rcat_lem': "size (concat (map to_bl wl)) = length wl * size (hd wl)"
   by (induct wl) (auto simp: word_size)
 
 lemmas size_rcat_lem = size_rcat_lem' [unfolded word_size]
 
 lemma nth_rcat_lem:
   "n < length (wl::'a word list) * LENGTH('a::len) \<Longrightarrow>
     rev (concat (map to_bl wl)) ! n =
     rev (to_bl (rev wl ! (n div LENGTH('a)))) ! (n mod LENGTH('a))"
   apply (induct wl)
    apply clarsimp
   apply (clarsimp simp add : nth_append size_rcat_lem)
   apply (simp flip: mult_Suc minus_div_mult_eq_mod add: less_Suc_eq_le not_less)
   apply (metis (no_types, lifting) diff_is_0_eq div_le_mono len_not_eq_0 less_Suc_eq less_mult_imp_div_less nonzero_mult_div_cancel_right not_le nth_Cons_0)
   done
 
 lemma foldl_eq_foldr: "foldl (+) x xs = foldr (+) (x # xs) 0"
   for x :: "'a::comm_monoid_add"
   by (induct xs arbitrary: x) (auto simp: add.assoc)
 
 lemmas word_cat_bl_no_bin [simp] =
   word_cat_bl [where a="numeral a" and b="numeral b", unfolded to_bl_numeral]
   for a b (* FIXME: negative numerals, 0 and 1 *)
 
 lemmas word_split_bl_no_bin [simp] =
   word_split_bl_eq [where c="numeral c", unfolded to_bl_numeral] for c
 
 lemmas word_rot_defs = word_roti_eq_word_rotr_word_rotl word_rotr_eq word_rotl_eq
 
 lemma to_bl_rotl: "to_bl (word_rotl n w) = rotate n (to_bl w)"
   by (simp add: word_rotl_eq to_bl_use_of_bl)
 
 lemmas blrs0 = rotate_eqs [THEN to_bl_rotl [THEN trans]]
 
 lemmas word_rotl_eqs =
   blrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotl [symmetric]]
 
 lemma to_bl_rotr: "to_bl (word_rotr n w) = rotater n (to_bl w)"
   by (simp add: word_rotr_eq to_bl_use_of_bl)
 
 lemmas brrs0 = rotater_eqs [THEN to_bl_rotr [THEN trans]]
 
 lemmas word_rotr_eqs =
   brrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotr [symmetric]]
 
 declare word_rotr_eqs (1) [simp]
 declare word_rotl_eqs (1) [simp]
 
 lemmas abl_cong = arg_cong [where f = "of_bl"]
 
 end
 
 locale word_rotate
 begin
 
 lemmas word_rot_defs' = to_bl_rotl to_bl_rotr
 
 lemmas blwl_syms [symmetric] = bl_word_not bl_word_and bl_word_or bl_word_xor
 
 lemmas lbl_lbl = trans [OF word_bl_Rep' word_bl_Rep' [symmetric]]
 
 lemmas ths_map2 [OF lbl_lbl] = rotate_map2 rotater_map2
 
 lemmas ths_map [where xs = "to_bl v"] = rotate_map rotater_map for v
 
 lemmas th1s [simplified word_rot_defs' [symmetric]] = ths_map2 ths_map
 
 end
 
 lemmas bl_word_rotl_dt = trans [OF to_bl_rotl rotate_drop_take,
   simplified word_bl_Rep']
 
 lemmas bl_word_rotr_dt = trans [OF to_bl_rotr rotater_drop_take,
   simplified word_bl_Rep']
 
 lemma bl_word_roti_dt':
   "n = nat ((- i) mod int (size (w :: 'a::len word))) \<Longrightarrow>
     to_bl (word_roti i w) = drop n (to_bl w) @ take n (to_bl w)"
   apply (unfold word_roti_eq_word_rotr_word_rotl)
   apply (simp add: bl_word_rotl_dt bl_word_rotr_dt word_size)
   apply safe
    apply (simp add: zmod_zminus1_eq_if)
    apply safe
     apply (simp add: nat_mult_distrib)
    apply (simp add: nat_diff_distrib [OF pos_mod_sign pos_mod_conj
                                       [THEN conjunct2, THEN order_less_imp_le]]
                     nat_mod_distrib)
   apply (simp add: nat_mod_distrib)
   done
 
 lemmas bl_word_roti_dt = bl_word_roti_dt' [unfolded word_size]
 
 lemmas word_rotl_dt = bl_word_rotl_dt [THEN word_bl.Rep_inverse' [symmetric]]
 lemmas word_rotr_dt = bl_word_rotr_dt [THEN word_bl.Rep_inverse' [symmetric]]
 lemmas word_roti_dt = bl_word_roti_dt [THEN word_bl.Rep_inverse' [symmetric]]
 
 lemmas word_rotr_dt_no_bin' [simp] =
   word_rotr_dt [where w="numeral w", unfolded to_bl_numeral] for w
   (* FIXME: negative numerals, 0 and 1 *)
 
 lemmas word_rotl_dt_no_bin' [simp] =
   word_rotl_dt [where w="numeral w", unfolded to_bl_numeral] for w
   (* FIXME: negative numerals, 0 and 1 *)
 
 lemma max_word_bl: "to_bl (- 1::'a::len word) = replicate LENGTH('a) True"
   by (fact to_bl_n1)
 
 lemma to_bl_mask:
   "to_bl (mask n :: 'a::len word) =
   replicate (LENGTH('a) - n) False @
     replicate (min (LENGTH('a)) n) True"
   by (simp add: mask_bl word_rep_drop min_def)
 
 lemma map_replicate_True:
   "n = length xs \<Longrightarrow>
     map (\<lambda>(x,y). x \<and> y) (zip xs (replicate n True)) = xs"
   by (induct xs arbitrary: n) auto
 
 lemma map_replicate_False:
   "n = length xs \<Longrightarrow> map (\<lambda>(x,y). x \<and> y)
     (zip xs (replicate n False)) = replicate n False"
   by (induct xs arbitrary: n) auto
 
 context
   includes bit_operations_syntax
 begin
 
 lemma bl_and_mask:
   fixes w :: "'a::len word"
     and n :: nat
   defines "n' \<equiv> LENGTH('a) - n"
   shows "to_bl (w AND mask n) = replicate n' False @ drop n' (to_bl w)"
 proof -
   note [simp] = map_replicate_True map_replicate_False
   have "to_bl (w AND mask n) = map2 (\<and>) (to_bl w) (to_bl (mask n::'a::len word))"
     by (simp add: bl_word_and)
   also have "to_bl w = take n' (to_bl w) @ drop n' (to_bl w)"
     by simp
   also have "map2 (\<and>) \<dots> (to_bl (mask n::'a::len word)) =
       replicate n' False @ drop n' (to_bl w)"
     unfolding to_bl_mask n'_def by (subst zip_append) auto
   finally show ?thesis .
 qed
 
 lemma drop_rev_takefill:
   "length xs \<le> n \<Longrightarrow>
     drop (n - length xs) (rev (takefill False n (rev xs))) = xs"
   by (simp add: takefill_alt rev_take)
 
 declare bin_to_bl_def [simp]
 
 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 transfer
   apply (simp add: take_bit_eq_mod)
   apply (rule Divides.mod_less)
    apply (rule bl_to_bin_ge0)
   using bl_to_bin_lt2p_drop apply (rule order.strict_trans2)
   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_and_1_bl:
   fixes x::"'a::len word"
   shows "(x AND 1) = of_bl [bit x 0]"
-  by (simp add: mod_2_eq_odd and_one_eq)
+  by (simp add: word_and_1)
 
 lemma word_1_and_bl:
   fixes x::"'a::len word"
   shows "(1 AND x) = of_bl [bit x 0]"
-  by (simp add: mod_2_eq_odd one_and_eq)
+  using word_and_1_bl [of x] by (simp add: ac_simps)
 
 lemma of_bl_drop:
   "of_bl (drop n xs) = (of_bl xs AND mask (length xs - n))"
   apply (rule bit_word_eqI)
   apply (auto simp: rev_nth bit_simps cong: rev_conj_cong)
   done
 
 lemma to_bl_1:
   "to_bl (1::'a::len word) = replicate (LENGTH('a) - 1) False @ [True]"
   by (rule nth_equalityI) (auto simp add: to_bl_unfold nth_append rev_nth bit_1_iff not_less not_le)
 
 lemma eq_zero_set_bl:
   "(w = 0) = (True \<notin> set (to_bl w))"
   apply (auto simp add: to_bl_unfold)
   apply (rule bit_word_eqI)
   apply auto
   done
 
 lemma of_drop_to_bl:
   "of_bl (drop n (to_bl x)) = (x AND mask (size x - n))"
   by (simp add: of_bl_drop word_size_bl)
 
 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 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 word_msb_alt: "msb w \<longleftrightarrow> hd (to_bl w)"
   for w :: "'a::len word"
   apply (simp add: msb_word_eq)
   apply (subst hd_conv_nth)
    apply simp
   apply (subst nth_to_bl)
    apply simp
   apply simp
   done
 
 lemma word_lsb_last:
   \<open>lsb w \<longleftrightarrow> last (to_bl w)\<close>
   for w :: \<open>'a::len word\<close>
   using nth_to_bl [of \<open>LENGTH('a) - Suc 0\<close> w]
-  by (simp add: lsb_odd last_conv_nth)
+  by (simp add: last_conv_nth bit_0 lsb_odd)
 
 lemma is_aligned_to_bl:
   "is_aligned (w :: 'a :: len word) n = (True \<notin> set (drop (size w - n) (to_bl w)))"
   by (simp add: is_aligned_mask eq_zero_set_bl bl_and_mask word_size)
 
 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"
   apply (rule nth_equalityI)
   using assms apply (simp_all add: nth_append not_less word_size to_bl_nth is_aligned_imp_not_bit)
   done
 
 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 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 (rule nth_equalityI)
    apply (auto simp add: nth_append to_bl_nth word_size bit_simps not_less nth_Cons le_diff_conv)
   subgoal for i
   apply (cases \<open>Suc (i + n) - LENGTH('a)\<close>)
   apply simp_all
     done
   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)"
   apply (auto simp add: to_bl_eq_rev take_map drop_map take_rev drop_rev bit_simps)
   apply (rule nth_equalityI)
    apply (auto simp add: bit_simps rev_nth nth_append Suc_diff_Suc)
   done
 
 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
 
 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 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 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) AND NOT(mask n) = a"
   apply (simp flip: push_bit_eq_mult subtract_mask(1) take_bit_eq_mask)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps not_le not_less)
    apply (meson is_aligned_imp_not_bit is_aligned_weaken less_diff_conv2)
   apply (erule is_alignedE')
   apply (simp add: take_bit_push_bit)
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   done
 
 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 (simp flip: push_bit_eq_mult take_bit_eq_mask)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps not_le not_less unsigned_or_eq unsigned_drop_bit_eq
      unsigned_push_bit_eq bin_to_bl_or simp flip: bin_to_bl_def)
    apply (meson is_aligned_imp_not_bit is_aligned_weaken less_diff_conv2)
   apply (erule is_alignedE')
   apply (rule nth_equalityI)
    apply (auto simp add: nth_bin_to_bl bit_simps rev_nth simp flip: bin_to_bl_def)
   done
 
 (* 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 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 map_bits_rev_to_bl:
   "map (bit x) [0..<size x] = rev (to_bl x)"
   by (auto simp: list_eq_iff_nth_eq test_bit_bl word_size)
 
 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 of_bl_max:
   "(of_bl xs :: 'a::len word) \<le> mask (length xs)"
 proof -
   define ys where \<open>ys = rev xs\<close>
   have \<open>take_bit (length ys) (horner_sum of_bool 2 ys :: 'a word) = horner_sum of_bool 2 ys\<close>
     by transfer (simp add: take_bit_horner_sum_bit_eq min_def)
   then have \<open>(of_bl (rev ys) :: 'a word) \<le> mask (length ys)\<close>
     by (simp only: of_bl_rev_eq less_eq_mask_iff_take_bit_eq_self)
   with ys_def show ?thesis
     by simp
 qed
 
 text\<open>Some auxiliaries for sign-shifting by the entire word length or more\<close>
 
 lemma sshiftr_clamp_pos:
   assumes
     "LENGTH('a) \<le> n"
     "0 \<le> sint x"
   shows "(x::'a::len word) >>> n = 0"
   apply (rule bit_word_eqI)
   using assms
   apply (auto simp add: bit_simps bit_last_iff)
   done
 
 lemma sshiftr_clamp_neg:
   assumes
     "LENGTH('a) \<le> n"
     "sint x < 0"
   shows "(x::'a::len word) >>> n = -1"
   apply (rule bit_word_eqI)
   using assms
   apply (auto simp add: bit_simps bit_last_iff)
   done
 
 lemma sshiftr_clamp:
   assumes "LENGTH('a) \<le> n"
   shows "(x::'a::len word) >>> n = x >>> LENGTH('a)"
   apply (rule bit_word_eqI)
   using assms
   apply (auto simp add: bit_simps bit_last_iff)
   done
 
 text\<open>
 Like @{thm shiftr1_bl_of}, but the precondition is stronger because we need to pick the msb out of
 the list.
 \<close>
 lemma sshiftr1_bl_of:
   "length bl = LENGTH('a) \<Longrightarrow>
     sshiftr1 (of_bl bl::'a::len word) = of_bl (hd bl # butlast bl)"
   apply (rule word_bl.Rep_eqD)
   apply (subst bl_sshiftr1[of "of_bl bl :: 'a word"])
   by (simp add: word_bl.Abs_inverse)
 
 text\<open>
 Like @{thm sshiftr1_bl_of}, with a weaker precondition.
 We still get a direct equation for @{term \<open>sshiftr1 (of_bl bl)\<close>}, it's just uglier.
 \<close>
 lemma sshiftr1_bl_of':
   "LENGTH('a) \<le> length bl \<Longrightarrow>
     sshiftr1 (of_bl bl::'a::len word) =
     of_bl (hd (drop (length bl - LENGTH('a)) bl) # butlast (drop (length bl - LENGTH('a)) bl))"
   apply (subst of_bl_drop'[symmetric, of "length bl - LENGTH('a)"])
   using sshiftr1_bl_of[of "drop (length bl - LENGTH('a)) bl"]
   by auto
 
 text\<open>
 Like @{thm shiftr_bl_of}.
 \<close>
 lemma sshiftr_bl_of:
   assumes "length bl = LENGTH('a)"
   shows "(of_bl bl::'a::len word) >>> n = of_bl (replicate n (hd bl) @ take (length bl - n) bl)"
 proof -
   from assms obtain b bs where \<open>bl = b # bs\<close>
     by (cases bl) simp_all
   then have *: \<open>bl ! 0 \<longleftrightarrow> b\<close> \<open>hd bl \<longleftrightarrow> b\<close>
     by simp_all
   show ?thesis
   apply (rule bit_word_eqI)
     using assms * by (auto simp add: bit_simps nth_append rev_nth not_less)
 qed
 
 text\<open>Like @{thm shiftr_bl}\<close>
 lemma sshiftr_bl: "x >>> n \<equiv> of_bl (replicate n (msb x) @ take (LENGTH('a) - n) (to_bl x))"
   for x :: "'a::len word"
   unfolding word_msb_alt
   by (smt (z3) length_to_bl_eq sshiftr_bl_of word_bl.Rep_inverse)
 
 end
 
 lemma of_bl_drop_eq_take_bit:
   \<open>of_bl (drop n xs) = take_bit (length xs - n) (of_bl xs)\<close>
   by (simp add: of_bl_drop take_bit_eq_mask)
 
 lemma of_bl_take_to_bl_eq_drop_bit:
   \<open>of_bl (take n (to_bl w)) = drop_bit (LENGTH('a) - n) w\<close>
     if \<open>n \<le> LENGTH('a)\<close>
     for w :: \<open>'a::len word\<close>
   using that shiftr_bl [of w \<open>LENGTH('a) - n\<close>] by (simp add: shiftr_def)
 
 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,1891 +1,1888 @@
 (*
  * 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
     Type_Syntax
     Signed_Division_Word
     Signed_Words
     More_Word
     Most_significant_bit
     Enumeration_Word
     Aligned
     Bit_Shifts_Infix_Syntax
     Word_EqI
 begin
 
 context
   includes bit_operations_syntax
 begin
 
 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 ucast_zero_is_aligned:
   \<open>is_aligned w n\<close> if \<open>UCAST('a::len \<rightarrow> 'b::len) w = 0\<close> \<open>n \<le> LENGTH('b)\<close>
 proof (rule is_aligned_bitI)
   fix q
   assume \<open>q < n\<close>
   moreover have \<open>bit (UCAST('a::len \<rightarrow> 'b::len) w) q = bit 0 q\<close>
     using that by simp
   with \<open>q < n\<close> \<open>n \<le> LENGTH('b)\<close> show \<open>\<not> bit w q\<close>
     by (simp add: bit_simps)
 qed
 
 lemma unat_ucast_eq_unat_and_mask:
   "unat (UCAST('b::len \<rightarrow> 'a::len) w) = unat (w AND mask LENGTH('a))"
   apply (simp flip: take_bit_eq_mask)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 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: of_int_mask_eq)
   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
     apply (simp add: unsigned_ucast_eq take_bit_word_eq_self_iff)
     apply (meson \<open>x \<le> 2 ^ LENGTH('b) - 1\<close> not_le word_less_sub_le)
     done
 qed
 
 lemma uint_shiftr_eq:
   \<open>uint (w >> n) = uint w div 2 ^ n\<close>
   by word_eqI
 
 lemma bit_shiftl_word_iff [bit_simps]:
   \<open>bit (w << m) n \<longleftrightarrow> m \<le> n \<and> n < LENGTH('a) \<and> bit w (n - m)\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: bit_simps)
 
 lemma bit_shiftr_word_iff:
   \<open>bit (w >> m) n \<longleftrightarrow> bit w (m + n)\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: bit_simps)
 
 lemma uint_sshiftr_eq:
   \<open>uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^  n)\<close>
   for w :: \<open>'a::len word\<close>
   by (word_eqI_solve dest: test_bit_lenD)
 
 lemma sshiftr_n1: "-1 >>> n = -1"
   by (simp add: sshiftr_def)
 
 lemma nth_sshiftr:
   "bit (w >>> m) n = (n < size w \<and> (if n + m \<ge> size w then bit w (size w - 1) else bit w (n + m)))"
   apply (auto simp add: bit_simps word_size ac_simps not_less)
   apply (meson bit_imp_le_length bit_shiftr_word_iff leD)
   done
 
 lemma sshiftr_numeral:
   \<open>(numeral k >>> numeral n :: 'a::len word) =
     word_of_int (signed_take_bit (LENGTH('a) - 1) (numeral k) >> numeral n)\<close>
   using signed_drop_bit_word_numeral [of n k] by (simp add: sshiftr_def shiftr_def)
 
 lemma sshiftr_div_2n: "sint (w >>> n) = sint w div 2 ^ n"
   by word_eqI (cases \<open>n < LENGTH('a)\<close>; fastforce simp: le_diff_conv2)
 
 lemma mask_eq:
   \<open>mask n = (1 << n) - (1 :: 'a::len word)\<close>
   by (simp add: mask_eq_exp_minus_1 shiftl_def)
 
 lemma nth_shiftl': "bit (w << m) n \<longleftrightarrow> n < size w \<and> n >= m \<and> bit w (n - m)"
   for w :: "'a::len word"
   by (simp add: bit_simps word_size ac_simps)
 
 lemmas nth_shiftl = nth_shiftl' [unfolded word_size]
 
 lemma nth_shiftr: "bit (w >> m) n = bit w (n + m)"
   for w :: "'a::len word"
   by (simp add: bit_simps ac_simps)
 
 lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n"
   by (fact uint_shiftr_eq)
 
 lemma shiftl_rev: "shiftl w n = word_reverse (shiftr (word_reverse w) n)"
   by word_eqI_solve
 
 lemma rev_shiftl: "word_reverse w << n = word_reverse (w >> n)"
   by (simp add: shiftl_rev)
 
 lemma shiftr_rev: "w >> n = word_reverse (word_reverse w << n)"
   by (simp add: rev_shiftl)
 
 lemma rev_shiftr: "word_reverse w >> n = word_reverse (w << n)"
   by (simp add: shiftr_rev)
 
 lemmas ucast_up =
   rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]]
 lemmas ucast_down =
   rc2 [simplified rev_shiftr revcast_ucast [symmetric]]
 
 lemma shiftl_zero_size: "size x \<le> n \<Longrightarrow> x << n = 0"
   for x :: "'a::len word"
   by (simp add: shiftl_def word_size)
 
 lemma shiftl_t2n: "shiftl w n = 2 ^ n * w"
   for w :: "'a::len word"
   by (simp add: shiftl_def push_bit_eq_mult)
 
 lemma word_shift_by_2:
   "x * 4 = (x::'a::len word) << 2"
   by (simp add: shiftl_t2n)
 
 lemma word_shift_by_3:
   "x * 8 = (x::'a::len word) << 3"
   by (simp add: shiftl_t2n)
 
 lemma slice_shiftr: "slice n w = ucast (w >> n)"
   by word_eqI (cases \<open>n \<le> LENGTH('b)\<close>; fastforce simp: ac_simps dest: bit_imp_le_length)
 
 lemma shiftr_zero_size: "size x \<le> n \<Longrightarrow> x >> n = 0"
   for x :: "'a :: len word"
   by word_eqI
 
 lemma shiftr_x_0 [simp]: "x >> 0 = x"
   for x :: "'a::len word"
   by (simp add: shiftr_def)
 
 lemma shiftl_x_0 [simp]: "x << 0 = x"
   for x :: "'a::len word"
   by (simp add: shiftl_def)
 
 lemmas shiftl0 = shiftl_x_0
 
 lemma shiftr_1 [simp]: "(1::'a::len word) >> n = (if n = 0 then 1 else 0)"
   by (simp add: shiftr_def)
 
 lemma and_not_mask:
   "w AND NOT (mask n) = (w >> n) << n"
   for w :: \<open>'a::len word\<close>
   by word_eqI_solve
 
 lemma and_mask:
   "w AND mask n = (w << (size w - n)) >> (size w - n)"
   for w :: \<open>'a::len word\<close>
   by word_eqI_solve
 
 lemma shiftr_div_2n_w: "w >> n = w div (2^n :: 'a :: len word)"
   by (fact shiftr_eq_div)
 
 lemma le_shiftr:
   "u \<le> v \<Longrightarrow> u >> (n :: nat) \<le> (v :: 'a :: len word) >> n"
   apply (unfold shiftr_def)
   apply transfer
   apply (simp add: take_bit_drop_bit)
   apply (simp add: drop_bit_eq_div zdiv_mono1)
   done
 
 lemma le_shiftr':
   "\<lbrakk> u >> n \<le> v >> n ; u >> n \<noteq> v >> n \<rbrakk> \<Longrightarrow> (u::'a::len word) \<le> v"
   by (metis le_cases le_shiftr verit_la_disequality)
 
 lemma shiftr_mask_le:
   "n <= m \<Longrightarrow> mask n >> m = (0 :: 'a::len word)"
   by word_eqI
 
 lemma shiftr_mask [simp]:
   \<open>mask m >> m = (0::'a::len word)\<close>
   by (rule shiftr_mask_le) simp
 
 lemma le_mask_iff:
   "(w \<le> mask n) = (w >> n = 0)"
   for w :: \<open>'a::len word\<close>
   apply safe
    apply (rule word_le_0_iff [THEN iffD1])
    apply (rule xtrans(3))
     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 bit_simps)
   apply (case_tac "n <= n'")
   by auto
 
 lemma and_mask_eq_iff_shiftr_0:
   "(w AND mask n = w) = (w >> n = 0)"
   for w :: \<open>'a::len word\<close>
   by (simp flip: take_bit_eq_mask add: shiftr_def take_bit_eq_self_iff_drop_bit_eq_0)
 
 lemma mask_shiftl_decompose:
   "mask m << n = mask (m + n) AND NOT (mask n :: 'a::len word)"
   by word_eqI_solve
 
 lemma shiftl_over_and_dist:
   fixes a::"'a::len word"
   shows "(a AND b) << c = (a << c) AND (b << c)"
   by (unfold shiftl_def) (fact push_bit_and)
 
 lemma shiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >> c = (a >> c) AND (b >> c)"
   by (unfold shiftr_def) (fact drop_bit_and)
 
 lemma sshiftr_over_and_dist:
   fixes a::"'a::len word"
   shows "a AND b >>> c = (a >>> c) AND (b >>> c)"
   by word_eqI
 
 lemma shiftl_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b << c = (a << c) OR (b << c)"
   by (unfold shiftl_def) (fact push_bit_or)
 
 lemma shiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >> c = (a >> c) OR (b >> c)"
   by (unfold shiftr_def) (fact drop_bit_or)
 
 lemma sshiftr_over_or_dist:
   fixes a::"'a::len word"
   shows "a OR b >>> c = (a >>> c) OR (b >>> c)"
   by word_eqI
 
 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)"
   by (word_eqI_solve simp: add.commute add.left_commute)
 
 lemma shiftr_shiftr:
   fixes a::"'a::len word"
   shows "a >> b >> c = a >> (b + c)"
   by word_eqI (simp add: add.left_commute add.commute)
 
 lemma shiftl_shiftr1:
   fixes a::"'a::len word"
   shows "c \<le> b \<Longrightarrow> a << b >> c = a AND (mask (size a - b)) << (b - c)"
   by word_eqI (auto simp: ac_simps)
 
 lemma shiftl_shiftr2:
   fixes a::"'a::len word"
   shows "b < c \<Longrightarrow> a << b >> c = (a >> (c - b)) AND (mask (size a - c))"
   by word_eqI_solve
 
 lemma shiftr_shiftl1:
   fixes a::"'a::len word"
   shows "c \<le> b \<Longrightarrow> a >> b << c = (a >> (b - c)) AND (NOT (mask c))"
   by word_eqI_solve
 
 lemma shiftr_shiftl2:
   fixes a::"'a::len word"
   shows "b < c \<Longrightarrow> a >> b << c = (a << (c - b)) AND (NOT (mask c))"
   by word_eqI (auto simp: ac_simps)
 
 lemmas multi_shift_simps =
   shiftl_shiftl shiftr_shiftr
   shiftl_shiftr1 shiftl_shiftr2
   shiftr_shiftl1 shiftr_shiftl2
 
 lemma shiftr_mask2:
   "n \<le> LENGTH('a) \<Longrightarrow> (mask n >> m :: ('a :: len) word) = mask (n - m)"
   by word_eqI_solve
 
 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 mask_shift:
   "(x AND NOT (mask y)) >> y = x >> y"
   for x :: \<open>'a::len word\<close>
   by word_eqI
 
 lemma shiftr_div_2n':
   "unat (w >> n) = unat w div 2 ^ n"
   by word_eqI
 
 lemma shiftl_shiftr_id:
   "\<lbrakk> n < LENGTH('a); x < 2 ^ (LENGTH('a) - n) \<rbrakk> \<Longrightarrow> x << n >> n = (x::'a::len word)" 
   by word_eqI (metis add.commute less_diff_conv)
 
 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 (transfer fixing: n) (simp add: take_bit_push_bit)
 
 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_shiftr_lt:
   fixes w :: "'a::len word"
   shows "unat (w >> n) < (2 ^ (LENGTH('a) - n))"
   apply (subst shiftr_div_2n')
   apply transfer
   apply (simp flip: drop_bit_eq_div add: drop_bit_nat_eq drop_bit_take_bit)
   done
 
 lemma shiftr_less_t2n':
   "\<lbrakk> x AND 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] flip: take_bit_eq_mask)
   apply transfer
   apply (simp add: take_bit_drop_bit ac_simps)
   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 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] flip: take_bit_eq_mask)
   apply transfer
   apply (simp add: take_bit_push_bit)
   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 scast_bit_test [simp]:
   "scast ((1 :: 'a::len signed word) << n) = (1 :: 'a word) << n"
   by word_eqI
 
 lemma signed_shift_guard_to_word:
   \<open>unat x * 2 ^ y < 2 ^ n \<longleftrightarrow> x = 0 \<or> x < 1 << n >> y\<close>
     if \<open>n < LENGTH('a)\<close> \<open>0 < n\<close>
     for x :: \<open>'a::len word\<close>
 proof (cases \<open>x = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then have \<open>unat x \<noteq> 0\<close>
     by (simp add: unat_eq_0)
   then have \<open>unat x \<ge> 1\<close>
     by simp
   show ?thesis
   proof (cases \<open>y < n\<close>)
     case False
     then have \<open>n \<le> y\<close>
       by simp
     then obtain q where \<open>y = n + q\<close>
       using le_Suc_ex by blast
     moreover have \<open>(2 :: nat) ^ n >> n + q \<le> 1\<close>
       by (simp add: drop_bit_eq_div power_add shiftr_def)
     ultimately show ?thesis
       using \<open>x \<noteq> 0\<close> \<open>unat x \<ge> 1\<close> \<open>n < LENGTH('a)\<close>
       by (simp add: power_add not_less word_le_nat_alt unat_drop_bit_eq shiftr_def shiftl_def)
   next
     case True
     with that have \<open>y < LENGTH('a)\<close>
       by simp
     show ?thesis
     proof (cases \<open>2 ^ n = unat x * 2 ^ y\<close>)
       case True
       moreover have \<open>unat x * 2 ^ y < 2 ^ LENGTH('a)\<close>
         using \<open>n < LENGTH('a)\<close> by (simp flip: True)
       moreover have \<open>(word_of_nat (2 ^ n) :: 'a word) = word_of_nat (unat x * 2 ^ y)\<close>
         using True by simp
       then have \<open>2 ^ n = x * 2 ^ y\<close>
         by simp
       ultimately show ?thesis
         using \<open>y < LENGTH('a)\<close>
         by (auto simp add: drop_bit_eq_div word_less_nat_alt unat_div unat_word_ariths
           shiftr_def shiftl_def)
     next
       case False
       with \<open>y < n\<close> have *: \<open>unat x \<noteq> 2 ^ n div 2 ^ y\<close>
         by (auto simp flip: power_sub power_add)
       have \<open>unat x * 2 ^ y < 2 ^ n \<longleftrightarrow> unat x * 2 ^ y \<le> 2 ^ n\<close>
         using False by (simp add: less_le)
       also have \<open>\<dots> \<longleftrightarrow> unat x \<le> 2 ^ n div 2 ^ y\<close>
         by (simp add: less_eq_div_iff_mult_less_eq)
       also have \<open>\<dots> \<longleftrightarrow> unat x < 2 ^ n div 2 ^ y\<close>
         using * by (simp add: less_le)
       finally show ?thesis
       using that \<open>x \<noteq> 0\<close> by (simp flip: push_bit_eq_mult drop_bit_eq_div
         add: shiftr_def shiftl_def unat_drop_bit_eq word_less_iff_unsigned [where ?'a = nat])
     qed
   qed
 qed
 
 lemma shiftr_not_mask_0:
   "n+m \<ge> LENGTH('a :: len) \<Longrightarrow> ((w::'a::len word) >> n) AND NOT (mask m) = 0"
   by word_eqI
 
 lemma shiftl_mask_is_0[simp]:
   "(x << n) AND mask n = 0"
   for x :: \<open>'a::len word\<close>
   by (simp flip: take_bit_eq_mask add: take_bit_push_bit shiftl_def)
 
 lemma rshift_sub_mask_eq:
   "(a >> (size a - b)) AND mask b = a >> (size a - b)"
   for a :: \<open>'a::len word\<close>
   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_eq_decr_exp word_size
                    p2_eq_0[THEN iffD2])
   done
 
 lemma shiftl_shiftr3:
   "b \<le> c \<Longrightarrow> a << b >> c = (a >> c - b) AND mask (size a - c)"
   for a :: \<open>'a::len word\<close>
   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 AND mask m) >> n = (w >> n) AND mask (m-n)"
   for w :: \<open>'a::len word\<close>
   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 AND mask m) << n = (w << n) AND mask (m+n)"
   for w :: \<open>'a::len word\<close>
   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"
   for x :: \<open>'a::len word\<close>
   by (simp add: le_mask_iff shiftl_shiftr3)
 
 lemma word_and_1_shiftl:
   "x AND (1 << n) = (if bit 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 AND (mask n << m) = ((x >> m) AND mask n) << m"
   for x :: \<open>'a::len word\<close>
   by word_eqI_solve
 
 lemma shift_times_fold:
   "(x :: 'a :: len word) * (2 ^ n) << m = x << (m + n)"
   by (simp add: shiftl_t2n ac_simps power_add)
 
 lemma of_bool_nth:
   "of_bool (bit x v) = (x >> v) AND 1"
   for x :: \<open>'a::len word\<close>
   by (simp add: bit_iff_odd_drop_bit word_and_1 shiftr_def)
 
 lemma shiftr_mask_eq:
   "(x >> n) AND mask (size x - n) = x >> n" for x :: "'a :: len word"
   by (word_eqI_solve dest: test_bit_lenD)
 
 lemma shiftr_mask_eq':
   "m = (size x - n) \<Longrightarrow> (x >> n) AND mask m = x >> n" for x :: "'a :: len word"
   by (simp add: shiftr_mask_eq)
 
 lemma and_eq_0_is_nth:
   fixes x :: "'a :: len word"
   shows "y = 1 << n \<Longrightarrow> ((x AND y) = 0) = (\<not> (bit x n))"
   by (simp add: and_exp_eq_0_iff_not_bit shiftl_def)
 
 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 mask_shift_and_negate[simp]:"(w AND mask n << m) AND NOT (mask n << m) = 0"
   for w :: \<open>'a::len word\<close>
   by word_eqI
 
 (* 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 AND NOT (mask n << m) OR ((y AND mask n) << m)) AND NOT (mask n << m) = x AND NOT (mask n << m)"
   for x :: \<open>'a::len word\<close>
   by word_eqI_solve
 
 lemma bitfield_op_twice'':
   "\<lbrakk>NOT a = b << c; \<exists>x. b = mask x\<rbrakk> \<Longrightarrow> (x AND a OR (y AND b << c)) AND a = x AND a"
   for a b :: \<open>'a::len word\<close>
   by word_eqI_solve
 
 lemma shiftr1_unfold: "x div 2 = x >> 1"
   by (simp add: drop_bit_eq_div shiftr_def)
 
 lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
   by (simp add: drop_bit_eq_div shiftr_def)
 
 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 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 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 shiftr1_irrelevant_lsb: "bit (x::('a::len) word) 0 \<or> x >> 1 = (x + 1) >> 1"
-  apply (cases \<open>LENGTH('a)\<close>; transfer)
-   apply (simp_all add: take_bit_drop_bit)
-  apply (simp add: drop_bit_take_bit drop_bit_Suc)
-  done
+  by (auto simp add: bit_0 shiftr_def drop_bit_Suc ac_simps elim: evenE)
 
 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> (bit (x::('a::len) word) 0) \<Longrightarrow> x >> 1 = (x + 1) >> 1"
-  by (metis shiftr1_irrelevant_lsb)
+  using shiftr1_irrelevant_lsb [of x] by simp
 
 (* 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) OR (((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_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) OR
    (((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 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 less_mult_imp_div_less)
 
 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
 
 (* negating a mask which has been shifted to the very left *)
 lemma NOT_mask_shifted_lenword:
   "NOT (mask len << (LENGTH('a) - len) ::'a::len word) = mask (LENGTH('a) - len)"
   by word_eqI_solve
 
 (* Comparisons between different word sizes. *)
 
 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 AND w' \<noteq> 0 \<Longrightarrow> w \<noteq> 0 \<and> w' \<noteq> 0"
   by auto
 
 lemma shiftr_le_0:
   "unat (w::'a::len word) < 2 ^ n \<Longrightarrow> w >> n = (0::'a::len word)"
   by (auto simp add: take_bit_word_eq_self_iff word_less_nat_alt shiftr_def
     simp flip: take_bit_eq_self_iff_drop_bit_eq_0 intro: ccontr)
 
 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)
 
 (* continue sorting out from here *)
 
 (* 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 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_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 :: 'a::len word) ^ n + mask n"
   by (simp add: mask_eq_decr_exp)
 
 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 AND b = 0"
   by (metis and_zero_eq is_aligned_mask le_mask_imp_and_mask word_bw_lcs(1))
 
 lemma word_and_or_mask_aligned:
   "\<lbrakk> is_aligned a n; b \<le> mask n \<rbrakk> \<Longrightarrow> a + b = a OR 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 OR 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 (simp add: bit_ucast_iff is_aligned_nth)
 
 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"
   apply (simp add: less_eq_mask_iff_take_bit_eq_self)
   apply transfer
   apply (simp add: ac_simps)
   done
 
 lemma shiftl_inj:
   \<open>x = y\<close>
     if \<open>x << n = y << n\<close> \<open>x \<le> mask (LENGTH('a) - n)\<close> \<open>y \<le> mask (LENGTH('a) - n)\<close>
     for x y :: \<open>'a::len word\<close>
 proof (cases \<open>n < LENGTH('a)\<close>)
   case False
   with that show ?thesis
     by simp
 next
   case True
   moreover from that have \<open>take_bit (LENGTH('a) - n) x = x\<close> \<open>take_bit (LENGTH('a) - n) y = y\<close>
     by (simp_all add: less_eq_mask_iff_take_bit_eq_self)
   ultimately show ?thesis
     using \<open>x << n = y << n\<close> by (metis diff_less gr_implies_not0 linorder_cases linorder_not_le shiftl_shiftr_id shiftl_x_0 take_bit_word_eq_self_iff)
 qed
 
 lemma distinct_word_add_ucast_shift_inj:
   \<open>p' = p \<and> off' = off\<close>
   if *: \<open>p + (UCAST('a::len \<rightarrow> 'b::len) off << n) = p' + (ucast off' << n)\<close>
     and \<open>is_aligned p n'\<close> \<open>is_aligned p' n'\<close> \<open>n' = n + LENGTH('a)\<close> \<open>n' < LENGTH('b)\<close>
 proof -
   from \<open>n' = n + LENGTH('a)\<close>
   have [simp]: \<open>n' - n = LENGTH('a)\<close> \<open>n + LENGTH('a) = n'\<close>
     by simp_all
   from \<open>is_aligned p n'\<close> obtain q
     where p: \<open>p = push_bit n' (word_of_nat q)\<close> \<open>q < 2 ^ (LENGTH('b) - n')\<close>
     by (rule is_alignedE')
   from \<open>is_aligned p' n'\<close> obtain q'
     where p': \<open>p' = push_bit n' (word_of_nat q')\<close> \<open>q' < 2 ^ (LENGTH('b) - n')\<close>
     by (rule is_alignedE')
   define m :: nat where \<open>m = unat off\<close>
   then have off: \<open>off = word_of_nat m\<close>
     by simp
   define m' :: nat where \<open>m' = unat off'\<close>
   then have off': \<open>off' = word_of_nat m'\<close>
     by simp
   have \<open>push_bit n' q + take_bit n' (push_bit n m) < 2 ^ LENGTH('b)\<close>
     by (metis id_apply is_aligned_no_wrap''' of_nat_eq_id of_nat_push_bit p(1) p(2) take_bit_nat_eq_self_iff take_bit_nat_less_exp take_bit_push_bit that(2) that(5) unsigned_of_nat)
   moreover have \<open>push_bit n' q' + take_bit n' (push_bit n m') < 2 ^ LENGTH('b)\<close>
     by (metis \<open>n' - n = LENGTH('a)\<close> id_apply is_aligned_no_wrap''' m'_def of_nat_eq_id of_nat_push_bit off' p'(1) p'(2) take_bit_nat_eq_self_iff take_bit_push_bit that(3) that(5) unsigned_of_nat)
   ultimately have \<open>push_bit n' q + take_bit n' (push_bit n m) = push_bit n' q' + take_bit n' (push_bit n m')\<close>
     using * by (simp add: p p' off off' push_bit_of_nat push_bit_take_bit word_of_nat_inj unsigned_of_nat shiftl_def flip: of_nat_add)
   then have \<open>int (push_bit n' q + take_bit n' (push_bit n m))
     = int (push_bit n' q' + take_bit n' (push_bit n m'))\<close>
     by simp
   then have \<open>concat_bit n' (int (push_bit n m)) (int q)
     = concat_bit n' (int (push_bit n m')) (int q')\<close>
     by (simp add: of_nat_push_bit of_nat_take_bit concat_bit_eq)
   then show ?thesis
     by (simp add: p p' off off' take_bit_of_nat take_bit_push_bit word_of_nat_eq_iff concat_bit_eq_iff)
       (simp add: push_bit_eq_mult)
 qed
 
 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 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 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:
   \<open>(x + y * m) AND NOT(mask n) = (x AND NOT(mask n)) + y * m\<close>
   if \<open>m AND (2 ^ n - 1) = 0\<close>
   for x y m :: \<open>'a::len word\<close>
   by (metis (no_types, opaque_lifting)
             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: of_nat_diff 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 AND mask n = 0 \<Longrightarrow> x + y AND NOT(mask n) = (x AND NOT(mask n)) + y"
   for x y :: \<open>'a::len word\<close>
   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 dest: bit_imp_le_length)
 
 lemma add_right_shift:
   "\<lbrakk> x AND mask n = 0; y AND 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_iff_dvd_nat)
   done
 
 lemma sub_right_shift:
   "\<lbrakk> x AND mask n = 0; y AND 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 AND mask n = mask n \<Longrightarrow> (x AND y) AND mask n = x AND mask n"
   by (simp add: ac_simps)
 
 lemma and_and_mask_simple_not:
   "y AND mask n = 0 \<Longrightarrow> (x AND y) AND mask n = 0"
   by (simp add: ac_simps)
 
 lemma word_and_le':
   "b \<le> c \<Longrightarrow> (a :: 'a :: len word) AND b \<le> c"
   by (metis word_and_le1 order_trans)
 
 lemma word_and_less':
   "b < c \<Longrightarrow> (a :: 'a :: len word) AND b < c"
   by transfer simp
 
 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 unsigned_uminus1 [simp]:
   \<open>(unsigned (-1::'b::len word)::'c::len word) = mask LENGTH('b)\<close>
   by (fact unsigned_minus_1_eq_mask)
 
 lemma ucast_ucast_mask_eq:
   "\<lbrakk> UCAST('a::len \<rightarrow> 'b::len) x = y; x AND mask LENGTH('b) = x \<rbrakk> \<Longrightarrow> x = ucast y"
   by (drule sym) (simp flip: take_bit_eq_mask add: unsigned_ucast_eq)
 
 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 (simp add: word_eq_iff bit_simps)
 
 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 AND mask n = 0; m \<le> n \<rbrakk> \<Longrightarrow> x AND mask m = 0"
   for x :: \<open>'a::len word\<close>
   by (metis mask_twice2 word_and_notzeroD)
 
 lemma mask_len_id [simp]:
   "(x :: 'a :: len word) AND 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) AND 1 = x \<rbrakk> \<Longrightarrow> x = 0 \<or> x = 1"
   by (metis word_and_1)
 
 lemma shiftr_and_eq_shiftl:
   "(w >> n) AND x = y \<Longrightarrow> w AND (x << n) = (y << n)" for y :: "'a:: len word"
   apply (drule sym)
   apply simp
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   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> bit p n' \<rbrakk>
    \<Longrightarrow> x + p AND NOT(mask n) = x"
   using add_mask_lower_bits by auto
 
 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 ac_simps)
 
 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 (simp add: word_le_nat_alt unsigned_of_nat take_bit_nat_eq_self)
 
 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 AND NOT(mask sz)) + 2 ^ sz - 1"
   for x :: \<open>'a::len word\<close>
   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))"
   by transfer (simp add: take_bit_add)
 
 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, opaque_lifting) 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) AND (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) AND mask m) = unat (x AND mask m)"
   by (metis ucast_and_mask unat_ucast_up_simp)
 
 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_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"
   apply transfer
   apply (simp add: take_bit_drop_bit)
   apply (simp add: drop_bit_take_bit)
   apply (rule order_trans)
    defer
    apply assumption
   apply (simp add: nat_le_iff of_nat_diff)
   done
 
 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"
   apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps dest: bit_imp_le_length)
   done
 
 lemma of_int_uint_ucast:
    "of_int (uint (x :: 'a::len word)) = (ucast x :: 'b::len word)"
   by (fact Word.of_int_uint)
 
 lemma mod_mask_drop:
   "\<lbrakk> m = 2 ^ n; 0 < m; mask n AND msk = mask n \<rbrakk>
    \<Longrightarrow> (x mod m) AND msk = x mod m"
   for x :: \<open>'a::len word\<close>
   by (simp add: word_mod_2p_is_mask word_bw_assocs)
 
 lemma mask_eq_ucast_eq:
   "\<lbrakk> x AND 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 AND NOT(mask n :: 'a::len word)"
   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 AND NOT(mask sz')) - (ptr AND NOT(mask sz)) \<le> 2 ^ sz - 2 ^ sz'"
   (is "_ \<Longrightarrow> ?lhs \<le> ?rhs")
   for ptr :: \<open>'a::len word\<close>
 proof -
   assume lt: "sz' \<le> sz"
   hence "?lhs = ptr AND (mask sz AND NOT(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_out_eq_0:
   "\<lbrakk> idx < 2 ^ sz; sz < LENGTH('a) \<rbrakk> \<Longrightarrow> (of_nat idx :: 'a :: len word) AND NOT(mask sz) = 0"
   by (simp add: of_nat_power less_mask_eq mask_eq_0_eq_x)
 
 lemma is_aligned_neg_mask_eq':
   "is_aligned ptr sz = (ptr AND NOT(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) AND NOT(mask sz)) + unat (ptr AND 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:
   \<open>unat (x << n) < 2 ^ m\<close>
   if \<open>unat (x :: 'a :: len word) < 2 ^ (m - n)\<close> \<open>m < LENGTH('a)\<close>
 proof (cases \<open>n \<le> m\<close>)
   case False
   with that show ?thesis
     apply (transfer fixing: m n)
     apply (simp add: not_le take_bit_push_bit)
     apply (metis diff_le_self order_le_less_trans push_bit_of_0 take_bit_0 take_bit_int_eq_self
       take_bit_int_less_exp take_bit_nonnegative take_bit_tightened)
     done
 next
   case True
   moreover define q r where \<open>q = m - n\<close> and \<open>r = LENGTH('a) - n - q\<close>
   ultimately have \<open>m - n = q\<close> \<open>m = n + q\<close> \<open>LENGTH('a) = r + q + n\<close>
     using that by simp_all
   with that show ?thesis
     apply (transfer fixing: m n q r)
     apply (simp add: not_le take_bit_push_bit)
     apply (simp add: push_bit_eq_mult power_add)
     using take_bit_tightened_less_eq_int [of \<open>r + q\<close> \<open>r + q + n\<close>]
     apply (rule le_less_trans)
      apply simp_all
     done
 qed
 
 lemma unat_is_aligned_add:
   "\<lbrakk> is_aligned p n; unat d < 2 ^ n \<rbrakk>
    \<Longrightarrow> unat (p + d AND mask n) = unat d \<and> unat (p + d AND NOT(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) AND NOT(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) AND mask high_bits = x >> low_bits"
   for x :: \<open>'a::len word\<close>
   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 AND mask low_bits = 0) = (x = 0)"
   for x :: \<open>'a::len word\<close>
   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) AND mask n = q AND 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 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) AND mask sz) + unat z < 2 ^ sz; sz < LENGTH('a) \<rbrakk>
    \<Longrightarrow> x \<le> x + z"
   apply (subgoal_tac "(x AND NOT(mask sz)) + (x AND mask sz) \<le> (x AND NOT(mask sz)) + ((x AND 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 of_nat_power is_aligned_no_wrap' by force
 
 lemma mul_not_mask_eq_neg_shiftl:
   "NOT(mask n :: 'a::len word) = -1 << n"
   by (simp add: NOT_mask shiftl_t2n)
 
 lemma shiftr_mul_not_mask_eq_and_not_mask:
   "(x >> n) * NOT(mask n) = - (x AND NOT(mask n))"
   for x :: \<open>'a::len word\<close>
   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) AND NOT(mask n) = p + (x AND NOT(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) AND NOT(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) AND mask (m::nat) = (mask (min m n) :: 'a::len word)"
   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)
 
 lemma plus_mask_AND_NOT_mask_eq:
   "x AND NOT(mask n) = x \<Longrightarrow> (x + mask n) AND NOT(mask n) = x" for x::\<open>'a::len word\<close>
   apply (subst word_plus_and_or_coroll; word_eqI; fastforce?)
   apply (erule allE, drule (1) iffD2)
   apply clarsimp
   done
 
 lemmas unat_ucast_mask = unat_ucast_eq_unat_and_mask[where w=a for a]
 
 lemma t2n_mask_eq_if:
   "2 ^ n AND mask m = (if n < m then 2 ^ n else (0 :: 'a::len word))"
   by word_eqI_solve
 
 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 (- 1 :: '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 AND mask a >> b) :: 'a :: len word) = p AND 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 AND mask a >> b) :: 'a :: len word) = unat (p AND mask a >> b)"
   by (metis linear ucast_ucast_mask_shift unat_ucast_up_simp)
 
 lemma mask_overlap_zero:
   "a \<le> b \<Longrightarrow> (p AND mask a) AND NOT(mask b) = 0"
   for p :: \<open>'a::len word\<close>
   by (metis NOT_mask_AND_mask mask_lower_twice2 max_def)
 
 lemma mask_shifl_overlap_zero:
   "a + c \<le> b \<Longrightarrow> (p AND mask a << c) AND NOT(mask b) = 0"
   for p :: \<open>'a::len word\<close>
   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 AND NOT(mask a)) AND mask b = 0"
   for p :: \<open>'a::len word\<close>
   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 AND NOT(mask a)) + ((p AND mask a) AND NOT(mask b)) + (p AND mask b) = p"
   for p :: \<open>'a::len word\<close>
   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 AND mask a >> b << b) = (p AND mask a) AND NOT(mask b)"
   for p :: \<open>'a::len word\<close>
   by (simp add: and_not_mask)
 
 lemma mask_shift_sum:
   "\<lbrakk> a \<ge> b; unat n = unat (p AND mask b) \<rbrakk>
    \<Longrightarrow> (p AND NOT(mask a)) + (p AND mask a >> b) * (1 << b) + n = (p :: 'a :: len word)"
   apply (simp add: shiftl_def shiftr_def flip: push_bit_eq_mult take_bit_eq_mask word_unat_eq_iff)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps)
   apply (subst disjunctive_add)
    apply (auto simp add: bit_simps)
     apply (rule bit_word_eqI)
   apply (auto simp add: bit_simps)
   done
 
 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 (fact Word.of_int_sint)
 
 lemma scast_of_nat_to_signed [simp]:
   "scast (of_nat x :: 'a :: len word) = (of_nat x :: 'a signed word)"
   by (rule bit_word_eqI) (simp add: bit_simps)
 
 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 AND mask n \<in> of_nat ` set [0 ..< 2 ^ n]"
   apply (simp flip: take_bit_eq_mask)
   apply (rule image_eqI [of _ _ \<open>unat (take_bit n x)\<close>])
   using len apply simp_all
   apply transfer
   apply simp
   done
 
 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 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 (smt (z3) eq_or_less_helperD le_add2 le_eq_less_or_eq le_trans power_add unat_mult_lem unat_pow_le_intro unat_power_lower word_eq_unatI)
 
 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 AND mask (size w - n)"
   for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (auto simp add: bit_simps 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: shiftl_def minus_exp_eq_not_mask)
 
 lemma ucast_eq_mask:
   "(UCAST('a::len \<rightarrow> 'b::len) x = UCAST('a \<rightarrow> 'b) y) =
    (x AND mask LENGTH('b) = y AND mask LENGTH('b))"
   by transfer (simp flip: take_bit_eq_mask add: ac_simps)
 
 context
   fixes w :: "'a::len word"
 begin
 
 private lemma sbintrunc_uint_ucast:
   "Suc n = LENGTH('b::len) \<Longrightarrow> signed_take_bit n (uint (ucast w :: 'b word)) = signed_take_bit n (uint w)"
   by word_eqI
 
 private lemma test_bit_sbintrunc:
   assumes "i < LENGTH('a)"
   shows "bit (word_of_int (signed_take_bit n (uint w)) :: 'a word) i
            = (if n < i then bit w n else bit w i)"
   using assms by (simp add: bit_simps)
 
 private lemma test_bit_sbintrunc_ucast:
   assumes len_a: "i < LENGTH('a)"
   shows "bit (word_of_int (signed_take_bit (LENGTH('b) - 1) (uint (ucast w :: 'b word))) :: 'a word) i
           = (if LENGTH('b::len) \<le> i then bit w (LENGTH('b) - 1) else bit w i)"
   using len_a by (auto simp add: sbintrunc_uint_ucast bit_simps)
 
 lemma scast_ucast_high_bits:
   \<open>scast (ucast w :: 'b::len word) = w
      \<longleftrightarrow> (\<forall> i \<in> {LENGTH('b) ..< size w}. bit w i = bit w (LENGTH('b) - 1))\<close>
 proof (cases \<open>LENGTH('a) \<le> LENGTH('b)\<close>)
   case True
   moreover define m where \<open>m = LENGTH('b) - LENGTH('a)\<close>
   ultimately have \<open>LENGTH('b) = m + LENGTH('a)\<close>
     by simp
   then show ?thesis
     by (simp add: signed_ucast_eq word_size) word_eqI
 next
   case False
   define q where \<open>q = LENGTH('b) - 1\<close>
   then have \<open>LENGTH('b) = Suc q\<close>
     by simp
   moreover define m where \<open>m = Suc LENGTH('a) - LENGTH('b)\<close>
   with False \<open>LENGTH('b) = Suc q\<close> have \<open>LENGTH('a) = m + q\<close>
     by (simp add: not_le)
   ultimately show ?thesis
     apply (simp add: signed_ucast_eq word_size)
     apply (transfer fixing: m q)
     apply (simp add: signed_take_bit_take_bit)
     apply (rule impI)
     apply (subst bit_eq_iff)
     apply (simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def)
     apply (auto simp add: Suc_le_eq)
     using less_imp_le_nat apply blast
     using less_imp_le_nat apply blast
     done
 qed
 
 lemma scast_ucast_mask_compare:
   "scast (ucast w :: 'b::len word) = w
    \<longleftrightarrow> (w \<le> mask (LENGTH('b) - 1) \<or> NOT(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 AND mask LENGTH('b))"
   by word_eqI_solve
 
 lemma ucast_NOT:
   "ucast (NOT x) = NOT(ucast x) AND mask (LENGTH('a))" for x::"'a::len word"
   by word_eqI_solve
 
 lemma ucast_NOT_down:
   "is_down UCAST('a::len \<rightarrow> 'b::len) \<Longrightarrow> UCAST('a \<rightarrow> 'b) (NOT x) = NOT(UCAST('a \<rightarrow> 'b) x)"
   by word_eqI
 
 lemma upto_enum_step_shift:
   "is_aligned p n \<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 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 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 (simp only: ucast_eq)
   apply (subst lift_M)
   apply (subst of_int_uint [symmetric], subst lift_M')
   apply (metis local.distrib local.is_down take_bit_eq_mod ucast_down_wi uint_word_of_int_eq word_of_int_uint)
   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_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_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_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_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_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_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_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_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 (simp only: 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_wi scast_down_wi
   ucast_of_nat scast_of_nat
   uint_up_ucast sint_up_scast
   up_scast_surj up_ucast_surj
 
 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)
 
   let ?range = \<open>{- (2 ^ (size a - 1))..<2 ^ (size a - 1)} :: int set\<close>
 
   have result_range: "sint a sdiv sint b \<in> ?range \<union> {2 ^ (size a - 1)}"
     using sdiv_word_min [of a b] sdiv_word_max [of a b] by auto
 
   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: signed_divide_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 auto
     apply (cases \<open>size a\<close>)
      apply simp_all
     apply (smt (z3) One_nat_def diff_Suc_1 signed_word_eqI sint_int_min sint_range_size wsst_TYs(3))
     done
 
   have result_range_simple: "(sint a sdiv sint b \<in> ?range) \<Longrightarrow> ?thesis"
     apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
     apply (clarsimp simp: word_size 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]
 
 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 signed_take_bit_int_eq_self_iff intro: sym dest: sym)
 
 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 nasty_split_lt:
   \<open>x * 2 ^ n + (2 ^ n - 1) \<le> 2 ^ m - 1\<close>
     if \<open>x < 2 ^ (m - n)\<close> \<open>n \<le> m\<close> \<open>m < LENGTH('a::len)\<close>
     for x :: \<open>'a::len word\<close>
 proof -
   define q where \<open>q = m - n\<close>
   with \<open>n \<le> m\<close> have \<open>m = q + n\<close>
     by simp
   with \<open>x < 2 ^ (m - n)\<close> have *: \<open>i < q\<close> if \<open>bit x i\<close> for i
     using that by simp (metis bit_take_bit_iff take_bit_word_eq_self_iff)
   from \<open>m = q + n\<close> have \<open>push_bit n x OR mask n \<le> mask m\<close>
     by (auto simp add: le_mask_high_bits word_size bit_simps dest!: *)
   then have \<open>push_bit n x + mask n \<le> mask m\<close>
     by (simp add: disjunctive_add bit_simps)
   then show ?thesis
     by (simp add: mask_eq_exp_minus_1 push_bit_eq_mult)
 qed
 
 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
 
 end
 
 end