src/HOL/Word/Misc_msb.thy
author haftmann
Mon, 06 Jul 2020 10:47:30 +0000
changeset 72000 379d0c207c29
child 72088 a36db1c8238e
permissions -rw-r--r--
separation of traditional bit operations
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     1
(*  Author:     Jeremy Dawson, NICTA
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     2
*)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     3
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     4
section \<open>Operation variant for the most significant bit\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     5
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     6
theory Misc_msb
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     7
  imports Word
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     8
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
     9
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    10
class msb =
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    11
  fixes msb :: \<open>'a \<Rightarrow> bool\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    12
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    13
instantiation int :: msb
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    14
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    15
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    16
definition \<open>msb x \<longleftrightarrow> x < 0\<close> for x :: int
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    17
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    18
instance ..
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    19
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    20
end
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    21
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    22
lemma msb_conv_bin_sign: "msb x \<longleftrightarrow> bin_sign x = -1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    23
by(simp add: bin_sign_def not_le msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    24
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    25
lemma msb_bin_rest [simp]: "msb (bin_rest x) = msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    26
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    27
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    28
lemma int_msb_and [simp]: "msb ((x :: int) AND y) \<longleftrightarrow> msb x \<and> msb y"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    29
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    30
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    31
lemma int_msb_or [simp]: "msb ((x :: int) OR y) \<longleftrightarrow> msb x \<or> msb y"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    32
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    33
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    34
lemma int_msb_xor [simp]: "msb ((x :: int) XOR y) \<longleftrightarrow> msb x \<noteq> msb y"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    35
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    36
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    37
lemma int_msb_not [simp]: "msb (NOT (x :: int)) \<longleftrightarrow> \<not> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    38
by(simp add: msb_int_def not_less)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    39
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    40
lemma msb_shiftl [simp]: "msb ((x :: int) << n) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    41
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    42
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    43
lemma msb_shiftr [simp]: "msb ((x :: int) >> r) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    44
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    45
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    46
lemma msb_bin_sc [simp]: "msb (bin_sc n b x) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    47
by(simp add: msb_conv_bin_sign)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    48
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    49
lemma msb_0 [simp]: "msb (0 :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    50
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    51
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    52
lemma msb_1 [simp]: "msb (1 :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    53
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    54
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    55
lemma msb_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    56
  "msb (numeral n :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    57
  "msb (- numeral n :: int) = True"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    58
by(simp_all add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    59
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    60
instantiation word :: (len) msb
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    61
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    62
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    63
definition msb_word :: \<open>'a word \<Rightarrow> bool\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    64
  where \<open>msb a \<longleftrightarrow> bin_sign (sbintrunc (LENGTH('a) - 1) (uint a)) = - 1\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    65
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    66
lemma msb_word_eq:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    67
  \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - 1)\<close> for w :: \<open>'a::len word\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    68
  by (simp add: msb_word_def bin_sign_lem bit_uint_iff)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    69
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    70
instance ..
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    71
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    72
end
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    73
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    74
lemma word_msb_def:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    75
  "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    76
  by (simp add: msb_word_def sint_uint)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    77
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    78
lemma word_msb_sint: "msb w \<longleftrightarrow> sint w < 0"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    79
  by (simp add: msb_word_eq bit_last_iff)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    80
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    81
lemma msb_word_of_int: "msb (word_of_int x::'a::len word) = bin_nth x (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    82
  by (simp add: word_msb_def word_sbin.eq_norm bin_sign_lem)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    83
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    84
lemma word_msb_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    85
  "msb (numeral w::'a::len word) = bin_nth (numeral w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    86
  unfolding word_numeral_alt by (rule msb_word_of_int)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    87
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    88
lemma word_msb_neg_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    89
  "msb (- numeral w::'a::len word) = bin_nth (- numeral w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    90
  unfolding word_neg_numeral_alt by (rule msb_word_of_int)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    91
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    92
lemma word_msb_0 [simp]: "\<not> msb (0::'a::len word)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    93
  by (simp add: word_msb_def bin_sign_def sint_uint sbintrunc_eq_take_bit)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    94
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    95
lemma word_msb_1 [simp]: "msb (1::'a::len word) \<longleftrightarrow> LENGTH('a) = 1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    96
  unfolding word_1_wi msb_word_of_int eq_iff [where 'a=nat]
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    97
  by (simp add: Suc_le_eq)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    98
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    99
lemma word_msb_nth: "msb w = bin_nth (uint w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   100
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   101
  by (simp add: word_msb_def sint_uint bin_sign_lem)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   102
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   103
lemma word_msb_alt: "msb w \<longleftrightarrow> hd (to_bl w)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   104
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   105
  apply (simp add: msb_word_eq)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   106
  apply (subst hd_conv_nth)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   107
   apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   108
  apply (subst nth_to_bl)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   109
   apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   110
  apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   111
  done
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   112
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   113
lemma msb_nth: "msb w = w !! (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   114
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   115
  by (simp add: word_msb_nth word_test_bit_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   116
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   117
lemma word_msb_n1 [simp]: "msb (-1::'a::len word)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   118
  by (simp add: msb_word_eq exp_eq_zero_iff not_le)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   119
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   120
lemma msb_shift: "msb w \<longleftrightarrow> w >> (LENGTH('a) - 1) \<noteq> 0"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   121
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   122
  by (simp add: msb_word_eq shiftr_word_eq bit_iff_odd_drop_bit drop_bit_eq_zero_iff_not_bit_last)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   123
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   124
lemmas word_ops_msb = msb1 [unfolded msb_nth [symmetric, unfolded One_nat_def]]
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   125
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   126
end