# Theory Word

theory Word
imports Type_Length Bits_Int Bit_Comprehension Misc_Typedef
```(*  Title:      HOL/Word/Word.thy
Author:     Jeremy Dawson and Gerwin Klein, NICTA
*)

section ‹A type of finite bit strings›

theory Word
imports
"HOL-Library.Type_Length"
"HOL-Library.Boolean_Algebra"
"HOL-Library.Bit_Operations"
Bits_Int
Bit_Comprehension
Misc_Typedef
begin

subsection ‹Type definition›

quotient_type (overloaded) 'a word = int / ‹λk l. take_bit LENGTH('a) k = take_bit LENGTH('a::len) l›
morphisms rep_word Word by (auto intro!: equivpI reflpI sympI transpI)

hide_const (open) Word ― ‹only for code generation›

lift_definition word_of_int :: ‹int ⇒ 'a::len word›
is ‹λk. k› .

lift_definition uint :: ‹'a::len word ⇒ int›
is ‹take_bit LENGTH('a)› .

lemma uint_nonnegative: "0 ≤ uint w"
by transfer simp

lemma uint_bounded: "uint w < 2 ^ LENGTH('a)"
for w :: "'a::len word"

lemma uint_idem: "uint w mod 2 ^ LENGTH('a) = uint w"
for w :: "'a::len word"
using uint_nonnegative uint_bounded by (rule mod_pos_pos_trivial)

lemma word_uint_eqI: "uint a = uint b ⟹ a = b"
by transfer simp

lemma word_uint_eq_iff: "a = b ⟷ uint a = uint b"
using word_uint_eqI by auto

lemma uint_word_of_int: "uint (word_of_int k :: 'a::len word) = k mod 2 ^ LENGTH('a)"

lemma word_of_int_uint: "word_of_int (uint w) = w"
by transfer simp

lemma split_word_all: "(⋀x::'a::len word. PROP P x) ≡ (⋀x. PROP P (word_of_int x))"
proof
fix x :: "'a word"
assume "⋀x. PROP P (word_of_int x)"
then have "PROP P (word_of_int (uint x))" .
then show "PROP P x" by (simp add: word_of_int_uint)
qed

subsection ‹Type conversions and casting›

lemma signed_take_bit_decr_length_iff:
‹signed_take_bit (LENGTH('a::len) - Suc 0) k = signed_take_bit (LENGTH('a) - Suc 0) l
⟷ take_bit LENGTH('a) k = take_bit LENGTH('a) l›
by (cases ‹LENGTH('a)›)

lift_definition sint :: ‹'a::len word ⇒ int›
― ‹treats the most-significant bit as a sign bit›
is ‹signed_take_bit (LENGTH('a) - 1)›

lemma sint_uint [code]:
‹sint w = signed_take_bit (LENGTH('a) - 1) (uint w)›
for w :: ‹'a::len word›
by (cases ‹LENGTH('a)›; transfer) (simp_all add: signed_take_bit_take_bit)

lift_definition unat :: ‹'a::len word ⇒ nat›
is ‹nat ∘ take_bit LENGTH('a)›
by transfer simp

lemma nat_uint_eq [simp]:
‹nat (uint w) = unat w›
by transfer simp

lemma unat_eq_nat_uint [code]:
‹unat w = nat (uint w)›
by simp

lift_definition ucast :: ‹'a::len word ⇒ 'b::len word›
is ‹take_bit LENGTH('a)›
by simp

lemma ucast_eq [code]:
‹ucast w = word_of_int (uint w)›
by transfer simp

lift_definition scast :: ‹'a::len word ⇒ 'b::len word›
is ‹signed_take_bit (LENGTH('a) - 1)›
by (simp flip: signed_take_bit_decr_length_iff)

lemma scast_eq [code]:
‹scast w = word_of_int (sint w)›
by transfer simp

instantiation word :: (len) size
begin

lift_definition size_word :: ‹'a word ⇒ nat›
is ‹λ_. LENGTH('a)› ..

instance ..

end

lemma word_size [code]:
‹size w = LENGTH('a)› for w :: ‹'a::len word›
by (fact size_word.rep_eq)

lemma word_size_gt_0 [iff]: "0 < size w"
for w :: "'a::len word"

lemmas lens_gt_0 = word_size_gt_0 len_gt_0

lemma lens_not_0 [iff]:
‹size w ≠ 0› for  w :: ‹'a::len word›
by auto

lift_definition source_size :: ‹('a::len word ⇒ 'b) ⇒ nat›
is ‹λ_. LENGTH('a)› .

lift_definition target_size :: ‹('a ⇒ 'b::len word) ⇒ nat›
is ‹λ_. LENGTH('b)› ..

lift_definition is_up :: ‹('a::len word ⇒ 'b::len word) ⇒ bool›
is ‹λ_. LENGTH('a) ≤ LENGTH('b)› ..

lift_definition is_down :: ‹('a::len word ⇒ 'b::len word) ⇒ bool›
is ‹λ_. LENGTH('a) ≥ LENGTH('b)› ..

lemma is_up_eq:
‹is_up f ⟷ source_size f ≤ target_size f›
for f :: ‹'a::len word ⇒ 'b::len word›
by (simp add: source_size.rep_eq target_size.rep_eq is_up.rep_eq)

lemma is_down_eq:
‹is_down f ⟷ target_size f ≤ source_size f›
for f :: ‹'a::len word ⇒ 'b::len word›
by (simp add: source_size.rep_eq target_size.rep_eq is_down.rep_eq)

lift_definition word_int_case :: ‹(int ⇒ 'b) ⇒ 'a::len word ⇒ 'b›
is ‹λf. f ∘ take_bit LENGTH('a)› by simp

lemma word_int_case_eq_uint [code]:
‹word_int_case f w = f (uint w)›
by transfer simp

translations
"case x of XCONST of_int y ⇒ b" ⇌ "CONST word_int_case (λy. b) x"
"case x of (XCONST of_int :: 'a) y ⇒ b" ⇀ "CONST word_int_case (λy. b) x"

subsection ‹Basic code generation setup›

lemma Word_eq_word_of_int [code_post]:
‹Word.Word = word_of_int›
by rule (transfer, rule)

lemma [code abstype]:
‹Word.Word (uint w) = w›
by transfer simp

lemma [code abstract]:
‹uint (word_of_int k :: 'a::len word) = take_bit LENGTH('a) k›
by transfer rule

instantiation word :: (len) equal
begin

lift_definition equal_word :: ‹'a word ⇒ 'a word ⇒ bool›
is ‹λk l. take_bit LENGTH('a) k = take_bit LENGTH('a) l›
by simp

instance
by (standard; transfer) rule

end

lemma [code]:
‹HOL.equal k l ⟷ HOL.equal (uint k) (uint l)›

notation fcomp (infixl "∘>" 60)
notation scomp (infixl "∘→" 60)

instantiation word :: ("{len, typerep}") random
begin

definition
"random_word i = Random.range i ∘→ (λk. Pair (
let j = word_of_int (int_of_integer (integer_of_natural k)) :: 'a word
in (j, λ_::unit. Code_Evaluation.term_of j)))"

instance ..

end

no_notation fcomp (infixl "∘>" 60)
no_notation scomp (infixl "∘→" 60)

subsection ‹Type-definition locale instantiations›

lemmas uint_0 = uint_nonnegative (* FIXME duplicate *)
lemmas uint_lt = uint_bounded (* FIXME duplicate *)
lemmas uint_mod_same = uint_idem (* FIXME duplicate *)

definition uints :: "nat ⇒ int set"
― ‹the sets of integers representing the words›
where "uints n = range (take_bit n)"

definition sints :: "nat ⇒ int set"
where "sints n = range (signed_take_bit (n - 1))"

lemma uints_num: "uints n = {i. 0 ≤ i ∧ i < 2 ^ n}"

lemma sints_num: "sints n = {i. - (2 ^ (n - 1)) ≤ i ∧ i < 2 ^ (n - 1)}"

definition unats :: "nat ⇒ nat set"
where "unats n = {i. i < 2 ^ n}"

― ‹naturals›
lemma uints_unats: "uints n = int ` unats n"
apply (unfold unats_def uints_num)
apply safe
apply (rule_tac image_eqI)
apply (erule_tac nat_0_le [symmetric])
by auto

lemma unats_uints: "unats n = nat ` uints n"
by (auto simp: uints_unats image_iff)

lemma td_ext_uint:
"td_ext (uint :: 'a word ⇒ int) word_of_int (uints (LENGTH('a::len)))
(λw::int. w mod 2 ^ LENGTH('a))"
apply (unfold td_ext_def')
apply transfer
done

interpretation word_uint:
td_ext
"uint::'a::len word ⇒ int"
word_of_int
"uints (LENGTH('a::len))"
"λw. w mod 2 ^ LENGTH('a::len)"
by (fact td_ext_uint)

lemmas td_uint = word_uint.td_thm
lemmas int_word_uint = word_uint.eq_norm

lemma td_ext_ubin:
"td_ext (uint :: 'a word ⇒ int) word_of_int (uints (LENGTH('a::len)))
(take_bit (LENGTH('a)))"
apply standard
apply transfer
apply simp
done

interpretation word_ubin:
td_ext
"uint::'a::len word ⇒ int"
word_of_int
"uints (LENGTH('a::len))"
"take_bit (LENGTH('a::len))"
by (fact td_ext_ubin)

subsection ‹Arithmetic operations›

lift_definition word_succ :: "'a::len word ⇒ 'a word" is "λx. x + 1"

lift_definition word_pred :: "'a::len word ⇒ 'a word" is "λx. x - 1"
by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)

instantiation word :: (len) "{neg_numeral, modulo, comm_monoid_mult, comm_ring}"
begin

lift_definition zero_word :: "'a word" is "0" .

lift_definition one_word :: "'a word" is "1" .

lift_definition plus_word :: "'a word ⇒ 'a word ⇒ 'a word" is "(+)"

lift_definition minus_word :: "'a word ⇒ 'a word ⇒ 'a word" is "(-)"
by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)

lift_definition uminus_word :: "'a word ⇒ 'a word" is uminus
by (auto simp add: take_bit_eq_mod intro: mod_minus_cong)

lift_definition times_word :: "'a word ⇒ 'a word ⇒ 'a word" is "(*)"
by (auto simp add: take_bit_eq_mod intro: mod_mult_cong)

lift_definition divide_word :: "'a word ⇒ 'a word ⇒ 'a word"
is "λa b. take_bit LENGTH('a) a div take_bit LENGTH('a) b"
by simp

lift_definition modulo_word :: "'a word ⇒ 'a word ⇒ 'a word"
is "λa b. take_bit LENGTH('a) a mod take_bit LENGTH('a) b"
by simp

instance
by standard (transfer, simp add: algebra_simps)+

end

lemma uint_0_eq [simp, code]:
‹uint 0 = 0›
by transfer simp

quickcheck_generator word
constructors:
‹0 :: 'a::len word›,
‹numeral :: num ⇒ 'a::len word›,
‹uminus :: 'a word ⇒ 'a::len word›

lemma uint_1_eq [simp, code]:
‹uint 1 = 1›
by transfer simp

lemma word_div_def [code]:
"a div b = word_of_int (uint a div uint b)"
by transfer rule

lemma word_mod_def [code]:
"a mod b = word_of_int (uint a mod uint b)"
by transfer rule

context
includes lifting_syntax
notes power_transfer [transfer_rule]
begin

lemma power_transfer_word [transfer_rule]:
‹(pcr_word ===> (=) ===> pcr_word) (^) (^)›
by transfer_prover

end

text ‹Legacy theorems:›

"a + b = word_of_int (uint a + uint b)"

lemma word_sub_wi [code]:
"a - b = word_of_int (uint a - uint b)"

lemma word_mult_def [code]:
"a * b = word_of_int (uint a * uint b)"
by transfer (simp add: take_bit_eq_mod mod_simps)

lemma word_minus_def [code]:
"- a = word_of_int (- uint a)"

lemma word_succ_alt [code]:
"word_succ a = word_of_int (uint a + 1)"
by transfer (simp add: take_bit_eq_mod mod_simps)

lemma word_pred_alt [code]:
"word_pred a = word_of_int (uint a - 1)"
by transfer (simp add: take_bit_eq_mod mod_simps)

lemma word_0_wi:
"0 = word_of_int 0"
by transfer simp

lemma word_1_wi:
"1 = word_of_int 1"
by transfer simp

lemmas word_arith_wis =
word_minus_def word_succ_alt word_pred_alt
word_0_wi word_1_wi

lemma wi_homs:
shows wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)"
and wi_hom_sub: "word_of_int a - word_of_int b = word_of_int (a - b)"
and wi_hom_mult: "word_of_int a * word_of_int b = word_of_int (a * b)"
and wi_hom_neg: "- word_of_int a = word_of_int (- a)"
and wi_hom_succ: "word_succ (word_of_int a) = word_of_int (a + 1)"
and wi_hom_pred: "word_pred (word_of_int a) = word_of_int (a - 1)"
by (transfer, simp)+

lemmas wi_hom_syms = wi_homs [symmetric]

lemmas word_of_int_homs = wi_homs word_0_wi word_1_wi

lemmas word_of_int_hom_syms = word_of_int_homs [symmetric]

instance word :: (len) comm_monoid_add ..

instance word :: (len) semiring_numeral ..

instance word :: (len) comm_ring_1
proof
have *: "0 < LENGTH('a)" by (rule len_gt_0)
show "(0::'a word) ≠ 1"
by transfer (use * in ‹auto simp add: gr0_conv_Suc›)
qed

lemma word_of_nat: "of_nat n = word_of_int (int n)"
by (induct n) (auto simp add : word_of_int_hom_syms)

lemma word_of_int: "of_int = word_of_int"
apply (rule ext)
apply (case_tac x rule: int_diff_cases)
done

context
includes lifting_syntax
notes
transfer_rule_of_bool [transfer_rule]
transfer_rule_numeral [transfer_rule]
transfer_rule_of_nat [transfer_rule]
transfer_rule_of_int [transfer_rule]
begin

lemma [transfer_rule]:
"((=) ===> pcr_word) of_bool of_bool"
by transfer_prover

lemma [transfer_rule]:
"((=) ===> pcr_word) numeral numeral"
by transfer_prover

lemma [transfer_rule]:
"((=) ===> pcr_word) int of_nat"
by transfer_prover

lemma [transfer_rule]:
"((=) ===> pcr_word) (λk. k) of_int"
proof -
have "((=) ===> pcr_word) of_int of_int"
by transfer_prover
then show ?thesis by (simp add: id_def)
qed

end

lemma word_of_int_eq:
"word_of_int = of_int"
by (rule ext) (transfer, rule)

definition udvd :: "'a::len word ⇒ 'a::len word ⇒ bool" (infixl "udvd" 50)
where "a udvd b = (∃n≥0. uint b = n * uint a)"

context
includes lifting_syntax
begin

lemma [transfer_rule]:
‹(pcr_word ===> (⟷)) even ((dvd) 2 :: 'a::len word ⇒ bool)›
proof -
have even_word_unfold: "even k ⟷ (∃l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P ⟷ ?Q")
for k :: int
proof
assume ?P
then show ?Q
by auto
next
assume ?Q
then obtain l where "take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l)" ..
then have "even (take_bit LENGTH('a) k)"
by simp
then show ?P
by simp
qed
show ?thesis by (simp only: even_word_unfold [abs_def] dvd_def [where ?'a = "'a word", abs_def])
transfer_prover
qed

end

instance word :: (len) semiring_modulo
proof
show "a div b * b + a mod b = a" for a b :: "'a word"
proof transfer
fix k l :: int
define r :: int where "r = 2 ^ LENGTH('a)"
then have r: "take_bit LENGTH('a) k = k mod r" for k
have "k mod r = ((k mod r) div (l mod r) * (l mod r)
+ (k mod r) mod (l mod r)) mod r"
also have "... = (((k mod r) div (l mod r) * (l mod r)) mod r
+ (k mod r) mod (l mod r)) mod r"
also have "... = (((k mod r) div (l mod r) * l) mod r
+ (k mod r) mod (l mod r)) mod r"
finally have "k mod r = ((k mod r) div (l mod r) * l
+ (k mod r) mod (l mod r)) mod r"
with r show "take_bit LENGTH('a) (take_bit LENGTH('a) k div take_bit LENGTH('a) l * l
+ take_bit LENGTH('a) k mod take_bit LENGTH('a) l) = take_bit LENGTH('a) k"
by simp
qed
qed

instance word :: (len) semiring_parity
proof
show "¬ 2 dvd (1::'a word)"
by transfer simp
show even_iff_mod_2_eq_0: "2 dvd a ⟷ a mod 2 = 0"
for a :: "'a word"
by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
show "¬ 2 dvd a ⟷ a mod 2 = 1"
for a :: "'a word"
by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
qed

lemma exp_eq_zero_iff:
‹2 ^ n = (0 :: 'a::len word) ⟷ n ≥ LENGTH('a)›
by transfer simp

lemma double_eq_zero_iff:
‹2 * a = 0 ⟷ a = 0 ∨ a = 2 ^ (LENGTH('a) - Suc 0)›
for a :: ‹'a::len word›
proof -
define n where ‹n = LENGTH('a) - Suc 0›
then have *: ‹LENGTH('a) = Suc n›
by simp
have ‹a = 0› if ‹2 * a = 0› and ‹a ≠ 2 ^ (LENGTH('a) - Suc 0)›
using that by transfer
(auto simp add: take_bit_eq_0_iff take_bit_eq_mod *)
moreover have ‹2 ^ LENGTH('a) = (0 :: 'a word)›
by transfer simp
then have ‹2 * 2 ^ (LENGTH('a) - Suc 0) = (0 :: 'a word)›
ultimately show ?thesis
by auto
qed

subsection ‹Ordering›

instantiation word :: (len) linorder
begin

lift_definition less_eq_word :: "'a word ⇒ 'a word ⇒ bool"
is "λa b. take_bit LENGTH('a) a ≤ take_bit LENGTH('a) b"
by simp

lift_definition less_word :: "'a word ⇒ 'a word ⇒ bool"
is "λa b. take_bit LENGTH('a) a < take_bit LENGTH('a) b"
by simp

instance
by (standard; transfer) auto

end

interpretation word_order: ordering_top ‹(≤)› ‹(<)› ‹- 1 :: 'a::len word›
by (standard; transfer) (simp add: take_bit_eq_mod zmod_minus1)

interpretation word_coorder: ordering_top ‹(≥)› ‹(>)› ‹0 :: 'a::len word›
by (standard; transfer) simp

lemma word_le_def [code]:
"a ≤ b ⟷ uint a ≤ uint b"
by transfer rule

lemma word_less_def [code]:
"a < b ⟷ uint a < uint b"
by transfer rule

lemma word_greater_zero_iff:
‹a > 0 ⟷ a ≠ 0› for a :: ‹'a::len word›

lemma of_nat_word_eq_iff:
‹of_nat m = (of_nat n :: 'a::len word) ⟷ take_bit LENGTH('a) m = take_bit LENGTH('a) n›

lemma of_nat_word_less_eq_iff:
‹of_nat m ≤ (of_nat n :: 'a::len word) ⟷ take_bit LENGTH('a) m ≤ take_bit LENGTH('a) n›

lemma of_nat_word_less_iff:
‹of_nat m < (of_nat n :: 'a::len word) ⟷ take_bit LENGTH('a) m < take_bit LENGTH('a) n›

lemma of_nat_word_eq_0_iff:
‹of_nat n = (0 :: 'a::len word) ⟷ 2 ^ LENGTH('a) dvd n›
using of_nat_word_eq_iff [where ?'a = 'a, of n 0] by (simp add: take_bit_eq_0_iff)

lemma of_int_word_eq_iff:
‹of_int k = (of_int l :: 'a::len word) ⟷ take_bit LENGTH('a) k = take_bit LENGTH('a) l›
by transfer rule

lemma of_int_word_less_eq_iff:
‹of_int k ≤ (of_int l :: 'a::len word) ⟷ take_bit LENGTH('a) k ≤ take_bit LENGTH('a) l›
by transfer rule

lemma of_int_word_less_iff:
‹of_int k < (of_int l :: 'a::len word) ⟷ take_bit LENGTH('a) k < take_bit LENGTH('a) l›
by transfer rule

lemma of_int_word_eq_0_iff:
‹of_int k = (0 :: 'a::len word) ⟷ 2 ^ LENGTH('a) dvd k›
using of_int_word_eq_iff [where ?'a = 'a, of k 0] by (simp add: take_bit_eq_0_iff)

lift_definition word_sle :: ‹'a::len word ⇒ 'a word ⇒ bool›  (‹(_/ <=s _)› [50, 51] 50)
is ‹λk l. signed_take_bit (LENGTH('a) - 1) k ≤ signed_take_bit (LENGTH('a) - 1) l›
by (simp flip: signed_take_bit_decr_length_iff)

lemma word_sle_eq [code]:
‹a <=s b ⟷ sint a ≤ sint b›
by transfer simp

lift_definition word_sless :: ‹'a::len word ⇒ 'a word ⇒ bool›  (‹(_/ <s _)› [50, 51] 50)
is ‹λk l. signed_take_bit (LENGTH('a) - 1) k < signed_take_bit (LENGTH('a) - 1) l›
by (simp flip: signed_take_bit_decr_length_iff)

lemma word_sless_eq:
‹x <s y ⟷ x <=s y ∧ x ≠ y›
by transfer (simp add: signed_take_bit_decr_length_iff less_le)

lemma [code]:
‹a <s b ⟷ sint a < sint b›
by transfer simp

subsection ‹Bit-wise operations›

lemma word_bit_induct [case_names zero even odd]:
‹P a› if word_zero: ‹P 0›
and word_even: ‹⋀a. P a ⟹ 0 < a ⟹ a < 2 ^ (LENGTH('a) - 1) ⟹ P (2 * a)›
and word_odd: ‹⋀a. P a ⟹ a < 2 ^ (LENGTH('a) - 1) ⟹ P (1 + 2 * a)›
for P and a :: ‹'a::len word›
proof -
define m :: nat where ‹m = LENGTH('a) - 1›
then have l: ‹LENGTH('a) = Suc m›
by simp
define n :: nat where ‹n = unat a›
then have ‹n < 2 ^ LENGTH('a)›
by (unfold unat_def) (transfer, simp add: take_bit_eq_mod)
then have ‹n < 2 * 2 ^ m›
then have ‹P (of_nat n)›
proof (induction n rule: nat_bit_induct)
case zero
show ?case
by simp (rule word_zero)
next
case (even n)
then have ‹n < 2 ^ m›
by simp
with even.IH have ‹P (of_nat n)›
by simp
moreover from ‹n < 2 ^ m› even.hyps have ‹0 < (of_nat n :: 'a word)›
by (auto simp add: word_greater_zero_iff of_nat_word_eq_0_iff l)
moreover from ‹n < 2 ^ m› have ‹(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - 1)›
using of_nat_word_less_iff [where ?'a = 'a, of n ‹2 ^ m›]
by (cases ‹m = 0›) (simp_all add: not_less take_bit_eq_self ac_simps l)
ultimately have ‹P (2 * of_nat n)›
by (rule word_even)
then show ?case
by simp
next
case (odd n)
then have ‹Suc n ≤ 2 ^ m›
by simp
with odd.IH have ‹P (of_nat n)›
by simp
moreover from ‹Suc n ≤ 2 ^ m› have ‹(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - 1)›
using of_nat_word_less_iff [where ?'a = 'a, of n ‹2 ^ m›]
by (cases ‹m = 0›) (simp_all add: not_less take_bit_eq_self ac_simps l)
ultimately have ‹P (1 + 2 * of_nat n)›
by (rule word_odd)
then show ?case
by simp
qed
moreover have ‹of_nat (nat (uint a)) = a›
by transfer simp
ultimately show ?thesis
qed

lemma bit_word_half_eq:
‹(of_bool b + a * 2) div 2 = a›
if ‹a < 2 ^ (LENGTH('a) - Suc 0)›
for a :: ‹'a::len word›
proof (cases ‹2 ≤ LENGTH('a::len)›)
case False
have ‹of_bool (odd k) < (1 :: int) ⟷ even k› for k :: int
by auto
with False that show ?thesis
next
case True
obtain n where length: ‹LENGTH('a) = Suc n›
by (cases ‹LENGTH('a)›) simp_all
show ?thesis proof (cases b)
case False
moreover have ‹a * 2 div 2 = a›
using that proof transfer
fix k :: int
from length have ‹k * 2 mod 2 ^ LENGTH('a) = (k mod 2 ^ n) * 2›
by simp
moreover assume ‹take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))›
with ‹LENGTH('a) = Suc n›
have ‹k mod 2 ^ LENGTH('a) = k mod 2 ^ n›
ultimately have ‹take_bit LENGTH('a) (k * 2) = take_bit LENGTH('a) k * 2›
with True show ‹take_bit LENGTH('a) (take_bit LENGTH('a) (k * 2) div take_bit LENGTH('a) 2)
= take_bit LENGTH('a) k›
by simp
qed
ultimately show ?thesis
by simp
next
case True
moreover have ‹(1 + a * 2) div 2 = a›
using that proof transfer
fix k :: int
from length have ‹(1 + k * 2) mod 2 ^ LENGTH('a) = 1 + (k mod 2 ^ n) * 2›
using pos_zmod_mult_2 [of ‹2 ^ n› k] by (simp add: ac_simps)
moreover assume ‹take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))›
with ‹LENGTH('a) = Suc n›
have ‹k mod 2 ^ LENGTH('a) = k mod 2 ^ n›
ultimately have ‹take_bit LENGTH('a) (1 + k * 2) = 1 + take_bit LENGTH('a) k * 2›
with True show ‹take_bit LENGTH('a) (take_bit LENGTH('a) (1 + k * 2) div take_bit LENGTH('a) 2)
= take_bit LENGTH('a) k›
qed
ultimately show ?thesis
by simp
qed
qed

lemma even_mult_exp_div_word_iff:
‹even (a * 2 ^ m div 2 ^ n) ⟷ ¬ (
m ≤ n ∧
n < LENGTH('a) ∧ odd (a div 2 ^ (n - m)))› for a :: ‹'a::len word›
by transfer
(auto simp flip: drop_bit_eq_div simp add: even_drop_bit_iff_not_bit bit_take_bit_iff,

instantiation word :: (len) semiring_bits
begin

lift_definition bit_word :: ‹'a word ⇒ nat ⇒ bool›
is ‹λk n. n < LENGTH('a) ∧ bit k n›
proof
fix k l :: int and n :: nat
assume *: ‹take_bit LENGTH('a) k = take_bit LENGTH('a) l›
show ‹n < LENGTH('a) ∧ bit k n ⟷ n < LENGTH('a) ∧ bit l n›
proof (cases ‹n < LENGTH('a)›)
case True
from * have ‹bit (take_bit LENGTH('a) k) n ⟷ bit (take_bit LENGTH('a) l) n›
by simp
then show ?thesis
next
case False
then show ?thesis
by simp
qed
qed

instance proof
show ‹P a› if stable: ‹⋀a. a div 2 = a ⟹ P a›
and rec: ‹⋀a b. P a ⟹ (of_bool b + 2 * a) div 2 = a ⟹ P (of_bool b + 2 * a)›
for P and a :: ‹'a word›
proof (induction a rule: word_bit_induct)
case zero
have ‹0 div 2 = (0::'a word)›
by transfer simp
with stable [of 0] show ?case
by simp
next
case (even a)
with rec [of a False] show ?case
using bit_word_half_eq [of a False] by (simp add: ac_simps)
next
case (odd a)
with rec [of a True] show ?case
using bit_word_half_eq [of a True] by (simp add: ac_simps)
qed
show ‹bit a n ⟷ odd (a div 2 ^ n)› for a :: ‹'a word› and n
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit bit_iff_odd_drop_bit)
show ‹0 div a = 0›
for a :: ‹'a word›
by transfer simp
show ‹a div 1 = a›
for a :: ‹'a word›
by transfer simp
show ‹a mod b div b = 0›
for a b :: ‹'a word›
apply transfer
apply (subst (3) mod_pos_pos_trivial [of _ ‹2 ^ LENGTH('a)›])
apply simp_all
apply (metis le_less mod_by_0 pos_mod_conj zero_less_numeral zero_less_power)
using pos_mod_bound [of ‹2 ^ LENGTH('a)›] apply simp
proof -
fix aa :: int and ba :: int
have f1: "⋀i n. (i::int) mod 2 ^ n = 0 ∨ 0 < i mod 2 ^ n"
by (metis le_less take_bit_eq_mod take_bit_nonnegative)
have "(0::int) < 2 ^ len_of (TYPE('a)::'a itself) ∧ ba mod 2 ^ len_of (TYPE('a)::'a itself) ≠ 0 ∨ aa mod 2 ^ len_of (TYPE('a)::'a itself) mod (ba mod 2 ^ len_of (TYPE('a)::'a itself)) < 2 ^ len_of (TYPE('a)::'a itself)"
by (metis (no_types) mod_by_0 unique_euclidean_semiring_numeral_class.pos_mod_bound zero_less_numeral zero_less_power)
then show "aa mod 2 ^ len_of (TYPE('a)::'a itself) mod (ba mod 2 ^ len_of (TYPE('a)::'a itself)) < 2 ^ len_of (TYPE('a)::'a itself)"
using f1 by (meson le_less less_le_trans unique_euclidean_semiring_numeral_class.pos_mod_bound)
qed
show ‹(1 + a) div 2 = a div 2›
if ‹even a›
for a :: ‹'a word›
using that by transfer
(auto dest: le_Suc_ex simp add: mod_2_eq_odd take_bit_Suc elim!: evenE)
show ‹(2 :: 'a word) ^ m div 2 ^ n = of_bool ((2 :: 'a word) ^ m ≠ 0 ∧ n ≤ m) * 2 ^ (m - n)›
for m n :: nat
by transfer (simp, simp add: exp_div_exp_eq)
show "a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)"
for a :: "'a word" and m n :: nat
apply transfer
apply (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: drop_bit_eq_div)
done
show "a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n"
for a :: "'a word" and m n :: nat
by transfer (auto simp flip: take_bit_eq_mod simp add: ac_simps)
show ‹a * 2 ^ m mod 2 ^ n = a mod 2 ^ (n - m) * 2 ^ m›
if ‹m ≤ n› for a :: "'a word" and m n :: nat
using that apply transfer
apply (auto simp flip: take_bit_eq_mod)
apply (auto simp flip: push_bit_eq_mult simp add: push_bit_take_bit split: split_min_lin)
done
show ‹a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n›
for a :: "'a word" and m n :: nat
by transfer (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: take_bit_eq_mod drop_bit_eq_div split: split_min_lin)
show ‹even ((2 ^ m - 1) div (2::'a word) ^ n) ⟷ 2 ^ n = (0::'a word) ∨ m ≤ n›
for m n :: nat
show ‹even (a * 2 ^ m div 2 ^ n) ⟷ n < m ∨ (2::'a word) ^ n = 0 ∨ m ≤ n ∧ even (a div 2 ^ (n - m))›
for a :: ‹'a word› and m n :: nat
proof transfer
show ‹even (take_bit LENGTH('a) (k * 2 ^ m) div take_bit LENGTH('a) (2 ^ n)) ⟷
n < m
∨ take_bit LENGTH('a) ((2::int) ^ n) = take_bit LENGTH('a) 0
∨ (m ≤ n ∧ even (take_bit LENGTH('a) k div take_bit LENGTH('a) (2 ^ (n - m))))›
for m n :: nat and k l :: int
by (auto simp flip: take_bit_eq_mod drop_bit_eq_div push_bit_eq_mult
simp add: div_push_bit_of_1_eq_drop_bit drop_bit_take_bit drop_bit_push_bit_int [of n m])
qed
qed

end

instantiation word :: (len) semiring_bit_shifts
begin

lift_definition push_bit_word :: ‹nat ⇒ 'a word ⇒ 'a word›
is push_bit
proof -
show ‹take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)›
if ‹take_bit LENGTH('a) k = take_bit LENGTH('a) l› for k l :: int and n :: nat
proof -
from that
have ‹take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k)
= take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)›
by simp
moreover have ‹min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n›
by simp
ultimately show ?thesis
qed
qed

lift_definition drop_bit_word :: ‹nat ⇒ 'a word ⇒ 'a word›
is ‹λn. drop_bit n ∘ take_bit LENGTH('a)›

lift_definition take_bit_word :: ‹nat ⇒ 'a word ⇒ 'a word›
is ‹λn. take_bit (min LENGTH('a) n)›
by (simp add: ac_simps) (simp only: flip: take_bit_take_bit)

instance proof
show ‹push_bit n a = a * 2 ^ n› for n :: nat and a :: ‹'a word›
show ‹drop_bit n a = a div 2 ^ n› for n :: nat and a :: ‹'a word›
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit)
show ‹take_bit n a = a mod 2 ^ n› for n :: nat and a :: ‹'a word›
by transfer (auto simp flip: take_bit_eq_mod)
qed

end

lemma bit_word_eqI:
‹a = b› if ‹⋀n. n < LENGTH('a) ⟹ bit a n ⟷ bit b n›
for a b :: ‹'a::len word›
using that by transfer (auto simp add: nat_less_le bit_eq_iff bit_take_bit_iff)

lemma bit_imp_le_length:
‹n < LENGTH('a)› if ‹bit w n›
for w :: ‹'a::len word›
using that by transfer simp

lemma not_bit_length [simp]:
‹¬ bit w LENGTH('a)› for w :: ‹'a::len word›
by transfer simp

lemma uint_take_bit_eq [code]:
‹uint (take_bit n w) = take_bit n (uint w)›

lemma take_bit_length_eq [simp]:
‹take_bit LENGTH('a) w = w› for w :: ‹'a::len word›
by transfer simp

lemma bit_word_of_int_iff:
‹bit (word_of_int k :: 'a::len word) n ⟷ n < LENGTH('a) ∧ bit k n›
by transfer rule

lemma bit_uint_iff:
‹bit (uint w) n ⟷ n < LENGTH('a) ∧ bit w n›
for w :: ‹'a::len word›

lemma bit_sint_iff:
‹bit (sint w) n ⟷ n ≥ LENGTH('a) ∧ bit w (LENGTH('a) - 1) ∨ bit w n›
for w :: ‹'a::len word›
by transfer (auto simp add: bit_signed_take_bit_iff min_def le_less not_less)

lemma bit_word_ucast_iff:
‹bit (ucast w :: 'b::len word) n ⟷ n < LENGTH('a) ∧ n < LENGTH('b) ∧ bit w n›
for w :: ‹'a::len word›
by transfer (simp add: bit_take_bit_iff ac_simps)

lemma bit_word_scast_iff:
‹bit (scast w :: 'b::len word) n ⟷
n < LENGTH('b) ∧ (bit w n ∨ LENGTH('a) ≤ n ∧ bit w (LENGTH('a) - Suc 0))›
for w :: ‹'a::len word›
by transfer (auto simp add: bit_signed_take_bit_iff le_less min_def)

lift_definition shiftl1 :: ‹'a::len word ⇒ 'a word›
is ‹(*) 2›
by (auto simp add: take_bit_eq_mod intro: mod_mult_cong)

lemma shiftl1_eq:
‹shiftl1 w = word_of_int (2 * uint w)›
by transfer (simp add: take_bit_eq_mod mod_simps)

lemma shiftl1_eq_mult_2:
‹shiftl1 = (*) 2›
by (rule ext, transfer) simp

lemma bit_shiftl1_iff:
‹bit (shiftl1 w) n ⟷ 0 < n ∧ n < LENGTH('a) ∧ bit w (n - 1)›
for w :: ‹'a::len word›

lift_definition shiftr1 :: ‹'a::len word ⇒ 'a word›
― ‹shift right as unsigned or as signed, ie logical or arithmetic›
is ‹λk. take_bit LENGTH('a) k div 2› by simp

lemma shiftr1_eq_div_2:
‹shiftr1 w = w div 2›
by transfer simp

lemma bit_shiftr1_iff:
‹bit (shiftr1 w) n ⟷ bit w (Suc n)›
by transfer (auto simp flip: bit_Suc simp add: bit_take_bit_iff)

lemma shiftr1_eq:
‹shiftr1 w = word_of_int (uint w div 2)›
by transfer simp

instantiation word :: (len) ring_bit_operations
begin

lift_definition not_word :: ‹'a word ⇒ 'a word›
is not

lift_definition and_word :: ‹'a word ⇒ 'a word ⇒ 'a word›
is ‹and›
by simp

lift_definition or_word :: ‹'a word ⇒ 'a word ⇒ 'a word›
is or
by simp

lift_definition xor_word ::  ‹'a word ⇒ 'a word ⇒ 'a word›
is xor
by simp

lift_definition mask_word :: ‹nat ⇒ 'a word›
.

instance by (standard; transfer)
bit_not_iff bit_and_iff bit_or_iff bit_xor_iff)

end

context
includes lifting_syntax
begin

lemma set_bit_word_transfer [transfer_rule]:
‹((=) ===> pcr_word ===> pcr_word) set_bit set_bit›
by (unfold set_bit_def) transfer_prover

lemma unset_bit_word_transfer [transfer_rule]:
‹((=) ===> pcr_word ===> pcr_word) unset_bit unset_bit›
by (unfold unset_bit_def) transfer_prover

lemma flip_bit_word_transfer [transfer_rule]:
‹((=) ===> pcr_word ===> pcr_word) flip_bit flip_bit›
by (unfold flip_bit_def) transfer_prover

end

instantiation word :: (len) semiring_bit_syntax
begin

lift_definition test_bit_word :: ‹'a::len word ⇒ nat ⇒ bool›
is ‹λk n. n < LENGTH('a) ∧ bit k n›
proof
fix k l :: int and n :: nat
assume *: ‹take_bit LENGTH('a) k = take_bit LENGTH('a) l›
show ‹n < LENGTH('a) ∧ bit k n ⟷ n < LENGTH('a) ∧ bit l n›
proof (cases ‹n < LENGTH('a)›)
case True
from * have ‹bit (take_bit LENGTH('a) k) n ⟷ bit (take_bit LENGTH('a) l) n›
by simp
then show ?thesis
next
case False
then show ?thesis
by simp
qed
qed

lemma test_bit_word_eq:
‹test_bit = (bit :: 'a word ⇒ _)›
by transfer simp

lemma bit_word_iff_drop_bit_and [code]:
‹bit a n ⟷ drop_bit n a AND 1 = 1› for a :: ‹'a::len word›
by (simp add: bit_iff_odd_drop_bit odd_iff_mod_2_eq_one and_one_eq)

lemma [code]:
‹test_bit a n ⟷ drop_bit n a AND 1 = 1› for a :: ‹'a::len word›

lift_definition shiftl_word :: ‹'a::len word ⇒ nat ⇒ 'a word›
is ‹λk n. push_bit n k›
proof -
show ‹take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)›
if ‹take_bit LENGTH('a) k = take_bit LENGTH('a) l› for k l :: int and n :: nat
proof -
from that
have ‹take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k)
= take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)›
by simp
moreover have ‹min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n›
by simp
ultimately show ?thesis
qed
qed

lemma shiftl_word_eq:
‹w << n = push_bit n w› for w :: ‹'a::len word›
by transfer rule

lift_definition shiftr_word :: ‹'a::len word ⇒ nat ⇒ 'a word›
is ‹λk n. drop_bit n (take_bit LENGTH('a) k)› by simp

lemma shiftr_word_eq:
‹w >> n = drop_bit n w› for w :: ‹'a::len word›
by transfer simp

instance
by (standard; transfer) simp_all

end

lemma shiftl_code [code]:
‹w << n = w * 2 ^ n›
for w :: ‹'a::len word›

lemma shiftl1_code [code]:
‹shiftl1 w = w << 1›
by transfer (simp add: push_bit_eq_mult ac_simps)

lemma uint_shiftr_eq [code]:
‹uint (w >> n) = uint w div 2 ^ n›
for w :: ‹'a::len word›
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit min_def le_less less_diff_conv)

lemma shiftr1_code [code]:
‹shiftr1 w = w >> 1›

lemma word_test_bit_def:
‹test_bit a = bit (uint a)›
by transfer (simp add: fun_eq_iff bit_take_bit_iff)

lemma shiftl_def:
‹w << n = (shiftl1 ^^ n) w›
proof -
have ‹push_bit n = (((*) 2 ^^ n) :: int ⇒ int)› for n
then show ?thesis
by transfer simp
qed

lemma shiftr_def:
‹w >> n = (shiftr1 ^^ n) w›
proof -
have ‹drop_bit n = (((λk::int. k div 2) ^^ n))› for n
by (rule sym, induction n)
(simp_all add: fun_eq_iff drop_bit_Suc flip: drop_bit_half)
then show ?thesis
apply transfer
apply simp
apply (metis bintrunc_bintrunc rco_bintr)
done
qed

lemma bit_shiftl_word_iff:
‹bit (w << m) n ⟷ m ≤ n ∧ n < LENGTH('a) ∧ bit w (n - m)›
for w :: ‹'a::len word›
by (simp add: shiftl_word_eq bit_push_bit_iff exp_eq_zero_iff not_le)

lemma [code]:
‹push_bit n w = w << n› for w :: ‹'a::len word›

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

lemma [code]:
‹drop_bit n w = w >> n› for w :: ‹'a::len word›

lemma [code]:
‹uint (take_bit n w) = (if n < LENGTH('a::len) then take_bit n (uint w) else uint w)›
for w :: ‹'a::len word›

lemma [code]:
by transfer simp

lemma [code_abbrev]:
‹push_bit n 1 = (2 :: 'a::len word) ^ n›
by (fact push_bit_of_1)

lemma
word_not_def [code]: "NOT (a::'a::len word) = word_of_int (NOT (uint a))"
and word_and_def: "(a::'a word) AND b = word_of_int (uint a AND uint b)"
and word_or_def: "(a::'a word) OR b = word_of_int (uint a OR uint b)"
and word_xor_def: "(a::'a word) XOR b = word_of_int (uint a XOR uint b)"

lemma [code abstract]:
‹uint (v AND w) = uint v AND uint w›
by transfer simp

lemma [code abstract]:
‹uint (v OR w) = uint v OR uint w›
by transfer simp

lemma [code abstract]:
‹uint (v XOR w) = uint v XOR uint w›
by transfer simp

lift_definition setBit :: ‹'a::len word ⇒ nat ⇒ 'a word›
is ‹λk n. set_bit n k›

lemma set_Bit_eq:
‹setBit w n = set_bit n w›
by transfer simp

lemma bit_setBit_iff:
‹bit (setBit w m) n ⟷ (m = n ∧ n < LENGTH('a) ∨ bit w n)›
for w :: ‹'a::len word›
by transfer (auto simp add: bit_set_bit_iff)

lift_definition clearBit :: ‹'a::len word ⇒ nat ⇒ 'a word›
is ‹λk n. unset_bit n k›

lemma clear_Bit_eq:
‹clearBit w n = unset_bit n w›
by transfer simp

lemma bit_clearBit_iff:
‹bit (clearBit w m) n ⟷ m ≠ n ∧ bit w n›
for w :: ‹'a::len word›
by transfer (auto simp add: bit_unset_bit_iff)

definition even_word :: ‹'a::len word ⇒ bool›
where [code_abbrev]: ‹even_word = even›

lemma even_word_iff [code]:
‹even_word a ⟷ a AND 1 = 0›
by (simp add: and_one_eq even_iff_mod_2_eq_zero even_word_def)

lemma map_bit_range_eq_if_take_bit_eq:
‹map (bit k) [0..<n] = map (bit l) [0..<n]›
if ‹take_bit n k = take_bit n l› for k l :: int
using that proof (induction n arbitrary: k l)
case 0
then show ?case
by simp
next
case (Suc n)
from Suc.prems have ‹take_bit n (k div 2) = take_bit n (l div 2)›
then have ‹map (bit (k div 2)) [0..<n] = map (bit (l div 2)) [0..<n]›
by (rule Suc.IH)
moreover have ‹bit (r div 2) = bit r ∘ Suc› for r :: int
moreover from Suc.prems have ‹even k ⟷ even l›
by (auto simp add: take_bit_Suc elim!: evenE oddE) arith+
ultimately show ?case
by (simp only: map_Suc_upt upt_conv_Cons flip: list.map_comp) simp
qed

subsection ‹More shift operations›

lift_definition sshiftr1 :: ‹'a::len word ⇒ 'a word›
is ‹λk. take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - 1) k div 2)›
by (simp flip: signed_take_bit_decr_length_iff)

lift_definition sshiftr :: ‹'a::len word ⇒ nat ⇒ 'a word›  (infixl ‹>>>› 55)
is ‹λk n. take_bit LENGTH('a) (drop_bit n (signed_take_bit (LENGTH('a) - 1) k))›
by (simp flip: signed_take_bit_decr_length_iff)

lift_definition bshiftr1 :: ‹bool ⇒ 'a::len word ⇒ 'a word›
is ‹λb k. take_bit LENGTH('a) k div 2 + of_bool b * 2 ^ (LENGTH('a) - Suc 0)›
by (fact arg_cong)

lemma sshiftr1_eq:
‹sshiftr1 w = word_of_int (sint w div 2)›
by transfer simp

lemma sshiftr_eq:
‹w >>> n = (sshiftr1 ^^ n) w›
proof -
have *: ‹(λk. take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - Suc 0) k div 2)) ^^ Suc n =
take_bit LENGTH('a) ∘ drop_bit (Suc n) ∘ signed_take_bit (LENGTH('a) - Suc 0)›
for n
apply (induction n)
apply (auto simp add: fun_eq_iff drop_bit_Suc)
apply (metis (no_types, lifting) Suc_pred funpow_swap1 len_gt_0 sbintrunc_bintrunc sbintrunc_rest)
done
show ?thesis
apply transfer
apply simp
subgoal for k n
apply (cases n)
apply (simp_all only: *)
apply simp_all
done
done
qed

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

lemma uint_sshiftr_eq [code]:
‹uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^  n)›
for w :: ‹'a::len word›
by transfer (simp flip: drop_bit_eq_div)

lemma sshift1_code [code]:
‹sshiftr1 w = w >>> 1›

subsection ‹Rotation›

lift_definition word_rotr :: ‹nat ⇒ 'a::len word ⇒ 'a::len word›
is ‹λn k. concat_bit (LENGTH('a) - n mod LENGTH('a))
(drop_bit (n mod LENGTH('a)) (take_bit LENGTH('a) k))
(take_bit (n mod LENGTH('a)) k)›
subgoal for n k l
apply (simp add: concat_bit_def nat_le_iff less_imp_le
take_bit_tightened [of ‹LENGTH('a)› k l ‹n mod LENGTH('a::len)›])
done
done

lift_definition word_rotl :: ‹nat ⇒ 'a::len word ⇒ 'a::len word›
is ‹λn k. concat_bit (n mod LENGTH('a))
(drop_bit (LENGTH('a) - n mod LENGTH('a)) (take_bit LENGTH('a) k))
(take_bit (LENGTH('a) - n mod LENGTH('a)) k)›
subgoal for n k l
apply (simp add: concat_bit_def nat_le_iff less_imp_le
take_bit_tightened [of ‹LENGTH('a)› k l ‹LENGTH('a) - n mod LENGTH('a::len)›])
done
done

lift_definition word_roti :: ‹int ⇒ 'a::len word ⇒ 'a::len word›
is ‹λr k. concat_bit (LENGTH('a) - nat (r mod int LENGTH('a)))
(drop_bit (nat (r mod int LENGTH('a))) (take_bit LENGTH('a) k))
(take_bit (nat (r mod int LENGTH('a))) k)›
subgoal for r k l
apply (simp add: concat_bit_def nat_le_iff less_imp_le
take_bit_tightened [of ‹LENGTH('a)› k l ‹nat (r mod int LENGTH('a::len))›])
done
done

lemma word_rotl_eq_word_rotr [code]:
‹word_rotl n = (word_rotr (LENGTH('a) - n mod LENGTH('a)) :: 'a::len word ⇒ 'a word)›
by (rule ext, cases ‹n mod LENGTH('a) = 0›; transfer) simp_all

lemma word_roti_eq_word_rotr_word_rotl [code]:
‹word_roti i w =
(if i ≥ 0 then word_rotr (nat i) w else word_rotl (nat (- i)) w)›
proof (cases ‹i ≥ 0›)
case True
moreover define n where ‹n = nat i›
ultimately have ‹i = int n›
by simp
moreover have ‹word_roti (int n) = (word_rotr n :: _ ⇒ 'a word)›
by (rule ext, transfer) (simp add: nat_mod_distrib)
ultimately show ?thesis
by simp
next
case False
moreover define n where ‹n = nat (- i)›
ultimately have ‹i = - int n› ‹n > 0›
by simp_all
moreover have ‹word_roti (- int n) = (word_rotl n :: _ ⇒ 'a word)›
by (rule ext, transfer)
(simp add: zmod_zminus1_eq_if flip: of_nat_mod of_nat_diff)
ultimately show ?thesis
by simp
qed

lemma bit_word_rotr_iff:
‹bit (word_rotr m w) n ⟷
n < LENGTH('a) ∧ bit w ((n + m) mod LENGTH('a))›
for w :: ‹'a::len word›
proof transfer
fix k :: int and m n :: nat
define q where ‹q = m mod LENGTH('a)›
have ‹q < LENGTH('a)›
then have ‹q ≤ LENGTH('a)›
by simp
have ‹m mod LENGTH('a) = q›
moreover have ‹(n + m) mod LENGTH('a) = (n + q) mod LENGTH('a)›
moreover have ‹n < LENGTH('a) ∧
bit (concat_bit (LENGTH('a) - q) (drop_bit q (take_bit LENGTH('a) k)) (take_bit q k)) n ⟷
n < LENGTH('a) ∧ bit k ((n + q) mod LENGTH('a))›
using ‹q < LENGTH('a)›
by (cases ‹q + n ≥ LENGTH('a)›)
bit_take_bit_iff le_mod_geq ac_simps)
ultimately show ‹n < LENGTH('a) ∧
bit (concat_bit (LENGTH('a) - m mod LENGTH('a))
(drop_bit (m mod LENGTH('a)) (take_bit LENGTH('a) k))
(take_bit (m mod LENGTH('a)) k)) n
⟷ n < LENGTH('a) ∧
(n + m) mod LENGTH('a) < LENGTH('a) ∧
bit k ((n + m) mod LENGTH('a))›
by simp
qed

lemma bit_word_rotl_iff:
‹bit (word_rotl m w) n ⟷
n < LENGTH('a) ∧ bit w ((n + (LENGTH('a) - m mod LENGTH('a))) mod LENGTH('a))›
for w :: ‹'a::len word›

lemma bit_word_roti_iff:
‹bit (word_roti k w) n ⟷
n < LENGTH('a) ∧ bit w (nat ((int n + k) mod int LENGTH('a)))›
for w :: ‹'a::len word›
proof transfer
fix k l :: int and n :: nat
define m where ‹m = nat (k mod int LENGTH('a))›
have ‹m < LENGTH('a)›
then have ‹m ≤ LENGTH('a)›
by simp
have ‹k mod int LENGTH('a) = int m›
moreover have ‹(int n + k) mod int LENGTH('a) = int ((n + m) mod LENGTH('a))›
by (subst mod_add_right_eq [symmetric]) (simp add: of_nat_mod ‹k mod int LENGTH('a) = int m›)
moreover have ‹n < LENGTH('a) ∧
bit (concat_bit (LENGTH('a) - m) (drop_bit m (take_bit LENGTH('a) l)) (take_bit m l)) n ⟷
n < LENGTH('a) ∧ bit l ((n + m) mod LENGTH('a))›
using ‹m < LENGTH('a)›
by (cases ‹m + n ≥ LENGTH('a)›)
bit_take_bit_iff nat_less_iff not_le not_less ac_simps
le_diff_conv le_mod_geq)
ultimately show ‹n < LENGTH('a)
∧ bit (concat_bit (LENGTH('a) - nat (k mod int LENGTH('a)))
(drop_bit (nat (k mod int LENGTH('a))) (take_bit LENGTH('a) l))
(take_bit (nat (k mod int LENGTH('a))) l)) n ⟷
n < LENGTH('a)
∧ nat ((int n + k) mod int LENGTH('a)) < LENGTH('a)
∧ bit l (nat ((int n + k) mod int LENGTH('a)))›
by simp
qed

lemma uint_word_rotr_eq [code]:
‹uint (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a))
(drop_bit (n mod LENGTH('a)) (uint w))
(uint (take_bit (n mod LENGTH('a)) w))›
for w :: ‹'a::len word›
apply transfer
apply (simp add: concat_bit_def take_bit_drop_bit push_bit_take_bit min_def)
using mod_less_divisor not_less apply blast
done

subsection ‹Split and cat operations›

lift_definition word_cat :: ‹'a::len word ⇒ 'b::len word ⇒ 'c::len word›
is ‹λk l. concat_bit LENGTH('b) l (take_bit LENGTH('a) k)›
by (simp add: bit_eq_iff bit_concat_bit_iff bit_take_bit_iff)

lemma word_cat_eq:
‹(word_cat v w :: 'c::len word) = push_bit LENGTH('b) (ucast v) + ucast w›
for v :: ‹'a::len word› and w :: ‹'b::len word›
by transfer (simp add: concat_bit_eq ac_simps)

lemma word_cat_eq' [code]:
‹word_cat a b = word_of_int (concat_bit LENGTH('b) (uint b) (uint a))›
for a :: ‹'a::len word› and b :: ‹'b::len word›
by transfer simp

lemma bit_word_cat_iff:
‹bit (word_cat v w :: 'c::len word) n ⟷ n < LENGTH('c) ∧ (if n < LENGTH('b) then bit w n else bit v (n - LENGTH('b)))›
for v :: ‹'a::len word› and w :: ‹'b::len word›
by transfer (simp add: bit_concat_bit_iff bit_take_bit_iff)

definition word_split :: "'a::len word ⇒ 'b::len word × 'c::len word"
where "word_split a =
(case bin_split (LENGTH('c)) (uint a) of
(u, v) ⇒ (word_of_int u, word_of_int v))"

definition word_rcat :: ‹'a::len word list ⇒ 'b::len word›
where ‹word_rcat = word_of_int ∘ horner_sum uint (2 ^ LENGTH('a)) ∘ rev›

lemma word_rcat_eq:
‹word_rcat ws = word_of_int (bin_rcat (LENGTH('a::len)) (map uint ws))›
for ws :: ‹'a::len word list›
apply (simp add: word_rcat_def bin_rcat_def rev_map)
apply transfer
apply (simp add: horner_sum_foldr foldr_map comp_def)
done

definition word_rsplit :: "'a::len word ⇒ 'b::len word list"
where "word_rsplit w = map word_of_int (bin_rsplit (LENGTH('b)) (LENGTH('a), uint w))"

abbreviation (input) max_word :: ‹'a::len word›
― ‹Largest representable machine integer.›
where "max_word ≡ - 1"

lemma sint_sbintrunc': "sint (word_of_int bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) bin"
by (auto simp: sint_uint word_ubin.eq_norm sbintrunc_bintrunc_lt)

lemma uint_sint: "uint w = take_bit (LENGTH('a)) (sint w)"
for w :: "'a::len word"
by (auto simp: sint_uint bintrunc_sbintrunc_le)

lemma bintr_uint: "LENGTH('a) ≤ n ⟹ take_bit n (uint w) = uint w"
for w :: "'a::len word"
apply (subst word_ubin.norm_Rep [symmetric])
apply (simp only: bintrunc_bintrunc_min word_size)
done

lemma wi_bintr:
"LENGTH('a::len) ≤ n ⟹
word_of_int (take_bit n w) = (word_of_int w :: 'a word)"
by (auto simp: word_ubin.norm_eq_iff [symmetric] min.absorb1)

lemma td_ext_sbin:
"td_ext (sint :: 'a word ⇒ int) word_of_int (sints (LENGTH('a::len)))
(signed_take_bit (LENGTH('a) - 1))"
apply (unfold td_ext_def' sint_uint)
apply (cases "LENGTH('a)")
apply (auto simp add : sints_def)
apply (rule sym [THEN trans])
apply (rule word_ubin.Abs_norm)
apply (simp only: bintrunc_sbintrunc)
apply (drule sym)
apply simp
done

lemma td_ext_sint:
"td_ext (sint :: 'a word ⇒ int) word_of_int (sints (LENGTH('a::len)))
(λw. (w + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) -
2 ^ (LENGTH('a) - 1))"
using td_ext_sbin [where ?'a = 'a] by (simp add: no_sbintr_alt2)

text ‹
We do ‹sint› before ‹sbin›, before ‹sint› is the user version
and interpretations do not produce thm duplicates. I.e.
we get the name ‹word_sint.Rep_eqD›, but not ‹word_sbin.Req_eqD›,
because the latter is the same thm as the former.
›
interpretation word_sint:
td_ext
"sint ::'a::len word ⇒ int"
word_of_int
"sints (LENGTH('a::len))"
"λw. (w + 2^(LENGTH('a::len) - 1)) mod 2^LENGTH('a::len) -
2 ^ (LENGTH('a::len) - 1)"
by (rule td_ext_sint)

interpretation word_sbin:
td_ext
"sint ::'a::len word ⇒ int"
word_of_int
"sints (LENGTH('a::len))"
"signed_take_bit (LENGTH('a::len) - 1)"
by (rule td_ext_sbin)

lemmas int_word_sint = td_ext_sint [THEN td_ext.eq_norm]

lemmas td_sint = word_sint.td

lemma uints_mod: "uints n = range (λw. w mod 2 ^ n)"
by (fact uints_def [unfolded no_bintr_alt1])

lemma word_numeral_alt: "numeral b = word_of_int (numeral b)"
by (induct b, simp_all only: numeral.simps word_of_int_homs)

declare word_numeral_alt [symmetric, code_abbrev]

lemma word_neg_numeral_alt: "- numeral b = word_of_int (- numeral b)"
by (simp only: word_numeral_alt wi_hom_neg)

declare word_neg_numeral_alt [symmetric, code_abbrev]

lemma uint_bintrunc [simp]:
"uint (numeral bin :: 'a word) =
take_bit (LENGTH('a::len)) (numeral bin)"
unfolding word_numeral_alt by (rule word_ubin.eq_norm)

lemma uint_bintrunc_neg [simp]:
"uint (- numeral bin :: 'a word) = take_bit (LENGTH('a::len)) (- numeral bin)"
by (simp only: word_neg_numeral_alt word_ubin.eq_norm)

lemma sint_sbintrunc [simp]:
"sint (numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (numeral bin)"
by (simp only: word_numeral_alt word_sbin.eq_norm)

lemma sint_sbintrunc_neg [simp]:
"sint (- numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (- numeral bin)"
by (simp only: word_neg_numeral_alt word_sbin.eq_norm)

lemma unat_bintrunc [simp]:
"unat (numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (numeral bin))"
by transfer simp

lemma unat_bintrunc_neg [simp]:
"unat (- numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (- numeral bin))"
by transfer simp

lemma size_0_eq: "size w = 0 ⟹ v = w"
for v w :: "'a::len word"
apply (unfold word_size)
apply (rule word_uint.Rep_eqD)
apply (rule box_equals)
defer
apply (rule word_ubin.norm_Rep)+
apply simp
done

lemma uint_ge_0 [iff]: "0 ≤ uint x"
for x :: "'a::len word"
using word_uint.Rep [of x] by (simp add: uints_num)

lemma uint_lt2p [iff]: "uint x < 2 ^ LENGTH('a)"
for x :: "'a::len word"
using word_uint.Rep [of x] by (simp add: uints_num)

lemma word_exp_length_eq_0 [simp]:
‹(2 :: 'a::len word) ^ LENGTH('a) = 0›

lemma sint_ge: "- (2 ^ (LENGTH('a) - 1)) ≤ sint x"
for x :: "'a::len word"
using word_sint.Rep [of x] by (simp add: sints_num)

lemma sint_lt: "sint x < 2 ^ (LENGTH('a) - 1)"
for x :: "'a::len word"
using word_sint.Rep [of x] by (simp add: sints_num)

lemma sign_uint_Pls [simp]: "bin_sign (uint x) = 0"

lemma uint_m2p_neg: "uint x - 2 ^ LENGTH('a) < 0"
for x :: "'a::len word"
by (simp only: diff_less_0_iff_less uint_lt2p)

lemma uint_m2p_not_non_neg: "¬ 0 ≤ uint x - 2 ^ LENGTH('a)"
for x :: "'a::len word"
by (simp only: not_le uint_m2p_neg)

lemma lt2p_lem: "LENGTH('a) ≤ n ⟹ uint w < 2 ^ n"
for w :: "'a::len word"
by (metis bintr_lt2p bintr_uint)

lemma uint_le_0_iff [simp]: "uint x ≤ 0 ⟷ uint x = 0"
by (fact uint_ge_0 [THEN leD, THEN antisym_conv1])

lemma uint_nat: "uint w = int (unat w)"
by transfer simp

lemma uint_numeral: "uint (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
by (simp only: word_numeral_alt int_word_uint)

lemma uint_neg_numeral: "uint (- numeral b :: 'a::len word) = - numeral b mod 2 ^ LENGTH('a)"
by (simp only: word_neg_numeral_alt int_word_uint)

lemma unat_numeral: "unat (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
by transfer (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)

lemma sint_numeral:
"sint (numeral b :: 'a::len word) =
(numeral b +
2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) -
2 ^ (LENGTH('a) - 1)"
unfolding word_numeral_alt by (rule int_word_sint)

lemma word_of_int_0 [simp, code_post]: "word_of_int 0 = 0"
unfolding word_0_wi ..

lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1"
unfolding word_1_wi ..

lemma word_of_int_neg_1 [simp]: "word_of_int (- 1) = - 1"

lemma word_of_int_numeral [simp] : "(word_of_int (numeral bin) :: 'a::len word) = numeral bin"
by (simp only: word_numeral_alt)

lemma word_of_int_neg_numeral [simp]:
"(word_of_int (- numeral bin) :: 'a::len word) = - numeral bin"
by (simp only: word_numeral_alt wi_hom_syms)

lemma word_int_case_wi:
"word_int_case f (word_of_int i :: 'b word) = f (i mod 2 ^ LENGTH('b::len))"

lemma word_int_split:
"P (word_int_case f x) =
(∀i. x = (word_of_int i :: 'b::len word) ∧ 0 ≤ i ∧ i < 2 ^ LENGTH('b) ⟶ P (f i))"
by transfer (auto simp add: take_bit_eq_mod)

lemma word_int_split_asm:
"P (word_int_case f x) =
(∄n. x = (word_of_int n :: 'b::len word) ∧ 0 ≤ n ∧ n < 2 ^ LENGTH('b::len) ∧ ¬ P (f n))"
by transfer (auto simp add: take_bit_eq_mod)

lemmas uint_range' = word_uint.Rep [unfolded uints_num mem_Collect_eq]
lemmas sint_range' = word_sint.Rep [unfolded One_nat_def sints_num mem_Collect_eq]

lemma uint_range_size: "0 ≤ uint w ∧ uint w < 2 ^ size w"
unfolding word_size by (rule uint_range')

lemma sint_range_size: "- (2 ^ (size w - Suc 0)) ≤ sint w ∧ sint w < 2 ^ (size w - Suc 0)"
unfolding word_size by (rule sint_range')

lemma sint_above_size: "2 ^ (size w - 1) ≤ x ⟹ sint w < x"
for w :: "'a::len word"
unfolding word_size by (rule less_le_trans [OF sint_lt])

lemma sint_below_size: "x ≤ - (2 ^ (size w - 1)) ⟹ x ≤ sint w"
for w :: "'a::len word"
unfolding word_size by (rule order_trans [OF _ sint_ge])

subsection ‹Testing bits›

lemma test_bit_eq_iff: "test_bit u = test_bit v ⟷ u = v"
for u v :: "'a::len word"
unfolding word_test_bit_def by (simp add: bin_nth_eq_iff)

lemma test_bit_size [rule_format] : "w !! n ⟶ n < size w"
for w :: "'a::len word"
apply (unfold word_test_bit_def)
apply (subst word_ubin.norm_Rep [symmetric])
apply (simp only: nth_bintr word_size)
apply fast
done

lemma word_eq_iff: "x = y ⟷ (∀n<LENGTH('a). x !! n = y !! n)" (is ‹?P ⟷ ?Q›)
for x y :: "'a::len word"
proof
assume ?P
then show ?Q
by simp
next
assume ?Q
then have *: ‹bit (uint x) n ⟷ bit (uint y) n› if ‹n < LENGTH('a)› for n
using that by (simp add: word_test_bit_def)
show ?P
proof (rule word_uint_eqI, rule bit_eqI, rule iffI)
fix n
assume ‹bit (uint x) n›
then have ‹n < LENGTH('a)›
with * ‹bit (uint x) n›
show ‹bit (uint y) n›
by simp
next
fix n
assume ‹bit (uint y) n›
then have ‹n < LENGTH('a)›
with * ‹bit (uint y) n›
show ‹bit (uint x) n›
by simp
qed
qed

lemma word_eqI: "(⋀n. n < size u ⟶ u !! n = v !! n) ⟹ u = v"
for u :: "'a::len word"

lemma word_eqD: "u = v ⟹ u !! x = v !! x"
for u v :: "'a::len word"
by simp

lemma test_bit_bin': "w !! n ⟷ n < size w ∧ bin_nth (uint w) n"
by (simp add: word_test_bit_def word_size nth_bintr [symmetric])

lemmas test_bit_bin = test_bit_bin' [unfolded word_size]

lemma bin_nth_uint_imp: "bin_nth (uint w) n ⟹ n < LENGTH('a)"
for w :: "'a::len word"
apply (rule nth_bintr [THEN iffD1, THEN conjunct1])
apply (subst word_ubin.norm_Rep)
apply assumption
done

lemma bin_nth_sint:
"LENGTH('a) ≤ n ⟹
bin_nth (sint w) n = bin_nth (sint w) (LENGTH('a) - 1)"
for w :: "'a::len word"
apply (subst word_sbin.norm_Rep [symmetric])
done

lemmas bintr_num =
word_ubin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b
lemmas sbintr_num =
word_sbin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b

lemma num_of_bintr':
"take_bit (LENGTH('a::len)) (numeral a :: int) = (numeral b) ⟹
numeral a = (numeral b :: 'a word)"
unfolding bintr_num by (erule subst, simp)

lemma num_of_sbintr':
"signed_take_bit (LENGTH('a::len) - 1) (numeral a) = (numeral b) ⟹
numeral a = (numeral b :: 'a word)"
unfolding sbintr_num by (erule subst, simp)

lemma num_abs_bintr:
"(numeral x :: 'a word) =
word_of_int (take_bit (LENGTH('a::len)) (numeral x))"
by (simp only: word_ubin.Abs_norm word_numeral_alt)

lemma num_abs_sbintr:
"(numeral x :: 'a word) =
word_of_int (signed_take_bit (LENGTH('a::len) - 1) (numeral x))"
by (simp only: word_sbin.Abs_norm word_numeral_alt)

text ‹
‹cast› -- note, no arg for new length, as it's determined by type of result,
thus in ‹cast w = w›, the type means cast to length of ‹w›!
›

lemma bit_ucast_iff:
‹bit (ucast a :: 'a::len word) n ⟷ n < LENGTH('a::len) ∧ Parity.bit a n›

lemma ucast_id [simp]: "ucast w = w"
by transfer simp

lemma scast_id [simp]: "scast w = w"
by transfer simp

lemma nth_ucast: "(ucast w::'a::len word) !! n = (w !! n ∧ n < LENGTH('a))"
by transfer (simp add: bit_take_bit_iff ac_simps)

― ‹literal u(s)cast›
lemma ucast_bintr [simp]:
"ucast (numeral w :: 'a::len word) =
word_of_int (take_bit (LENGTH('a)) (numeral w))"
by transfer simp

(* TODO: neg_numeral *)

lemma scast_sbintr [simp]:
"scast (numeral w ::'a::len word) =
word_of_int (signed_take_bit (LENGTH('a) - Suc 0) (numeral w))"
by transfer simp

lemma source_size: "source_size (c::'a::len word ⇒ _) = LENGTH('a)"
by transfer simp

lemma target_size: "target_size (c::_ ⇒ 'b::len word) = LENGTH('b)"
by transfer simp

lemma is_down: "is_down c ⟷ LENGTH('b) ≤ LENGTH('a)"
for c :: "'a::len word ⇒ 'b::len word"
by transfer simp

lemma is_up: "is_up c ⟷ LENGTH('a) ≤ LENGTH('b)"
for c :: "'a::len word ⇒ 'b::len word"
by transfer simp

lemma is_up_down:
‹is_up c ⟷ is_down d›
for c :: ‹'a::len word ⇒ 'b::len word›
and d :: ‹'b::len word ⇒ 'a::len word›
by transfer simp

context
fixes dummy_types :: ‹'a::len × 'b::len›
begin

private abbreviation (input) UCAST :: ‹'a::len word ⇒ 'b::len word›
where ‹UCAST == ucast›

private abbreviation (input) SCAST :: ‹'a::len word ⇒ 'b::len word›
where ‹SCAST == scast›

lemma down_cast_same:
‹UCAST = scast› if ‹is_down UCAST›
by (rule ext, use that in transfer) (simp add: take_bit_signed_take_bit)

lemma sint_up_scast:
‹sint (SCAST w) = sint w› if ‹is_up SCAST›
using that by transfer (simp add: min_def Suc_leI le_diff_iff)

lemma uint_up_ucast:
‹uint (UCAST w) = uint w› if ‹is_up UCAST›
using that by transfer (simp add: min_def)

lemma ucast_up_ucast:
‹ucast (UCAST w) = ucast w› if ‹is_up UCAST›
using that by transfer (simp add: ac_simps)

lemma ucast_up_ucast_id:
‹ucast (UCAST w) = w› if ‹is_up UCAST›
using that by (simp add: ucast_up_ucast)

lemma scast_up_scast:
‹scast (SCAST w) = scast w› if ‹is_up SCAST›
using that by transfer (simp add: ac_simps)

lemma scast_up_scast_id:
‹scast (SCAST w) = w› if ‹is_up SCAST›
using that by (simp add: scast_up_scast)

lemma isduu:
‹is_up UCAST› if ‹is_down d›
for d :: ‹'b word ⇒ 'a word›
using that is_up_down [of UCAST d] by simp

lemma isdus:
‹is_up SCAST› if ‹is_down d›
for d :: ‹'b word ⇒ 'a word›
using that is_up_down [of SCAST d] by simp

lemmas ucast_down_ucast_id = isduu [THEN ucast_up_ucast_id]
lemmas scast_down_scast_id = isdus [THEN scast_up_scast_id]

lemma up_ucast_surj:
‹surj (ucast :: 'b word ⇒ 'a word)› if ‹is_up UCAST›
by (rule surjI) (use that in ‹rule ucast_up_ucast_id›)

lemma up_scast_surj:
‹surj (scast :: 'b word ⇒ 'a word)› if ‹is_up SCAST›
by (rule surjI) (use that in ‹rule scast_up_scast_id›)

lemma down_ucast_inj:
‹inj_on UCAST A› if ‹is_down (ucast :: 'b word ⇒ 'a word)›
by (rule inj_on_inverseI) (use that in ‹rule ucast_down_ucast_id›)

lemma down_scast_inj:
‹inj_on SCAST A› if ‹is_down (scast :: 'b word ⇒ 'a word)›
by (rule inj_on_inverseI) (use that in ‹rule scast_down_scast_id›)

lemma ucast_down_wi:
‹UCAST (word_of_int x) = word_of_int x› if ‹is_down UCAST›
using that by transfer simp

lemma ucast_down_no:
‹UCAST (numeral bin) = numeral bin› if ‹is_down UCAST›
using that by transfer simp

end

lemmas test_bit_def' = word_test_bit_def [THEN fun_cong]

lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def

lemma bit_last_iff:
‹bit w (LENGTH('a) - Suc 0) ⟷ sint w < 0› (is ‹?P ⟷ ?Q›)
for w :: ‹'a::len word›
proof -
have ‹?P ⟷ bit (uint w) (LENGTH('a) - Suc 0)›
also have ‹… ⟷ ?Q›
finally show ?thesis .
qed

lemma drop_bit_eq_zero_iff_not_bit_last:
‹drop_bit (LENGTH('a) - Suc 0) w = 0 ⟷ ¬ bit w (LENGTH('a) - Suc 0)›
for w :: "'a::len word"
apply (cases ‹LENGTH('a)›)
apply simp_all
apply transfer
apply (auto simp add: drop_bit_eq_div take_bit_eq_mod min_def)
apply (auto elim!: evenE)
apply (metis div_exp_eq mod_div_trivial mult.commute nonzero_mult_div_cancel_left power_Suc0_right power_add zero_neq_numeral)
done

subsection ‹Word Arithmetic›

lemma word_less_alt: "a < b ⟷ uint a < uint b"
by (fact word_less_def)

lemma signed_linorder: "class.linorder word_sle word_sless"
by (standard; transfer) (auto simp add: signed_take_bit_decr_length_iff)

interpretation signed: linorder "word_sle" "word_sless"
by (rule signed_linorder)

lemma udvdI: "0 ≤ n ⟹ uint b = n * uint a ⟹ a udvd b"
by (auto simp: udvd_def)

lemmas word_div_no [simp] = word_div_def [of "numeral a" "numeral b"] for a b
lemmas word_mod_no [simp] = word_mod_def [of "numeral a" "numeral b"] for a b
lemmas word_less_no [simp] = word_less_def [of "numeral a" "numeral b"] for a b
lemmas word_le_no [simp] = word_le_def [of "numeral a" "numeral b"] for a b
lemmas word_sless_no [simp] = word_sless_eq [of "numeral a" "numeral b"] for a b
lemmas word_sle_no [simp] = word_sle_eq [of "numeral a" "numeral b"] for a b

lemma word_m1_wi: "- 1 = word_of_int (- 1)"
by (simp add: word_neg_numeral_alt [of Num.One])

lemma uint_0_iff: "uint x = 0 ⟷ x = 0"

lemma unat_0_iff: "unat x = 0 ⟷ x = 0"
by transfer (auto intro: antisym)

lemma unat_0 [simp]: "unat 0 = 0"
by transfer simp

lemma size_0_same': "size w = 0 ⟹ w = v"
for v w :: "'a::len word"
by (unfold word_size) simp

lemmas size_0_same = size_0_same' [unfolded word_size]

lemmas unat_eq_0 = unat_0_iff
lemmas unat_eq_zero = unat_0_iff

lemma unat_gt_0: "0 < unat x ⟷ x ≠ 0"
by (auto simp: unat_0_iff [symmetric])

lemma ucast_0 [simp]: "ucast 0 = 0"
by transfer simp

lemma sint_0 [simp]: "sint 0 = 0"

lemma scast_0 [simp]: "scast 0 = 0"
by transfer simp

lemma sint_n1 [simp] : "sint (- 1) = - 1"
by transfer simp

lemma scast_n1 [simp]: "scast (- 1) = - 1"
by transfer simp

lemma uint_1: "uint (1::'a::len word) = 1"
by (fact uint_1_eq)

lemma unat_1 [simp]: "unat (1::'a::len word) = 1"
by transfer simp

lemma ucast_1 [simp]: "ucast (1::'a::len word) = 1"
by transfer simp

― ‹now, to get the weaker results analogous to ‹word_div›/‹mod_def››

subsection ‹Transferring goals from words to ints›

lemma word_ths:
shows word_succ_p1: "word_succ a = a + 1"
and word_pred_m1: "word_pred a = a - 1"
and word_pred_succ: "word_pred (word_succ a) = a"
and word_succ_pred: "word_succ (word_pred a) = a"
and word_mult_succ: "word_succ a * b = b + a * b"

lemma uint_cong: "x = y ⟹ uint x = uint y"
by simp

lemma uint_word_ariths:
fixes a b :: "'a::len word"
shows "uint (a + b) = (uint a + uint b) mod 2 ^ LENGTH('a::len)"
and "uint (a - b) = (uint a - uint b) mod 2 ^ LENGTH('a)"
and "uint (a * b) = uint a * uint b mod 2 ^ LENGTH('a)"
and "uint (- a) = - uint a mod 2 ^ LENGTH('a)"
and "uint (word_succ a) = (uint a + 1) mod 2 ^ LENGTH('a)"
and "uint (word_pred a) = (uint a - 1) mod 2 ^ LENGTH('a)"
and "uint (0 :: 'a word) = 0 mod 2 ^ LENGTH('a)"
and "uint (1 :: 'a word) = 1 mod 2 ^ LENGTH('a)"
apply (simp_all only: word_arith_wis)
done

lemma uint_word_arith_bintrs:
fixes a b :: "'a::len word"
shows "uint (a + b) = take_bit (LENGTH('a)) (uint a + uint b)"
and "uint (a - b) = take_bit (LENGTH('a)) (uint a - uint b)"
and "uint (a * b) = take_bit (LENGTH('a)) (uint a * uint b)"
and "uint (- a) = take_bit (LENGTH('a)) (- uint a)"
and "uint (word_succ a) = take_bit (LENGTH('a)) (uint a + 1)"
and "uint (word_pred a) = take_bit (LENGTH('a)) (uint a - 1)"
and "uint (0 :: 'a word) = take_bit (LENGTH('a)) 0"
and "uint (1 :: 'a word) = take_bit (LENGTH('a)) 1"

lemma sint_word_ariths:
fixes a b :: "'a::len word"
shows "sint (a + b) = signed_take_bit (LENGTH('a) - 1) (sint a + sint b)"
and "sint (a - b) = signed_take_bit (LENGTH('a) - 1) (sint a - sint b)"
and "sint (a * b) = signed_take_bit (LENGTH('a) - 1) (sint a * sint b)"
and "sint (- a) = signed_take_bit (LENGTH('a) - 1) (- sint a)"
and "sint (word_succ a) = signed_take_bit (LENGTH('a) - 1) (sint a + 1)"
and "sint (word_pred a) = signed_take_bit (LENGTH('a) - 1) (sint a - 1)"
and "sint (0 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 0"
and "sint (1 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 1"
apply (simp_all only: word_sbin.inverse_norm [symmetric])
apply transfer apply simp
apply transfer apply simp
done

lemmas uint_div_alt = word_div_def [THEN trans [OF uint_cong int_word_uint]]
lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]]

lemma word_pred_0_n1: "word_pred 0 = word_of_int (- 1)"
unfolding word_pred_m1 by simp

lemma succ_pred_no [simp]:
"word_succ (numeral w) = numeral w + 1"
"word_pred (numeral w) = numeral w - 1"
"word_succ (- numeral w) = - numeral w + 1"
"word_pred (- numeral w) = - numeral w - 1"

lemma word_sp_01 [simp]:
"word_succ (- 1) = 0 ∧ word_succ 0 = 1 ∧ word_pred 0 = - 1 ∧ word_pred 1 = 0"

― ‹alternative approach to lifting arithmetic equalities›
lemma word_of_int_Ex: "∃y. x = word_of_int y"
by (rule_tac x="uint x" in exI) simp

subsection ‹Order on fixed-length words›

lemma word_zero_le [simp]: "0 ≤ y"
for y :: "'a::len word"
unfolding word_le_def by auto

lemma word_m1_ge [simp] : "word_pred 0 ≥ y" (* FIXME: delete *)

lemma word_n1_ge [simp]: "y ≤ -1"
for y :: "'a::len word"
by (fact word_order.extremum)

lemmas word_not_simps [simp] =
word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD]

lemma word_gt_0: "0 < y ⟷ 0 ≠ y"
for y :: "'a::len word"

lemmas word_gt_0_no [simp] = word_gt_0 [of "numeral y"] for y

lemma word_sless_alt: "a <s b ⟷ sint a < sint b"
by (auto simp add: word_sle_eq word_sless_eq less_le)

lemma word_le_nat_alt: "a ≤ b ⟷ unat a ≤ unat b"

lemma word_less_nat_alt: "a < b ⟷ unat a < unat b"
by transfer (auto simp add: less_le [of 0])

lemmas unat_mono = word_less_nat_alt [THEN iffD1]

instance word :: (len) wellorder
proof
fix P :: "'a word ⇒ bool" and a
assume *: "(⋀b. (⋀a. a < b ⟹ P a) ⟹ P b)"
have "wf (measure unat)" ..
moreover have "{(a, b :: ('a::len) word). a < b} ⊆ measure unat"
ultimately have "wf {(a, b :: ('a::len) word). a < b}"
by (rule wf_subset)
then show "P a" using *
by induction blast
qed

lemma wi_less:
"(word_of_int n < (word_of_int m :: 'a::len word)) =
(n mod 2 ^ LENGTH('a) < m mod 2 ^ LENGTH('a))"
unfolding word_less_alt by (simp add: word_uint.eq_norm)

lemma wi_le:
"(word_of_int n ≤ (word_of_int m :: 'a::len word)) =
(n mod 2 ^ LENGTH('a) ≤ m mod 2 ^ LENGTH('a))"
unfolding word_le_def by (simp add: word_uint.eq_norm)

lemma udvd_nat_alt: "a udvd b ⟷ (∃n≥0. unat b = n * unat a)"
supply nat_uint_eq [simp del]
apply (unfold udvd_def)
apply safe
apply (rule exI)
apply safe
prefer 2
apply (erule notE)
apply (rule refl)
apply force
done

lemma udvd_iff_dvd: "x udvd y ⟷ unat x dvd unat y"
unfolding dvd_def udvd_nat_alt by force

lemma unat_minus_one:
‹unat (w - 1) = unat w - 1› if ‹w ≠ 0›
proof -
have "0 ≤ uint w" by (fact uint_nonnegative)
moreover from that have "0 ≠ uint w"
ultimately have "1 ≤ uint w"
by arith
from uint_lt2p [of w] have "uint w - 1 < 2 ^ LENGTH('a)"
by arith
with ‹1 ≤ uint w› have "(uint w - 1) mod 2 ^ LENGTH('a) = uint w - 1"
by (auto intro: mod_pos_pos_trivial)
with ‹1 ≤ uint w› have "nat ((uint w - 1) mod 2 ^ LENGTH('a)) = nat (uint w) - 1"
by (auto simp del: nat_uint_eq)
then show ?thesis
by (simp only: unat_eq_nat_uint int_word_uint word_arith_wis mod_diff_right_eq)
qed

lemma measure_unat: "p ≠ 0 ⟹ unat (p - 1) < unat p"

lemmas uint_mult_ge0 [simp] = mult_nonneg_nonneg [OF uint_ge_0 uint_ge_0]

lemma uint_sub_lt2p [simp]: "uint x - uint y < 2 ^ LENGTH('a)"
for x :: "'a::len word" and y :: "'b::len word"
using uint_ge_0 [of y] uint_lt2p [of x] by arith

subsection ‹Conditions for the addition (etc) of two words to overflow›

"(uint x + uint y < 2 ^ LENGTH('a)) =
(uint (x + y) = uint x + uint y)"
for x y :: "'a::len word"

lemma uint_mult_lem:
"(uint x * uint y < 2 ^ LENGTH('a)) =
(uint (x * y) = uint x * uint y)"
for x y :: "'a::len word"
by (metis mod_pos_pos_trivial uint_lt2p uint_mult_ge0 uint_word_ariths(3))

lemma uint_sub_lem: "uint x ≥ uint y ⟷ uint (x - y) = uint x - uint y"
by (metis (mono_tags, hide_lams) diff_ge_0_iff_ge mod_pos_pos_trivial of_nat_0_le_iff take_bit_eq_mod uint_nat uint_sub_lt2p word_sub_wi word_ubin.eq_norm)  find_theorems uint ‹- _›

lemma uint_add_le: "uint (x + y) ≤ uint x + uint y"
unfolding uint_word_ariths by (simp add: zmod_le_nonneg_dividend)

lemma uint_sub_ge: "uint (x - y) ≥ uint x - uint y"
unfolding uint_word_ariths by (simp add: int_mod_ge)

"x < z ⟹ y < z ⟹ 0 ≤ y ⟹ 0 ≤ x ⟹ 0 ≤ z ⟹
(x + y) mod z = (if x + y < z then x + y else x + y - z)"
for x y z :: int
apply (rule antisym)
apply (metis diff_ge_0_iff_ge minus_mod_self2 zmod_le_nonneg_dividend)
apply (simp only: flip: minus_mod_self2 [of ‹x + y› z])
apply (rule int_mod_ge)
apply simp_all
done

lemma uint_plus_if':
"uint (a + b) =
(if uint a + uint b < 2 ^ LENGTH('a) then uint a + uint b
else uint a + uint b - 2 ^ LENGTH('a))"
for a b :: "'a::len word"
using mod_add_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)

lemma mod_sub_if_z:
"x < z ⟹ y < z ⟹ 0 ≤ y ⟹ 0 ≤ x ⟹ 0 ≤ z ⟹
(x - y) mod z = (if y ≤ x then x - y else x - y + z)"
for x y z :: int
apply (rule antisym)
apply (simp only: flip: mod_add_self2 [of ‹x - y› z])
apply (rule zmod_le_nonneg_dividend)
apply simp
done

lemma uint_sub_if':
"uint (a - b) =
(if uint b ≤ uint a then uint a - uint b
else uint a - uint b + 2 ^ LENGTH('a))"
for a b :: "'a::len word"
using mod_sub_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)

subsection ‹Definition of ‹uint_arith››

lemma word_of_int_inverse:
"word_of_int r = a ⟹ 0 ≤ r ⟹ r < 2 ^ LENGTH('a) ⟹ uint a = r"
for a :: "'a::len word"
apply (erule word_uint.Abs_inverse' [rotated])
done

lemma uint_split:
"P (uint x) = (∀i. word_of_int i = x ∧ 0 ≤ i ∧ i < 2^LENGTH('a) ⟶ P i)"
for x :: "'a::len word"
by transfer (auto simp add: take_bit_eq_mod take_bit_int_less_exp)

lemma uint_split_asm:
"P (uint x) = (∄i. word_of_int i = x ∧ 0 ≤ i ∧ i < 2^LENGTH('a) ∧ ¬ P i)"
for x :: "'a::len word"
by (auto dest!: word_of_int_inverse
simp: int_word_uint
split: uint_split)

lemmas uint_splits = uint_split uint_split_asm

lemmas uint_arith_simps =
word_le_def word_less_alt
word_uint.Rep_inject [symmetric]
uint_sub_if' uint_plus_if'

― ‹use this to stop, eg. ‹2 ^ LENGTH(32)› being simplified›
lemma power_False_cong: "False ⟹ a ^ b = c ^ d"
by auto

― ‹‹uint_arith_tac›: reduce to arithmetic on int, try to solve by arith›
ML ‹
fun uint_arith_simpset ctxt =
delsimps @{thms word_uint.Rep_inject}

fun uint_arith_tacs ctxt =
let
fun arith_tac' n t =
Arith_Data.arith_tac ctxt n t
handle Cooper.COOPER _ => Seq.empty;
in
[ clarify_tac ctxt 1,
full_simp_tac (uint_arith_simpset ctxt) 1,
ALLGOALS (full_simp_tac
(put_simpset HOL_ss ctxt
rewrite_goals_tac ctxt @{thms word_size},
ALLGOALS  (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
REPEAT (eresolve_tac ctxt [conjE] n) THEN
REPEAT (dresolve_tac ctxt @{thms word_of_int_inverse} n
THEN assume_tac ctxt n
THEN assume_tac ctxt n)),
TRYALL arith_tac' ]
end

fun uint_arith_tac ctxt = SELECT_GOAL (EVERY (uint_arith_tacs ctxt))
›

method_setup uint_arith =
‹Scan.succeed (SIMPLE_METHOD' o uint_arith_tac)›
"solving word arithmetic via integers and arith"

subsection ‹More on overflows and monotonicity›

lemma no_plus_overflow_uint_size: "x ≤ x + y ⟷ uint x + uint y < 2 ^ size x"
for x y :: "'a::len word"
unfolding word_size by uint_arith

lemmas no_olen_add = no_plus_overflow_uint_size [unfolded word_size]

lemma no_ulen_sub: "x ≥ x - y ⟷ uint y ≤ uint x"
for x y :: "'a::len word"
by uint_arith

lemma no_olen_add': "x ≤ y + x ⟷ uint y + uint x < 2 ^ LENGTH('a)"
for x y :: "'a::len word"

lemmas uint_plus_simple = uint_plus_simple_iff [THEN iffD1]
lemmas uint_minus_simple_iff = trans [OF no_ulen_sub uint_sub_lem]
lemmas uint_minus_simple_alt = uint_sub_lem [folded word_le_def]
lemmas word_sub_le_iff = no_ulen_sub [folded word_le_def]
lemmas word_sub_le = word_sub_le_iff [THEN iffD2]

lemma word_less_sub1: "x ≠ 0 ⟹ 1 < x ⟷ 0 < x - 1"
for x :: "'a::len word"
by uint_arith

lemma word_le_sub1: "x ≠ 0 ⟹ 1 ≤ x ⟷ 0 ≤ x - 1"
for x :: "'a::len word"
by uint_arith

lemma sub_wrap_lt: "x < x - z ⟷ x < z"
for x z :: "'a::len word"
by uint_arith

lemma sub_wrap: "x ≤ x - z ⟷ z = 0 ∨ x < z"
for x z :: "'a::len word"
by uint_arith

lemma plus_minus_not_NULL_ab: "x ≤ ab - c ⟹ c ≤ ab ⟹ c ≠ 0 ⟹ x + c ≠ 0"
for x ab c :: "'a::len word"
by uint_arith

lemma plus_minus_no_overflow_ab: "x ≤ ab - c ⟹ c ≤ ab ⟹ x ≤ x + c"
for x ab c :: "'a::len word"
by uint_arith

lemma le_minus': "a + c ≤ b ⟹ a ≤ a + c ⟹ c ≤ b - a"
for a b c :: "'a::len word"
by uint_arith

lemma le_plus': "a ≤ b ⟹ c ≤ b - a ⟹ a + c ≤ b"
for a b c :: "'a::len word"
by uint_arith

lemmas le_plus = le_plus' [rotated]

lemmas le_minus = leD [THEN thin_rl, THEN le_minus'] (* FIXME *)

lemma word_plus_mono_right: "y ≤ z ⟹ x ≤ x + z ⟹ x + y ≤ x + z"
for x y z :: "'a::len word"
by uint_arith

lemma word_less_minus_cancel: "y - x < z - x ⟹ x ≤ z ⟹ y < z"
for x y z :: "'a::len word"
by uint_arith

lemma word_less_minus_mono_left: "y < z ⟹ x ≤ y ⟹ y - x < z - x"
for x y z :: "'a::len word"
by uint_arith

lemma word_less_minus_mono: "a < c ⟹ d < b ⟹ a - b < a ⟹ c - d < c ⟹ a - b < c - d"
for a b c d :: "'a::len word"
by uint_arith

lemma word_le_minus_cancel: "y - x ≤ z - x ⟹ x ≤ z ⟹ y ≤ z"
for x y z :: "'a::len word"
by uint_arith

lemma word_le_minus_mono_left: "y ≤ z ⟹ x ≤ y ⟹ y - x ≤ z - x"
for x y z :: "'a::len word"
by uint_arith

lemma word_le_minus_mono:
"a ≤ c ⟹ d ≤ b ⟹ a - b ≤ a ⟹ c - d ≤ c ⟹ a - b ≤ c - d"
for a b c d :: "'a::len word"
by uint_arith

lemma plus_le_left_cancel_wrap: "x + y' < x ⟹ x + y < x ⟹ x + y' < x + y ⟷ y' < y"
for x y y' :: "'a::len word"
by uint_arith

lemma plus_le_left_cancel_nowrap: "x ≤ x + y' ⟹ x ≤ x + y ⟹ x + y' < x + y ⟷ y' < y"
for x y y' :: "'a::len word"
by uint_arith

lemma word_plus_mono_right2: "a ≤ a + b ⟹ c ≤ b ⟹ a ≤ a + c"
for a b c :: "'a::len word"
by uint_arith

lemma word_less_add_right: "x < y - z ⟹ z ≤ y ⟹ x + z < y"
for x y z :: "'a::len word"
by uint_arith

lemma word_less_sub_right: "x < y + z ⟹ y ≤ x ⟹ x - y < z"
for x y z :: "'a::len word"
by uint_arith

lemma word_le_plus_either: "x ≤ y ∨ x ≤ z ⟹ y ≤ y + z ⟹ x ≤ y + z"
for x y z :: "'a::len word"
by uint_arith

lemma word_less_nowrapI: "x < z - k ⟹ k ≤ z ⟹ 0 < k ⟹ x < x + k"
for x z k :: "'a::len word"
by uint_arith

lemma inc_le: "i < m ⟹ i + 1 ≤ m"
for i m :: "'a::len word"
by uint_arith

lemma inc_i: "1 ≤ i ⟹ i < m ⟹ 1 ≤ i + 1 ∧ i + 1 ≤ m"
for i m :: "'a::len word"
by uint_arith

lemma udvd_incr_lem:
"up < uq ⟹ up = ua + n * uint K ⟹
uq = ua + n' * uint K ⟹ up + uint K ≤ uq"
by auto (metis int_distrib(1) linorder_not_less mult.left_neutral mult_right_mono uint_nonnegative zless_imp_add1_zle)

lemma udvd_incr':
"p < q ⟹ uint p = ua + n * uint K ⟹
uint q = ua + n' * uint K ⟹ p + K ≤ q"
apply (unfold word_less_alt word_le_def)
apply (drule (2) udvd_incr_lem)
done

lemma udvd_decr':
"p < q ⟹ uint p = ua + n * uint K ⟹
uint q = ua + n' * uint K ⟹ p ≤ q - K"
apply (unfold word_less_alt word_le_def)
apply (drule (2) udvd_incr_lem)
apply (drule le_diff_eq [THEN iffD2])
apply (erule order_trans)
apply (rule uint_sub_ge)
done

lemmas udvd_incr_lem0 = udvd_incr_lem [where ua=0, unfolded add_0_left]
lemmas udvd_incr0 = udvd_incr' [where ua=0, unfolded add_0_left]
lemmas udvd_decr0 = udvd_decr' [where ua=0, unfolded add_0_left]

lemma udvd_minus_le': "xy < k ⟹ z udvd xy ⟹ z udvd k ⟹ xy ≤ k - z"
apply (unfold udvd_def)
apply clarify
apply (erule (2) udvd_decr0)
done

lemma udvd_incr2_K:
"p < a + s ⟹ a ≤ a + s ⟹ K udvd s ⟹ K udvd p - a ⟹ a ≤ p ⟹
0 < K ⟹ p ≤ p + K ∧ p + K ≤ a + s"
supply [[simproc del: linordered_ring_less_cancel_factor]]
apply (unfold udvd_def)
apply clarify
apply (simp add: uint_arith_simps split: if_split_asm)
prefer 2
apply (insert uint_range' [of s])[1]
apply arith
apply (simp flip: diff_less_eq)
apply (subst (asm) mult_less_cancel_right)
apply simp
apply auto
apply (drule less_le_trans [of _ ‹2 ^ LENGTH('a)›]) apply assumption
done

subsection ‹Arithmetic type class instantiations›

lemmas word_le_0_iff [simp] =
word_zero_le [THEN leD, THEN antisym_conv1]

lemma word_of_int_nat: "0 ≤ x ⟹ word_of_int x = of_nat (nat x)"

text ‹
note that ‹iszero_def› is only for class ‹comm_semiring_1_cancel›,
which requires word length ‹≥ 1›, ie ‹'a::len word›
›
lemma iszero_word_no [simp]:
"iszero (numeral bin :: 'a::len word) =
iszero (take_bit LENGTH('a) (numeral bin :: int))"
using word_ubin.norm_eq_iff [where 'a='a, of "numeral bin" 0]

text ‹Use ‹iszero› to simplify equalities between word numerals.›

lemmas word_eq_numeral_iff_iszero [simp] =
eq_numeral_iff_iszero [where 'a="'a::len word"]

subsection ‹Word and nat›

lemma td_ext_unat [OF refl]:
"n = LENGTH('a::len) ⟹
td_ext (unat :: 'a word ⇒ nat) of_nat (unats n) (λi. i mod 2 ^ n)"
apply (standard; transfer)
apply (simp_all add: unats_def take_bit_int_less_exp take_bit_of_nat take_bit_eq_self)
done

lemmas unat_of_nat = td_ext_unat [THEN td_ext.eq_norm]

interpretation word_unat:
td_ext
"unat::'a::len word ⇒ nat"
of_nat
"unats (LENGTH('a::len))"
"λi. i mod 2 ^ LENGTH('a::len)"
by (rule td_ext_unat)

lemmas td_unat = word_unat.td_thm

lemmas unat_lt2p [iff] = word_unat.Rep [unfolded unats_def mem_Collect_eq]

lemma unat_le: "y ≤ unat z ⟹ y ∈ unats (LENGTH('a))"
for z :: "'a::len word"
apply (unfold unats_def)
apply clarsimp
apply (rule xtrans, rule unat_lt2p, assumption)
done

lemma word_nchotomy: "∀w :: 'a::len word. ∃n. w = of_nat n ∧ n < 2 ^ LENGTH('a)"
apply (rule allI)
apply (rule word_unat.Abs_cases)
apply (unfold unats_def)
apply auto
done

lemma of_nat_eq: "of_nat n = w ⟷ (∃q. n = unat w + q * 2 ^ LENGTH('a))"
for w :: "'a::len word"
using mod_div_mult_eq [of n "2 ^ LENGTH('a)", symmetric]

lemma of_nat_eq_size: "of_nat n = w ⟷ (∃q. n = unat w + q * 2 ^ size w)"
unfolding word_size by (rule of_nat_eq)

lemma of_nat_0: "of_nat m = (0::'a::len word) ⟷ (∃q. m = q * 2 ^ LENGTH('a))"

lemma of_nat_2p [simp]: "of_nat (2 ^ LENGTH('a)) = (0::'a::len word)"
by (fact mult_1 [symmetric, THEN iffD2 [OF of_nat_0 exI]])

lemma of_nat_gt_0: "of_nat k ≠ 0 ⟹ 0 < k"
by (cases k) auto

lemma of_nat_neq_0: "0 < k ⟹ k < 2 ^ LENGTH('a::len) ⟹ of_nat k ≠ (0 :: 'a word)"
by (auto simp add : of_nat_0)

lemma Abs_fnat_hom_add: "of_nat a + of_nat b = of_nat (a + b)"
by simp

lemma Abs_fnat_hom_mult: "of_nat a * of_nat b = (of_nat (a * b) :: 'a::len word)"

lemma Abs_fnat_hom_Suc: "word_succ (of_nat a) = of_nat (Suc a)"
by (simp add: word_of_nat wi_hom_succ ac_simps)

lemma Abs_fnat_hom_0: "(0::'a::len word) = of_nat 0"
by simp

lemma Abs_fnat_hom_1: "(1::'a::len word) = of_nat (Suc 0)"
by simp

lemmas Abs_fnat_homs =
Abs_fnat_hom_0 Abs_fnat_hom_1

lemma word_arith_nat_add: "a + b = of_nat (unat a + unat b)"
by simp

lemma word_arith_nat_mult: "a * b = of_nat (unat a * unat b)"
by simp

lemma word_arith_nat_Suc: "word_succ a = of_nat (Suc (unat a))"
by (subst Abs_fnat_hom_Suc [symmetric]) simp

lemma word_arith_nat_div: "a div b = of_nat (unat a div unat b)"
by (simp add: word_div_def word_of_nat zdiv_int uint_nat)

lemma word_arith_nat_mod: "a mod b = of_nat (unat a mod unat b)"
by (simp add: word_mod_def word_of_nat zmod_int uint_nat)

lemmas word_arith_nat_defs =
word_arith_nat_Suc Abs_fnat_hom_0
Abs_fnat_hom_1 word_arith_nat_div
word_arith_nat_mod

lemma unat_cong: "x = y ⟹ unat x = unat y"
by simp

lemmas unat_word_ariths = word_arith_nat_defs
[THEN trans [OF unat_cong unat_of_nat]]

lemmas word_sub_less_iff = word_sub_le_iff
[unfolded linorder_not_less [symmetric] Not_eq_iff]

"unat x + unat y < 2 ^ LENGTH('a) ⟷ unat (x + y) = unat x + unat y"
for x y :: "'a::len word"
apply (auto simp: unat_word_ariths)
apply (metis unat_lt2p word_unat.eq_norm)
done

lemma unat_mult_lem:
"unat x * unat y < 2 ^ LENGTH('a) ⟷ unat (x * y) = unat x * unat y"
for x y :: "'a::len word"
apply (auto simp: unat_word_ariths)
apply (metis unat_lt2p word_unat.eq_norm)
done

lemma unat_plus_if':
‹unat (a + b) =
(if unat a + unat b < 2 ^ LENGTH('a)
then unat a + unat b
else unat a + unat b - 2 ^ LENGTH('a))› for a b :: ‹'a::len word›
apply (auto simp: unat_word_ariths not_less)
apply auto
done

lemma le_no_overflow: "x ≤ b ⟹ a ≤ a + b ⟹ x ≤ a + b"
for a b x :: "'a::len word"
apply (erule order_trans)
done

lemmas un_ui_le =
trans [OF word_le_nat_alt [symmetric] word_le_def]

lemma unat_sub_if_size:
"unat (x - y) =
(if unat y ≤ unat x
then unat x - unat y
else unat x + 2 ^ size x - unat y)"
supply nat_uint_eq [simp del]
apply (unfold word_size)
apply (auto simp add: unat_eq_nat_uint uint_sub_if')
apply (rule nat_diff_distrib)
prefer 3
apply (rule nat_diff_distrib [THEN trans])
prefer 3
prefer 3
apply auto
apply uint_arith
done

lemmas unat_sub_if' = unat_sub_if_size [unfolded word_size]

lemma uint_div:
‹uint (x div y) = uint x div uint y›
by (metis div_le_dividend le_less_trans mod_less uint_nat unat_lt2p unat_word_ariths(6) zdiv_int)

lemma unat_div:
‹unat (x div y) = unat x div unat y›
by (simp add: uint_div nat_div_distrib flip: nat_uint_eq)

lemma uint_mod:
‹uint (x mod y) = uint x mod uint y›
by (metis (no_types, lifting) le_less_trans mod_by_0 mod_le_divisor mod_less neq0_conv uint_nat unat_lt2p unat_word_ariths(7) zmod_int)

lemma unat_mod:
‹unat (x mod y) = unat x mod unat y›
by (simp add: uint_mod nat_mod_distrib flip: nat_uint_eq)

text ‹Definition of ‹unat_arith› tactic›

lemma unat_split: "P (unat x) ⟷ (∀n. of_nat n = x ∧ n < 2^LENGTH('a) ⟶ P n)"
for x :: "'a::len word"
by (auto simp: unat_of_nat)

lemma unat_split_asm: "P (unat x) ⟷ (∄n. of_nat n = x ∧ n < 2^LENGTH('a) ∧ ¬ P n)"
for x :: "'a::len word"
by (auto simp: unat_of_nat)

lemmas of_nat_inverse =
word_unat.Abs_inverse' [rotated, unfolded unats_def, simplified]

lemmas unat_splits = unat_split unat_split_asm

lemmas unat_arith_simps =
word_le_nat_alt word_less_nat_alt
word_unat.Rep_inject [symmetric]
unat_sub_if' unat_plus_if' unat_div unat_mod

― ‹‹unat_arith_tac›: tactic to reduce word arithmetic to ‹nat›, try to solve via ‹arith››
ML ‹
fun unat_arith_simpset ctxt =
delsimps @{thms word_unat.Rep_inject}

fun unat_arith_tacs ctxt =
let
fun arith_tac' n t =
Arith_Data.arith_tac ctxt n t
handle Cooper.COOPER _ => Seq.empty;
in
[ clarify_tac ctxt 1,
full_simp_tac (unat_arith_simpset ctxt) 1,
ALLGOALS (full_simp_tac
(put_simpset HOL_ss ctxt
rewrite_goals_tac ctxt @{thms word_size},
ALLGOALS (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
REPEAT (eresolve_tac ctxt [conjE] n) THEN
REPEAT (dresolve_tac ctxt @{thms of_nat_inverse} n THEN assume_tac ctxt n)),
TRYALL arith_tac' ]
end

fun unat_arith_tac ctxt = SELECT_GOAL (EVERY (unat_arith_tacs ctxt))
›

method_setup unat_arith =
‹Scan.succeed (SIMPLE_METHOD' o unat_arith_tac)›
"solving word arithmetic via natural numbers and arith"

lemma no_plus_overflow_unat_size: "x ≤ x + y ⟷ unat x + unat y < 2 ^ size x"
for x y :: "'a::len word"
unfolding word_size by unat_arith

no_plus_overflow_unat_size [unfolded word_size]

lemmas unat_plus_simple =

lemma word_div_mult: "0 < y ⟹ unat x * unat y < 2 ^ LENGTH('a) ⟹ x * y div y = x"
for x y :: "'a::len word"
apply unat_arith
apply clarsimp
apply (subst unat_mult_lem [THEN iffD1])
apply auto
done

lemma div_lt': "i ≤ k div x ⟹ unat i * unat x < 2 ^ LENGTH('a)"
for i k x :: "'a::len word"
apply unat_arith
apply clarsimp
apply (drule mult_le_mono1)
apply (erule order_le_less_trans)
done

lemmas div_lt'' = order_less_imp_le [THEN div_lt']

lemma div_lt_mult: "i < k div x ⟹ 0 < x ⟹ i * x < k"
for i k x :: "'a::len word"
apply (frule div_lt'' [THEN unat_mult_lem [THEN iffD1]])
apply (drule (1) mult_less_mono1)
apply (erule order_less_le_trans)
apply auto
done

lemma div_le_mult: "i ≤ k div x ⟹ 0 < x ⟹ i * x ≤ k"
for i k x :: "'a::len word"
apply (frule div_lt' [THEN unat_mult_lem [THEN iffD1]])
apply (drule mult_le_mono1)
apply (erule order_trans)
apply auto
done

lemma div_lt_uint': "i ≤ k div x ⟹ uint i * uint x < 2 ^ LENGTH('a)"
for i k x :: "'a::len word"
apply (unfold uint_nat)
apply (drule div_lt')
apply (metis of_nat_less_iff of_nat_mult of_nat_numeral of_nat_power)
done

lemmas div_lt_uint'' = order_less_imp_le [THEN div_lt_uint']

lemma word_le_exists': "x ≤ y ⟹ ∃z. y = x + z ∧ uint x + uint z < 2 ^ LENGTH('a)"
for x y z :: "'a::len word"

lemmas plus_minus_not_NULL = order_less_imp_le [THEN plus_minus_not_NULL_ab]

lemmas plus_minus_no_overflow =
order_less_imp_le [THEN plus_minus_no_overflow_ab]

lemmas mcs = word_less_minus_cancel word_less_minus_mono_left
word_le_minus_cancel word_le_minus_mono_left

lemmas word_l_diffs = mcs [where y = "w + x", unfolded add_diff_cancel] for w x
lemmas word_diff_ls = mcs [where z = "w + x", unfolded add_diff_cancel] for w x
lemmas word_plus_mcs = word_diff_ls [where y = "v + x", unfolded add_diff_cancel] for v x

lemmas le_unat_uoi = unat_le [THEN word_unat.Abs_inverse]

lemmas thd = times_div_less_eq_dividend

lemmas uno_simps [THEN le_unat_uoi] = mod_le_divisor div_le_dividend

lemma word_mod_div_equality: "(n div b) * b + (n mod b) = n"
for n b :: "'a::len word"
by (fact div_mult_mod_eq)

lemma word_div_mult_le: "a div b * b ≤ a"
for a b :: "'a::len word"
by (metis div_le_mult mult_not_zero order.not_eq_order_implies_strict order_refl word_zero_le)

lemma word_mod_less_divisor: "0 < n ⟹ m mod n < n"
for m n :: "'a::len word"

lemma word_of_int_power_hom: "word_of_int a ^ n = (word_of_int (a ^ n) :: 'a::len word)"
by (induct n) (simp_all add: wi_hom_mult [symmetric])

lemma word_arith_power_alt: "a ^ n = (word_of_int (uint a ^ n) :: 'a::len word)"
by (simp add : word_of_int_power_hom [symmetric])

lemma unatSuc: "1 + n ≠ 0 ⟹ unat (1 + n) = Suc (unat n)"
for n :: "'a::len word"
by unat_arith

subsection ‹Cardinality, finiteness of set of words›

lemma inj_on_word_of_int: ‹inj_on (word_of_int :: int ⇒ 'a word) {0..<2 ^ LENGTH('a::len)}›
apply (rule inj_onI)
apply transfer
done

lemma inj_uint: ‹inj uint›
by (rule injI) simp

lemma range_uint: ‹range (uint :: 'a word ⇒ int) = {0..<2 ^ LENGTH('a::len)}›
by transfer (auto simp add: bintr_lt2p range_bintrunc)

lemma UNIV_eq: ‹(UNIV :: 'a word set) = word_of_int ` {0..<2 ^ LENGTH('a::len)}›
proof -
have ‹uint ` (UNIV :: 'a word set) = uint ` (word_of_int :: int ⇒ 'a word) ` {0..<2 ^ LENGTH('a::len)}›
then show ?thesis
using inj_image_eq_iff [of ‹uint :: 'a word ⇒ int› ‹UNIV :: 'a word set› ‹word_of_int ` {0..<2 ^ LENGTH('a)} :: 'a word set›, OF inj_uint]
by simp
qed

lemma card_word: "CARD('a word) = 2 ^ LENGTH('a::len)"
by (simp add: UNIV_eq card_image inj_on_word_of_int)

lemma card_word_size: "CARD('a word) = 2 ^ size x"
for x :: "'a::len word"
unfolding word_size by (rule card_word)

instance word :: (len) finite

subsection ‹Bitwise Operations on Words›

lemmas bin_log_bintrs = bin_trunc_not bin_trunc_xor bin_trunc_and bin_trunc_or

― ‹following definitions require both arithmetic and bit-wise word operations›

― ‹to get ‹word_no_log_defs› from ‹word_log_defs›, using ‹bin_log_bintrs››
lemmas wils1 = bin_log_bintrs [THEN word_ubin.norm_eq_iff [THEN iffD1],
folded word_ubin.eq_norm, THEN eq_reflection]

― ‹the binary operations only›  (* BH: why is this needed? *)
lemmas word_log_binary_defs =
word_and_def word_or_def word_xor_def

lemma word_wi_log_defs:
"NOT (word_of_int a) = word_of_int (NOT a)"
"word_of_int a AND word_of_int b = word_of_int (a AND b)"
"word_of_int a OR word_of_int b = word_of_int (a OR b)"
"word_of_int a XOR word_of_int b = word_of_int (a XOR b)"
by (transfer, rule refl)+

lemma word_no_log_defs [simp]:
"NOT (numeral a) = word_of_int (NOT (numeral a))"
"NOT (- numeral a) = word_of_int (NOT (- numeral a))"
"numeral a AND numeral b = word_of_int (numeral a AND numeral b)"
"numeral a AND - numeral b = word_of_int (numeral a AND - numeral b)"
"- numeral a AND numeral b = word_of_int (- numeral a AND numeral b)"
"- numeral a AND - numeral b = word_of_int (- numeral a AND - numeral b)"
"numeral a OR numeral b = word_of_int (numeral a OR numeral b)"
"numeral a OR - numeral b = word_of_int (numeral a OR - numeral b)"
"- numeral a OR numeral b = word_of_int (- numeral a OR numeral b)"
"- numeral a OR - numeral b = word_of_int (- numeral a OR - numeral b)"
"numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)"
"numeral a XOR - numeral b = word_of_int (numeral a XOR - numeral b)"
"- numeral a XOR numeral b = word_of_int (- numeral a XOR numeral b)"
"- numeral a XOR - numeral b = word_of_int (- numeral a XOR - numeral b)"
by (transfer, rule refl)+

text ‹Special cases for when one of the arguments equals 1.›

lemma word_bitwise_1_simps [simp]:
"NOT (1::'a::len word) = -2"
"1 AND numeral b = word_of_int (1 AND numeral b)"
"1 AND - numeral b = word_of_int (1 AND - numeral b)"
"numeral a AND 1 = word_of_int (numeral a AND 1)"
"- numeral a AND 1 = word_of_int (- numeral a AND 1)"
"1 OR numeral b = word_of_int (1 OR numeral b)"
"1 OR - numeral b = word_of_int (1 OR - numeral b)"
"numeral a OR 1 = word_of_int (numeral a OR 1)"
"- numeral a OR 1 = word_of_int (- numeral a OR 1)"
"1 XOR numeral b = word_of_int (1 XOR numeral b)"
"1 XOR - numeral b = word_of_int (1 XOR - numeral b)"
"numeral a XOR 1 = word_of_int (numeral a XOR 1)"
"- numeral a XOR 1 = word_of_int (- numeral a XOR 1)"
by (transfer, simp)+

text ‹Special cases for when one of the arguments equals -1.›

lemma word_bitwise_m1_simps [simp]:
"NOT (-1::'a::len word) = 0"
"(-1::'a::len word) AND x = x"
"x AND (-1::'a::len word) = x"
"(-1::'a::len word) OR x = -1"
"x OR (-1::'a::len word) = -1"
" (-1::'a::len word) XOR x = NOT x"
"x XOR (-1::'a::len word) = NOT x"
by (transfer, simp)+

lemma uint_and:
‹uint (x AND y) = uint x AND uint y›
by transfer simp

lemma uint_or:
‹uint (x OR y) = uint x OR uint y›
by transfer simp

lemma uint_xor:
‹uint (x XOR y) = uint x XOR uint y›
by transfer simp

lemma test_bit_wi [simp]:
"(word_of_int x :: 'a::len word) !! n ⟷ n < LENGTH('a) ∧ bin_nth x n"
by (simp add: word_test_bit_def word_ubin.eq_norm nth_bintr)

lemma word_test_bit_transfer [transfer_rule]:
"(rel_fun pcr_word (rel_fun (=) (=)))
(λx n. n < LENGTH('a) ∧ bit x n) (test_bit :: 'a::len word ⇒ _)"
by (simp only: test_bit_eq_bit) transfer_prover

lemma word_ops_nth_size:
"n < size x ⟹
(x OR y) !! n = (x !! n | y !! n) ∧
(x AND y) !! n = (x !! n ∧ y !! n) ∧
(x XOR y) !! n = (x !! n ≠ y !! n) ∧
(NOT x) !! n = (¬ x !! n)"
for x :: "'a::len word"
unfolding word_size by transfer (simp add: bin_nth_ops)

lemma word_ao_nth:
"(x OR y) !! n = (x !! n | y !! n) ∧
(x AND y) !! n = (x !! n ∧ y !! n)"
for x :: "'a::len word"
by transfer (auto simp add: bin_nth_ops)

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_numeral [simp]:
"(numeral w :: 'a::len word) !! n ⟷
n < LENGTH('a) ∧ bin_nth (numeral w) n"
by transfer (rule refl)

lemma test_bit_neg_numeral [simp]:
"(- numeral w :: 'a::len word) !! n ⟷
n < LENGTH('a) ∧ bin_nth (- numeral w) n"
by transfer (rule refl)

lemma test_bit_1 [simp]: "(1 :: 'a::len word) !! n ⟷ n = 0"
by transfer auto

lemma nth_0 [simp]: "¬ (0 :: 'a::len word) !! n"
by transfer simp

lemma nth_minus1 [simp]: "(-1 :: 'a::len word) !! n ⟷ n < LENGTH('a)"
by transfer simp

― ‹get from commutativity, associativity etc of ‹int_and› etc to same for ‹word_and etc››
lemmas bwsimps =
word_wi_log_defs

lemma word_bw_assocs:
"(x AND y) AND z = x AND y AND z"
"(x OR y) OR z = x OR y OR z"
"(x XOR y) XOR z = x XOR y XOR z"
for x :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_bw_comms:
"x AND y = y AND x"
"x OR y = y OR x"
"x XOR y = y XOR x"
for x :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_bw_lcs:
"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 :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_log_esimps:
"x AND 0 = 0"
"x AND -1 = x"
"x OR 0 = x"
"x OR -1 = -1"
"x XOR 0 = x"
"x XOR -1 = NOT x"
"0 AND x = 0"
"-1 AND x = x"
"0 OR x = x"
"-1 OR x = -1"
"0 XOR x = x"
"-1 XOR x = NOT x"
for x :: "'a::len word"
by simp_all

lemma word_not_dist:
"NOT (x OR y) = NOT x AND NOT y"
"NOT (x AND y) = NOT x OR NOT y"
for x :: "'a::len word"
by simp_all

lemma word_bw_same:
"x AND x = x"
"x OR x = x"
"x XOR x = 0"
for x :: "'a::len word"
by simp_all

lemma word_ao_absorbs [simp]:
"x AND (y OR x) = x"
"x OR y AND x = x"
"x AND (x OR y) = x"
"y AND x OR x = x"
"(y OR x) AND x = x"
"x OR x AND y = x"
"(x OR y) AND x = x"
"x AND y OR x = x"
for x :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_not_not [simp]: "NOT (NOT x) = x"
for x :: "'a::len word"
by simp

lemma word_ao_dist: "(x OR y) AND z = x AND z OR y AND z"
for x :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_oa_dist: "x AND y OR z = (x OR z) AND (y OR z)"
for x :: "'a::len word"
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size])

lemma word_add_not [simp]: "x + NOT x = -1"
for x :: "'a::len word"

lemma word_plus_and_or [simp]: "(x AND y) + (x OR y) = x + y"
for x :: "'a::len word"

lemma leoa: "w = x OR y ⟹ y = w AND y"
for x :: "'a::len word"
by auto

lemma leao: "w' = x' AND y' ⟹ x' = x' OR w'"
for x' :: "'a::len word"
by auto

lemma word_ao_equiv: "w = w OR w' ⟷ w' = w AND w'"
for w w' :: "'a::len word"
by (auto intro: leoa leao)

lemma le_word_or2: "x ≤ x OR y"
for x y :: "'a::len word"
by (auto simp: word_le_def uint_or intro: le_int_or)

lemmas le_word_or1 = xtrans(3) [OF word_bw_comms (2) le_word_or2]
lemmas word_and_le1 = xtrans(3) [OF word_ao_absorbs (4) [symmetric] le_word_or2]
lemmas word_and_le2 = xtrans(3) [OF word_ao_absorbs (8) [symmetric] le_word_or2]

lemma bit_horner_sum_bit_word_iff:
‹bit (horner_sum of_bool (2 :: 'a::len word) bs) n
⟷ n < min LENGTH('a) (length bs) ∧ bs ! n›

definition word_reverse :: ‹'a::len word ⇒ 'a word›
where ‹word_reverse w = horner_sum of_bool 2 (rev (map (bit w) [0..<LENGTH('a)]))›

lemma bit_word_reverse_iff:
‹bit (word_reverse w) n ⟷ n < LENGTH('a) ∧ bit w (LENGTH('a) - Suc n)›
for w :: ‹'a::len word›
by (cases ‹n < LENGTH('a)›)

lemma word_rev_rev [simp] : "word_reverse (word_reverse w) = w"
by (rule bit_word_eqI)
(auto simp add: bit_word_reverse_iff bit_imp_le_length Suc_diff_Suc)

lemma word_rev_gal: "word_reverse w = u ⟹ word_reverse u = w"
by (metis word_rev_rev)

lemma word_rev_gal': "u = word_reverse w ⟹ w = word_reverse u"
by simp

lemmas lsb0 = len_gt_0 [THEN word_ops_nth_size [unfolded word_size]]

lemma nth_sint:
fixes w :: "'a::len word"
defines "l ≡ LENGTH('a)"
shows "bin_nth (sint w) n = (if n < l - 1 then w !! n else w !! (l - 1))"
unfolding sint_uint l_def
by (auto simp: nth_sbintr word_test_bit_def [symmetric])

lemma setBit_no [simp]: "setBit (numeral bin) n = word_of_int (bin_sc n True (numeral bin))"

lemma clearBit_no [simp]:
"clearBit (numeral bin) n = word_of_int (bin_sc n False (numeral bin))"

lemma test_bit_2p: "(word_of_int (2 ^ n)::'a::len word) !! m ⟷ m = n ∧ m < LENGTH('a)"
by (auto simp: word_test_bit_def word_ubin.eq_norm nth_bintr nth_2p_bin)

lemma nth_w2p: "((2::'a::len word) ^ n) !! m ⟷ m = n ∧ m < LENGTH('a::len)"
by (simp add: test_bit_2p [symmetric] word_of_int [symmetric])

lemma uint_2p: "(0::'a::len word) < 2 ^ n ⟹ uint (2 ^ n::'a::len word) = 2 ^ n"
apply (unfold word_arith_power_alt)
apply (case_tac "LENGTH('a)")
apply clarsimp
apply (case_tac "nat")
apply clarsimp
apply (case_tac "n")
apply clarsimp
apply clarsimp
apply (drule word_gt_0 [THEN iffD1])
apply (safe intro!: word_eqI)
apply (erule notE)
apply (simp (no_asm_use) add: uint_word_of_int word_size)
apply (subst mod_pos_pos_trivial)
apply simp
apply (rule power_strict_increasing)
apply simp_all
done

lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a::len word) = 2 ^ n"
by (induct n) (simp_all add: wi_hom_syms)

lemma bang_is_le: "x !! m ⟹ 2 ^ m ≤ 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

subsection ‹Bit comprehension›

instantiation word :: (len) bit_comprehension
begin

definition word_set_bits_def:
‹(BITS n. P n) = (horner_sum of_bool 2 (map P [0..<LENGTH('a)]) :: 'a word)›

instance ..

end

lemma bit_set_bits_word_iff:
‹bit (set_bits P :: 'a::len word) n ⟷ n < LENGTH('a) ∧ P n›
by (auto simp add: word_set_bits_def bit_horner_sum_bit_word_iff)

lemma set_bits_bit_eq:
‹set_bits (bit w) = w› for w :: ‹'a::len word›
by (rule bit_word_eqI) (auto simp add: bit_set_bits_word_iff bit_imp_le_length)

lemma set_bits_K_False [simp]:
‹set_bits (λ_. False) = (0 :: 'a :: len word)›
by (rule bit_word_eqI) (simp add: bit_set_bits_word_iff)

lemmas of_nth_def = word_set_bits_def (* FIXME duplicate *)

interpretation test_bit:
td_ext
"(!!) :: 'a::len word ⇒ nat ⇒ bool"
set_bits
"{f. ∀i. f i ⟶ i < LENGTH('a::len)}"
"(λh i. h i ∧ i < LENGTH('a::len))"
by standard
(auto simp add: test_bit_word_eq bit_imp_le_length bit_set_bits_word_iff set_bits_bit_eq)

lemmas td_nth = test_bit.td_thm

subsection ‹Shifting, Rotating, and Splitting Words›

lemma shiftl1_wi [simp]: "shiftl1 (word_of_int w) = word_of_int (2 * w)"
by transfer simp

lemma shiftl1_numeral [simp]: "shiftl1 (numeral w) = numeral (Num.Bit0 w)"
unfolding word_numeral_alt shiftl1_wi by simp

lemma shiftl1_neg_numeral [simp]: "shiftl1 (- numeral w) = - numeral (Num.Bit0 w)"
unfolding word_neg_numeral_alt shiftl1_wi by simp

lemma shiftl1_0 [simp] : "shiftl1 0 = 0"
by transfer simp

lemma shiftl1_def_u: "shiftl1 w = word_of_int (2 * uint w)"
by (fact shiftl1_eq)

lemma shiftl1_def_s: "shiftl1 w = word_of_int (2 * sint w)"

lemma shiftr1_0 [simp]: "shiftr1 0 = 0"
by transfer simp

lemma sshiftr1_0 [simp]: "sshiftr1 0 = 0"
by transfer simp

lemma sshiftr1_n1 [simp]: "sshiftr1 (- 1) = - 1"
by transfer simp

lemma shiftl_0 [simp]: "(0::'a::len word) << n = 0"
by transfer simp

lemma shiftr_0 [simp]: "(0::'a::len word) >> n = 0"
by transfer simp

lemma sshiftr_0 [simp]: "0 >>> n = 0"
by transfer simp

lemma sshiftr_n1 [simp]: "-1 >>> n = -1"
by transfer simp

lemma nth_shiftl1: "shiftl1 w !! n ⟷ n < size w ∧ n > 0 ∧ w !! (n - 1)"
by transfer (auto simp add: bit_double_iff)

lemma nth_shiftl': "(w << m) !! n ⟷ n < size w ∧ n >= m ∧ w !! (n - m)"
for w :: "'a::len word"
by transfer (auto simp add: bit_push_bit_iff)

lemmas nth_shiftl = nth_shiftl' [unfolded word_size]

lemma nth_shiftr1: "shiftr1 w !! n = w !! Suc n"
by transfer (auto simp add: bit_take_bit_iff simp flip: bit_Suc)

lemma nth_shiftr: "(w >> m) !! n = w !! (n + m)"
for w :: "'a::len word"
apply (unfold shiftr_def)
apply (induct "m" arbitrary: n)
done

text ‹
see paper page 10, (1), (2), ‹shiftr1_def› is of the form of (1),
where ‹f› (ie ‹bin_rest›) takes normal arguments to normal results,
thus we get (2) from (1)
›

lemma uint_shiftr1: "uint (shiftr1 w) = bin_rest (uint w)"
by transfer simp

lemma bit_sshiftr1_iff:
‹bit (sshiftr1 w) n ⟷ bit w (if n = LENGTH('a) - 1 then LENGTH('a) - 1 else Suc n)›
for w :: ‹'a::len word›
apply transfer
apply (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def simp flip: bit_Suc)
using le_less_Suc_eq apply fastforce
using le_less_Suc_eq apply fastforce
done

lemma bit_sshiftr_word_iff:
‹bit (w >>> m) n ⟷ bit w (if LENGTH('a) - m ≤ n ∧ n < LENGTH('a) then LENGTH('a) - 1 else (m + n))›
for w :: ‹'a::len word›
apply transfer
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le simp flip: bit_Suc)
using le_less_Suc_eq apply fastforce
using le_less_Suc_eq apply fastforce
done

lemma nth_sshiftr1: "sshiftr1 w !! n = (if n = size w - 1 then w !! n else w !! Suc n)"
apply transfer
apply (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def simp flip: bit_Suc)
using le_less_Suc_eq apply fastforce
using le_less_Suc_eq apply fastforce
done

lemma nth_sshiftr :
"sshiftr w m !! n =
(n < size w ∧ (if n + m ≥ size w then w !! (size w - 1) else w !! (n + m)))"
apply transfer
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le ac_simps)
using le_less_Suc_eq apply fastforce
using le_less_Suc_eq apply fastforce
done

lemma shiftr1_div_2: "uint (shiftr1 w) = uint w div 2"
by (fact uint_shiftr1)

lemma sshiftr1_div_2: "sint (sshiftr1 w) = sint w div 2"
by transfer simp

lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n"
apply (unfold shiftr_def)
apply (induct n)
apply simp
apply (simp add: shiftr1_div_2 mult.commute zdiv_zmult2_eq [symmetric])
done

lemma sshiftr_div_2n: "sint (sshiftr w n) = sint w div 2 ^ n"
apply transfer
apply (auto simp add: bit_eq_iff bit_signed_take_bit_iff bit_drop_bit_eq min_def simp flip: drop_bit_eq_div)
done

lemma bit_bshiftr1_iff:
‹bit (bshiftr1 b w) n ⟷ b ∧ n = LENGTH('a) - 1 ∨ bit w (Suc n)›
for w :: ‹'a::len word›
apply transfer
apply (simp add: bit_take_bit_iff flip: bit_Suc)
apply (auto simp add: bit_take_bit_iff bit_or_iff bit_exp_iff simp flip: bit_Suc)
done

subsubsection ‹shift functions in terms of lists of bools›

lemma shiftl1_rev: "shiftl1 w = word_reverse (shiftr1 (word_reverse w))"
apply (rule bit_word_eqI)
apply (auto simp add: bit_shiftl1_iff bit_word_reverse_iff bit_shiftr1_iff Suc_diff_Suc)
done

lemma shiftl_rev: "shiftl w n = word_reverse (shiftr (word_reverse w) n)"
by (induct n) (auto simp add: shiftl_def shiftr_def shiftl1_rev)

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

lemma shiftl_numeral [simp]:
‹numeral k << numeral l = (push_bit (numeral l) (numeral k) :: 'a::len word)›
by (fact shiftl_word_eq)

lemma shiftl_zero_size: "size x ≤ n ⟹ x << n = 0"
for x :: "'a::len word"
apply transfer
done

― ‹note -- the following results use ‹'a::len word < number_ring››

lemma shiftl1_2t: "shiftl1 w = 2 * w"
for w :: "'a::len word"
by (simp add: shiftl1_eq wi_hom_mult [symmetric])

lemma shiftl1_p: "shiftl1 w = w + w"
for w :: "'a::len word"

lemma shiftl_t2n: "shiftl w n = 2 ^ n * w"
for w :: "'a::len word"
by (induct n) (auto simp: shiftl_def shiftl1_2t)

lemma shiftr1_bintr [simp]:
"(shiftr1 (numeral w) :: 'a::len word) =
word_of_int (bin_rest (take_bit (LENGTH('a)) (numeral w)))"
unfolding shiftr1_eq word_numeral_alt by (simp add: word_ubin.eq_norm)

lemma sshiftr1_sbintr [simp]:
"(sshiftr1 (numeral w) :: 'a::len word) =
word_of_int (bin_rest (signed_take_bit (LENGTH('a) - 1) (numeral w)))"
unfolding sshiftr1_eq word_numeral_alt by (simp add: word_sbin.eq_norm)

text ‹TODO: rules for \<^term>‹- (numeral n)››

lemma drop_bit_word_numeral [simp]:
‹drop_bit (numeral n) (numeral k) =
(word_of_int (drop_bit (numeral n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)›
by transfer simp

lemma shiftr_numeral [simp]:
‹(numeral k >> numeral n :: 'a::len word) = drop_bit (numeral n) (numeral k)›
by (fact shiftr_word_eq)

lemma sshiftr_numeral [simp]:
‹(numeral k >>> numeral n :: 'a::len word) =
word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (numeral k)))›
apply (rule word_eqI)
apply (cases ‹LENGTH('a)›)
apply (simp_all add: word_size bit_drop_bit_eq nth_sshiftr nth_sbintr not_le not_less less_Suc_eq_le ac_simps)
done

lemma zip_replicate: "n ≥ length ys ⟹ zip (replicate n x) ys = map (λy. (x, y)) ys"
apply (induct ys arbitrary: n)
apply simp_all
apply (case_tac n)
apply simp_all
done

lemma align_lem_or [rule_format] :
"∀x m. length x = n + m ⟶ length y = n + m ⟶
drop m x = replicate n False ⟶ take m y = replicate m False ⟶
map2 (|) x y = take m x @ drop m y"
apply (induct y)
apply force
apply clarsimp
apply (case_tac x)
apply force
apply (case_tac m)
apply auto
apply (drule_tac t="length xs" for xs in sym)
apply (auto simp: zip_replicate o_def)
done

lemma align_lem_and [rule_format] :
"∀x m. length x = n + m ⟶ length y = n + m ⟶
drop m x = replicate n False ⟶ take m y = replicate m False ⟶
map2 (∧) x y = replicate (n + m) False"
apply (induct y)
apply force
apply clarsimp
apply (case_tac x)
apply force
apply (case_tac m)
apply auto
apply (drule_tac t="length xs" for xs in sym)
apply (auto simp: zip_replicate o_def map_replicate_const)
done

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

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

‹mask (Suc n) = 2 * mask n + (1 :: 'a::len word)›

context
begin

‹bit (mask m :: 'a::len word) n ⟷ n < min LENGTH('a) m›

end

‹(mask n :: 'a::len word) !! i ⟷ i < n ∧ i < size (mask n :: 'a word)›

by (auto simp add: nth_bintr word_size intro: word_eqI)

lemma and_mask_bintr: "w AND mask n = word_of_int (take_bit n (uint w))"
apply (rule word_eqI)
apply (simp add: nth_bintr word_size word_ops_nth_size)
done

lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (take_bit n i)"
by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff)

"word_of_int i AND mask n = (word_of_int (take_bit (min LENGTH('a) n) i) :: 'a::len word)"
by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff)

lemma and_mask_no: "numeral i AND mask n = word_of_int (take_bit n (numeral i))"

lemma and_mask_mod_2p: "w AND mask n = word_of_int (uint w mod 2 ^ n)"

by transfer simp

apply (rule AND_upper2'')
apply simp
done

lemma eq_mod_iff: "0 < n ⟹ b = b mod n ⟷ 0 ≤ b ∧ b < n"
for b n :: int
by auto (metis pos_mod_conj)+

lemma mask_eq_iff: "w AND mask n = w ⟷ uint w < 2 ^ n"
apply (simp add: eq_mod_iff take_bit_eq_mod min_def)
apply (fast intro!: lt2p_lem)
done

lemma and_mask_dvd: "2 ^ n dvd uint w ⟷ w AND mask n = 0"
apply (simp add: word_uint.norm_eq_iff [symmetric] word_of_int_homs del: word_of_int_0)
apply (subst word_uint.norm_Rep [symmetric])
apply (simp only: bintrunc_bintrunc_min take_bit_eq_mod [symmetric] min_def)
apply auto
done

lemma and_mask_dvd_nat: "2 ^ n dvd unat w ⟷ w AND mask n = 0"
apply transfer
using dvd_nat_abs_iff [of _ ‹take_bit LENGTH('a) k› for k]
apply simp
done

lemma word_2p_lem: "n < size w ⟹ w < 2 ^ n = (uint w < 2 ^ n)"
for w :: "'a::len word"
apply (unfold word_size word_less_alt word_numeral_alt)
apply (auto simp add: word_of_int_power_hom word_uint.eq_norm
simp del: word_of_int_numeral)
done

lemma less_mask_eq: "x < 2 ^ n ⟹ x AND mask n = x"
for x :: "'a::len word"
apply transfer
apply (metis bintrunc_bintrunc_ge mod_pos_pos_trivial mult.commute mult.left_neutral mult_zero_left not_le of_bool_def take_bit_eq_mod take_bit_nonnegative)
done

lemma and_mask_less_size: "n < size x ⟹ x AND mask n < 2 ^ n"
for x :: ‹'a::len word›

lemma word_mod_2p_is_mask [OF refl]: "c = 2 ^ n ⟹ c > 0 ⟹ x mod c = x AND mask n"
for c x :: "'a::len word"
by (auto simp: word_mod_def uint_2p and_mask_mod_2p)

using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b]
by (auto simp: and_mask_wi' word_of_int_homs word.abs_eq_iff take_bit_eq_mod mod_simps)

for x :: ‹'a::len word›
using word_of_int_Ex [where x=x]
by (auto simp: and_mask_wi' word_of_int_power_hom word.abs_eq_iff take_bit_eq_mod mod_simps)

subsubsection ‹Slices›

definition slice1 :: ‹nat ⇒ 'a::len word ⇒ 'b::len word›
where ‹slice1 n w = (if n < LENGTH('a)
then ucast (drop_bit (LENGTH('a) - n) w)
else push_bit (n - LENGTH('a)) (ucast w))›

lemma bit_slice1_iff:
‹bit (slice1 m w :: 'b::len word) n ⟷ m - LENGTH('a) ≤ n ∧ n < min LENGTH('b) m
∧ bit w (n + (LENGTH('a) - m) - (m - LENGTH('a)))›
for w :: ‹'a::len word›
by (auto simp add: slice1_def bit_ucast_iff bit_drop_bit_eq bit_push_bit_iff exp_eq_zero_iff not_less not_le ac_simps
dest: bit_imp_le_length)

definition slice :: ‹nat ⇒ 'a::len word ⇒ 'b::len word›
where ‹slice n = slice1 (LENGTH('a) - n)›

lemma bit_slice_iff:
‹bit (slice m w :: 'b::len word) n ⟷ n < min LENGTH('b) (LENGTH('a) - m) ∧ bit w (n + LENGTH('a) - (LENGTH('a) - m))›
for w :: ‹'a::len word›
by (simp add: slice_def word_size bit_slice1_iff)

lemma slice1_0 [simp] : "slice1 n 0 = 0"
unfolding slice1_def by simp

lemma slice_0 [simp] : "slice n 0 = 0"
unfolding slice_def by auto

lemma slice_shiftr: "slice n w = ucast (w >> n)"
apply (rule bit_word_eqI)
apply (cases ‹n ≤ LENGTH('b)›)
apply (auto simp add: bit_slice_iff bit_ucast_iff bit_shiftr_word_iff ac_simps
dest: bit_imp_le_length)
done

lemma nth_slice: "(slice n w :: 'a::len word) !! m = (w !! (m + n) ∧ m < LENGTH('a))"
by (simp add: slice_shiftr nth_ucast nth_shiftr)

lemma ucast_slice1: "ucast w = slice1 (size w) w"
apply transfer
apply simp
done

lemma ucast_slice: "ucast w = slice 0 w"

lemma slice_id: "slice 0 t = t"
by (simp only: ucast_slice [symmetric] ucast_id)

lemma rev_slice1:
‹slice1 n (word_reverse w :: 'b::len word) = word_reverse (slice1 k w :: 'a::len word)›
if ‹n + k = LENGTH('a) + LENGTH('b)›
proof (rule bit_word_eqI)
fix m
assume *: ‹m < LENGTH('a)›
from that have **: ‹LENGTH('b) = n + k - LENGTH('a)›
by simp
show ‹bit (slice1 n (word_reverse w :: 'b word) :: 'a word) m ⟷ bit (word_reverse (slice1 k w :: 'a word)) m›
using * **
apply (cases ‹n ≤ LENGTH('a)›; cases ‹k ≤ LENGTH('a)›)
apply auto
done
qed

lemma rev_slice:
"n + k + LENGTH('a::len) = LENGTH('b::len) ⟹
slice n (word_reverse (w::'b word)) = word_reverse (slice k w :: 'a word)"
apply (unfold slice_def word_size)
apply (rule rev_slice1)
apply arith
done

subsubsection ‹Revcast›

definition revcast :: ‹'a::len word ⇒ 'b::len word›
where ‹revcast = slice1 LENGTH('b)›

lemma bit_revcast_iff:
‹bit (revcast w :: 'b::len word) n ⟷ LENGTH('b) - LENGTH('a) ≤ n ∧ n < LENGTH('b)
∧ bit w (n + (LENGTH('a) - LENGTH('b)) - (LENGTH('b) - LENGTH('a)))›
for w :: ‹'a::len word›

lemma revcast_slice1 [OF refl]: "rc = revcast w ⟹ slice1 (size rc) w = rc"

lemma revcast_rev_ucast [OF refl refl refl]:
"cs = [rc, uc] ⟹ rc = revcast (word_reverse w) ⟹ uc = ucast w ⟹
rc = word_reverse uc"
apply auto
apply (rule bit_word_eqI)
apply (cases ‹LENGTH('a) ≤ LENGTH('b)›)
apply (simp_all add: bit_revcast_iff bit_word_reverse_iff bit_ucast_iff not_le
bit_imp_le_length)
using bit_imp_le_length apply fastforce
using bit_imp_le_length apply fastforce
done

lemma revcast_ucast: "revcast w = word_reverse (ucast (word_reverse w))"
using revcast_rev_ucast [of "word_reverse w"] by simp

lemma ucast_revcast: "ucast w = word_reverse (revcast (word_reverse w))"
by (fact revcast_rev_ucast [THEN word_rev_gal'])

lemma ucast_rev_revcast: "ucast (word_reverse w) = word_reverse (revcast w)"
by (fact revcast_ucast [THEN word_rev_gal'])

text "linking revcast and cast via shift"

lemmas wsst_TYs = source_size target_size word_size

lemma revcast_down_uu [OF refl]:
"rc = revcast ⟹ source_size rc = target_size rc + n ⟹ rc w = ucast (w >> n)"
for w :: "'a::len word"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_ucast_iff bit_shiftr_word_iff ac_simps)
done

lemma revcast_down_us [OF refl]:
"rc = revcast ⟹ source_size rc = target_size rc + n ⟹ rc w = ucast (w >>> n)"
for w :: "'a::len word"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_ucast_iff bit_sshiftr_word_iff ac_simps)
done

lemma revcast_down_su [OF refl]:
"rc = revcast ⟹ source_size rc = target_size rc + n ⟹ rc w = scast (w >> n)"
for w :: "'a::len word"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_word_scast_iff bit_shiftr_word_iff ac_simps)
done

lemma revcast_down_ss [OF refl]:
"rc = revcast ⟹ source_size rc = target_size rc + n ⟹ rc w = scast (w >>> n)"
for w :: "'a::len word"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_word_scast_iff bit_sshiftr_word_iff ac_simps)
done

lemma cast_down_rev [OF refl]:
"uc = ucast ⟹ source_size uc = target_size uc + n ⟹ uc w = revcast (w << n)"
for w :: "'a::len word"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
done

lemma revcast_up [OF refl]:
"rc = revcast ⟹ source_size rc + n = target_size rc ⟹
rc w = (ucast w :: 'a::len word) << n"
apply (rule bit_word_eqI)
apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff)
apply auto
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]]

lemmas ucast_up =
rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]]
lemmas ucast_down =
rc2 [simplified rev_shiftr revcast_ucast [symmetric]]

lemmas sym_notr =
not_iff [THEN iffD2, THEN not_sym, THEN not_iff [THEN iffD1]]

― ‹problem posed by TPHOLs referee:
criterion for overflow of addition of signed integers›

lemma sofl_test:
‹sint x + sint y = sint (x + y) ⟷
(x + y XOR x) AND (x + y XOR y) >> (size x - 1) = 0›
for x y :: ‹'a::len word›
proof -
obtain n where n: ‹LENGTH('a) = Suc n›
by (cases ‹LENGTH('a)›) simp_all
have *: ‹sint x + sint y + 2 ^ Suc n > signed_take_bit n (sint x + sint y) ⟹ sint x + sint y ≥ - (2 ^ n)›
‹signed_take_bit n (sint x + sint y) > sint x + sint y - 2 ^ Suc n ⟹ 2 ^ n > sint x + sint y›
using signed_take_bit_greater_eq [of ‹sint x + sint y› n] signed_take_bit_less_eq [of n ‹sint x + sint y›]
by (auto intro: ccontr)
have ‹sint x + sint y = sint (x + y) ⟷
(sint (x + y) < 0 ⟷ sint x < 0) ∨
(sint (x + y) < 0 ⟷ sint y < 0)›
using sint_range' [of x] sint_range' [of y]
apply (unfold sint_word_ariths word_sbin.set_iff_norm [symmetric] sints_num)
apply (auto simp add: signed_take_bit_eq_take_bit_minus take_bit_Suc_from_most n not_less intro!: *)
done
then show ?thesis
apply (simp add: word_size shiftr_word_eq drop_bit_eq_zero_iff_not_bit_last bit_and_iff bit_xor_iff)
done
qed

lemma shiftr_zero_size: "size x ≤ n ⟹ x >> n = 0"
for x :: "'a :: len word"
by (rule word_eqI) (auto simp add: nth_shiftr dest: test_bit_size)

subsection ‹Split and cat›

lemmas word_split_bin' = word_split_def
lemmas word_cat_bin' = word_cat_eq

lemma word_rsplit_no:
"(word_rsplit (numeral bin :: 'b::len word) :: 'a word list) =
map word_of_int (bin_rsplit (LENGTH('a::len))
(LENGTH('b), take_bit (LENGTH('b)) (numeral bin)))"

lemmas word_rsplit_no_cl [simp] = word_rsplit_no
[unfolded bin_rsplitl_def bin_rsplit_l [symmetric]]

lemma test_bit_cat [OF refl]:
"wc = word_cat a b ⟹ wc !! n = (n < size wc ∧
(if n < size b then b !! n else 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

lemma split_uint_lem: "bin_split n (uint w) = (a, b) ⟹
a = take_bit (LENGTH('a) - n) a ∧ b = take_bit (LENGTH('a)) b"
for w :: "'a::len word"
apply (frule word_ubin.norm_Rep [THEN ssubst])
apply (drule bin_split_trunc1)
apply (drule sym [THEN trans])
apply assumption
apply safe
done

― ‹keep quantifiers for use in simplification›
lemma test_bit_split':
"word_split c = (a, b) ⟶
(∀n m.
b !! n = (n < size b ∧ c !! n) ∧
a !! m = (m < size a ∧ c !! (m + size b)))"
apply (unfold word_split_bin' test_bit_bin)
apply (clarify)
apply (clarsimp simp: word_ubin.eq_norm nth_bintr word_size split: prod.splits)
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq ac_simps bin_nth_uint_imp)
done

lemma test_bit_split:
"word_split c = (a, b) ⟹
(∀n::nat. b !! n ⟷ n < size b ∧ c !! n) ∧
(∀m::nat. a !! m ⟷ m < size a ∧ c !! (m + size b))"

lemma test_bit_split_eq:
"word_split c = (a, b) ⟷
((∀n::nat. b !! n = (n < size b ∧ c !! n)) ∧
(∀m::nat. a !! m = (m < size a ∧ 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

― ‹this odd result is analogous to ‹ucast_id›,
result to the length given by the result type›

lemma word_cat_id: "word_cat a b = b"
by transfer simp

― ‹limited hom result›
lemma word_cat_hom:
"LENGTH('a::len) ≤ LENGTH('b::len) + LENGTH('c::len) ⟹
(word_cat (word_of_int w :: 'b word) (b :: 'c word) :: 'a word) =
word_of_int (bin_cat w (size b) (uint b))"
apply transfer
using bintr_cat by auto

lemma word_cat_split_alt: "size w ≤ size u + size v ⟹ word_split w = (u, v) ⟹ word_cat u v = w"
apply (rule word_eqI)
apply (drule test_bit_split)
apply (clarsimp simp add : test_bit_cat word_size)
apply safe
apply arith
done

lemmas word_cat_split_size = sym [THEN [2] word_cat_split_alt [symmetric]]

subsubsection ‹Split and slice›

lemma split_slices: "word_split w = (u, v) ⟹ u = slice (size v) w ∧ v = slice 0 w"
apply (drule test_bit_split)
apply (rule conjI)
apply (rule word_eqI, clarsimp simp: nth_slice word_size)+
done

lemma slice_cat1 [OF refl]:
"wc = word_cat a b ⟹ size wc >= size a + size b ⟹ slice (size b) wc = a"
apply safe
apply (rule word_eqI)
apply (simp add: nth_slice test_bit_cat word_size)
done

lemmas slice_cat2 = trans [OF slice_id word_cat_id]

lemma cat_slices:
"a = slice n c ⟹ b = slice 0 c ⟹ n = size b ⟹
size a + size b >= size c ⟹ word_cat a b = c"
apply safe
apply (rule word_eqI)
apply (simp add: nth_slice test_bit_cat word_size)
apply safe
apply arith
done

lemma word_split_cat_alt:
"w = word_cat u v ⟹ size u + size v ≤ size w ⟹ word_split w = (u, v)"
apply (case_tac "word_split w")
apply (rule trans, assumption)
apply (drule test_bit_split)
apply safe
apply (rule word_eqI, clarsimp simp: test_bit_cat word_size)+
done

text ‹
This odd result arises from the fact that the statement of the
result implies that the decoded words are of the same type,
and therefore of the same length, as the original word.›

lemma word_rsplit_same: "word_rsplit w = [w]"

lemma word_rsplit_empty_iff_size: "word_rsplit w = [] ⟷ size w = 0"
by (simp add: word_rsplit_def bin_rsplit_def word_size bin_rsplit_aux_simp_alt Let_def
split: prod.split)

lemma test_bit_rsplit:
"sw = word_rsplit w ⟹ m < size (hd sw) ⟹
k < length sw ⟹ (rev sw ! k) !! m = w !! (k * size (hd sw) + m)"
for sw :: "'a::len word list"
apply (unfold word_rsplit_def word_test_bit_def)
apply (rule trans)
apply (rule_tac f = "λx. bin_nth x m" in arg_cong)
apply (rule nth_map [symmetric])
apply simp
apply (rule bin_nth_rsplit)
apply simp_all
apply (simp add : word_size rev_map)
apply (rule trans)
defer
apply (rule map_ident [THEN fun_cong])
apply (rule refl [THEN map_cong])
apply (erule bin_rsplit_size_sign [OF len_gt_0 refl])
done

lemma horner_sum_uint_exp_Cons_eq:
‹horner_sum uint (2 ^ LENGTH('a)) (w # ws) =
concat_bit LENGTH('a) (uint w) (horner_sum uint (2 ^ LENGTH('a)) ws)›
for ws :: ‹'a::len word list›

lemma bit_horner_sum_uint_exp_iff:
‹bit (horner_sum uint (2 ^ LENGTH('a)) ws) n ⟷
n div LENGTH('a) < length ws ∧ bit (ws ! (n div LENGTH('a))) (n mod LENGTH('a))›
for ws :: ‹'a::len word list›
proof (induction ws arbitrary: n)
case Nil
then show ?case
by simp
next
case (Cons w ws)
then show ?case
by (cases ‹n ≥ LENGTH('a)›)
(simp_all only: horner_sum_uint_exp_Cons_eq, simp_all add: bit_concat_bit_iff le_div_geq le_mod_geq bit_uint_iff Cons)
qed

lemma test_bit_rcat:
"sw = size (hd wl) ⟹ rc = word_rcat wl ⟹ rc !! n =
(n < size rc ∧ n div sw < size wl ∧ (rev wl) ! (n div sw) !! (n mod sw))"
for wl :: "'a::len word list"
by (simp add: word_size word_rcat_def bin_rcat_def foldl_map rev_map bit_horner_sum_uint_exp_iff)

lemmas test_bit_cong = arg_cong [where f = "test_bit", THEN fun_cong]

lemma test_bit_rsplit_alt:
‹(word_rsplit w  :: 'b::len word list) ! i !! m ⟷
w !! ((length (word_rsplit w :: 'b::len word list) - Suc i) * size (hd (word_rsplit w :: 'b::len word list)) + m)›
if ‹i < length (word_rsplit w :: 'b::len word list)› ‹m < size (hd (word_rsplit w :: 'b::len word list))› ‹0 < length (word_rsplit w :: 'b::len word list)›
for w :: ‹'a::len word›
apply (rule trans)
apply (rule test_bit_cong)
apply (rule rev_nth [of _ ‹rev (word_rsplit w)›, simplified rev_rev_ident])
apply simp
apply (rule that(1))
apply simp
apply (rule test_bit_rsplit)
apply (rule refl)
apply (rule asm_rl)
apply (rule that(2))
apply (rule diff_Suc_less)
apply (rule that(3))
done

lemma word_rsplit_len_indep [OF refl refl refl refl]:
"[u,v] = p ⟹ [su,sv] = q ⟹ word_rsplit u = su ⟹
word_rsplit v = sv ⟹ length su = length sv"
by (auto simp: word_rsplit_def bin_rsplit_len_indep)

lemma length_word_rsplit_size:
"n = LENGTH('a::len) ⟹
length (word_rsplit w :: 'a word list) ≤ m ⟷ size w ≤ m * n"
by (auto simp: word_rsplit_def word_size bin_rsplit_len_le)

lemmas length_word_rsplit_lt_size =
length_word_rsplit_size [unfolded Not_eq_iff linorder_not_less [symmetric]]

lemma length_word_rsplit_exp_size:
"n = LENGTH('a::len) ⟹
length (word_rsplit w :: 'a word list) = (size w + n - 1) div n"
by (auto simp: word_rsplit_def word_size bin_rsplit_len)

lemma length_word_rsplit_even_size:
"n = LENGTH('a::len) ⟹ size w = m * n ⟹
length (word_rsplit w :: 'a word list) = m"
by (cases ‹LENGTH('a)›) (simp_all add: length_word_rsplit_exp_size div_nat_eqI)

lemmas length_word_rsplit_exp_size' = refl [THEN length_word_rsplit_exp_size]

― ‹alternative proof of ‹word_rcat_rsplit››
lemmas tdle = times_div_less_eq_dividend
lemmas dtle = xtrans(4) [OF tdle mult.commute]

lemma word_rcat_rsplit: "word_rcat (word_rsplit w) = w"
apply (rule word_eqI)
apply (clarsimp simp: test_bit_rcat word_size)
apply (subst refl [THEN test_bit_rsplit])
refl [THEN length_word_rsplit_size [simplified not_less [symmetric], simplified]])
apply safe
apply (erule xtrans(7), rule dtle)+
done

lemma size_word_rsplit_rcat_size:
"word_rcat ws = frcw ⟹ size frcw = length ws * LENGTH('a)
⟹ length (word_rsplit frcw::'a word list) = length ws"
for ws :: "'a::len word list" and frcw :: "'b::len word"
by (cases ‹LENGTH('a)›) (simp_all add: word_size length_word_rsplit_exp_size' div_nat_eqI)

lemma msrevs:
"0 < n ⟹ (k * n + m) div n = m div n + k"
"(k * n + m) mod n = m mod n"
for n :: nat

lemma word_rsplit_rcat_size [OF refl]:
"word_rcat ws = frcw ⟹
size frcw = length ws * LENGTH('a) ⟹ word_rsplit frcw = ws"
for ws :: "'a::len word list"
apply (frule size_word_rsplit_rcat_size, assumption)
apply (clarsimp simp add : word_size)
apply (rule nth_equalityI, assumption)
apply clarsimp
apply (rule word_eqI [rule_format])
apply (rule trans)
apply (rule test_bit_rsplit_alt)
apply (clarsimp simp: word_size)+
apply (rule trans)
apply (rule test_bit_rcat [OF refl refl])
apply (subst rev_nth)
apply arith
apply (simp add: le0 [THEN [2] xtrans(7), THEN diff_Suc_less])
apply safe
apply (cases "size ws")
apply simp_all
done

subsection ‹Rotation›

lemma word_rotr_word_rotr_eq:
‹word_rotr m (word_rotr n w) = word_rotr (m + n) w›

lemma word_rot_rl [simp]:
‹word_rotl k (word_rotr k v) = v›
apply (rule bit_word_eqI)
apply (simp add: word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps)
apply (auto dest: bit_imp_le_length)
done

lemma word_rot_lr [simp]:
‹word_rotr k (word_rotl k v) = v›
apply (rule bit_word_eqI)
apply (simp add: word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps)
apply (auto dest: bit_imp_le_length)
done

lemma word_rot_gal:
‹word_rotr n v = w ⟷ word_rotl n w = v›
by auto

lemma word_rot_gal':
‹w = word_rotr n v ⟷ v = word_rotl n w›
by auto

lemma word_rotr_rev:
‹word_rotr n w = word_reverse (word_rotl n (word_reverse w))›
proof (rule bit_word_eqI)
fix m
assume ‹m < LENGTH('a)›
moreover have ‹1 +
((int m + int n mod int LENGTH('a)) mod int LENGTH('a) +
((int LENGTH('a) * 2) mod int LENGTH('a) - (1 + (int m + int n mod int LENGTH('a)))) mod int LENGTH('a)) =
int LENGTH('a)›
apply (cases ‹(1 + (int m + int n mod int LENGTH('a))) mod
int LENGTH('a) = 0›)
using zmod_zminus1_eq_if [of ‹1 + (int m + int n mod int LENGTH('a))› ‹int LENGTH('a)›]
apply simp_all
apply (simp add: minus_equation_iff [of ‹int m›])
apply (drule sym [of _ ‹int m›])
apply simp
apply (metis (no_types, hide_lams) Abs_fnat_hom_add less_not_refl mod_Suc of_nat_Suc of_nat_gt_0 of_nat_mod)
done
then have ‹int ((m + n) mod LENGTH('a)) =
int (LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a)))›
using ‹m < LENGTH('a)›
by (simp only: of_nat_mod mod_simps)
then have ‹(m + n) mod LENGTH('a) =
LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a))›
by simp
ultimately show ‹bit (word_rotr n w) m ⟷ bit (word_reverse (word_rotl n (word_reverse w))) m›
by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff bit_word_reverse_iff)
qed

lemma word_roti_0 [simp]: "word_roti 0 w = w"
by transfer simp

lemma word_roti_add: "word_roti (m + n) w = word_roti m (word_roti n w)"
by (rule bit_word_eqI)
(simp add: bit_word_roti_iff nat_less_iff mod_simps ac_simps)

lemma word_roti_conv_mod':
"word_roti n w = word_roti (n mod int (size w)) w"
by transfer simp

lemmas word_roti_conv_mod = word_roti_conv_mod' [unfolded word_size]

subsubsection ‹"Word rotation commutes with bit-wise operations›

― ‹using locale to not pollute lemma namespace›
locale word_rotate
begin

lemma word_rot_logs:
"word_rotl n (NOT v) = NOT (word_rotl n v)"
"word_rotr n (NOT v) = NOT (word_rotr n v)"
"word_rotl n (x AND y) = word_rotl n x AND word_rotl n y"
"word_rotr n (x AND y) = word_rotr n x AND word_rotr n y"
"word_rotl n (x OR y) = word_rotl n x OR word_rotl n y"
"word_rotr n (x OR y) = word_rotr n x OR word_rotr n y"
"word_rotl n (x XOR y) = word_rotl n x XOR word_rotl n y"
"word_rotr n (x XOR y) = word_rotr n x XOR word_rotr n y"
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotl_iff bit_not_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotr_iff bit_not_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotl_iff bit_and_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotr_iff bit_and_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotl_iff bit_or_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotr_iff bit_or_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotl_iff bit_xor_iff algebra_simps exp_eq_zero_iff not_le)
apply (rule bit_word_eqI)
apply (auto simp add: bit_word_rotr_iff bit_xor_iff algebra_simps exp_eq_zero_iff not_le)
done

end

lemmas word_rot_logs = word_rotate.word_rot_logs

lemma word_rotx_0 [simp] : "word_rotr i 0 = 0 ∧ word_rotl i 0 = 0"
by transfer simp_all

lemma word_roti_0' [simp] : "word_roti n 0 = 0"
by transfer simp

declare word_roti_eq_word_rotr_word_rotl [simp]

subsection ‹Maximum machine word›

lemma word_int_cases:
fixes x :: "'a::len word"
obtains n where "x = word_of_int n" and "0 ≤ n" and "n < 2^LENGTH('a)"
by (cases x rule: word_uint.Abs_cases) (simp add: uints_num)

lemma word_nat_cases [cases type: word]:
fixes x :: "'a::len word"
obtains n where "x = of_nat n" and "n < 2^LENGTH('a)"
by (cases x rule: word_unat.Abs_cases) (simp add: unats_def)

lemma max_word_max [intro!]: "n ≤ max_word"
by (fact word_order.extremum)

lemma word_of_int_2p_len: "word_of_int (2 ^ LENGTH('a)) = (0::'a::len word)"
by (subst word_uint.Abs_norm [symmetric]) simp

lemma word_pow_0: "(2::'a::len word) ^ LENGTH('a) = 0"
by (fact word_exp_length_eq_0)

lemma max_word_wrap: "x + 1 = 0 ⟹ x = max_word"

lemma max_test_bit: "(max_word::'a::len word) !! n ⟷ n < LENGTH('a)"
by (fact nth_minus1)

lemma word_and_max: "x AND max_word = x"
by (fact word_log_esimps)

lemma word_or_max: "x OR max_word = max_word"
by (fact word_log_esimps)

lemma word_ao_dist2: "x AND (y OR z) = x AND y OR x AND z"
for x y z :: "'a::len word"
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size)

lemma word_oa_dist2: "x OR y AND z = (x OR y) AND (x OR z)"
for x y z :: "'a::len word"
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size)

lemma word_and_not [simp]: "x AND NOT x = 0"
for x :: "'a::len word"
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size)

lemma word_or_not [simp]: "x OR NOT x = max_word"
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size)

lemma word_xor_and_or: "x XOR y = x AND NOT y OR NOT x AND y"
for x y :: "'a::len word"
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size)

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

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

lemma shiftl_1 [simp]: "(1::'a::len word) << n = 2^n"

lemma uint_lt_0 [simp]: "uint x < 0 = False"

lemma shiftr1_1 [simp]: "shiftr1 (1::'a::len word) = 0"
by transfer simp

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

lemma word_less_1 [simp]: "x < 1 ⟷ x = 0"
for x :: "'a::len word"

lemma map_nth_0 [simp]: "map ((!!) (0::'a::len word)) xs = replicate (length xs) False"
by (induct xs) auto

lemma uint_plus_if_size:
"uint (x + y) =
(if uint x + uint y < 2^size x
then uint x + uint y
else uint x + uint y - 2^size x)"

lemma unat_plus_if_size:
"unat (x + y) =
(if unat x + unat y < 2^size x
then unat x + unat y
else unat x + unat y - 2^size x)"
for x y :: "'a::len word"
apply (subst word_arith_nat_defs)
apply (subst unat_of_nat)
apply (auto simp add: not_less word_size)
apply (metis not_le unat_plus_if' unat_word_ariths(1))
done

lemma word_neq_0_conv: "w ≠ 0 ⟷ 0 < w"
for w :: "'a::len word"

lemma max_lt: "unat (max a b div c) = unat (max a b) div unat c"
for c :: "'a::len word"
by (fact unat_div)

lemma uint_sub_if_size:
"uint (x - y) =
(if uint y ≤ uint x
then uint x - uint y
else uint x - uint y + 2^size x)"
by (simp add: word_arith_wis int_word_uint mod_sub_if_z word_size)

lemma unat_sub:
‹unat (a - b) = unat a - unat b›
if ‹b ≤ a›
proof -
from that have ‹unat b ≤ unat a›
by transfer simp
with that show ?thesis
apply transfer
apply simp
apply (subst take_bit_diff [symmetric])
apply (subst nat_take_bit_eq)
apply (simp add: nat_diff_distrib take_bit_eq_self less_imp_diff_less bintr_lt2p)
done
qed

lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "numeral w"] for w
lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "numeral w"] for w

lemma word_of_int_minus: "word_of_int (2^LENGTH('a) - i) = (word_of_int (-i)::'a::len word)"
proof -
have *: "2^LENGTH('a) - i = -i + 2^LENGTH('a)"
by simp
show ?thesis
apply (subst *)
apply (subst word_uint.Abs_norm [symmetric], subst mod_add_self2)
apply simp
done
qed

lemmas word_of_int_inj =
word_uint.Abs_inject [unfolded uints_num, simplified]

lemma word_le_less_eq: "x ≤ y ⟷ x = y ∨ x < y"
for x y :: "'z::len word"

lemma mod_plus_cong:
fixes b b' :: int
assumes 1: "b = b'"
and 2: "x mod b' = x' mod b'"
and 3: "y mod b' = y' mod b'"
and 4: "x' + y' = z'"
shows "(x + y) mod b = z' mod b'"
proof -
from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'"
also have "… = (x' + y') mod b'"
finally show ?thesis
qed

lemma mod_minus_cong:
fixes b b' :: int
assumes "b = b'"
and "x mod b' = x' mod b'"
and "y mod b' = y' mod b'"
and "x' - y' = z'"
shows "(x - y) mod b = z' mod b'"
using assms [symmetric] by (auto intro: mod_diff_cong)

lemma word_induct_less: "P 0 ⟹ (⋀n. n < m ⟹ P n ⟹ P (1 + n)) ⟹ P m"
for P :: "'a::len word ⇒ bool"
apply (cases m)
apply atomize
apply (erule rev_mp)+
apply (rule_tac x=m in spec)
apply (induct_tac n)
apply simp
apply clarsimp
apply (erule impE)
apply clarsimp
apply (erule_tac x=n in allE)
apply (erule impE)
apply (clarsimp simp: unat_of_nat)
apply simp
apply (erule_tac x="of_nat na" in allE)
apply (erule impE)
apply (clarsimp simp: unat_of_nat)
apply simp
done

lemma word_induct: "P 0 ⟹ (⋀n. P n ⟹ P (1 + n)) ⟹ P m"
for P :: "'a::len word ⇒ bool"
by (erule word_induct_less) simp

lemma word_induct2 [induct type]: "P 0 ⟹ (⋀n. 1 + n ≠ 0 ⟹ P n ⟹ P (1 + n)) ⟹ P n"
for P :: "'b::len word ⇒ bool"
apply (rule word_induct)
apply simp
apply (case_tac "1 + n = 0")
apply auto
done

subsection ‹Recursion combinator for words›

definition word_rec :: "'a ⇒ ('b::len word ⇒ 'a ⇒ 'a) ⇒ 'b word ⇒ 'a"
where "word_rec forZero forSuc n = rec_nat forZero (forSuc ∘ of_nat) (unat n)"

lemma word_rec_0: "word_rec z s 0 = z"

lemma word_rec_Suc: "1 + n ≠ 0 ⟹ word_rec z s (1 + n) = s n (word_rec z s n)"
for n :: "'a::len word"
apply (auto simp add: word_rec_def unat_word_ariths)
apply (metis (mono_tags, lifting) old.nat.simps(7) unatSuc word_unat.Rep_inverse word_unat.eq_norm word_unat.td_th)
done

lemma word_rec_Pred: "n ≠ 0 ⟹ word_rec z s n = s (n - 1) (word_rec z s (n - 1))"
apply (rule subst[where t="n" and s="1 + (n - 1)"])
apply simp
apply (subst word_rec_Suc)
apply simp
apply simp
done

lemma word_rec_in: "f (word_rec z (λ_. f) n) = word_rec (f z) (λ_. f) n"
by (induct n) (simp_all add: word_rec_0 word_rec_Suc)

lemma word_rec_in2: "f n (word_rec z f n) = word_rec (f 0 z) (f ∘ (+) 1) n"
by (induct n) (simp_all add: word_rec_0 word_rec_Suc)

lemma word_rec_twice:
"m ≤ n ⟹ word_rec z f n = word_rec (word_rec z f (n - m)) (f ∘ (+) (n - m)) m"
apply (erule rev_mp)
apply (rule_tac x=z in spec)
apply (rule_tac x=f in spec)
apply (induct n)
apply clarsimp
apply (rule_tac t="1 + n - m" and s="1 + (n - m)" in subst)
apply simp
apply (case_tac "1 + (n - m) = 0")
apply (rule_tac f = "word_rec a b" for a b in arg_cong)
apply (rule_tac t="m" and s="m + (1 + (n - m))" in subst)
apply simp
apply (simp (no_asm_use))
apply (erule impE)
apply uint_arith
apply (drule_tac x="x ∘ (+) 1" in spec)
apply (drule_tac x="x 0 xa" in spec)
apply simp
apply (rule_tac t="λa. x (1 + (n - m + a))" and s="λa. x (1 + (n - m) + a)" in subst)
apply (rule_tac t="(1 + (n - m + xb))" and s="1 + (n - m) + xb" in subst)
apply simp
apply (rule refl)
apply (rule refl)
done

lemma word_rec_id: "word_rec z (λ_. id) n = z"
by (induct n) (auto simp add: word_rec_0 word_rec_Suc)

lemma word_rec_id_eq: "∀m < n. f m = id ⟹ word_rec z f n = z"
apply (erule rev_mp)
apply (induct n)
apply (auto simp add: word_rec_0 word_rec_Suc)
apply (drule spec, erule mp)
apply uint_arith
apply (drule_tac x=n in spec, erule impE)
apply uint_arith
apply simp
done

lemma word_rec_max:
"∀m≥n. m ≠ - 1 ⟶ f m = id ⟹ word_rec z f (- 1) = word_rec z f n"
apply (subst word_rec_twice[where n="-1" and m="-1 - n"])
apply simp
apply simp
apply (rule word_rec_id_eq)
apply clarsimp
apply (drule spec, rule mp, erule mp)
apply (rule word_plus_mono_right2[OF _ order_less_imp_le])
prefer 2
apply assumption
apply simp
apply (erule contrapos_pn)
apply simp
apply (drule arg_cong[where f="λx. x - n"])
apply simp
done

subsection ‹More›

lemma test_bit_1' [simp]:
"(1 :: 'a :: len word) !! n ⟷ 0 < LENGTH('a) ∧ n = 0"
by simp

lemma shiftl0:
"x << 0 = (x :: 'a :: len word)"
by (fact shiftl_x_0)

lemma bin_last_bintrunc: "bin_last (take_bit l n) = (l > 0 ∧ bin_last n)"
by simp

lemma word_and_1:
"n AND 1 = (if n !! 0 then 1 else 0)" for n :: "_ word"
by (rule bit_word_eqI) (auto simp add: bit_and_iff test_bit_eq_bit bit_1_iff intro: gr0I)

lemma bintrunc_shiftl:
"take_bit n (m << i) = take_bit (n - i) m << i"
for m :: int
by (rule bit_eqI) (auto simp add: bit_take_bit_iff)

lemma uint_shiftl:
"uint (n << i) = take_bit (size n) (uint n << i)"
by transfer (simp add: push_bit_take_bit shiftl_eq_push_bit)

subsection ‹Misc›

ML_file ‹Tools/word_lib.ML›
ML_file ‹Tools/smt_word.ML›

end
```