src/HOL/Bit_Operations.thy
author wenzelm
Tue, 05 Nov 2024 23:01:09 +0100
changeset 81351 95cb584cb777
parent 81132 dff7dfd8dce3
child 81641 5af6a5e4343b
permissions -rw-r--r--
update to jdk-21.0.5; enforce rebuild of Isabelle/ML and Isabelle/Scala;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
     1
(*  Author:  Florian Haftmann, TUM
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
     2
*)
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
     3
71956
a4bffc0de967 bit operations as distinctive library theory
haftmann
parents: 71922
diff changeset
     4
section \<open>Bit operations in suitable algebraic structures\<close>
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
     5
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
     6
theory Bit_Operations
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
     7
  imports Presburger Groups_List
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
     8
begin
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
     9
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    10
subsection \<open>Abstract bit structures\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    11
79541
4f40225936d1 common type class for trivial properties on div/mod
haftmann
parents: 79531
diff changeset
    12
class semiring_bits = semiring_parity + semiring_modulo_trivial +
79480
c7cb1bf6efa0 consolidated name of lemma analogously to nat/int/word_bit_induct
haftmann
parents: 79117
diff changeset
    13
  assumes bit_induct [case_names stable rec]:
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    14
    \<open>(\<And>a. a div 2 = a \<Longrightarrow> P a)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    15
     \<Longrightarrow> (\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a))
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    16
        \<Longrightarrow> P a\<close>
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
    17
  assumes bits_mod_div_trivial [simp]: \<open>a mod b div b = 0\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
    18
    and half_div_exp_eq: \<open>a div 2 div 2 ^ n = a div 2 ^ Suc n\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    19
    and even_double_div_exp_iff: \<open>2 ^ Suc n \<noteq> 0 \<Longrightarrow> even (2 * a div 2 ^ Suc n) \<longleftrightarrow> even (a div 2 ^ n)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    20
  fixes bit :: \<open>'a \<Rightarrow> nat \<Rightarrow> bool\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    21
  assumes bit_iff_odd: \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    22
begin
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    23
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    24
text \<open>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    25
  Having \<^const>\<open>bit\<close> as definitional class operation
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    26
  takes into account that specific instances can be implemented
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    27
  differently wrt. code generation.
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    28
\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    29
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    30
lemma half_1 [simp]:
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    31
  \<open>1 div 2 = 0\<close>
79488
62d8c6c08fb2 consolidated lemma name
haftmann
parents: 79481
diff changeset
    32
  using even_half_succ_eq [of 0] by simp
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    33
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    34
lemma div_exp_eq_funpow_half:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    35
  \<open>a div 2 ^ n = ((\<lambda>a. a div 2) ^^ n) a\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    36
proof -
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    37
  have \<open>((\<lambda>a. a div 2) ^^ n) = (\<lambda>a. a div 2 ^ n)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    38
    by (induction n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    39
      (simp_all del: funpow.simps power.simps add: power_0 funpow_Suc_right half_div_exp_eq)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    40
  then show ?thesis
79481
8205977e9e2c simplified specification of type class
haftmann
parents: 79480
diff changeset
    41
    by simp
8205977e9e2c simplified specification of type class
haftmann
parents: 79480
diff changeset
    42
qed
8205977e9e2c simplified specification of type class
haftmann
parents: 79480
diff changeset
    43
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    44
lemma div_exp_eq:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    45
  \<open>a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    46
  by (simp add: div_exp_eq_funpow_half Groups.add.commute [of m] funpow_add)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
    47
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
    48
lemma bit_0:
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    49
  \<open>bit a 0 \<longleftrightarrow> odd a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    50
  by (simp add: bit_iff_odd)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    51
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    52
lemma bit_Suc:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    53
  \<open>bit a (Suc n) \<longleftrightarrow> bit (a div 2) n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    54
  using div_exp_eq [of a 1 n] by (simp add: bit_iff_odd)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    55
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    56
lemma bit_rec:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    57
  \<open>bit a n \<longleftrightarrow> (if n = 0 then odd a else bit (a div 2) (n - 1))\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
    58
  by (cases n) (simp_all add: bit_Suc bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    59
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    60
context
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    61
  fixes a
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    62
  assumes stable: \<open>a div 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    63
begin
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    64
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    65
lemma bits_stable_imp_add_self:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    66
  \<open>a + a mod 2 = 0\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    67
proof -
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    68
  have \<open>a div 2 * 2 + a mod 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    69
    by (fact div_mult_mod_eq)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    70
  then have \<open>a * 2 + a mod 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    71
    by (simp add: stable)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    72
  then show ?thesis
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    73
    by (simp add: mult_2_right ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    74
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    75
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    76
lemma stable_imp_bit_iff_odd:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    77
  \<open>bit a n \<longleftrightarrow> odd a\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
    78
  by (induction n) (simp_all add: stable bit_Suc bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    79
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    80
end
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    81
79585
dafb3d343cd6 more lemmas and more correct lemma names
haftmann
parents: 79555
diff changeset
    82
lemma bit_iff_odd_imp_stable:
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    83
  \<open>a div 2 = a\<close> if \<open>\<And>n. bit a n \<longleftrightarrow> odd a\<close>
79480
c7cb1bf6efa0 consolidated name of lemma analogously to nat/int/word_bit_induct
haftmann
parents: 79117
diff changeset
    84
using that proof (induction a rule: bit_induct)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    85
  case (stable a)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    86
  then show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    87
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    88
next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    89
  case (rec a b)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    90
  from rec.prems [of 1] have [simp]: \<open>b = odd a\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
    91
    by (simp add: rec.hyps bit_Suc bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    92
  from rec.hyps have hyp: \<open>(of_bool (odd a) + 2 * a) div 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    93
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    94
  have \<open>bit a n \<longleftrightarrow> odd a\<close> for n
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    95
    using rec.prems [of \<open>Suc n\<close>] by (simp add: hyp bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    96
  then have \<open>a div 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    97
    by (rule rec.IH)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    98
  then have \<open>of_bool (odd a) + 2 * a = 2 * (a div 2) + of_bool (odd a)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
    99
    by (simp add: ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   100
  also have \<open>\<dots> = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   101
    using mult_div_mod_eq [of 2 a]
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   102
    by (simp add: of_bool_odd_eq_mod_2)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   103
  finally show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   104
    using \<open>a div 2 = a\<close> by (simp add: hyp)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   105
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   106
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   107
lemma even_succ_div_exp [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   108
  \<open>(1 + a) div 2 ^ n = a div 2 ^ n\<close> if \<open>even a\<close> and \<open>n > 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   109
proof (cases n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   110
  case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   111
  with that show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   112
    by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   113
next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   114
  case (Suc n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   115
  with \<open>even a\<close> have \<open>(1 + a) div 2 ^ Suc n = a div 2 ^ Suc n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   116
  proof (induction n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   117
    case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   118
    then show ?case
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   119
      by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   120
  next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   121
    case (Suc n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   122
    then show ?case
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   123
      using div_exp_eq [of _ 1 \<open>Suc n\<close>, symmetric]
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   124
      by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   125
  qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   126
  with Suc show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   127
    by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   128
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   129
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   130
lemma even_succ_mod_exp [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   131
  \<open>(1 + a) mod 2 ^ n = 1 + (a mod 2 ^ n)\<close> if \<open>even a\<close> and \<open>n > 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   132
  using div_mult_mod_eq [of \<open>1 + a\<close> \<open>2 ^ n\<close>] div_mult_mod_eq [of a \<open>2 ^ n\<close>] that
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   133
  by simp (metis (full_types) add.left_commute add_left_imp_eq)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   134
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   135
named_theorems bit_simps \<open>Simplification rules for \<^const>\<open>bit\<close>\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   136
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   137
definition possible_bit :: \<open>'a itself \<Rightarrow> nat \<Rightarrow> bool\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   138
  where \<open>possible_bit TYPE('a) n \<longleftrightarrow> 2 ^ n \<noteq> 0\<close>
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
   139
  \<comment> \<open>This auxiliary avoids non-termination with extensionality.\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   140
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   141
lemma possible_bit_0 [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   142
  \<open>possible_bit TYPE('a) 0\<close>
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   143
  by (simp add: possible_bit_def)
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   144
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   145
lemma fold_possible_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   146
  \<open>2 ^ n = 0 \<longleftrightarrow> \<not> possible_bit TYPE('a) n\<close>
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   147
  by (simp add: possible_bit_def)
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   148
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   149
lemma bit_imp_possible_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   150
  \<open>possible_bit TYPE('a) n\<close> if \<open>bit a n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   151
  by (rule ccontr) (use that in \<open>auto simp: bit_iff_odd possible_bit_def\<close>)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   152
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   153
lemma impossible_bit:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   154
  \<open>\<not> bit a n\<close> if \<open>\<not> possible_bit TYPE('a) n\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   155
  using that by (blast dest: bit_imp_possible_bit)
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   156
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   157
lemma possible_bit_less_imp:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   158
  \<open>possible_bit TYPE('a) j\<close> if \<open>possible_bit TYPE('a) i\<close> \<open>j \<le> i\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   159
  using power_add [of 2 j \<open>i - j\<close>] that mult_not_zero [of \<open>2 ^ j\<close> \<open>2 ^ (i - j)\<close>]
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   160
  by (simp add: possible_bit_def)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   161
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   162
lemma possible_bit_min [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   163
  \<open>possible_bit TYPE('a) (min i j) \<longleftrightarrow> possible_bit TYPE('a) i \<or> possible_bit TYPE('a) j\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   164
  by (auto simp: min_def elim: possible_bit_less_imp)
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   165
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   166
lemma bit_eqI:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   167
  \<open>a = b\<close> if \<open>\<And>n. possible_bit TYPE('a) n \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   168
proof -
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   169
  have \<open>bit a n \<longleftrightarrow> bit b n\<close> for n
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   170
  proof (cases \<open>possible_bit TYPE('a) n\<close>)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   171
    case False
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   172
    then show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   173
      by (simp add: impossible_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   174
  next
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   175
    case True
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   176
    then show ?thesis
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   177
      by (rule that)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   178
  qed
79480
c7cb1bf6efa0 consolidated name of lemma analogously to nat/int/word_bit_induct
haftmann
parents: 79117
diff changeset
   179
  then show ?thesis proof (induction a arbitrary: b rule: bit_induct)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   180
    case (stable a)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   181
    from stable(2) [of 0] have **: \<open>even b \<longleftrightarrow> even a\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   182
      by (simp add: bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   183
    have \<open>b div 2 = b\<close>
79585
dafb3d343cd6 more lemmas and more correct lemma names
haftmann
parents: 79555
diff changeset
   184
    proof (rule bit_iff_odd_imp_stable)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   185
      fix n
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   186
      from stable have *: \<open>bit b n \<longleftrightarrow> bit a n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   187
        by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   188
      also have \<open>bit a n \<longleftrightarrow> odd a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   189
        using stable by (simp add: stable_imp_bit_iff_odd)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   190
      finally show \<open>bit b n \<longleftrightarrow> odd b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   191
        by (simp add: **)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   192
    qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   193
    from ** have \<open>a mod 2 = b mod 2\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   194
      by (simp add: mod2_eq_if)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   195
    then have \<open>a mod 2 + (a + b) = b mod 2 + (a + b)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   196
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   197
    then have \<open>a + a mod 2 + b = b + b mod 2 + a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   198
      by (simp add: ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   199
    with \<open>a div 2 = a\<close> \<open>b div 2 = b\<close> show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   200
      by (simp add: bits_stable_imp_add_self)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   201
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   202
    case (rec a p)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   203
    from rec.prems [of 0] have [simp]: \<open>p = odd b\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   204
      by (simp add: bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   205
    from rec.hyps have \<open>bit a n \<longleftrightarrow> bit (b div 2) n\<close> for n
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   206
      using rec.prems [of \<open>Suc n\<close>] by (simp add: bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   207
    then have \<open>a = b div 2\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   208
      by (rule rec.IH)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   209
    then have \<open>2 * a = 2 * (b div 2)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   210
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   211
    then have \<open>b mod 2 + 2 * a = b mod 2 + 2 * (b div 2)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   212
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   213
    also have \<open>\<dots> = b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   214
      by (fact mod_mult_div_eq)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   215
    finally show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   216
      by (auto simp: mod2_eq_if)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   217
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   218
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   219
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   220
lemma bit_eq_rec:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   221
  \<open>a = b \<longleftrightarrow> (even a \<longleftrightarrow> even b) \<and> a div 2 = b div 2\<close> (is \<open>?P = ?Q\<close>)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   222
proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   223
  assume ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   224
  then show ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   225
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   226
next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   227
  assume ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   228
  then have \<open>even a \<longleftrightarrow> even b\<close> and \<open>a div 2 = b div 2\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   229
    by simp_all
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   230
  show ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   231
  proof (rule bit_eqI)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   232
    fix n
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   233
    show \<open>bit a n \<longleftrightarrow> bit b n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   234
    proof (cases n)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   235
      case 0
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   236
      with \<open>even a \<longleftrightarrow> even b\<close> show ?thesis
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   237
        by (simp add: bit_0)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   238
    next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   239
      case (Suc n)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   240
      moreover from \<open>a div 2 = b div 2\<close> have \<open>bit (a div 2) n = bit (b div 2) n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   241
        by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   242
      ultimately show ?thesis
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   243
        by (simp add: bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   244
    qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   245
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   246
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   247
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   248
lemma bit_eq_iff:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   249
  \<open>a = b \<longleftrightarrow> (\<forall>n. possible_bit TYPE('a) n \<longrightarrow> bit a n \<longleftrightarrow> bit b n)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   250
  by (auto intro: bit_eqI simp add: possible_bit_def)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   251
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   252
lemma bit_0_eq [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   253
  \<open>bit 0 = \<bottom>\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   254
proof -
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   255
  have \<open>0 div 2 ^ n = 0\<close> for n
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   256
    unfolding div_exp_eq_funpow_half by (induction n) simp_all
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   257
  then show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   258
    by (simp add: fun_eq_iff bit_iff_odd)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   259
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   260
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   261
lemma bit_double_Suc_iff:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   262
  \<open>bit (2 * a) (Suc n) \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit a n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   263
  using even_double_div_exp_iff [of n a]
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   264
  by (cases \<open>possible_bit TYPE('a) (Suc n)\<close>)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   265
    (auto simp: bit_iff_odd possible_bit_def)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   266
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   267
lemma bit_double_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   268
  \<open>bit (2 * a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> 0 \<and> bit a (n - 1)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   269
  by (cases n) (simp_all add: bit_0 bit_double_Suc_iff)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   270
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   271
lemma even_bit_succ_iff:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   272
  \<open>bit (1 + a) n \<longleftrightarrow> bit a n \<or> n = 0\<close> if \<open>even a\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   273
  using that by (cases \<open>n = 0\<close>) (simp_all add: bit_iff_odd)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   274
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   275
lemma odd_bit_iff_bit_pred:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   276
  \<open>bit a n \<longleftrightarrow> bit (a - 1) n \<or> n = 0\<close> if \<open>odd a\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   277
proof -
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   278
  from \<open>odd a\<close> obtain b where \<open>a = 2 * b + 1\<close> ..
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   279
  moreover have \<open>bit (2 * b) n \<or> n = 0 \<longleftrightarrow> bit (1 + 2 * b) n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   280
    using even_bit_succ_iff by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   281
  ultimately show ?thesis by (simp add: ac_simps)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   282
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   283
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   284
lemma bit_exp_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   285
  \<open>bit (2 ^ m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n = m\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   286
proof (cases \<open>possible_bit TYPE('a) n\<close>)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   287
  case False
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   288
  then show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   289
    by (simp add: impossible_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   290
next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   291
  case True
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   292
  then show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   293
  proof (induction n arbitrary: m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   294
    case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   295
    show ?case
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   296
      by (simp add: bit_0)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   297
  next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   298
    case (Suc n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   299
    then have \<open>possible_bit TYPE('a) n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   300
      by (simp add: possible_bit_less_imp)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   301
    show ?case
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   302
    proof (cases m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   303
      case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   304
      then show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   305
        by (simp add: bit_Suc)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   306
    next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   307
      case (Suc m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   308
      with Suc.IH [of m] \<open>possible_bit TYPE('a) n\<close> show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   309
        by (simp add: bit_double_Suc_iff)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   310
    qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   311
  qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   312
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   313
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   314
lemma bit_1_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   315
  \<open>bit 1 n \<longleftrightarrow> n = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   316
  using bit_exp_iff [of 0 n] by auto
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   317
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   318
lemma bit_2_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   319
  \<open>bit 2 n \<longleftrightarrow> possible_bit TYPE('a) 1 \<and> n = 1\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   320
  using bit_exp_iff [of 1 n] by auto
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   321
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   322
lemma bit_of_bool_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   323
  \<open>bit (of_bool b) n \<longleftrightarrow> n = 0 \<and> b\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   324
  by (simp add: bit_1_iff)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   325
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   326
lemma bit_mod_2_iff [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   327
  \<open>bit (a mod 2) n \<longleftrightarrow> n = 0 \<and> odd a\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   328
  by (simp add: mod_2_eq_odd bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   329
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   330
end
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   331
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   332
lemma nat_bit_induct [case_names zero even odd]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   333
  \<open>P n\<close> if zero: \<open>P 0\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   334
    and even: \<open>\<And>n. P n \<Longrightarrow> n > 0 \<Longrightarrow> P (2 * n)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   335
    and odd: \<open>\<And>n. P n \<Longrightarrow> P (Suc (2 * n))\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   336
proof (induction n rule: less_induct)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   337
  case (less n)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   338
  show \<open>P n\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   339
  proof (cases \<open>n = 0\<close>)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   340
    case True with zero show ?thesis by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   341
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   342
    case False
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   343
    with less have hyp: \<open>P (n div 2)\<close> by simp
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   344
    show ?thesis
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   345
    proof (cases \<open>even n\<close>)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   346
      case True
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   347
      then have \<open>n \<noteq> 1\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   348
        by auto
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   349
      with \<open>n \<noteq> 0\<close> have \<open>n div 2 > 0\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   350
        by simp
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   351
      with \<open>even n\<close> hyp even [of \<open>n div 2\<close>] show ?thesis
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   352
        by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   353
    next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   354
      case False
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   355
      with hyp odd [of \<open>n div 2\<close>] show ?thesis
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   356
        by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   357
    qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   358
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   359
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   360
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   361
instantiation nat :: semiring_bits
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   362
begin
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   363
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   364
definition bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> bool\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   365
  where \<open>bit_nat m n \<longleftrightarrow> odd (m div 2 ^ n)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   366
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   367
instance
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   368
proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   369
  show \<open>P n\<close> if stable: \<open>\<And>n. n div 2 = n \<Longrightarrow> P n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   370
    and rec: \<open>\<And>n b. P n \<Longrightarrow> (of_bool b + 2 * n) div 2 = n \<Longrightarrow> P (of_bool b + 2 * n)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   371
    for P and n :: nat
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   372
  proof (induction n rule: nat_bit_induct)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   373
    case zero
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   374
    from stable [of 0] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   375
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   376
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   377
    case (even n)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   378
    with rec [of n False] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   379
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   380
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   381
    case (odd n)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   382
    with rec [of n True] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   383
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   384
  qed
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   385
qed (auto simp: div_mult2_eq bit_nat_def)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   386
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   387
end
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   388
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   389
lemma possible_bit_nat [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   390
  \<open>possible_bit TYPE(nat) n\<close>
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   391
  by (simp add: possible_bit_def)
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   392
79069
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
   393
lemma bit_Suc_0_iff [bit_simps]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
   394
  \<open>bit (Suc 0) n \<longleftrightarrow> n = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
   395
  using bit_1_iff [of n, where ?'a = nat] by simp
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
   396
74497
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   397
lemma not_bit_Suc_0_Suc [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   398
  \<open>\<not> bit (Suc 0) (Suc n)\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   399
  by (simp add: bit_Suc)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   400
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   401
lemma not_bit_Suc_0_numeral [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   402
  \<open>\<not> bit (Suc 0) (numeral n)\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   403
  by (simp add: numeral_eq_Suc)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
   404
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   405
context semiring_bits
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   406
begin
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   407
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   408
lemma bit_of_nat_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   409
  \<open>bit (of_nat m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit m n\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   410
proof (cases \<open>possible_bit TYPE('a) n\<close>)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   411
  case False
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   412
  then show ?thesis
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   413
    by (simp add: impossible_bit)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   414
next
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   415
  case True
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   416
  then have \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   417
  proof (induction m arbitrary: n rule: nat_bit_induct)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   418
    case zero
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   419
    then show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   420
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   421
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   422
    case (even m)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   423
    then show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   424
      by (cases n)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   425
        (auto simp: bit_double_iff Bit_Operations.bit_double_iff possible_bit_def bit_0 dest: mult_not_zero)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   426
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   427
    case (odd m)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   428
    then show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   429
      by (cases n)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   430
        (auto simp: bit_double_iff even_bit_succ_iff possible_bit_def
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   431
          Bit_Operations.bit_Suc Bit_Operations.bit_0 dest: mult_not_zero)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   432
  qed
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   433
  with True show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   434
    by simp
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   435
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   436
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   437
end
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   438
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   439
lemma int_bit_induct [case_names zero minus even odd]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   440
  \<open>P k\<close> if zero_int: \<open>P 0\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   441
    and minus_int: \<open>P (- 1)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   442
    and even_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> P (k * 2)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   443
    and odd_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> - 1 \<Longrightarrow> P (1 + (k * 2))\<close> for k :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   444
proof (cases \<open>k \<ge> 0\<close>)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   445
  case True
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   446
  define n where \<open>n = nat k\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   447
  with True have \<open>k = int n\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   448
    by simp
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   449
  then show \<open>P k\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   450
  proof (induction n arbitrary: k rule: nat_bit_induct)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   451
    case zero
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   452
    then show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   453
      by (simp add: zero_int)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   454
  next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   455
    case (even n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   456
    have \<open>P (int n * 2)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   457
      by (rule even_int) (use even in simp_all)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   458
    with even show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   459
      by (simp add: ac_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   460
  next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   461
    case (odd n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   462
    have \<open>P (1 + (int n * 2))\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   463
      by (rule odd_int) (use odd in simp_all)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   464
    with odd show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   465
      by (simp add: ac_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   466
  qed
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   467
next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   468
  case False
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   469
  define n where \<open>n = nat (- k - 1)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   470
  with False have \<open>k = - int n - 1\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   471
    by simp
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   472
  then show \<open>P k\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   473
  proof (induction n arbitrary: k rule: nat_bit_induct)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   474
    case zero
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   475
    then show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   476
      by (simp add: minus_int)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   477
  next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   478
    case (even n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   479
    have \<open>P (1 + (- int (Suc n) * 2))\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   480
      by (rule odd_int) (use even in \<open>simp_all add: algebra_simps\<close>)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   481
    also have \<open>\<dots> = - int (2 * n) - 1\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   482
      by (simp add: algebra_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   483
    finally show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   484
      using even.prems by simp
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   485
  next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   486
    case (odd n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   487
    have \<open>P (- int (Suc n) * 2)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   488
      by (rule even_int) (use odd in \<open>simp_all add: algebra_simps\<close>)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   489
    also have \<open>\<dots> = - int (Suc (2 * n)) - 1\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   490
      by (simp add: algebra_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   491
    finally show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   492
      using odd.prems by simp
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   493
  qed
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   494
qed
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   495
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   496
instantiation int :: semiring_bits
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   497
begin
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   498
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   499
definition bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   500
  where \<open>bit_int k n \<longleftrightarrow> odd (k div 2 ^ n)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   501
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   502
instance
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   503
proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   504
  show \<open>P k\<close> if stable: \<open>\<And>k. k div 2 = k \<Longrightarrow> P k\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   505
    and rec: \<open>\<And>k b. P k \<Longrightarrow> (of_bool b + 2 * k) div 2 = k \<Longrightarrow> P (of_bool b + 2 * k)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   506
    for P and k :: int
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   507
  proof (induction k rule: int_bit_induct)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   508
    case zero
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   509
    from stable [of 0] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   510
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   511
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   512
    case minus
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   513
    from stable [of \<open>- 1\<close>] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   514
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   515
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   516
    case (even k)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   517
    with rec [of k False] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   518
      by (simp add: ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   519
  next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   520
    case (odd k)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   521
    with rec [of k True] show ?case
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   522
      by (simp add: ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   523
  qed
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   524
qed (auto simp: zdiv_zmult2_eq bit_int_def)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   525
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   526
end
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   527
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   528
lemma possible_bit_int [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   529
  \<open>possible_bit TYPE(int) n\<close>
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   530
  by (simp add: possible_bit_def)
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
   531
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   532
lemma bit_nat_iff [bit_simps]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   533
  \<open>bit (nat k) n \<longleftrightarrow> k \<ge> 0 \<and> bit k n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   534
proof (cases \<open>k \<ge> 0\<close>)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   535
  case True
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   536
  moreover define m where \<open>m = nat k\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   537
  ultimately have \<open>k = int m\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   538
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   539
  then show ?thesis
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   540
    by (simp add: bit_simps)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   541
next
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   542
  case False
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   543
  then show ?thesis
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   544
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   545
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   546
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   547
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   548
subsection \<open>Bit operations\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   549
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   550
class semiring_bit_operations = semiring_bits +
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   551
  fixes "and" :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>AND\<close> 64)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   552
    and or :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>OR\<close> 59)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   553
    and xor :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>XOR\<close> 59)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   554
    and mask :: \<open>nat \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   555
    and set_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   556
    and unset_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   557
    and flip_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   558
    and push_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   559
    and drop_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   560
    and take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
79008
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   561
  assumes and_rec: \<open>a AND b = of_bool (odd a \<and> odd b) + 2 * ((a div 2) AND (b div 2))\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   562
    and or_rec: \<open>a OR b = of_bool (odd a \<or> odd b) + 2 * ((a div 2) OR (b div 2))\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   563
    and xor_rec: \<open>a XOR b = of_bool (odd a \<noteq> odd b) + 2 * ((a div 2) XOR (b div 2))\<close>
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   564
    and mask_eq_exp_minus_1: \<open>mask n = 2 ^ n - 1\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   565
    and set_bit_eq_or: \<open>set_bit n a = a OR push_bit n 1\<close>
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
   566
    and unset_bit_eq_or_xor: \<open>unset_bit n a = (a OR push_bit n 1) XOR push_bit n 1\<close>
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   567
    and flip_bit_eq_xor: \<open>flip_bit n a = a XOR push_bit n 1\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   568
    and push_bit_eq_mult: \<open>push_bit n a = a * 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   569
    and drop_bit_eq_div: \<open>drop_bit n a = a div 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   570
    and take_bit_eq_mod: \<open>take_bit n a = a mod 2 ^ n\<close>
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
   571
begin
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
   572
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   573
text \<open>
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   574
  We want the bitwise operations to bind slightly weaker
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   575
  than \<open>+\<close> and \<open>-\<close>.
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   576
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   577
  Logically, \<^const>\<open>push_bit\<close>,
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   578
  \<^const>\<open>drop_bit\<close> and \<^const>\<open>take_bit\<close> are just aliases; having them
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   579
  as separate operations makes proofs easier, otherwise proof automation
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   580
  would fiddle with concrete expressions \<^term>\<open>2 ^ n\<close> in a way obfuscating the basic
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   581
  algebraic relationships between those operations.
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   582
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
   583
  For the sake of code generation operations
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   584
  are specified as definitional class operations,
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   585
  taking into account that specific instances of these can be implemented
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   586
  differently wrt. code generation.
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   587
\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   588
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   589
lemma bit_iff_odd_drop_bit:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   590
  \<open>bit a n \<longleftrightarrow> odd (drop_bit n a)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   591
  by (simp add: bit_iff_odd drop_bit_eq_div)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   592
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   593
lemma even_drop_bit_iff_not_bit:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   594
  \<open>even (drop_bit n a) \<longleftrightarrow> \<not> bit a n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   595
  by (simp add: bit_iff_odd_drop_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   596
79008
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   597
lemma bit_and_iff [bit_simps]:
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   598
  \<open>bit (a AND b) n \<longleftrightarrow> bit a n \<and> bit b n\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   599
proof (induction n arbitrary: a b)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   600
  case 0
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   601
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   602
    by (simp add: bit_0 and_rec [of a b] even_bit_succ_iff)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   603
next
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   604
  case (Suc n)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   605
  from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   606
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   607
    by (simp add: and_rec [of a b] bit_Suc)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   608
      (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   609
qed
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   610
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   611
lemma bit_or_iff [bit_simps]:
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   612
  \<open>bit (a OR b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   613
proof (induction n arbitrary: a b)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   614
  case 0
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   615
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   616
    by (simp add: bit_0 or_rec [of a b] even_bit_succ_iff)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   617
next
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   618
  case (Suc n)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   619
  from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   620
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   621
    by (simp add: or_rec [of a b] bit_Suc)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   622
      (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   623
qed
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   624
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   625
lemma bit_xor_iff [bit_simps]:
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   626
  \<open>bit (a XOR b) n \<longleftrightarrow> bit a n \<noteq> bit b n\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   627
proof (induction n arbitrary: a b)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   628
  case 0
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   629
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   630
    by (simp add: bit_0 xor_rec [of a b] even_bit_succ_iff)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   631
next
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   632
  case (Suc n)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   633
  from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   634
  show ?case
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   635
    by (simp add: xor_rec [of a b] bit_Suc)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   636
      (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   637
qed
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
   638
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   639
sublocale "and": semilattice \<open>(AND)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   640
  by standard (auto simp: bit_eq_iff bit_and_iff)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   641
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   642
sublocale or: semilattice_neutr \<open>(OR)\<close> 0
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   643
  by standard (auto simp: bit_eq_iff bit_or_iff)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   644
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   645
sublocale xor: comm_monoid \<open>(XOR)\<close> 0
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   646
  by standard (auto simp: bit_eq_iff bit_xor_iff)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   647
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   648
lemma even_and_iff:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   649
  \<open>even (a AND b) \<longleftrightarrow> even a \<or> even b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   650
  using bit_and_iff [of a b 0] by (auto simp: bit_0)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   651
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   652
lemma even_or_iff:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   653
  \<open>even (a OR b) \<longleftrightarrow> even a \<and> even b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   654
  using bit_or_iff [of a b 0] by (auto simp: bit_0)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   655
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   656
lemma even_xor_iff:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   657
  \<open>even (a XOR b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   658
  using bit_xor_iff [of a b 0] by (auto simp: bit_0)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   659
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   660
lemma zero_and_eq [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   661
  \<open>0 AND a = 0\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   662
  by (simp add: bit_eq_iff bit_and_iff)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   663
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   664
lemma and_zero_eq [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   665
  \<open>a AND 0 = 0\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   666
  by (simp add: bit_eq_iff bit_and_iff)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   667
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   668
lemma one_and_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   669
  \<open>1 AND a = a mod 2\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   670
  by (simp add: bit_eq_iff bit_and_iff) (auto simp: bit_1_iff bit_0)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   671
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   672
lemma and_one_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   673
  \<open>a AND 1 = a mod 2\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   674
  using one_and_eq [of a] by (simp add: ac_simps)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   675
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   676
lemma one_or_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   677
  \<open>1 OR a = a + of_bool (even a)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   678
  by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   679
    (auto simp: bit_1_iff bit_0)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   680
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   681
lemma or_one_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   682
  \<open>a OR 1 = a + of_bool (even a)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   683
  using one_or_eq [of a] by (simp add: ac_simps)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   684
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   685
lemma one_xor_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   686
  \<open>1 XOR a = a + of_bool (even a) - of_bool (odd a)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
   687
  by (simp add: bit_eq_iff bit_xor_iff add.commute [of _ 1] even_bit_succ_iff)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   688
    (auto simp: bit_1_iff odd_bit_iff_bit_pred bit_0 elim: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   689
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   690
lemma xor_one_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   691
  \<open>a XOR 1 = a + of_bool (even a) - of_bool (odd a)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   692
  using one_xor_eq [of a] by (simp add: ac_simps)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   693
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
   694
lemma xor_self_eq [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
   695
  \<open>a XOR a = 0\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
   696
  by (rule bit_eqI) (simp add: bit_simps)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
   697
79588
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   698
lemma mask_0 [simp]:
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   699
  \<open>mask 0 = 0\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   700
  by (simp add: mask_eq_exp_minus_1)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   701
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   702
lemma inc_mask_eq_exp:
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   703
  \<open>mask n + 1 = 2 ^ n\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   704
proof (induction n)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   705
  case 0
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   706
  then show ?case
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   707
    by simp
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   708
next
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   709
  case (Suc n)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   710
  from Suc.IH [symmetric] have \<open>2 ^ Suc n = 2 * mask n + 2\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   711
    by (simp add: algebra_simps)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   712
  also have \<open>\<dots> = 2 * mask n + 1 + 1\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   713
    by (simp add: add.assoc)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   714
  finally have *: \<open>2 ^ Suc n = 2 * mask n + 1 + 1\<close> .
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   715
  then show ?case
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   716
    by (simp add: mask_eq_exp_minus_1)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   717
qed
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   718
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   719
lemma mask_Suc_double:
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   720
  \<open>mask (Suc n) = 1 OR 2 * mask n\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   721
proof -
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   722
  have \<open>mask (Suc n) + 1 = (mask n + 1) + (mask n + 1)\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   723
    by (simp add: inc_mask_eq_exp mult_2)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   724
  also have \<open>\<dots> = (1 OR 2 * mask n) + 1\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   725
    by (simp add: one_or_eq mult_2_right algebra_simps)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   726
  finally show ?thesis
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   727
    by simp
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   728
qed
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   729
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   730
lemma bit_mask_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   731
  \<open>bit (mask m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n < m\<close>
79588
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   732
proof (cases \<open>possible_bit TYPE('a) n\<close>)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   733
  case False
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   734
  then show ?thesis
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   735
    by (simp add: impossible_bit)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   736
next
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   737
  case True
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   738
  then have \<open>bit (mask m) n \<longleftrightarrow> n < m\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   739
  proof (induction m arbitrary: n)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   740
    case 0
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   741
    then show ?case
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   742
      by (simp add: bit_iff_odd)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   743
  next
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   744
    case (Suc m)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   745
    show ?case
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   746
    proof (cases n)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   747
      case 0
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   748
      then show ?thesis
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   749
        by (simp add: bit_0 mask_Suc_double even_or_iff)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   750
    next
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   751
      case (Suc n)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   752
      with Suc.prems have \<open>possible_bit TYPE('a) n\<close>
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   753
        using possible_bit_less_imp by auto
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   754
      with Suc.IH [of n] have \<open>bit (mask m) n \<longleftrightarrow> n < m\<close> .
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   755
      with Suc.prems show ?thesis
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   756
        by (simp add: Suc mask_Suc_double bit_simps)
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   757
    qed
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   758
  qed
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   759
  with True show ?thesis
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   760
    by simp
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   761
qed
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   762
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   763
lemma even_mask_iff:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   764
  \<open>even (mask n) \<longleftrightarrow> n = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   765
  using bit_mask_iff [of n 0] by (auto simp: bit_0)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   766
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   767
lemma mask_Suc_0 [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   768
  \<open>mask (Suc 0) = 1\<close>
79588
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
   769
  by (simp add: mask_Suc_double)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   770
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   771
lemma mask_Suc_exp:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   772
  \<open>mask (Suc n) = 2 ^ n OR mask n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   773
  by (auto simp: bit_eq_iff bit_simps)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   774
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   775
lemma mask_numeral:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   776
  \<open>mask (numeral n) = 1 + 2 * mask (pred_numeral n)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   777
  by (simp add: numeral_eq_Suc mask_Suc_double one_or_eq ac_simps)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   778
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   779
lemma push_bit_0_id [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   780
  \<open>push_bit 0 = id\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   781
  by (simp add: fun_eq_iff push_bit_eq_mult)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   782
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   783
lemma push_bit_Suc [simp]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   784
  \<open>push_bit (Suc n) a = push_bit n (a * 2)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   785
  by (simp add: push_bit_eq_mult ac_simps)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   786
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   787
lemma push_bit_double:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   788
  \<open>push_bit n (a * 2) = push_bit n a * 2\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   789
  by (simp add: push_bit_eq_mult ac_simps)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   790
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   791
lemma bit_push_bit_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   792
  \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> possible_bit TYPE('a) n \<and> bit a (n - m)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   793
proof (induction n arbitrary: m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   794
  case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   795
  then show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   796
    by (auto simp: bit_0 push_bit_eq_mult)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   797
next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   798
  case (Suc n)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   799
  show ?case
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   800
  proof (cases m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   801
    case 0
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   802
    then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   803
      by (auto simp: bit_imp_possible_bit)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   804
  next
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   805
    case (Suc m')
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   806
    with Suc.prems Suc.IH [of m'] show ?thesis
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   807
      apply (simp add: push_bit_double)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   808
      apply (auto simp: possible_bit_less_imp bit_simps mult.commute [of _ 2])
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   809
      done
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   810
  qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   811
qed
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   812
79590
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
   813
lemma funpow_double_eq_push_bit:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
   814
  \<open>times 2 ^^ n = push_bit n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
   815
  by (induction n) (simp_all add: fun_eq_iff push_bit_double ac_simps)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
   816
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   817
lemma div_push_bit_of_1_eq_drop_bit:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   818
  \<open>a div push_bit n 1 = drop_bit n a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   819
  by (simp add: push_bit_eq_mult drop_bit_eq_div)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   820
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   821
lemma bits_ident:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   822
  \<open>push_bit n (drop_bit n a) + take_bit n a = a\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   823
  using div_mult_mod_eq by (simp add: push_bit_eq_mult take_bit_eq_mod drop_bit_eq_div)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   824
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   825
lemma push_bit_push_bit [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   826
  \<open>push_bit m (push_bit n a) = push_bit (m + n) a\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   827
  by (simp add: push_bit_eq_mult power_add ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   828
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   829
lemma push_bit_of_0 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   830
  \<open>push_bit n 0 = 0\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   831
  by (simp add: push_bit_eq_mult)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   832
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
   833
lemma push_bit_of_1 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   834
  \<open>push_bit n 1 = 2 ^ n\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   835
  by (simp add: push_bit_eq_mult)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   836
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   837
lemma push_bit_add:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   838
  \<open>push_bit n (a + b) = push_bit n a + push_bit n b\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   839
  by (simp add: push_bit_eq_mult algebra_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   840
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   841
lemma push_bit_numeral [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   842
  \<open>push_bit (numeral l) (numeral k) = push_bit (pred_numeral l) (numeral (Num.Bit0 k))\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   843
  by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   844
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   845
lemma bit_drop_bit_eq [bit_simps]:
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   846
  \<open>bit (drop_bit n a) = bit a \<circ> (+) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   847
  by rule (simp add: drop_bit_eq_div bit_iff_odd div_exp_eq)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   848
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   849
lemma disjunctive_xor_eq_or:
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   850
  \<open>a XOR b = a OR b\<close> if \<open>a AND b = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   851
  using that by (auto simp: bit_eq_iff bit_simps)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   852
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   853
lemma disjunctive_add_eq_or:
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   854
  \<open>a + b = a OR b\<close> if \<open>a AND b = 0\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   855
proof (rule bit_eqI)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   856
  fix n
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   857
  assume \<open>possible_bit TYPE('a) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   858
  moreover from that have \<open>\<And>n. \<not> bit (a AND b) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   859
    by simp
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   860
  then have \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   861
    by (simp add: bit_simps)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   862
  ultimately show \<open>bit (a + b) n \<longleftrightarrow> bit (a OR b) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   863
  proof (induction n arbitrary: a b)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   864
    case 0
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   865
    from "0"(2)[of 0] show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   866
      by (auto simp: even_or_iff bit_0)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   867
  next
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   868
    case (Suc n)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   869
    from Suc.prems(2) [of 0] have even: \<open>even a \<or> even b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   870
      by (auto simp: bit_0)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   871
    have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   872
      using Suc.prems(2) [of \<open>Suc n\<close>] by (simp add: bit_Suc)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   873
    from Suc.prems have \<open>possible_bit TYPE('a) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   874
      using possible_bit_less_imp by force
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   875
    with \<open>\<And>n. \<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> Suc.IH [of \<open>a div 2\<close> \<open>b div 2\<close>]
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   876
    have IH: \<open>bit (a div 2 + b div 2) n \<longleftrightarrow> bit (a div 2 OR b div 2) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   877
      by (simp add: bit_Suc)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   878
    have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   879
      using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   880
    also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   881
      using even by (auto simp: algebra_simps mod2_eq_if)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   882
    finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   883
      using \<open>possible_bit TYPE('a) (Suc n)\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff possible_bit_def)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   884
    also have \<open>\<dots> \<longleftrightarrow> bit (a div 2 OR b div 2) n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   885
      by (rule IH)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   886
    finally show ?case
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   887
      by (simp add: bit_simps flip: bit_Suc)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   888
  qed
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   889
qed
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   890
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   891
lemma disjunctive_add_eq_xor:
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   892
  \<open>a + b = a XOR b\<close> if \<open>a AND b = 0\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   893
  using that by (simp add: disjunctive_add_eq_or disjunctive_xor_eq_or)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   894
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   895
lemma take_bit_0 [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   896
  "take_bit 0 a = 0"
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   897
  by (simp add: take_bit_eq_mod)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   898
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   899
lemma bit_take_bit_iff [bit_simps]:
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   900
  \<open>bit (take_bit m a) n \<longleftrightarrow> n < m \<and> bit a n\<close>
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   901
proof -
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   902
  have \<open>push_bit m (drop_bit m a) AND take_bit m a = 0\<close> (is \<open>?lhs = _\<close>)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   903
  proof (rule bit_eqI)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   904
    fix n
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   905
    show \<open>bit ?lhs n \<longleftrightarrow> bit 0 n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   906
    proof (cases \<open>m \<le> n\<close>)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   907
      case False
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   908
      then show ?thesis
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   909
        by (simp add: bit_simps)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   910
    next
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   911
      case True
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   912
      moreover define q where \<open>q = n - m\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   913
      ultimately have \<open>n = m + q\<close> by simp
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   914
      moreover have \<open>\<not> bit (take_bit m a) (m + q)\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   915
        by (simp add: take_bit_eq_mod bit_iff_odd flip: div_exp_eq)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   916
      ultimately show ?thesis
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   917
        by (simp add: bit_simps)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   918
    qed
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   919
  qed
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   920
  then have \<open>push_bit m (drop_bit m a) XOR take_bit m a = push_bit m (drop_bit m a) + take_bit m a\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   921
    by (simp add: disjunctive_add_eq_xor)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   922
  also have \<open>\<dots> = a\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   923
    by (simp add: bits_ident)
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   924
  finally have \<open>bit (push_bit m (drop_bit m a) XOR take_bit m a) n \<longleftrightarrow> bit a n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   925
    by simp
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   926
  also have \<open>\<dots> \<longleftrightarrow> (m \<le> n \<or> n < m) \<and> bit a n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   927
    by auto
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   928
  also have \<open>\<dots> \<longleftrightarrow> m \<le> n \<and> bit a n \<or> n < m \<and> bit a n\<close>
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   929
    by auto
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   930
  also have \<open>m \<le> n \<and> bit a n \<longleftrightarrow> bit (push_bit m (drop_bit m a)) n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   931
    by (auto simp: bit_simps bit_imp_possible_bit)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   932
  finally show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
   933
    by (auto simp: bit_simps)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
   934
qed
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   935
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   936
lemma take_bit_Suc:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   937
  \<open>take_bit (Suc n) a = take_bit n (a div 2) * 2 + a mod 2\<close> (is \<open>?lhs = ?rhs\<close>)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   938
proof (rule bit_eqI)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   939
  fix m
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   940
  assume \<open>possible_bit TYPE('a) m\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   941
  then show \<open>bit ?lhs m \<longleftrightarrow> bit ?rhs m\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   942
    apply (cases a rule: parity_cases; cases m)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   943
       apply (simp_all add: bit_simps even_bit_succ_iff mult.commute [of _ 2] add.commute [of _ 1] flip: bit_Suc)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   944
     apply (simp_all add: bit_0)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   945
    done
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   946
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   947
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   948
lemma take_bit_rec:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   949
  \<open>take_bit n a = (if n = 0 then 0 else take_bit (n - 1) (a div 2) * 2 + a mod 2)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   950
  by (cases n) (simp_all add: take_bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   951
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   952
lemma take_bit_Suc_0 [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   953
  \<open>take_bit (Suc 0) a = a mod 2\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   954
  by (simp add: take_bit_eq_mod)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   955
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   956
lemma take_bit_of_0 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   957
  \<open>take_bit n 0 = 0\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   958
  by (rule bit_eqI) (simp add: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   959
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   960
lemma take_bit_of_1 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   961
  \<open>take_bit n 1 = of_bool (n > 0)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   962
  by (cases n) (simp_all add: take_bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   963
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   964
lemma drop_bit_of_0 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   965
  \<open>drop_bit n 0 = 0\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   966
  by (rule bit_eqI) (simp add: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   967
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   968
lemma drop_bit_of_1 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   969
  \<open>drop_bit n 1 = of_bool (n = 0)\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   970
  by (rule bit_eqI) (simp add: bit_simps ac_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   971
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   972
lemma drop_bit_0 [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   973
  \<open>drop_bit 0 = id\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   974
  by (simp add: fun_eq_iff drop_bit_eq_div)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   975
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   976
lemma drop_bit_Suc:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   977
  \<open>drop_bit (Suc n) a = drop_bit n (a div 2)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   978
  using div_exp_eq [of a 1] by (simp add: drop_bit_eq_div)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   979
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   980
lemma drop_bit_rec:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   981
  \<open>drop_bit n a = (if n = 0 then a else drop_bit (n - 1) (a div 2))\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   982
  by (cases n) (simp_all add: drop_bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   983
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   984
lemma drop_bit_half:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   985
  \<open>drop_bit n (a div 2) = drop_bit n a div 2\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   986
  by (induction n arbitrary: a) (simp_all add: drop_bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   987
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   988
lemma drop_bit_of_bool [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   989
  \<open>drop_bit n (of_bool b) = of_bool (n = 0 \<and> b)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   990
  by (cases n) simp_all
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   991
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   992
lemma even_take_bit_eq [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   993
  \<open>even (take_bit n a) \<longleftrightarrow> n = 0 \<or> even a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   994
  by (simp add: take_bit_rec [of n a])
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   995
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   996
lemma take_bit_take_bit [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
   997
  \<open>take_bit m (take_bit n a) = take_bit (min m n) a\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
   998
  by (rule bit_eqI) (simp add: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
   999
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1000
lemma drop_bit_drop_bit [simp]:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1001
  \<open>drop_bit m (drop_bit n a) = drop_bit (m + n) a\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1002
  by (simp add: drop_bit_eq_div power_add div_exp_eq ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1003
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1004
lemma push_bit_take_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1005
  \<open>push_bit m (take_bit n a) = take_bit (m + n) (push_bit m a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1006
  by (rule bit_eqI) (auto simp: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1007
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1008
lemma take_bit_push_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1009
  \<open>take_bit m (push_bit n a) = push_bit n (take_bit (m - n) a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1010
  by (rule bit_eqI) (auto simp: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1011
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1012
lemma take_bit_drop_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1013
  \<open>take_bit m (drop_bit n a) = drop_bit n (take_bit (m + n) a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1014
  by (rule bit_eqI) (auto simp: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1015
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1016
lemma drop_bit_take_bit:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1017
  \<open>drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1018
  by (rule bit_eqI) (auto simp: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1019
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1020
lemma even_push_bit_iff [simp]:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1021
  \<open>even (push_bit n a) \<longleftrightarrow> n \<noteq> 0 \<or> even a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1022
  by (simp add: push_bit_eq_mult) auto
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1023
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1024
lemma stable_imp_drop_bit_eq:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1025
  \<open>drop_bit n a = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1026
  if \<open>a div 2 = a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1027
  by (induction n) (simp_all add: that drop_bit_Suc)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1028
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1029
lemma stable_imp_take_bit_eq:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  1030
  \<open>take_bit n a = (if even a then 0 else mask n)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1031
    if \<open>a div 2 = a\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  1032
  by (rule bit_eqI) (use that in \<open>simp add: bit_simps stable_imp_bit_iff_odd\<close>)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1033
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1034
lemma exp_dvdE:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1035
  assumes \<open>2 ^ n dvd a\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1036
  obtains b where \<open>a = push_bit n b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1037
proof -
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1038
  from assms obtain b where \<open>a = 2 ^ n * b\<close> ..
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1039
  then have \<open>a = push_bit n b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1040
    by (simp add: push_bit_eq_mult ac_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1041
  with that show thesis .
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1042
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1043
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1044
lemma take_bit_eq_0_iff:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1045
  \<open>take_bit n a = 0 \<longleftrightarrow> 2 ^ n dvd a\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1046
proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1047
  assume ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1048
  then show ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1049
    by (simp add: take_bit_eq_mod mod_0_imp_dvd)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1050
next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1051
  assume ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1052
  then obtain b where \<open>a = push_bit n b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1053
    by (rule exp_dvdE)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1054
  then show ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1055
    by (simp add: take_bit_push_bit)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1056
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1057
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1058
lemma take_bit_tightened:
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1059
  \<open>take_bit m a = take_bit m b\<close> if \<open>take_bit n a = take_bit n b\<close> and \<open>m \<le> n\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1060
proof -
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1061
  from that have \<open>take_bit m (take_bit n a) = take_bit m (take_bit n b)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1062
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1063
  then have \<open>take_bit (min m n) a = take_bit (min m n) b\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1064
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1065
  with that show ?thesis
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1066
    by (simp add: min_def)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1067
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1068
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1069
lemma take_bit_eq_self_iff_drop_bit_eq_0:
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1070
  \<open>take_bit n a = a \<longleftrightarrow> drop_bit n a = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1071
proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1072
  assume ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1073
  show ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1074
  proof (rule bit_eqI)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1075
    fix m
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1076
    from \<open>?P\<close> have \<open>a = take_bit n a\<close> ..
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1077
    also have \<open>\<not> bit (take_bit n a) (n + m)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1078
      unfolding bit_simps
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1079
      by (simp add: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1080
    finally show \<open>bit (drop_bit n a) m \<longleftrightarrow> bit 0 m\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1081
      by (simp add: bit_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1082
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1083
next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1084
  assume ?Q
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1085
  show ?P
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1086
  proof (rule bit_eqI)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1087
    fix m
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1088
    from \<open>?Q\<close> have \<open>\<not> bit (drop_bit n a) (m - n)\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1089
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1090
    then have \<open> \<not> bit a (n + (m - n))\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1091
      by (simp add: bit_simps)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1092
    then show \<open>bit (take_bit n a) m \<longleftrightarrow> bit a m\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1093
      by (cases \<open>m < n\<close>) (auto simp: bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1094
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1095
qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1096
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1097
lemma drop_bit_exp_eq:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1098
  \<open>drop_bit m (2 ^ n) = of_bool (m \<le> n \<and> possible_bit TYPE('a) n) * 2 ^ (n - m)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1099
  by (auto simp: bit_eq_iff bit_simps)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1100
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1101
lemma take_bit_and [simp]:
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1102
  \<open>take_bit n (a AND b) = take_bit n a AND take_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1103
  by (auto simp: bit_eq_iff bit_simps)
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1104
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1105
lemma take_bit_or [simp]:
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1106
  \<open>take_bit n (a OR b) = take_bit n a OR take_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1107
  by (auto simp: bit_eq_iff bit_simps)
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1108
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1109
lemma take_bit_xor [simp]:
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1110
  \<open>take_bit n (a XOR b) = take_bit n a XOR take_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1111
  by (auto simp: bit_eq_iff bit_simps)
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1112
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1113
lemma push_bit_and [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1114
  \<open>push_bit n (a AND b) = push_bit n a AND push_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1115
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1116
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1117
lemma push_bit_or [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1118
  \<open>push_bit n (a OR b) = push_bit n a OR push_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1119
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1120
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1121
lemma push_bit_xor [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1122
  \<open>push_bit n (a XOR b) = push_bit n a XOR push_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1123
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1124
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1125
lemma drop_bit_and [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1126
  \<open>drop_bit n (a AND b) = drop_bit n a AND drop_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1127
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1128
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1129
lemma drop_bit_or [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1130
  \<open>drop_bit n (a OR b) = drop_bit n a OR drop_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1131
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1132
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1133
lemma drop_bit_xor [simp]:
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1134
  \<open>drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1135
  by (auto simp: bit_eq_iff bit_simps)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1136
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1137
lemma take_bit_of_mask [simp]:
72830
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  1138
  \<open>take_bit m (mask n) = mask (min m n)\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  1139
  by (rule bit_eqI) (simp add: bit_simps)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  1140
71965
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71956
diff changeset
  1141
lemma take_bit_eq_mask:
71823
214b48a1937b explicit mask operation for bits
haftmann
parents: 71822
diff changeset
  1142
  \<open>take_bit n a = a AND mask n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1143
  by (auto simp: bit_eq_iff bit_simps)
71823
214b48a1937b explicit mask operation for bits
haftmann
parents: 71822
diff changeset
  1144
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72262
diff changeset
  1145
lemma or_eq_0_iff:
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72262
diff changeset
  1146
  \<open>a OR b = 0 \<longleftrightarrow> a = 0 \<and> b = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1147
  by (auto simp: bit_eq_iff bit_or_iff)
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72262
diff changeset
  1148
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1149
lemma bit_iff_and_drop_bit_eq_1:
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1150
  \<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close>
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1151
  by (simp add: bit_iff_odd_drop_bit and_one_eq odd_iff_mod_2_eq_one)
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1152
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1153
lemma bit_iff_and_push_bit_not_eq_0:
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1154
  \<open>bit a n \<longleftrightarrow> a AND push_bit n 1 \<noteq> 0\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  1155
  by (cases \<open>possible_bit TYPE('a) n\<close>) (simp_all add: bit_eq_iff bit_simps impossible_bit)
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72488
diff changeset
  1156
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1157
lemma bit_set_bit_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1158
  \<open>bit (set_bit m a) n \<longleftrightarrow> bit a n \<or> (m = n \<and> possible_bit TYPE('a) n)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1159
  by (auto simp: set_bit_eq_or bit_or_iff bit_exp_iff)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1160
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1161
lemma even_set_bit_iff:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1162
  \<open>even (set_bit m a) \<longleftrightarrow> even a \<and> m \<noteq> 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1163
  using bit_set_bit_iff [of m a 0] by (auto simp: bit_0)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1164
79031
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  1165
lemma bit_unset_bit_iff [bit_simps]:
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  1166
  \<open>bit (unset_bit m a) n \<longleftrightarrow> bit a n \<and> m \<noteq> n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1167
  by (auto simp: unset_bit_eq_or_xor bit_simps dest: bit_imp_possible_bit)
79031
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  1168
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1169
lemma even_unset_bit_iff:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1170
  \<open>even (unset_bit m a) \<longleftrightarrow> even a \<or> m = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1171
  using bit_unset_bit_iff [of m a 0] by (auto simp: bit_0)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1172
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1173
lemma bit_flip_bit_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1174
  \<open>bit (flip_bit m a) n \<longleftrightarrow> (m = n \<longleftrightarrow> \<not> bit a n) \<and> possible_bit TYPE('a) n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1175
  by (auto simp: bit_eq_iff bit_simps flip_bit_eq_xor bit_imp_possible_bit)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1176
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1177
lemma even_flip_bit_iff:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1178
  \<open>even (flip_bit m a) \<longleftrightarrow> \<not> (even a \<longleftrightarrow> m = 0)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  1179
  using bit_flip_bit_iff [of m a 0] by (auto simp: possible_bit_def  bit_0)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1180
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1181
lemma and_exp_eq_0_iff_not_bit:
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1182
  \<open>a AND 2 ^ n = 0 \<longleftrightarrow> \<not> bit a n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1183
  using bit_imp_possible_bit[of a n]
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1184
  by (auto simp: bit_eq_iff bit_simps)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1185
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1186
lemma bit_sum_mult_2_cases:
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1187
  assumes a: \<open>\<forall>j. \<not> bit a (Suc j)\<close>
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1188
  shows \<open>bit (a + 2 * b) n = (if n = 0 then odd a else bit (2 * b) n)\<close>
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1189
proof -
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1190
  from a have \<open>n = 0\<close> if \<open>bit a n\<close> for n using that
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1191
    by (cases n) simp_all
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1192
  then have \<open>a = 0 \<or> a = 1\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1193
    by (auto simp: bit_eq_iff bit_1_iff)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1194
  then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1195
    by (cases n) (auto simp: bit_0 bit_double_iff even_bit_succ_iff)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1196
qed
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1197
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1198
lemma set_bit_0 [simp]:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1199
  \<open>set_bit 0 a = 1 + 2 * (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1200
  by (auto simp: bit_eq_iff bit_simps even_bit_succ_iff simp flip: bit_Suc)
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1201
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1202
lemma set_bit_Suc:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1203
  \<open>set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1204
  by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1205
    elim: possible_bit_less_imp)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1206
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1207
lemma unset_bit_0 [simp]:
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1208
  \<open>unset_bit 0 a = 2 * (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1209
  by (auto simp: bit_eq_iff bit_simps simp flip: bit_Suc)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1210
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1211
lemma unset_bit_Suc:
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1212
  \<open>unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1213
  by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1214
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1215
lemma flip_bit_0 [simp]:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1216
  \<open>flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1217
  by (auto simp: bit_eq_iff bit_simps even_bit_succ_iff bit_0 simp flip: bit_Suc)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1218
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1219
lemma flip_bit_Suc:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1220
  \<open>flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1221
  by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1222
    elim: possible_bit_less_imp)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1223
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1224
lemma flip_bit_eq_if:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1225
  \<open>flip_bit n a = (if bit a n then unset_bit else set_bit) n a\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1226
  by (rule bit_eqI) (auto simp: bit_set_bit_iff bit_unset_bit_iff bit_flip_bit_iff)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1227
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1228
lemma take_bit_set_bit_eq:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1229
  \<open>take_bit n (set_bit m a) = (if n \<le> m then take_bit n a else set_bit m (take_bit n a))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1230
  by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_set_bit_iff)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1231
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1232
lemma take_bit_unset_bit_eq:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1233
  \<open>take_bit n (unset_bit m a) = (if n \<le> m then take_bit n a else unset_bit m (take_bit n a))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1234
  by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_unset_bit_iff)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1235
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1236
lemma take_bit_flip_bit_eq:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1237
  \<open>take_bit n (flip_bit m a) = (if n \<le> m then take_bit n a else flip_bit m (take_bit n a))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1238
  by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_flip_bit_iff)
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1239
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  1240
lemma bit_1_0 [simp]:
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  1241
  \<open>bit 1 0\<close>
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  1242
  by (simp add: bit_0)
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  1243
74497
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1244
lemma not_bit_1_Suc [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1245
  \<open>\<not> bit 1 (Suc n)\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1246
  by (simp add: bit_Suc)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1247
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1248
lemma push_bit_Suc_numeral [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1249
  \<open>push_bit (Suc n) (numeral k) = push_bit n (numeral (Num.Bit0 k))\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1250
  by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1251
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1252
lemma mask_eq_0_iff [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1253
  \<open>mask n = 0 \<longleftrightarrow> n = 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1254
  by (cases n) (simp_all add: mask_Suc_double or_eq_0_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1255
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1256
lemma bit_horner_sum_bit_iff [bit_simps]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1257
  \<open>bit (horner_sum of_bool 2 bs) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n < length bs \<and> bs ! n\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1258
proof (induction bs arbitrary: n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1259
  case Nil
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1260
  then show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1261
    by simp
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1262
next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1263
  case (Cons b bs)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1264
  show ?case
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1265
  proof (cases n)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1266
    case 0
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1267
    then show ?thesis
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1268
      by (simp add: bit_0)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1269
  next
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1270
    case (Suc m)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1271
    with bit_rec [of _ n] Cons.prems Cons.IH [of m]
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1272
    show ?thesis
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1273
      by (simp add: bit_simps)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1274
        (auto simp: possible_bit_less_imp bit_simps simp flip: bit_Suc)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1275
  qed
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1276
qed
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1277
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1278
lemma horner_sum_bit_eq_take_bit:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1279
  \<open>horner_sum of_bool 2 (map (bit a) [0..<n]) = take_bit n a\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1280
  by (rule bit_eqI) (auto simp: bit_simps)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1281
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1282
lemma take_bit_horner_sum_bit_eq:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1283
  \<open>take_bit n (horner_sum of_bool 2 bs) = horner_sum of_bool 2 (take n bs)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1284
  by (auto simp: bit_eq_iff bit_take_bit_iff bit_horner_sum_bit_iff)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1285
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1286
lemma take_bit_sum:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1287
  \<open>take_bit n a = (\<Sum>k = 0..<n. push_bit k (of_bool (bit a k)))\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1288
  by (simp flip: horner_sum_bit_eq_take_bit add: horner_sum_eq_sum push_bit_eq_mult)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1289
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1290
lemma set_bit_eq:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1291
  \<open>set_bit n a = a + of_bool (\<not> bit a n) * 2 ^ n\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1292
proof -
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1293
  have \<open>a AND of_bool (\<not> bit a n) * 2 ^ n = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1294
    by (auto simp: bit_eq_iff bit_simps)
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1295
  then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1296
    by (auto simp: bit_eq_iff bit_simps disjunctive_add_eq_or)
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1297
qed
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1298
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1299
end
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1300
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1301
class ring_bit_operations = semiring_bit_operations + ring_parity +
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1302
  fixes not :: \<open>'a \<Rightarrow> 'a\<close>  (\<open>NOT\<close>)
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1303
  assumes not_eq_complement: \<open>NOT a = - a - 1\<close>
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1304
begin
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1305
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1306
text \<open>
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1307
  For the sake of code generation \<^const>\<open>not\<close> is specified as
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1308
  definitional class operation.  Note that \<^const>\<open>not\<close> has no
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1309
  sensible definition for unlimited but only positive bit strings
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1310
  (type \<^typ>\<open>nat\<close>).
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1311
\<close>
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1312
71186
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1313
lemma bits_minus_1_mod_2_eq [simp]:
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1314
  \<open>(- 1) mod 2 = 1\<close>
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1315
  by (simp add: mod_2_eq_odd)
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1316
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1317
lemma minus_eq_not_plus_1:
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1318
  \<open>- a = NOT a + 1\<close>
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1319
  using not_eq_complement [of a] by simp
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1320
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1321
lemma minus_eq_not_minus_1:
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1322
  \<open>- a = NOT (a - 1)\<close>
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1323
  using not_eq_complement [of \<open>a - 1\<close>] by simp (simp add: algebra_simps)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1324
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1325
lemma not_rec:
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1326
  \<open>NOT a = of_bool (even a) + 2 * NOT (a div 2)\<close>
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1327
  by (simp add: not_eq_complement algebra_simps mod_2_eq_odd flip: minus_mod_eq_mult_div)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1328
79590
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1329
lemma decr_eq_not_minus:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1330
  \<open>a - 1 = NOT (- a)\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1331
  using not_eq_complement [of \<open>- a\<close>] by simp
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1332
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1333
lemma even_not_iff [simp]:
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1334
  \<open>even (NOT a) \<longleftrightarrow> odd a\<close>
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1335
  by (simp add: not_eq_complement)
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1336
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1337
lemma bit_not_iff [bit_simps]:
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1338
  \<open>bit (NOT a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit a n\<close>
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1339
proof (cases \<open>possible_bit TYPE('a) n\<close>)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1340
  case False
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1341
  then show ?thesis
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1342
    by (auto dest: bit_imp_possible_bit)
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1343
next
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1344
  case True
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1345
  moreover have \<open>bit (NOT a) n \<longleftrightarrow> \<not> bit a n\<close>
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1346
  using \<open>possible_bit TYPE('a) n\<close> proof (induction n arbitrary: a)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1347
    case 0
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1348
    then show ?case
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1349
      by (simp add: bit_0)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1350
  next
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1351
    case (Suc n)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1352
    from Suc.prems Suc.IH [of \<open>a div 2\<close>]
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1353
    show ?case
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1354
      by (simp add: impossible_bit possible_bit_less_imp not_rec [of a] even_bit_succ_iff bit_double_iff flip: bit_Suc)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1355
  qed
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1356
  ultimately show ?thesis
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1357
    by simp
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1358
qed
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1359
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72512
diff changeset
  1360
lemma bit_not_exp_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1361
  \<open>bit (NOT (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> m\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1362
  by (auto simp: bit_not_iff bit_exp_iff)
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1363
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1364
lemma bit_minus_iff [bit_simps]:
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1365
  \<open>bit (- a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit (a - 1) n\<close>
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1366
  by (simp add: minus_eq_not_minus_1 bit_not_iff)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1367
71186
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1368
lemma bit_minus_1_iff [simp]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1369
  \<open>bit (- 1) n \<longleftrightarrow> possible_bit TYPE('a) n\<close>
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1370
  by (simp add: bit_minus_iff)
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1371
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72512
diff changeset
  1372
lemma bit_minus_exp_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1373
  \<open>bit (- (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<ge> m\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1374
  by (auto simp: bit_simps simp flip: mask_eq_exp_minus_1)
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1375
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1376
lemma bit_minus_2_iff [simp]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1377
  \<open>bit (- 2) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n > 0\<close>
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1378
  by (simp add: bit_minus_iff bit_1_iff)
71186
3d35e12999ba characterization of typical bit operations
haftmann
parents: 71181
diff changeset
  1379
79590
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1380
lemma bit_decr_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1381
  \<open>bit (a - 1) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit (- a) n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1382
  by (simp add: decr_eq_not_minus bit_not_iff)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  1383
79018
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1384
lemma bit_not_iff_eq:
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1385
  \<open>bit (NOT a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> \<not> bit a n\<close>
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1386
  by (simp add: bit_simps possible_bit_def)
7449ff77029e base abstract specification of NOT on recursive equation rather than bit projection
haftmann
parents: 79017
diff changeset
  1387
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  1388
lemma not_one_eq [simp]:
73969
ca2a35c0fe6e operations for symbolic computation of bit operations
haftmann
parents: 73871
diff changeset
  1389
  \<open>NOT 1 = - 2\<close>
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1390
  by (simp add: bit_eq_iff bit_not_iff) (simp add: bit_1_iff)
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1391
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1392
sublocale "and": semilattice_neutr \<open>(AND)\<close> \<open>- 1\<close>
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1393
  by standard (rule bit_eqI, simp add: bit_and_iff)
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1394
74123
7c5842b06114 clarified abstract and concrete boolean algebras
haftmann
parents: 74108
diff changeset
  1395
sublocale bit: abstract_boolean_algebra \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1396
  by standard (auto simp: bit_and_iff bit_or_iff bit_not_iff intro: bit_eqI)
74123
7c5842b06114 clarified abstract and concrete boolean algebras
haftmann
parents: 74108
diff changeset
  1397
7c5842b06114 clarified abstract and concrete boolean algebras
haftmann
parents: 74108
diff changeset
  1398
sublocale bit: abstract_boolean_algebra_sym_diff \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close> \<open>(XOR)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1399
proof
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1400
  show \<open>\<And>x y. x XOR y = x AND NOT y OR NOT x AND y\<close>
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1401
    by (intro bit_eqI) (auto simp: bit_simps)
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1402
qed
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1403
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1404
lemma and_eq_not_not_or:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1405
  \<open>a AND b = NOT (NOT a OR NOT b)\<close>
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1406
  by simp
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1407
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1408
lemma or_eq_not_not_and:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1409
  \<open>a OR b = NOT (NOT a AND NOT b)\<close>
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1410
  by simp
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1411
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1412
lemma not_add_distrib:
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1413
  \<open>NOT (a + b) = NOT a - b\<close>
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1414
  by (simp add: not_eq_complement algebra_simps)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1415
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1416
lemma not_diff_distrib:
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1417
  \<open>NOT (a - b) = NOT a + b\<close>
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1418
  using not_add_distrib [of a \<open>- b\<close>] by simp
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1419
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1420
lemma and_eq_minus_1_iff:
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72262
diff changeset
  1421
  \<open>a AND b = - 1 \<longleftrightarrow> a = - 1 \<and> b = - 1\<close>
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  1422
  by (auto simp: bit_eq_iff bit_simps)
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72262
diff changeset
  1423
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1424
lemma disjunctive_and_not_eq_xor:
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1425
  \<open>a AND NOT b = a XOR b\<close> if \<open>NOT a AND b = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1426
  using that by (auto simp: bit_eq_iff bit_simps)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1427
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1428
lemma disjunctive_diff_eq_and_not:
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1429
  \<open>a - b = a AND NOT b\<close> if \<open>NOT a AND b = 0\<close>
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1430
proof -
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1431
  from that have \<open>NOT a + b = NOT a OR b\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1432
    by (rule disjunctive_add_eq_or)
72239
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1433
  then have \<open>NOT (NOT a + b) = NOT (NOT a OR b)\<close>
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1434
    by simp
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1435
  then show ?thesis
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1436
    by (simp add: not_add_distrib)
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1437
qed
12e94c2ff6c5 generalized
haftmann
parents: 72227
diff changeset
  1438
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1439
lemma disjunctive_diff_eq_xor:
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1440
  \<open>a AND NOT b = a XOR b\<close> if \<open>NOT a AND b = 0\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1441
  using that by (simp add: disjunctive_and_not_eq_xor disjunctive_diff_eq_and_not)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1442
71412
96d126844adc more theorems
haftmann
parents: 71409
diff changeset
  1443
lemma push_bit_minus:
96d126844adc more theorems
haftmann
parents: 71409
diff changeset
  1444
  \<open>push_bit n (- a) = - push_bit n a\<close>
96d126844adc more theorems
haftmann
parents: 71409
diff changeset
  1445
  by (simp add: push_bit_eq_mult)
96d126844adc more theorems
haftmann
parents: 71409
diff changeset
  1446
71409
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1447
lemma take_bit_not_take_bit:
0bb0cb558bf9 sketches of ideas still to come
haftmann
parents: 71195
diff changeset
  1448
  \<open>take_bit n (NOT (take_bit n a)) = take_bit n (NOT a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1449
  by (auto simp: bit_eq_iff bit_take_bit_iff bit_not_iff)
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1450
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1451
lemma take_bit_not_iff:
73969
ca2a35c0fe6e operations for symbolic computation of bit operations
haftmann
parents: 73871
diff changeset
  1452
  \<open>take_bit n (NOT a) = take_bit n (NOT b) \<longleftrightarrow> take_bit n a = take_bit n b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1453
  by (auto simp: bit_eq_iff bit_simps)
71418
bd9d27ccb3a3 more theorems
haftmann
parents: 71413
diff changeset
  1454
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1455
lemma take_bit_not_eq_mask_diff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1456
  \<open>take_bit n (NOT a) = mask n - take_bit n a\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1457
proof -
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1458
  have \<open>NOT (mask n) AND take_bit n a = 0\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1459
    by (simp add: bit_eq_iff bit_simps)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1460
  moreover have \<open>take_bit n (NOT a) = mask n AND NOT (take_bit n a)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1461
    by (auto simp: bit_eq_iff bit_simps)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1462
  ultimately show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1463
    by (simp add: disjunctive_diff_eq_and_not)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1464
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1465
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72028
diff changeset
  1466
lemma mask_eq_take_bit_minus_one:
8c355e2dd7db more consequent transferability
haftmann
parents: 72028
diff changeset
  1467
  \<open>mask n = take_bit n (- 1)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72028
diff changeset
  1468
  by (simp add: bit_eq_iff bit_mask_iff bit_take_bit_iff conj_commute)
8c355e2dd7db more consequent transferability
haftmann
parents: 72028
diff changeset
  1469
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1470
lemma take_bit_minus_one_eq_mask [simp]:
71922
2c6a5c709f22 more theorems
haftmann
parents: 71921
diff changeset
  1471
  \<open>take_bit n (- 1) = mask n\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72028
diff changeset
  1472
  by (simp add: mask_eq_take_bit_minus_one)
71922
2c6a5c709f22 more theorems
haftmann
parents: 71921
diff changeset
  1473
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1474
lemma minus_exp_eq_not_mask:
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1475
  \<open>- (2 ^ n) = NOT (mask n)\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1476
  by (rule bit_eqI) (simp add: bit_minus_iff bit_not_iff flip: mask_eq_exp_minus_1)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1477
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1478
lemma push_bit_minus_one_eq_not_mask [simp]:
71922
2c6a5c709f22 more theorems
haftmann
parents: 71921
diff changeset
  1479
  \<open>push_bit n (- 1) = NOT (mask n)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1480
  by (simp add: push_bit_eq_mult minus_exp_eq_not_mask)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1481
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1482
lemma take_bit_not_mask_eq_0:
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1483
  \<open>take_bit m (NOT (mask n)) = 0\<close> if \<open>n \<ge> m\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  1484
  by (rule bit_eqI) (use that in \<open>simp add: bit_take_bit_iff bit_not_iff bit_mask_iff\<close>)
71922
2c6a5c709f22 more theorems
haftmann
parents: 71921
diff changeset
  1485
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1486
lemma unset_bit_eq_and_not:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1487
  \<open>unset_bit n a = a AND NOT (push_bit n 1)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1488
  by (rule bit_eqI) (auto simp: bit_simps)
71426
745e518d3d0b easy abstraction over pointwise bit operations
haftmann
parents: 71424
diff changeset
  1489
74497
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1490
lemma push_bit_Suc_minus_numeral [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1491
  \<open>push_bit (Suc n) (- numeral k) = push_bit n (- numeral (Num.Bit0 k))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1492
  using local.push_bit_Suc_numeral push_bit_minus by presburger
74497
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1493
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1494
lemma push_bit_minus_numeral [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1495
  \<open>push_bit (numeral l) (- numeral k) = push_bit (pred_numeral l) (- numeral (Num.Bit0 k))\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1496
  by (simp only: numeral_eq_Suc push_bit_Suc_minus_numeral)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  1497
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1498
lemma take_bit_Suc_minus_1_eq:
74498
27475e64a887 more complete simp rules
haftmann
parents: 74497
diff changeset
  1499
  \<open>take_bit (Suc n) (- 1) = 2 ^ Suc n - 1\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1500
  by (simp add: mask_eq_exp_minus_1)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1501
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1502
lemma take_bit_numeral_minus_1_eq:
74498
27475e64a887 more complete simp rules
haftmann
parents: 74497
diff changeset
  1503
  \<open>take_bit (numeral k) (- 1) = 2 ^ numeral k - 1\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1504
  by (simp add: mask_eq_exp_minus_1)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1505
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1506
lemma push_bit_mask_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1507
  \<open>push_bit m (mask n) = mask (n + m) AND NOT (mask m)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1508
  by (rule bit_eqI) (auto simp: bit_simps not_less possible_bit_less_imp)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1509
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1510
lemma slice_eq_mask:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1511
  \<open>push_bit n (take_bit m (drop_bit n a)) = a AND mask (m + n) AND NOT (mask n)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1512
  by (rule bit_eqI) (auto simp: bit_simps)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1513
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1514
lemma push_bit_numeral_minus_1 [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1515
  \<open>push_bit (numeral n) (- 1) = - (2 ^ numeral n)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1516
  by (simp add: push_bit_eq_mult)
74498
27475e64a887 more complete simp rules
haftmann
parents: 74497
diff changeset
  1517
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1518
lemma unset_bit_eq:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1519
  \<open>unset_bit n a = a - of_bool (bit a n) * 2 ^ n\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1520
proof -
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1521
  have \<open>NOT a AND of_bool (bit a n) * 2 ^ n = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1522
    by (auto simp: bit_eq_iff bit_simps)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1523
  moreover have \<open>unset_bit n a = a AND NOT (of_bool (bit a n) * 2 ^ n)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1524
    by (auto simp: bit_eq_iff bit_simps)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1525
  ultimately show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  1526
    by (simp add: disjunctive_diff_eq_and_not)
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1527
qed
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1528
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1529
end
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1530
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1531
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1532
subsection \<open>Common algebraic structure\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1533
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1534
class linordered_euclidean_semiring_bit_operations =
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1535
  linordered_euclidean_semiring + semiring_bit_operations
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1536
begin
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1537
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1538
lemma possible_bit [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1539
  \<open>possible_bit TYPE('a) n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1540
  by (simp add: possible_bit_def)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1541
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1542
lemma take_bit_of_exp [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1543
  \<open>take_bit m (2 ^ n) = of_bool (n < m) * 2 ^ n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1544
  by (simp add: take_bit_eq_mod exp_mod_exp)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1545
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1546
lemma take_bit_of_2 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1547
  \<open>take_bit n 2 = of_bool (2 \<le> n) * 2\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1548
  using take_bit_of_exp [of n 1] by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1549
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1550
lemma push_bit_eq_0_iff [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1551
  \<open>push_bit n a = 0 \<longleftrightarrow> a = 0\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1552
  by (simp add: push_bit_eq_mult)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1553
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1554
lemma take_bit_add:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1555
  \<open>take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1556
  by (simp add: take_bit_eq_mod mod_simps)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1557
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1558
lemma take_bit_of_1_eq_0_iff [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1559
  \<open>take_bit n 1 = 0 \<longleftrightarrow> n = 0\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1560
  by (simp add: take_bit_eq_mod)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1561
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1562
lemma drop_bit_Suc_bit0 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1563
  \<open>drop_bit (Suc n) (numeral (Num.Bit0 k)) = drop_bit n (numeral k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1564
  by (simp add: drop_bit_Suc numeral_Bit0_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1565
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1566
lemma drop_bit_Suc_bit1 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1567
  \<open>drop_bit (Suc n) (numeral (Num.Bit1 k)) = drop_bit n (numeral k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1568
  by (simp add: drop_bit_Suc numeral_Bit1_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1569
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1570
lemma drop_bit_numeral_bit0 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1571
  \<open>drop_bit (numeral l) (numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (numeral k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1572
  by (simp add: drop_bit_rec numeral_Bit0_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1573
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1574
lemma drop_bit_numeral_bit1 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1575
  \<open>drop_bit (numeral l) (numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (numeral k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1576
  by (simp add: drop_bit_rec numeral_Bit1_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1577
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1578
lemma take_bit_Suc_1 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1579
  \<open>take_bit (Suc n) 1 = 1\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1580
  by (simp add: take_bit_Suc)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1581
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1582
lemma take_bit_Suc_bit0:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1583
  \<open>take_bit (Suc n) (numeral (Num.Bit0 k)) = take_bit n (numeral k) * 2\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1584
  by (simp add: take_bit_Suc numeral_Bit0_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1585
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1586
lemma take_bit_Suc_bit1:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1587
  \<open>take_bit (Suc n) (numeral (Num.Bit1 k)) = take_bit n (numeral k) * 2 + 1\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1588
  by (simp add: take_bit_Suc numeral_Bit1_div_2 mod_2_eq_odd)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1589
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1590
lemma take_bit_numeral_1 [simp]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1591
  \<open>take_bit (numeral l) 1 = 1\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1592
  by (simp add: take_bit_rec [of \<open>numeral l\<close> 1])
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1593
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1594
lemma take_bit_numeral_bit0:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1595
  \<open>take_bit (numeral l) (numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (numeral k) * 2\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1596
  by (simp add: take_bit_rec numeral_Bit0_div_2)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1597
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1598
lemma take_bit_numeral_bit1:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1599
  \<open>take_bit (numeral l) (numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (numeral k) * 2 + 1\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1600
  by (simp add: take_bit_rec numeral_Bit1_div_2 mod_2_eq_odd)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1601
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1602
lemma bit_of_nat_iff_bit [bit_simps]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1603
  \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1604
proof -
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1605
  have \<open>even (m div 2 ^ n) \<longleftrightarrow> even (of_nat (m div 2 ^ n))\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1606
    by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1607
  also have \<open>of_nat (m div 2 ^ n) = of_nat m div of_nat (2 ^ n)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1608
    by (simp add: of_nat_div)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1609
  finally show ?thesis
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1610
    by (simp add: bit_iff_odd semiring_bits_class.bit_iff_odd)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1611
qed
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1612
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1613
lemma drop_bit_mask_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1614
  \<open>drop_bit m (mask n) = mask (n - m)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1615
  by (rule bit_eqI) (auto simp: bit_simps possible_bit_def)
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1616
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1617
lemma bit_push_bit_iff':
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1618
  \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> bit a (n - m)\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1619
  by (simp add: bit_simps)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1620
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1621
lemma mask_half:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1622
  \<open>mask n div 2 = mask (n - 1)\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1623
  by (cases n) (simp_all add: mask_Suc_double one_or_eq)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1624
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1625
lemma take_bit_Suc_from_most:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1626
  \<open>take_bit (Suc n) a = 2 ^ n * of_bool (bit a n) + take_bit n a\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1627
  using mod_mult2_eq' [of a \<open>2 ^ n\<close> 2]
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1628
  by (simp only: take_bit_eq_mod power_Suc2)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1629
    (simp_all add: bit_iff_odd odd_iff_mod_2_eq_one)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1630
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1631
lemma take_bit_nonnegative [simp]:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1632
  \<open>0 \<le> take_bit n a\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1633
  using horner_sum_nonnegative by (simp flip: horner_sum_bit_eq_take_bit)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1634
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1635
lemma not_take_bit_negative [simp]:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1636
  \<open>\<not> take_bit n a < 0\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1637
  by (simp add: not_less)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1638
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1639
lemma bit_imp_take_bit_positive:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1640
  \<open>0 < take_bit m a\<close> if \<open>n < m\<close> and \<open>bit a n\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1641
proof (rule ccontr)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1642
  assume \<open>\<not> 0 < take_bit m a\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1643
  then have \<open>take_bit m a = 0\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1644
    by (auto simp: not_less intro: order_antisym)
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1645
  then have \<open>bit (take_bit m a) n = bit 0 n\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1646
    by simp
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1647
  with that show False
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1648
    by (simp add: bit_take_bit_iff)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1649
qed
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1650
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1651
lemma take_bit_mult:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1652
  \<open>take_bit n (take_bit n a * take_bit n b) = take_bit n (a * b)\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1653
  by (simp add: take_bit_eq_mod mod_mult_eq)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1654
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1655
lemma drop_bit_push_bit:
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1656
  \<open>drop_bit m (push_bit n a) = drop_bit (m - n) (push_bit (n - m) a)\<close>
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1657
  by (cases \<open>m \<le> n\<close>)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1658
    (auto simp: mult.left_commute [of _ \<open>2 ^ n\<close>] mult.commute [of _ \<open>2 ^ n\<close>] mult.assoc
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1659
    mult.commute [of a] drop_bit_eq_div push_bit_eq_mult not_le power_add Orderings.not_le dest!: le_Suc_ex less_imp_Suc_add)
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1660
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1661
end
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1662
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1663
71956
a4bffc0de967 bit operations as distinctive library theory
haftmann
parents: 71922
diff changeset
  1664
subsection \<open>Instance \<^typ>\<open>int\<close>\<close>
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1665
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1666
locale fold2_bit_int =
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1667
  fixes f :: \<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1668
begin
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1669
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1670
context
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1671
begin
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1672
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1673
function F :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1674
  where \<open>F k l = (if k \<in> {0, - 1} \<and> l \<in> {0, - 1}
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1675
    then - of_bool (f (odd k) (odd l))
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1676
    else of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (l div 2)))\<close>
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1677
  by auto
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1678
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1679
private termination proof (relation \<open>measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>)
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1680
  have less_eq: \<open>\<bar>k div 2\<bar> \<le> \<bar>k\<bar>\<close> for k :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1681
    by (cases k) (simp_all add: divide_int_def nat_add_distrib)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  1682
  then have less: \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close> if \<open>k \<notin> {0, - 1}\<close> for k :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1683
    using that by (auto simp: less_le [of k])
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1684
  show \<open>wf (measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>)))\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1685
    by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1686
  show \<open>((k div 2, l div 2), k, l) \<in> measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1687
    if \<open>\<not> (k \<in> {0, - 1} \<and> l \<in> {0, - 1})\<close> for k l
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1688
  proof -
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1689
    from that have *: \<open>k \<notin> {0, - 1} \<or> l \<notin> {0, - 1}\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1690
      by simp
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1691
    then have \<open>0 < \<bar>k\<bar> + \<bar>l\<bar>\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1692
      by auto
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1693
    moreover from * have \<open>\<bar>k div 2\<bar> + \<bar>l div 2\<bar> < \<bar>k\<bar> + \<bar>l\<bar>\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1694
    proof
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1695
      assume \<open>k \<notin> {0, - 1}\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1696
      then have \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1697
        by (rule less)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1698
      with less_eq [of l] show ?thesis
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1699
        by auto
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1700
    next
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1701
      assume \<open>l \<notin> {0, - 1}\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1702
      then have \<open>\<bar>l div 2\<bar> < \<bar>l\<bar>\<close>
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1703
        by (rule less)
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1704
      with less_eq [of k] show ?thesis
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1705
        by auto
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1706
    qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1707
    ultimately show ?thesis
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1708
      by (simp only: in_measure split_def fst_conv snd_conv nat_mono_iff)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1709
  qed
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1710
qed
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1711
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1712
declare F.simps [simp del]
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1713
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1714
lemma rec:
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1715
  \<open>F k l = of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (l div 2))\<close>
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1716
    for k l :: int
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1717
proof (cases \<open>k \<in> {0, - 1} \<and> l \<in> {0, - 1}\<close>)
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1718
  case True
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1719
  then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1720
    by (auto simp: F.simps [of 0] F.simps [of \<open>- 1\<close>])
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1721
next
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1722
  case False
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1723
  then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1724
    by (auto simp: ac_simps F.simps [of k l])
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1725
qed
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1726
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1727
lemma bit_iff:
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1728
  \<open>bit (F k l) n \<longleftrightarrow> f (bit k n) (bit l n)\<close> for k l :: int
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1729
proof (induction n arbitrary: k l)
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1730
  case 0
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1731
  then show ?case
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1732
    by (simp add: rec [of k l] bit_0)
71804
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1733
next
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1734
  case (Suc n)
6fd70ed18199 simplified construction of binary bit operations
haftmann
parents: 71802
diff changeset
  1735
  then show ?case
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1736
    by (simp add: rec [of k l] bit_Suc)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1737
qed
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1738
79030
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1739
end
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1740
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1741
end
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1742
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1743
instantiation int :: ring_bit_operations
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1744
begin
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1745
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1746
definition not_int :: \<open>int \<Rightarrow> int\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1747
  where \<open>not_int k = - k - 1\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1748
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1749
global_interpretation and_int: fold2_bit_int \<open>(\<and>)\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1750
  defines and_int = and_int.F .
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1751
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1752
global_interpretation or_int: fold2_bit_int \<open>(\<or>)\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1753
  defines or_int = or_int.F .
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1754
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1755
global_interpretation xor_int: fold2_bit_int \<open>(\<noteq>)\<close>
bdea2b95817b more direct characterization of binary bit operations
haftmann
parents: 79018
diff changeset
  1756
  defines xor_int = xor_int.F .
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1757
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  1758
definition mask_int :: \<open>nat \<Rightarrow> int\<close>
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  1759
  where \<open>mask n = (2 :: int) ^ n - 1\<close>
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  1760
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1761
definition push_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1762
  where \<open>push_bit_int n k = k * 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1763
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1764
definition drop_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1765
  where \<open>drop_bit_int n k = k div 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1766
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1767
definition take_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1768
  where \<open>take_bit_int n k = k mod 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1769
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1770
definition set_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1771
  where \<open>set_bit n k = k OR push_bit n 1\<close> for k :: int
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1772
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1773
definition unset_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1774
  where \<open>unset_bit n k = k AND NOT (push_bit n 1)\<close> for k :: int
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1775
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1776
definition flip_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1777
  where \<open>flip_bit n k = k XOR push_bit n 1\<close> for k :: int
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1778
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1779
lemma not_int_div_2:
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1780
  \<open>NOT k div 2 = NOT (k div 2)\<close> for k :: int
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1781
  by (simp add: not_int_def)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1782
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1783
lemma bit_not_int_iff:
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1784
  \<open>bit (NOT k) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1785
proof (rule sym, induction n arbitrary: k)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1786
  case 0
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1787
  then show ?case
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1788
    by (simp add: bit_0 not_int_def)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1789
next
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1790
  case (Suc n)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1791
  then show ?case
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1792
    by (simp add: bit_Suc not_int_div_2)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1793
qed
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1794
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1795
instance proof
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1796
  fix k l :: int and m n :: nat
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1797
  show \<open>unset_bit n k = (k OR push_bit n 1) XOR push_bit n 1\<close>
79031
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  1798
    by (rule bit_eqI)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1799
      (auto simp: unset_bit_int_def
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  1800
        and_int.bit_iff or_int.bit_iff xor_int.bit_iff bit_not_int_iff push_bit_int_def bit_simps)
79031
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  1801
qed (fact and_int.rec or_int.rec xor_int.rec mask_int_def set_bit_int_def flip_bit_int_def
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  1802
  push_bit_int_def drop_bit_int_def take_bit_int_def not_int_def)+
71042
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1803
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1804
end
400e9512f1d3 proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
haftmann
parents:
diff changeset
  1805
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1806
instance int :: linordered_euclidean_semiring_bit_operations ..
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1807
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1808
context ring_bit_operations
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1809
begin
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1810
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1811
lemma even_of_int_iff:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1812
  \<open>even (of_int k) \<longleftrightarrow> even k\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1813
  by (induction k rule: int_bit_induct) simp_all
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1814
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1815
lemma bit_of_int_iff [bit_simps]:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1816
  \<open>bit (of_int k) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit k n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1817
proof (cases \<open>possible_bit TYPE('a) n\<close>)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1818
  case False
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1819
  then show ?thesis
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1820
    by (simp add: impossible_bit)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1821
next
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1822
  case True
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1823
  then have \<open>bit (of_int k) n \<longleftrightarrow> bit k n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1824
  proof (induction k arbitrary: n rule: int_bit_induct)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1825
    case zero
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1826
    then show ?case
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1827
      by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1828
  next
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1829
    case minus
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1830
    then show ?case
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1831
      by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1832
  next
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1833
    case (even k)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1834
    then show ?case
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1835
      using bit_double_iff [of \<open>of_int k\<close> n] Bit_Operations.bit_double_iff [of k n]
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1836
      by (cases n) (auto simp: ac_simps possible_bit_def dest: mult_not_zero)
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1837
  next
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1838
    case (odd k)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1839
    then show ?case
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1840
      using bit_double_iff [of \<open>of_int k\<close> n]
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1841
      by (cases n)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1842
        (auto simp: ac_simps bit_double_iff even_bit_succ_iff Bit_Operations.bit_0 Bit_Operations.bit_Suc
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1843
          possible_bit_def dest: mult_not_zero)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1844
  qed
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1845
  with True show ?thesis
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1846
    by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1847
qed
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1848
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1849
lemma push_bit_of_int:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1850
  \<open>push_bit n (of_int k) = of_int (push_bit n k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1851
  by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1852
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1853
lemma of_int_push_bit:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1854
  \<open>of_int (push_bit n k) = push_bit n (of_int k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1855
  by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1856
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1857
lemma take_bit_of_int:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1858
  \<open>take_bit n (of_int k) = of_int (take_bit n k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1859
  by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_int_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1860
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1861
lemma of_int_take_bit:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1862
  \<open>of_int (take_bit n k) = take_bit n (of_int k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1863
  by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_int_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1864
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1865
lemma of_int_not_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1866
  \<open>of_int (NOT k) = NOT (of_int k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1867
  by (rule bit_eqI) (simp add: bit_not_iff Bit_Operations.bit_not_iff bit_of_int_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1868
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1869
lemma of_int_not_numeral:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1870
  \<open>of_int (NOT (numeral k)) = NOT (numeral k)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1871
  by (simp add: local.of_int_not_eq)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1872
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1873
lemma of_int_and_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1874
  \<open>of_int (k AND l) = of_int k AND of_int l\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1875
  by (rule bit_eqI) (simp add: bit_of_int_iff bit_and_iff Bit_Operations.bit_and_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1876
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1877
lemma of_int_or_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1878
  \<open>of_int (k OR l) = of_int k OR of_int l\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1879
  by (rule bit_eqI) (simp add: bit_of_int_iff bit_or_iff Bit_Operations.bit_or_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1880
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1881
lemma of_int_xor_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1882
  \<open>of_int (k XOR l) = of_int k XOR of_int l\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1883
  by (rule bit_eqI) (simp add: bit_of_int_iff bit_xor_iff Bit_Operations.bit_xor_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1884
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1885
lemma of_int_mask_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1886
  \<open>of_int (mask n) = mask n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1887
  by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_int_or_eq)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1888
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1889
end
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  1890
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1891
lemma take_bit_int_less_exp [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1892
  \<open>take_bit n k < 2 ^ n\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1893
  by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1894
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1895
lemma take_bit_int_eq_self_iff:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1896
  \<open>take_bit n k = k \<longleftrightarrow> 0 \<le> k \<and> k < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1897
  for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1898
proof
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1899
  assume ?P
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1900
  moreover note take_bit_int_less_exp [of n k] take_bit_nonnegative [of n k]
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1901
  ultimately show ?Q
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1902
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1903
next
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1904
  assume ?Q
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1905
  then show ?P
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1906
    by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1907
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1908
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1909
lemma take_bit_int_eq_self:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1910
  \<open>take_bit n k = k\<close> if \<open>0 \<le> k\<close> \<open>k < 2 ^ n\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1911
  using that by (simp add: take_bit_int_eq_self_iff)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1912
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1913
lemma mask_nonnegative_int [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1914
  \<open>mask n \<ge> (0::int)\<close>
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  1915
  by (simp add: mask_eq_exp_minus_1 add_le_imp_le_diff)
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1916
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1917
lemma not_mask_negative_int [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1918
  \<open>\<not> mask n < (0::int)\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1919
  by (simp add: not_less)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  1920
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1921
lemma not_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1922
  \<open>NOT k \<ge> 0 \<longleftrightarrow> k < 0\<close> for k :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1923
  by (simp add: not_int_def)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1924
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1925
lemma not_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1926
  \<open>NOT k < 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1927
  by (subst Not_eq_iff [symmetric]) (simp add: not_less not_le)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1928
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1929
lemma and_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1930
  \<open>k AND l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<or> l \<ge> 0\<close> for k l :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1931
proof (induction k arbitrary: l rule: int_bit_induct)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1932
  case zero
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1933
  then show ?case
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1934
    by simp
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1935
next
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1936
  case minus
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1937
  then show ?case
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1938
    by simp
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1939
next
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1940
  case (even k)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1941
  then show ?case
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1942
    using and_int.rec [of \<open>k * 2\<close> l]
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1943
    by (simp add: pos_imp_zdiv_nonneg_iff zero_le_mult_iff)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1944
next
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1945
  case (odd k)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1946
  from odd have \<open>0 \<le> k AND l div 2 \<longleftrightarrow> 0 \<le> k \<or> 0 \<le> l div 2\<close>
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1947
    by simp
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1948
  then have \<open>0 \<le> (1 + k * 2) div 2 AND l div 2 \<longleftrightarrow> 0 \<le> (1 + k * 2) div 2 \<or> 0 \<le> l div 2\<close>
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1949
    by simp
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1950
  with and_int.rec [of \<open>1 + k * 2\<close> l]
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1951
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  1952
    by (auto simp: zero_le_mult_iff not_le)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1953
qed
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1954
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1955
lemma and_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1956
  \<open>k AND l < 0 \<longleftrightarrow> k < 0 \<and> l < 0\<close> for k l :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1957
  by (subst Not_eq_iff [symmetric]) (simp add: not_less)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1958
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1959
lemma and_less_eq:
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1960
  \<open>k AND l \<le> k\<close> if \<open>l < 0\<close> for k l :: int
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1961
using that proof (induction k arbitrary: l rule: int_bit_induct)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1962
  case zero
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1963
  then show ?case
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1964
    by simp
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1965
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1966
  case minus
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1967
  then show ?case
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1968
    by simp
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1969
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1970
  case (even k)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1971
  from even.IH [of \<open>l div 2\<close>] even.hyps even.prems
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1972
  show ?case
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1973
    by (simp add: and_int.rec [of _ l])
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1974
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1975
  case (odd k)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1976
  from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1977
  show ?case
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  1978
    by (simp add: and_int.rec [of _ l])
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1979
qed
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1980
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1981
lemma or_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1982
  \<open>k OR l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<and> l \<ge> 0\<close> for k l :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1983
  by (simp only: or_eq_not_not_and not_nonnegative_int_iff) simp
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1984
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1985
lemma or_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1986
  \<open>k OR l < 0 \<longleftrightarrow> k < 0 \<or> l < 0\<close> for k l :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1987
  by (subst Not_eq_iff [symmetric]) (simp add: not_less)
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  1988
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1989
lemma or_greater_eq:
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1990
  \<open>k OR l \<ge> k\<close> if \<open>l \<ge> 0\<close> for k l :: int
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1991
using that proof (induction k arbitrary: l rule: int_bit_induct)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1992
  case zero
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1993
  then show ?case
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1994
    by simp
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1995
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1996
  case minus
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1997
  then show ?case
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1998
    by simp
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  1999
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2000
  case (even k)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2001
  from even.IH [of \<open>l div 2\<close>] even.hyps even.prems
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2002
  show ?case
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2003
    by (simp add: or_int.rec [of _ l])
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2004
next
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2005
  case (odd k)
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2006
  from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2007
  show ?case
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2008
    by (simp add: or_int.rec [of _ l])
72009
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2009
qed
febdd4eead56 more on single-bit operations
haftmann
parents: 71991
diff changeset
  2010
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2011
lemma xor_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2012
  \<open>k XOR l \<ge> 0 \<longleftrightarrow> (k \<ge> 0 \<longleftrightarrow> l \<ge> 0)\<close> for k l :: int
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2013
  by (simp only: bit.xor_def or_nonnegative_int_iff) auto
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2014
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2015
lemma xor_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2016
  \<open>k XOR l < 0 \<longleftrightarrow> (k < 0) \<noteq> (l < 0)\<close> for k l :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2017
  by (subst Not_eq_iff [symmetric]) (auto simp: not_less)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2018
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2019
lemma OR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2020
  \<open>x OR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2021
using that proof (induction x arbitrary: y n rule: int_bit_induct)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2022
  case zero
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2023
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2024
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2025
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2026
  case minus
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2027
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2028
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2029
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2030
  case (even x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2031
  from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2032
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2033
    by (cases n) (auto simp: or_int.rec [of \<open>_ * 2\<close>] elim: oddE)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2034
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2035
  case (odd x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2036
  from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2037
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2038
    by (cases n) (auto simp: or_int.rec [of \<open>1 + _ * 2\<close>], linarith)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2039
qed
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2040
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2041
lemma XOR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2042
  \<open>x XOR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2043
using that proof (induction x arbitrary: y n rule: int_bit_induct)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2044
  case zero
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2045
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2046
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2047
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2048
  case minus
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2049
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2050
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2051
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2052
  case (even x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2053
  from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2054
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2055
    by (cases n) (auto simp: xor_int.rec [of \<open>_ * 2\<close>] elim: oddE)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2056
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2057
  case (odd x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2058
  from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2059
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2060
    by (cases n) (auto simp: xor_int.rec [of \<open>1 + _ * 2\<close>])
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2061
qed
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2062
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2063
lemma AND_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2064
  \<open>0 \<le> x AND y\<close> if \<open>0 \<le> x\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2065
  using that by simp
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2066
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2067
lemma OR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2068
  \<open>0 \<le> x OR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2069
  using that by simp
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2070
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2071
lemma XOR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2072
  \<open>0 \<le> x XOR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2073
  using that by simp
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2074
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2075
lemma AND_upper1 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2076
  \<open>x AND y \<le> x\<close> if \<open>0 \<le> x\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2077
using that proof (induction x arbitrary: y rule: int_bit_induct)
73535
0f33c7031ec9 new lemmas
haftmann
parents: 72830
diff changeset
  2078
  case (odd k)
0f33c7031ec9 new lemmas
haftmann
parents: 72830
diff changeset
  2079
  then have \<open>k AND y div 2 \<le> k\<close>
0f33c7031ec9 new lemmas
haftmann
parents: 72830
diff changeset
  2080
    by simp
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2081
  then show ?case
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2082
    by (simp add: and_int.rec [of \<open>1 + _ * 2\<close>])
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2083
qed (simp_all add: and_int.rec [of \<open>_ * 2\<close>])
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2084
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2085
lemma AND_upper1' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2086
  \<open>y AND x \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y z :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2087
  using _ \<open>y \<le> z\<close> by (rule order_trans) (use \<open>0 \<le> y\<close> in simp)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2088
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2089
lemma AND_upper1'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2090
  \<open>y AND x < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y z :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2091
  using _ \<open>y < z\<close> by (rule order_le_less_trans) (use \<open>0 \<le> y\<close> in simp)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2092
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2093
lemma AND_upper2 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2094
  \<open>x AND y \<le> y\<close> if \<open>0 \<le> y\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2095
  using that AND_upper1 [of y x] by (simp add: ac_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2096
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2097
lemma AND_upper2' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2098
  \<open>x AND y \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2099
  using that AND_upper1' [of y z x] by (simp add: ac_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2100
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2101
lemma AND_upper2'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2102
  \<open>x AND y < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y :: int
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2103
  using that AND_upper1'' [of y z x] by (simp add: ac_simps)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2104
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2105
lemma plus_and_or:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2106
  \<open>(x AND y) + (x OR y) = x + y\<close> for x y :: int
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2107
proof (induction x arbitrary: y rule: int_bit_induct)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2108
  case zero
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2109
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2110
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2111
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2112
  case minus
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2113
  then show ?case
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2114
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2115
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2116
  case (even x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2117
  from even.IH [of \<open>y div 2\<close>]
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2118
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2119
    by (auto simp: and_int.rec [of _ y] or_int.rec [of _ y] elim: oddE)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2120
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2121
  case (odd x)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2122
  from odd.IH [of \<open>y div 2\<close>]
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2123
  show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2124
    by (auto simp: and_int.rec [of _ y] or_int.rec [of _ y] elim: oddE)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2125
qed
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  2126
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2127
lemma push_bit_minus_one:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2128
  \<open>push_bit n (- 1 :: int) = - (2 ^ n)\<close>
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2129
  by (simp add: push_bit_eq_mult)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2130
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2131
lemma minus_1_div_exp_eq_int:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2132
  \<open>- 1 div (2 :: int) ^ n = - 1\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2133
  by (induction n) (use div_exp_eq [symmetric, of \<open>- 1 :: int\<close> 1] in \<open>simp_all add: ac_simps\<close>)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2134
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2135
lemma drop_bit_minus_one [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2136
  \<open>drop_bit n (- 1 :: int) = - 1\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2137
  by (simp add: drop_bit_eq_div minus_1_div_exp_eq_int)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2138
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2139
lemma take_bit_minus:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2140
  \<open>take_bit n (- take_bit n k) = take_bit n (- k)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2141
    for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2142
  by (simp add: take_bit_eq_mod mod_minus_eq)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2143
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2144
lemma take_bit_diff:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2145
  \<open>take_bit n (take_bit n k - take_bit n l) = take_bit n (k - l)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2146
    for k l :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2147
  by (simp add: take_bit_eq_mod mod_diff_eq)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2148
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2149
lemma (in ring_1) of_nat_nat_take_bit_eq [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2150
  \<open>of_nat (nat (take_bit n k)) = of_int (take_bit n k)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2151
  by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2152
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2153
lemma take_bit_minus_small_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2154
  \<open>take_bit n (- k) = 2 ^ n - k\<close> if \<open>0 < k\<close> \<open>k \<le> 2 ^ n\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2155
proof -
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2156
  define m where \<open>m = nat k\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2157
  with that have \<open>k = int m\<close> and \<open>0 < m\<close> and \<open>m \<le> 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2158
    by simp_all
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2159
  have \<open>(2 ^ n - m) mod 2 ^ n = 2 ^ n - m\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2160
    using \<open>0 < m\<close> by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2161
  then have \<open>int ((2 ^ n - m) mod 2 ^ n) = int (2 ^ n - m)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2162
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2163
  then have \<open>(2 ^ n - int m) mod 2 ^ n = 2 ^ n - int m\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2164
    using \<open>m \<le> 2 ^ n\<close> by (simp only: of_nat_mod of_nat_diff) simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2165
  with \<open>k = int m\<close> have \<open>(2 ^ n - k) mod 2 ^ n = 2 ^ n - k\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2166
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2167
  then show ?thesis
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2168
    by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2169
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2170
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2171
lemma push_bit_nonnegative_int_iff [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2172
  \<open>push_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2173
  by (simp add: push_bit_eq_mult zero_le_mult_iff power_le_zero_eq)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2174
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2175
lemma push_bit_negative_int_iff [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2176
  \<open>push_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2177
  by (subst Not_eq_iff [symmetric]) (simp add: not_less)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2178
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2179
lemma drop_bit_nonnegative_int_iff [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2180
  \<open>drop_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2181
  by (induction n) (auto simp: drop_bit_Suc drop_bit_half)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2182
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2183
lemma drop_bit_negative_int_iff [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2184
  \<open>drop_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2185
  by (subst Not_eq_iff [symmetric]) (simp add: not_less)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2186
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2187
lemma set_bit_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2188
  \<open>set_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2189
  by (simp add: set_bit_eq_or)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2190
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2191
lemma set_bit_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2192
  \<open>set_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2193
  by (simp add: set_bit_eq_or)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2194
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2195
lemma unset_bit_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2196
  \<open>unset_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2197
  by (simp add: unset_bit_eq_and_not)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2198
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2199
lemma unset_bit_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2200
  \<open>unset_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2201
  by (simp add: unset_bit_eq_and_not)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2202
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2203
lemma flip_bit_nonnegative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2204
  \<open>flip_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2205
  by (simp add: flip_bit_eq_xor)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2206
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2207
lemma flip_bit_negative_int_iff [simp]:
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2208
  \<open>flip_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2209
  by (simp add: flip_bit_eq_xor)
71802
ab3cecb836b5 more rules
haftmann
parents: 71800
diff changeset
  2210
71986
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2211
lemma set_bit_greater_eq:
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2212
  \<open>set_bit n k \<ge> k\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2213
  by (simp add: set_bit_eq_or or_greater_eq)
71986
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2214
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2215
lemma unset_bit_less_eq:
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2216
  \<open>unset_bit n k \<le> k\<close> for k :: int
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2217
  by (simp add: unset_bit_eq_and_not and_less_eq)
71986
76193dd4aec8 factored out ancient numeral representation
haftmann
parents: 71965
diff changeset
  2218
75651
f4116b7a6679 Move code lemmas for symbolic computation of bit operations on int to distribution.
haftmann
parents: 75138
diff changeset
  2219
lemma and_int_unfold:
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2220
  \<open>k AND l = (if k = 0 \<or> l = 0 then 0 else if k = - 1 then l else if l = - 1 then k
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2221
    else (k mod 2) * (l mod 2) + 2 * ((k div 2) AND (l div 2)))\<close> for k l :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2222
  by (auto simp: and_int.rec [of k l] zmult_eq_1_iff elim: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2223
75651
f4116b7a6679 Move code lemmas for symbolic computation of bit operations on int to distribution.
haftmann
parents: 75138
diff changeset
  2224
lemma or_int_unfold:
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2225
  \<open>k OR l = (if k = - 1 \<or> l = - 1 then - 1 else if k = 0 then l else if l = 0 then k
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2226
    else max (k mod 2) (l mod 2) + 2 * ((k div 2) OR (l div 2)))\<close> for k l :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2227
  by (auto simp: or_int.rec [of k l] elim: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2228
75651
f4116b7a6679 Move code lemmas for symbolic computation of bit operations on int to distribution.
haftmann
parents: 75138
diff changeset
  2229
lemma xor_int_unfold:
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2230
  \<open>k XOR l = (if k = - 1 then NOT l else if l = - 1 then NOT k else if k = 0 then l else if l = 0 then k
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2231
    else \<bar>k mod 2 - l mod 2\<bar> + 2 * ((k div 2) XOR (l div 2)))\<close> for k l :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2232
  by (auto simp: xor_int.rec [of k l] not_int_def elim!: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2233
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2234
lemma bit_minus_int_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2235
  \<open>bit (- k) n \<longleftrightarrow> bit (NOT (k - 1)) n\<close> for k :: int
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2236
  by (simp add: bit_simps)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2237
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2238
lemma take_bit_incr_eq:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2239
  \<open>take_bit n (k + 1) = 1 + take_bit n k\<close> if \<open>take_bit n k \<noteq> 2 ^ n - 1\<close> for k :: int
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2240
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2241
  from that have \<open>2 ^ n \<noteq> k mod 2 ^ n + 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2242
    by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2243
  moreover have \<open>k mod 2 ^ n < 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2244
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2245
  ultimately have *: \<open>k mod 2 ^ n + 1 < 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2246
    by linarith
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2247
  have \<open>(k + 1) mod 2 ^ n = (k mod 2 ^ n + 1) mod 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2248
    by (simp add: mod_simps)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2249
  also have \<open>\<dots> = k mod 2 ^ n + 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2250
    using * by (simp add: zmod_trivial_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2251
  finally have \<open>(k + 1) mod 2 ^ n = k mod 2 ^ n + 1\<close> .
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2252
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2253
    by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2254
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2255
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2256
lemma take_bit_decr_eq:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2257
  \<open>take_bit n (k - 1) = take_bit n k - 1\<close> if \<open>take_bit n k \<noteq> 0\<close> for k :: int
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2258
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2259
  from that have \<open>k mod 2 ^ n \<noteq> 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2260
    by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2261
  moreover have \<open>k mod 2 ^ n \<ge> 0\<close> \<open>k mod 2 ^ n < 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2262
    by simp_all
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2263
  ultimately have *: \<open>k mod 2 ^ n > 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2264
    by linarith
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2265
  have \<open>(k - 1) mod 2 ^ n = (k mod 2 ^ n - 1) mod 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2266
    by (simp add: mod_simps)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2267
  also have \<open>\<dots> = k mod 2 ^ n - 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2268
    by (simp add: zmod_trivial_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2269
      (use \<open>k mod 2 ^ n < 2 ^ n\<close> * in linarith)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2270
  finally have \<open>(k - 1) mod 2 ^ n = k mod 2 ^ n - 1\<close> .
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2271
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2272
    by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2273
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2274
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2275
lemma take_bit_int_greater_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2276
  \<open>k + 2 ^ n \<le> take_bit n k\<close> if \<open>k < 0\<close> for k :: int
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2277
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2278
  have \<open>k + 2 ^ n \<le> take_bit n (k + 2 ^ n)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2279
  proof (cases \<open>k > - (2 ^ n)\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2280
    case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2281
    then have \<open>k + 2 ^ n \<le> 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2282
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2283
    also note take_bit_nonnegative
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2284
    finally show ?thesis .
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2285
  next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2286
    case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2287
    with that have \<open>0 \<le> k + 2 ^ n\<close> and \<open>k + 2 ^ n < 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2288
      by simp_all
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2289
    then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2290
      by (simp only: take_bit_eq_mod mod_pos_pos_trivial)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2291
  qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2292
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2293
    by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2294
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2295
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2296
lemma take_bit_int_less_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2297
  \<open>take_bit n k \<le> k - 2 ^ n\<close> if \<open>2 ^ n \<le> k\<close> and \<open>n > 0\<close> for k :: int
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2298
  using that zmod_le_nonneg_dividend [of \<open>k - 2 ^ n\<close> \<open>2 ^ n\<close>]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2299
  by (simp add: take_bit_eq_mod)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2300
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2301
lemma take_bit_int_less_eq_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2302
  \<open>take_bit n k \<le> k \<longleftrightarrow> 0 \<le> k\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for k :: int
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2303
proof
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2304
  assume ?P
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2305
  show ?Q
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2306
  proof (rule ccontr)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2307
    assume \<open>\<not> 0 \<le> k\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2308
    then have \<open>k < 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2309
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2310
    with \<open>?P\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2311
    have \<open>take_bit n k < 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2312
      by (rule le_less_trans)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2313
    then show False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2314
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2315
  qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2316
next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2317
  assume ?Q
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2318
  then show ?P
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2319
    by (simp add: take_bit_eq_mod zmod_le_nonneg_dividend)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2320
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2321
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2322
lemma take_bit_int_less_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2323
  \<open>take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close> for k :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2324
  by (auto simp: less_le take_bit_int_less_eq_self_iff take_bit_int_eq_self_iff
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2325
    intro: order_trans [of 0 \<open>2 ^ n\<close> k])
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2326
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2327
lemma take_bit_int_greater_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2328
  \<open>k < take_bit n k \<longleftrightarrow> k < 0\<close> for k :: int
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2329
  using take_bit_int_less_eq_self_iff [of n k] by auto
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2330
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2331
lemma take_bit_int_greater_eq_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2332
  \<open>k \<le> take_bit n k \<longleftrightarrow> k < 2 ^ n\<close> for k :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2333
  by (auto simp: le_less take_bit_int_greater_self_iff take_bit_int_eq_self_iff
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2334
    dest: sym not_sym intro: less_trans [of k 0 \<open>2 ^ n\<close>])
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2335
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2336
lemma take_bit_tightened_less_eq_int:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2337
  \<open>take_bit m k \<le> take_bit n k\<close> if \<open>m \<le> n\<close> for k :: int
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2338
proof -
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2339
  have \<open>take_bit m (take_bit n k) \<le> take_bit n k\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2340
    by (simp only: take_bit_int_less_eq_self_iff take_bit_nonnegative)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2341
  with that show ?thesis
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2342
    by simp
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2343
qed
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2344
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2345
lemma not_exp_less_eq_0_int [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2346
  \<open>\<not> 2 ^ n \<le> (0::int)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2347
  by (simp add: power_le_zero_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2348
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2349
lemma int_bit_bound:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2350
  fixes k :: int
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2351
  obtains n where \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2352
    and \<open>n > 0 \<Longrightarrow> bit k (n - 1) \<noteq> bit k n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2353
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2354
  obtain q where *: \<open>\<And>m. q \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2355
  proof (cases \<open>k \<ge> 0\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2356
    case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2357
    moreover from power_gt_expt [of 2 \<open>nat k\<close>]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2358
    have \<open>nat k < 2 ^ nat k\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2359
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2360
    then have \<open>int (nat k) < int (2 ^ nat k)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2361
      by (simp only: of_nat_less_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2362
    ultimately have *: \<open>k div 2 ^ nat k = 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2363
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2364
    show thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2365
    proof (rule that [of \<open>nat k\<close>])
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2366
      fix m
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2367
      assume \<open>nat k \<le> m\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2368
      then show \<open>bit k m \<longleftrightarrow> bit k (nat k)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2369
        by (auto simp: * bit_iff_odd power_add zdiv_zmult2_eq dest!: le_Suc_ex)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2370
    qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2371
  next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2372
    case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2373
    moreover from power_gt_expt [of 2 \<open>nat (- k)\<close>]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2374
    have \<open>nat (- k) < 2 ^ nat (- k)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2375
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2376
    then have \<open>int (nat (- k)) < int (2 ^ nat (- k))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2377
      by (simp only: of_nat_less_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2378
    ultimately have \<open>- k div - (2 ^ nat (- k)) = - 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2379
      by (subst div_pos_neg_trivial) simp_all
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2380
    then have *: \<open>k div 2 ^ nat (- k) = - 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2381
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2382
    show thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2383
    proof (rule that [of \<open>nat (- k)\<close>])
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2384
      fix m
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2385
      assume \<open>nat (- k) \<le> m\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2386
      then show \<open>bit k m \<longleftrightarrow> bit k (nat (- k))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2387
        by (auto simp: * bit_iff_odd power_add zdiv_zmult2_eq minus_1_div_exp_eq_int dest!: le_Suc_ex)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2388
    qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2389
  qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2390
  show thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2391
  proof (cases \<open>\<forall>m. bit k m \<longleftrightarrow> bit k q\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2392
    case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2393
    then have \<open>bit k 0 \<longleftrightarrow> bit k q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2394
      by blast
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2395
    with True that [of 0] show thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2396
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2397
  next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2398
    case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2399
    then obtain r where **: \<open>bit k r \<noteq> bit k q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2400
      by blast
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2401
    have \<open>r < q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2402
      by (rule ccontr) (use * [of r] ** in simp)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2403
    define N where \<open>N = {n. n < q \<and> bit k n \<noteq> bit k q}\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2404
    moreover have \<open>finite N\<close> \<open>r \<in> N\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2405
      using ** N_def \<open>r < q\<close> by auto
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2406
    moreover define n where \<open>n = Suc (Max N)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2407
    ultimately have \<dagger>: \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2408
      by (smt (verit) "*" Max_ge Suc_n_not_le_n linorder_not_less mem_Collect_eq not_less_eq_eq)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2409
    have \<open>bit k (Max N) \<noteq> bit k n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2410
      by (metis (mono_tags, lifting) "*" Max_in N_def \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m = bit k n\<close> \<open>finite N\<close> \<open>r \<in> N\<close> empty_iff le_cases mem_Collect_eq)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2411
    with \<dagger> n_def that [of n] show thesis
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2412
      by fastforce
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2413
  qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2414
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2415
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2416
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2417
subsection \<open>Instance \<^typ>\<open>nat\<close>\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2418
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2419
instantiation nat :: semiring_bit_operations
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2420
begin
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2421
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2422
definition and_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2423
  where \<open>m AND n = nat (int m AND int n)\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2424
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2425
definition or_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2426
  where \<open>m OR n = nat (int m OR int n)\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2427
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2428
definition xor_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2429
  where \<open>m XOR n = nat (int m XOR int n)\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2430
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2431
definition mask_nat :: \<open>nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2432
  where \<open>mask n = (2 :: nat) ^ n - 1\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2433
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2434
definition push_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2435
  where \<open>push_bit_nat n m = m * 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2436
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2437
definition drop_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2438
  where \<open>drop_bit_nat n m = m div 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2439
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2440
definition take_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2441
  where \<open>take_bit_nat n m = m mod 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2442
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2443
definition set_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2444
  where \<open>set_bit m n = n OR push_bit m 1\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2445
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2446
definition unset_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  2447
  where \<open>unset_bit m n = (n OR push_bit m 1) XOR push_bit m 1\<close> for m n :: nat
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2448
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2449
definition flip_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2450
  where \<open>flip_bit m n = n XOR push_bit m 1\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2451
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2452
instance proof
79031
4596a14d9a95 slightly more elementary characterization of unset_bit
haftmann
parents: 79030
diff changeset
  2453
  fix m n :: nat
79008
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2454
  show \<open>m AND n = of_bool (odd m \<and> odd n) + 2 * (m div 2 AND n div 2)\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2455
    by (simp add: and_nat_def and_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2456
  show \<open>m OR n = of_bool (odd m \<or> odd n) + 2 * (m div 2 OR n div 2)\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2457
    by (simp add: or_nat_def or_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2458
  show \<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * (m div 2 XOR n div 2)\<close>
74a4776f7a22 operations AND, OR, XOR are specified by characteristic recursive equation
haftmann
parents: 78955
diff changeset
  2459
    by (simp add: xor_nat_def xor_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
79489
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  2460
qed (simp_all add: mask_nat_def set_bit_nat_def unset_bit_nat_def flip_bit_nat_def
1e19abf373ac streamlined type class specification
haftmann
parents: 79488
diff changeset
  2461
  push_bit_nat_def drop_bit_nat_def take_bit_nat_def)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2462
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2463
end
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2464
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2465
instance nat :: linordered_euclidean_semiring_bit_operations ..
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2466
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2467
context semiring_bit_operations
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2468
begin
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2469
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2470
lemma push_bit_of_nat:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2471
  \<open>push_bit n (of_nat m) = of_nat (push_bit n m)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2472
  by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2473
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2474
lemma of_nat_push_bit:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2475
  \<open>of_nat (push_bit m n) = push_bit m (of_nat n)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2476
  by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2477
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2478
lemma take_bit_of_nat:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2479
  \<open>take_bit n (of_nat m) = of_nat (take_bit n m)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2480
  by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_nat_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2481
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2482
lemma of_nat_take_bit:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2483
  \<open>of_nat (take_bit n m) = take_bit n (of_nat m)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2484
  by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_nat_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2485
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2486
lemma of_nat_and_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2487
  \<open>of_nat (m AND n) = of_nat m AND of_nat n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2488
  by (rule bit_eqI) (simp add: bit_of_nat_iff bit_and_iff Bit_Operations.bit_and_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2489
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2490
lemma of_nat_or_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2491
  \<open>of_nat (m OR n) = of_nat m OR of_nat n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2492
  by (rule bit_eqI) (simp add: bit_of_nat_iff bit_or_iff Bit_Operations.bit_or_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2493
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2494
lemma of_nat_xor_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2495
  \<open>of_nat (m XOR n) = of_nat m XOR of_nat n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2496
  by (rule bit_eqI) (simp add: bit_of_nat_iff bit_xor_iff Bit_Operations.bit_xor_iff)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2497
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2498
lemma of_nat_mask_eq:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2499
  \<open>of_nat (mask n) = mask n\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2500
  by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_nat_or_eq)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2501
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2502
end
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2503
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2504
context linordered_euclidean_semiring_bit_operations
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2505
begin
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2506
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2507
lemma drop_bit_of_nat:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2508
  "drop_bit n (of_nat m) = of_nat (drop_bit n m)"
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2509
  by (simp add: drop_bit_eq_div Bit_Operations.drop_bit_eq_div of_nat_div [of m "2 ^ n"])
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2510
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2511
lemma of_nat_drop_bit:
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2512
  \<open>of_nat (drop_bit m n) = drop_bit m (of_nat n)\<close>
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2513
  by (simp add: drop_bit_eq_div Bit_Operations.drop_bit_eq_div of_nat_div)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2514
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2515
end
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  2516
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2517
lemma take_bit_nat_less_exp [simp]:
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2518
  \<open>take_bit n m < 2 ^ n\<close> for n m :: nat
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2519
  by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2520
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2521
lemma take_bit_nat_eq_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2522
  \<open>take_bit n m = m \<longleftrightarrow> m < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for n m :: nat
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2523
proof
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2524
  assume ?P
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2525
  moreover note take_bit_nat_less_exp [of n m]
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2526
  ultimately show ?Q
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2527
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2528
next
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2529
  assume ?Q
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2530
  then show ?P
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2531
    by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2532
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2533
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2534
lemma take_bit_nat_eq_self:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2535
  \<open>take_bit n m = m\<close> if \<open>m < 2 ^ n\<close> for m n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2536
  using that by (simp add: take_bit_nat_eq_self_iff)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2537
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2538
lemma take_bit_nat_less_eq_self [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2539
  \<open>take_bit n m \<le> m\<close> for n m :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2540
  by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2541
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2542
lemma take_bit_nat_less_self_iff:
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2543
  \<open>take_bit n m < m \<longleftrightarrow> 2 ^ n \<le> m\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for m n :: nat
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2544
proof
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2545
  assume ?P
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2546
  then have \<open>take_bit n m \<noteq> m\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2547
    by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2548
  then show \<open>?Q\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2549
    by (simp add: take_bit_nat_eq_self_iff)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2550
next
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2551
  have \<open>take_bit n m < 2 ^ n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2552
    by (fact take_bit_nat_less_exp)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2553
  also assume ?Q
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2554
  finally show ?P .
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2555
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2556
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2557
lemma Suc_0_and_eq [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2558
  \<open>Suc 0 AND n = n mod 2\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2559
  using one_and_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2560
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2561
lemma and_Suc_0_eq [simp]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2562
  \<open>n AND Suc 0 = n mod 2\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2563
  using and_one_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2564
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2565
lemma Suc_0_or_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2566
  \<open>Suc 0 OR n = n + of_bool (even n)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2567
  using one_or_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2568
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2569
lemma or_Suc_0_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2570
  \<open>n OR Suc 0 = n + of_bool (even n)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2571
  using or_one_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2572
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2573
lemma Suc_0_xor_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2574
  \<open>Suc 0 XOR n = n + of_bool (even n) - of_bool (odd n)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2575
  using one_xor_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2576
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2577
lemma xor_Suc_0_eq:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2578
  \<open>n XOR Suc 0 = n + of_bool (even n) - of_bool (odd n)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2579
  using xor_one_eq [of n] by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2580
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2581
lemma and_nat_unfold [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2582
  \<open>m AND n = (if m = 0 \<or> n = 0 then 0 else (m mod 2) * (n mod 2) + 2 * ((m div 2) AND (n div 2)))\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2583
    for m n :: nat
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2584
  by (auto simp: and_rec [of m n] elim: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2585
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2586
lemma or_nat_unfold [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2587
  \<open>m OR n = (if m = 0 then n else if n = 0 then m
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2588
    else max (m mod 2) (n mod 2) + 2 * ((m div 2) OR (n div 2)))\<close> for m n :: nat
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2589
  by (auto simp: or_rec [of m n] elim: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2590
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2591
lemma xor_nat_unfold [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2592
  \<open>m XOR n = (if m = 0 then n else if n = 0 then m
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2593
    else (m mod 2 + n mod 2) mod 2 + 2 * ((m div 2) XOR (n div 2)))\<close> for m n :: nat
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2594
  by (auto simp: xor_rec [of m n] elim!: oddE)
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2595
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2596
lemma [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2597
  \<open>unset_bit 0 m = 2 * (m div 2)\<close>
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2598
  \<open>unset_bit (Suc n) m = m mod 2 + 2 * unset_bit n (m div 2)\<close> for m n :: nat
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2599
  by (simp_all add: unset_bit_Suc)
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2600
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2601
lemma push_bit_of_Suc_0 [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2602
  \<open>push_bit n (Suc 0) = 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2603
  using push_bit_of_1 [where ?'a = nat] by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2604
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2605
lemma take_bit_of_Suc_0 [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2606
  \<open>take_bit n (Suc 0) = of_bool (0 < n)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2607
  using take_bit_of_1 [where ?'a = nat] by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2608
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2609
lemma drop_bit_of_Suc_0 [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2610
  \<open>drop_bit n (Suc 0) = of_bool (n = 0)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2611
  using drop_bit_of_1 [where ?'a = nat] by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2612
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2613
lemma Suc_mask_eq_exp:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2614
  \<open>Suc (mask n) = 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2615
  by (simp add: mask_eq_exp_minus_1)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2616
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2617
lemma less_eq_mask:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2618
  \<open>n \<le> mask n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2619
  by (simp add: mask_eq_exp_minus_1 le_diff_conv2)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2620
    (metis Suc_mask_eq_exp diff_Suc_1 diff_le_diff_pow diff_zero le_refl not_less_eq_eq power_0)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2621
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2622
lemma less_mask:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2623
  \<open>n < mask n\<close> if \<open>Suc 0 < n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2624
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2625
  define m where \<open>m = n - 2\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2626
  with that have *: \<open>n = m + 2\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2627
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2628
  have \<open>Suc (Suc (Suc m)) < 4 * 2 ^ m\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2629
    by (induction m) simp_all
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2630
  then have \<open>Suc (m + 2) < Suc (mask (m + 2))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2631
    by (simp add: Suc_mask_eq_exp)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2632
  then have \<open>m + 2 < mask (m + 2)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2633
    by (simp add: less_le)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2634
  with * show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2635
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2636
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2637
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2638
lemma mask_nat_less_exp [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2639
  \<open>(mask n :: nat) < 2 ^ n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2640
  by (simp add: mask_eq_exp_minus_1)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2641
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2642
lemma mask_nat_positive_iff [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2643
  \<open>(0::nat) < mask n \<longleftrightarrow> 0 < n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2644
proof (cases \<open>n = 0\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2645
  case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2646
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2647
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2648
next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2649
  case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2650
  then have \<open>0 < n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2651
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2652
  then have \<open>(0::nat) < mask n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2653
    using less_eq_mask [of n] by (rule order_less_le_trans)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2654
  with \<open>0 < n\<close> show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2655
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2656
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2657
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2658
lemma take_bit_tightened_less_eq_nat:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2659
  \<open>take_bit m q \<le> take_bit n q\<close> if \<open>m \<le> n\<close> for q :: nat
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2660
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2661
  have \<open>take_bit m (take_bit n q) \<le> take_bit n q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2662
    by (rule take_bit_nat_less_eq_self)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2663
  with that show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2664
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2665
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2666
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2667
lemma push_bit_nat_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2668
  \<open>push_bit n (nat k) = nat (push_bit n k)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2669
  by (cases \<open>k \<ge> 0\<close>) (simp_all add: push_bit_eq_mult nat_mult_distrib not_le mult_nonneg_nonpos2)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2670
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2671
lemma drop_bit_nat_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2672
  \<open>drop_bit n (nat k) = nat (drop_bit n k)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2673
proof (cases \<open>k \<ge> 0\<close>)
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2674
  case True
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2675
  then show ?thesis
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2676
    by (metis drop_bit_of_nat int_nat_eq nat_int) 
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2677
qed (simp add: nat_eq_iff2)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2678
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2679
lemma take_bit_nat_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2680
  \<open>take_bit n (nat k) = nat (take_bit n k)\<close> if \<open>k \<ge> 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2681
  using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2682
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2683
lemma nat_take_bit_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2684
  \<open>nat (take_bit n k) = take_bit n (nat k)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2685
  if \<open>k \<ge> 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2686
  using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2687
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2688
lemma nat_mask_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2689
  \<open>nat (mask n) = mask n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2690
  by (simp add: nat_eq_iff of_nat_mask_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2691
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  2692
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2693
subsection \<open>Symbolic computations on numeral expressions\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2694
75138
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2695
context semiring_bits
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2696
begin
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2697
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2698
lemma not_bit_numeral_Bit0_0 [simp]:
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2699
  \<open>\<not> bit (numeral (Num.Bit0 m)) 0\<close>
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2700
  by (simp add: bit_0)
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2701
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2702
lemma bit_numeral_Bit1_0 [simp]:
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2703
  \<open>bit (numeral (Num.Bit1 m)) 0\<close>
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2704
  by (simp add: bit_0)
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2705
79590
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2706
lemma bit_numeral_Bit0_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2707
  \<open>bit (numeral (num.Bit0 m)) n
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2708
    \<longleftrightarrow> possible_bit TYPE('a) n \<and> n > 0 \<and> bit (numeral m) (n - 1)\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2709
  by (simp only: numeral_Bit0_eq_double [of m] bit_simps) simp
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2710
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2711
lemma bit_numeral_Bit1_Suc_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2712
  \<open>bit (numeral (num.Bit1 m)) (Suc n)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2713
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit (numeral m) n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2714
  using even_bit_succ_iff [of \<open>2 * numeral m\<close> \<open>Suc n\<close>]
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2715
  by (simp only: numeral_Bit1_eq_inc_double [of m] bit_simps) simp
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2716
75138
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2717
end
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2718
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2719
context ring_bit_operations
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2720
begin
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2721
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2722
lemma not_bit_minus_numeral_Bit0_0 [simp]:
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2723
  \<open>\<not> bit (- numeral (Num.Bit0 m)) 0\<close>
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2724
  by (simp add: bit_0)
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2725
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2726
lemma bit_minus_numeral_Bit1_0 [simp]:
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2727
  \<open>bit (- numeral (Num.Bit1 m)) 0\<close>
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2728
  by (simp add: bit_0)
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2729
79590
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2730
lemma bit_minus_numeral_Bit0_Suc_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2731
  \<open>bit (- numeral (num.Bit0 m)) (Suc n)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2732
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit (- numeral m) n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2733
  by (simp only: numeral_Bit0_eq_double [of m] minus_mult_right bit_simps) auto
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2734
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2735
lemma bit_minus_numeral_Bit1_Suc_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2736
  \<open>bit (- numeral (num.Bit1 m)) (Suc n)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2737
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> \<not> bit (numeral m) n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2738
  by (simp only: numeral_Bit1_eq_inc_double [of m] minus_add_distrib minus_mult_right add_uminus_conv_diff
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2739
    bit_decr_iff bit_double_iff)
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2740
    auto
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2741
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2742
lemma bit_numeral_BitM_0 [simp]:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2743
  \<open>bit (numeral (Num.BitM m)) 0\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2744
  by (simp only: numeral_BitM bit_decr_iff not_bit_minus_numeral_Bit0_0) simp
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2745
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2746
lemma bit_numeral_BitM_Suc_iff:
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2747
  \<open>bit (numeral (Num.BitM m)) (Suc n) \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> \<not> bit (- numeral m) n\<close>
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2748
  by (simp_all only: numeral_BitM bit_decr_iff bit_minus_numeral_Bit0_Suc_iff) auto
b14c4cb37d99 more lemmas
haftmann
parents: 79588
diff changeset
  2749
75138
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2750
end
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2751
78955
74147aa81dbb more specific name for type class
haftmann
parents: 78937
diff changeset
  2752
context linordered_euclidean_semiring_bit_operations
75138
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2753
begin
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2754
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2755
lemma bit_numeral_iff:
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2756
  \<open>bit (numeral m) n \<longleftrightarrow> bit (numeral m :: nat) n\<close>
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2757
  using bit_of_nat_iff_bit [of \<open>numeral m\<close> n] by simp
cd77ffb01e15 simp rules for negative numerals
haftmann
parents: 75086
diff changeset
  2758
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2759
lemma bit_numeral_Bit0_Suc_iff [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2760
  \<open>bit (numeral (Num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2761
  by (simp add: bit_Suc numeral_Bit0_div_2)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2762
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2763
lemma bit_numeral_Bit1_Suc_iff [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2764
  \<open>bit (numeral (Num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2765
  by (simp add: bit_Suc numeral_Bit1_div_2)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2766
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2767
lemma bit_numeral_rec:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2768
  \<open>bit (numeral (Num.Bit0 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> False | Suc m \<Rightarrow> bit (numeral w) m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2769
  \<open>bit (numeral (Num.Bit1 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> True | Suc m \<Rightarrow> bit (numeral w) m)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2770
  by (cases n; simp add: bit_0)+
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2771
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2772
lemma bit_numeral_simps [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2773
  \<open>\<not> bit 1 (numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2774
  \<open>bit (numeral (Num.Bit0 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2775
  \<open>bit (numeral (Num.Bit1 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2776
  by (simp_all add: bit_1_iff numeral_eq_Suc)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2777
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2778
lemma and_numerals [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2779
  \<open>1 AND numeral (Num.Bit0 y) = 0\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2780
  \<open>1 AND numeral (Num.Bit1 y) = 1\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2781
  \<open>numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2782
  \<open>numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = 2 * (numeral x AND numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2783
  \<open>numeral (Num.Bit0 x) AND 1 = 0\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2784
  \<open>numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2785
  \<open>numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = 1 + 2 * (numeral x AND numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2786
  \<open>numeral (Num.Bit1 x) AND 1 = 1\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2787
  by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2788
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2789
lemma or_numerals [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2790
  \<open>1 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2791
  \<open>1 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2792
  \<open>numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = 2 * (numeral x OR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2793
  \<open>numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2794
  \<open>numeral (Num.Bit0 x) OR 1 = numeral (Num.Bit1 x)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2795
  \<open>numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = 1 + 2 * (numeral x OR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2796
  \<open>numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2797
  \<open>numeral (Num.Bit1 x) OR 1 = numeral (Num.Bit1 x)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2798
  by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2799
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2800
lemma xor_numerals [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2801
  \<open>1 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2802
  \<open>1 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2803
  \<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = 2 * (numeral x XOR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2804
  \<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = 1 + 2 * (numeral x XOR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2805
  \<open>numeral (Num.Bit0 x) XOR 1 = numeral (Num.Bit1 x)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2806
  \<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = 1 + 2 * (numeral x XOR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2807
  \<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = 2 * (numeral x XOR numeral y)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2808
  \<open>numeral (Num.Bit1 x) XOR 1 = numeral (Num.Bit0 x)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  2809
  by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2810
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2811
end
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2812
79017
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2813
lemma drop_bit_Suc_minus_bit0 [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2814
  \<open>drop_bit (Suc n) (- numeral (Num.Bit0 k)) = drop_bit n (- numeral k :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2815
  by (simp add: drop_bit_Suc numeral_Bit0_div_2)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2816
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2817
lemma drop_bit_Suc_minus_bit1 [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2818
  \<open>drop_bit (Suc n) (- numeral (Num.Bit1 k)) = drop_bit n (- numeral (Num.inc k) :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2819
  by (simp add: drop_bit_Suc numeral_Bit1_div_2 add_One)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2820
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2821
lemma drop_bit_numeral_minus_bit0 [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2822
  \<open>drop_bit (numeral l) (- numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (- numeral k :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2823
  by (simp add: numeral_eq_Suc numeral_Bit0_div_2)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2824
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2825
lemma drop_bit_numeral_minus_bit1 [simp]:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2826
  \<open>drop_bit (numeral l) (- numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (- numeral (Num.inc k) :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2827
  by (simp add: numeral_eq_Suc numeral_Bit1_div_2)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2828
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2829
lemma take_bit_Suc_minus_bit0:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2830
  \<open>take_bit (Suc n) (- numeral (Num.Bit0 k)) = take_bit n (- numeral k) * (2 :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2831
  by (simp add: take_bit_Suc numeral_Bit0_div_2)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2832
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2833
lemma take_bit_Suc_minus_bit1:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2834
  \<open>take_bit (Suc n) (- numeral (Num.Bit1 k)) = take_bit n (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2835
  by (simp add: take_bit_Suc numeral_Bit1_div_2 add_One)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2836
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2837
lemma take_bit_numeral_minus_bit0:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2838
  \<open>take_bit (numeral l) (- numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2839
  by (simp add: numeral_eq_Suc numeral_Bit0_div_2 take_bit_Suc_minus_bit0)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2840
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2841
lemma take_bit_numeral_minus_bit1:
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2842
  \<open>take_bit (numeral l) (- numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2843
  by (simp add: numeral_eq_Suc numeral_Bit1_div_2 take_bit_Suc_minus_bit1)
127ba61b2630 modernized, reordered, generalized
haftmann
parents: 79008
diff changeset
  2844
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2845
lemma and_nat_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2846
  \<open>Suc 0 AND numeral (Num.Bit0 y) = 0\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2847
  \<open>Suc 0 AND numeral (Num.Bit1 y) = 1\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2848
  \<open>numeral (Num.Bit0 x) AND Suc 0 = 0\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2849
  \<open>numeral (Num.Bit1 x) AND Suc 0 = 1\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2850
  by (simp_all only: and_numerals flip: One_nat_def)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2851
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2852
lemma or_nat_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2853
  \<open>Suc 0 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2854
  \<open>Suc 0 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2855
  \<open>numeral (Num.Bit0 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2856
  \<open>numeral (Num.Bit1 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2857
  by (simp_all only: or_numerals flip: One_nat_def)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2858
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2859
lemma xor_nat_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2860
  \<open>Suc 0 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2861
  \<open>Suc 0 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2862
  \<open>numeral (Num.Bit0 x) XOR Suc 0 = numeral (Num.Bit1 x)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2863
  \<open>numeral (Num.Bit1 x) XOR Suc 0 = numeral (Num.Bit0 x)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2864
  by (simp_all only: xor_numerals flip: One_nat_def)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2865
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2866
context ring_bit_operations
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2867
begin
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2868
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2869
lemma minus_numeral_inc_eq:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2870
  \<open>- numeral (Num.inc n) = NOT (numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2871
  by (simp add: not_eq_complement sub_inc_One_eq add_One)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2872
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2873
lemma sub_one_eq_not_neg:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2874
  \<open>Num.sub n num.One = NOT (- numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2875
  by (simp add: not_eq_complement)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2876
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2877
lemma minus_numeral_eq_not_sub_one:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2878
  \<open>- numeral n = NOT (Num.sub n num.One)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2879
  by (simp add: not_eq_complement)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2880
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2881
lemma not_numeral_eq [simp]:
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2882
  \<open>NOT (numeral n) = - numeral (Num.inc n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2883
  by (simp add: minus_numeral_inc_eq)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2884
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2885
lemma not_minus_numeral_eq [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2886
  \<open>NOT (- numeral n) = Num.sub n num.One\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2887
  by (simp add: sub_one_eq_not_neg)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2888
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2889
lemma minus_not_numeral_eq [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2890
  \<open>- (NOT (numeral n)) = numeral (Num.inc n)\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2891
  by simp
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2892
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2893
lemma not_numeral_BitM_eq:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2894
  \<open>NOT (numeral (Num.BitM n)) =  - numeral (num.Bit0 n)\<close>
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  2895
  by (simp add: inc_BitM_eq)
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2896
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2897
lemma not_numeral_Bit0_eq:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2898
  \<open>NOT (numeral (Num.Bit0 n)) =  - numeral (num.Bit1 n)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2899
  by simp
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2900
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2901
end
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2902
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2903
lemma bit_minus_numeral_int [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2904
  \<open>bit (- numeral (num.Bit0 w) :: int) (numeral n) \<longleftrightarrow> bit (- numeral w :: int) (pred_numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2905
  \<open>bit (- numeral (num.Bit1 w) :: int) (numeral n) \<longleftrightarrow> \<not> bit (numeral w :: int) (pred_numeral n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2906
  by (simp_all add: bit_minus_iff bit_not_iff numeral_eq_Suc bit_Suc add_One sub_inc_One_eq)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2907
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2908
lemma bit_minus_numeral_Bit0_Suc_iff [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2909
  \<open>bit (- numeral (num.Bit0 w) :: int) (Suc n) \<longleftrightarrow> bit (- numeral w :: int) n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2910
  by (simp add: bit_Suc)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2911
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2912
lemma bit_minus_numeral_Bit1_Suc_iff [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2913
  \<open>bit (- numeral (num.Bit1 w) :: int) (Suc n) \<longleftrightarrow> \<not> bit (numeral w :: int) n\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2914
  by (simp add: bit_Suc add_One flip: bit_not_int_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2915
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2916
lemma and_not_numerals:
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2917
  \<open>1 AND NOT 1 = (0 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2918
  \<open>1 AND NOT (numeral (Num.Bit0 n)) = (1 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2919
  \<open>1 AND NOT (numeral (Num.Bit1 n)) = (0 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2920
  \<open>numeral (Num.Bit0 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2921
  \<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit0 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2922
  \<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2923
  \<open>numeral (Num.Bit1 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2924
  \<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m AND NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2925
  \<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2926
  by (simp_all add: bit_eq_iff) (auto simp: bit_0 bit_simps bit_Suc bit_numeral_rec BitM_inc_eq sub_inc_One_eq split: nat.split)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2927
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2928
fun and_not_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2929
where
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2930
  \<open>and_not_num num.One num.One = None\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2931
| \<open>and_not_num num.One (num.Bit0 n) = Some num.One\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2932
| \<open>and_not_num num.One (num.Bit1 n) = None\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2933
| \<open>and_not_num (num.Bit0 m) num.One = Some (num.Bit0 m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2934
| \<open>and_not_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_not_num m n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2935
| \<open>and_not_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2936
| \<open>and_not_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2937
| \<open>and_not_num (num.Bit1 m) (num.Bit0 n) = (case and_not_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2938
| \<open>and_not_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2939
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2940
lemma int_numeral_and_not_num:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2941
  \<open>numeral m AND NOT (numeral n) = (case and_not_num m n of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2942
  by (induction m n rule: and_not_num.induct) (simp_all del: not_numeral_eq not_one_eq add: and_not_numerals split: option.splits)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2943
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2944
lemma int_numeral_not_and_num:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2945
  \<open>NOT (numeral m) AND numeral n = (case and_not_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2946
  using int_numeral_and_not_num [of n m] by (simp add: ac_simps)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2947
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2948
lemma and_not_num_eq_None_iff:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2949
  \<open>and_not_num m n = None \<longleftrightarrow> numeral m AND NOT (numeral n) = (0 :: int)\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2950
  by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2951
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2952
lemma and_not_num_eq_Some_iff:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2953
  \<open>and_not_num m n = Some q \<longleftrightarrow> numeral m AND NOT (numeral n) = (numeral q :: int)\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2954
  by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2955
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2956
lemma and_minus_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2957
  \<open>1 AND - (numeral (num.Bit0 n)) = (0::int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2958
  \<open>1 AND - (numeral (num.Bit1 n)) = (1::int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2959
  \<open>numeral m AND - (numeral (num.Bit0 n)) = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2960
  \<open>numeral m AND - (numeral (num.Bit1 n)) = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2961
  \<open>- (numeral (num.Bit0 n)) AND 1 = (0::int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2962
  \<open>- (numeral (num.Bit1 n)) AND 1 = (1::int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2963
  \<open>- (numeral (num.Bit0 n)) AND numeral m = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2964
  \<open>- (numeral (num.Bit1 n)) AND numeral m = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2965
  by (simp_all del: not_numeral_eq add: ac_simps
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2966
    and_not_numerals one_and_eq not_numeral_BitM_eq not_numeral_Bit0_eq and_not_num_eq_None_iff and_not_num_eq_Some_iff split: option.split)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2967
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2968
lemma and_minus_minus_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2969
  \<open>- (numeral m :: int) AND - (numeral n :: int) = NOT ((numeral m - 1) OR (numeral n - 1))\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2970
  by (simp add: minus_numeral_eq_not_sub_one)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2971
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2972
lemma or_not_numerals:
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2973
  \<open>1 OR NOT 1 = NOT (0 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2974
  \<open>1 OR NOT (numeral (Num.Bit0 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2975
  \<open>1 OR NOT (numeral (Num.Bit1 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2976
  \<open>numeral (Num.Bit0 m) OR NOT (1 :: int) = NOT (1 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2977
  \<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2978
  \<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m OR NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2979
  \<open>numeral (Num.Bit1 m) OR NOT (1 :: int) = NOT (0 :: int)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2980
  \<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2981
  \<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit1 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2982
  by (simp_all add: bit_eq_iff)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  2983
    (auto simp: bit_0 bit_simps bit_Suc bit_numeral_rec sub_inc_One_eq split: nat.split)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2984
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2985
fun or_not_num_neg :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2986
where
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2987
  \<open>or_not_num_neg num.One num.One = num.One\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2988
| \<open>or_not_num_neg num.One (num.Bit0 m) = num.Bit1 m\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2989
| \<open>or_not_num_neg num.One (num.Bit1 m) = num.Bit1 m\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2990
| \<open>or_not_num_neg (num.Bit0 n) num.One = num.Bit0 num.One\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2991
| \<open>or_not_num_neg (num.Bit0 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2992
| \<open>or_not_num_neg (num.Bit0 n) (num.Bit1 m) = num.Bit0 (or_not_num_neg n m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2993
| \<open>or_not_num_neg (num.Bit1 n) num.One = num.One\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2994
| \<open>or_not_num_neg (num.Bit1 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2995
| \<open>or_not_num_neg (num.Bit1 n) (num.Bit1 m) = Num.BitM (or_not_num_neg n m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2996
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2997
lemma int_numeral_or_not_num_neg:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  2998
  \<open>numeral m OR NOT (numeral n :: int) = - numeral (or_not_num_neg m n)\<close>
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  2999
  by (induction m n rule: or_not_num_neg.induct) (simp_all del: not_numeral_eq not_one_eq add: or_not_numerals, simp_all)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3000
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3001
lemma int_numeral_not_or_num_neg:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3002
  \<open>NOT (numeral m) OR (numeral n :: int) = - numeral (or_not_num_neg n m)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3003
  using int_numeral_or_not_num_neg [of n m] by (simp add: ac_simps)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3004
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3005
lemma numeral_or_not_num_eq:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3006
  \<open>numeral (or_not_num_neg m n) = - (numeral m OR NOT (numeral n :: int))\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3007
  using int_numeral_or_not_num_neg [of m n] by simp
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3008
74495
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3009
lemma or_minus_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3010
  \<open>1 OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3011
  \<open>1 OR - (numeral (num.Bit1 n)) = - (numeral (num.Bit1 n) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3012
  \<open>numeral m OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3013
  \<open>numeral m OR - (numeral (num.Bit1 n)) = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3014
  \<open>- (numeral (num.Bit0 n)) OR 1 = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3015
  \<open>- (numeral (num.Bit1 n)) OR 1 = - (numeral (num.Bit1 n) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3016
  \<open>- (numeral (num.Bit0 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3017
  \<open>- (numeral (num.Bit1 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3018
  by (simp_all only: or.commute [of _ 1] or.commute [of _ \<open>numeral m\<close>]
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3019
    minus_numeral_eq_not_sub_one or_not_numerals
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3020
    numeral_or_not_num_eq arith_simps minus_minus numeral_One)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3021
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3022
lemma or_minus_minus_numerals [simp]:
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3023
  \<open>- (numeral m :: int) OR - (numeral n :: int) = NOT ((numeral m - 1) AND (numeral n - 1))\<close>
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3024
  by (simp add: minus_numeral_eq_not_sub_one)
bc27c490aaac normalizing NOT (numeral _) (again)
haftmann
parents: 74391
diff changeset
  3025
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3026
lemma xor_minus_numerals [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3027
  \<open>- numeral n XOR k = NOT (neg_numeral_class.sub n num.One XOR k)\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3028
  \<open>k XOR - numeral n = NOT (k XOR (neg_numeral_class.sub n num.One))\<close> for k :: int
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3029
  by (simp_all add: minus_numeral_eq_not_sub_one)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3030
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3031
definition take_bit_num :: \<open>nat \<Rightarrow> num \<Rightarrow> num option\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3032
  where \<open>take_bit_num n m =
75651
f4116b7a6679 Move code lemmas for symbolic computation of bit operations on int to distribution.
haftmann
parents: 75138
diff changeset
  3033
    (if take_bit n (numeral m :: nat) = 0 then None else Some (num_of_nat (take_bit n (numeral m :: nat))))\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3034
74618
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3035
lemma take_bit_num_simps:
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3036
  \<open>take_bit_num 0 m = None\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3037
  \<open>take_bit_num (Suc n) Num.One =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3038
    Some Num.One\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3039
  \<open>take_bit_num (Suc n) (Num.Bit0 m) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3040
    (case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3041
  \<open>take_bit_num (Suc n) (Num.Bit1 m) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3042
    Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>
74618
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3043
  \<open>take_bit_num (numeral r) Num.One =
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3044
    Some Num.One\<close>
74618
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3045
  \<open>take_bit_num (numeral r) (Num.Bit0 m) =
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3046
    (case take_bit_num (pred_numeral r) m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3047
  \<open>take_bit_num (numeral r) (Num.Bit1 m) =
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3048
    Some (case take_bit_num (pred_numeral r) m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3049
  by (auto simp: take_bit_num_def ac_simps mult_2 num_of_nat_double
74618
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3050
    take_bit_Suc_bit0 take_bit_Suc_bit1 take_bit_numeral_bit0 take_bit_numeral_bit1)
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3051
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3052
lemma take_bit_num_code [code]:
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3053
  \<comment> \<open>Ocaml-style pattern matching is more robust wrt. different representations of \<^typ>\<open>nat\<close>\<close>
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3054
  \<open>take_bit_num n m = (case (n, m)
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3055
   of (0, _) \<Rightarrow> None
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3056
    | (Suc n, Num.One) \<Rightarrow> Some Num.One
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3057
    | (Suc n, Num.Bit0 m) \<Rightarrow> (case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3058
    | (Suc n, Num.Bit1 m) \<Rightarrow> Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q))\<close>
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3059
  by (cases n; cases m) (simp_all add: take_bit_num_simps)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3060
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3061
context semiring_bit_operations
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3062
begin
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3063
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3064
lemma take_bit_num_eq_None_imp:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3065
  \<open>take_bit m (numeral n) = 0\<close> if \<open>take_bit_num m n = None\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3066
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3067
  from that have \<open>take_bit m (numeral n :: nat) = 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3068
    by (simp add: take_bit_num_def split: if_splits)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3069
  then have \<open>of_nat (take_bit m (numeral n)) = of_nat 0\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3070
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3071
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3072
    by (simp add: of_nat_take_bit)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3073
qed
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3074
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3075
lemma take_bit_num_eq_Some_imp:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3076
  \<open>take_bit m (numeral n) = numeral q\<close> if \<open>take_bit_num m n = Some q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3077
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3078
  from that have \<open>take_bit m (numeral n :: nat) = numeral q\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3079
    by (auto simp: take_bit_num_def Num.numeral_num_of_nat_unfold split: if_splits)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3080
  then have \<open>of_nat (take_bit m (numeral n)) = of_nat (numeral q)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3081
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3082
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3083
    by (simp add: of_nat_take_bit)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3084
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3085
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3086
lemma take_bit_numeral_numeral:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3087
  \<open>take_bit (numeral m) (numeral n) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3088
    (case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> numeral q)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3089
  by (auto split: option.split dest: take_bit_num_eq_None_imp take_bit_num_eq_Some_imp)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3090
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3091
end
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3092
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3093
lemma take_bit_numeral_minus_numeral_int:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3094
  \<open>take_bit (numeral m) (- numeral n :: int) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3095
    (case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> take_bit (numeral m) (2 ^ numeral m - numeral q))\<close> (is \<open>?lhs = ?rhs\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3096
proof (cases \<open>take_bit_num (numeral m) n\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3097
  case None
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3098
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3099
    by (auto dest: take_bit_num_eq_None_imp [where ?'a = int] simp add: take_bit_eq_0_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3100
next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3101
  case (Some q)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3102
  then have q: \<open>take_bit (numeral m) (numeral n :: int) = numeral q\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3103
    by (auto dest: take_bit_num_eq_Some_imp)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3104
  let ?T = \<open>take_bit (numeral m) :: int \<Rightarrow> int\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3105
  have *: \<open>?T (2 ^ numeral m) = ?T (?T 0)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3106
    by (simp add: take_bit_eq_0_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3107
  have \<open>?lhs = ?T (0 - numeral n)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3108
    by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3109
  also have \<open>\<dots> = ?T (?T (?T 0) - ?T (?T (numeral n)))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3110
    by (simp only: take_bit_diff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3111
  also have \<open>\<dots> = ?T (2 ^ numeral m - ?T (numeral n))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3112
    by (simp only: take_bit_diff flip: *)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3113
  also have \<open>\<dots> = ?rhs\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3114
    by (simp add: q Some)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3115
  finally show ?thesis .
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3116
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3117
74618
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3118
declare take_bit_num_simps [simp]
43142ac556e6 moved generic implementation into HOL-Main
haftmann
parents: 74592
diff changeset
  3119
  take_bit_numeral_numeral [simp]
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3120
  take_bit_numeral_minus_numeral_int [simp]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3121
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74123
diff changeset
  3122
79069
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3123
subsection \<open>Symbolic computations for code generation\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3124
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3125
lemma bit_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3126
  \<open>bit (0::int)               n      \<longleftrightarrow> False\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3127
  \<open>bit (Int.Neg num.One)      n      \<longleftrightarrow> True\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3128
  \<open>bit (Int.Pos num.One)      0      \<longleftrightarrow> True\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3129
  \<open>bit (Int.Pos (num.Bit0 m)) 0      \<longleftrightarrow> False\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3130
  \<open>bit (Int.Pos (num.Bit1 m)) 0      \<longleftrightarrow> True\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3131
  \<open>bit (Int.Neg (num.Bit0 m)) 0      \<longleftrightarrow> False\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3132
  \<open>bit (Int.Neg (num.Bit1 m)) 0      \<longleftrightarrow> True\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3133
  \<open>bit (Int.Pos num.One)      (Suc n) \<longleftrightarrow> False\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3134
  \<open>bit (Int.Pos (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3135
  \<open>bit (Int.Pos (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3136
  \<open>bit (Int.Neg (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg m) n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3137
  \<open>bit (Int.Neg (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg (Num.inc m)) n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3138
  by (simp_all add: Num.add_One bit_0 bit_Suc)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3139
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3140
lemma not_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3141
  \<open>NOT (0 :: int) = - 1\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3142
  \<open>NOT (Int.Pos n) = Int.Neg (Num.inc n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3143
  \<open>NOT (Int.Neg n) = Num.sub n num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3144
  by (simp_all add: Num.add_One not_int_def)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3145
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3146
fun and_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3147
where
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3148
  \<open>and_num num.One num.One = Some num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3149
| \<open>and_num num.One (num.Bit0 n) = None\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3150
| \<open>and_num num.One (num.Bit1 n) = Some num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3151
| \<open>and_num (num.Bit0 m) num.One = None\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3152
| \<open>and_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3153
| \<open>and_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3154
| \<open>and_num (num.Bit1 m) num.One = Some num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3155
| \<open>and_num (num.Bit1 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3156
| \<open>and_num (num.Bit1 m) (num.Bit1 n) = (case and_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3157
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3158
context linordered_euclidean_semiring_bit_operations
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3159
begin
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3160
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3161
lemma numeral_and_num:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3162
  \<open>numeral m AND numeral n = (case and_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3163
  by (induction m n rule: and_num.induct) (simp_all add: split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3164
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3165
lemma and_num_eq_None_iff:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3166
  \<open>and_num m n = None \<longleftrightarrow> numeral m AND numeral n = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3167
  by (simp add: numeral_and_num split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3168
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3169
lemma and_num_eq_Some_iff:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3170
  \<open>and_num m n = Some q \<longleftrightarrow> numeral m AND numeral n = numeral q\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3171
  by (simp add: numeral_and_num split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3172
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3173
end
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3174
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3175
lemma and_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3176
  fixes i j :: int shows
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3177
  \<open>0 AND j = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3178
  \<open>i AND 0 = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3179
  \<open>Int.Pos n AND Int.Pos m = (case and_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3180
  \<open>Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3181
  \<open>Int.Pos n AND Int.Neg num.One = Int.Pos n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3182
  \<open>Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (or_not_num_neg (Num.BitM m) n) num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3183
  \<open>Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (or_not_num_neg (num.Bit0 m) n) num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3184
  \<open>Int.Neg num.One AND Int.Pos m = Int.Pos m\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3185
  \<open>Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (or_not_num_neg (Num.BitM n) m) num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3186
  \<open>Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (or_not_num_neg (num.Bit0 n) m) num.One\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3187
  apply (auto simp: and_num_eq_None_iff [where ?'a = int] and_num_eq_Some_iff [where ?'a = int]
79069
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3188
    split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3189
     apply (simp_all only: sub_one_eq_not_neg numeral_or_not_num_eq minus_minus and_not_numerals
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3190
       bit.de_Morgan_disj bit.double_compl and_not_num_eq_None_iff and_not_num_eq_Some_iff ac_simps)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3191
  done
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3192
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3193
context linordered_euclidean_semiring_bit_operations
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3194
begin
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3195
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3196
fun or_num :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3197
where
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3198
  \<open>or_num num.One num.One = num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3199
| \<open>or_num num.One (num.Bit0 n) = num.Bit1 n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3200
| \<open>or_num num.One (num.Bit1 n) = num.Bit1 n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3201
| \<open>or_num (num.Bit0 m) num.One = num.Bit1 m\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3202
| \<open>or_num (num.Bit0 m) (num.Bit0 n) = num.Bit0 (or_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3203
| \<open>or_num (num.Bit0 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3204
| \<open>or_num (num.Bit1 m) num.One = num.Bit1 m\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3205
| \<open>or_num (num.Bit1 m) (num.Bit0 n) = num.Bit1 (or_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3206
| \<open>or_num (num.Bit1 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3207
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3208
lemma numeral_or_num:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3209
  \<open>numeral m OR numeral n = numeral (or_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3210
  by (induction m n rule: or_num.induct) simp_all
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3211
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3212
lemma numeral_or_num_eq:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3213
  \<open>numeral (or_num m n) = numeral m OR numeral n\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3214
  by (simp add: numeral_or_num)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3215
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3216
end
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3217
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3218
lemma or_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3219
  fixes i j :: int shows
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3220
  \<open>0 OR j = j\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3221
  \<open>i OR 0 = i\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3222
  \<open>Int.Pos n OR Int.Pos m = Int.Pos (or_num n m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3223
  \<open>Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3224
  \<open>Int.Pos n OR Int.Neg num.One = Int.Neg num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3225
  \<open>Int.Pos n OR Int.Neg (num.Bit0 m) = (case and_not_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3226
  \<open>Int.Pos n OR Int.Neg (num.Bit1 m) = (case and_not_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3227
  \<open>Int.Neg num.One OR Int.Pos m = Int.Neg num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3228
  \<open>Int.Neg (num.Bit0 n) OR Int.Pos m = (case and_not_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3229
  \<open>Int.Neg (num.Bit1 n) OR Int.Pos m = (case and_not_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3230
  apply (auto simp: numeral_or_num_eq split: option.splits)
79069
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3231
         apply (simp_all only: and_not_num_eq_None_iff and_not_num_eq_Some_iff and_not_numerals
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3232
           numeral_or_not_num_eq or_eq_not_not_and bit.double_compl ac_simps flip: numeral_eq_iff [where ?'a = int])
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3233
         apply simp_all
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3234
  done
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3235
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3236
fun xor_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3237
where
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3238
  \<open>xor_num num.One num.One = None\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3239
| \<open>xor_num num.One (num.Bit0 n) = Some (num.Bit1 n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3240
| \<open>xor_num num.One (num.Bit1 n) = Some (num.Bit0 n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3241
| \<open>xor_num (num.Bit0 m) num.One = Some (num.Bit1 m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3242
| \<open>xor_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (xor_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3243
| \<open>xor_num (num.Bit0 m) (num.Bit1 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3244
| \<open>xor_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3245
| \<open>xor_num (num.Bit1 m) (num.Bit0 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3246
| \<open>xor_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (xor_num m n)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3247
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3248
context linordered_euclidean_semiring_bit_operations
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3249
begin
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3250
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3251
lemma numeral_xor_num:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3252
  \<open>numeral m XOR numeral n = (case xor_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3253
  by (induction m n rule: xor_num.induct) (simp_all split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3254
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3255
lemma xor_num_eq_None_iff:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3256
  \<open>xor_num m n = None \<longleftrightarrow> numeral m XOR numeral n = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3257
  by (simp add: numeral_xor_num split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3258
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3259
lemma xor_num_eq_Some_iff:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3260
  \<open>xor_num m n = Some q \<longleftrightarrow> numeral m XOR numeral n = numeral q\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3261
  by (simp add: numeral_xor_num split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3262
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3263
end
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3264
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3265
lemma xor_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3266
  fixes i j :: int shows
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3267
  \<open>0 XOR j = j\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3268
  \<open>i XOR 0 = i\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3269
  \<open>Int.Pos n XOR Int.Pos m = (case xor_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3270
  \<open>Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3271
  \<open>Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3272
  \<open>Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3273
  by (simp_all add: xor_num_eq_None_iff [where ?'a = int] xor_num_eq_Some_iff [where ?'a = int] split: option.split)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3274
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3275
lemma push_bit_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3276
  \<open>push_bit 0 i = i\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3277
  \<open>push_bit (Suc n) i = push_bit n (Int.dup i)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3278
  by (simp_all add: ac_simps)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3279
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3280
lemma drop_bit_int_code [code]:
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3281
  fixes i :: int shows
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3282
  \<open>drop_bit 0 i = i\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3283
  \<open>drop_bit (Suc n) 0 = (0 :: int)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3284
  \<open>drop_bit (Suc n) (Int.Pos num.One) = 0\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3285
  \<open>drop_bit (Suc n) (Int.Pos (num.Bit0 m)) = drop_bit n (Int.Pos m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3286
  \<open>drop_bit (Suc n) (Int.Pos (num.Bit1 m)) = drop_bit n (Int.Pos m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3287
  \<open>drop_bit (Suc n) (Int.Neg num.One) = - 1\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3288
  \<open>drop_bit (Suc n) (Int.Neg (num.Bit0 m)) = drop_bit n (Int.Neg m)\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3289
  \<open>drop_bit (Suc n) (Int.Neg (num.Bit1 m)) = drop_bit n (Int.Neg (Num.inc m))\<close>
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3290
  by (simp_all add: drop_bit_Suc add_One)
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3291
48ca09068adf grouped lemmas for symbolic computations
haftmann
parents: 79068
diff changeset
  3292
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  3293
subsection \<open>More properties\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  3294
72830
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3295
lemma take_bit_eq_mask_iff:
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3296
  \<open>take_bit n k = mask n \<longleftrightarrow> take_bit n (k + 1) = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3297
  for k :: int
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3298
proof
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3299
  assume ?P
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3300
  then have \<open>take_bit n (take_bit n k + take_bit n 1) = 0\<close>
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  3301
    by (simp add: mask_eq_exp_minus_1 take_bit_eq_0_iff)
72830
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3302
  then show ?Q
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3303
    by (simp only: take_bit_add)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3304
next
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3305
  assume ?Q
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3306
  then have \<open>take_bit n (k + 1) - 1 = - 1\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3307
    by simp
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3308
  then have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n (- 1)\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3309
    by simp
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3310
  moreover have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n k\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3311
    by (simp add: take_bit_eq_mod mod_simps)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3312
  ultimately show ?P
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3313
    by simp
72830
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3314
qed
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3315
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3316
lemma take_bit_eq_mask_iff_exp_dvd:
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3317
  \<open>take_bit n k = mask n \<longleftrightarrow> 2 ^ n dvd k + 1\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3318
  for k :: int
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3319
  by (simp add: take_bit_eq_mask_iff flip: take_bit_eq_0_iff)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72792
diff changeset
  3320
71442
d45495e897f4 more instances
haftmann
parents: 71426
diff changeset
  3321
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3322
subsection \<open>Bit concatenation\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3323
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3324
definition concat_bit :: \<open>nat \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int\<close>
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3325
  where \<open>concat_bit n k l = take_bit n k OR push_bit n l\<close>
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3326
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72512
diff changeset
  3327
lemma bit_concat_bit_iff [bit_simps]:
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3328
  \<open>bit (concat_bit m k l) n \<longleftrightarrow> n < m \<and> bit k n \<or> m \<le> n \<and> bit l (n - m)\<close>
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3329
  by (simp add: concat_bit_def bit_or_iff bit_and_iff bit_take_bit_iff bit_push_bit_iff ac_simps)
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3330
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3331
lemma concat_bit_eq:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3332
  \<open>concat_bit n k l = take_bit n k + push_bit n l\<close>
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3333
proof -
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3334
  have \<open>take_bit n k AND push_bit n l = 0\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3335
    by (simp add: bit_eq_iff bit_simps)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3336
  then show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3337
    by (simp add: bit_eq_iff bit_simps disjunctive_add_eq_or)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3338
qed
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3339
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3340
lemma concat_bit_0 [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3341
  \<open>concat_bit 0 k l = l\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3342
  by (simp add: concat_bit_def)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3343
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3344
lemma concat_bit_Suc:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3345
  \<open>concat_bit (Suc n) k l = k mod 2 + 2 * concat_bit n (k div 2) l\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3346
  by (simp add: concat_bit_eq take_bit_Suc push_bit_double)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3347
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3348
lemma concat_bit_of_zero_1 [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3349
  \<open>concat_bit n 0 l = push_bit n l\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3350
  by (simp add: concat_bit_def)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3351
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3352
lemma concat_bit_of_zero_2 [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3353
  \<open>concat_bit n k 0 = take_bit n k\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3354
  by (simp add: concat_bit_def take_bit_eq_mask)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3355
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3356
lemma concat_bit_nonnegative_iff [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3357
  \<open>concat_bit n k l \<ge> 0 \<longleftrightarrow> l \<ge> 0\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3358
  by (simp add: concat_bit_def)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3359
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3360
lemma concat_bit_negative_iff [simp]:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3361
  \<open>concat_bit n k l < 0 \<longleftrightarrow> l < 0\<close>
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3362
  by (simp add: concat_bit_def)
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3363
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3364
lemma concat_bit_assoc:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3365
  \<open>concat_bit n k (concat_bit m l r) = concat_bit (m + n) (concat_bit n k l) r\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3366
  by (rule bit_eqI) (auto simp: bit_concat_bit_iff ac_simps)
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3367
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3368
lemma concat_bit_assoc_sym:
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3369
  \<open>concat_bit m (concat_bit n k l) r = concat_bit (min m n) k (concat_bit (m - n) l r)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3370
  by (rule bit_eqI) (auto simp: bit_concat_bit_iff ac_simps min_def)
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3371
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3372
lemma concat_bit_eq_iff:
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3373
  \<open>concat_bit n k l = concat_bit n r s
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3374
    \<longleftrightarrow> take_bit n k = take_bit n r \<and> l = s\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3375
proof
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3376
  assume ?Q
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3377
  then show ?P
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3378
    by (simp add: concat_bit_def)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3379
next
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3380
  assume ?P
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3381
  then have *: \<open>bit (concat_bit n k l) m = bit (concat_bit n r s) m\<close> for m
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3382
    by (simp add: bit_eq_iff)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3383
  have \<open>take_bit n k = take_bit n r\<close>
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3384
  proof (rule bit_eqI)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3385
    fix m
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3386
    from * [of m]
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3387
    show \<open>bit (take_bit n k) m \<longleftrightarrow> bit (take_bit n r) m\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3388
      by (auto simp: bit_take_bit_iff bit_concat_bit_iff)
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3389
  qed
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3390
  moreover have \<open>push_bit n l = push_bit n s\<close>
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3391
  proof (rule bit_eqI)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3392
    fix m
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3393
    from * [of m]
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3394
    show \<open>bit (push_bit n l) m \<longleftrightarrow> bit (push_bit n s) m\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3395
      by (auto simp: bit_push_bit_iff bit_concat_bit_iff)
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3396
  qed
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3397
  then have \<open>l = s\<close>
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3398
    by (simp add: push_bit_eq_mult)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3399
  ultimately show ?Q
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3400
    by (simp add: concat_bit_def)
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3401
qed
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3402
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3403
lemma take_bit_concat_bit_eq:
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3404
  \<open>take_bit m (concat_bit n k l) = concat_bit (min m n) k (take_bit (m - n) l)\<close>
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3405
  by (rule bit_eqI)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3406
    (auto simp: bit_take_bit_iff bit_concat_bit_iff min_def)
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3407
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  3408
lemma concat_bit_take_bit_eq:
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  3409
  \<open>concat_bit n (take_bit n b) = concat_bit n b\<close>
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  3410
  by (simp add: concat_bit_def [abs_def])
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72397
diff changeset
  3411
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3412
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3413
subsection \<open>Taking bits with sign propagation\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3414
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3415
context ring_bit_operations
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3416
begin
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3417
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3418
definition signed_take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3419
  where \<open>signed_take_bit n a = take_bit n a OR (of_bool (bit a n) * NOT (mask n))\<close>
72227
0f3d24dc197f more on conversions
haftmann
parents: 72187
diff changeset
  3420
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3421
lemma signed_take_bit_eq_if_positive:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3422
  \<open>signed_take_bit n a = take_bit n a\<close> if \<open>\<not> bit a n\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3423
  using that by (simp add: signed_take_bit_def)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3424
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3425
lemma signed_take_bit_eq_if_negative:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3426
  \<open>signed_take_bit n a = take_bit n a OR NOT (mask n)\<close> if \<open>bit a n\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3427
  using that by (simp add: signed_take_bit_def)
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3428
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3429
lemma even_signed_take_bit_iff:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3430
  \<open>even (signed_take_bit m a) \<longleftrightarrow> even a\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3431
  by (auto simp: bit_0 signed_take_bit_def even_or_iff even_mask_iff bit_double_iff)
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3432
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72512
diff changeset
  3433
lemma bit_signed_take_bit_iff [bit_simps]:
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  3434
  \<open>bit (signed_take_bit m a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit a (min m n)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3435
  by (simp add: signed_take_bit_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff min_def not_le)
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  3436
    (blast dest: bit_imp_possible_bit)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3437
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3438
lemma signed_take_bit_0 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3439
  \<open>signed_take_bit 0 a = - (a mod 2)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  3440
  by (simp add: bit_0 signed_take_bit_def odd_iff_mod_2_eq_one)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3441
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3442
lemma signed_take_bit_Suc:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3443
  \<open>signed_take_bit (Suc n) a = a mod 2 + 2 * signed_take_bit n (a div 2)\<close>
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74618
diff changeset
  3444
  by (simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 possible_bit_less_imp flip: bit_Suc min_Suc_Suc)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3445
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3446
lemma signed_take_bit_of_0 [simp]:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3447
  \<open>signed_take_bit n 0 = 0\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3448
  by (simp add: signed_take_bit_def)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3449
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3450
lemma signed_take_bit_of_minus_1 [simp]:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3451
  \<open>signed_take_bit n (- 1) = - 1\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3452
  by (simp add: signed_take_bit_def mask_eq_exp_minus_1 possible_bit_def)
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3453
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3454
lemma signed_take_bit_Suc_1 [simp]:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3455
  \<open>signed_take_bit (Suc n) 1 = 1\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3456
  by (simp add: signed_take_bit_Suc)
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3457
74497
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  3458
lemma signed_take_bit_numeral_of_1 [simp]:
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  3459
  \<open>signed_take_bit (numeral k) 1 = 1\<close>
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  3460
  by (simp add: bit_1_iff signed_take_bit_eq_if_positive)
9c04a82c3128 more complete simp rules
haftmann
parents: 74495
diff changeset
  3461
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3462
lemma signed_take_bit_rec:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3463
  \<open>signed_take_bit n a = (if n = 0 then - (a mod 2) else a mod 2 + 2 * signed_take_bit (n - 1) (a div 2))\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3464
  by (cases n) (simp_all add: signed_take_bit_Suc)
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3465
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3466
lemma signed_take_bit_eq_iff_take_bit_eq:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3467
  \<open>signed_take_bit n a = signed_take_bit n b \<longleftrightarrow> take_bit (Suc n) a = take_bit (Suc n) b\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3468
proof -
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3469
  have \<open>bit (signed_take_bit n a) = bit (signed_take_bit n b) \<longleftrightarrow> bit (take_bit (Suc n) a) = bit (take_bit (Suc n) b)\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3470
    by (simp add: fun_eq_iff bit_signed_take_bit_iff bit_take_bit_iff not_le less_Suc_eq_le min_def)
74309
42523fbf643b explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
haftmann
parents: 74163
diff changeset
  3471
      (use bit_imp_possible_bit in fastforce)
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3472
  then show ?thesis
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3473
    by (auto simp: fun_eq_iff intro: bit_eqI)
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3474
qed
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3475
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3476
lemma signed_take_bit_signed_take_bit [simp]:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3477
  \<open>signed_take_bit m (signed_take_bit n a) = signed_take_bit (min m n) a\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3478
  by (auto simp: bit_eq_iff bit_simps ac_simps)
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3479
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3480
lemma signed_take_bit_take_bit:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3481
  \<open>signed_take_bit m (take_bit n a) = (if n \<le> m then take_bit n else signed_take_bit m) a\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3482
  by (rule bit_eqI) (auto simp: bit_signed_take_bit_iff min_def bit_take_bit_iff)
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3483
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3484
lemma take_bit_signed_take_bit:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3485
  \<open>take_bit m (signed_take_bit n a) = take_bit m a\<close> if \<open>m \<le> Suc n\<close>
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3486
  using that by (rule le_SucE; intro bit_eqI)
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3487
   (auto simp: bit_take_bit_iff bit_signed_take_bit_iff min_def less_Suc_eq)
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3488
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3489
lemma signed_take_bit_eq_take_bit_add:
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3490
  \<open>signed_take_bit n k = take_bit (Suc n) k + NOT (mask (Suc n)) * of_bool (bit k n)\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3491
proof (cases \<open>bit k n\<close>)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3492
  case False
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3493
  show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3494
    by (rule bit_eqI) (simp add: False bit_simps min_def less_Suc_eq)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3495
next
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3496
  case True
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3497
  have \<open>signed_take_bit n k = take_bit (Suc n) k OR NOT (mask (Suc n))\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3498
    by (rule bit_eqI) (auto simp: bit_signed_take_bit_iff min_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff less_Suc_eq True)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3499
  also have \<open>\<dots> = take_bit (Suc n) k + NOT (mask (Suc n))\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3500
    by (simp add: disjunctive_add_eq_or bit_eq_iff bit_simps)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3501
  finally show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3502
    by (simp add: True)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3503
qed
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3504
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3505
lemma signed_take_bit_eq_take_bit_minus:
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3506
  \<open>signed_take_bit n k = take_bit (Suc n) k - 2 ^ Suc n * of_bool (bit k n)\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3507
  by (simp add: signed_take_bit_eq_take_bit_add flip: minus_exp_eq_not_mask)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3508
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3509
end
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3510
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3511
text \<open>Modulus centered around 0\<close>
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3512
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3513
lemma signed_take_bit_eq_concat_bit:
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3514
  \<open>signed_take_bit n k = concat_bit n k (- of_bool (bit k n))\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3515
  by (simp add: concat_bit_def signed_take_bit_def)
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3516
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3517
lemma signed_take_bit_add:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3518
  \<open>signed_take_bit n (signed_take_bit n k + signed_take_bit n l) = signed_take_bit n (k + l)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3519
  for k l :: int
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3520
proof -
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3521
  have \<open>take_bit (Suc n)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3522
     (take_bit (Suc n) (signed_take_bit n k) +
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3523
      take_bit (Suc n) (signed_take_bit n l)) =
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3524
    take_bit (Suc n) (k + l)\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3525
    by (simp add: take_bit_signed_take_bit take_bit_add)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3526
  then show ?thesis
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3527
    by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_add)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3528
qed
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3529
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3530
lemma signed_take_bit_diff:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3531
  \<open>signed_take_bit n (signed_take_bit n k - signed_take_bit n l) = signed_take_bit n (k - l)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3532
  for k l :: int
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3533
proof -
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3534
  have \<open>take_bit (Suc n)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3535
     (take_bit (Suc n) (signed_take_bit n k) -
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3536
      take_bit (Suc n) (signed_take_bit n l)) =
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3537
    take_bit (Suc n) (k - l)\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3538
    by (simp add: take_bit_signed_take_bit take_bit_diff)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3539
  then show ?thesis
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3540
    by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_diff)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3541
qed
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3542
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3543
lemma signed_take_bit_minus:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3544
  \<open>signed_take_bit n (- signed_take_bit n k) = signed_take_bit n (- k)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3545
  for k :: int
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3546
proof -
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3547
  have \<open>take_bit (Suc n)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3548
     (- take_bit (Suc n) (signed_take_bit n k)) =
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3549
    take_bit (Suc n) (- k)\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3550
    by (simp add: take_bit_signed_take_bit take_bit_minus)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3551
  then show ?thesis
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3552
    by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_minus)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3553
qed
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3554
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3555
lemma signed_take_bit_mult:
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3556
  \<open>signed_take_bit n (signed_take_bit n k * signed_take_bit n l) = signed_take_bit n (k * l)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3557
  for k l :: int
72187
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3558
proof -
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3559
  have \<open>take_bit (Suc n)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3560
     (take_bit (Suc n) (signed_take_bit n k) *
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3561
      take_bit (Suc n) (signed_take_bit n l)) =
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3562
    take_bit (Suc n) (k * l)\<close>
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3563
    by (simp add: take_bit_signed_take_bit take_bit_mult)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3564
  then show ?thesis
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3565
    by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_mult)
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3566
qed
e4aecb0c7296 more lemmas
haftmann
parents: 72130
diff changeset
  3567
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3568
lemma signed_take_bit_eq_take_bit_shift:
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3569
  \<open>signed_take_bit n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n\<close> (is \<open>?lhs = ?rhs\<close>)
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3570
  for k :: int
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3571
proof -
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3572
  have \<open>take_bit n k AND 2 ^ n = 0\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3573
    by (rule bit_eqI) (simp add: bit_simps)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3574
  then have *: \<open>take_bit n k OR 2 ^ n = take_bit n k + 2 ^ n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3575
    by (simp add: disjunctive_add_eq_or)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3576
  have \<open>take_bit n k - 2 ^ n = take_bit n k + NOT (mask n)\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3577
    by (simp add: minus_exp_eq_not_mask)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3578
  also have \<open>\<dots> = take_bit n k OR NOT (mask n)\<close>
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3579
    by (rule disjunctive_add_eq_or) (simp add: bit_eq_iff bit_simps)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3580
  finally have **: \<open>take_bit n k - 2 ^ n = take_bit n k OR NOT (mask n)\<close> .
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3581
  have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (take_bit (Suc n) k + take_bit (Suc n) (2 ^ n))\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3582
    by (simp only: take_bit_add)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3583
  also have \<open>take_bit (Suc n) k = 2 ^ n * of_bool (bit k n) + take_bit n k\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3584
    by (simp add: take_bit_Suc_from_most)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3585
  finally have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (2 ^ (n + of_bool (bit k n)) + take_bit n k)\<close>
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3586
    by (simp add: ac_simps)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3587
  also have \<open>2 ^ (n + of_bool (bit k n)) + take_bit n k = 2 ^ (n + of_bool (bit k n)) OR take_bit n k\<close>
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3588
    by (rule disjunctive_add_eq_or, rule bit_eqI) (simp add: bit_simps)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3589
  finally show ?thesis
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3590
    using * ** by (simp add: signed_take_bit_def concat_bit_Suc min_def ac_simps)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3591
qed
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3592
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3593
lemma signed_take_bit_nonnegative_iff [simp]:
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3594
  \<open>0 \<le> signed_take_bit n k \<longleftrightarrow> \<not> bit k n\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3595
  for k :: int
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3596
  by (simp add: signed_take_bit_def not_less concat_bit_def)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3597
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3598
lemma signed_take_bit_negative_iff [simp]:
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3599
  \<open>signed_take_bit n k < 0 \<longleftrightarrow> bit k n\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3600
  for k :: int
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3601
  by (simp add: signed_take_bit_def not_less concat_bit_def)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3602
73868
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3603
lemma signed_take_bit_int_greater_eq_minus_exp [simp]:
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3604
  \<open>- (2 ^ n) \<le> signed_take_bit n k\<close>
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3605
  for k :: int
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3606
  by (simp add: signed_take_bit_eq_take_bit_shift)
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3607
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3608
lemma signed_take_bit_int_less_exp [simp]:
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3609
  \<open>signed_take_bit n k < 2 ^ n\<close>
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3610
  for k :: int
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3611
  using take_bit_int_less_exp [of \<open>Suc n\<close>]
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3612
  by (simp add: signed_take_bit_eq_take_bit_shift)
465846b611d5 some word streamlining
haftmann
parents: 73816
diff changeset
  3613
72261
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3614
lemma signed_take_bit_int_eq_self_iff:
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3615
  \<open>signed_take_bit n k = k \<longleftrightarrow> - (2 ^ n) \<le> k \<and> k < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3616
  for k :: int
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3617
  by (auto simp: signed_take_bit_eq_take_bit_shift take_bit_int_eq_self_iff algebra_simps)
72261
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3618
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3619
lemma signed_take_bit_int_eq_self:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3620
  \<open>signed_take_bit n k = k\<close> if \<open>- (2 ^ n) \<le> k\<close> \<open>k < 2 ^ n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3621
  for k :: int
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3622
  using that by (simp add: signed_take_bit_int_eq_self_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3623
72261
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3624
lemma signed_take_bit_int_less_eq_self_iff:
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3625
  \<open>signed_take_bit n k \<le> k \<longleftrightarrow> - (2 ^ n) \<le> k\<close>
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3626
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3627
  by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_eq_self_iff algebra_simps)
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3628
    linarith
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3629
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3630
lemma signed_take_bit_int_less_self_iff:
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3631
  \<open>signed_take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close>
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3632
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3633
  by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_self_iff algebra_simps)
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3634
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3635
lemma signed_take_bit_int_greater_self_iff:
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3636
  \<open>k < signed_take_bit n k \<longleftrightarrow> k < - (2 ^ n)\<close>
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3637
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3638
  by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_self_iff algebra_simps)
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3639
    linarith
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3640
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3641
lemma signed_take_bit_int_greater_eq_self_iff:
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3642
  \<open>k \<le> signed_take_bit n k \<longleftrightarrow> k < 2 ^ n\<close>
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3643
  for k :: int
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3644
  by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_eq_self_iff algebra_simps)
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3645
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3646
lemma signed_take_bit_int_greater_eq:
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3647
  \<open>k + 2 ^ Suc n \<le> signed_take_bit n k\<close> if \<open>k < - (2 ^ n)\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3648
  for k :: int
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3649
  using that take_bit_int_greater_eq [of \<open>k + 2 ^ n\<close> \<open>Suc n\<close>]
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3650
  by (simp add: signed_take_bit_eq_take_bit_shift)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3651
72261
5193570b739a more lemmas
haftmann
parents: 72241
diff changeset
  3652
lemma signed_take_bit_int_less_eq:
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3653
  \<open>signed_take_bit n k \<le> k - 2 ^ Suc n\<close> if \<open>k \<ge> 2 ^ n\<close>
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3654
  for k :: int
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3655
  using that take_bit_int_less_eq [of \<open>Suc n\<close> \<open>k + 2 ^ n\<close>]
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3656
  by (simp add: signed_take_bit_eq_take_bit_shift)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3657
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3658
lemma signed_take_bit_Suc_bit0 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3659
  \<open>signed_take_bit (Suc n) (numeral (Num.Bit0 k)) = signed_take_bit n (numeral k) * (2 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3660
  by (simp add: signed_take_bit_Suc)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3661
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3662
lemma signed_take_bit_Suc_bit1 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3663
  \<open>signed_take_bit (Suc n) (numeral (Num.Bit1 k)) = signed_take_bit n (numeral k) * 2 + (1 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3664
  by (simp add: signed_take_bit_Suc)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3665
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3666
lemma signed_take_bit_Suc_minus_bit0 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3667
  \<open>signed_take_bit (Suc n) (- numeral (Num.Bit0 k)) = signed_take_bit n (- numeral k) * (2 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3668
  by (simp add: signed_take_bit_Suc)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3669
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3670
lemma signed_take_bit_Suc_minus_bit1 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3671
  \<open>signed_take_bit (Suc n) (- numeral (Num.Bit1 k)) = signed_take_bit n (- numeral k - 1) * 2 + (1 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3672
  by (simp add: signed_take_bit_Suc)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3673
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3674
lemma signed_take_bit_numeral_bit0 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3675
  \<open>signed_take_bit (numeral l) (numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (numeral k) * (2 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3676
  by (simp add: signed_take_bit_rec)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3677
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3678
lemma signed_take_bit_numeral_bit1 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3679
  \<open>signed_take_bit (numeral l) (numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (numeral k) * 2 + (1 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3680
  by (simp add: signed_take_bit_rec)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3681
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3682
lemma signed_take_bit_numeral_minus_bit0 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3683
  \<open>signed_take_bit (numeral l) (- numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3684
  by (simp add: signed_take_bit_rec)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3685
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3686
lemma signed_take_bit_numeral_minus_bit1 [simp]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3687
  \<open>signed_take_bit (numeral l) (- numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (- numeral k - 1) * 2 + (1 :: int)\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3688
  by (simp add: signed_take_bit_rec)
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3689
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3690
lemma signed_take_bit_code [code]:
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3691
  \<open>signed_take_bit n a =
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3692
  (let l = take_bit (Suc n) a
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3693
   in if bit l n then l + push_bit (Suc n) (- 1) else l)\<close>
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3694
  by (simp add: signed_take_bit_eq_take_bit_add bit_simps)
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3695
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  3696
71800
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3697
subsection \<open>Key ideas of bit operations\<close>
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3698
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3699
text \<open>
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3700
  When formalizing bit operations, it is tempting to represent
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3701
  bit values as explicit lists over a binary type. This however
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3702
  is a bad idea, mainly due to the inherent ambiguities in
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3703
  representation concerning repeating leading bits.
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3704
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3705
  Hence this approach avoids such explicit lists altogether
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3706
  following an algebraic path:
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3707
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3708
  \<^item> Bit values are represented by numeric types: idealized
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3709
    unbounded bit values can be represented by type \<^typ>\<open>int\<close>,
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3710
    bounded bit values by quotient types over \<^typ>\<open>int\<close>.
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3711
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3712
  \<^item> (A special case are idealized unbounded bit values ending
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3713
    in @{term [source] 0} which can be represented by type \<^typ>\<open>nat\<close> but
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3714
    only support a restricted set of operations).
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3715
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3716
  \<^item> From this idea follows that
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3717
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3718
      \<^item> multiplication by \<^term>\<open>2 :: int\<close> is a bit shift to the left and
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3719
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3720
      \<^item> division by \<^term>\<open>2 :: int\<close> is a bit shift to the right.
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3721
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3722
  \<^item> Concerning bounded bit values, iterated shifts to the left
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3723
    may result in eliminating all bits by shifting them all
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3724
    beyond the boundary.  The property \<^prop>\<open>(2 :: int) ^ n \<noteq> 0\<close>
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3725
    represents that \<^term>\<open>n\<close> is \<^emph>\<open>not\<close> beyond that boundary.
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3726
71965
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71956
diff changeset
  3727
  \<^item> The projection on a single bit is then @{thm bit_iff_odd [where ?'a = int, no_vars]}.
71800
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3728
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3729
  \<^item> This leads to the most fundamental properties of bit values:
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3730
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3731
      \<^item> Equality rule: @{thm bit_eqI [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3732
79480
c7cb1bf6efa0 consolidated name of lemma analogously to nat/int/word_bit_induct
haftmann
parents: 79117
diff changeset
  3733
      \<^item> Induction rule: @{thm bit_induct [where ?'a = int, no_vars]}
71800
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3734
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3735
  \<^item> Typical operations are characterized as follows:
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3736
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3737
      \<^item> Singleton \<^term>\<open>n\<close>th bit: \<^term>\<open>(2 :: int) ^ n\<close>
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3738
71956
a4bffc0de967 bit operations as distinctive library theory
haftmann
parents: 71922
diff changeset
  3739
      \<^item> Bit mask upto bit \<^term>\<open>n\<close>: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]}
71800
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3740
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3741
      \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3742
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3743
      \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3744
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3745
      \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3746
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3747
      \<^item> Negation: @{thm bit_not_iff [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3748
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3749
      \<^item> And: @{thm bit_and_iff [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3750
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3751
      \<^item> Or: @{thm bit_or_iff [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3752
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3753
      \<^item> Xor: @{thm bit_xor_iff [where ?'a = int, no_vars]}
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3754
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3755
      \<^item> Set a single bit: @{thm set_bit_eq_or [where ?'a = int, no_vars]}
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3756
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3757
      \<^item> Unset a single bit: @{thm unset_bit_eq_and_not [where ?'a = int, no_vars]}
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3758
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3759
      \<^item> Flip a single bit: @{thm flip_bit_eq_xor [where ?'a = int, no_vars]}
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3760
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3761
      \<^item> Signed truncation, or modulus centered around \<^term>\<open>0::int\<close>: @{thm signed_take_bit_def [no_vars]}
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3762
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  3763
      \<^item> Bit concatenation: @{thm concat_bit_def [no_vars]}
72028
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3764
08f1e4cb735f concatentation of bit values
haftmann
parents: 72023
diff changeset
  3765
      \<^item> (Bounded) conversion from and to a list of bits: @{thm horner_sum_bit_eq_take_bit [where ?'a = int, no_vars]}
71800
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3766
\<close>
35a951ed2e82 documentation of relevant ideas
haftmann
parents: 71535
diff changeset
  3767
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3768
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3769
subsection \<open>Lemma duplicates and other\<close>
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3770
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3771
context semiring_bits
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3772
begin
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3773
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3774
lemma exp_div_exp_eq:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3775
  \<open>2 ^ m div 2 ^ n = of_bool (2 ^ m \<noteq> 0 \<and> m \<ge> n) * 2 ^ (m - n)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3776
  using bit_exp_iff div_exp_eq
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3777
  by (intro bit_eqI) (auto simp: bit_iff_odd possible_bit_def)
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3778
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3779
lemma bits_1_div_2:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3780
  \<open>1 div 2 = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3781
  by (fact half_1)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3782
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3783
lemma bits_1_div_exp:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3784
  \<open>1 div 2 ^ n = of_bool (n = 0)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3785
  using div_exp_eq [of 1 1] by (cases n) simp_all
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3786
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3787
lemma exp_add_not_zero_imp:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3788
  \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> if \<open>2 ^ (m + n) \<noteq> 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3789
proof -
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3790
  have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3791
  proof (rule notI)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3792
    assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3793
    then have \<open>2 ^ (m + n) = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3794
      by (rule disjE) (simp_all add: power_add)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3795
    with that show False ..
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3796
  qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3797
  then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3798
    by simp_all
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3799
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3800
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3801
lemma
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3802
  exp_add_not_zero_imp_left: \<open>2 ^ m \<noteq> 0\<close>
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3803
  and exp_add_not_zero_imp_right: \<open>2 ^ n \<noteq> 0\<close>
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3804
  if \<open>2 ^ (m + n) \<noteq> 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3805
proof -
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3806
  have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3807
  proof (rule notI)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3808
    assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3809
    then have \<open>2 ^ (m + n) = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3810
      by (rule disjE) (simp_all add: power_add)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3811
    with that show False ..
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3812
  qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3813
  then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3814
    by simp_all
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3815
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3816
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3817
lemma exp_not_zero_imp_exp_diff_not_zero:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3818
  \<open>2 ^ (n - m) \<noteq> 0\<close> if \<open>2 ^ n \<noteq> 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3819
proof (cases \<open>m \<le> n\<close>)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3820
  case True
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3821
  moreover define q where \<open>q = n - m\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3822
  ultimately have \<open>n = m + q\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3823
    by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3824
  with that show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3825
    by (simp add: exp_add_not_zero_imp_right)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3826
next
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3827
  case False
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3828
  with that show ?thesis
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3829
    by simp
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3830
qed
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3831
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3832
lemma exp_eq_0_imp_not_bit:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3833
  \<open>\<not> bit a n\<close> if \<open>2 ^ n = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3834
  using that by (simp add: bit_iff_odd)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3835
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3836
lemma bit_disjunctive_add_iff:
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3837
  \<open>bit (a + b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3838
  if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3839
proof (cases \<open>possible_bit TYPE('a) n\<close>)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3840
  case False
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3841
  then show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3842
    by (auto dest: impossible_bit)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3843
next
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3844
  case True
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3845
  with that show ?thesis proof (induction n arbitrary: a b)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3846
    case 0
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3847
    from "0.prems"(1) [of 0] show ?case
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3848
      by (auto simp: bit_0)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3849
  next
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3850
    case (Suc n)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3851
    from Suc.prems(1) [of 0] have even: \<open>even a \<or> even b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3852
      by (auto simp: bit_0)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3853
    have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3854
      using Suc.prems(1) [of \<open>Suc n\<close>] by (simp add: bit_Suc)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3855
    from Suc.prems(2) have \<open>possible_bit TYPE('a) (Suc n)\<close> \<open>possible_bit TYPE('a) n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3856
      by (simp_all add: possible_bit_less_imp)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3857
    have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3858
      using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3859
    also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3860
      using even by (auto simp: algebra_simps mod2_eq_if)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3861
    finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3862
      using \<open>possible_bit TYPE('a) (Suc n)\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff possible_bit_def)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3863
    also have \<open>\<dots> \<longleftrightarrow> bit (a div 2) n \<or> bit (b div 2) n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3864
      using bit \<open>possible_bit TYPE('a) n\<close> by (rule Suc.IH)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3865
    finally show ?case
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3866
      by (simp add: bit_Suc)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3867
  qed
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3868
qed
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3869
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3870
end
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3871
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3872
context semiring_bit_operations
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3873
begin
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3874
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3875
lemma even_mask_div_iff:
79588
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
  3876
  \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> 2 ^ n = 0 \<or> m \<le> n\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3877
  using bit_mask_iff [of m n] by (auto simp: mask_eq_exp_minus_1 bit_iff_odd possible_bit_def)
79588
9f22b71e209e simplified class specification
haftmann
parents: 79585
diff changeset
  3878
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3879
lemma mod_exp_eq:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3880
  \<open>a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3881
  by (simp flip: take_bit_eq_mod add: ac_simps)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3882
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3883
lemma mult_exp_mod_exp_eq:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3884
  \<open>m \<le> n \<Longrightarrow> (a * 2 ^ m) mod (2 ^ n) = (a mod 2 ^ (n - m)) * 2 ^ m\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3885
  by (simp flip: push_bit_eq_mult take_bit_eq_mod add: push_bit_take_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3886
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3887
lemma div_exp_mod_exp_eq:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3888
  \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3889
  by (simp flip: drop_bit_eq_div take_bit_eq_mod add: drop_bit_take_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3890
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3891
lemma even_mult_exp_div_exp_iff:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3892
  \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> m > n \<or> 2 ^ n = 0 \<or> (m \<le> n \<and> even (a div 2 ^ (n - m)))\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3893
  by (simp flip: push_bit_eq_mult drop_bit_eq_div add: even_drop_bit_iff_not_bit bit_simps possible_bit_def) auto
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3894
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3895
lemma mod_exp_div_exp_eq_0:
79531
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3896
  \<open>a mod 2 ^ n div 2 ^ n = 0\<close>
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3897
  by (simp flip: take_bit_eq_mod drop_bit_eq_div add: drop_bit_take_bit)
22a137a6de44 rearranged and reformulated abstract classes for bit structures and operations
haftmann
parents: 79489
diff changeset
  3898
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3899
lemmas bits_one_mod_two_eq_one = one_mod_two_eq_one
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3900
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3901
lemmas set_bit_def = set_bit_eq_or
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3902
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3903
lemmas unset_bit_def = unset_bit_eq_and_not
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3904
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3905
lemmas flip_bit_def = flip_bit_eq_xor
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3906
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3907
lemma disjunctive_add:
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3908
  \<open>a + b = a OR b\<close> if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3909
  by (rule disjunctive_add_eq_or) (use that in \<open>simp add: bit_eq_iff bit_simps\<close>)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3910
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3911
lemma even_mod_exp_div_exp_iff:
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
  3912
  \<open>even (a mod 2 ^ m div 2 ^ n) \<longleftrightarrow> m \<le> n \<or> even (a div 2 ^ n)\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3913
  by (auto simp: even_drop_bit_iff_not_bit bit_simps simp flip: drop_bit_eq_div take_bit_eq_mod)
79673
c172eecba85d simplified specification of type class semiring_bits
haftmann
parents: 79610
diff changeset
  3914
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3915
end
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3916
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3917
context ring_bit_operations
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3918
begin
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3919
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3920
lemma disjunctive_diff:
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3921
  \<open>a - b = a AND NOT b\<close> if \<open>\<And>n. bit b n \<Longrightarrow> bit a n\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3922
proof -
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3923
  have \<open>NOT a + b = NOT a OR b\<close>
80758
8f96e1329845 Some tidying
paulson <lp15@cam.ac.uk>
parents: 79893
diff changeset
  3924
    by (rule disjunctive_add) (auto simp: bit_not_iff dest: that)
79610
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3925
  then have \<open>NOT (NOT a + b) = NOT (NOT a OR b)\<close>
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3926
    by simp
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3927
  then show ?thesis
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3928
    by (simp add: not_add_distrib)
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3929
qed
ad29777e8746 more on disjunctive addition/subtraction
haftmann
parents: 79590
diff changeset
  3930
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3931
end
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3932
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3933
lemma and_nat_rec:
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3934
  \<open>m AND n = of_bool (odd m \<and> odd n) + 2 * ((m div 2) AND (n div 2))\<close> for m n :: nat
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3935
  by (fact and_rec)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3936
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3937
lemma or_nat_rec:
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3938
  \<open>m OR n = of_bool (odd m \<or> odd n) + 2 * ((m div 2) OR (n div 2))\<close> for m n :: nat
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3939
  by (fact or_rec)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3940
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3941
lemma xor_nat_rec:
79070
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3942
  \<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * ((m div 2) XOR (n div 2))\<close> for m n :: nat
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3943
  by (fact xor_rec)
a4775fe69f5d restructured
haftmann
parents: 79069
diff changeset
  3944
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3945
lemma bit_push_bit_iff_nat:
79071
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  3946
  \<open>bit (push_bit m q) n \<longleftrightarrow> m \<le> n \<and> bit q (n - m)\<close> for q :: nat
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  3947
  by (fact bit_push_bit_iff')
7ab8b3f1d84b generalized
haftmann
parents: 79070
diff changeset
  3948
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3949
lemma mask_half_int:
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3950
  \<open>mask n div 2 = (mask (n - 1) :: int)\<close>
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3951
  by (fact mask_half)
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3952
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3953
lemma not_int_rec:
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3954
  \<open>NOT k = of_bool (even k) + 2 * NOT (k div 2)\<close> for k :: int
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3955
  by (fact not_rec)
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3956
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3957
lemma even_not_iff_int:
79068
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3958
  \<open>even (NOT k) \<longleftrightarrow> odd k\<close> for k :: int
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3959
  by (fact even_not_iff)
cb72e2c0c539 sorted out lemma duplicates
haftmann
parents: 79031
diff changeset
  3960
79072
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  3961
lemma bit_not_int_iff':
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  3962
  \<open>bit (- k - 1) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  3963
  by (simp flip: not_eq_complement add: bit_simps)
a91050cd5c93 de-duplicated specification of class ring_bit_operations
haftmann
parents: 79071
diff changeset
  3964
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3965
lemmas and_int_rec = and_int.rec
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3966
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3967
lemma even_and_iff_int:
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3968
  \<open>even (k AND l) \<longleftrightarrow> even k \<or> even l\<close> for k l :: int
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3969
  by (fact even_and_iff)
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3970
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3971
lemmas bit_and_int_iff = and_int.bit_iff
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3972
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3973
lemmas or_int_rec = or_int.rec
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3974
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3975
lemmas bit_or_int_iff = or_int.bit_iff
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3976
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3977
lemmas xor_int_rec = xor_int.rec
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3978
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3979
lemmas bit_xor_int_iff = xor_int.bit_iff
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3980
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3981
lemma drop_bit_push_bit_int:
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3982
  \<open>drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\<close> for k :: int
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3983
  by (fact drop_bit_push_bit)
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3984
79893
7ea70796acaa avoid [no_atp] declations shadowing propositions from sledgehammer
haftmann
parents: 79673
diff changeset
  3985
lemma bit_push_bit_iff_int:
79116
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3986
  \<open>bit (push_bit m k) n \<longleftrightarrow> m \<le> n \<and> bit k (n - m)\<close> for k :: int
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3987
  by (fact bit_push_bit_iff')
b90bf6636260 explicit annotation of lemma duplicates
haftmann
parents: 79072
diff changeset
  3988
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73969
diff changeset
  3989
bundle bit_operations_syntax
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  3990
begin
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73969
diff changeset
  3991
notation
74391
930047942f46 repaired slip
haftmann
parents: 74364
diff changeset
  3992
  not  (\<open>NOT\<close>)
74364
99add5178e51 NOT is part of syntax bundle also
haftmann
parents: 74309
diff changeset
  3993
    and "and"  (infixr \<open>AND\<close> 64)
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73969
diff changeset
  3994
    and or  (infixr \<open>OR\<close>  59)
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73969
diff changeset
  3995
    and xor  (infixr \<open>XOR\<close> 59)
81132
dff7dfd8dce3 more robust declarations via "no syntax" bundles;
wenzelm
parents: 80758
diff changeset
  3996
end
dff7dfd8dce3 more robust declarations via "no syntax" bundles;
wenzelm
parents: 80758
diff changeset
  3997
dff7dfd8dce3 more robust declarations via "no syntax" bundles;
wenzelm
parents: 80758
diff changeset
  3998
unbundle no bit_operations_syntax
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73969
diff changeset
  3999
71442
d45495e897f4 more instances
haftmann
parents: 71426
diff changeset
  4000
end