# HG changeset patch # User haftmann # Date 1521657563 -3600 # Node ID 02a14c1cb9175f79818571f163c867ab34f38cca # Parent 9cc32b18c7851f560a87546c0eda6052785bf38d prefer convention to place operation name before type name diff -r 9cc32b18c785 -r 02a14c1cb917 src/HOL/Parity.thy --- a/src/HOL/Parity.thy Tue Mar 20 09:27:40 2018 +0000 +++ b/src/HOL/Parity.thy Wed Mar 21 19:39:23 2018 +0100 @@ -681,29 +681,29 @@ text \The primary purpose of the following operations is to avoid ad-hoc simplification of concrete expressions @{term "2 ^ n"}\ -definition bit_push :: "nat \ 'a \ 'a" - where bit_push_eq_mult: "bit_push n a = a * 2 ^ n" +definition push_bit :: "nat \ 'a \ 'a" + where push_bit_eq_mult: "push_bit n a = a * 2 ^ n" -definition bit_take :: "nat \ 'a \ 'a" - where bit_take_eq_mod: "bit_take n a = a mod of_nat (2 ^ n)" +definition take_bit :: "nat \ 'a \ 'a" + where take_bit_eq_mod: "take_bit n a = a mod of_nat (2 ^ n)" -definition bit_drop :: "nat \ 'a \ 'a" - where bit_drop_eq_div: "bit_drop n a = a div of_nat (2 ^ n)" +definition drop_bit :: "nat \ 'a \ 'a" + where drop_bit_eq_div: "drop_bit n a = a div of_nat (2 ^ n)" lemma bit_ident: - "bit_push n (bit_drop n a) + bit_take n a = a" - using div_mult_mod_eq by (simp add: bit_push_eq_mult bit_take_eq_mod bit_drop_eq_div) + "push_bit n (drop_bit n a) + take_bit n a = a" + using div_mult_mod_eq by (simp add: push_bit_eq_mult take_bit_eq_mod drop_bit_eq_div) -lemma bit_take_bit_take [simp]: - "bit_take n (bit_take n a) = bit_take n a" - by (simp add: bit_take_eq_mod) +lemma take_bit_take_bit [simp]: + "take_bit n (take_bit n a) = take_bit n a" + by (simp add: take_bit_eq_mod) -lemma bit_take_0 [simp]: - "bit_take 0 a = 0" - by (simp add: bit_take_eq_mod) +lemma take_bit_0 [simp]: + "take_bit 0 a = 0" + by (simp add: take_bit_eq_mod) -lemma bit_take_Suc [simp]: - "bit_take (Suc n) a = bit_take n (a div 2) * 2 + of_bool (odd a)" +lemma take_bit_Suc [simp]: + "take_bit (Suc n) a = take_bit n (a div 2) * 2 + of_bool (odd a)" proof - have "1 + 2 * (a div 2) mod (2 * 2 ^ n) = (a div 2 * 2 + a mod 2) mod (2 * 2 ^ n)" if "odd a" @@ -712,99 +712,99 @@ also have "\ = a mod (2 * 2 ^ n)" by (simp only: div_mult_mod_eq) finally show ?thesis - by (simp add: bit_take_eq_mod algebra_simps mult_mod_right) + by (simp add: take_bit_eq_mod algebra_simps mult_mod_right) qed -lemma bit_take_of_0 [simp]: - "bit_take n 0 = 0" - by (simp add: bit_take_eq_mod) +lemma take_bit_of_0 [simp]: + "take_bit n 0 = 0" + by (simp add: take_bit_eq_mod) -lemma bit_take_plus: - "bit_take n (bit_take n a + bit_take n b) = bit_take n (a + b)" - by (simp add: bit_take_eq_mod mod_simps) +lemma take_bit_plus: + "take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)" + by (simp add: take_bit_eq_mod mod_simps) -lemma bit_take_of_1_eq_0_iff [simp]: - "bit_take n 1 = 0 \ n = 0" - by (simp add: bit_take_eq_mod) +lemma take_bit_of_1_eq_0_iff [simp]: + "take_bit n 1 = 0 \ n = 0" + by (simp add: take_bit_eq_mod) -lemma bit_push_eq_0_iff [simp]: - "bit_push n a = 0 \ a = 0" - by (simp add: bit_push_eq_mult) +lemma push_bit_eq_0_iff [simp]: + "push_bit n a = 0 \ a = 0" + by (simp add: push_bit_eq_mult) -lemma bit_drop_0 [simp]: - "bit_drop 0 = id" - by (simp add: fun_eq_iff bit_drop_eq_div) +lemma drop_bit_0 [simp]: + "drop_bit 0 = id" + by (simp add: fun_eq_iff drop_bit_eq_div) -lemma bit_drop_of_0 [simp]: - "bit_drop n 0 = 0" - by (simp add: bit_drop_eq_div) +lemma drop_bit_of_0 [simp]: + "drop_bit n 0 = 0" + by (simp add: drop_bit_eq_div) -lemma bit_drop_Suc [simp]: - "bit_drop (Suc n) a = bit_drop n (a div 2)" +lemma drop_bit_Suc [simp]: + "drop_bit (Suc n) a = drop_bit n (a div 2)" proof (cases "even a") case True then obtain b where "a = 2 * b" .. - moreover have "bit_drop (Suc n) (2 * b) = bit_drop n b" - by (simp add: bit_drop_eq_div) + moreover have "drop_bit (Suc n) (2 * b) = drop_bit n b" + by (simp add: drop_bit_eq_div) ultimately show ?thesis by simp next case False then obtain b where "a = 2 * b + 1" .. - moreover have "bit_drop (Suc n) (2 * b + 1) = bit_drop n b" + moreover have "drop_bit (Suc n) (2 * b + 1) = drop_bit n b" using div_mult2_eq' [of "1 + b * 2" 2 "2 ^ n"] - by (auto simp add: bit_drop_eq_div ac_simps) + by (auto simp add: drop_bit_eq_div ac_simps) ultimately show ?thesis by simp qed -lemma bit_drop_half: - "bit_drop n (a div 2) = bit_drop n a div 2" +lemma drop_bit_half: + "drop_bit n (a div 2) = drop_bit n a div 2" by (induction n arbitrary: a) simp_all -lemma bit_drop_of_bool [simp]: - "bit_drop n (of_bool d) = of_bool (n = 0 \ d)" +lemma drop_bit_of_bool [simp]: + "drop_bit n (of_bool d) = of_bool (n = 0 \ d)" by (cases n) simp_all -lemma even_bit_take_eq [simp]: - "even (bit_take n a) \ n = 0 \ even a" - by (cases n) (simp_all add: bit_take_eq_mod dvd_mod_iff) +lemma even_take_bit_eq [simp]: + "even (take_bit n a) \ n = 0 \ even a" + by (cases n) (simp_all add: take_bit_eq_mod dvd_mod_iff) -lemma bit_push_0_id [simp]: - "bit_push 0 = id" - by (simp add: fun_eq_iff bit_push_eq_mult) +lemma push_bit_0_id [simp]: + "push_bit 0 = id" + by (simp add: fun_eq_iff push_bit_eq_mult) -lemma bit_push_of_0 [simp]: - "bit_push n 0 = 0" - by (simp add: bit_push_eq_mult) +lemma push_bit_of_0 [simp]: + "push_bit n 0 = 0" + by (simp add: push_bit_eq_mult) -lemma bit_push_of_1: - "bit_push n 1 = 2 ^ n" - by (simp add: bit_push_eq_mult) +lemma push_bit_of_1: + "push_bit n 1 = 2 ^ n" + by (simp add: push_bit_eq_mult) -lemma bit_push_Suc [simp]: - "bit_push (Suc n) a = bit_push n (a * 2)" - by (simp add: bit_push_eq_mult ac_simps) +lemma push_bit_Suc [simp]: + "push_bit (Suc n) a = push_bit n (a * 2)" + by (simp add: push_bit_eq_mult ac_simps) -lemma bit_push_double: - "bit_push n (a * 2) = bit_push n a * 2" - by (simp add: bit_push_eq_mult ac_simps) +lemma push_bit_double: + "push_bit n (a * 2) = push_bit n a * 2" + by (simp add: push_bit_eq_mult ac_simps) -lemma bit_drop_bit_take [simp]: - "bit_drop n (bit_take n a) = 0" - by (simp add: bit_drop_eq_div bit_take_eq_mod) +lemma drop_bit_take_bit [simp]: + "drop_bit n (take_bit n a) = 0" + by (simp add: drop_bit_eq_div take_bit_eq_mod) -lemma bit_take_bit_drop_commute: - "bit_drop m (bit_take n a) = bit_take (n - m) (bit_drop m a)" +lemma take_bit_drop_bit_commute: + "drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)" for m n :: nat proof (cases "n \ m") case True moreover define q where "q = n - m" ultimately have "n - m = q" and "n = m + q" by simp_all - moreover have "bit_drop m (bit_take (m + q) a) = bit_take q (bit_drop m a)" + moreover have "drop_bit m (take_bit (m + q) a) = take_bit q (drop_bit m a)" using mod_mult2_eq' [of a "2 ^ m" "2 ^ q"] - by (simp add: bit_drop_eq_div bit_take_eq_mod power_add) + by (simp add: drop_bit_eq_div take_bit_eq_mod power_add) ultimately show ?thesis by simp next @@ -812,9 +812,9 @@ moreover define q where "q = m - n" ultimately have "m - n = q" and "m = n + q" by simp_all - moreover have "bit_drop (n + q) (bit_take n a) = 0" + moreover have "drop_bit (n + q) (take_bit n a) = 0" using div_mult2_eq' [of "a mod 2 ^ n" "2 ^ n" "2 ^ q"] - by (simp add: bit_drop_eq_div bit_take_eq_mod power_add div_mult2_eq) + by (simp add: drop_bit_eq_div take_bit_eq_mod power_add div_mult2_eq) ultimately show ?thesis by simp qed diff -r 9cc32b18c785 -r 02a14c1cb917 src/HOL/Set_Interval.thy --- a/src/HOL/Set_Interval.thy Tue Mar 20 09:27:40 2018 +0000 +++ b/src/HOL/Set_Interval.thy Wed Mar 21 19:39:23 2018 +0100 @@ -1929,8 +1929,8 @@ lemma sum_diff_distrib: "\x. Q x \ P x \ (\xxxk = 0..k = 0..k = 0..k = Suc 0..k = 0..k = Suc 0..k = Suc 0..k = 0..k = Suc 0..k = 0.. 0" - by (simp add: bit_take_eq_mod) + shows "take_bit n k \ 0" + by (simp add: take_bit_eq_mod) -definition signed_bit_take :: "nat \ int \ int" - where signed_bit_take_eq_bit_take: - "signed_bit_take n k = bit_take (Suc n) (k + 2 ^ n) - 2 ^ n" +definition signed_take_bit :: "nat \ int \ int" + where signed_take_bit_eq_take_bit: + "signed_take_bit n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n" -lemma signed_bit_take_eq_bit_take': +lemma signed_take_bit_eq_take_bit': assumes "n > 0" - shows "signed_bit_take (n - Suc 0) k = bit_take n (k + 2 ^ (n - 1)) - 2 ^ (n - 1)" - using assms by (simp add: signed_bit_take_eq_bit_take) + shows "signed_take_bit (n - Suc 0) k = take_bit n (k + 2 ^ (n - 1)) - 2 ^ (n - 1)" + using assms by (simp add: signed_take_bit_eq_take_bit) -lemma signed_bit_take_0 [simp]: - "signed_bit_take 0 k = - (k mod 2)" +lemma signed_take_bit_0 [simp]: + "signed_take_bit 0 k = - (k mod 2)" proof (cases "even k") case True then have "odd (k + 1)" @@ -42,54 +42,54 @@ then have "(k + 1) mod 2 = 1" by (simp add: even_iff_mod_2_eq_zero) with True show ?thesis - by (simp add: signed_bit_take_eq_bit_take) + by (simp add: signed_take_bit_eq_take_bit) next case False then show ?thesis - by (simp add: signed_bit_take_eq_bit_take odd_iff_mod_2_eq_one) + by (simp add: signed_take_bit_eq_take_bit odd_iff_mod_2_eq_one) qed -lemma signed_bit_take_Suc [simp]: - "signed_bit_take (Suc n) k = signed_bit_take n (k div 2) * 2 + k mod 2" - by (simp add: odd_iff_mod_2_eq_one signed_bit_take_eq_bit_take algebra_simps) +lemma signed_take_bit_Suc [simp]: + "signed_take_bit (Suc n) k = signed_take_bit n (k div 2) * 2 + k mod 2" + by (simp add: odd_iff_mod_2_eq_one signed_take_bit_eq_take_bit algebra_simps) -lemma signed_bit_take_of_0 [simp]: - "signed_bit_take n 0 = 0" - by (simp add: signed_bit_take_eq_bit_take bit_take_eq_mod) +lemma signed_take_bit_of_0 [simp]: + "signed_take_bit n 0 = 0" + by (simp add: signed_take_bit_eq_take_bit take_bit_eq_mod) -lemma signed_bit_take_of_minus_1 [simp]: - "signed_bit_take n (- 1) = - 1" +lemma signed_take_bit_of_minus_1 [simp]: + "signed_take_bit n (- 1) = - 1" by (induct n) simp_all -lemma signed_bit_take_eq_iff_bit_take_eq: +lemma signed_take_bit_eq_iff_take_bit_eq: assumes "n > 0" - shows "signed_bit_take (n - Suc 0) k = signed_bit_take (n - Suc 0) l \ bit_take n k = bit_take n l" (is "?P \ ?Q") + shows "signed_take_bit (n - Suc 0) k = signed_take_bit (n - Suc 0) l \ take_bit n k = take_bit n l" (is "?P \ ?Q") proof - from assms obtain m where m: "n = Suc m" by (cases n) auto show ?thesis proof assume ?Q - have "bit_take (Suc m) (k + 2 ^ m) = - bit_take (Suc m) (bit_take (Suc m) k + bit_take (Suc m) (2 ^ m))" - by (simp only: bit_take_plus) + have "take_bit (Suc m) (k + 2 ^ m) = + take_bit (Suc m) (take_bit (Suc m) k + take_bit (Suc m) (2 ^ m))" + by (simp only: take_bit_plus) also have "\ = - bit_take (Suc m) (bit_take (Suc m) l + bit_take (Suc m) (2 ^ m))" + take_bit (Suc m) (take_bit (Suc m) l + take_bit (Suc m) (2 ^ m))" by (simp only: \?Q\ m [symmetric]) - also have "\ = bit_take (Suc m) (l + 2 ^ m)" - by (simp only: bit_take_plus) + also have "\ = take_bit (Suc m) (l + 2 ^ m)" + by (simp only: take_bit_plus) finally show ?P - by (simp only: signed_bit_take_eq_bit_take m) simp + by (simp only: signed_take_bit_eq_take_bit m) simp next assume ?P with assms have "(k + 2 ^ (n - Suc 0)) mod 2 ^ n = (l + 2 ^ (n - Suc 0)) mod 2 ^ n" - by (simp add: signed_bit_take_eq_bit_take' bit_take_eq_mod) + by (simp add: signed_take_bit_eq_take_bit' take_bit_eq_mod) then have "(i + (k + 2 ^ (n - Suc 0))) mod 2 ^ n = (i + (l + 2 ^ (n - Suc 0))) mod 2 ^ n" for i by (metis mod_add_eq) then have "k mod 2 ^ n = l mod 2 ^ n" by (metis add_diff_cancel_right' uminus_add_conv_diff) then show ?Q - by (simp add: bit_take_eq_mod) + by (simp add: take_bit_eq_mod) qed qed @@ -98,7 +98,7 @@ subsubsection \Basic properties\ -quotient_type (overloaded) 'a word = int / "\k l. bit_take LENGTH('a) k = bit_take LENGTH('a::len0) l" +quotient_type (overloaded) 'a word = int / "\k l. take_bit LENGTH('a) k = take_bit LENGTH('a::len0) l" by (auto intro!: equivpI reflpI sympI transpI) instantiation word :: (len0) "{semiring_numeral, comm_semiring_0, comm_ring}" @@ -114,19 +114,19 @@ lift_definition plus_word :: "'a word \ 'a word \ 'a word" is plus - by (subst bit_take_plus [symmetric]) (simp add: bit_take_plus) + by (subst take_bit_plus [symmetric]) (simp add: take_bit_plus) lift_definition uminus_word :: "'a word \ 'a word" is uminus - by (subst bit_take_uminus [symmetric]) (simp add: bit_take_uminus) + by (subst take_bit_uminus [symmetric]) (simp add: take_bit_uminus) lift_definition minus_word :: "'a word \ 'a word \ 'a word" is minus - by (subst bit_take_minus [symmetric]) (simp add: bit_take_minus) + by (subst take_bit_minus [symmetric]) (simp add: take_bit_minus) lift_definition times_word :: "'a word \ 'a word \ 'a word" is times - by (auto simp add: bit_take_eq_mod intro: mod_mult_cong) + by (auto simp add: take_bit_eq_mod intro: mod_mult_cong) instance by standard (transfer; simp add: algebra_simps)+ @@ -159,7 +159,7 @@ begin lift_definition unsigned :: "'b::len0 word \ 'a" - is "of_nat \ nat \ bit_take LENGTH('b)" + is "of_nat \ nat \ take_bit LENGTH('b)" by simp lemma unsigned_0 [simp]: @@ -181,8 +181,8 @@ begin lift_definition signed :: "'b::len word \ 'a" - is "of_int \ signed_bit_take (LENGTH('b) - 1)" - by (simp add: signed_bit_take_eq_iff_bit_take_eq [symmetric]) + is "of_int \ signed_take_bit (LENGTH('b) - 1)" + by (simp add: signed_take_bit_eq_iff_take_bit_eq [symmetric]) lemma signed_0 [simp]: "signed 0 = 0" @@ -191,8 +191,8 @@ end lemma unsigned_of_nat [simp]: - "unsigned (of_nat n :: 'a word) = bit_take LENGTH('a::len) n" - by transfer (simp add: nat_eq_iff bit_take_eq_mod zmod_int) + "unsigned (of_nat n :: 'a word) = take_bit LENGTH('a::len) n" + by transfer (simp add: nat_eq_iff take_bit_eq_mod zmod_int) lemma of_nat_unsigned [simp]: "of_nat (unsigned a) = a" @@ -207,17 +207,17 @@ lemma word_eq_iff_signed: "a = b \ signed a = signed b" - by safe (transfer; auto simp add: signed_bit_take_eq_iff_bit_take_eq) + by safe (transfer; auto simp add: signed_take_bit_eq_iff_take_bit_eq) end lemma signed_of_int [simp]: - "signed (of_int k :: 'a word) = signed_bit_take (LENGTH('a::len) - 1) k" + "signed (of_int k :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) k" by transfer simp lemma of_int_signed [simp]: "of_int (signed a) = a" - by transfer (simp add: signed_bit_take_eq_bit_take bit_take_eq_mod mod_simps) + by transfer (simp add: signed_take_bit_eq_take_bit take_bit_eq_mod mod_simps) subsubsection \Properties\ @@ -229,11 +229,11 @@ begin lift_definition divide_word :: "'a word \ 'a word \ 'a word" - is "\a b. bit_take LENGTH('a) a div bit_take LENGTH('a) b" + 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. bit_take LENGTH('a) a mod bit_take LENGTH('a) b" + is "\a b. take_bit LENGTH('a) a mod take_bit LENGTH('a) b" by simp instance .. @@ -247,11 +247,11 @@ begin lift_definition less_eq_word :: "'a word \ 'a word \ bool" - is "\a b. bit_take LENGTH('a) a \ bit_take LENGTH('a) b" + 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. bit_take LENGTH('a) a < bit_take LENGTH('a) b" + is "\a b. take_bit LENGTH('a) a < take_bit LENGTH('a) b" by simp instance @@ -268,7 +268,7 @@ lemma word_less_iff_unsigned: "a < b \ unsigned a < unsigned b" - by (transfer fixing: less) (auto dest: preorder_class.le_less_trans [OF bit_take_nonnegative]) + by (transfer fixing: less) (auto dest: preorder_class.le_less_trans [OF take_bit_nonnegative]) end