# HG changeset patch # User haftmann # Date 1598276349 0 # Node ID 7ffa26f05c723631c1c8e9cb90e5b9e88a36c190 # Parent 957bf00eff2a817ed3ac776aae543a8954cdb1d4 a proof of concept for generic conversions diff -r 957bf00eff2a -r 7ffa26f05c72 src/HOL/ROOT --- a/src/HOL/ROOT Sat Aug 22 23:31:20 2020 +0200 +++ b/src/HOL/ROOT Mon Aug 24 13:39:09 2020 +0000 @@ -696,7 +696,6 @@ Triangular_Numbers Unification While_Combinator_Example - Word_Conversions veriT_Preprocessing theories [skip_proofs = false] SAT_Examples @@ -898,6 +897,7 @@ Word More_Word Word_Examples + Conversions document_files "root.bib" "root.tex" session "HOL-Statespace" in Statespace = HOL + diff -r 957bf00eff2a -r 7ffa26f05c72 src/HOL/Word/Conversions.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Word/Conversions.thy Mon Aug 24 13:39:09 2020 +0000 @@ -0,0 +1,325 @@ +(* Author: Florian Haftmann, TUM +*) + +section \Proof of concept for conversions for algebraically founded bit word types\ + +theory Conversions + imports + Main + "HOL-Library.Type_Length" + "HOL-Library.Bit_Operations" + "HOL-Word.Word" +begin + +hide_const (open) unat uint sint word_of_int ucast scast + +subsection \Conversions to words\ + +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\ + +lemma Word_eq_word_of_int [simp]: + \Word.Word = word_of_int\ + by (rule ext; transfer) simp + +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 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 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_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 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_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 word_of_nat_eq_0_iff [simp]: + \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 word_of_int_eq_0_iff [simp]: + \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) + +lemma int_AND_eq: + \int (m AND n) = int m AND int n\ + by (rule bit_eqI) (simp add: bit_and_iff) + +lemma int_OR_eq: + \int (m OR n) = int m OR int n\ + by (rule bit_eqI) (simp add: bit_or_iff) + +lemma int_XOR_eq: + \int (m XOR n) = int m XOR int n\ + by (rule bit_eqI) (simp add: bit_xor_iff) + +context semiring_bit_operations +begin + +lemma push_bit_and [simp]: + \push_bit n (a AND b) = push_bit n a AND push_bit n b\ + by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_and_iff) + +lemma push_bit_or [simp]: + \push_bit n (a OR b) = push_bit n a OR push_bit n b\ + by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_or_iff) + +lemma push_bit_xor [simp]: + \push_bit n (a XOR b) = push_bit n a XOR push_bit n b\ + by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_xor_iff) + +lemma drop_bit_and [simp]: + \drop_bit n (a AND b) = drop_bit n a AND drop_bit n b\ + by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_and_iff) + +lemma drop_bit_or [simp]: + \drop_bit n (a OR b) = drop_bit n a OR drop_bit n b\ + by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_or_iff) + +lemma drop_bit_xor [simp]: + \drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\ + by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_xor_iff) + +end + +lemma bit_word_of_nat_iff: + \bit (word_of_nat m :: 'a::len word) n \ n < LENGTH('a) \ bit m n\ + 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 simp + +lemma word_of_nat_AND_eq: + \word_of_nat (m AND n) = word_of_nat m AND word_of_nat n\ + by (rule bit_eqI) (auto simp add: bit_word_of_nat_iff bit_and_iff) + +lemma word_of_int_AND_eq: + \word_of_int (k AND l) = word_of_int k AND word_of_int l\ + by (rule bit_eqI) (auto simp add: bit_word_of_int_iff bit_and_iff) + +lemma word_of_nat_OR_eq: + \word_of_nat (m OR n) = word_of_nat m OR word_of_nat n\ + by (rule bit_eqI) (auto simp add: bit_word_of_nat_iff bit_or_iff) + +lemma word_of_int_OR_eq: + \word_of_int (k OR l) = word_of_int k OR word_of_int l\ + by (rule bit_eqI) (auto simp add: bit_word_of_int_iff bit_or_iff) + +lemma word_of_nat_XOR_eq: + \word_of_nat (m XOR n) = word_of_nat m XOR word_of_nat n\ + by (rule bit_eqI) (auto simp add: bit_word_of_nat_iff bit_xor_iff) + +lemma word_of_int_XOR_eq: + \word_of_int (k XOR l) = word_of_int k XOR word_of_int l\ + by (rule bit_eqI) (auto simp add: bit_word_of_int_iff bit_xor_iff) + + +subsection \Conversion from words\ + +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 + +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 + +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 unat :: \'a::len word \ nat\ + where \unat \ unsigned\ + +abbreviation uint :: \'a::len word \ int\ + where \uint \ unsigned\ + +abbreviation sint :: \'a::len word \ int\ + where \sint \ signed\ + +abbreviation ucast :: \'a::len word \ 'b::len word\ + where \ucast \ unsigned\ + +abbreviation scast :: \'a::len word \ 'b::len word\ + where \scast \ signed\ + +context + includes lifting_syntax +begin + +lemma [transfer_rule]: + \(pcr_word ===> (=)) (nat \ take_bit LENGTH('a)) (unat :: 'a::len word \ nat)\ + using unsigned.transfer [where ?'a = nat] by simp + +lemma [transfer_rule]: + \(pcr_word ===> (=)) (take_bit LENGTH('a)) (uint :: 'a::len word \ int)\ + using unsigned.transfer [where ?'a = int] by (simp add: comp_def) + +lemma [transfer_rule]: + \(pcr_word ===> (=)) (signed_take_bit (LENGTH('a) - Suc 0)) (sint :: 'a::len word \ int)\ + using signed.transfer [where ?'a = int] by simp + +lemma [transfer_rule]: + \(pcr_word ===> pcr_word) (take_bit LENGTH('a)) (ucast :: 'a::len word \ 'b::len word)\ +proof (rule rel_funI) + fix k :: int and w :: \'a word\ + assume \pcr_word k w\ + then have \w = word_of_int k\ + by (simp add: pcr_word_def cr_word_def relcompp_apply) + moreover have \pcr_word (take_bit LENGTH('a) k) (ucast (word_of_int k :: 'a word))\ + by transfer (simp add: pcr_word_def cr_word_def relcompp_apply) + ultimately show \pcr_word (take_bit LENGTH('a) k) (ucast w)\ + by simp +qed + +lemma [transfer_rule]: + \(pcr_word ===> pcr_word) (signed_take_bit (LENGTH('a) - 1)) (scast :: 'a::len word \ 'b::len word)\ +proof (rule rel_funI) + fix k :: int and w :: \'a word\ + assume \pcr_word k w\ + then have \w = word_of_int k\ + by (simp add: pcr_word_def cr_word_def relcompp_apply) + moreover have \pcr_word (signed_take_bit (LENGTH('a) - 1) k) (scast (word_of_int k :: 'a word))\ + by transfer (simp add: pcr_word_def cr_word_def relcompp_apply) + ultimately show \pcr_word (signed_take_bit (LENGTH('a) - 1) k) (scast w)\ + by simp +qed + +end + +lemma unsigned_of_nat [simp]: + \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_unat [simp]: + \of_nat (unat w) = unsigned w\ + by transfer simp + +lemma of_int_uint [simp]: + \of_int (uint w) = unsigned w\ + by transfer simp + +context unique_euclidean_semiring_numeral +begin + +lemma unsigned_greater_eq: + \0 \ unsigned w\ for w :: \'b::len word\ + by (transfer fixing: less_eq) simp + +lemma unsigned_less: + \unsigned w < 2 ^ LENGTH('b)\ for w :: \'b::len word\ + by (transfer fixing: less) (simp add: take_bit_int_less_exp) + +end + +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 signed_of_int [simp]: + \signed (word_of_int k :: 'a::len word) = of_int (signed_take_bit (LENGTH('a) - 1) k)\ + by transfer simp + +lemma of_int_sint [simp]: + \of_int (sint a) = signed a\ + by transfer (simp_all add: take_bit_signed_take_bit) + +lemma sint_greater_eq: + \- (2 ^ (LENGTH('a) - 1)) \ sint 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 sint_less: + \sint 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) + +end diff -r 957bf00eff2a -r 7ffa26f05c72 src/HOL/ex/Bit_Lists.thy --- a/src/HOL/ex/Bit_Lists.thy Sat Aug 22 23:31:20 2020 +0200 +++ b/src/HOL/ex/Bit_Lists.thy Mon Aug 24 13:39:09 2020 +0000 @@ -5,7 +5,7 @@ theory Bit_Lists imports - Word_Conversions "HOL-Library.More_List" + "HOL-Word.Conversions" "HOL-Library.More_List" begin subsection \Fragments of algebraic bit representations\ diff -r 957bf00eff2a -r 7ffa26f05c72 src/HOL/ex/Word_Conversions.thy --- a/src/HOL/ex/Word_Conversions.thy Sat Aug 22 23:31:20 2020 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,202 +0,0 @@ -(* 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\ - -lemma unsigned_of_nat [simp]: - \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_of_word [simp]: - \of_nat (nat_of_word w) = unsigned w\ - by transfer simp - -lemma of_int_unsigned [simp]: - \of_int (unsigned_int w) = unsigned w\ - by transfer simp - -lemma unsigned_int_greater_eq: - \0 \ unsigned_int w\ for w :: \'a::len word\ - by transfer simp - -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_int w < 2 ^ LENGTH('a)\ for w :: \'a::len word\ - by transfer (simp add: take_bit_eq_mod) - -lemma signed_of_int [simp]: - \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_int a) = signed a\ - by transfer (simp_all add: take_bit_signed_take_bit) - -lemma signed_int_greater_eq: - \- (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_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 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 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 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 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 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 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