# HG changeset patch # User wenzelm # Date 1701727967 -3600 # Node ID e475d6ac8eb1c7d06b0c8bcbd964c4db1977d34f # Parent 486a32079c60061d47be85d7892cd60ed68f0eb6# Parent 89d4a8f52738eddf6a8c9fae0a499fd67aed982e merged diff -r 89d4a8f52738 -r e475d6ac8eb1 NEWS --- a/NEWS Mon Dec 04 23:07:06 2023 +0100 +++ b/NEWS Mon Dec 04 23:12:47 2023 +0100 @@ -29,6 +29,9 @@ unique_euclidean_semiring_with_bit_operations is renamed to linordered_euclidean_semiring_bit_operations. Minor INCOMPATIBILITY. +* Streamlined specification of type class (semi)ring_parity. Minor + INCOMPATIBILITY. + *** ML *** diff -r 89d4a8f52738 -r e475d6ac8eb1 src/HOL/Bit_Operations.thy --- a/src/HOL/Bit_Operations.thy Mon Dec 04 23:07:06 2023 +0100 +++ b/src/HOL/Bit_Operations.thy Mon Dec 04 23:12:47 2023 +0100 @@ -5,7 +5,7 @@ theory Bit_Operations imports Presburger Groups_List -begin +begin subsection \Abstract bit structures\ @@ -83,10 +83,6 @@ \0 mod a = 0\ using div_mult_mod_eq [of 0 a] by simp -lemma bits_one_mod_two_eq_one [simp]: - \1 mod 2 = 1\ - by (simp add: mod2_eq_if) - lemma bit_0: \bit a 0 \ odd a\ by (simp add: bit_iff_odd) @@ -3761,68 +3757,75 @@ subsection \Lemma duplicates and other\ -lemmas set_bit_def = set_bit_eq_or - -lemmas unset_bit_def = unset_bit_eq_and_not - -lemmas flip_bit_def = flip_bit_eq_xor - -lemma and_nat_rec: +context semiring_bit_operations +begin + +lemmas bits_one_mod_two_eq_one [no_atp] = one_mod_two_eq_one + +lemmas set_bit_def [no_atp] = set_bit_eq_or + +lemmas unset_bit_def [no_atp] = unset_bit_eq_and_not + +lemmas flip_bit_def [no_atp] = flip_bit_eq_xor + +end + +lemma and_nat_rec [no_atp]: \m AND n = of_bool (odd m \ odd n) + 2 * ((m div 2) AND (n div 2))\ for m n :: nat by (fact and_rec) -lemma or_nat_rec: +lemma or_nat_rec [no_atp]: \m OR n = of_bool (odd m \ odd n) + 2 * ((m div 2) OR (n div 2))\ for m n :: nat by (fact or_rec) -lemma xor_nat_rec: +lemma xor_nat_rec [no_atp]: \m XOR n = of_bool (odd m \ odd n) + 2 * ((m div 2) XOR (n div 2))\ for m n :: nat by (fact xor_rec) -lemma bit_push_bit_iff_nat: +lemma bit_push_bit_iff_nat [no_atp]: \bit (push_bit m q) n \ m \ n \ bit q (n - m)\ for q :: nat by (fact bit_push_bit_iff') -lemmas and_int_rec = and_int.rec - -lemmas bit_and_int_iff = and_int.bit_iff - -lemmas or_int_rec = or_int.rec - -lemmas bit_or_int_iff = or_int.bit_iff - -lemmas xor_int_rec = xor_int.rec - -lemmas bit_xor_int_iff = xor_int.bit_iff - -lemma not_int_rec: +lemma mask_half_int [no_atp]: + \mask n div 2 = (mask (n - 1) :: int)\ + by (fact mask_half) + +lemma not_int_rec [no_atp]: \NOT k = of_bool (even k) + 2 * NOT (k div 2)\ for k :: int by (fact not_rec) -lemma mask_half_int: - \mask n div 2 = (mask (n - 1) :: int)\ - by (fact mask_half) - -lemma drop_bit_push_bit_int: - \drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\ for k :: int - by (fact drop_bit_push_bit) - -lemma even_not_iff_int: +lemma even_not_iff_int [no_atp]: \even (NOT k) \ odd k\ for k :: int by (fact even_not_iff) -lemma even_and_iff_int: - \even (k AND l) \ even k \ even l\ for k l :: int - by (fact even_and_iff) - -lemma bit_push_bit_iff_int: - \bit (push_bit m k) n \ m \ n \ bit k (n - m)\ for k :: int - by (fact bit_push_bit_iff') - lemma bit_not_int_iff': \bit (- k - 1) n \ \ bit k n\ for k :: int by (simp flip: not_eq_complement add: bit_simps) +lemmas and_int_rec [no_atp] = and_int.rec + +lemma even_and_iff_int [no_atp]: + \even (k AND l) \ even k \ even l\ for k l :: int + by (fact even_and_iff) + +lemmas bit_and_int_iff [no_atp] = and_int.bit_iff + +lemmas or_int_rec [no_atp] = or_int.rec + +lemmas bit_or_int_iff [no_atp] = or_int.bit_iff + +lemmas xor_int_rec [no_atp] = xor_int.rec + +lemmas bit_xor_int_iff [no_atp] = xor_int.bit_iff + +lemma drop_bit_push_bit_int [no_atp]: + \drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\ for k :: int + by (fact drop_bit_push_bit) + +lemma bit_push_bit_iff_int [no_atp] : + \bit (push_bit m k) n \ m \ n \ bit k (n - m)\ for k :: int + by (fact bit_push_bit_iff') + no_notation not (\NOT\) and "and" (infixr \AND\ 64) diff -r 89d4a8f52738 -r e475d6ac8eb1 src/HOL/Library/Word.thy --- a/src/HOL/Library/Word.thy Mon Dec 04 23:07:06 2023 +0100 +++ b/src/HOL/Library/Word.thy Mon Dec 04 23:12:47 2023 +0100 @@ -668,16 +668,7 @@ end 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 + by (standard; transfer) (simp_all add: mod_2_eq_odd) lemma word_bit_induct [case_names zero even odd]: \P a\ if word_zero: \P 0\ diff -r 89d4a8f52738 -r e475d6ac8eb1 src/HOL/Parity.thy --- a/src/HOL/Parity.thy Mon Dec 04 23:07:06 2023 +0100 +++ b/src/HOL/Parity.thy Mon Dec 04 23:12:47 2023 +0100 @@ -12,16 +12,15 @@ subsection \Ring structures with parity and \even\/\odd\ predicates\ class semiring_parity = comm_semiring_1 + semiring_modulo + - assumes even_iff_mod_2_eq_zero: "2 dvd a \ a mod 2 = 0" - and odd_iff_mod_2_eq_one: "\ 2 dvd a \ a mod 2 = 1" - and odd_one [simp]: "\ 2 dvd 1" + assumes mod_2_eq_odd: \a mod 2 = of_bool (\ 2 dvd a)\ + and odd_one [simp]: \\ 2 dvd 1\ begin abbreviation even :: "'a \ bool" - where "even a \ 2 dvd a" + where \even a \ 2 dvd a\ abbreviation odd :: "'a \ bool" - where "odd a \ \ 2 dvd a" + where \odd a \ \ 2 dvd a\ end @@ -41,47 +40,44 @@ context semiring_parity begin -lemma parity_cases [case_names even odd]: - assumes "even a \ a mod 2 = 0 \ P" - assumes "odd a \ a mod 2 = 1 \ P" - shows P - using assms by (cases "even a") - (simp_all add: even_iff_mod_2_eq_zero [symmetric] odd_iff_mod_2_eq_one [symmetric]) +lemma evenE [elim?]: + assumes \even a\ + obtains b where \a = 2 * b\ + using assms by (rule dvdE) + +lemma oddE [elim?]: + assumes \odd a\ + obtains b where \a = 2 * b + 1\ +proof - + have \a = 2 * (a div 2) + a mod 2\ + by (simp add: mult_div_mod_eq) + with assms have \a = 2 * (a div 2) + 1\ + by (simp add: mod_2_eq_odd) + then show thesis .. +qed + +lemma of_bool_odd_eq_mod_2: + \of_bool (odd a) = a mod 2\ + by (simp add: mod_2_eq_odd) lemma odd_of_bool_self [simp]: \odd (of_bool p) \ p\ by (cases p) simp_all lemma not_mod_2_eq_0_eq_1 [simp]: - "a mod 2 \ 0 \ a mod 2 = 1" - by (cases a rule: parity_cases) simp_all + \a mod 2 \ 0 \ a mod 2 = 1\ + by (simp add: mod_2_eq_odd) lemma not_mod_2_eq_1_eq_0 [simp]: - "a mod 2 \ 1 \ a mod 2 = 0" - by (cases a rule: parity_cases) simp_all - -lemma evenE [elim?]: - assumes "even a" - obtains b where "a = 2 * b" - using assms by (rule dvdE) + \a mod 2 \ 1 \ a mod 2 = 0\ + by (simp add: mod_2_eq_odd) -lemma oddE [elim?]: - assumes "odd a" - obtains b where "a = 2 * b + 1" -proof - - have "a = 2 * (a div 2) + a mod 2" - by (simp add: mult_div_mod_eq) - with assms have "a = 2 * (a div 2) + 1" - by (simp add: odd_iff_mod_2_eq_one) - then show ?thesis .. -qed +lemma even_iff_mod_2_eq_zero: + \2 dvd a \ a mod 2 = 0\ + by (simp add: mod_2_eq_odd) -lemma mod_2_eq_odd: - "a mod 2 = of_bool (odd a)" - by (auto elim: oddE simp add: even_iff_mod_2_eq_zero) - -lemma of_bool_odd_eq_mod_2: - "of_bool (odd a) = a mod 2" +lemma odd_iff_mod_2_eq_one: + \\ 2 dvd a \ a mod 2 = 1\ by (simp add: mod_2_eq_odd) lemma even_mod_2_iff [simp]: @@ -92,8 +88,22 @@ "a mod 2 = (if even a then 0 else 1)" by (simp add: mod_2_eq_odd) +lemma zero_mod_two_eq_zero [simp]: + \0 mod 2 = 0\ + by (simp add: mod_2_eq_odd) + +lemma one_mod_two_eq_one [simp]: + \1 mod 2 = 1\ + by (simp add: mod_2_eq_odd) + +lemma parity_cases [case_names even odd]: + assumes \even a \ a mod 2 = 0 \ P\ + assumes \odd a \ a mod 2 = 1 \ P\ + shows P + using assms by (auto simp add: mod_2_eq_odd) + lemma even_zero [simp]: - "even 0" + \even 0\ by (fact dvd_0_right) lemma odd_even_add: @@ -622,15 +632,6 @@ by simp qed -lemma one_mod_two_eq_one [simp]: - "1 mod 2 = 1" -proof - - from of_nat_mod [symmetric] have "of_nat 1 mod of_nat 2 = of_nat 1" - by (simp only:) simp - then show ?thesis - by simp -qed - lemma one_mod_2_pow_eq [simp]: "1 mod (2 ^ n) = of_bool (n > 0)" proof - @@ -812,15 +813,13 @@ subclass semiring_parity proof - show "2 dvd a \ a mod 2 = 0" for a - by (fact dvd_eq_mod_eq_0) - show "\ 2 dvd a \ a mod 2 = 1" for a - proof - assume "a mod 2 = 1" - then show "\ 2 dvd a" - by auto + show \a mod 2 = of_bool (\ 2 dvd a)\ for a + proof (cases \2 dvd a\) + case True + then show ?thesis + by (simp add: dvd_eq_mod_eq_0) next - assume "\ 2 dvd a" + case False have eucl: "euclidean_size (a mod 2) = 1" proof (rule Orderings.order_antisym) show "euclidean_size (a mod 2) \ 1" @@ -841,15 +840,17 @@ then have "of_nat (euclidean_size a) mod 2 = 1" by (simp add: of_nat_mod) from \\ 2 dvd a\ eucl - show "a mod 2 = 1" + have "a mod 2 = 1" by (auto intro: division_segment_eq_iff simp add: division_segment_mod) + with \\ 2 dvd a\ show ?thesis + by simp qed - show "\ is_unit 2" - proof (rule notI) - assume "is_unit 2" - then have "of_nat 2 dvd of_nat 1" + show \\ is_unit 2\ + proof + assume \is_unit 2\ + then have \of_nat 2 dvd of_nat 1\ by simp - then have "is_unit (2::nat)" + then have \is_unit (2::nat)\ by (simp only: of_nat_dvd_iff) then show False by simp