src/HOL/Word/Word.thy
changeset 71958 4320875eb8a1
parent 71957 3e162c63371a
child 71965 d45f5d4c41bd
equal deleted inserted replaced
71957:3e162c63371a 71958:4320875eb8a1
   383 context
   383 context
   384   includes lifting_syntax
   384   includes lifting_syntax
   385 begin
   385 begin
   386 
   386 
   387 lemma [transfer_rule]:
   387 lemma [transfer_rule]:
   388   "(pcr_word ===> (\<longleftrightarrow>)) even ((dvd) 2 :: 'a::len word \<Rightarrow> bool)"
   388   \<open>(pcr_word ===> (\<longleftrightarrow>)) even ((dvd) 2 :: 'a::len word \<Rightarrow> bool)\<close>
   389 proof -
   389 proof -
   390   have even_word_unfold: "even k \<longleftrightarrow> (\<exists>l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P \<longleftrightarrow> ?Q")
   390   have even_word_unfold: "even k \<longleftrightarrow> (\<exists>l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P \<longleftrightarrow> ?Q")
   391     for k :: int
   391     for k :: int
   392   proof
   392   proof
   393     assume ?P
   393     assume ?P
   446 qed
   446 qed
   447 
   447 
   448 lemma exp_eq_zero_iff:
   448 lemma exp_eq_zero_iff:
   449   \<open>2 ^ n = (0 :: 'a::len word) \<longleftrightarrow> n \<ge> LENGTH('a)\<close>
   449   \<open>2 ^ n = (0 :: 'a::len word) \<longleftrightarrow> n \<ge> LENGTH('a)\<close>
   450   by transfer simp
   450   by transfer simp
       
   451 
       
   452 lemma double_eq_zero_iff:
       
   453   \<open>2 * a = 0 \<longleftrightarrow> a = 0 \<or> a = 2 ^ (LENGTH('a) - Suc 0)\<close>
       
   454   for a :: \<open>'a::len word\<close>
       
   455 proof -
       
   456   define n where \<open>n = LENGTH('a) - Suc 0\<close>
       
   457   then have *: \<open>LENGTH('a) = Suc n\<close>
       
   458     by simp
       
   459   have \<open>a = 0\<close> if \<open>2 * a = 0\<close> and \<open>a \<noteq> 2 ^ (LENGTH('a) - Suc 0)\<close>
       
   460     using that by transfer
       
   461       (auto simp add: take_bit_eq_0_iff take_bit_eq_mod *)
       
   462   moreover have \<open>2 ^ LENGTH('a) = (0 :: 'a word)\<close>
       
   463     by transfer simp
       
   464   then have \<open>2 * 2 ^ (LENGTH('a) - Suc 0) = (0 :: 'a word)\<close>
       
   465     by (simp add: *)
       
   466   ultimately show ?thesis
       
   467     by auto
       
   468 qed
   451 
   469 
   452 
   470 
   453 subsection \<open>Ordering\<close>
   471 subsection \<open>Ordering\<close>
   454 
   472 
   455 instantiation word :: (len) linorder
   473 instantiation word :: (len) linorder
   777     by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit)
   795     by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit)
   778 qed
   796 qed
   779 
   797 
   780 end
   798 end
   781 
   799 
       
   800 lemma bit_word_eqI:
       
   801   \<open>a = b\<close> if \<open>\<And>n. n \<le> LENGTH('a) \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
       
   802     for a b :: \<open>'a::len word\<close>
       
   803   by (rule bit_eqI, rule that) (simp add: exp_eq_zero_iff)
       
   804 
   782 definition shiftl1 :: "'a::len word \<Rightarrow> 'a word"
   805 definition shiftl1 :: "'a::len word \<Rightarrow> 'a word"
   783   where "shiftl1 w = word_of_int (uint w BIT False)"
   806   where "shiftl1 w = word_of_int (uint w BIT False)"
   784 
   807 
   785 lemma shiftl1_eq_mult_2:
   808 lemma shiftl1_eq_mult_2:
   786   \<open>shiftl1 = (*) 2\<close>
   809   \<open>shiftl1 = (*) 2\<close>
  1450   by (auto simp: ucast_def of_bl_def uint_bl word_size)
  1473   by (auto simp: ucast_def of_bl_def uint_bl word_size)
  1451 
  1474 
  1452 lemma nth_ucast: "(ucast w::'a::len word) !! n = (w !! n \<and> n < LENGTH('a))"
  1475 lemma nth_ucast: "(ucast w::'a::len word) !! n = (w !! n \<and> n < LENGTH('a))"
  1453   by (simp add: ucast_def test_bit_bin word_ubin.eq_norm nth_bintr word_size)
  1476   by (simp add: ucast_def test_bit_bin word_ubin.eq_norm nth_bintr word_size)
  1454     (fast elim!: bin_nth_uint_imp)
  1477     (fast elim!: bin_nth_uint_imp)
       
  1478 
       
  1479 context
       
  1480   includes lifting_syntax
       
  1481 begin
       
  1482 
       
  1483 lemma transfer_rule_mask_word [transfer_rule]:
       
  1484   \<open>((=) ===> pcr_word) Bit_Operations.mask Bit_Operations.mask\<close>
       
  1485   by (simp only: mask_eq_exp_minus_1 [abs_def]) transfer_prover
       
  1486 
       
  1487 end
  1455 
  1488 
  1456 lemma ucast_mask_eq:
  1489 lemma ucast_mask_eq:
  1457   \<open>ucast (Bit_Operations.mask n :: 'b word) = Bit_Operations.mask (min LENGTH('b::len) n)\<close>
  1490   \<open>ucast (Bit_Operations.mask n :: 'b word) = Bit_Operations.mask (min LENGTH('b::len) n)\<close>
  1458   by (simp add: bit_eq_iff) (auto simp add: bit_mask_iff bit_ucast_iff exp_eq_zero_iff)
  1491   by (simp add: bit_eq_iff) (auto simp add: bit_mask_iff bit_ucast_iff exp_eq_zero_iff)
  1459 
  1492