src/HOL/Word/Bits_Int.thy
changeset 72028 08f1e4cb735f
parent 72010 a851ce626b78
child 72042 587d4681240c
equal deleted inserted replaced
72027:759532ef0885 72028:08f1e4cb735f
   289   "sbintrunc (Suc n) (- numeral (Num.Bit0 w)) = 2 * sbintrunc n (- numeral w)"
   289   "sbintrunc (Suc n) (- numeral (Num.Bit0 w)) = 2 * sbintrunc n (- numeral w)"
   290   "sbintrunc (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * sbintrunc n (- numeral (w + Num.One))"
   290   "sbintrunc (Suc n) (- numeral (Num.Bit1 w)) = 1 + 2 * sbintrunc n (- numeral (w + Num.One))"
   291   by (simp_all add: signed_take_bit_Suc)
   291   by (simp_all add: signed_take_bit_Suc)
   292 
   292 
   293 lemma bin_sign_lem: "(bin_sign (sbintrunc n bin) = -1) = bit bin n"
   293 lemma bin_sign_lem: "(bin_sign (sbintrunc n bin) = -1) = bit bin n"
   294   using mask_nonnegative [of n] by (simp add: bin_sign_def not_le signed_take_bit_def)
   294   by (simp add: bin_sign_def)
   295 
   295 
   296 lemma nth_bintr: "bin_nth (bintrunc m w) n \<longleftrightarrow> n < m \<and> bin_nth w n"
   296 lemma nth_bintr: "bin_nth (bintrunc m w) n \<longleftrightarrow> n < m \<and> bin_nth w n"
   297   by (fact bit_take_bit_iff)
   297   by (fact bit_take_bit_iff)
   298 
   298 
   299 lemma nth_sbintr: "bin_nth (sbintrunc m w) n = (if n < m then bin_nth w n else bin_nth w m)"
   299 lemma nth_sbintr: "bin_nth (sbintrunc m w) n = (if n < m then bin_nth w n else bin_nth w m)"
   551 lemma [code]:
   551 lemma [code]:
   552   "bin_split (Suc n) w = (let (w1, w2) = bin_split n (w div 2) in (w1, of_bool (odd w) + 2 * w2))"
   552   "bin_split (Suc n) w = (let (w1, w2) = bin_split n (w div 2) in (w1, of_bool (odd w) + 2 * w2))"
   553   "bin_split 0 w = (w, 0)"
   553   "bin_split 0 w = (w, 0)"
   554   by (simp_all add: drop_bit_Suc take_bit_Suc mod_2_eq_odd)
   554   by (simp_all add: drop_bit_Suc take_bit_Suc mod_2_eq_odd)
   555 
   555 
   556 primrec bin_cat :: "int \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int"
   556 abbreviation (input) bin_cat :: \<open>int \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int\<close>
   557   where
   557   where \<open>bin_cat k n l \<equiv> concat_bit n l k\<close>
   558     Z: "bin_cat w 0 v = w"
       
   559   | Suc: "bin_cat w (Suc n) v = of_bool (odd v) + 2 * bin_cat w n (v div 2)"
       
   560 
   558 
   561 lemma bin_cat_eq_push_bit_add_take_bit:
   559 lemma bin_cat_eq_push_bit_add_take_bit:
   562   \<open>bin_cat k n l = push_bit n k + take_bit n l\<close>
   560   \<open>bin_cat k n l = push_bit n k + take_bit n l\<close>
   563   by (induction n arbitrary: k l)
   561   by (simp add: concat_bit_eq)
   564     (simp_all add: take_bit_Suc push_bit_double mod_2_eq_odd)
   562   
   565 
       
   566 lemma bin_sign_cat: "bin_sign (bin_cat x n y) = bin_sign x"
   563 lemma bin_sign_cat: "bin_sign (bin_cat x n y) = bin_sign x"
   567 proof -
   564 proof -
   568   have \<open>0 \<le> x\<close> if \<open>0 \<le> x * 2 ^ n + y mod 2 ^ n\<close>
   565   have \<open>0 \<le> x\<close> if \<open>0 \<le> x * 2 ^ n + y mod 2 ^ n\<close>
   569   proof -
   566   proof -
   570     have \<open>y mod 2 ^ n < 2 ^ n\<close>
   567     have \<open>y mod 2 ^ n < 2 ^ n\<close>
   586   then show ?thesis
   583   then show ?thesis
   587     by (simp add: bin_sign_def not_le not_less bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult take_bit_eq_mod)
   584     by (simp add: bin_sign_def not_le not_less bin_cat_eq_push_bit_add_take_bit push_bit_eq_mult take_bit_eq_mod)
   588 qed
   585 qed
   589 
   586 
   590 lemma bin_cat_assoc: "bin_cat (bin_cat x m y) n z = bin_cat x (m + n) (bin_cat y n z)"
   587 lemma bin_cat_assoc: "bin_cat (bin_cat x m y) n z = bin_cat x (m + n) (bin_cat y n z)"
   591   by (induct n arbitrary: z) auto
   588   by (fact concat_bit_assoc)
   592 
   589 
   593 lemma bin_cat_assoc_sym: "bin_cat x m (bin_cat y n z) = bin_cat (bin_cat x (m - n) y) (min m n) z"
   590 lemma bin_cat_assoc_sym: "bin_cat x m (bin_cat y n z) = bin_cat (bin_cat x (m - n) y) (min m n) z"
   594   apply (induct n arbitrary: z m)
   591   by (fact concat_bit_assoc_sym)
   595    apply clarsimp
       
   596   apply (case_tac m, auto)
       
   597   done
       
   598 
   592 
   599 definition bin_rcat :: "nat \<Rightarrow> int list \<Rightarrow> int"
   593 definition bin_rcat :: "nat \<Rightarrow> int list \<Rightarrow> int"
   600   where "bin_rcat n = foldl (\<lambda>u v. bin_cat u n v) 0"
   594   where "bin_rcat n = foldl (\<lambda>u v. bin_cat u n v) 0"
   601 
   595 
   602 fun bin_rsplit_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   596 fun bin_rsplit_aux :: "nat \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int list \<Rightarrow> int list"
   623 declare bin_rsplitl_aux.simps [simp del]
   617 declare bin_rsplitl_aux.simps [simp del]
   624 
   618 
   625 lemma bin_nth_cat:
   619 lemma bin_nth_cat:
   626   "bin_nth (bin_cat x k y) n =
   620   "bin_nth (bin_cat x k y) n =
   627     (if n < k then bin_nth y n else bin_nth x (n - k))"
   621     (if n < k then bin_nth y n else bin_nth x (n - k))"
   628   apply (induct k arbitrary: n y)
   622   by (simp add: bit_concat_bit_iff)
   629    apply simp
       
   630   apply (case_tac n)
       
   631    apply (simp_all add: bit_Suc)
       
   632   done
       
   633 
   623 
   634 lemma bin_nth_drop_bit_iff:
   624 lemma bin_nth_drop_bit_iff:
   635   \<open>bin_nth (drop_bit n c) k \<longleftrightarrow> bin_nth c (n + k)\<close>
   625   \<open>bin_nth (drop_bit n c) k \<longleftrightarrow> bin_nth c (n + k)\<close>
   636   by (simp add: bit_drop_bit_eq)
   626   by (simp add: bit_drop_bit_eq)
   637 
   627 
   651 lemma bintr_cat1: "bintrunc (k + n) (bin_cat a n b) = bin_cat (bintrunc k a) n b"
   641 lemma bintr_cat1: "bintrunc (k + n) (bin_cat a n b) = bin_cat (bintrunc k a) n b"
   652   by (metis bin_cat_assoc bin_cat_zero)
   642   by (metis bin_cat_assoc bin_cat_zero)
   653 
   643 
   654 lemma bintr_cat: "bintrunc m (bin_cat a n b) =
   644 lemma bintr_cat: "bintrunc m (bin_cat a n b) =
   655     bin_cat (bintrunc (m - n) a) n (bintrunc (min m n) b)"
   645     bin_cat (bintrunc (m - n) a) n (bintrunc (min m n) b)"
       
   646   
   656   by (rule bin_eqI) (auto simp: bin_nth_cat nth_bintr)
   647   by (rule bin_eqI) (auto simp: bin_nth_cat nth_bintr)
   657 
   648 
   658 lemma bintr_cat_same [simp]: "bintrunc n (bin_cat a n b) = bintrunc n b"
   649 lemma bintr_cat_same [simp]: "bintrunc n (bin_cat a n b) = bintrunc n b"
   659   by (auto simp add : bintr_cat)
   650   by (auto simp add : bintr_cat)
   660 
   651 
   667 lemma bin_cat_split: "bin_split n w = (u, v) \<Longrightarrow> w = bin_cat u n v"
   658 lemma bin_cat_split: "bin_split n w = (u, v) \<Longrightarrow> w = bin_cat u n v"
   668   by (auto simp add: bin_cat_eq_push_bit_add_take_bit bits_ident)
   659   by (auto simp add: bin_cat_eq_push_bit_add_take_bit bits_ident)
   669 
   660 
   670 lemma drop_bit_bin_cat_eq:
   661 lemma drop_bit_bin_cat_eq:
   671   \<open>drop_bit n (bin_cat v n w) = v\<close>
   662   \<open>drop_bit n (bin_cat v n w) = v\<close>
   672   by (induct n arbitrary: w)
   663   by (rule bit_eqI) (simp add: bit_drop_bit_eq bit_concat_bit_iff)
   673     (simp_all add: drop_bit_Suc)
       
   674 
   664 
   675 lemma take_bit_bin_cat_eq:
   665 lemma take_bit_bin_cat_eq:
   676   \<open>take_bit n (bin_cat v n w) = take_bit n w\<close>
   666   \<open>take_bit n (bin_cat v n w) = take_bit n w\<close>
   677   by (induct n arbitrary: w)
   667   by (rule bit_eqI) (simp add: bit_concat_bit_iff)
   678     (simp_all add: take_bit_Suc mod_2_eq_odd)
       
   679 
   668 
   680 lemma bin_split_cat: "bin_split n (bin_cat v n w) = (v, bintrunc n w)"
   669 lemma bin_split_cat: "bin_split n (bin_cat v n w) = (v, bintrunc n w)"
   681   by (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
   670   by (simp add: drop_bit_bin_cat_eq take_bit_bin_cat_eq)
   682 
   671 
   683 lemma bin_split_zero [simp]: "bin_split n 0 = (0, 0)"
   672 lemma bin_split_zero [simp]: "bin_split n 0 = (0, 0)"
  1911     bin_cat w (nv + length bs) (bl_to_bin_aux bs v)"
  1900     bin_cat w (nv + length bs) (bl_to_bin_aux bs v)"
  1912   by (rule bit_eqI)
  1901   by (rule bit_eqI)
  1913     (auto simp add: bin_nth_of_bl_aux bin_nth_cat algebra_simps)
  1902     (auto simp add: bin_nth_of_bl_aux bin_nth_cat algebra_simps)
  1914 
  1903 
  1915 lemma bin_to_bl_aux_cat:
  1904 lemma bin_to_bl_aux_cat:
  1916   "\<And>w bs. bin_to_bl_aux (nv + nw) (bin_cat v nw w) bs =
  1905   "bin_to_bl_aux (nv + nw) (bin_cat v nw w) bs =
  1917     bin_to_bl_aux nv v (bin_to_bl_aux nw w bs)"
  1906     bin_to_bl_aux nv v (bin_to_bl_aux nw w bs)"
  1918   by (induct nw) auto
  1907   by (induction nw arbitrary: w bs) (simp_all add: concat_bit_Suc)
  1919 
  1908 
  1920 lemma bl_to_bin_aux_alt: "bl_to_bin_aux bs w = bin_cat w (length bs) (bl_to_bin bs)"
  1909 lemma bl_to_bin_aux_alt: "bl_to_bin_aux bs w = bin_cat w (length bs) (bl_to_bin bs)"
  1921   using bl_to_bin_aux_cat [where nv = "0" and v = "0"]
  1910   using bl_to_bin_aux_cat [where nv = "0" and v = "0"]
  1922   by (simp add: bl_to_bin_def [symmetric])
  1911   by (simp add: bl_to_bin_def [symmetric])
  1923 
  1912