src/HOL/Word/Misc_msb.thy
author desharna
Thu, 08 Oct 2020 16:36:00 +0200
changeset 72399 f8900a5ad4a7
parent 72388 633d14bd1e59
permissions -rw-r--r--
drop obsolete ad hoc support for Satallax isar proof reconstruction
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
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72000
diff changeset
     7
  imports
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72000
diff changeset
     8
    Word
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72000
diff changeset
     9
    Reversed_Bit_Lists
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    10
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    11
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    12
class msb =
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    13
  fixes msb :: \<open>'a \<Rightarrow> bool\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    14
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    15
instantiation int :: msb
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    16
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    17
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    18
definition \<open>msb x \<longleftrightarrow> x < 0\<close> for x :: int
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    19
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    20
instance ..
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    21
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    22
end
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    23
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    24
lemma msb_conv_bin_sign: "msb x \<longleftrightarrow> bin_sign x = -1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    25
by(simp add: bin_sign_def not_le msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    26
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    27
lemma msb_bin_rest [simp]: "msb (bin_rest x) = msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    28
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    29
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    30
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
    31
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    32
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    33
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
    34
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    35
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    36
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
    37
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    38
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    39
lemma int_msb_not [simp]: "msb (NOT (x :: int)) \<longleftrightarrow> \<not> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    40
by(simp add: msb_int_def not_less)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    41
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    42
lemma msb_shiftl [simp]: "msb ((x :: int) << n) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    43
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    44
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    45
lemma msb_shiftr [simp]: "msb ((x :: int) >> r) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    46
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    47
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    48
lemma msb_bin_sc [simp]: "msb (bin_sc n b x) \<longleftrightarrow> msb x"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    49
by(simp add: msb_conv_bin_sign)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    50
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    51
lemma msb_0 [simp]: "msb (0 :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    52
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    53
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    54
lemma msb_1 [simp]: "msb (1 :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    55
by(simp add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    56
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    57
lemma msb_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    58
  "msb (numeral n :: int) = False"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    59
  "msb (- numeral n :: int) = True"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    60
by(simp_all add: msb_int_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    61
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    62
instantiation word :: (len) msb
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    63
begin
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    64
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    65
definition msb_word :: \<open>'a word \<Rightarrow> bool\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    66
  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
    67
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    68
lemma msb_word_eq:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    69
  \<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
    70
  by (simp add: msb_word_def bin_sign_lem bit_uint_iff)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    71
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    72
instance ..
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    73
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    74
end
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    75
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    76
lemma msb_word_iff_bit:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    77
  \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - Suc 0)\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    78
  for w :: \<open>'a::len word\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    79
  by (simp add: msb_word_def bin_sign_def bit_uint_iff)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    80
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    81
lemma word_msb_def:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    82
  "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    83
  by (simp add: msb_word_def sint_uint)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    84
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    85
lemma word_msb_sint: "msb w \<longleftrightarrow> sint w < 0"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    86
  by (simp add: msb_word_eq bit_last_iff)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    87
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    88
lemma msb_word_iff_sless_0:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    89
  \<open>msb w \<longleftrightarrow> w <s 0\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    90
  by (simp add: word_msb_sint word_sless_alt)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72088
diff changeset
    91
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    92
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
    93
  by (simp add: word_msb_def word_sbin.eq_norm bin_sign_lem)
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_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    96
  "msb (numeral w::'a::len word) = bin_nth (numeral w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
    97
  unfolding word_numeral_alt by (rule msb_word_of_int)
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_neg_numeral [simp]:
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   100
  "msb (- numeral w::'a::len word) = bin_nth (- numeral w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   101
  unfolding word_neg_numeral_alt by (rule msb_word_of_int)
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_0 [simp]: "\<not> msb (0::'a::len word)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   104
  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
   105
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   106
lemma word_msb_1 [simp]: "msb (1::'a::len word) \<longleftrightarrow> LENGTH('a) = 1"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   107
  unfolding word_1_wi msb_word_of_int eq_iff [where 'a=nat]
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   108
  by (simp add: Suc_le_eq)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   109
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   110
lemma word_msb_nth: "msb w = bin_nth (uint w) (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   111
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   112
  by (simp add: word_msb_def sint_uint bin_sign_lem)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   113
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   114
lemma word_msb_alt: "msb w \<longleftrightarrow> hd (to_bl w)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   115
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   116
  apply (simp add: msb_word_eq)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   117
  apply (subst hd_conv_nth)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   118
   apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   119
  apply (subst nth_to_bl)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   120
   apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   121
  apply simp
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   122
  done
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   123
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   124
lemma msb_nth: "msb w = w !! (LENGTH('a) - 1)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   125
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   126
  by (simp add: word_msb_nth word_test_bit_def)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   127
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   128
lemma word_msb_n1 [simp]: "msb (-1::'a::len word)"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   129
  by (simp add: msb_word_eq exp_eq_zero_iff not_le)
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   130
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   131
lemma msb_shift: "msb w \<longleftrightarrow> w >> (LENGTH('a) - 1) \<noteq> 0"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   132
  for w :: "'a::len word"
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   133
  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
   134
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   135
lemmas word_ops_msb = msb1 [unfolded msb_nth [symmetric, unfolded One_nat_def]]
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   136
379d0c207c29 separation of traditional bit operations
haftmann
parents:
diff changeset
   137
end