diff -r 1d8e914e04d6 -r 572ab9e64e18 src/HOL/ex/Bit_Lists.thy --- a/src/HOL/ex/Bit_Lists.thy Wed Feb 05 20:16:59 2020 +0000 +++ b/src/HOL/ex/Bit_Lists.thy Wed Feb 05 20:17:00 2020 +0000 @@ -5,9 +5,19 @@ theory Bit_Lists imports - Word + Word "HOL-Library.More_List" begin +lemma hd_zip: + \hd (zip xs ys) = (hd xs, hd ys)\ if \xs \ []\ and \ys \ []\ + using that by (cases xs; cases ys) simp_all + +lemma last_zip: + \last (zip xs ys) = (last xs, last ys)\ if \xs \ []\ and \ys \ []\ + and \length xs = length ys\ + using that by (cases xs rule: rev_cases; cases ys rule: rev_cases) simp_all + + subsection \Fragments of algebraic bit representations\ context comm_semiring_1 @@ -36,7 +46,7 @@ simp_all add: algebra_simps) lemma unsigned_of_bits_take [simp]: - "unsigned_of_bits (take n bs) = Parity.take_bit n (unsigned_of_bits bs)" + "unsigned_of_bits (take n bs) = take_bit n (unsigned_of_bits bs)" proof (induction bs arbitrary: n) case Nil then show ?case @@ -59,6 +69,18 @@ by (cases n) simp_all qed +lemma bit_unsigned_of_bits_iff: + \bit (unsigned_of_bits bs) n \ nth_default False bs n\ +proof (induction bs arbitrary: n) + case Nil + then show ?case + by simp +next + case (Cons b bs) + then show ?case + by (cases n) simp_all +qed + primrec n_bits_of :: "nat \ 'a \ bool list" where "n_bits_of 0 a = []" @@ -125,6 +147,10 @@ end +lemma bit_of_bits_nat_iff: + \bit (of_bits bs :: nat) n \ nth_default False bs n\ + by (simp add: bit_unsigned_of_bits_iff) + lemma bits_of_Suc_0 [simp]: "bits_of (Suc 0) = [True]" by simp @@ -211,6 +237,18 @@ by (simp_all add: *) qed +lemma bit_of_bits_int_iff: + \bit (of_bits bs :: int) n \ nth_default (bs \ [] \ last bs) bs n\ +proof (induction bs arbitrary: n) + case Nil + then show ?case + by simp +next + case (Cons b bs) + then show ?case + by (cases n; cases b; cases bs) simp_all +qed + lemma of_bits_append [simp]: "of_bits (bs @ cs) = of_bits bs + push_bit (length bs) (of_bits cs :: int)" if "bs \ []" "\ last bs" @@ -291,24 +329,14 @@ class ring_bit_representation = ring_bit_operations + semiring_bit_representation + assumes not_eq: "not = of_bits \ map Not \ bits_of" - context zip_nat begin lemma of_bits: "of_bits bs \<^bold>\ of_bits cs = (of_bits (map2 (\<^bold>*) bs cs) :: nat)" - if "length bs = length cs" for bs cs -using that proof (induction bs cs rule: list_induct2) - case Nil - then show ?case - by simp -next - case (Cons b bs c cs) - then show ?case - by (cases "of_bits bs = (0::nat) \ of_bits cs = (0::nat)") - (auto simp add: ac_simps end_of_bits rec [of "Suc 0"]) -qed - + if "length bs = length cs" for bs cs + by (simp add: Parity.bit_eq_iff bit_unsigned_of_bits_iff bit_eq_iff) + (simp add: that end_of_bits nth_default_map2 [of _ _ _ False False]) end instance nat :: semiring_bit_representation @@ -321,32 +349,22 @@ begin lemma of_bits: - "of_bits bs \<^bold>\ of_bits cs = (of_bits (map2 (\<^bold>*) bs cs) :: int)" - if "length bs = length cs" and "\ False \<^bold>* False" for bs cs -using \length bs = length cs\ proof (induction bs cs rule: list_induct2) - case Nil - then show ?case - using \\ False \<^bold>* False\ by (auto simp add: False_False_imp_True_True split: bool.splits) + \of_bits bs \<^bold>\ of_bits cs = (of_bits (map2 (\<^bold>*) bs cs) :: int)\ + if \length bs = length cs\ and \\ False \<^bold>* False\ for bs cs +proof (cases \bs = []\) + case True + moreover have \cs = []\ + using True that by simp + ultimately show ?thesis + by (simp add: Parity.bit_eq_iff bit_eq_iff that) next - case (Cons b bs c cs) - show ?case - proof (cases "bs = []") - case True - with Cons show ?thesis - using \\ False \<^bold>* False\ by (cases b; cases c) - (auto simp add: ac_simps split: bool.splits) - next - case False - with Cons.hyps have "cs \ []" - by auto - with \bs \ []\ have "map2 (\<^bold>*) bs cs \ []" - by (simp add: zip_eq_Nil_iff) - from \bs \ []\ \cs \ []\ \map2 (\<^bold>*) bs cs \ []\ Cons show ?thesis - by (cases b; cases c) - (auto simp add: \\ False \<^bold>* False\ ac_simps - rec [of "of_bits bs * 2"] rec [of "of_bits cs * 2"] - rec [of "1 + of_bits bs * 2"]) - qed + case False + moreover have \cs \ []\ + using False that by auto + ultimately show ?thesis + apply (simp add: Parity.bit_eq_iff bit_of_bits_int_iff bit_eq_iff zip_eq_Nil_iff last_map last_zip that) + apply (simp add: that nth_default_map2 [of _ _ _ \last bs\ \last cs\]) + done qed end