diff -r bad75618fb82 -r 66beb9d92e43 src/HOL/Word/Word.thy --- a/src/HOL/Word/Word.thy Thu Jul 02 12:10:58 2020 +0000 +++ b/src/HOL/Word/Word.thy Fri Jul 03 06:18:27 2020 +0000 @@ -15,7 +15,63 @@ Misc_Arithmetic begin -text \See \<^file>\Word_Examples.thy\ for examples.\ +subsection \Prelude\ + +lemma (in semiring_bit_shifts) bit_push_bit_iff: \ \TODO move\ + \bit (push_bit m a) n \ m \ n \ 2 ^ n \ 0 \ bit a (n - m)\ + by (auto simp add: bit_iff_odd push_bit_eq_mult even_mult_exp_div_exp_iff) + +lemma (in semiring_bit_shifts) push_bit_numeral [simp]: \ \TODO: move\ + \push_bit (numeral l) (numeral k) = push_bit (pred_numeral l) (numeral (Num.Bit0 k))\ + by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0) + +lemma minus_mod_int_eq: \ \TODO move\ + \- k mod l = l - 1 - (k - 1) mod l\ if \l \ 0\ for k l :: int +proof (cases \l = 0\) + case True + then show ?thesis + by simp +next + case False + with that have \l > 0\ + by simp + then show ?thesis + proof (cases \l dvd k\) + case True + then obtain j where \k = l * j\ .. + moreover have \(l * j mod l - 1) mod l = l - 1\ + using \l > 0\ by (simp add: zmod_minus1) + then have \(l * j - 1) mod l = l - 1\ + by (simp only: mod_simps) + ultimately show ?thesis + by simp + next + case False + moreover have \0 < k mod l\ \k mod l < 1 + l\ + using \0 < l\ le_imp_0_less pos_mod_conj False apply auto + using le_less apply fastforce + using pos_mod_bound [of l k] apply linarith + done + with \l > 0\ have \(k mod l - 1) mod l = k mod l - 1\ + by (simp add: zmod_trival_iff) + ultimately show ?thesis + apply (simp only: zmod_zminus1_eq_if) + apply (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps) + done + qed +qed + +lemma nth_rotate: \ \TODO move\ + \rotate m xs ! n = xs ! ((m + n) mod length xs)\ if \n < length xs\ + using that apply (auto simp add: rotate_drop_take nth_append not_less less_diff_conv ac_simps dest!: le_Suc_ex) + apply (metis add.commute mod_add_right_eq mod_less) + apply (metis (no_types, lifting) Nat.diff_diff_right add.commute add_diff_cancel_right' diff_le_self dual_order.strict_trans2 length_greater_0_conv less_nat_zero_code list.size(3) mod_add_right_eq mod_add_self2 mod_le_divisor mod_less) + done + +lemma nth_rotate1: \ \TODO move\ + \rotate1 xs ! n = xs ! (Suc n mod length xs)\ if \n < length xs\ + using that nth_rotate [of n xs 1] by simp + subsection \Type definition\ @@ -813,8 +869,46 @@ lemma bit_word_eqI: \a = b\ if \\n. n \ LENGTH('a) \ bit a n \ bit b n\ - for a b :: \'a::len word\ - by (rule bit_eqI, rule that) (simp add: exp_eq_zero_iff) + 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 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\ + by transfer (simp add: bit_take_bit_iff) + +lemma bit_sint_iff: + \bit (sint w) n \ n \ LENGTH('a) \ bit w (LENGTH('a) - 1) \ bit w n\ + for w :: \'a::len word\ + apply (cases \LENGTH('a)\) + apply simp + apply (simp add: sint_uint nth_sbintr not_less bit_uint_iff not_le Suc_le_eq) + apply (auto simp add: le_less dest: bit_imp_le_length) + done + +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 (simp add: ucast_def bit_word_of_int_iff bit_uint_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 (simp add: scast_def bit_word_of_int_iff bit_sint_iff ac_simps) definition shiftl1 :: "'a::len word \ 'a word" where "shiftl1 w = word_of_int (2 * uint w)" @@ -822,12 +916,16 @@ lemma shiftl1_eq_mult_2: \shiftl1 = (*) 2\ apply (simp add: fun_eq_iff shiftl1_def) - apply (simp only: mult_2) apply transfer - apply (simp only: take_bit_add) + apply (simp only: mult_2 take_bit_add) apply simp done +lemma bit_shiftl1_iff: + \bit (shiftl1 w) n \ 0 < n \ n < LENGTH('a) \ bit w (n - 1)\ + for w :: \'a::len word\ + by (simp add: shiftl1_eq_mult_2 bit_double_iff exp_eq_zero_iff not_le) (simp add: ac_simps) + definition shiftr1 :: "'a::len word \ 'a word" \ \shift right as unsigned or as signed, ie logical or arithmetic\ where "shiftr1 w = word_of_int (bin_rest (uint w))" @@ -839,6 +937,11 @@ apply (auto simp add: not_le dest: less_2_cases) done +lemma bit_shiftr1_iff: + \bit (shiftr1 w) n \ bit w (Suc n)\ + for w :: \'a::len word\ + by (simp add: shiftr1_eq_div_2 bit_Suc) + instantiation word :: (len) ring_bit_operations begin @@ -900,6 +1003,18 @@ apply (simp add: bit_take_bit_iff) done +lemma set_bit_unfold: + \set_bit w n b = (if b then Bit_Operations.set_bit n w else unset_bit n w)\ + for w :: \'a::len word\ + apply (auto simp add: word_set_bit_def bin_clr_conv_NAND bin_set_conv_OR unset_bit_def set_bit_def shiftl_int_def; transfer) + apply simp_all + done + +lemma bit_set_bit_word_iff: + \bit (set_bit w m b) n \ (if m = n then n < LENGTH('a) \ b else bit w n)\ + for w :: \'a::len word\ + by (auto simp add: set_bit_unfold bit_unset_bit_iff bit_set_bit_iff exp_eq_zero_iff not_le bit_imp_le_length) + lemma lsb_word_eq: \lsb = (odd :: 'a word \ bool)\ for w :: \'a::len word\ apply (simp add: word_lsb_def fun_eq_iff) @@ -918,6 +1033,11 @@ \w << n = push_bit n w\ for w :: \'a::len word\ by (induction n) (simp_all add: shiftl_def shiftl1_eq_mult_2 push_bit_double) +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\ by (simp add: shiftl_word_eq) @@ -926,6 +1046,11 @@ \w >> n = drop_bit n w\ for w :: \'a::len word\ by (induction n) (simp_all add: shiftr_def shiftr1_eq_div_2 drop_bit_Suc drop_bit_half) +lemma bit_shiftr_word_iff: + \bit (w >> m) n \ bit w (m + n)\ + for w :: \'a::len word\ + by (simp add: shiftr_word_eq bit_drop_bit_eq) + lemma [code]: \drop_bit n w = w >> n\ for w :: \'a::len word\ by (simp add: shiftr_word_eq) @@ -952,9 +1077,29 @@ definition setBit :: "'a::len word \ nat \ 'a word" where "setBit w n = set_bit w n True" +lemma setBit_eq_set_bit: + \setBit w n = Bit_Operations.set_bit n w\ + for w :: \'a::len word\ + by (simp add: setBit_def set_bit_unfold) + +lemma bit_setBit_iff: + \bit (setBit w m) n \ (m = n \ n < LENGTH('a) \ bit w n)\ + for w :: \'a::len word\ + by (simp add: setBit_eq_set_bit bit_set_bit_iff exp_eq_zero_iff not_le ac_simps) + definition clearBit :: "'a::len word \ nat \ 'a word" where "clearBit w n = set_bit w n False" +lemma clearBit_eq_unset_bit: + \clearBit w n = unset_bit n w\ + for w :: \'a::len word\ + by (simp add: clearBit_def set_bit_unfold) + +lemma bit_clearBit_iff: + \bit (clearBit w m) n \ m \ n \ bit w n\ + for w :: \'a::len word\ + by (simp add: clearBit_eq_unset_bit bit_unset_bit_iff ac_simps) + definition even_word :: \'a::len word \ bool\ where [code_abbrev]: \even_word = even\ @@ -981,11 +1126,15 @@ definition mask :: "nat \ 'a::len word" where "mask n = (1 << n) - 1" +definition slice1 :: "nat \ 'a::len word \ 'b::len word" + where "slice1 n w = of_bl (takefill False n (to_bl w))" + definition revcast :: "'a::len word \ 'b::len word" where "revcast w = of_bl (takefill False (LENGTH('b)) (to_bl w))" -definition slice1 :: "nat \ 'a::len word \ 'b::len word" - where "slice1 n w = of_bl (takefill False n (to_bl w))" +lemma revcast_eq: + \(revcast :: 'a::len word \ 'b::len word) = slice1 LENGTH('b)\ + by (simp add: fun_eq_iff revcast_def slice1_def) definition slice :: "nat \ 'a::len word \ 'b::len word" where "slice n w = slice1 (size w - n) w" @@ -1016,6 +1165,18 @@ definition word_cat :: "'a::len word \ 'b::len word \ 'c::len word" where "word_cat a b = word_of_int (bin_cat (uint a) (LENGTH('b)) (uint b))" +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\ + apply (simp add: word_cat_def bin_cat_eq_push_bit_add_take_bit ucast_def) + apply transfer apply simp + done + +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 (auto simp add: word_cat_def bit_word_of_int_iff bin_nth_cat bit_uint_iff not_less bit_imp_le_length) + definition word_split :: "'a::len word \ 'b::len word \ 'c::len word" where "word_split a = (case bin_split (LENGTH('c)) (uint a) of @@ -1404,6 +1565,10 @@ by (auto simp add: of_bl_def word_test_bit_def word_size word_ubin.eq_norm nth_bintr bin_nth_of_bl) +lemma bit_of_bl_iff: + \bit (of_bl bs :: 'a word) n \ rev bs ! n \ n < LENGTH('a::len) \ n < length bs\ + using test_bit_of_bl [of bs n] by (simp add: test_bit_word_eq) + lemma no_of_bl: "(numeral bin ::'a::len word) = of_bl (bin_to_bl (LENGTH('a)) (numeral bin))" by (simp add: of_bl_def) @@ -3029,6 +3194,36 @@ apply (auto simp add: word_size) done +lemma map_bit_interval_eq: + \map (bit w) [0.. for w :: \'a::len word\ +proof (rule nth_equalityI) + show \length (map (bit w) [0.. + by simp + fix m + assume \m < length (map (bit w) [0.. + then have \m < n\ + by simp + then have \bit w m \ takefill False n (rev (to_bl w)) ! m\ + by (auto simp add: nth_takefill not_less rev_nth to_bl_nth word_size test_bit_word_eq dest: bit_imp_le_length) + with \m < n \show \map (bit w) [0.. takefill False n (rev (to_bl w)) ! m\ + by simp +qed + +lemma to_bl_unfold: + \to_bl w = rev (map (bit w) [0.. for w :: \'a::len word\ + by (simp add: map_bit_interval_eq takefill_bintrunc to_bl_def flip: bin_to_bl_def) + +lemma nth_rev_to_bl: + \rev (to_bl w) ! n \ bit w n\ + if \n < LENGTH('a)\ for w :: \'a::len word\ + using that by (simp add: to_bl_unfold) + +lemma nth_to_bl: + \to_bl w ! n \ bit w (LENGTH('a) - Suc n)\ + if \n < LENGTH('a)\ for w :: \'a::len word\ + using that by (simp add: to_bl_unfold rev_nth) + lemma test_bit_set: "(set_bit w n x) !! n \ n < size w \ x" for w :: "'a::len word" by (auto simp: word_size word_test_bit_def word_set_bit_def word_ubin.eq_norm nth_bintr) @@ -3045,6 +3240,29 @@ lemma of_bl_rep_False: "of_bl (replicate n False @ bs) = of_bl bs" by (auto simp: of_bl_def bl_to_bin_rep_F) +lemma 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)\) (simp_all add: word_reverse_def bit_of_bl_iff nth_to_bl) + +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 (cases \n + (LENGTH('a) - m) - (m - LENGTH('a)) < LENGTH('a)\) + (auto simp add: slice1_def bit_of_bl_iff takefill_alt rev_take nth_append not_less nth_rev_to_bl ac_simps) + +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\ + by (simp add: revcast_eq bit_slice1_iff) + +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 msb_nth: "msb w = w !! (LENGTH('a) - 1)" for w :: "'a::len word" by (simp add: word_msb_nth word_test_bit_def) @@ -3214,6 +3432,10 @@ 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_of_bl_iff) + lemmas of_nth_def = word_set_bits_def (* FIXME duplicate *) lemma td_ext_nth [OF refl refl refl, unfolded word_size]: @@ -3338,6 +3560,25 @@ apply simp done +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 (cases \LENGTH('a)\) + apply simp + apply (simp add: sshiftr1_def bit_word_of_int_iff bit_sint_iff flip: bit_Suc) + apply transfer apply auto + 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 (cases \LENGTH('a)\) + apply simp + apply (simp only:) + apply (induction m arbitrary: n) + apply (auto simp add: sshiftr_def bit_sshiftr1_iff not_le less_diff_conv) + done + lemma nth_sshiftr1: "sshiftr1 w !! n = (if n = size w - 1 then w !! n else w !! Suc n)" apply (unfold sshiftr1_def word_test_bit_def) apply (simp add: nth_bintr word_ubin.eq_norm bit_Suc [symmetric] word_size) @@ -3404,6 +3645,15 @@ apply (simp add: sshiftr1_div_2 mult.commute zdiv_zmult2_eq [symmetric]) 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 (cases \LENGTH('a)\) + apply simp + apply (simp add: bshiftr1_def bit_of_bl_iff nth_append not_less rev_nth nth_butlast nth_to_bl) + apply (use bit_imp_le_length in fastforce) + done + subsubsection \shift functions in terms of lists of bools\ @@ -3706,15 +3956,15 @@ context begin -qualified lemma bit_mask_iff [simp]: - \bit (mask m :: 'a::len word) n \ n < LENGTH('a) \ n < m\ +qualified lemma bit_mask_iff: + \bit (mask m :: 'a::len word) n \ n < min LENGTH('a) m\ by (simp add: mask_eq_mask bit_mask_iff exp_eq_zero_iff not_le) end lemma nth_mask [simp]: \(mask n :: 'a::len word) !! i \ i < n \ i < size (mask n :: 'a word)\ - by (auto simp add: test_bit_word_eq word_size) + by (auto simp add: test_bit_word_eq word_size Word.bit_mask_iff) lemma mask_bl: "mask n = of_bl (replicate n True)" by (auto simp add : test_bit_of_bl word_size intro: word_eqI) @@ -4447,6 +4697,36 @@ lemmas rotater_0' [simp] = rotater_def [where n = "0", simplified] +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\ +proof (cases \n < LENGTH('a)\) + case False + then show ?thesis + by (auto dest: bit_imp_le_length) +next + case True + define k where \k = int n - int m\ + then have k: \int n = k + int m\ + by simp + define l where \l = int LENGTH('a)\ + then have l: \int LENGTH('a) = l\ \l > 0\ + by simp_all + have *: \int (m - n) = int m - int n\ if \n \ m\ for n m + using that by (simp add: int_minus) + from \l > 0\ have \l = 1 + (k mod l + ((- 1 - k) mod l))\ + using minus_mod_int_eq [of l \k + 1\] by (simp add: algebra_simps) + then have \int (LENGTH('a) - Suc ((m + LENGTH('a) - Suc n) mod LENGTH('a))) = + int ((n + LENGTH('a) - m mod LENGTH('a)) mod LENGTH('a))\ + by (simp add: * k l zmod_int Suc_leI trans_le_add2 algebra_simps mod_simps \n < LENGTH('a)\) + then have \LENGTH('a) - Suc ((m + LENGTH('a) - Suc n) mod LENGTH('a)) = + (n + LENGTH('a) - m mod LENGTH('a)) mod LENGTH('a)\ + by simp + with True show ?thesis + by (simp add: word_rotl_def bit_of_bl_iff rev_nth nth_rotate nth_to_bl) +qed + lemmas word_rot_defs = word_roti_def word_rotr_def word_rotl_def lemma rotate_eq_mod: "m mod length xs = n mod length xs \ rotate m xs = rotate n xs" @@ -4497,7 +4777,15 @@ lemma rotater_Suc [simp]: "rotater (Suc n) xs = rotater1 (rotater n xs)" unfolding rotater_def by auto -lemma rotate_inv_plus [rule_format] : +lemma nth_rotater: + \rotater m xs ! n = xs ! ((n + (length xs - m mod length xs)) mod length xs)\ if \n < length xs\ + using that by (simp add: rotater_drop_take nth_append not_less less_diff_conv ac_simps le_mod_geq) + +lemma nth_rotater1: + \rotater1 xs ! n = xs ! ((n + (length xs - 1)) mod length xs)\ if \n < length xs\ + using that nth_rotater [of n xs 1] by simp + +lemma rotate_inv_plus [rule_format]: "\k. k = m + n \ rotater k (rotate n xs) = rotater m xs \ rotate k (rotater n xs) = rotate m xs \ rotater n (rotate k xs) = rotate m xs \ @@ -4520,6 +4808,69 @@ lemma length_rotater [simp]: "length (rotater n xs) = length xs" by (simp add : rotater_rev) +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 (cases \n < LENGTH('a)\) + case False + then show ?thesis + by (auto dest: bit_imp_le_length) +next + case True + define k where \k = int n + int m\ + then have k: \int n = k - int m\ + by simp + define l where \l = int LENGTH('a)\ + then have l: \int LENGTH('a) = l\ \l > 0\ + by simp_all + have *: \int (m - n) = int m - int n\ if \n \ m\ for n m + using that by (simp add: int_minus) + have \int ((LENGTH('a) + - Suc ((LENGTH('a) + LENGTH('a) - Suc (n + m mod LENGTH('a))) mod LENGTH('a)))) = + int ((n + m) mod LENGTH('a))\ + using True + apply (simp add: l * zmod_int Suc_leI add_strict_mono) + apply (subst mod_diff_left_eq [symmetric]) + apply simp + using l minus_mod_int_eq [of l \int n + int m mod l + 1\] apply simp + apply (simp add: mod_simps) + done + then have \(LENGTH('a) + - Suc ((LENGTH('a) + LENGTH('a) - Suc (n + m mod LENGTH('a))) mod LENGTH('a))) = + ((n + m) mod LENGTH('a))\ + by simp + with True show ?thesis + by (simp add: word_rotr_def bit_of_bl_iff rev_nth nth_rotater nth_to_bl) +qed + +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 (cases \k \ 0\) + case True + moreover define m where \m = nat k\ + ultimately have \k = int m\ + by simp + then show ?thesis + by (simp add: word_roti_def bit_word_rotr_iff nat_mod_distrib nat_add_distrib) +next + have *: \int (m - n) = int m - int n\ if \n \ m\ for n m + using that by (simp add: int_minus) + case False + moreover define m where \m = nat (- k)\ + ultimately have \k = - int m\ \k < 0\ + by simp_all + moreover have \(int n - int m) mod int LENGTH('a) = + int ((n + LENGTH('a) - m mod LENGTH('a)) mod LENGTH('a))\ + apply (simp add: zmod_int * trans_le_add2 mod_simps) + apply (metis mod_add_self2 mod_diff_cong) + done + ultimately show ?thesis + by (simp add: word_roti_def bit_word_rotl_iff nat_mod_distrib) +qed + lemma restrict_to_left: "x = y \ x = z \ y = z" by simp @@ -5173,7 +5524,10 @@ lemma uint_shiftl: "uint (n << i) = bintrunc (size n) (uint n << i)" - unfolding word_size by transfer (simp add: bintrunc_shiftl) + apply (simp add: word_size shiftl_eq_push_bit shiftl_word_eq) + apply transfer + apply (simp add: push_bit_take_bit) + done subsection \Misc\