diff --git a/src/HOL/ex/Word_Conversions.thy b/src/HOL/ex/Word_Conversions.thy --- a/src/HOL/ex/Word_Conversions.thy +++ b/src/HOL/ex/Word_Conversions.thy @@ -1,204 +1,202 @@ (* Author: Florian Haftmann, TUM *) section \Proof of concept for conversions for algebraically founded bit word types\ theory Word_Conversions imports Main "HOL-Library.Type_Length" "HOL-Library.Bit_Operations" "HOL-Word.Word" begin context semiring_1 begin lift_definition unsigned :: \'b::len word \ 'a\ is \of_nat \ nat \ take_bit LENGTH('b)\ by simp lemma unsigned_0 [simp]: \unsigned 0 = 0\ by transfer simp lemma unsigned_1 [simp]: \unsigned 1 = 1\ by transfer simp end lemma unat_unsigned: \unat = unsigned\ by transfer simp lemma uint_unsigned: \uint = unsigned\ by transfer (simp add: fun_eq_iff) context semiring_char_0 begin lemma unsigned_word_eqI: \v = w\ if \unsigned v = unsigned w\ using that by transfer (simp add: eq_nat_nat_iff) lemma word_eq_iff_unsigned: \v = w \ unsigned v = unsigned w\ by (auto intro: unsigned_word_eqI) end context ring_1 begin lift_definition signed :: \'b::len word \ 'a\ is \of_int \ signed_take_bit (LENGTH('b) - 1)\ by (simp flip: signed_take_bit_decr_length_iff) lemma signed_0 [simp]: \signed 0 = 0\ by transfer simp lemma signed_1 [simp]: \signed (1 :: 'b::len word) = (if LENGTH('b) = 1 then - 1 else 1)\ by (transfer fixing: uminus) (simp_all add: signed_take_bit_eq not_le Suc_lessI) lemma signed_minus_1 [simp]: \signed (- 1 :: 'b::len word) = - 1\ by (transfer fixing: uminus) simp end lemma sint_signed: \sint = signed\ by transfer simp context ring_char_0 begin lemma signed_word_eqI: \v = w\ if \signed v = signed w\ using that by transfer (simp flip: signed_take_bit_decr_length_iff) lemma word_eq_iff_signed: \v = w \ signed v = signed w\ by (auto intro: signed_word_eqI) end abbreviation nat_of_word :: \'a::len word \ nat\ where \nat_of_word \ unsigned\ abbreviation unsigned_int :: \'a::len word \ int\ where \unsigned_int \ unsigned\ abbreviation signed_int :: \'a::len word \ int\ where \signed_int \ signed\ abbreviation word_of_nat :: \nat \ 'a::len word\ where \word_of_nat \ of_nat\ abbreviation word_of_int :: \int \ 'a::len word\ where \word_of_int \ of_int\ -text \TODO rework names from here\ - lemma unsigned_of_nat [simp]: - \unsigned (of_nat n :: 'a::len word) = take_bit LENGTH('a) n\ + \unsigned (of_nat n :: 'a::len word) = of_nat (take_bit LENGTH('a) n)\ by transfer (simp add: nat_eq_iff take_bit_of_nat) -lemma of_nat_unsigned [simp]: - \of_nat (unsigned w) = w\ +lemma of_nat_of_word [simp]: + \of_nat (nat_of_word w) = unsigned w\ by transfer simp lemma of_int_unsigned [simp]: - \of_int (unsigned w) = w\ + \of_int (unsigned_int w) = unsigned w\ by transfer simp lemma unsigned_int_greater_eq: - \(0::int) \ unsigned w\ for w :: \'a::len word\ + \0 \ unsigned_int w\ for w :: \'a::len word\ by transfer simp -lemma unsigned_nat_less: - \unsigned w < (2 ^ LENGTH('a) :: nat)\ for w :: \'a::len word\ +lemma nat_of_word_less: + \nat_of_word w < 2 ^ LENGTH('a)\ for w :: \'a::len word\ by transfer (simp add: take_bit_eq_mod) lemma unsigned_int_less: - \unsigned w < (2 ^ LENGTH('a) :: int)\ for w :: \'a::len word\ + \unsigned_int w < 2 ^ LENGTH('a)\ for w :: \'a::len word\ by transfer (simp add: take_bit_eq_mod) lemma signed_of_int [simp]: - \signed (of_int k :: 'a::len word) = signed_take_bit (LENGTH('a) - 1) k\ + \signed (word_of_int k :: 'a::len word) = of_int (signed_take_bit (LENGTH('a) - 1) k)\ by transfer simp lemma of_int_signed [simp]: - \of_int (signed a) = a\ + \of_int (signed_int a) = signed a\ by transfer (simp_all add: take_bit_signed_take_bit) lemma signed_int_greater_eq: - \- ((2::int) ^ (LENGTH('a) - 1)) \ signed w\ for w :: \'a::len word\ + \- (2 ^ (LENGTH('a) - 1)) \ signed_int w\ for w :: \'a::len word\ proof (cases \bit w (LENGTH('a) - 1)\) case True then show ?thesis by transfer (simp add: signed_take_bit_eq_or minus_exp_eq_not_mask or_greater_eq ac_simps) next have *: \- (2 ^ (LENGTH('a) - Suc 0)) \ (0::int)\ by simp case False then show ?thesis by transfer (auto simp add: signed_take_bit_eq intro: order_trans *) qed lemma signed_int_less: - \signed w < (2 ^ (LENGTH('a) - 1) :: int)\ for w :: \'a::len word\ + \signed_int w < 2 ^ (LENGTH('a) - 1)\ for w :: \'a::len word\ by (cases \bit w (LENGTH('a) - 1)\; transfer) (simp_all add: signed_take_bit_eq signed_take_bit_eq_or take_bit_int_less_exp not_eq_complement mask_eq_exp_minus_1 OR_upper) context linordered_semidom begin lemma word_less_eq_iff_unsigned: "a \ b \ unsigned a \ unsigned b" by (transfer fixing: less_eq) (simp add: nat_le_eq_zle) lemma word_less_iff_unsigned: "a < b \ unsigned a < unsigned b" by (transfer fixing: less) (auto dest: preorder_class.le_less_trans [OF take_bit_nonnegative]) end -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\ - by transfer (simp add: take_bit_of_nat) - -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\ - by transfer (simp add: take_bit_of_nat) - -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 word_of_nat_eq_iff: + \word_of_nat m = (word_of_nat n :: 'a::len word) \ take_bit LENGTH('a) m = take_bit LENGTH('a) n\ by transfer (simp add: take_bit_of_nat) -lemma of_nat_word_eq_0_iff: - \of_nat n = (0 :: 'a::len word) \ 2 ^ LENGTH('a) dvd n\ +lemma word_of_nat_less_eq_iff: + \word_of_nat m \ (word_of_nat n :: 'a::len word) \ take_bit LENGTH('a) m \ take_bit LENGTH('a) n\ + by transfer (simp add: take_bit_of_nat) + +lemma word_of_nat_less_iff: + \word_of_nat m < (word_of_nat n :: 'a::len word) \ take_bit LENGTH('a) m < take_bit LENGTH('a) n\ + by transfer (simp add: take_bit_of_nat) + +lemma word_of_nat_eq_0_iff: + \word_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\ +lemma word_of_int_eq_iff: + \word_of_int k = (word_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\ +lemma word_of_int_less_eq_iff: + \word_of_int k \ (word_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\ +lemma word_of_int_less_iff: + \word_of_int k < (word_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\ +lemma word_of_int_eq_0_iff: + \word_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) end