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 |