# Theory Word_Lemmas

```(*
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
*
*)

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
Boolean_Inequalities
Word_EqI
begin

context
includes bit_operations_syntax
begin

lemma word_max_le_or:
"max x y ≤ x OR y" for x :: "'a::len word"

lemma word_and_le_min:
"x AND y ≤ min x y" for x :: "'a::len word"

lemma word_not_le_eq:
"(NOT x ≤ y) = (NOT y ≤ x)" for x :: "'a::len word"

lemma word_not_le_not_eq[simp]:
"(NOT y ≤ NOT x) = (x ≤ y)" for x :: "'a::len word"
by (subst word_not_le_eq) simp

lemma not_min_eq:
"NOT (min x y) = max (NOT x) (NOT y)" for x :: "'a::len word"
unfolding min_def max_def
by auto

lemma not_max_eq:
"NOT (max x y) = min (NOT x) (NOT y)" for x :: "'a::len word"
unfolding min_def max_def
by auto

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 → 'b) x ≤ UCAST('a → 'b) y) = (x ≤ y)"
apply (rule iffI)
apply (cases "LENGTH('b) < LENGTH('a)")
apply (unfold n)
apply (erule ucast_mono_le[OF _ y[unfolded n]])
done

lemma ucast_zero_is_aligned:
‹is_aligned w n› if ‹UCAST('a::len → 'b::len) w = 0› ‹n ≤ LENGTH('b)›
proof (rule is_aligned_bitI)
fix q
assume ‹q < n›
moreover have ‹bit (UCAST('a::len → 'b::len) w) q = bit 0 q›
using that by simp
with ‹q < n› ‹n ≤ LENGTH('b)› show ‹¬ bit w q›
qed

"unat (UCAST('b::len → 'a::len) w) = unat (w AND mask LENGTH('a))"
apply transfer
done

lemma le_max_word_ucast_id:
‹UCAST('b → 'a) (UCAST('a → 'b) x) = x›
if ‹x ≤ UCAST('b::len → 'a) (- 1)›
for x :: ‹'a::len word›
proof -
from that have a1: ‹x ≤ word_of_int (uint (word_of_int (2 ^ LENGTH('b) - 1) :: 'b word))›
have f2: "((∃i ia. (0::int) ≤ i ∧ ¬ 0 ≤ i + - 1 * ia ∧ i mod ia ≠ i) ∨
¬ (0::int) ≤ - 1 + 2 ^ LENGTH('b) ∨ (0::int) ≤ - 1 + 2 ^ LENGTH('b) + - 1 * 2 ^ LENGTH('b) ∨
(- (1::int) + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b) =
- 1 + 2 ^ LENGTH('b)) = ((∃i ia. (0::int) ≤ i ∧ ¬ 0 ≤ i + - 1 * ia ∧ i mod ia ≠ i) ∨
¬ (1::int) ≤ 2 ^ LENGTH('b) ∨
2 ^ LENGTH('b) + - (1::int) * ((- 1 + 2 ^ LENGTH('b)) mod 2 ^ LENGTH('b)) = 1)"
by force
have f3: "∀i ia. ¬ (0::int) ≤ i ∨ 0 ≤ i + - 1 * ia ∨ i mod ia = i"
using mod_pos_pos_trivial by force
have "(1::int) ≤ 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 ≤ 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 "∀x0 x1. (x1::int) - x0 = x1 + - 1 * x0"
by force
then have "x ≤ 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 ‹uint x ≤ uint (2 ^ LENGTH('b) - (1 :: 'a word))›
then have ‹uint x ≤ 2 ^ LENGTH('b) - 1›
(metis ‹1 ≤ 2 ^ LENGTH('b)› ‹uint x ≤ uint (2 ^ LENGTH('b) - 1)› linorder_not_less lt2p_lem uint_1 uint_minus_simple_alt uint_power_lower word_le_def zle_diff1_eq)
then show ?thesis
apply (meson ‹x ≤ 2 ^ LENGTH('b) - 1› not_le word_less_sub_le)
done
qed

lemma uint_shiftr_eq:
‹uint (w >> n) = uint w div 2 ^ n›
by word_eqI

lemma bit_shiftl_word_iff [bit_simps]:
‹bit (w << m) n ⟷ m ≤ n ∧ n < LENGTH('a) ∧ bit w (n - m)›
for w :: ‹'a::len word›

lemma bit_shiftr_word_iff:
‹bit (w >> m) n ⟷ bit w (m + n)›
for w :: ‹'a::len word›

lemma uint_sshiftr_eq:
‹uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^  n)›
for w :: ‹'a::len word›
by (word_eqI_solve dest: test_bit_lenD)

lemma sshiftr_n1: "-1 >>> n = -1"

lemma nth_sshiftr:
"bit (w >>> m) n = (n < size w ∧ (if n + m ≥ 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:
‹(numeral k >>> numeral n :: 'a::len word) =
word_of_int (signed_take_bit (LENGTH('a) - 1) (numeral k) >> numeral n)›
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 ‹n < LENGTH('a)›; fastforce simp: le_diff_conv2)

‹mask n = (1 << n) - (1 :: 'a::len word)›

lemma nth_shiftl': "bit (w << m) n ⟷ n < size w ∧ n >= m ∧ 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"

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)"

lemma shiftr_rev: "w >> n = word_reverse (word_reverse w << n)"

lemma rev_shiftr: "word_reverse w >> n = word_reverse (w << n)"

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 ≤ n ⟹ x << n = 0"
for x :: "'a::len word"

lemma shiftl_t2n: "shiftl w n = 2 ^ n * w"
for w :: "'a::len word"

lemma word_shift_by_2:
"x * 4 = (x::'a::len word) << 2"

lemma word_shift_by_3:
"x * 8 = (x::'a::len word) << 3"

lemma slice_shiftr: "slice n w = ucast (w >> n)"
by word_eqI (cases ‹n ≤ LENGTH('b)›; fastforce simp: ac_simps dest: bit_imp_le_length)

lemma shiftr_zero_size: "size x ≤ n ⟹ x >> n = 0"
for x :: "'a :: len word"
by word_eqI

lemma shiftr_x_0 [simp]: "x >> 0 = x"
for x :: "'a::len word"

lemma shiftl_x_0 [simp]: "x << 0 = x"
for x :: "'a::len word"

lemmas shiftl0 = shiftl_x_0

lemma shiftr_1 [simp]: "(1::'a::len word) >> n = (if n = 0 then 1 else 0)"

"w AND NOT (mask n) = (w >> n) << n"
for w :: ‹'a::len word›
by word_eqI_solve

"w AND mask n = (w << (size w - n)) >> (size w - n)"
for w :: ‹'a::len word›
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 ≤ v ⟹ u >> (n :: nat) ≤ (v :: 'a :: len word) >> n"
apply (unfold shiftr_def)
apply transfer
done

lemma le_shiftr':
"⟦ u >> n ≤ v >> n ; u >> n ≠ v >> n ⟧ ⟹ (u::'a::len word) ≤ v"
by (metis le_cases le_shiftr verit_la_disequality)

"n <= m ⟹ mask n >> m = (0 :: 'a::len word)"
by word_eqI

‹mask m >> m = (0::'a::len word)›

"(w ≤ mask n) = (w >> n = 0)"
for w :: ‹'a::len word›
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

"(w AND mask n = w) = (w >> n = 0)"
for w :: ‹'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)"

lemma shiftr_shiftr:
fixes a::"'a::len word"
shows "a >> b >> c = a >> (b + c)"

lemma shiftl_shiftr1:
fixes a::"'a::len word"
shows "c ≤ b ⟹ 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 ⟹ 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 ≤ b ⟹ 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 ⟹ 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

"n ≤ LENGTH('a) ⟹ (mask n >> m :: ('a :: len) word) = mask (n - m)"
by word_eqI_solve

fixes x :: "'a :: len word"
shows "(x + y) << n = (x << n) + (y << n)"

"(x AND NOT (mask y)) >> y = x >> y"
for x :: ‹'a::len word›
by word_eqI

lemma shiftr_div_2n':
"unat (w >> n) = unat w div 2 ^ n"
by word_eqI

lemma shiftl_shiftr_id:
"⟦ n < LENGTH('a); x < 2 ^ (LENGTH('a) - n) ⟧ ⟹ x << n >> n = (x::'a::len word)"

lemma ucast_shiftl_eq_0:
fixes w :: "'a :: len word"
shows "⟦ n ≥ LENGTH('b) ⟧ ⟹ ucast (w << n) = (0 :: 'b :: len word)"
by (transfer fixing: n) (simp add: take_bit_push_bit)

lemma word_shift_nonzero:
"⟦ (x::'a::len word) ≤ 2 ^ m; m + n < LENGTH('a::len); x ≠ 0⟧
⟹ x << n ≠ 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 (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':
"⟦ x AND mask (n + m) = x; m < LENGTH('a) ⟧ ⟹ x >> n < 2 ^ m" for x :: "'a :: len word"
apply transfer
done

lemma shiftr_less_t2n:
"x < 2 ^ (n + m) ⟹ x >> n < 2 ^ m" for x :: "'a :: len word"
apply (rule shiftr_less_t2n')
apply (rule ccontr)
apply (subst (asm) p2_eq_0[symmetric])
done

lemma shiftr_eq_0:
"n ≥ LENGTH('a) ⟹ ((w::'a::len word) >> n) = 0"
apply (cut_tac shiftr_less_t2n'[of w n 0], simp)
apply simp
done

lemma shiftl_less_t2n:
fixes x :: "'a :: len word"
shows "⟦ x < (2 ^ (m - n)); m < LENGTH('a) ⟧ ⟹ (x << n) < 2 ^ m"
apply transfer
done

lemma shiftl_less_t2n':
"(x::'a::len word) < 2 ^ m ⟹ m+n < LENGTH('a) ⟹ 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:
‹unat x * 2 ^ y < 2 ^ n ⟷ x = 0 ∨ x < 1 << n >> y›
if ‹n < LENGTH('a)› ‹0 < n›
for x :: ‹'a::len word›
proof (cases ‹x = 0›)
case True
then show ?thesis
by simp
next
case False
then have ‹unat x ≠ 0›
then have ‹unat x ≥ 1›
by simp
show ?thesis
proof (cases ‹y < n›)
case False
then have ‹n ≤ y›
by simp
then obtain q where ‹y = n + q›
using le_Suc_ex by blast
moreover have ‹(2 :: nat) ^ n >> n + q ≤ 1›
ultimately show ?thesis
using ‹x ≠ 0› ‹unat x ≥ 1› ‹n < LENGTH('a)›
next
case True
with that have ‹y < LENGTH('a)›
by simp
show ?thesis
proof (cases ‹2 ^ n = unat x * 2 ^ y›)
case True
moreover have ‹unat x * 2 ^ y < 2 ^ LENGTH('a)›
using ‹n < LENGTH('a)› by (simp flip: True)
moreover have ‹(word_of_nat (2 ^ n) :: 'a word) = word_of_nat (unat x * 2 ^ y)›
using True by simp
then have ‹2 ^ n = x * 2 ^ y›
by simp
ultimately show ?thesis
using ‹y < LENGTH('a)›
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 ‹y < n› have *: ‹unat x ≠ 2 ^ n div 2 ^ y›
by (auto simp flip: power_sub power_add)
have ‹unat x * 2 ^ y < 2 ^ n ⟷ unat x * 2 ^ y ≤ 2 ^ n›
using False by (simp add: less_le)
also have ‹… ⟷ unat x ≤ 2 ^ n div 2 ^ y›
also have ‹… ⟷ unat x < 2 ^ n div 2 ^ y›
using * by (simp add: less_le)
finally show ?thesis
using that ‹x ≠ 0› 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

"n+m ≥ LENGTH('a :: len) ⟹ ((w::'a::len word) >> n) AND NOT (mask m) = 0"
by word_eqI

"(x << n) AND mask n = 0"
for x :: ‹'a::len word›

"(a >> (size a - b)) AND mask b = a >> (size a - b)"
for a :: ‹'a::len word›
using shiftl_shiftr2[where a=a and b=0 and c="size a - b"]
apply (cases "b < size a")
apply simp
p2_eq_0[THEN iffD2])
done

lemma shiftl_shiftr3:
"b ≤ c ⟹ a << b >> c = (a >> c - b) AND mask (size a - c)"
for a :: ‹'a::len word›
apply (cases "b = c")
done

"m ≤ size w ⟹ (w AND mask m) >> n = (w >> n) AND mask (m-n)"
for w :: ‹'a::len word›

"m+n ≤ size w ⟹ (w AND mask m) << n = (w << n) AND mask (m+n)"
for w :: ‹'a::len word›

for x :: ‹'a::len word›

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]

"x AND (mask n << m) = ((x >> m) AND mask n) << m"
for x :: ‹'a::len word›
by word_eqI_solve

lemma shift_times_fold:
"(x :: 'a :: len word) * (2 ^ n) << m = x << (m + n)"

lemma of_bool_nth:
"of_bool (bit x v) = (x >> v) AND 1"
for x :: ‹'a::len word›
by (simp add: bit_iff_odd_drop_bit word_and_1 shiftr_def)

"(x >> n) AND mask (size x - n) = x >> n" for x :: "'a :: len word"
by (word_eqI_solve dest: test_bit_lenD)

"m = (size x - n) ⟹ (x >> n) AND mask m = x >> n" for x :: "'a :: len word"

lemma and_eq_0_is_nth:
fixes x :: "'a :: len word"
shows "y = 1 << n ⟹ ((x AND y) = 0) = (¬ (bit x n))"

lemma word_shift_zero:
"⟦ x << n = 0; x ≤ 2^m; m + n < LENGTH('a)⟧ ⟹ (x::'a::len word) = 0"
apply (rule ccontr)
apply (drule (2) word_shift_nonzero)
apply simp
done

for w :: ‹'a::len word›
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 :: ‹'a::len word›
by word_eqI_solve

lemma bitfield_op_twice'':
"⟦NOT a = b << c; ∃x. b = mask x⟧ ⟹ (x AND a OR (y AND b << c)) AND a = x AND a"
for a b :: ‹'a::len word›
by word_eqI_solve

lemma shiftr1_unfold: "x div 2 = x >> 1"

lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"

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 ≠ 0 ⟹ (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 ⟹ x = 0 ∨ x = 1"
apply (subst (asm) shiftr1_is_div_2)
apply (drule word_less_div)
apply (case_tac "LENGTH('a) = 1")
apply (erule disjE)
apply (subgoal_tac "(2::'a word) ≠ 0")
apply simp
apply (rule not_degenerate_imp_2_neq_0)
apply (subgoal_tac "LENGTH('a) ≠ 0")
apply arith
apply simp
apply (rule x_less_2_0_1', simp+)
done

lemma shiftr1_irrelevant_lsb: "bit (x::('a::len) word) 0 ∨ x >> 1 = (x + 1) >> 1"
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 ⟹ x = 0 ∨ x + 1 = 0"
by (metis One_nat_def shiftr1_0_or_1 word_less_1 word_overflow)

lemma shiftr1_irrelevant_lsb': "¬ (bit (x::('a::len) word) 0) ⟹ x >> 1 = (x + 1) >> 1"
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:
"⟦n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m⟧ ⟹
(((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 word_ao_dist2[symmetric])
apply clarsimp
apply (rule ucast_ucast_len)
apply (rule shiftr_less_t2n')
apply (metis add_diff_cancel_left' len_gt_0 mult_2_right zero_less_diff)
done

lemma cast_chunk_scast_assemble_id:
"⟦n = LENGTH('a::len); m = LENGTH('b::len); n * 2 = m⟧ ⟹
(((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 (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) ⟹ unat (x >> n) < 2 ^ m"

lemma ucast_less_shiftl_helper:
"⟦ LENGTH('b) + 2 < LENGTH('a); 2 ^ (LENGTH('b) + 2) ≤ n⟧
⟹ (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 *)
"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 ⟹ 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' ≠ 0 ⟹ w ≠ 0 ∧ w' ≠ 0"
by auto

lemma shiftr_le_0:
"unat (w::'a::len word) < 2 ^ n ⟹ 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) ⟹ (1::'a::len word) << n ≠ 0"

(* 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) ≤ 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) ⟷
(a ∈ {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 ⟹
a ∈ {base..base OR mask (LENGTH('a) - len)}"
apply(metis helper3 le_word_or2 word_bw_comms(1) word_bw_comms(2))
done
next
assume "a ∈ {base..base OR mask (LENGTH('a) - len)}"
hence a: "base ≤ a ∧ a ≤ base OR mask (LENGTH('a) - len)" by simp
show "base = NOT (mask (LENGTH('a) - len)) AND a"
proof -
have f2: "∀x⇩0. base AND NOT (mask x⇩0) ≤ a AND NOT (mask x⇩0)"
have f3: "∀x⇩0. a AND NOT (mask x⇩0) ≤ (base OR mask (LENGTH('a) - len)) AND NOT (mask x⇩0)"
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: "∀x⇩6. (base OR x⇩6) AND NOT (mask (LENGTH('a) - len)) =
base OR x⇩6 AND NOT (mask (LENGTH('a) - len))"
using word_ao_dist by (metis)
have f6: "∀x⇩2 x⇩3. a AND NOT (mask x⇩2) ≤ x⇩3 ∨
¬ (base OR mask (LENGTH('a) - len)) AND NOT (mask x⇩2) ≤ x⇩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))

"⟦ w + 2^n ≤ x; w + 2^n ≠ 0; is_aligned w n ⟧ ⟹ (w::'a::len word) < x"
by (blast dest: is_aligned_no_overflow le_less_trans word_leq_le_minus_one)

"mask (Suc n) = (2 :: 'a::len word) ^ n + mask n"

"sz' ≤ sz ⟹ mask sz' ≤ (mask sz :: 'a::len word)"

"⟦ is_aligned (a :: 'a :: len word) n; b ≤ mask n ⟧ ⟹ a AND b = 0"

"⟦ is_aligned a n; b ≤ mask n ⟧ ⟹ a + b = a OR b"

‹is_aligned b n ⟹ a ≤ mask n ⟹ a + b = a OR b›

lemma is_aligned_ucastI:
"is_aligned w n ⟹ is_aligned (ucast w) n"

"a ≤ mask n ⟹ UCAST('a::len → 'b::len) a ≤ mask n"

"⟦ a ≤ mask n; is_aligned b n ⟧ ⟹ UCAST ('a::len → 'b::len) (a + b) = ucast a + ucast b"

lemma ucast_shiftl:
"LENGTH('b) ≤ LENGTH ('a) ⟹ UCAST ('a::len → 'b::len) x << n = ucast (x << n)"
by word_eqI_solve

"LENGTH('a) ≤ n ⟹ ucast (x::'a::len word) ≤ mask n"
apply transfer
done

lemma shiftl_inj:
‹x = y›
if ‹x << n = y << n› ‹x ≤ mask (LENGTH('a) - n)› ‹y ≤ mask (LENGTH('a) - n)›
for x y :: ‹'a::len word›
proof (cases ‹n < LENGTH('a)›)
case False
with that show ?thesis
by simp
next
case True
moreover from that have ‹take_bit (LENGTH('a) - n) x = x› ‹take_bit (LENGTH('a) - n) y = y›
ultimately show ?thesis
using ‹x << n = y << n› 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

‹p' = p ∧ off' = off›
if *: ‹p + (UCAST('a::len → 'b::len) off << n) = p' + (ucast off' << n)›
and ‹is_aligned p n'› ‹is_aligned p' n'› ‹n' = n + LENGTH('a)› ‹n' < LENGTH('b)›
proof -
from ‹n' = n + LENGTH('a)›
have [simp]: ‹n' - n = LENGTH('a)› ‹n + LENGTH('a) = n'›
by simp_all
from ‹is_aligned p n'› obtain q
where p: ‹p = push_bit n' (word_of_nat q)› ‹q < 2 ^ (LENGTH('b) - n')›
by (rule is_alignedE')
from ‹is_aligned p' n'› obtain q'
where p': ‹p' = push_bit n' (word_of_nat q')› ‹q' < 2 ^ (LENGTH('b) - n')›
by (rule is_alignedE')
define m :: nat where ‹m = unat off›
then have off: ‹off = word_of_nat m›
by simp
define m' :: nat where ‹m' = unat off'›
then have off': ‹off' = word_of_nat m'›
by simp
have ‹push_bit n' q + take_bit n' (push_bit n m) < 2 ^ LENGTH('b)›
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 ‹push_bit n' q' + take_bit n' (push_bit n m') < 2 ^ LENGTH('b)›
by (metis ‹n' - n = LENGTH('a)› 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 ‹push_bit n' q + take_bit n' (push_bit n m) = push_bit n' q' + take_bit n' (push_bit n m')›
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 ‹int (push_bit n' q + take_bit n' (push_bit n m))
= int (push_bit n' q' + take_bit n' (push_bit n m'))›
by simp
then have ‹concat_bit n' (int (push_bit n m)) (int q)
= concat_bit n' (int (push_bit n m')) (int q')›
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)
qed

lemma word_upto_Nil:
"y < x ⟹ [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 ≤ a ∧ a ≤ y"
proof -
have "set as ⊆ set [x .e. y] ∧ a ∈ 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 ⟹ 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 (drule (1) dual_order.not_eq_order_implies_strict)
apply (case_tac "x < y")
prefer 2
apply (case_tac "x = y", simp)
apply (drule (1) dual_order.not_eq_order_implies_strict)
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 ⟹ a ∉ 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 ≤ a ∧ a ≤ y ∧ a ∉ set as ∧ (∀z ∈ set as. x ≤ z ∧ z ≤ y)"
proof -
from assms
have "set as ⊆ set [x .e. y] ∧ a ∈ set [x .e. y]"
by (auto dest: arg_cong[where f=set])
with word_enum_decomp_set[OF assms]
show ?thesis by auto
qed

"⟦of_nat (unat t) = w; t ≤ mask LENGTH('a)⟧ ⟹ t = UCAST('a::len → 'b::len) w"

lemma less_diff_gt0:
"a < b ⟹ (0 :: 'a :: len word) < b - a"
by unat_arith

lemma unat_plus_gt:
"unat ((a :: 'a :: len word) + b) ≤ unat a + unat b"
by (clarsimp simp: unat_plus_if_size)

lemma const_less:
"⟦ (a :: 'a :: len word) - 1 < b; a ≠ b ⟧ ⟹ a < b"
by (metis less_1_simp word_le_less_eq)

‹(x + y * m) AND NOT(mask n) = (x AND NOT(mask n)) + y * m›
if ‹m AND (2 ^ n - 1) = 0›
for x y m :: ‹'a::len word›
by (metis (no_types, opaque_lifting)

lemma unat_of_nat_minus_1:
"⟦ n < 2 ^ LENGTH('a); n ≠ 0 ⟧ ⟹ unat ((of_nat n:: 'a :: len word) - 1) = n - 1"

lemma word_eq_zeroI:
"a ≤ a - 1 ⟹ a = 0" for a :: "'a :: len word"

"(-1 :: 'a :: len  word) + b + c = b + (c - 1)"
by simp

lemma upto_enum_word_nth:
"⟦ i ≤ j; k ≤ unat (j - i) ⟧ ⟹ [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:
"⟦ a ≤ c; n ≤ unat ((c - a) div (b - a)) ⟧
⟹ [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 ⟹ [(0 :: 'a :: len word) .e. 1 + a] = [0 .e. a] @ [1 + a]"
apply (subgoal_tac "unat (1+a) = 1 + unat a")
apply simp
apply (subst unat_plus_simple[THEN iffD1])
apply unat_arith
done

"y AND mask n = 0 ⟹ x + y AND NOT(mask n) = (x AND NOT(mask n)) + y"
for x y :: ‹'a::len word›

lemma shiftr_shiftl_shiftr[simp]:
"(x :: 'a :: len word) >> a << a >> a = x >> a"
by (word_eqI_solve dest: bit_imp_le_length)

"⟦ x AND mask n = 0; y AND mask n = 0; x ≤ x + y ⟧
⟹ (x + y :: ('a :: len) word) >> n = (x >> n) + (y >> n)"
apply (simp add: unat_arith_simps shiftr_div_2n' split del: if_split)
apply (subst if_P)
apply (erule order_le_less_trans[rotated])
done

lemma sub_right_shift:
"⟦ x AND mask n = 0; y AND mask n = 0; y ≤ x ⟧
⟹ (x - y) >> n = (x >> n :: 'a :: len word) - (y >> n)"
using add_right_shift[where x="x - y" and y=y and n=n]

"y AND mask n = 0 ⟹ (x AND y) AND mask n = 0"

lemma word_and_le':
"b ≤ c ⟹ (a :: 'a :: len word) AND b ≤ c"
by (metis word_and_le1 order_trans)

lemma word_and_less':
"b < c ⟹ (a :: 'a :: len word) AND b < c"
by transfer simp

lemma shiftr_w2p:
"x < LENGTH('a) ⟹ 2 ^ x = (2 ^ (LENGTH('a) - 1) >> (LENGTH('a) - 1 - x) :: 'a :: len word)"
by word_eqI_solve

lemma t2p_shiftr:
"⟦ b ≤ a; a < LENGTH('a) ⟧ ⟹ (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]:
‹(unsigned (-1::'b::len word)::'c::len word) = mask LENGTH('b)›

"⟦ UCAST('a::len → 'b::len) x = y; x AND mask LENGTH('b) = x ⟧ ⟹ x = ucast y"

lemma ucast_up_eq:
"⟦ ucast x = (ucast y::'b::len word); LENGTH('a) ≤ LENGTH ('b) ⟧
⟹ ucast x = (ucast y::'a::len word)"

lemma ucast_up_neq:
"⟦ ucast x ≠ (ucast y::'b::len word); LENGTH('b) ≤ LENGTH ('a) ⟧
⟹ ucast x ≠ (ucast y::'a::len word)"
by (fastforce dest: ucast_up_eq)

"⟦ x AND mask n = 0; m ≤ n ⟧ ⟹ x AND mask m = 0"
for x :: ‹'a::len word›

"(x :: 'a :: len word) AND mask LENGTH('a) = x"

lemma scast_ucast_down_same:
"LENGTH('b) ≤ LENGTH('a) ⟹ SCAST('a → 'b) = UCAST('a::len → 'b::len)"

lemma word_aligned_0_sum:
"⟦ a + b = 0; is_aligned (a :: 'a :: len word) n; b ≤ mask n; n < LENGTH('a) ⟧
⟹ a = 0 ∧ b = 0"

"⟦ LENGTH('a) > 1; (x :: 'a :: len word) AND 1 = x ⟧ ⟹ x = 0 ∨ x = 1"
by (metis word_and_1)

lemma shiftr_and_eq_shiftl:
"(w >> n) AND x = y ⟹ w AND (x << n) = (y << n)" for y :: "'a:: len word"
apply (drule sym)
apply simp
apply (rule bit_word_eqI)
done

"⟦ len = LENGTH('a); is_aligned (x :: 'a :: len word) n;
∀n' ≥ n. n' < len ⟶ ¬ bit p n' ⟧
⟹ x + p AND NOT(mask n) = x"

"(x :: 'a :: len word) ≤ mask (low_bits + high_bits) ⟹ (x >> low_bits) ≤ mask high_bits"

"(x :: 'a :: len word) ≤ mask (low_bits + LENGTH('b))
⟹ ucast((ucast (x >> low_bits)) :: 'b :: len word) = x >> low_bits"
ucast_ucast_len)

lemma const_le_unat:
"⟦ b < 2 ^ LENGTH('a); of_nat b ≤ a ⟧ ⟹ b ≤ 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:
"⟦ x < 2 ^ LENGTH('a) - 1 ; n ≤ unat x ⟧
⟹ ([(0 :: 'a :: len word) .e. x] ! n) = of_nat n"
apply (induct x arbitrary: n)
apply simp

"x ≤ (x AND NOT(mask sz)) + 2 ^ sz - 1"
for x :: ‹'a::len word›

"ucast (a + (b :: 'a :: len word)) = ucast a + (ucast b :: ('a signed word))"

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"])
done

"scast (ucast (x :: 'a::len word) + (1 :: 'a signed word)) = x + 1"
apply (subst ucast_1[symmetric])
apply clarsimp
done

lemma word_and_le_plus_one:
"a > 0 ⟹ (x :: 'a :: len word) AND (a - 1) < a"

lemma unat_of_ucast_then_shift_eq_unat_of_shift[simp]:
"LENGTH('b) ≥ LENGTH('a)
⟹ unat ((ucast (x :: 'a :: len word) :: 'b :: len word) >> n) = unat (x >> n)"

"LENGTH('b) ≥ LENGTH('a)
⟹ unat ((ucast (x :: 'a :: len word) :: 'b :: len word) AND mask m) = unat (x AND mask m)"

lemma shiftr_less_t2n3:
"⟦ (2 :: 'a word) ^ (n + m) = 0; m < LENGTH('a) ⟧
⟹ (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:
"⟦ 2 ^ (LENGTH('a :: len) - n) - 1 ≤ bnd; 0 < n ⟧
⟹ unat ((x :: 'a word) >> n) ≤ bnd"
apply transfer
apply (rule order_trans)
defer
apply assumption
done

lemma shiftr_eqD:
"⟦ x >> n = y >> n; is_aligned x n; is_aligned y n ⟧
⟹ x = y"
by (metis is_aligned_shiftr_shiftl)

lemma word_shiftr_shiftl_shiftr_eq_shiftr:
"a ≥ b ⟹ (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)

"⟦ m = 2 ^ n; 0 < m; mask n AND msk = mask n ⟧
⟹ (x mod m) AND msk = x mod m"
for x :: ‹'a::len word›

"⟦ x AND mask LENGTH('a) = (x :: ('c :: len word));
LENGTH('a) ≤ LENGTH('b)⟧
⟹ ucast (ucast x :: ('a :: len word)) = (ucast x :: ('b :: len word))"

lemma of_nat_less_t2n:
"of_nat i < (2 :: ('a :: len) word) ^ n ⟹ n < LENGTH('a) ∧ 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:
"⟦ n ≤ m; m ≤ LENGTH('a) ⟧ ⟹ (2 :: 'a :: len word) ^ n - 1 ≤ 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:
"⟦ y + x ≤ z + x; y ≤ y + x; z ≤ z + x ⟧ ⟹ y ≤ z" for y :: "'a :: len word"

lemma eq_or_less_helperD:
"⟦ n = unat (2 ^ m - 1 :: 'a :: len word) ∨ n < unat (2 ^ m - 1 :: 'a word); m < LENGTH('a) ⟧
⟹ n < 2 ^ m"
by (meson le_less_trans nat_less_le unat_less_power word_power_less_1)

"sz'≤ sz ⟹ (ptr AND NOT(mask sz')) - (ptr AND NOT(mask sz)) ≤ 2 ^ sz - 2 ^ sz'"
(is "_ ⟹ ?lhs ≤ ?rhs")
for ptr :: ‹'a::len word›
proof -
assume lt: "sz' ≤ sz"
also have "… ≤ ?rhs" using lt
finally show ?thesis by simp
qed

"⟦ idx < 2 ^ sz; sz < LENGTH('a) ⟧ ⟹ (of_nat idx :: 'a :: len word) AND NOT(mask sz) = 0"

"is_aligned ptr sz = (ptr AND NOT(mask sz) = ptr)"

"sz < LENGTH('a)
⟹ unat ((ptr :: 'a :: len word) AND NOT(mask sz)) + unat (ptr AND mask sz) = unat ptr"

lemma unat_pow_le_intro:
"LENGTH('a) ≤ n ⟹ 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:
‹unat (x << n) < 2 ^ m›
if ‹unat (x :: 'a :: len word) < 2 ^ (m - n)› ‹m < LENGTH('a)›
proof (cases ‹n ≤ m›)
case False
with that show ?thesis
apply (transfer fixing: m n)
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 ‹q = m - n› and ‹r = LENGTH('a) - n - q›
ultimately have ‹m - n = q› ‹m = n + q› ‹LENGTH('a) = r + q + n›
using that by simp_all
with that show ?thesis
apply (transfer fixing: m n q r)
using take_bit_tightened_less_eq_int [of ‹r + q› ‹r + q + n›]
apply (rule le_less_trans)
apply simp_all
done
qed

"⟦ is_aligned p n; unat d < 2 ^ n ⟧
⟹ unat (p + d AND mask n) = unat d ∧ unat (p + d AND NOT(mask n)) = unat p"

"⟦ c + a ≥ LENGTH('a) + b ; c < LENGTH('a) ⟧
⟹ 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]

"x ≤ mask (low_bits + high_bits) ⟹ (x >> low_bits) AND mask high_bits = x >> low_bits"
for x :: ‹'a::len word›

lemma leq_low_bits_iff_zero:
"⟦ x ≤ mask (low bits + high bits); x >> low_bits = 0 ⟧ ⟹ (x AND mask low_bits = 0) = (x = 0)"
for x :: ‹'a::len word›

lemma unat_less_iff:
"⟦ unat (a :: 'a :: len word) = b; c < 2 ^ LENGTH('a) ⟧ ⟹ (a < of_nat c) = (b < c)"
using unat_ucast_less_no_overflow_simp by blast

lemma is_aligned_no_overflow3:
"⟦ is_aligned (a :: 'a :: len word) n; n < LENGTH('a); b < 2 ^ n; c ≤ 2 ^ n; b < c ⟧
⟹ a + b ≤ a + (c - 1)"
by (meson is_aligned_no_wrap' le_m1_iff_lt not_le word_less_sub_1 word_plus_mono_right)

"is_aligned p n ⟹ (q + p) AND mask n = q AND mask n"

"x ≤ mask high_bits ⟹ (x :: 'a :: len word) << low_bits ≤ mask (low_bits + high_bits)"

lemma word_two_power_neg_ineq:
"2 ^ m ≠ (0 :: 'a word) ⟹ 2 ^ n ≤ - (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 (drule power_increasing[where a=2 and n=n] power_increasing[where a=2 and n=m], simp)+
apply simp
done

lemma unat_shiftl_absorb:
"⟦ x ≤ 2 ^ p; p + k < LENGTH('a) ⟧ ⟹ unat (x :: 'a :: len word) * 2 ^ k = unat (x * 2 ^ k)"
unat_lt2p unat_mult_lem unat_power_lower word_le_nat_alt)

lemma word_plus_mono_right_split:
"⟦ unat ((x :: 'a :: len word) AND mask sz) + unat z < 2 ^ sz; sz < LENGTH('a) ⟧
⟹ x ≤ x + z"
apply (subgoal_tac "(x AND NOT(mask sz)) + (x AND mask sz) ≤ (x AND NOT(mask sz)) + ((x AND mask sz) + z)")
apply (rule word_plus_mono_right)
using of_nat_power is_aligned_no_wrap' by force

"NOT(mask n :: 'a::len word) = -1 << n"

"(x >> n) * NOT(mask n) = - (x AND NOT(mask n))"
for x :: ‹'a::len word›

"n ≤ LENGTH('a) ⟹ (mask n :: 'a :: len word) = -1 >> (LENGTH('a) - n)"

"is_aligned p n ⟹ (p + x) AND NOT(mask n) = p + (x AND NOT(mask n))"

lemma aligned_bump_down:
"is_aligned x n ⟹ (x - 1) AND NOT(mask n) = x - 2 ^ n"

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)

by word_eqI_solve

lemma unat_signed_ucast_less_ucast:
"LENGTH('a) ≤ LENGTH('b) ⟹ unat (ucast (x :: 'a :: len word) :: 'b :: len signed word) = unat x"

lemma toEnum_of_ucast:
"LENGTH('b) ≤ LENGTH('a) ⟹
(toEnum (unat (b::'b :: len word))::'a :: len word) = of_nat (unat b)"

"x AND NOT(mask n) = x ⟹ (x + mask n) AND NOT(mask n) = x" for x::‹'a::len word›
apply (subst word_plus_and_or_coroll; word_eqI; fastforce?)
apply (erule allE, drule (1) iffD2)
apply clarsimp
done