src/HOL/Library/Word.thy
author desharna
Mon, 23 May 2022 10:12:19 +0200
changeset 75458 4117491aa7fe
parent 75087 f3fcc7c5a0db
child 75623 7a6301d01199
permissions -rw-r--r--
merged
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
72515
c7038c397ae3 moved most material from session HOL-Word to Word_Lib in the AFP
haftmann
parents: 72512
diff changeset
     1
(*  Title:      HOL/Library/Word.thy
c7038c397ae3 moved most material from session HOL-Word to Word_Lib in the AFP
haftmann
parents: 72512
diff changeset
     2
    Author:     Jeremy Dawson and Gerwin Klein, NICTA, et. al.
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
     3
*)
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
     4
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
     5
section \<open>A type of finite bit strings\<close>
24350
4d74f37c6367 headers for document generation
huffman
parents: 24333
diff changeset
     6
29628
d9294387ab0e entry point for Word library now named Word
haftmann
parents: 27137
diff changeset
     7
theory Word
41413
64cd30d6b0b8 explicit file specifications -- avoid secondary load path;
wenzelm
parents: 41060
diff changeset
     8
imports
66453
cc19f7ca2ed6 session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
wenzelm
parents: 65363
diff changeset
     9
  "HOL-Library.Type_Length"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
    10
begin
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
    11
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    12
subsection \<open>Preliminaries\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    13
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    14
lemma signed_take_bit_decr_length_iff:
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    15
  \<open>signed_take_bit (LENGTH('a::len) - Suc 0) k = signed_take_bit (LENGTH('a) - Suc 0) l
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    16
    \<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    17
  by (cases \<open>LENGTH('a)\<close>)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    18
    (simp_all add: signed_take_bit_eq_iff_take_bit_eq)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    19
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    20
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    21
subsection \<open>Fundamentals\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    22
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    23
subsubsection \<open>Type definition\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
    24
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
    25
quotient_type (overloaded) 'a word = int / \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a::len) l\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    26
  morphisms rep Word by (auto intro!: equivpI reflpI sympI transpI)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    27
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    28
hide_const (open) rep \<comment> \<open>only for foundational purpose\<close>
72130
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
    29
hide_const (open) Word \<comment> \<open>only for code generation\<close>
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
    30
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    31
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    32
subsubsection \<open>Basic arithmetic\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    33
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    34
instantiation word :: (len) comm_ring_1
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    35
begin
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    36
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    37
lift_definition zero_word :: \<open>'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    38
  is 0 .
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    39
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    40
lift_definition one_word :: \<open>'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    41
  is 1 .
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    42
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    43
lift_definition plus_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    44
  is \<open>(+)\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    45
  by (auto simp add: take_bit_eq_mod intro: mod_add_cong)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    46
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    47
lift_definition minus_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    48
  is \<open>(-)\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    49
  by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    50
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    51
lift_definition uminus_word :: \<open>'a word \<Rightarrow> 'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    52
  is uminus
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    53
  by (auto simp add: take_bit_eq_mod intro: mod_minus_cong)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    54
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    55
lift_definition times_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    56
  is \<open>(*)\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    57
  by (auto simp add: take_bit_eq_mod intro: mod_mult_cong)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    58
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    59
instance
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    60
  by (standard; transfer) (simp_all add: algebra_simps)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    61
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    62
end
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    63
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    64
context
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    65
  includes lifting_syntax
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    66
  notes
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    67
    power_transfer [transfer_rule]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    68
    transfer_rule_of_bool [transfer_rule]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    69
    transfer_rule_numeral [transfer_rule]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    70
    transfer_rule_of_nat [transfer_rule]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    71
    transfer_rule_of_int [transfer_rule]
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    72
begin
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    73
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    74
lemma power_transfer_word [transfer_rule]:
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    75
  \<open>(pcr_word ===> (=) ===> pcr_word) (^) (^)\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    76
  by transfer_prover
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
    77
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    78
lemma [transfer_rule]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    79
  \<open>((=) ===> pcr_word) of_bool of_bool\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    80
  by transfer_prover
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    81
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    82
lemma [transfer_rule]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    83
  \<open>((=) ===> pcr_word) numeral numeral\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    84
  by transfer_prover
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    85
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    86
lemma [transfer_rule]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    87
  \<open>((=) ===> pcr_word) int of_nat\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    88
  by transfer_prover
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    89
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    90
lemma [transfer_rule]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    91
  \<open>((=) ===> pcr_word) (\<lambda>k. k) of_int\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    92
proof -
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    93
  have \<open>((=) ===> pcr_word) of_int of_int\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    94
    by transfer_prover
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    95
  then show ?thesis by (simp add: id_def)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    96
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    97
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    98
lemma [transfer_rule]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
    99
  \<open>(pcr_word ===> (\<longleftrightarrow>)) even ((dvd) 2 :: 'a::len word \<Rightarrow> bool)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   100
proof -
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   101
  have even_word_unfold: "even k \<longleftrightarrow> (\<exists>l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P \<longleftrightarrow> ?Q")
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   102
    for k :: int
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   103
  proof
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   104
    assume ?P
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   105
    then show ?Q
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   106
      by auto
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   107
  next
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   108
    assume ?Q
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   109
    then obtain l where "take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l)" ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   110
    then have "even (take_bit LENGTH('a) k)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   111
      by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   112
    then show ?P
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   113
      by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   114
  qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   115
  show ?thesis by (simp only: even_word_unfold [abs_def] dvd_def [where ?'a = "'a word", abs_def])
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   116
    transfer_prover
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   117
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   118
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   119
end
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   120
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
   121
lemma exp_eq_zero_iff [simp]:
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
   122
  \<open>2 ^ n = (0 :: 'a::len word) \<longleftrightarrow> n \<ge> LENGTH('a)\<close>
73535
0f33c7031ec9 new lemmas
haftmann
parents: 72954
diff changeset
   123
  by transfer auto
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
   124
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   125
lemma word_exp_length_eq_0 [simp]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   126
  \<open>(2 :: 'a::len word) ^ LENGTH('a) = 0\<close>
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
   127
  by simp
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   128
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   129
72489
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
   130
subsubsection \<open>Basic tool setup\<close>
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
   131
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
   132
ML_file \<open>Tools/word_lib.ML\<close>
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
   133
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
   134
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   135
subsubsection \<open>Basic code generation setup\<close>
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
   136
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   137
context
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   138
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   139
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   140
qualified lift_definition the_int :: \<open>'a::len word \<Rightarrow> int\<close>
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
   141
  is \<open>take_bit LENGTH('a)\<close> .
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
   142
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   143
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   144
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   145
lemma [code abstype]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   146
  \<open>Word.Word (Word.the_int w) = w\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   147
  by transfer simp
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   148
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   149
lemma Word_eq_word_of_int [code_post, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   150
  \<open>Word.Word = of_int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   151
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   152
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   153
quickcheck_generator word
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   154
  constructors:
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   155
    \<open>0 :: 'a::len word\<close>,
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   156
    \<open>numeral :: num \<Rightarrow> 'a::len word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   157
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   158
instantiation word :: (len) equal
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   159
begin
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   160
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   161
lift_definition equal_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   162
  is \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   163
  by simp
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   164
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   165
instance
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   166
  by (standard; transfer) rule
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   167
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   168
end
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   169
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   170
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   171
  \<open>HOL.equal v w \<longleftrightarrow> HOL.equal (Word.the_int v) (Word.the_int w)\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   172
  by transfer (simp add: equal)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   173
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   174
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   175
  \<open>Word.the_int 0 = 0\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   176
  by transfer simp
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   177
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   178
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   179
  \<open>Word.the_int 1 = 1\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   180
  by transfer simp
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   181
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   182
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   183
  \<open>Word.the_int (v + w) = take_bit LENGTH('a) (Word.the_int v + Word.the_int w)\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   184
  for v w :: \<open>'a::len word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   185
  by transfer (simp add: take_bit_add)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   186
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   187
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   188
  \<open>Word.the_int (- w) = (let k = Word.the_int w in if w = 0 then 0 else 2 ^ LENGTH('a) - k)\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   189
  for w :: \<open>'a::len word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   190
  by transfer (auto simp add: take_bit_eq_mod zmod_zminus1_eq_if)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   191
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   192
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   193
  \<open>Word.the_int (v - w) = take_bit LENGTH('a) (Word.the_int v - Word.the_int w)\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   194
  for v w :: \<open>'a::len word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   195
  by transfer (simp add: take_bit_diff)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   196
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   197
lemma [code]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   198
  \<open>Word.the_int (v * w) = take_bit LENGTH('a) (Word.the_int v * Word.the_int w)\<close>
72243
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   199
  for v w :: \<open>'a::len word\<close>
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   200
  by transfer (simp add: take_bit_mult)
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   201
eaac77208cf9 tuned theory structure
haftmann
parents: 72242
diff changeset
   202
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   203
subsubsection \<open>Basic conversions\<close>
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
   204
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   205
abbreviation word_of_nat :: \<open>nat \<Rightarrow> 'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   206
  where \<open>word_of_nat \<equiv> of_nat\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   207
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   208
abbreviation word_of_int :: \<open>int \<Rightarrow> 'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   209
  where \<open>word_of_int \<equiv> of_int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   210
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   211
lemma word_of_nat_eq_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   212
  \<open>word_of_nat m = (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m = take_bit LENGTH('a) n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   213
  by transfer (simp add: take_bit_of_nat)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   214
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   215
lemma word_of_int_eq_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   216
  \<open>word_of_int k = (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   217
  by transfer rule
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   218
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   219
lemma word_of_nat_eq_0_iff:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   220
  \<open>word_of_nat n = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   221
  using word_of_nat_eq_iff [where ?'a = 'a, of n 0] by (simp add: take_bit_eq_0_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   222
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   223
lemma word_of_int_eq_0_iff:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   224
  \<open>word_of_int k = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd k\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   225
  using word_of_int_eq_iff [where ?'a = 'a, of k 0] by (simp add: take_bit_eq_0_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   226
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   227
context semiring_1
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   228
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   229
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   230
lift_definition unsigned :: \<open>'b::len word \<Rightarrow> 'a\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   231
  is \<open>of_nat \<circ> nat \<circ> take_bit LENGTH('b)\<close>
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   232
  by simp
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
   233
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   234
lemma unsigned_0 [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   235
  \<open>unsigned 0 = 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   236
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   237
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   238
lemma unsigned_1 [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   239
  \<open>unsigned 1 = 1\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   240
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   241
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   242
lemma unsigned_numeral [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   243
  \<open>unsigned (numeral n :: 'b::len word) = of_nat (take_bit LENGTH('b) (numeral n))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   244
  by transfer (simp add: nat_take_bit_eq)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   245
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   246
lemma unsigned_neg_numeral [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   247
  \<open>unsigned (- numeral n :: 'b::len word) = of_nat (nat (take_bit LENGTH('b) (- numeral n)))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   248
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   249
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   250
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   251
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   252
context semiring_1
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   253
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   254
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   255
lemma unsigned_of_nat:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   256
  \<open>unsigned (word_of_nat n :: 'b::len word) = of_nat (take_bit LENGTH('b) n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   257
  by transfer (simp add: nat_eq_iff take_bit_of_nat)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   258
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   259
lemma unsigned_of_int:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   260
  \<open>unsigned (word_of_int k :: 'b::len word) = of_nat (nat (take_bit LENGTH('b) k))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   261
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   263
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   264
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   265
context semiring_char_0
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   266
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   267
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   268
lemma unsigned_word_eqI:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   269
  \<open>v = w\<close> if \<open>unsigned v = unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   270
  using that by transfer (simp add: eq_nat_nat_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   271
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   272
lemma word_eq_iff_unsigned:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   273
  \<open>v = w \<longleftrightarrow> unsigned v = unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   274
  by (auto intro: unsigned_word_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   275
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   276
lemma inj_unsigned [simp]:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   277
  \<open>inj unsigned\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   278
  by (rule injI) (simp add: unsigned_word_eqI)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   279
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   280
lemma unsigned_eq_0_iff:
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   281
  \<open>unsigned w = 0 \<longleftrightarrow> w = 0\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   282
  using word_eq_iff_unsigned [of w 0] by simp
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   283
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   284
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   285
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   286
context ring_1
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   287
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   288
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   289
lift_definition signed :: \<open>'b::len word \<Rightarrow> 'a\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   290
  is \<open>of_int \<circ> signed_take_bit (LENGTH('b) - Suc 0)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   291
  by (simp flip: signed_take_bit_decr_length_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   292
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   293
lemma signed_0 [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   294
  \<open>signed 0 = 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   295
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   296
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   297
lemma signed_1 [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   298
  \<open>signed (1 :: 'b::len word) = (if LENGTH('b) = 1 then - 1 else 1)\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
   299
  by (transfer fixing: uminus; cases \<open>LENGTH('b)\<close>) (auto dest: gr0_implies_Suc)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   300
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   301
lemma signed_minus_1 [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   302
  \<open>signed (- 1 :: 'b::len word) = - 1\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   303
  by (transfer fixing: uminus) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   304
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   305
lemma signed_numeral [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   306
  \<open>signed (numeral n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - 1) (numeral n))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   307
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   308
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   309
lemma signed_neg_numeral [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   310
  \<open>signed (- numeral n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - 1) (- numeral n))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   311
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   312
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   313
lemma signed_of_nat:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   314
  \<open>signed (word_of_nat n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - Suc 0) (int n))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   315
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   316
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   317
lemma signed_of_int:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   318
  \<open>signed (word_of_int n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - Suc 0) n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   319
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   320
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   321
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   322
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   323
context ring_char_0
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   324
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   325
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   326
lemma signed_word_eqI:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   327
  \<open>v = w\<close> if \<open>signed v = signed w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   328
  using that by transfer (simp flip: signed_take_bit_decr_length_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   329
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   330
lemma word_eq_iff_signed:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   331
  \<open>v = w \<longleftrightarrow> signed v = signed w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   332
  by (auto intro: signed_word_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   333
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   334
lemma inj_signed [simp]:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   335
  \<open>inj signed\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   336
  by (rule injI) (simp add: signed_word_eqI)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
   337
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   338
lemma signed_eq_0_iff:
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   339
  \<open>signed w = 0 \<longleftrightarrow> w = 0\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   340
  using word_eq_iff_signed [of w 0] by simp
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   341
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   342
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   343
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   344
abbreviation unat :: \<open>'a::len word \<Rightarrow> nat\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   345
  where \<open>unat \<equiv> unsigned\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   346
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   347
abbreviation uint :: \<open>'a::len word \<Rightarrow> int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   348
  where \<open>uint \<equiv> unsigned\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   349
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   350
abbreviation sint :: \<open>'a::len word \<Rightarrow> int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   351
  where \<open>sint \<equiv> signed\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   352
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   353
abbreviation ucast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   354
  where \<open>ucast \<equiv> unsigned\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   355
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   356
abbreviation scast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   357
  where \<open>scast \<equiv> signed\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   358
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   359
context
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   360
  includes lifting_syntax
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   361
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   362
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   363
lemma [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   364
  \<open>(pcr_word ===> (=)) (nat \<circ> take_bit LENGTH('a)) (unat :: 'a::len word \<Rightarrow> nat)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   365
  using unsigned.transfer [where ?'a = nat] by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   366
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   367
lemma [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   368
  \<open>(pcr_word ===> (=)) (take_bit LENGTH('a)) (uint :: 'a::len word \<Rightarrow> int)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   369
  using unsigned.transfer [where ?'a = int] by (simp add: comp_def)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   370
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   371
lemma [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   372
  \<open>(pcr_word ===> (=)) (signed_take_bit (LENGTH('a) - Suc 0)) (sint :: 'a::len word \<Rightarrow> int)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   373
  using signed.transfer [where ?'a = int] by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   374
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   375
lemma [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   376
  \<open>(pcr_word ===> pcr_word) (take_bit LENGTH('a)) (ucast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   377
proof (rule rel_funI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   378
  fix k :: int and w :: \<open>'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   379
  assume \<open>pcr_word k w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   380
  then have \<open>w = word_of_int k\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   381
    by (simp add: pcr_word_def cr_word_def relcompp_apply)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   382
  moreover have \<open>pcr_word (take_bit LENGTH('a) k) (ucast (word_of_int k :: 'a word))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   383
    by transfer (simp add: pcr_word_def cr_word_def relcompp_apply)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   384
  ultimately show \<open>pcr_word (take_bit LENGTH('a) k) (ucast w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   385
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   386
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   387
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   388
lemma [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   389
  \<open>(pcr_word ===> pcr_word) (signed_take_bit (LENGTH('a) - Suc 0)) (scast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   390
proof (rule rel_funI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   391
  fix k :: int and w :: \<open>'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   392
  assume \<open>pcr_word k w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   393
  then have \<open>w = word_of_int k\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   394
    by (simp add: pcr_word_def cr_word_def relcompp_apply)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   395
  moreover have \<open>pcr_word (signed_take_bit (LENGTH('a) - Suc 0) k) (scast (word_of_int k :: 'a word))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   396
    by transfer (simp add: pcr_word_def cr_word_def relcompp_apply)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   397
  ultimately show \<open>pcr_word (signed_take_bit (LENGTH('a) - Suc 0) k) (scast w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   398
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   399
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   400
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   401
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   402
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   403
lemma of_nat_unat [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   404
  \<open>of_nat (unat w) = unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   405
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   406
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   407
lemma of_int_uint [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   408
  \<open>of_int (uint w) = unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   409
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   410
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   411
lemma of_int_sint [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   412
  \<open>of_int (sint a) = signed a\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   413
  by transfer (simp_all add: take_bit_signed_take_bit)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   414
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   415
lemma nat_uint_eq [simp]:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   416
  \<open>nat (uint w) = unat w\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   417
  by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   418
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   419
lemma sgn_uint_eq [simp]:
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   420
  \<open>sgn (uint w) = of_bool (w \<noteq> 0)\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   421
  by transfer (simp add: less_le)
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
   422
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   423
text \<open>Aliasses only for code generation\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   424
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   425
context
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   426
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   427
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   428
qualified lift_definition of_int :: \<open>int \<Rightarrow> 'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   429
  is \<open>take_bit LENGTH('a)\<close> .
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   430
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   431
qualified lift_definition of_nat :: \<open>nat \<Rightarrow> 'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   432
  is \<open>int \<circ> take_bit LENGTH('a)\<close> .
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   433
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   434
qualified lift_definition the_nat :: \<open>'a::len word \<Rightarrow> nat\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   435
  is \<open>nat \<circ> take_bit LENGTH('a)\<close> by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   436
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   437
qualified lift_definition the_signed_int :: \<open>'a::len word \<Rightarrow> int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   438
  is \<open>signed_take_bit (LENGTH('a) - Suc 0)\<close> by (simp add: signed_take_bit_decr_length_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   439
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   440
qualified lift_definition cast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   441
  is \<open>take_bit LENGTH('a)\<close> by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   442
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   443
qualified lift_definition signed_cast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   444
  is \<open>signed_take_bit (LENGTH('a) - Suc 0)\<close> by (metis signed_take_bit_decr_length_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   445
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   446
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   447
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   448
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   449
  \<open>Word.the_int = uint\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   450
  by transfer rule
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   451
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   452
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   453
  \<open>Word.the_int (Word.of_int k :: 'a::len word) = take_bit LENGTH('a) k\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   454
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   455
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   456
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   457
  \<open>Word.of_int = word_of_int\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   458
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   459
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   460
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   461
  \<open>Word.the_int (Word.of_nat n :: 'a::len word) = take_bit LENGTH('a) (int n)\<close>
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   462
  by transfer (simp add: take_bit_of_nat)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   463
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   464
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   465
  \<open>Word.of_nat = word_of_nat\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   466
  by (rule; transfer) (simp add: take_bit_of_nat)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   467
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   468
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   469
  \<open>Word.the_nat w = nat (Word.the_int w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   470
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   471
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   472
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   473
  \<open>Word.the_nat = unat\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   474
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   475
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   476
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   477
  \<open>Word.the_signed_int w = signed_take_bit (LENGTH('a) - Suc 0) (Word.the_int w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   478
  for w :: \<open>'a::len word\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
   479
  by transfer (simp add: signed_take_bit_take_bit)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   480
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   481
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   482
  \<open>Word.the_signed_int = sint\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   483
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   484
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   485
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   486
  \<open>Word.the_int (Word.cast w :: 'b::len word) = take_bit LENGTH('b) (Word.the_int w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   487
  for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   488
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   489
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   490
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   491
  \<open>Word.cast = ucast\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   492
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   493
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   494
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   495
  \<open>Word.the_int (Word.signed_cast w :: 'b::len word) = take_bit LENGTH('b) (Word.the_signed_int w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   496
  for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   497
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   498
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   499
lemma [code_abbrev, simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   500
  \<open>Word.signed_cast = scast\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   501
  by (rule; transfer) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   502
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   503
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   504
  \<open>unsigned w = of_nat (nat (Word.the_int w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   505
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   506
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   507
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   508
  \<open>signed w = of_int (Word.the_signed_int w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   509
  by transfer simp
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   510
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   511
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   512
subsubsection \<open>Basic ordering\<close>
45547
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   513
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
   514
instantiation word :: (len) linorder
45547
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   515
begin
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   516
71950
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   517
lift_definition less_eq_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   518
  is "\<lambda>a b. take_bit LENGTH('a) a \<le> take_bit LENGTH('a) b"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   519
  by simp
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   520
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   521
lift_definition less_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   522
  is "\<lambda>a b. take_bit LENGTH('a) a < take_bit LENGTH('a) b"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   523
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
   524
45547
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   525
instance
71950
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   526
  by (standard; transfer) auto
45547
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   527
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   528
end
94c37f3df10f HOL-Word: removed more duplicate theorems
huffman
parents: 45546
diff changeset
   529
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   530
interpretation word_order: ordering_top \<open>(\<le>)\<close> \<open>(<)\<close> \<open>- 1 :: 'a::len word\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   531
  by (standard; transfer) (simp add: take_bit_eq_mod zmod_minus1)
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   532
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   533
interpretation word_coorder: ordering_top \<open>(\<ge>)\<close> \<open>(>)\<close> \<open>0 :: 'a::len word\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   534
  by (standard; transfer) simp
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
   535
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   536
lemma word_of_nat_less_eq_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   537
  \<open>word_of_nat m \<le> (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m \<le> take_bit LENGTH('a) n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   538
  by transfer (simp add: take_bit_of_nat)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   539
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   540
lemma word_of_int_less_eq_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   541
  \<open>word_of_int k \<le> (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k \<le> take_bit LENGTH('a) l\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   542
  by transfer rule
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   543
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   544
lemma word_of_nat_less_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   545
  \<open>word_of_nat m < (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m < take_bit LENGTH('a) n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   546
  by transfer (simp add: take_bit_of_nat)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   547
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   548
lemma word_of_int_less_iff:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   549
  \<open>word_of_int k < (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k < take_bit LENGTH('a) l\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   550
  by transfer rule
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   551
71950
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   552
lemma word_le_def [code]:
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   553
  "a \<le> b \<longleftrightarrow> uint a \<le> uint b"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   554
  by transfer rule
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   555
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   556
lemma word_less_def [code]:
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   557
  "a < b \<longleftrightarrow> uint a < uint b"
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   558
  by transfer rule
c9251bc7da4e more transfer rules
haftmann
parents: 71949
diff changeset
   559
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   560
lemma word_greater_zero_iff:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
   561
  \<open>a > 0 \<longleftrightarrow> a \<noteq> 0\<close> for a :: \<open>'a::len word\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   562
  by transfer (simp add: less_le)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   563
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   564
lemma of_nat_word_less_eq_iff:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   565
  \<open>of_nat m \<le> (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m \<le> take_bit LENGTH('a) n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   566
  by transfer (simp add: take_bit_of_nat)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   567
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   568
lemma of_nat_word_less_iff:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   569
  \<open>of_nat m < (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m < take_bit LENGTH('a) n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   570
  by transfer (simp add: take_bit_of_nat)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   571
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   572
lemma of_int_word_less_eq_iff:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   573
  \<open>of_int k \<le> (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k \<le> take_bit LENGTH('a) l\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   574
  by transfer rule
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   575
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   576
lemma of_int_word_less_iff:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   577
  \<open>of_int k < (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k < take_bit LENGTH('a) l\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   578
  by transfer rule
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   579
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
   580
72280
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   581
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   582
subsection \<open>Enumeration\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   583
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   584
lemma inj_on_word_of_nat:
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   585
  \<open>inj_on (word_of_nat :: nat \<Rightarrow> 'a::len word) {0..<2 ^ LENGTH('a)}\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   586
  by (rule inj_onI; transfer) (simp_all add: take_bit_int_eq_self)
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   587
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   588
lemma UNIV_word_eq_word_of_nat:
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   589
  \<open>(UNIV :: 'a::len word set) = word_of_nat ` {0..<2 ^ LENGTH('a)}\<close> (is \<open>_ = ?A\<close>)
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   590
proof
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   591
  show \<open>word_of_nat ` {0..<2 ^ LENGTH('a)} \<subseteq> UNIV\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   592
    by simp
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   593
  show \<open>UNIV \<subseteq> ?A\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   594
  proof
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   595
    fix w :: \<open>'a word\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   596
    show \<open>w \<in> (word_of_nat ` {0..<2 ^ LENGTH('a)} :: 'a word set)\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   597
      by (rule image_eqI [of _ _ \<open>unat w\<close>]; transfer) simp_all
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   598
  qed
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   599
qed
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   600
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   601
instantiation word :: (len) enum
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   602
begin
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   603
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   604
definition enum_word :: \<open>'a word list\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   605
  where \<open>enum_word = map word_of_nat [0..<2 ^ LENGTH('a)]\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   606
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   607
definition enum_all_word :: \<open>('a word \<Rightarrow> bool) \<Rightarrow> bool\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   608
  where \<open>enum_all_word = Ball UNIV\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   609
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   610
definition enum_ex_word :: \<open>('a word \<Rightarrow> bool) \<Rightarrow> bool\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   611
  where \<open>enum_ex_word = Bex UNIV\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   612
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   613
lemma [code]:
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   614
  \<open>Enum.enum_all P \<longleftrightarrow> Ball UNIV P\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   615
  \<open>Enum.enum_ex P \<longleftrightarrow> Bex UNIV P\<close> for P :: \<open>'a word \<Rightarrow> bool\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   616
  by (simp_all add: enum_all_word_def enum_ex_word_def)
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   617
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   618
instance
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   619
  by standard (simp_all add: UNIV_word_eq_word_of_nat inj_on_word_of_nat enum_word_def enum_all_word_def enum_ex_word_def distinct_map)
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   620
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   621
end
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   622
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
   623
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
   624
subsection \<open>Bit-wise operations\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
   625
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   626
instantiation word :: (len) semiring_modulo
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   627
begin
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   628
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   629
lift_definition divide_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   630
  is \<open>\<lambda>a b. take_bit LENGTH('a) a div take_bit LENGTH('a) b\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   631
  by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   632
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   633
lift_definition modulo_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   634
  is \<open>\<lambda>a b. take_bit LENGTH('a) a mod take_bit LENGTH('a) b\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   635
  by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   636
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   637
instance proof
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   638
  show "a div b * b + a mod b = a" for a b :: "'a word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   639
  proof transfer
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   640
    fix k l :: int
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   641
    define r :: int where "r = 2 ^ LENGTH('a)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   642
    then have r: "take_bit LENGTH('a) k = k mod r" for k
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   643
      by (simp add: take_bit_eq_mod)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   644
    have "k mod r = ((k mod r) div (l mod r) * (l mod r)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   645
      + (k mod r) mod (l mod r)) mod r"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   646
      by (simp add: div_mult_mod_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   647
    also have "... = (((k mod r) div (l mod r) * (l mod r)) mod r
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   648
      + (k mod r) mod (l mod r)) mod r"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   649
      by (simp add: mod_add_left_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   650
    also have "... = (((k mod r) div (l mod r) * l) mod r
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   651
      + (k mod r) mod (l mod r)) mod r"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   652
      by (simp add: mod_mult_right_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   653
    finally have "k mod r = ((k mod r) div (l mod r) * l
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   654
      + (k mod r) mod (l mod r)) mod r"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   655
      by (simp add: mod_simps)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   656
    with r show "take_bit LENGTH('a) (take_bit LENGTH('a) k div take_bit LENGTH('a) l * l
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   657
      + take_bit LENGTH('a) k mod take_bit LENGTH('a) l) = take_bit LENGTH('a) k"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   658
      by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   659
  qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   660
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   661
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   662
end
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   663
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   664
instance word :: (len) semiring_parity
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   665
proof
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   666
  show "\<not> 2 dvd (1::'a word)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   667
    by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   668
  show even_iff_mod_2_eq_0: "2 dvd a \<longleftrightarrow> a mod 2 = 0"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   669
    for a :: "'a word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   670
    by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   671
  show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   672
    for a :: "'a word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   673
    by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   674
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
   675
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   676
lemma word_bit_induct [case_names zero even odd]:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   677
  \<open>P a\<close> if word_zero: \<open>P 0\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   678
    and word_even: \<open>\<And>a. P a \<Longrightarrow> 0 < a \<Longrightarrow> a < 2 ^ (LENGTH('a) - Suc 0) \<Longrightarrow> P (2 * a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   679
    and word_odd: \<open>\<And>a. P a \<Longrightarrow> a < 2 ^ (LENGTH('a) - Suc 0) \<Longrightarrow> P (1 + 2 * a)\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   680
  for P and a :: \<open>'a::len word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   681
proof -
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   682
  define m :: nat where \<open>m = LENGTH('a) - Suc 0\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   683
  then have l: \<open>LENGTH('a) = Suc m\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   684
    by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   685
  define n :: nat where \<open>n = unat a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   686
  then have \<open>n < 2 ^ LENGTH('a)\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   687
    by transfer (simp add: take_bit_eq_mod)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   688
  then have \<open>n < 2 * 2 ^ m\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   689
    by (simp add: l)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   690
  then have \<open>P (of_nat n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   691
  proof (induction n rule: nat_bit_induct)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   692
    case zero
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   693
    show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   694
      by simp (rule word_zero)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   695
  next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   696
    case (even n)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   697
    then have \<open>n < 2 ^ m\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   698
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   699
    with even.IH have \<open>P (of_nat n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   700
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   701
    moreover from \<open>n < 2 ^ m\<close> even.hyps have \<open>0 < (of_nat n :: 'a word)\<close>
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
   702
      by (auto simp add: word_greater_zero_iff l word_of_nat_eq_0_iff)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   703
    moreover from \<open>n < 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - Suc 0)\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   704
      using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>]
72261
5193570b739a more lemmas
haftmann
parents: 72244
diff changeset
   705
      by (simp add: l take_bit_eq_mod)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   706
    ultimately have \<open>P (2 * of_nat n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   707
      by (rule word_even)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   708
    then show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   709
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   710
  next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   711
    case (odd n)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   712
    then have \<open>Suc n \<le> 2 ^ m\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   713
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   714
    with odd.IH have \<open>P (of_nat n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   715
      by simp
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   716
    moreover from \<open>Suc n \<le> 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - Suc 0)\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   717
      using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>]
72261
5193570b739a more lemmas
haftmann
parents: 72244
diff changeset
   718
      by (simp add: l take_bit_eq_mod)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   719
    ultimately have \<open>P (1 + 2 * of_nat n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   720
      by (rule word_odd)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   721
    then show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   722
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   723
  qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   724
  moreover have \<open>of_nat (nat (uint a)) = a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   725
    by transfer simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   726
  ultimately show ?thesis
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
   727
    by (simp add: n_def)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   728
qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   729
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   730
lemma bit_word_half_eq:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   731
  \<open>(of_bool b + a * 2) div 2 = a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   732
    if \<open>a < 2 ^ (LENGTH('a) - Suc 0)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   733
    for a :: \<open>'a::len word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   734
proof (cases \<open>2 \<le> LENGTH('a::len)\<close>)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   735
  case False
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   736
  have \<open>of_bool (odd k) < (1 :: int) \<longleftrightarrow> even k\<close> for k :: int
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   737
    by auto
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   738
  with False that show ?thesis
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   739
    by transfer (simp add: eq_iff)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   740
next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   741
  case True
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   742
  obtain n where length: \<open>LENGTH('a) = Suc n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   743
    by (cases \<open>LENGTH('a)\<close>) simp_all
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   744
  show ?thesis proof (cases b)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   745
    case False
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   746
    moreover have \<open>a * 2 div 2 = a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   747
    using that proof transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   748
      fix k :: int
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   749
      from length have \<open>k * 2 mod 2 ^ LENGTH('a) = (k mod 2 ^ n) * 2\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   750
        by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   751
      moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   752
      with \<open>LENGTH('a) = Suc n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   753
      have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   754
        by (simp add: take_bit_eq_mod divmod_digit_0)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   755
      ultimately have \<open>take_bit LENGTH('a) (k * 2) = take_bit LENGTH('a) k * 2\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   756
        by (simp add: take_bit_eq_mod)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   757
      with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (k * 2) div take_bit LENGTH('a) 2)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   758
        = take_bit LENGTH('a) k\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   759
        by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   760
    qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   761
    ultimately show ?thesis
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   762
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   763
  next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   764
    case True
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   765
    moreover have \<open>(1 + a * 2) div 2 = a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   766
    using that proof transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   767
      fix k :: int
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   768
      from length have \<open>(1 + k * 2) mod 2 ^ LENGTH('a) = 1 + (k mod 2 ^ n) * 2\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   769
        using pos_zmod_mult_2 [of \<open>2 ^ n\<close> k] by (simp add: ac_simps)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   770
      moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   771
      with \<open>LENGTH('a) = Suc n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   772
      have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   773
        by (simp add: take_bit_eq_mod divmod_digit_0)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   774
      ultimately have \<open>take_bit LENGTH('a) (1 + k * 2) = 1 + take_bit LENGTH('a) k * 2\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   775
        by (simp add: take_bit_eq_mod)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   776
      with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (1 + k * 2) div take_bit LENGTH('a) 2)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   777
        = take_bit LENGTH('a) k\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   778
        by (auto simp add: take_bit_Suc)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   779
    qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   780
    ultimately show ?thesis
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   781
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   782
  qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   783
qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   784
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   785
lemma even_mult_exp_div_word_iff:
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   786
  \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> \<not> (
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   787
    m \<le> n \<and>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   788
    n < LENGTH('a) \<and> odd (a div 2 ^ (n - m)))\<close> for a :: \<open>'a::len word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   789
  by transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   790
    (auto simp flip: drop_bit_eq_div simp add: even_drop_bit_iff_not_bit bit_take_bit_iff,
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   791
      simp_all flip: push_bit_eq_mult add: bit_push_bit_iff_int)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   792
71965
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   793
instantiation word :: (len) semiring_bits
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   794
begin
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   795
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   796
lift_definition bit_word :: \<open>'a word \<Rightarrow> nat \<Rightarrow> bool\<close>
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   797
  is \<open>\<lambda>k n. n < LENGTH('a) \<and> bit k n\<close>
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   798
proof
71965
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   799
  fix k l :: int and n :: nat
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   800
  assume *: \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   801
  show \<open>n < LENGTH('a) \<and> bit k n \<longleftrightarrow> n < LENGTH('a) \<and> bit l n\<close>
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   802
  proof (cases \<open>n < LENGTH('a)\<close>)
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   803
    case True
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   804
    from * have \<open>bit (take_bit LENGTH('a) k) n \<longleftrightarrow> bit (take_bit LENGTH('a) l) n\<close>
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   805
      by simp
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   806
    then show ?thesis
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   807
      by (simp add: bit_take_bit_iff)
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   808
  next
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   809
    case False
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   810
    then show ?thesis
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   811
      by simp
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   812
  qed
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   813
qed
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   814
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   815
instance proof
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   816
  show \<open>P a\<close> if stable: \<open>\<And>a. a div 2 = a \<Longrightarrow> P a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   817
    and rec: \<open>\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   818
  for P and a :: \<open>'a word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   819
  proof (induction a rule: word_bit_induct)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   820
    case zero
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   821
    have \<open>0 div 2 = (0::'a word)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   822
      by transfer simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   823
    with stable [of 0] show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   824
      by simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   825
  next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   826
    case (even a)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   827
    with rec [of a False] show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   828
      using bit_word_half_eq [of a False] by (simp add: ac_simps)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   829
  next
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   830
    case (odd a)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   831
    with rec [of a True] show ?case
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   832
      using bit_word_half_eq [of a True] by (simp add: ac_simps)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   833
  qed
71965
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   834
  show \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close> for a :: \<open>'a word\<close> and n
d45f5d4c41bd more class operations for the sake of efficient generated code
haftmann
parents: 71958
diff changeset
   835
    by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit bit_iff_odd_drop_bit)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   836
  show \<open>0 div a = 0\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   837
    for a :: \<open>'a word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   838
    by transfer simp
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   839
  show \<open>a div 1 = a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   840
    for a :: \<open>'a word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   841
    by transfer simp
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
   842
  have \<section>: "\<And>i n. (i::int) mod 2 ^ n = 0 \<or> 0 < i mod 2 ^ n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
   843
    by (metis le_less take_bit_eq_mod take_bit_nonnegative)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
   844
  have less_power: "\<And>n i p. (i::int) mod numeral p ^ n < numeral p ^ n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
   845
    by simp
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   846
  show \<open>a mod b div b = 0\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   847
    for a b :: \<open>'a word\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   848
    apply transfer
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
   849
    apply (simp add: take_bit_eq_mod mod_eq_0_iff_dvd dvd_def)
73932
fd21b4a93043 added opaque_combs and renamed hide_lams to opaque_lifting
desharna
parents: 73853
diff changeset
   850
    by (metis (no_types, opaque_lifting) "\<section>" Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign le_less_trans mult_eq_0_iff take_bit_eq_mod take_bit_nonnegative zdiv_eq_0_iff zmod_le_nonneg_dividend)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   851
  show \<open>(1 + a) div 2 = a div 2\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   852
    if \<open>even a\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   853
    for a :: \<open>'a word\<close>
71953
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
   854
    using that by transfer
73535
0f33c7031ec9 new lemmas
haftmann
parents: 72954
diff changeset
   855
      (auto dest: le_Suc_ex simp add: take_bit_Suc elim!: evenE)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   856
  show \<open>(2 :: 'a word) ^ m div 2 ^ n = of_bool ((2 :: 'a word) ^ m \<noteq> 0 \<and> n \<le> m) * 2 ^ (m - n)\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   857
    for m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   858
    by transfer (simp, simp add: exp_div_exp_eq)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   859
  show "a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)"
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   860
    for a :: "'a word" and m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   861
    apply transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   862
    apply (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: drop_bit_eq_div)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   863
    apply (simp add: drop_bit_take_bit)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   864
    done
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   865
  show "a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n"
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   866
    for a :: "'a word" and m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   867
    by transfer (auto simp flip: take_bit_eq_mod simp add: ac_simps)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   868
  show \<open>a * 2 ^ m mod 2 ^ n = a mod 2 ^ (n - m) * 2 ^ m\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   869
    if \<open>m \<le> n\<close> for a :: "'a word" and m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   870
    using that apply transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   871
    apply (auto simp flip: take_bit_eq_mod)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   872
           apply (auto simp flip: push_bit_eq_mult simp add: push_bit_take_bit split: split_min_lin)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   873
    done
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   874
  show \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   875
    for a :: "'a word" and m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   876
    by transfer (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: take_bit_eq_mod drop_bit_eq_div split: split_min_lin)
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   877
  show \<open>even ((2 ^ m - 1) div (2::'a word) ^ n) \<longleftrightarrow> 2 ^ n = (0::'a word) \<or> m \<le> n\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   878
    for m n :: nat
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
   879
    by transfer
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
   880
      (simp flip: drop_bit_eq_div mask_eq_exp_minus_1 add: bit_simps even_drop_bit_iff_not_bit not_less)
71951
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   881
  show \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> n < m \<or> (2::'a word) ^ n = 0 \<or> m \<le> n \<and> even (a div 2 ^ (n - m))\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   882
    for a :: \<open>'a word\<close> and m n :: nat
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   883
  proof transfer
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   884
    show \<open>even (take_bit LENGTH('a) (k * 2 ^ m) div take_bit LENGTH('a) (2 ^ n)) \<longleftrightarrow>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   885
      n < m
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   886
      \<or> take_bit LENGTH('a) ((2::int) ^ n) = take_bit LENGTH('a) 0
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   887
      \<or> (m \<le> n \<and> even (take_bit LENGTH('a) k div take_bit LENGTH('a) (2 ^ (n - m))))\<close>
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   888
    for m n :: nat and k l :: int
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   889
      by (auto simp flip: take_bit_eq_mod drop_bit_eq_div push_bit_eq_mult
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   890
        simp add: div_push_bit_of_1_eq_drop_bit drop_bit_take_bit drop_bit_push_bit_int [of n m])
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   891
  qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   892
qed
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   893
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   894
end
ac6f9738c200 essential instance about bit structure
haftmann
parents: 71950
diff changeset
   895
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   896
lemma bit_word_eqI:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   897
  \<open>a = b\<close> if \<open>\<And>n. n < LENGTH('a) \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   898
  for a b :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   899
  using that by transfer (auto simp add: nat_less_le bit_eq_iff bit_take_bit_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   900
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   901
lemma bit_imp_le_length:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   902
  \<open>n < LENGTH('a)\<close> if \<open>bit w n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   903
    for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   904
  using that by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   905
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   906
lemma not_bit_length [simp]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   907
  \<open>\<not> bit w LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   908
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   909
72830
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   910
lemma finite_bit_word [simp]:
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   911
  \<open>finite {n. bit w n}\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   912
  for w :: \<open>'a::len word\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   913
proof -
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   914
  have \<open>{n. bit w n} \<subseteq> {0..LENGTH('a)}\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   915
    by (auto dest: bit_imp_le_length)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   916
  moreover have \<open>finite {0..LENGTH('a)}\<close>
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   917
    by simp
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   918
  ultimately show ?thesis
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   919
    by (rule finite_subset)
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   920
qed
ec0d3a62bb3b moved some lemmas from AFP to distribution
haftmann
parents: 72735
diff changeset
   921
73789
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   922
lemma bit_numeral_word_iff [simp]:
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   923
  \<open>bit (numeral w :: 'a::len word) n
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   924
    \<longleftrightarrow> n < LENGTH('a) \<and> bit (numeral w :: int) n\<close>
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   925
  by transfer simp
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   926
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   927
lemma bit_neg_numeral_word_iff [simp]:
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   928
  \<open>bit (- numeral w :: 'a::len word) n
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   929
    \<longleftrightarrow> n < LENGTH('a) \<and> bit (- numeral w :: int) n\<close>
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   930
  by transfer simp
aab7975fa070 more lemmas
haftmann
parents: 73788
diff changeset
   931
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   932
instantiation word :: (len) ring_bit_operations
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   933
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   934
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   935
lift_definition not_word :: \<open>'a word \<Rightarrow> 'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   936
  is not
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   937
  by (simp add: take_bit_not_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   938
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   939
lift_definition and_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   940
  is \<open>and\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   941
  by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   942
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   943
lift_definition or_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   944
  is or
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   945
  by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   946
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   947
lift_definition xor_word ::  \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   948
  is xor
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   949
  by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   950
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   951
lift_definition mask_word :: \<open>nat \<Rightarrow> 'a word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   952
  is mask
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   953
  .
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   954
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   955
lift_definition set_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   956
  is set_bit
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   957
  by (simp add: set_bit_def)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   958
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   959
lift_definition unset_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   960
  is unset_bit
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   961
  by (simp add: unset_bit_def)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   962
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   963
lift_definition flip_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   964
  is flip_bit
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   965
  by (simp add: flip_bit_def)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
   966
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   967
lift_definition push_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   968
  is push_bit
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   969
proof -
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   970
  show \<open>take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   971
    if \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> for k l :: int and n :: nat
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   972
  proof -
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   973
    from that
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   974
    have \<open>take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   975
      = take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   976
      by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   977
    moreover have \<open>min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   978
      by simp
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   979
    ultimately show ?thesis
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   980
      by (simp add: take_bit_push_bit)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   981
  qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   982
qed
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   983
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   984
lift_definition drop_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   985
  is \<open>\<lambda>n. drop_bit n \<circ> take_bit LENGTH('a)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   986
  by (simp add: take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   987
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   988
lift_definition take_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   989
  is \<open>\<lambda>n. take_bit (min LENGTH('a) n)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   990
  by (simp add: ac_simps) (simp only: flip: take_bit_take_bit)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   991
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   992
instance apply (standard; transfer)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   993
  apply (auto simp add: minus_eq_not_minus_1 mask_eq_exp_minus_1
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   994
    bit_simps set_bit_def flip_bit_def take_bit_drop_bit
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   995
    simp flip: drop_bit_eq_div take_bit_eq_mod)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   996
   apply (simp_all add: drop_bit_take_bit flip: push_bit_eq_mult)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
   997
  done
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   998
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
   999
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1000
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1001
lemma [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1002
  \<open>push_bit n w = w * 2 ^ n\<close> for w :: \<open>'a::len word\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1003
  by (fact push_bit_eq_mult)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1004
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1005
lemma [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1006
  \<open>Word.the_int (drop_bit n w) = drop_bit n (Word.the_int w)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1007
  by transfer (simp add: drop_bit_take_bit min_def le_less less_diff_conv)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1008
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1009
lemma [code]:
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1010
  \<open>Word.the_int (take_bit n w) = (if n < LENGTH('a::len) then take_bit n (Word.the_int w) else Word.the_int w)\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1011
  for w :: \<open>'a::len word\<close>
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1012
  by transfer (simp add: not_le not_less ac_simps min_absorb2)
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1013
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1014
lemma [code_abbrev]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1015
  \<open>push_bit n 1 = (2 :: 'a::len word) ^ n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1016
  by (fact push_bit_of_1)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1017
74391
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1018
context
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1019
  includes bit_operations_syntax
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1020
begin
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1021
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1022
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1023
  \<open>NOT w = Word.of_int (NOT (Word.the_int w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1024
  for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1025
  by transfer (simp add: take_bit_not_take_bit) 
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1026
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1027
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1028
  \<open>Word.the_int (v AND w) = Word.the_int v AND Word.the_int w\<close>
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1029
  by transfer simp
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1030
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1031
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1032
  \<open>Word.the_int (v OR w) = Word.the_int v OR Word.the_int w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1033
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1034
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1035
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1036
  \<open>Word.the_int (v XOR w) = Word.the_int v XOR Word.the_int w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1037
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1038
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1039
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1040
  \<open>Word.the_int (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1041
  by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1042
73682
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1043
lemma [code]:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1044
  \<open>set_bit n w = w OR push_bit n 1\<close> for w :: \<open>'a::len word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1045
  by (fact set_bit_eq_or)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1046
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1047
lemma [code]:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1048
  \<open>unset_bit n w = w AND NOT (push_bit n 1)\<close> for w :: \<open>'a::len word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1049
  by (fact unset_bit_eq_and_not)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1050
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1051
lemma [code]:
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1052
  \<open>flip_bit n w = w XOR push_bit n 1\<close> for w :: \<open>'a::len word\<close>
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1053
  by (fact flip_bit_eq_xor)
78044b2f001c explicit type class operations for type-specific implementations
haftmann
parents: 73535
diff changeset
  1054
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1055
context
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1056
  includes lifting_syntax
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1057
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1058
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1059
lemma set_bit_word_transfer [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1060
  \<open>((=) ===> pcr_word ===> pcr_word) set_bit set_bit\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1061
  by (unfold set_bit_def) transfer_prover
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1062
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1063
lemma unset_bit_word_transfer [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1064
  \<open>((=) ===> pcr_word ===> pcr_word) unset_bit unset_bit\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1065
  by (unfold unset_bit_def) transfer_prover
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1066
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1067
lemma flip_bit_word_transfer [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1068
  \<open>((=) ===> pcr_word ===> pcr_word) flip_bit flip_bit\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1069
  by (unfold flip_bit_def) transfer_prover
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1070
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1071
lemma signed_take_bit_word_transfer [transfer_rule]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1072
  \<open>((=) ===> pcr_word ===> pcr_word)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1073
    (\<lambda>n k. signed_take_bit n (take_bit LENGTH('a::len) k))
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1074
    (signed_take_bit :: nat \<Rightarrow> 'a word \<Rightarrow> 'a word)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1075
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1076
  let ?K = \<open>\<lambda>n (k :: int). take_bit (min LENGTH('a) n) k OR of_bool (n < LENGTH('a) \<and> bit k n) * NOT (mask n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1077
  let ?W = \<open>\<lambda>n (w :: 'a word). take_bit n w OR of_bool (bit w n) * NOT (mask n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1078
  have \<open>((=) ===> pcr_word ===> pcr_word) ?K ?W\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1079
    by transfer_prover
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1080
  also have \<open>?K = (\<lambda>n k. signed_take_bit n (take_bit LENGTH('a::len) k))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1081
    by (simp add: fun_eq_iff signed_take_bit_def bit_take_bit_iff ac_simps)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1082
  also have \<open>?W = signed_take_bit\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1083
    by (simp add: fun_eq_iff signed_take_bit_def)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1084
  finally show ?thesis .
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1085
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1086
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1087
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1088
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1089
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1090
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1091
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1092
subsection \<open>Conversions including casts\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1093
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1094
subsubsection \<open>Generic unsigned conversion\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1095
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1096
context semiring_bits
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1097
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1098
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  1099
lemma bit_unsigned_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
  1100
  \<open>bit (unsigned w) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit w n\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1101
  for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1102
  by (transfer fixing: bit) (simp add: bit_of_nat_iff bit_nat_iff bit_take_bit_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1103
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1104
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1105
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
  1106
lemma possible_bit_word[simp]:
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
  1107
  \<open>possible_bit TYPE(('a :: len) word) m \<longleftrightarrow> m < LENGTH('a)\<close>
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
  1108
  by (simp add: possible_bit_def linorder_not_le)
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
  1109
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1110
context semiring_bit_operations
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1111
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1112
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1113
lemma unsigned_minus_1_eq_mask:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1114
  \<open>unsigned (- 1 :: 'b::len word) = mask LENGTH('b)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1115
  by (transfer fixing: mask) (simp add: nat_mask_eq of_nat_mask_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1116
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1117
lemma unsigned_push_bit_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1118
  \<open>unsigned (push_bit n w) = take_bit LENGTH('b) (push_bit n (unsigned w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1119
  for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1120
proof (rule bit_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1121
  fix m
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
  1122
  assume \<open>possible_bit TYPE('a) m\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1123
  show \<open>bit (unsigned (push_bit n w)) m = bit (take_bit LENGTH('b) (push_bit n (unsigned w))) m\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1124
  proof (cases \<open>n \<le> m\<close>)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1125
    case True
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
  1126
    with \<open>possible_bit TYPE('a) m\<close> have \<open>possible_bit TYPE('a) (m - n)\<close>
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
  1127
      by (simp add: possible_bit_less_imp)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1128
    with True show ?thesis
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1129
      by (simp add: bit_unsigned_iff bit_push_bit_iff Bit_Operations.bit_push_bit_iff bit_take_bit_iff not_le ac_simps)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1130
  next
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1131
    case False
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1132
    then show ?thesis
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1133
      by (simp add: not_le bit_unsigned_iff bit_push_bit_iff Bit_Operations.bit_push_bit_iff bit_take_bit_iff)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1134
  qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1135
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1136
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1137
lemma unsigned_take_bit_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1138
  \<open>unsigned (take_bit n w) = take_bit n (unsigned w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1139
  for w :: \<open>'b::len word\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1140
  by (rule bit_eqI) (simp add: bit_unsigned_iff bit_take_bit_iff Bit_Operations.bit_take_bit_iff)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1141
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1142
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1143
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1144
context unique_euclidean_semiring_with_bit_operations
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1145
begin
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1146
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1147
lemma unsigned_drop_bit_eq:
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1148
  \<open>unsigned (drop_bit n w) = drop_bit n (take_bit LENGTH('b) (unsigned w))\<close>
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1149
  for w :: \<open>'b::len word\<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
  1150
  by (rule bit_eqI) (auto simp add: bit_unsigned_iff bit_take_bit_iff bit_drop_bit_eq Bit_Operations.bit_drop_bit_eq possible_bit_def dest: bit_imp_le_length)
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1151
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1152
end
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  1153
73853
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  1154
lemma ucast_drop_bit_eq:
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  1155
  \<open>ucast (drop_bit n w) = drop_bit n (ucast w :: 'b::len word)\<close>
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  1156
  if \<open>LENGTH('a) \<le> LENGTH('b)\<close> for w :: \<open>'a::len word\<close>
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  1157
  by (rule bit_word_eqI) (use that in \<open>auto simp add: bit_unsigned_iff bit_drop_bit_eq dest: bit_imp_le_length\<close>)
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  1158
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1159
context semiring_bit_operations
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1160
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1161
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1162
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1163
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1164
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1165
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1166
lemma unsigned_and_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1167
  \<open>unsigned (v AND w) = unsigned v AND unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1168
  for v w :: \<open>'b::len word\<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
  1169
  by (simp add: bit_eq_iff bit_simps)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1170
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1171
lemma unsigned_or_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1172
  \<open>unsigned (v OR w) = unsigned v OR unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1173
  for v w :: \<open>'b::len word\<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
  1174
  by (simp add: bit_eq_iff bit_simps)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1175
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1176
lemma unsigned_xor_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1177
  \<open>unsigned (v XOR w) = unsigned v XOR unsigned w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1178
  for v w :: \<open>'b::len word\<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
  1179
  by (simp add: bit_eq_iff bit_simps)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1180
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1181
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1182
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1183
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1184
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1185
context ring_bit_operations
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1186
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1187
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1188
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1189
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1190
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1191
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1192
lemma unsigned_not_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1193
  \<open>unsigned (NOT w) = take_bit LENGTH('b) (NOT (unsigned w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1194
  for w :: \<open>'b::len word\<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
  1195
  by (simp add: bit_eq_iff bit_simps)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1196
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1197
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1198
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1199
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1200
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1201
context unique_euclidean_semiring_numeral
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1202
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1203
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  1204
lemma unsigned_greater_eq [simp]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1205
  \<open>0 \<le> unsigned w\<close> for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1206
  by (transfer fixing: less_eq) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1207
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  1208
lemma unsigned_less [simp]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1209
  \<open>unsigned w < 2 ^ LENGTH('b)\<close> for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1210
  by (transfer fixing: less) simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1211
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1212
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1213
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1214
context linordered_semidom
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1215
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1216
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1217
lemma word_less_eq_iff_unsigned:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1218
  "a \<le> b \<longleftrightarrow> unsigned a \<le> unsigned b"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1219
  by (transfer fixing: less_eq) (simp add: nat_le_eq_zle)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1220
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1221
lemma word_less_iff_unsigned:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1222
  "a < b \<longleftrightarrow> unsigned a < unsigned b"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1223
  by (transfer fixing: less) (auto dest: preorder_class.le_less_trans [OF take_bit_nonnegative])
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1224
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1225
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1226
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1227
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1228
subsubsection \<open>Generic signed conversion\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1229
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1230
context ring_bit_operations
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1231
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1232
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  1233
lemma bit_signed_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
  1234
  \<open>bit (signed w) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit w (min (LENGTH('b) - Suc 0) n)\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1235
  for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1236
  by (transfer fixing: bit)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1237
    (auto simp add: bit_of_int_iff Bit_Operations.bit_signed_take_bit_iff min_def)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1238
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1239
lemma signed_push_bit_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1240
  \<open>signed (push_bit n w) = signed_take_bit (LENGTH('b) - Suc 0) (push_bit n (signed w :: 'a))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1241
  for w :: \<open>'b::len word\<close>
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  1242
  apply (simp add: bit_eq_iff bit_simps possible_bit_less_imp min_less_iff_disj)
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
  1243
  apply (cases n, simp_all add: min_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
  1244
  done
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1245
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1246
lemma signed_take_bit_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1247
  \<open>signed (take_bit n w) = (if n < LENGTH('b) then take_bit n (signed w) else signed w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1248
  for w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1249
  by (transfer fixing: take_bit; cases \<open>LENGTH('b)\<close>)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1250
    (auto simp add: Bit_Operations.signed_take_bit_take_bit Bit_Operations.take_bit_signed_take_bit take_bit_of_int min_def less_Suc_eq)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1251
74391
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1252
context
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1253
  includes bit_operations_syntax
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1254
begin
930047942f46 repaired slip
haftmann
parents: 74309
diff changeset
  1255
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1256
lemma signed_not_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1257
  \<open>signed (NOT w) = signed_take_bit LENGTH('b) (NOT (signed w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1258
  for w :: \<open>'b::len word\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1259
  by (simp add: bit_eq_iff bit_simps possible_bit_less_imp min_less_iff_disj)
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
  1260
    (auto simp: min_def)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1261
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1262
lemma signed_and_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1263
  \<open>signed (v AND w) = signed v AND signed w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1264
  for v w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1265
  by (rule bit_eqI) (simp add: bit_signed_iff bit_and_iff Bit_Operations.bit_and_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1266
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1267
lemma signed_or_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1268
  \<open>signed (v OR w) = signed v OR signed w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1269
  for v w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1270
  by (rule bit_eqI) (simp add: bit_signed_iff bit_or_iff Bit_Operations.bit_or_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1271
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1272
lemma signed_xor_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1273
  \<open>signed (v XOR w) = signed v XOR signed w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1274
  for v w :: \<open>'b::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1275
  by (rule bit_eqI) (simp add: bit_signed_iff bit_xor_iff Bit_Operations.bit_xor_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1276
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1277
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1278
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1279
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1280
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1281
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1282
subsubsection \<open>More\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1283
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1284
lemma sint_greater_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1285
  \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> sint w\<close> for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1286
proof (cases \<open>bit w (LENGTH('a) - Suc 0)\<close>)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1287
  case True
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1288
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1289
    by transfer (simp add: signed_take_bit_eq_if_negative minus_exp_eq_not_mask or_greater_eq ac_simps)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1290
next
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1291
  have *: \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> (0::int)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1292
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1293
  case False
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1294
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1295
    by transfer (auto simp add: signed_take_bit_eq intro: order_trans *)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1296
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1297
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1298
lemma sint_less:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1299
  \<open>sint w < 2 ^ (LENGTH('a) - Suc 0)\<close> for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1300
  by (cases \<open>bit w (LENGTH('a) - Suc 0)\<close>; transfer)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1301
    (simp_all add: signed_take_bit_eq signed_take_bit_def not_eq_complement mask_eq_exp_minus_1 OR_upper)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1302
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1303
lemma unat_div_distrib:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1304
  \<open>unat (v div w) = unat v div unat w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1305
proof transfer
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1306
  fix k l
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1307
  have \<open>nat (take_bit LENGTH('a) k) div nat (take_bit LENGTH('a) l) \<le> nat (take_bit LENGTH('a) k)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1308
    by (rule div_le_dividend)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1309
  also have \<open>nat (take_bit LENGTH('a) k) < 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1310
    by (simp add: nat_less_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1311
  finally show \<open>(nat \<circ> take_bit LENGTH('a)) (take_bit LENGTH('a) k div take_bit LENGTH('a) l) =
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1312
    (nat \<circ> take_bit LENGTH('a)) k div (nat \<circ> take_bit LENGTH('a)) l\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1313
    by (simp add: nat_take_bit_eq div_int_pos_iff nat_div_distrib take_bit_nat_eq_self_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1314
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1315
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1316
lemma unat_mod_distrib:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1317
  \<open>unat (v mod w) = unat v mod unat w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1318
proof transfer
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1319
  fix k l
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1320
  have \<open>nat (take_bit LENGTH('a) k) mod nat (take_bit LENGTH('a) l) \<le> nat (take_bit LENGTH('a) k)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1321
    by (rule mod_less_eq_dividend)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1322
  also have \<open>nat (take_bit LENGTH('a) k) < 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1323
    by (simp add: nat_less_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1324
  finally show \<open>(nat \<circ> take_bit LENGTH('a)) (take_bit LENGTH('a) k mod take_bit LENGTH('a) l) =
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1325
    (nat \<circ> take_bit LENGTH('a)) k mod (nat \<circ> take_bit LENGTH('a)) l\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1326
    by (simp add: nat_take_bit_eq mod_int_pos_iff less_le nat_mod_distrib take_bit_nat_eq_self_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1327
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1328
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1329
lemma uint_div_distrib:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1330
  \<open>uint (v div w) = uint v div uint w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1331
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1332
  have \<open>int (unat (v div w)) = int (unat v div unat w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1333
    by (simp add: unat_div_distrib)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1334
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1335
    by (simp add: of_nat_div)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1336
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1337
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1338
lemma unat_drop_bit_eq:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1339
  \<open>unat (drop_bit n w) = drop_bit n (unat w)\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1340
  by (rule bit_eqI) (simp add: bit_unsigned_iff bit_drop_bit_eq)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1341
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1342
lemma uint_mod_distrib:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1343
  \<open>uint (v mod w) = uint v mod uint w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1344
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1345
  have \<open>int (unat (v mod w)) = int (unat v mod unat w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1346
    by (simp add: unat_mod_distrib)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1347
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1348
    by (simp add: of_nat_mod)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1349
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1350
74108
3146646a43a7 simplified hierarchy of type classes for bit operations
haftmann
parents: 74101
diff changeset
  1351
context semiring_bit_operations
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1352
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1353
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1354
lemma unsigned_ucast_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1355
  \<open>unsigned (ucast w :: 'c::len word) = take_bit LENGTH('c) (unsigned w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1356
  for w :: \<open>'b::len word\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  1357
  by (rule bit_eqI) (simp add: bit_unsigned_iff Word.bit_unsigned_iff bit_take_bit_iff not_le)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1358
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1359
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1360
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1361
context ring_bit_operations
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1362
begin
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1363
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1364
lemma signed_ucast_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1365
  \<open>signed (ucast w :: 'c::len word) = signed_take_bit (LENGTH('c) - Suc 0) (unsigned w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1366
  for w :: \<open>'b::len word\<close>
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1367
  by (simp add: bit_eq_iff bit_simps min_less_iff_disj)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1368
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1369
lemma signed_scast_eq:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1370
  \<open>signed (scast w :: 'c::len word) = signed_take_bit (LENGTH('c) - Suc 0) (signed w)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1371
  for w :: \<open>'b::len word\<close>
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  1372
  by (simp add: bit_eq_iff bit_simps min_less_iff_disj)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1373
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1374
end
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1375
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1376
lemma uint_nonnegative: "0 \<le> uint w"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1377
  by (fact unsigned_greater_eq)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1378
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1379
lemma uint_bounded: "uint w < 2 ^ LENGTH('a)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1380
  for w :: "'a::len word"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1381
  by (fact unsigned_less)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1382
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1383
lemma uint_idem: "uint w mod 2 ^ LENGTH('a) = uint w"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1384
  for w :: "'a::len word"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1385
  by transfer (simp add: take_bit_eq_mod)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1386
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1387
lemma word_uint_eqI: "uint a = uint b \<Longrightarrow> a = b"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1388
  by (fact unsigned_word_eqI)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1389
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1390
lemma word_uint_eq_iff: "a = b \<longleftrightarrow> uint a = uint b"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1391
  by (fact word_eq_iff_unsigned)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1392
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1393
lemma uint_word_of_int_eq:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1394
  \<open>uint (word_of_int k :: 'a::len word) = take_bit LENGTH('a) k\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1395
  by transfer rule
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1396
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1397
lemma uint_word_of_int: "uint (word_of_int k :: 'a::len word) = k mod 2 ^ LENGTH('a)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1398
  by (simp add: uint_word_of_int_eq take_bit_eq_mod)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1399
  
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1400
lemma word_of_int_uint: "word_of_int (uint w) = w"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1401
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1402
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1403
lemma word_div_def [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1404
  "a div b = word_of_int (uint a div uint b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1405
  by transfer rule
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1406
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1407
lemma word_mod_def [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1408
  "a mod b = word_of_int (uint a mod uint b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1409
  by transfer rule
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1410
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1411
lemma split_word_all: "(\<And>x::'a::len word. PROP P x) \<equiv> (\<And>x. PROP P (word_of_int x))"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1412
proof
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1413
  fix x :: "'a word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1414
  assume "\<And>x. PROP P (word_of_int x)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1415
  then have "PROP P (word_of_int (uint x))" .
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1416
  then show "PROP P x"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1417
    by (simp only: word_of_int_uint)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1418
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1419
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1420
lemma sint_uint:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1421
  \<open>sint w = signed_take_bit (LENGTH('a) - Suc 0) (uint w)\<close>
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1422
  for w :: \<open>'a::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1423
  by (cases \<open>LENGTH('a)\<close>; transfer) (simp_all add: signed_take_bit_take_bit)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1424
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1425
lemma unat_eq_nat_uint:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1426
  \<open>unat w = nat (uint w)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1427
  by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1428
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1429
lemma ucast_eq:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1430
  \<open>ucast w = word_of_int (uint w)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1431
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1432
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1433
lemma scast_eq:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1434
  \<open>scast w = word_of_int (sint w)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1435
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1436
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1437
lemma uint_0_eq:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1438
  \<open>uint 0 = 0\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1439
  by (fact unsigned_0)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1440
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1441
lemma uint_1_eq:
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1442
  \<open>uint 1 = 1\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1443
  by (fact unsigned_1)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1444
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1445
lemma word_m1_wi: "- 1 = word_of_int (- 1)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1446
  by simp
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1447
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1448
lemma uint_0_iff: "uint x = 0 \<longleftrightarrow> x = 0"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1449
  by (auto simp add: unsigned_word_eqI)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1450
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1451
lemma unat_0_iff: "unat x = 0 \<longleftrightarrow> x = 0"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1452
  by (auto simp add: unsigned_word_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1453
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1454
lemma unat_0: "unat 0 = 0"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1455
  by (fact unsigned_0)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1456
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1457
lemma unat_gt_0: "0 < unat x \<longleftrightarrow> x \<noteq> 0"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1458
  by (auto simp: unat_0_iff [symmetric])
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1459
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1460
lemma ucast_0: "ucast 0 = 0"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1461
  by (fact unsigned_0)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1462
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1463
lemma sint_0: "sint 0 = 0"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1464
  by (fact signed_0)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1465
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1466
lemma scast_0: "scast 0 = 0"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1467
  by (fact signed_0)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1468
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1469
lemma sint_n1: "sint (- 1) = - 1"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1470
  by (fact signed_minus_1)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1471
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1472
lemma scast_n1: "scast (- 1) = - 1"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1473
  by (fact signed_minus_1)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1474
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1475
lemma uint_1: "uint (1::'a::len word) = 1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1476
  by (fact uint_1_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1477
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1478
lemma unat_1: "unat (1::'a::len word) = 1"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1479
  by (fact unsigned_1)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1480
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1481
lemma ucast_1: "ucast (1::'a::len word) = 1"
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1482
  by (fact unsigned_1)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1483
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1484
instantiation word :: (len) size
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1485
begin
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1486
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1487
lift_definition size_word :: \<open>'a word \<Rightarrow> nat\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1488
  is \<open>\<lambda>_. LENGTH('a)\<close> ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1489
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1490
instance ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1491
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1492
end
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1493
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1494
lemma word_size [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1495
  \<open>size w = LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1496
  by (fact size_word.rep_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1497
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1498
lemma word_size_gt_0 [iff]: "0 < size w"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1499
  for w :: "'a::len word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1500
  by (simp add: word_size)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1501
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1502
lemmas lens_gt_0 = word_size_gt_0 len_gt_0
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1503
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1504
lemma lens_not_0 [iff]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1505
  \<open>size w \<noteq> 0\<close> for  w :: \<open>'a::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1506
  by auto
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1507
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1508
lift_definition source_size :: \<open>('a::len word \<Rightarrow> 'b) \<Rightarrow> nat\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1509
  is \<open>\<lambda>_. LENGTH('a)\<close> .
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1510
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1511
lift_definition target_size :: \<open>('a \<Rightarrow> 'b::len word) \<Rightarrow> nat\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1512
  is \<open>\<lambda>_. LENGTH('b)\<close> ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1513
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1514
lift_definition is_up :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1515
  is \<open>\<lambda>_. LENGTH('a) \<le> LENGTH('b)\<close> ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1516
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1517
lift_definition is_down :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1518
  is \<open>\<lambda>_. LENGTH('a) \<ge> LENGTH('b)\<close> ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1519
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1520
lemma is_up_eq:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1521
  \<open>is_up f \<longleftrightarrow> source_size f \<le> target_size f\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1522
  for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1523
  by (simp add: source_size.rep_eq target_size.rep_eq is_up.rep_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1524
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1525
lemma is_down_eq:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1526
  \<open>is_down f \<longleftrightarrow> target_size f \<le> source_size f\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1527
  for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1528
  by (simp add: source_size.rep_eq target_size.rep_eq is_down.rep_eq)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1529
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1530
lift_definition word_int_case :: \<open>(int \<Rightarrow> 'b) \<Rightarrow> 'a::len word \<Rightarrow> 'b\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1531
  is \<open>\<lambda>f. f \<circ> take_bit LENGTH('a)\<close> by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1532
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1533
lemma word_int_case_eq_uint [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1534
  \<open>word_int_case f w = f (uint w)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1535
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1536
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1537
translations
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1538
  "case x of XCONST of_int y \<Rightarrow> b" \<rightleftharpoons> "CONST word_int_case (\<lambda>y. b) x"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1539
  "case x of (XCONST of_int :: 'a) y \<Rightarrow> b" \<rightharpoonup> "CONST word_int_case (\<lambda>y. b) x"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1540
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1541
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1542
subsection \<open>Arithmetic operations\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1543
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1544
lemma div_word_self:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1545
  \<open>w div w = 1\<close> if \<open>w \<noteq> 0\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1546
  using that by transfer simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1547
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1548
lemma mod_word_self [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1549
  \<open>w mod w = 0\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1550
  apply (cases \<open>w = 0\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1551
  apply auto
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1552
  using div_mult_mod_eq [of w w] by (simp add: div_word_self)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1553
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1554
lemma div_word_less:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1555
  \<open>w div v = 0\<close> if \<open>w < v\<close> for w v :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1556
  using that by transfer simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1557
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1558
lemma mod_word_less:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1559
  \<open>w mod v = w\<close> if \<open>w < v\<close> for w v :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1560
  using div_mult_mod_eq [of w v] using that by (simp add: div_word_less)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1561
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1562
lemma div_word_one [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1563
  \<open>1 div w = of_bool (w = 1)\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1564
proof transfer
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1565
  fix k :: int
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1566
  show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) 1 div take_bit LENGTH('a) k) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1567
         take_bit LENGTH('a) (of_bool (take_bit LENGTH('a) k = take_bit LENGTH('a) 1))\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1568
  proof (cases \<open>take_bit LENGTH('a) k > 1\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1569
    case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1570
    with take_bit_nonnegative [of \<open>LENGTH('a)\<close> k]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1571
    have \<open>take_bit LENGTH('a) k = 0 \<or> take_bit LENGTH('a) k = 1\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1572
      by linarith
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1573
    then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1574
      by auto
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1575
  next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1576
    case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1577
    then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1578
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1579
  qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1580
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1581
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1582
lemma mod_word_one [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1583
  \<open>1 mod w = 1 - w * of_bool (w = 1)\<close> for w :: \<open>'a::len word\<close>
75087
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1584
  using div_mult_mod_eq [of 1 w] by auto
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1585
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1586
lemma div_word_by_minus_1_eq [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1587
  \<open>w div - 1 = of_bool (w = - 1)\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1588
  by (auto intro: div_word_less simp add: div_word_self word_order.not_eq_extremum)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1589
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1590
lemma mod_word_by_minus_1_eq [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1591
  \<open>w mod - 1 = w * of_bool (w < - 1)\<close> for w :: \<open>'a::len word\<close>
75087
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1592
proof (cases \<open>w = - 1\<close>)
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1593
  case True
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1594
  then show ?thesis
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1595
    by simp
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1596
next
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1597
  case False
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1598
  moreover have \<open>w < - 1\<close>
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1599
    using False by (simp add: word_order.not_eq_extremum)
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1600
  ultimately show ?thesis
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1601
    by (simp add: mod_word_less)
f3fcc7c5a0db Avoid overaggresive splitting.
haftmann
parents: 75085
diff changeset
  1602
qed
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1603
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1604
text \<open>Legacy theorems:\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1605
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1606
lemma word_add_def [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1607
  "a + b = word_of_int (uint a + uint b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1608
  by transfer (simp add: take_bit_add)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1609
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1610
lemma word_sub_wi [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1611
  "a - b = word_of_int (uint a - uint b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1612
  by transfer (simp add: take_bit_diff)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1613
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1614
lemma word_mult_def [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1615
  "a * b = word_of_int (uint a * uint b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1616
  by transfer (simp add: take_bit_eq_mod mod_simps)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1617
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1618
lemma word_minus_def [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1619
  "- a = word_of_int (- uint a)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1620
  by transfer (simp add: take_bit_minus)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1621
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1622
lemma word_0_wi:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1623
  "0 = word_of_int 0"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1624
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1625
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1626
lemma word_1_wi:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1627
  "1 = word_of_int 1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1628
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1629
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1630
lift_definition word_succ :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x + 1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1631
  by (auto simp add: take_bit_eq_mod intro: mod_add_cong)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1632
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1633
lift_definition word_pred :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x - 1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1634
  by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1635
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1636
lemma word_succ_alt [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1637
  "word_succ a = word_of_int (uint a + 1)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1638
  by transfer (simp add: take_bit_eq_mod mod_simps)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1639
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1640
lemma word_pred_alt [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1641
  "word_pred a = word_of_int (uint a - 1)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1642
  by transfer (simp add: take_bit_eq_mod mod_simps)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1643
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1644
lemmas word_arith_wis = 
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1645
  word_add_def word_sub_wi word_mult_def
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1646
  word_minus_def word_succ_alt word_pred_alt
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1647
  word_0_wi word_1_wi
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1648
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1649
lemma wi_homs:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1650
  shows wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1651
    and wi_hom_sub: "word_of_int a - word_of_int b = word_of_int (a - b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1652
    and wi_hom_mult: "word_of_int a * word_of_int b = word_of_int (a * b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1653
    and wi_hom_neg: "- word_of_int a = word_of_int (- a)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1654
    and wi_hom_succ: "word_succ (word_of_int a) = word_of_int (a + 1)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1655
    and wi_hom_pred: "word_pred (word_of_int a) = word_of_int (a - 1)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1656
  by (transfer, simp)+
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1657
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1658
lemmas wi_hom_syms = wi_homs [symmetric]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1659
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1660
lemmas word_of_int_homs = wi_homs word_0_wi word_1_wi
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1661
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1662
lemmas word_of_int_hom_syms = word_of_int_homs [symmetric]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1663
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1664
lemma double_eq_zero_iff:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1665
  \<open>2 * a = 0 \<longleftrightarrow> a = 0 \<or> a = 2 ^ (LENGTH('a) - Suc 0)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1666
  for a :: \<open>'a::len word\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1667
proof -
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1668
  define n where \<open>n = LENGTH('a) - Suc 0\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1669
  then have *: \<open>LENGTH('a) = Suc n\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1670
    by simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1671
  have \<open>a = 0\<close> if \<open>2 * a = 0\<close> and \<open>a \<noteq> 2 ^ (LENGTH('a) - Suc 0)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1672
    using that by transfer
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1673
      (auto simp add: take_bit_eq_0_iff take_bit_eq_mod *)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1674
  moreover have \<open>2 ^ LENGTH('a) = (0 :: 'a word)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1675
    by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1676
  then have \<open>2 * 2 ^ (LENGTH('a) - Suc 0) = (0 :: 'a word)\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1677
    by (simp add: *)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1678
  ultimately show ?thesis
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1679
    by auto
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1680
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1681
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1682
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1683
subsection \<open>Ordering\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1684
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1685
lift_definition word_sle :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1686
  is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - Suc 0) k \<le> signed_take_bit (LENGTH('a) - Suc 0) l\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1687
  by (simp flip: signed_take_bit_decr_length_iff)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1688
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1689
lift_definition word_sless :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1690
  is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - Suc 0) k < signed_take_bit (LENGTH('a) - Suc 0) l\<close>
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1691
  by (simp flip: signed_take_bit_decr_length_iff)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1692
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1693
notation
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1694
  word_sle    ("'(\<le>s')") and
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1695
  word_sle    ("(_/ \<le>s _)"  [51, 51] 50) and
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1696
  word_sless  ("'(<s')") and
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1697
  word_sless  ("(_/ <s _)"  [51, 51] 50)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1698
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1699
notation (input)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1700
  word_sle    ("(_/ <=s _)"  [51, 51] 50)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1701
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1702
lemma word_sle_eq [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1703
  \<open>a <=s b \<longleftrightarrow> sint a \<le> sint b\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1704
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1705
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1706
lemma [code]:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1707
  \<open>a <s b \<longleftrightarrow> sint a < sint b\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1708
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1709
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1710
lemma signed_ordering: \<open>ordering word_sle word_sless\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1711
  apply (standard; transfer)
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1712
  using signed_take_bit_decr_length_iff by force+
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1713
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1714
lemma signed_linorder: \<open>class.linorder word_sle word_sless\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1715
  by (standard; transfer) (auto simp add: signed_take_bit_decr_length_iff)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1716
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1717
interpretation signed: linorder word_sle word_sless
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1718
  by (fact signed_linorder)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1719
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1720
lemma word_sless_eq:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1721
  \<open>x <s y \<longleftrightarrow> x <=s y \<and> x \<noteq> y\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1722
  by (fact signed.less_le)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1723
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1724
lemma word_less_alt: "a < b \<longleftrightarrow> uint a < uint b"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1725
  by (fact word_less_def)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1726
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1727
lemma word_zero_le [simp]: "0 \<le> y"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1728
  for y :: "'a::len word"
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1729
  by (fact word_coorder.extremum)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1730
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1731
lemma word_m1_ge [simp] : "word_pred 0 \<ge> y" (* FIXME: delete *)
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  1732
  by transfer (simp add: mask_eq_exp_minus_1)
72244
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1733
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1734
lemma word_n1_ge [simp]: "y \<le> -1"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1735
  for y :: "'a::len word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1736
  by (fact word_order.extremum)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1737
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1738
lemmas word_not_simps [simp] =
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1739
  word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1740
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1741
lemma word_gt_0: "0 < y \<longleftrightarrow> 0 \<noteq> y"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1742
  for y :: "'a::len word"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1743
  by (simp add: less_le)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1744
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1745
lemmas word_gt_0_no [simp] = word_gt_0 [of "numeral y"] for y
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1746
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1747
lemma word_sless_alt: "a <s b \<longleftrightarrow> sint a < sint b"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1748
  by transfer simp
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1749
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1750
lemma word_le_nat_alt: "a \<le> b \<longleftrightarrow> unat a \<le> unat b"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1751
  by transfer (simp add: nat_le_eq_zle)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1752
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1753
lemma word_less_nat_alt: "a < b \<longleftrightarrow> unat a < unat b"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1754
  by transfer (auto simp add: less_le [of 0])
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1755
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1756
lemmas unat_mono = word_less_nat_alt [THEN iffD1]
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1757
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1758
instance word :: (len) wellorder
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1759
proof
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1760
  fix P :: "'a word \<Rightarrow> bool" and a
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1761
  assume *: "(\<And>b. (\<And>a. a < b \<Longrightarrow> P a) \<Longrightarrow> P b)"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1762
  have "wf (measure unat)" ..
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1763
  moreover have "{(a, b :: ('a::len) word). a < b} \<subseteq> measure unat"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1764
    by (auto simp add: word_less_nat_alt)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1765
  ultimately have "wf {(a, b :: ('a::len) word). a < b}"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1766
    by (rule wf_subset)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1767
  then show "P a" using *
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1768
    by induction blast
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1769
qed
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1770
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1771
lemma wi_less:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1772
  "(word_of_int n < (word_of_int m :: 'a::len word)) =
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1773
    (n mod 2 ^ LENGTH('a) < m mod 2 ^ LENGTH('a))"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1774
  by transfer (simp add: take_bit_eq_mod)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1775
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1776
lemma wi_le:
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1777
  "(word_of_int n \<le> (word_of_int m :: 'a::len word)) =
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1778
    (n mod 2 ^ LENGTH('a) \<le> m mod 2 ^ LENGTH('a))"
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1779
  by transfer (simp add: take_bit_eq_mod)
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1780
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1781
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1782
subsection \<open>Bit-wise operations\<close>
4b011fa5e83b restructured
haftmann
parents: 72243
diff changeset
  1783
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1784
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1785
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1786
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  1787
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1788
lemma uint_take_bit_eq:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1789
  \<open>uint (take_bit n w) = take_bit n (uint w)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1790
  by transfer (simp add: ac_simps)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1791
72227
0f3d24dc197f more on conversions
haftmann
parents: 72130
diff changeset
  1792
lemma take_bit_word_eq_self:
0f3d24dc197f more on conversions
haftmann
parents: 72130
diff changeset
  1793
  \<open>take_bit n w = w\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
0f3d24dc197f more on conversions
haftmann
parents: 72130
diff changeset
  1794
  using that by transfer simp
0f3d24dc197f more on conversions
haftmann
parents: 72130
diff changeset
  1795
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  1796
lemma take_bit_length_eq [simp]:
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  1797
  \<open>take_bit LENGTH('a) w = w\<close> for w :: \<open>'a::len word\<close>
72227
0f3d24dc197f more on conversions
haftmann
parents: 72130
diff changeset
  1798
  by (rule take_bit_word_eq_self) simp
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  1799
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1800
lemma bit_word_of_int_iff:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1801
  \<open>bit (word_of_int k :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> bit k n\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1802
  by transfer rule
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1803
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1804
lemma bit_uint_iff:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1805
  \<open>bit (uint w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w n\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1806
    for w :: \<open>'a::len word\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1807
  by transfer (simp add: bit_take_bit_iff)
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1808
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1809
lemma bit_sint_iff:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1810
  \<open>bit (sint w) n \<longleftrightarrow> n \<ge> LENGTH('a) \<and> bit w (LENGTH('a) - 1) \<or> bit w n\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1811
  for w :: \<open>'a::len word\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1812
  by transfer (auto simp add: bit_signed_take_bit_iff min_def le_less not_less)
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1813
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1814
lemma bit_word_ucast_iff:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1815
  \<open>bit (ucast w :: 'b::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> n < LENGTH('b) \<and> bit w n\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1816
  for w :: \<open>'a::len word\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1817
  by transfer (simp add: bit_take_bit_iff ac_simps)
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1818
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1819
lemma bit_word_scast_iff:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1820
  \<open>bit (scast w :: 'b::len word) n \<longleftrightarrow>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1821
    n < LENGTH('b) \<and> (bit w n \<or> LENGTH('a) \<le> n \<and> bit w (LENGTH('a) - Suc 0))\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  1822
  for w :: \<open>'a::len word\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1823
  by transfer (auto simp add: bit_signed_take_bit_iff le_less min_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1824
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  1825
lemma bit_word_iff_drop_bit_and [code]:
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  1826
  \<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close> for a :: \<open>'a::len word\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  1827
  by (simp add: bit_iff_odd_drop_bit odd_iff_mod_2_eq_one and_one_eq)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1828
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1829
lemma
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1830
  word_not_def: "NOT (a::'a::len word) = word_of_int (NOT (uint a))"
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  1831
    and word_and_def: "(a::'a word) AND b = word_of_int (uint a AND uint b)"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  1832
    and word_or_def: "(a::'a word) OR b = word_of_int (uint a OR uint b)"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  1833
    and word_xor_def: "(a::'a word) XOR b = word_of_int (uint a XOR uint b)"
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1834
  by (transfer, simp add: take_bit_not_take_bit)+
47374
9475d524bafb set up and use lift_definition for word operations
huffman
parents: 47372
diff changeset
  1835
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1836
definition even_word :: \<open>'a::len word \<Rightarrow> bool\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1837
  where [code_abbrev]: \<open>even_word = even\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1838
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1839
lemma even_word_iff [code]:
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1840
  \<open>even_word a \<longleftrightarrow> a AND 1 = 0\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1841
  by (simp add: and_one_eq even_iff_mod_2_eq_zero even_word_def)
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  1842
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1843
lemma map_bit_range_eq_if_take_bit_eq:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1844
  \<open>map (bit k) [0..<n] = map (bit l) [0..<n]\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1845
  if \<open>take_bit n k = take_bit n l\<close> for k l :: int
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1846
using that proof (induction n arbitrary: k l)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1847
  case 0
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1848
  then show ?case
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1849
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1850
next
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1851
  case (Suc n)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1852
  from Suc.prems have \<open>take_bit n (k div 2) = take_bit n (l div 2)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1853
    by (simp add: take_bit_Suc)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1854
  then have \<open>map (bit (k div 2)) [0..<n] = map (bit (l div 2)) [0..<n]\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1855
    by (rule Suc.IH)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1856
  moreover have \<open>bit (r div 2) = bit r \<circ> Suc\<close> for r :: int
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1857
    by (simp add: fun_eq_iff bit_Suc)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1858
  moreover from Suc.prems have \<open>even k \<longleftrightarrow> even l\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1859
    by (auto simp add: take_bit_Suc elim!: evenE oddE) arith+
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1860
  ultimately show ?case
75085
ccc3a72210e6 Avoid overaggresive simplification.
haftmann
parents: 74592
diff changeset
  1861
    by (simp only: map_Suc_upt upt_conv_Cons flip: list.map_comp) (simp add: bit_0)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1862
qed
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1863
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1864
lemma
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1865
  take_bit_word_Bit0_eq [simp]: \<open>take_bit (numeral n) (numeral (num.Bit0 m) :: 'a::len word)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1866
    = 2 * take_bit (pred_numeral n) (numeral m)\<close> (is ?P)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1867
  and take_bit_word_Bit1_eq [simp]: \<open>take_bit (numeral n) (numeral (num.Bit1 m) :: 'a::len word)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1868
    = 1 + 2 * take_bit (pred_numeral n) (numeral m)\<close> (is ?Q)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1869
  and take_bit_word_minus_Bit0_eq [simp]: \<open>take_bit (numeral n) (- numeral (num.Bit0 m) :: 'a::len word)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1870
    = 2 * take_bit (pred_numeral n) (- numeral m)\<close> (is ?R)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1871
  and take_bit_word_minus_Bit1_eq [simp]: \<open>take_bit (numeral n) (- numeral (num.Bit1 m) :: 'a::len word)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1872
    = 1 + 2 * take_bit (pred_numeral n) (- numeral (Num.inc m))\<close> (is ?S)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1873
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1874
  define w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1875
    where \<open>w = numeral m\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1876
  moreover define q :: nat
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1877
    where \<open>q = pred_numeral n\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1878
  ultimately have num:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1879
    \<open>numeral m = w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1880
    \<open>numeral (num.Bit0 m) = 2 * w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1881
    \<open>numeral (num.Bit1 m) = 1 + 2 * w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1882
    \<open>numeral (Num.inc m) = 1 + w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1883
    \<open>pred_numeral n = q\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1884
    \<open>numeral n = Suc q\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1885
    by (simp_all only: w_def q_def numeral_Bit0 [of m] numeral_Bit1 [of m] ac_simps
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1886
      numeral_inc numeral_eq_Suc flip: mult_2)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1887
  have even: \<open>take_bit (Suc q) (2 * w) = 2 * take_bit q w\<close> for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1888
    by (rule bit_word_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1889
      (auto simp add: bit_take_bit_iff bit_double_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1890
  have odd: \<open>take_bit (Suc q) (1 + 2 * w) = 1 + 2 * take_bit q w\<close> for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1891
    by (rule bit_eqI)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1892
      (auto simp add: bit_take_bit_iff bit_double_iff even_bit_succ_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1893
  show ?P
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1894
    using even [of w] by (simp add: num)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1895
  show ?Q
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1896
    using odd [of w] by (simp add: num)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1897
  show ?R
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1898
    using even [of \<open>- w\<close>] by (simp add: num)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1899
  show ?S
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1900
    using odd [of \<open>- (1 + w)\<close>] by (simp add: num)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1901
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  1902
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1903
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1904
subsection \<open>More shift operations\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1905
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1906
lift_definition signed_drop_bit :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a::len word\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1907
  is \<open>\<lambda>n. drop_bit n \<circ> signed_take_bit (LENGTH('a) - Suc 0)\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1908
  using signed_take_bit_decr_length_iff
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1909
  by (simp add: take_bit_drop_bit) force
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1910
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  1911
lemma bit_signed_drop_bit_iff [bit_simps]:
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1912
  \<open>bit (signed_drop_bit m w) n \<longleftrightarrow> bit w (if LENGTH('a) - m \<le> n \<and> n < LENGTH('a) then LENGTH('a) - 1 else m + n)\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1913
  for w :: \<open>'a::len word\<close>
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1914
  apply transfer
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1915
  apply (auto simp add: bit_drop_bit_eq bit_signed_take_bit_iff not_le min_def)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1916
   apply (metis add.commute le_antisym less_diff_conv less_eq_decr_length_iff)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1917
  apply (metis le_antisym less_eq_decr_length_iff)
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1918
  done
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1919
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  1920
lemma [code]:
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  1921
  \<open>Word.the_int (signed_drop_bit n w) = take_bit LENGTH('a) (drop_bit n (Word.the_signed_int w))\<close>
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  1922
  for w :: \<open>'a::len word\<close>
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  1923
  by transfer simp
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  1924
73816
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1925
lemma signed_drop_bit_of_0 [simp]:
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1926
  \<open>signed_drop_bit n 0 = 0\<close>
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1927
  by transfer simp
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1928
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1929
lemma signed_drop_bit_of_minus_1 [simp]:
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1930
  \<open>signed_drop_bit n (- 1) = - 1\<close>
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1931
  by transfer simp
0510c7a4256a moved more legacy to AFP
haftmann
parents: 73789
diff changeset
  1932
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  1933
lemma signed_drop_bit_signed_drop_bit [simp]:
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  1934
  \<open>signed_drop_bit m (signed_drop_bit n w) = signed_drop_bit (m + n) w\<close>
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  1935
  for w :: \<open>'a::len word\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1936
proof (cases \<open>LENGTH('a)\<close>)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1937
  case 0
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1938
  then show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1939
    using len_not_eq_0 by blast
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1940
next
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1941
  case (Suc n)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1942
  then show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1943
    by (force simp add: bit_signed_drop_bit_iff not_le less_diff_conv ac_simps intro!: bit_word_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1944
qed
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  1945
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1946
lemma signed_drop_bit_0 [simp]:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1947
  \<open>signed_drop_bit 0 w = w\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  1948
  by transfer (simp add: take_bit_signed_take_bit)
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1949
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1950
lemma sint_signed_drop_bit_eq:
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1951
  \<open>sint (signed_drop_bit n w) = drop_bit n (sint w)\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1952
proof (cases \<open>LENGTH('a) = 0 \<or> n=0\<close>)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1953
  case False
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1954
  then show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1955
    apply simp
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1956
    apply (rule bit_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1957
    by (auto simp add: bit_sint_iff bit_drop_bit_eq bit_signed_drop_bit_iff dest: bit_imp_le_length)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1958
qed auto
72388
633d14bd1e59 consolidated for the sake of documentation
haftmann
parents: 72292
diff changeset
  1959
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  1960
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  1961
subsection \<open>Rotation\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  1962
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1963
lift_definition word_rotr :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1964
  is \<open>\<lambda>n k. concat_bit (LENGTH('a) - n mod LENGTH('a))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1965
    (drop_bit (n mod LENGTH('a)) (take_bit LENGTH('a) k))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1966
    (take_bit (n mod LENGTH('a)) k)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1967
  subgoal for n k l
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1968
    by (simp add: concat_bit_def nat_le_iff less_imp_le
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1969
      take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>n mod LENGTH('a::len)\<close>])
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1970
  done
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1971
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1972
lift_definition word_rotl :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1973
  is \<open>\<lambda>n k. concat_bit (n mod LENGTH('a))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1974
    (drop_bit (LENGTH('a) - n mod LENGTH('a)) (take_bit LENGTH('a) k))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1975
    (take_bit (LENGTH('a) - n mod LENGTH('a)) k)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1976
  subgoal for n k l
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1977
    by (simp add: concat_bit_def nat_le_iff less_imp_le
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1978
      take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>LENGTH('a) - n mod LENGTH('a::len)\<close>])
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1979
  done
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1980
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1981
lift_definition word_roti :: \<open>int \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1982
  is \<open>\<lambda>r k. concat_bit (LENGTH('a) - nat (r mod int LENGTH('a)))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1983
    (drop_bit (nat (r mod int LENGTH('a))) (take_bit LENGTH('a) k))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1984
    (take_bit (nat (r mod int LENGTH('a))) k)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1985
  subgoal for r k l
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  1986
    by (simp add: concat_bit_def nat_le_iff less_imp_le
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1987
      take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>nat (r mod int LENGTH('a::len))\<close>])
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1988
  done
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1989
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1990
lemma word_rotl_eq_word_rotr [code]:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1991
  \<open>word_rotl n = (word_rotr (LENGTH('a) - n mod LENGTH('a)) :: 'a::len word \<Rightarrow> 'a word)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1992
  by (rule ext, cases \<open>n mod LENGTH('a) = 0\<close>; transfer) simp_all
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1993
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1994
lemma word_roti_eq_word_rotr_word_rotl [code]:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1995
  \<open>word_roti i w =
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1996
    (if i \<ge> 0 then word_rotr (nat i) w else word_rotl (nat (- i)) w)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1997
proof (cases \<open>i \<ge> 0\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1998
  case True
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  1999
  moreover define n where \<open>n = nat i\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2000
  ultimately have \<open>i = int n\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2001
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2002
  moreover have \<open>word_roti (int n) = (word_rotr n :: _ \<Rightarrow> 'a word)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2003
    by (rule ext, transfer) (simp add: nat_mod_distrib)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2004
  ultimately show ?thesis
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2005
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2006
next
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2007
  case False
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2008
  moreover define n where \<open>n = nat (- i)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2009
  ultimately have \<open>i = - int n\<close> \<open>n > 0\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2010
    by simp_all
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2011
  moreover have \<open>word_roti (- int n) = (word_rotl n :: _ \<Rightarrow> 'a word)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2012
    by (rule ext, transfer)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2013
      (simp add: zmod_zminus1_eq_if flip: of_nat_mod of_nat_diff)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2014
  ultimately show ?thesis
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2015
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2016
qed
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2017
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  2018
lemma bit_word_rotr_iff [bit_simps]:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2019
  \<open>bit (word_rotr m w) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2020
    n < LENGTH('a) \<and> bit w ((n + m) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2021
  for w :: \<open>'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2022
proof transfer
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2023
  fix k :: int and m n :: nat
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2024
  define q where \<open>q = m mod LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2025
  have \<open>q < LENGTH('a)\<close> 
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2026
    by (simp add: q_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2027
  then have \<open>q \<le> LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2028
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2029
  have \<open>m mod LENGTH('a) = q\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2030
    by (simp add: q_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2031
  moreover have \<open>(n + m) mod LENGTH('a) = (n + q) mod LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2032
    by (subst mod_add_right_eq [symmetric]) (simp add: \<open>m mod LENGTH('a) = q\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2033
  moreover have \<open>n < LENGTH('a) \<and>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2034
    bit (concat_bit (LENGTH('a) - q) (drop_bit q (take_bit LENGTH('a) k)) (take_bit q k)) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2035
    n < LENGTH('a) \<and> bit k ((n + q) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2036
    using \<open>q < LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2037
    by (cases \<open>q + n \<ge> LENGTH('a)\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2038
     (auto simp add: bit_concat_bit_iff bit_drop_bit_eq
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2039
        bit_take_bit_iff le_mod_geq ac_simps)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2040
  ultimately show \<open>n < LENGTH('a) \<and>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2041
    bit (concat_bit (LENGTH('a) - m mod LENGTH('a))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2042
      (drop_bit (m mod LENGTH('a)) (take_bit LENGTH('a) k))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2043
      (take_bit (m mod LENGTH('a)) k)) n
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2044
    \<longleftrightarrow> n < LENGTH('a) \<and>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2045
      (n + m) mod LENGTH('a) < LENGTH('a) \<and>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2046
      bit k ((n + m) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2047
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2048
qed
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2049
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  2050
lemma bit_word_rotl_iff [bit_simps]:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2051
  \<open>bit (word_rotl m w) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2052
    n < LENGTH('a) \<and> bit w ((n + (LENGTH('a) - m mod LENGTH('a))) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2053
  for w :: \<open>'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2054
  by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2055
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  2056
lemma bit_word_roti_iff [bit_simps]:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2057
  \<open>bit (word_roti k w) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2058
    n < LENGTH('a) \<and> bit w (nat ((int n + k) mod int LENGTH('a)))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2059
  for w :: \<open>'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2060
proof transfer
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2061
  fix k l :: int and n :: nat
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2062
  define m where \<open>m = nat (k mod int LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2063
  have \<open>m < LENGTH('a)\<close> 
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2064
    by (simp add: nat_less_iff m_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2065
  then have \<open>m \<le> LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2066
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2067
  have \<open>k mod int LENGTH('a) = int m\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2068
    by (simp add: nat_less_iff m_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2069
  moreover have \<open>(int n + k) mod int LENGTH('a) = int ((n + m) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2070
    by (subst mod_add_right_eq [symmetric]) (simp add: of_nat_mod \<open>k mod int LENGTH('a) = int m\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2071
  moreover have \<open>n < LENGTH('a) \<and>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2072
    bit (concat_bit (LENGTH('a) - m) (drop_bit m (take_bit LENGTH('a) l)) (take_bit m l)) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2073
    n < LENGTH('a) \<and> bit l ((n + m) mod LENGTH('a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2074
    using \<open>m < LENGTH('a)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2075
    by (cases \<open>m + n \<ge> LENGTH('a)\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2076
     (auto simp add: bit_concat_bit_iff bit_drop_bit_eq
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2077
        bit_take_bit_iff nat_less_iff not_le not_less ac_simps
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2078
        le_diff_conv le_mod_geq)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2079
  ultimately show \<open>n < LENGTH('a)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2080
    \<and> bit (concat_bit (LENGTH('a) - nat (k mod int LENGTH('a)))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2081
             (drop_bit (nat (k mod int LENGTH('a))) (take_bit LENGTH('a) l))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2082
             (take_bit (nat (k mod int LENGTH('a))) l)) n \<longleftrightarrow>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2083
       n < LENGTH('a) 
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2084
    \<and> nat ((int n + k) mod int LENGTH('a)) < LENGTH('a)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2085
    \<and> bit l (nat ((int n + k) mod int LENGTH('a)))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2086
    by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2087
qed
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2088
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2089
lemma uint_word_rotr_eq:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2090
  \<open>uint (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2091
    (drop_bit (n mod LENGTH('a)) (uint w))
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2092
    (uint (take_bit (n mod LENGTH('a)) w))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2093
  for w :: \<open>'a::len word\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  2094
  by transfer (simp add: take_bit_concat_bit_eq)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2095
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2096
lemma [code]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2097
  \<open>Word.the_int (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a))
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2098
    (drop_bit (n mod LENGTH('a)) (Word.the_int w))
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2099
    (Word.the_int (take_bit (n mod LENGTH('a)) w))\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2100
  for w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2101
  using uint_word_rotr_eq [of n w] by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2102
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2103
    
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2104
subsection \<open>Split and cat operations\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2105
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2106
lift_definition word_cat :: \<open>'a::len word \<Rightarrow> 'b::len word \<Rightarrow> 'c::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2107
  is \<open>\<lambda>k l. concat_bit LENGTH('b) l (take_bit LENGTH('a) k)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2108
  by (simp add: bit_eq_iff bit_concat_bit_iff bit_take_bit_iff)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2109
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2110
lemma word_cat_eq:
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2111
  \<open>(word_cat v w :: 'c::len word) = push_bit LENGTH('b) (ucast v) + ucast w\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2112
  for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close>
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2113
  by transfer (simp add: concat_bit_eq ac_simps)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2114
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2115
lemma word_cat_eq' [code]:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2116
  \<open>word_cat a b = word_of_int (concat_bit LENGTH('b) (uint b) (uint a))\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2117
  for a :: \<open>'a::len word\<close> and b :: \<open>'b::len word\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2118
  by transfer (simp add: concat_bit_take_bit_eq)
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2119
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  2120
lemma bit_word_cat_iff [bit_simps]:
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2121
  \<open>bit (word_cat v w :: 'c::len word) n \<longleftrightarrow> n < LENGTH('c) \<and> (if n < LENGTH('b) then bit w n else bit v (n - LENGTH('b)))\<close> 
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2122
  for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2123
  by transfer (simp add: bit_concat_bit_iff bit_take_bit_iff)
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  2124
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2125
definition word_split :: \<open>'a::len word \<Rightarrow> 'b::len word \<times> 'c::len word\<close>
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2126
  where \<open>word_split w =
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2127
    (ucast (drop_bit LENGTH('c) w) :: 'b::len word, ucast w :: 'c::len word)\<close>
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2128
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  2129
definition word_rcat :: \<open>'a::len word list \<Rightarrow> 'b::len word\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  2130
  where \<open>word_rcat = word_of_int \<circ> horner_sum uint (2 ^ LENGTH('a)) \<circ> rev\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  2131
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2132
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2133
subsection \<open>More on conversions\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2134
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2135
lemma int_word_sint:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2136
  \<open>sint (word_of_int x :: 'a::len word) = (x + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - 2 ^ (LENGTH('a) - 1)\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2137
  by transfer (simp flip: take_bit_eq_mod add: signed_take_bit_eq_take_bit_shift)
46010
ebbc2d5cd720 add section headings
huffman
parents: 46009
diff changeset
  2138
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2139
lemma sint_sbintrunc': "sint (word_of_int bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) bin"
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  2140
  by (simp add: signed_of_int)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2141
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2142
lemma uint_sint: "uint w = take_bit LENGTH('a) (sint w)"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2143
  for w :: "'a::len word"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2144
  by transfer (simp add: take_bit_signed_take_bit)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2145
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2146
lemma bintr_uint: "LENGTH('a) \<le> n \<Longrightarrow> take_bit n (uint w) = uint w"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2147
  for w :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2148
  by transfer (simp add: min_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2149
46057
8664713db181 remove unnecessary intermediate lemmas
huffman
parents: 46026
diff changeset
  2150
lemma wi_bintr:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2151
  "LENGTH('a::len) \<le> n \<Longrightarrow>
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2152
    word_of_int (take_bit n w) = (word_of_int w :: 'a word)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2153
  by transfer simp
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2154
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2155
lemma word_numeral_alt: "numeral b = word_of_int (numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2156
  by (induct b, simp_all only: numeral.simps word_of_int_homs)
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2157
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2158
declare word_numeral_alt [symmetric, code_abbrev]
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2159
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2160
lemma word_neg_numeral_alt: "- numeral b = word_of_int (- numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  2161
  by (simp only: word_numeral_alt wi_hom_neg)
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2162
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2163
declare word_neg_numeral_alt [symmetric, code_abbrev]
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2164
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2165
lemma uint_bintrunc [simp]:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2166
  "uint (numeral bin :: 'a word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2167
    take_bit (LENGTH('a::len)) (numeral bin)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2168
  by transfer rule
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2169
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2170
lemma uint_bintrunc_neg [simp]:
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2171
  "uint (- numeral bin :: 'a word) = take_bit (LENGTH('a::len)) (- numeral bin)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2172
  by transfer rule
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2173
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2174
lemma sint_sbintrunc [simp]:
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2175
  "sint (numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (numeral bin)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2176
  by transfer simp
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2177
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2178
lemma sint_sbintrunc_neg [simp]:
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2179
  "sint (- numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (- numeral bin)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2180
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2181
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2182
lemma unat_bintrunc [simp]:
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2183
  "unat (numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (numeral bin))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2184
  by transfer simp
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2185
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2186
lemma unat_bintrunc_neg [simp]:
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2187
  "unat (- numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (- numeral bin))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2188
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2189
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2190
lemma size_0_eq: "size w = 0 \<Longrightarrow> v = w"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2191
  for v w :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2192
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2193
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2194
lemma uint_ge_0 [iff]: "0 \<le> uint x"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2195
  by (fact unsigned_greater_eq)
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2196
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2197
lemma uint_lt2p [iff]: "uint x < 2 ^ LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2198
  for x :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2199
  by (fact unsigned_less)
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2200
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2201
lemma sint_ge: "- (2 ^ (LENGTH('a) - 1)) \<le> sint x"
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2202
  for x :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2203
  using sint_greater_eq [of x] by simp
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2204
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2205
lemma sint_lt: "sint x < 2 ^ (LENGTH('a) - 1)"
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2206
  for x :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2207
  using sint_less [of x] by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2208
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2209
lemma uint_m2p_neg: "uint x - 2 ^ LENGTH('a) < 0"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2210
  for x :: "'a::len word"
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2211
  by (simp only: diff_less_0_iff_less uint_lt2p)
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2212
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2213
lemma uint_m2p_not_non_neg: "\<not> 0 \<le> uint x - 2 ^ LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2214
  for x :: "'a::len word"
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2215
  by (simp only: not_le uint_m2p_neg)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2216
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2217
lemma lt2p_lem: "LENGTH('a) \<le> n \<Longrightarrow> uint w < 2 ^ n"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2218
  for w :: "'a::len word"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2219
  using uint_bounded [of w] by (rule less_le_trans) simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2220
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2221
lemma uint_le_0_iff [simp]: "uint x \<le> 0 \<longleftrightarrow> uint x = 0"
70749
5d06b7bb9d22 More type class generalisations. Note that linorder_antisym_conv1 and linorder_antisym_conv2 no longer exist.
paulson <lp15@cam.ac.uk>
parents: 70342
diff changeset
  2222
  by (fact uint_ge_0 [THEN leD, THEN antisym_conv1])
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2223
40827
abbc05c20e24 code preprocessor setup for numerals on word type;
haftmann
parents: 39910
diff changeset
  2224
lemma uint_nat: "uint w = int (unat w)"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2225
  by transfer simp
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2226
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2227
lemma uint_numeral: "uint (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2228
  by (simp flip: take_bit_eq_mod add: of_nat_take_bit)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2229
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2230
lemma uint_neg_numeral: "uint (- numeral b :: 'a::len word) = - numeral b mod 2 ^ LENGTH('a)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2231
  by (simp flip: take_bit_eq_mod add: of_nat_take_bit)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2232
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2233
lemma unat_numeral: "unat (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2234
  by transfer (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2235
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2236
lemma sint_numeral:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2237
  "sint (numeral b :: 'a::len word) =
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2238
    (numeral b + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - 2 ^ (LENGTH('a) - 1)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2239
  by (metis int_word_sint word_numeral_alt)
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2240
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2241
lemma word_of_int_0 [simp, code_post]: "word_of_int 0 = 0"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2242
  by (fact of_int_0)
45958
c28235388c43 simplify some proofs
huffman
parents: 45957
diff changeset
  2243
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2244
lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2245
  by (fact of_int_1)
45958
c28235388c43 simplify some proofs
huffman
parents: 45957
diff changeset
  2246
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  2247
lemma word_of_int_neg_1 [simp]: "word_of_int (- 1) = - 1"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  2248
  by (simp add: wi_hom_syms)
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  2249
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2250
lemma word_of_int_numeral [simp] : "(word_of_int (numeral bin) :: 'a::len word) = numeral bin"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2251
  by (fact of_int_numeral)
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2252
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2253
lemma word_of_int_neg_numeral [simp]:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2254
  "(word_of_int (- numeral bin) :: 'a::len word) = - numeral bin"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2255
  by (fact of_int_neg_numeral)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2256
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2257
lemma word_int_case_wi:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2258
  "word_int_case f (word_of_int i :: 'b word) = f (i mod 2 ^ LENGTH('b::len))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2259
  by transfer (simp add: take_bit_eq_mod)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2260
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2261
lemma word_int_split:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2262
  "P (word_int_case f x) =
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2263
    (\<forall>i. x = (word_of_int i :: 'b::len word) \<and> 0 \<le> i \<and> i < 2 ^ LENGTH('b) \<longrightarrow> P (f i))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2264
  by transfer (auto simp add: take_bit_eq_mod)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2265
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2266
lemma word_int_split_asm:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2267
  "P (word_int_case f x) =
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2268
    (\<nexists>n. x = (word_of_int n :: 'b::len word) \<and> 0 \<le> n \<and> n < 2 ^ LENGTH('b::len) \<and> \<not> P (f n))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2269
  by transfer (auto simp add: take_bit_eq_mod)
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2270
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2271
lemma uint_range_size: "0 \<le> uint w \<and> uint w < 2 ^ size w"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2272
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2273
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2274
lemma sint_range_size: "- (2 ^ (size w - Suc 0)) \<le> sint w \<and> sint w < 2 ^ (size w - Suc 0)"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2275
  by (simp add: word_size sint_greater_eq sint_less)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2276
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2277
lemma sint_above_size: "2 ^ (size w - 1) \<le> x \<Longrightarrow> sint w < x"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2278
  for w :: "'a::len word"
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2279
  unfolding word_size by (rule less_le_trans [OF sint_lt])
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2280
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2281
lemma sint_below_size: "x \<le> - (2 ^ (size w - 1)) \<Longrightarrow> x \<le> sint w"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2282
  for w :: "'a::len word"
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  2283
  unfolding word_size by (rule order_trans [OF _ sint_ge])
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2284
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2285
lemma word_unat_eq_iff:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2286
  \<open>v = w \<longleftrightarrow> unat v = unat w\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2287
  for v w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2288
  by (fact word_eq_iff_unsigned)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2289
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2290
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2291
subsection \<open>Testing bits\<close>
46010
ebbc2d5cd720 add section headings
huffman
parents: 46009
diff changeset
  2292
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2293
lemma bin_nth_uint_imp: "bit (uint w) n \<Longrightarrow> n < LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2294
  for w :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2295
  by transfer (simp add: bit_take_bit_iff)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2296
46057
8664713db181 remove unnecessary intermediate lemmas
huffman
parents: 46026
diff changeset
  2297
lemma bin_nth_sint:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2298
  "LENGTH('a) \<le> n \<Longrightarrow>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2299
    bit (sint w) n = bit (sint w) (LENGTH('a) - 1)"
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2300
  for w :: "'a::len word"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2301
  by (transfer fixing: n) (simp add: bit_signed_take_bit_iff le_diff_conv min_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2302
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2303
lemma num_of_bintr':
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2304
  "take_bit (LENGTH('a::len)) (numeral a :: int) = (numeral b) \<Longrightarrow>
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2305
    numeral a = (numeral b :: 'a word)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2306
proof (transfer fixing: a b)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2307
  assume \<open>take_bit LENGTH('a) (numeral a :: int) = numeral b\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2308
  then have \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (numeral a :: int)) = take_bit LENGTH('a) (numeral b)\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2309
    by simp
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2310
  then show \<open>take_bit LENGTH('a) (numeral a :: int) = take_bit LENGTH('a) (numeral b)\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2311
    by simp
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2312
qed
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2313
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2314
lemma num_of_sbintr':
72241
5a6d8675bf4b generalized signed_take_bit
haftmann
parents: 72239
diff changeset
  2315
  "signed_take_bit (LENGTH('a::len) - 1) (numeral a :: int) = (numeral b) \<Longrightarrow>
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2316
    numeral a = (numeral b :: 'a word)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2317
proof (transfer fixing: a b)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2318
  assume \<open>signed_take_bit (LENGTH('a) - 1) (numeral a :: int) = numeral b\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2319
  then have \<open>take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - 1) (numeral a :: int)) = take_bit LENGTH('a) (numeral b)\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2320
    by simp
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2321
  then show \<open>take_bit LENGTH('a) (numeral a :: int) = take_bit LENGTH('a) (numeral b)\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2322
    by (simp add: take_bit_signed_take_bit)
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2323
qed
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2324
 
46962
5bdcdb28be83 make more word theorems respect int/bin distinction
huffman
parents: 46656
diff changeset
  2325
lemma num_abs_bintr:
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2326
  "(numeral x :: 'a word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2327
    word_of_int (take_bit (LENGTH('a::len)) (numeral x))"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2328
  by transfer simp
46962
5bdcdb28be83 make more word theorems respect int/bin distinction
huffman
parents: 46656
diff changeset
  2329
5bdcdb28be83 make more word theorems respect int/bin distinction
huffman
parents: 46656
diff changeset
  2330
lemma num_abs_sbintr:
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2331
  "(numeral x :: 'a word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2332
    word_of_int (signed_take_bit (LENGTH('a::len) - 1) (numeral x))"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2333
  by transfer (simp add: take_bit_signed_take_bit)
46962
5bdcdb28be83 make more word theorems respect int/bin distinction
huffman
parents: 46656
diff changeset
  2334
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2335
text \<open>
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2336
  \<open>cast\<close> -- note, no arg for new length, as it's determined by type of result,
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2337
  thus in \<open>cast w = w\<close>, the type means cast to length of \<open>w\<close>!
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2338
\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2339
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  2340
lemma bit_ucast_iff:
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  2341
  \<open>bit (ucast a :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a::len) \<and> bit a n\<close>
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2342
  by transfer (simp add: bit_take_bit_iff)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2343
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2344
lemma ucast_id [simp]: "ucast w = w"
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2345
  by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2346
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2347
lemma scast_id [simp]: "scast w = w"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2348
  by transfer (simp add: take_bit_signed_take_bit)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2349
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  2350
lemma ucast_mask_eq:
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  2351
  \<open>ucast (mask n :: 'b word) = mask (min LENGTH('b::len) n)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  2352
  by (simp add: bit_eq_iff) (auto simp add: bit_mask_iff bit_ucast_iff)
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  2353
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2354
\<comment> \<open>literal u(s)cast\<close>
46001
0b562d564d5f redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents: 46000
diff changeset
  2355
lemma ucast_bintr [simp]:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2356
  "ucast (numeral w :: 'a::len word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2357
    word_of_int (take_bit (LENGTH('a)) (numeral w))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2358
  by transfer simp
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2359
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2360
(* TODO: neg_numeral *)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2361
46001
0b562d564d5f redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents: 46000
diff changeset
  2362
lemma scast_sbintr [simp]:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2363
  "scast (numeral w ::'a::len word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2364
    word_of_int (signed_take_bit (LENGTH('a) - Suc 0) (numeral w))"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2365
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2366
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2367
lemma source_size: "source_size (c::'a::len word \<Rightarrow> _) = LENGTH('a)"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2368
  by transfer simp
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  2369
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2370
lemma target_size: "target_size (c::_ \<Rightarrow> 'b::len word) = LENGTH('b)"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2371
  by transfer simp
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  2372
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2373
lemma is_down: "is_down c \<longleftrightarrow> LENGTH('b) \<le> LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2374
  for c :: "'a::len word \<Rightarrow> 'b::len word"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2375
  by transfer simp
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2376
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2377
lemma is_up: "is_up c \<longleftrightarrow> LENGTH('a) \<le> LENGTH('b)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2378
  for c :: "'a::len word \<Rightarrow> 'b::len word"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2379
  by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2380
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2381
lemma is_up_down:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2382
  \<open>is_up c \<longleftrightarrow> is_down d\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2383
  for c :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2384
  and d :: \<open>'b::len word \<Rightarrow> 'a::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2385
  by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2386
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2387
context
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2388
  fixes dummy_types :: \<open>'a::len \<times> 'b::len\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2389
begin
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2390
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2391
private abbreviation (input) UCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2392
  where \<open>UCAST == ucast\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2393
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2394
private abbreviation (input) SCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2395
  where \<open>SCAST == scast\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2396
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2397
lemma down_cast_same:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2398
  \<open>UCAST = scast\<close> if \<open>is_down UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2399
  by (rule ext, use that in transfer) (simp add: take_bit_signed_take_bit)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2400
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2401
lemma sint_up_scast:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2402
  \<open>sint (SCAST w) = sint w\<close> if \<open>is_up SCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2403
  using that by transfer (simp add: min_def Suc_leI le_diff_iff)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2404
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2405
lemma uint_up_ucast:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2406
  \<open>uint (UCAST w) = uint w\<close> if \<open>is_up UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2407
  using that by transfer (simp add: min_def)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2408
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2409
lemma ucast_up_ucast:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2410
  \<open>ucast (UCAST w) = ucast w\<close> if \<open>is_up UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2411
  using that by transfer (simp add: ac_simps)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2412
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2413
lemma ucast_up_ucast_id:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2414
  \<open>ucast (UCAST w) = w\<close> if \<open>is_up UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2415
  using that by (simp add: ucast_up_ucast)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2416
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2417
lemma scast_up_scast:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2418
  \<open>scast (SCAST w) = scast w\<close> if \<open>is_up SCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2419
  using that by transfer (simp add: ac_simps)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2420
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2421
lemma scast_up_scast_id:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2422
  \<open>scast (SCAST w) = w\<close> if \<open>is_up SCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2423
  using that by (simp add: scast_up_scast)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2424
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2425
lemma isduu:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2426
  \<open>is_up UCAST\<close> if \<open>is_down d\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2427
    for d :: \<open>'b word \<Rightarrow> 'a word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2428
  using that is_up_down [of UCAST d] by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2429
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2430
lemma isdus:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2431
  \<open>is_up SCAST\<close> if \<open>is_down d\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2432
    for d :: \<open>'b word \<Rightarrow> 'a word\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2433
  using that is_up_down [of SCAST d] by simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2434
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2435
lemmas ucast_down_ucast_id = isduu [THEN ucast_up_ucast_id]
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2436
lemmas scast_down_scast_id = isdus [THEN scast_up_scast_id]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2437
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2438
lemma up_ucast_surj:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2439
  \<open>surj (ucast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2440
  by (rule surjI) (use that in \<open>rule ucast_up_ucast_id\<close>)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2441
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2442
lemma up_scast_surj:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2443
  \<open>surj (scast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up SCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2444
  by (rule surjI) (use that in \<open>rule scast_up_scast_id\<close>)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2445
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2446
lemma down_ucast_inj:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2447
  \<open>inj_on UCAST A\<close> if \<open>is_down (ucast :: 'b word \<Rightarrow> 'a word)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2448
  by (rule inj_on_inverseI) (use that in \<open>rule ucast_down_ucast_id\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2449
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2450
lemma down_scast_inj:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2451
  \<open>inj_on SCAST A\<close> if \<open>is_down (scast :: 'b word \<Rightarrow> 'a word)\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2452
  by (rule inj_on_inverseI) (use that in \<open>rule scast_down_scast_id\<close>)
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2453
  
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2454
lemma ucast_down_wi:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2455
  \<open>UCAST (word_of_int x) = word_of_int x\<close> if \<open>is_down UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2456
  using that by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2457
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2458
lemma ucast_down_no:
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2459
  \<open>UCAST (numeral bin) = numeral bin\<close> if \<open>is_down UCAST\<close>
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2460
  using that by transfer simp
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2461
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2462
end
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2463
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2464
lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2465
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2466
lemma bit_last_iff:
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2467
  \<open>bit w (LENGTH('a) - Suc 0) \<longleftrightarrow> sint w < 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2468
  for w :: \<open>'a::len word\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2469
proof -
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2470
  have \<open>?P \<longleftrightarrow> bit (uint w) (LENGTH('a) - Suc 0)\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2471
    by (simp add: bit_uint_iff)
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2472
  also have \<open>\<dots> \<longleftrightarrow> ?Q\<close>
72010
a851ce626b78 signed_take_bit
haftmann
parents: 72009
diff changeset
  2473
    by (simp add: sint_uint)
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2474
  finally show ?thesis .
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2475
qed
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2476
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2477
lemma drop_bit_eq_zero_iff_not_bit_last:
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2478
  \<open>drop_bit (LENGTH('a) - Suc 0) w = 0 \<longleftrightarrow> \<not> bit w (LENGTH('a) - Suc 0)\<close>
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2479
  for w :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2480
proof (cases \<open>LENGTH('a)\<close>)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2481
  case (Suc n)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2482
  then show ?thesis
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2483
    apply transfer
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2484
    apply (simp add: take_bit_drop_bit)
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  2485
    by (simp add: bit_iff_odd_drop_bit drop_bit_take_bit odd_iff_mod_2_eq_one)
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2486
qed auto
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents: 71997
diff changeset
  2487
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2488
lemma unat_div:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2489
  \<open>unat (x div y) = unat x div unat y\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2490
  by (fact unat_div_distrib)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2491
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2492
lemma unat_mod:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2493
  \<open>unat (x mod y) = unat x mod unat y\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2494
  by (fact unat_mod_distrib)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2495
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2496
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2497
subsection \<open>Word Arithmetic\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2498
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2499
lemmas less_eq_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2500
  word_le_def [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2501
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2502
lemmas less_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2503
  word_less_def [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2504
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2505
lemmas less_eq_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2506
  word_le_def [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2507
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2508
lemmas less_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2509
  word_less_def [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2510
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2511
lemmas less_eq_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2512
  word_le_def [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2513
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2514
lemmas less_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2515
  word_less_def [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2516
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2517
lemmas less_eq_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2518
  word_le_def [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2519
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2520
lemmas less_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2521
  word_less_def [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2522
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2523
lemmas less_word_numeral_minus_1 [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2524
  word_less_def [of \<open>numeral a\<close> \<open>- 1\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2525
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2526
lemmas less_word_minus_numeral_minus_1 [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2527
  word_less_def [of \<open>- numeral a\<close> \<open>- 1\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2528
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2529
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2530
lemmas sless_eq_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2531
  word_sle_eq [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2532
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2533
lemmas sless_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2534
  word_sless_alt [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2535
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2536
lemmas sless_eq_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2537
  word_sle_eq [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2538
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2539
lemmas sless_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2540
  word_sless_alt [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2541
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2542
lemmas sless_eq_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2543
  word_sle_eq [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2544
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2545
lemmas sless_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2546
  word_sless_alt [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2547
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2548
lemmas sless_eq_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2549
  word_sle_eq [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2550
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2551
lemmas sless_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2552
  word_sless_alt [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified sint_sbintrunc sint_sbintrunc_neg]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2553
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2554
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2555
lemmas div_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2556
  word_div_def [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2557
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2558
lemmas div_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2559
  word_div_def [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2560
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2561
lemmas div_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2562
  word_div_def [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2563
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2564
lemmas div_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2565
  word_div_def [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2566
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2567
lemmas div_word_minus_1_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2568
  word_div_def [of \<open>- 1\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2569
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2570
lemmas div_word_minus_1_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2571
  word_div_def [of \<open>- 1\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2572
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2573
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2574
lemmas mod_word_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2575
  word_mod_def [of \<open>numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2576
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2577
lemmas mod_word_minus_numeral_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2578
  word_mod_def [of \<open>- numeral a\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2579
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2580
lemmas mod_word_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2581
  word_mod_def [of \<open>numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2582
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2583
lemmas mod_word_minus_numeral_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2584
  word_mod_def [of \<open>- numeral a\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2585
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2586
lemmas mod_word_minus_1_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2587
  word_mod_def [of \<open>- 1\<close> \<open>numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2588
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2589
lemmas mod_word_minus_1_minus_numeral [simp] =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2590
  word_mod_def [of \<open>- 1\<close> \<open>- numeral b\<close>, simplified uint_bintrunc uint_bintrunc_neg unsigned_minus_1_eq_mask mask_eq_exp_minus_1]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2591
  for a b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2593
lemma signed_drop_bit_of_1 [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2594
  \<open>signed_drop_bit n (1 :: 'a::len word) = of_bool (LENGTH('a) = 1 \<or> n = 0)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2595
  apply (transfer fixing: n)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2596
  apply (cases \<open>LENGTH('a)\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2597
   apply (auto simp add: take_bit_signed_take_bit)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2598
  apply (auto simp add: take_bit_drop_bit gr0_conv_Suc simp flip: take_bit_eq_self_iff_drop_bit_eq_0)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2599
  done
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2600
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2601
lemma take_bit_word_beyond_length_eq:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2602
  \<open>take_bit n w = w\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2603
  using that by transfer simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2604
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2605
lemmas word_div_no [simp] = word_div_def [of "numeral a" "numeral b"] for a b
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2606
lemmas word_mod_no [simp] = word_mod_def [of "numeral a" "numeral b"] for a b
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2607
lemmas word_less_no [simp] = word_less_def [of "numeral a" "numeral b"] for a b
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  2608
lemmas word_le_no [simp] = word_le_def [of "numeral a" "numeral b"] for a b
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2609
lemmas word_sless_no [simp] = word_sless_eq [of "numeral a" "numeral b"] for a b
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2610
lemmas word_sle_no [simp] = word_sle_eq [of "numeral a" "numeral b"] for a b
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2611
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2612
lemma size_0_same': "size w = 0 \<Longrightarrow> w = v"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2613
  for v w :: "'a::len word"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2614
  by (unfold word_size) simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2615
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  2616
lemmas size_0_same = size_0_same' [unfolded word_size]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2617
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2618
lemmas unat_eq_0 = unat_0_iff
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2619
lemmas unat_eq_zero = unat_0_iff
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2620
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2621
lemma mask_1: "mask 1 = 1"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2622
  by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2623
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2624
lemma mask_Suc_0: "mask (Suc 0) = 1"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2625
  by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2626
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2627
lemma bin_last_bintrunc: "odd (take_bit l n) \<longleftrightarrow> l > 0 \<and> odd n"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2628
  by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2629
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2630
lemma push_bit_word_beyond [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2631
  \<open>push_bit n w = 0\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2632
  using that by (transfer fixing: n) (simp add: take_bit_push_bit)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2633
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2634
lemma drop_bit_word_beyond [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2635
  \<open>drop_bit n w = 0\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2636
  using that by (transfer fixing: n) (simp add: drop_bit_take_bit)
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 signed_drop_bit_beyond:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2639
  \<open>signed_drop_bit n w = (if bit w (LENGTH('a) - Suc 0) then - 1 else 0)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2640
  if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2641
  by (rule bit_word_eqI) (simp add: bit_signed_drop_bit_iff that)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2642
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2643
lemma take_bit_numeral_minus_numeral_word [simp]:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2644
  \<open>take_bit (numeral m) (- numeral n :: 'a::len word) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2645
    (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
  2646
proof (cases \<open>LENGTH('a) \<le> numeral m\<close>)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2647
  case True
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2648
  then have *: \<open>(take_bit (numeral m) :: 'a word \<Rightarrow> 'a word) = id\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2649
    by (simp add: fun_eq_iff take_bit_word_eq_self)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2650
  have **: \<open>2 ^ numeral m = (0 :: 'a word)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2651
    using True by (simp flip: exp_eq_zero_iff)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2652
  show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2653
    by (auto simp only: * ** split: option.split
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2654
      dest!: take_bit_num_eq_None_imp [where ?'a = \<open>'a word\<close>] take_bit_num_eq_Some_imp [where ?'a = \<open>'a word\<close>])
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2655
      simp_all
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2656
next
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2657
  case False
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2658
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2659
    by (transfer fixing: m n) simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2660
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2661
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2662
lemma of_nat_inverse:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2663
  \<open>word_of_nat r = a \<Longrightarrow> r < 2 ^ LENGTH('a) \<Longrightarrow> unat a = r\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2664
  for a :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2665
  by (metis id_apply of_nat_eq_id take_bit_nat_eq_self_iff unsigned_of_nat)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2666
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2667
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2668
subsection \<open>Transferring goals from words to ints\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2669
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2670
lemma word_ths:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2671
  shows word_succ_p1: "word_succ a = a + 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2672
    and word_pred_m1: "word_pred a = a - 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2673
    and word_pred_succ: "word_pred (word_succ a) = a"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2674
    and word_succ_pred: "word_succ (word_pred a) = a"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2675
    and word_mult_succ: "word_succ a * b = b + a * b"
47374
9475d524bafb set up and use lift_definition for word operations
huffman
parents: 47372
diff changeset
  2676
  by (transfer, simp add: algebra_simps)+
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2677
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  2678
lemma uint_cong: "x = y \<Longrightarrow> uint x = uint y"
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  2679
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2680
55818
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2681
lemma uint_word_ariths:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2682
  fixes a b :: "'a::len word"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2683
  shows "uint (a + b) = (uint a + uint b) mod 2 ^ LENGTH('a::len)"
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2684
    and "uint (a - b) = (uint a - uint b) mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2685
    and "uint (a * b) = uint a * uint b mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2686
    and "uint (- a) = - uint a mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2687
    and "uint (word_succ a) = (uint a + 1) mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2688
    and "uint (word_pred a) = (uint a - 1) mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2689
    and "uint (0 :: 'a word) = 0 mod 2 ^ LENGTH('a)"
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2690
    and "uint (1 :: 'a word) = 1 mod 2 ^ LENGTH('a)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2691
  by (simp_all only: word_arith_wis uint_word_of_int_eq flip: take_bit_eq_mod)
55818
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2692
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2693
lemma uint_word_arith_bintrs:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2694
  fixes a b :: "'a::len word"
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2695
  shows "uint (a + b) = take_bit (LENGTH('a)) (uint a + uint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2696
    and "uint (a - b) = take_bit (LENGTH('a)) (uint a - uint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2697
    and "uint (a * b) = take_bit (LENGTH('a)) (uint a * uint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2698
    and "uint (- a) = take_bit (LENGTH('a)) (- uint a)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2699
    and "uint (word_succ a) = take_bit (LENGTH('a)) (uint a + 1)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2700
    and "uint (word_pred a) = take_bit (LENGTH('a)) (uint a - 1)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2701
    and "uint (0 :: 'a word) = take_bit (LENGTH('a)) 0"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2702
    and "uint (1 :: 'a word) = take_bit (LENGTH('a)) 1"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2703
  by (simp_all add: uint_word_ariths take_bit_eq_mod)
55818
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2704
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2705
lemma sint_word_ariths:
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  2706
  fixes a b :: "'a::len word"
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2707
  shows "sint (a + b) = signed_take_bit (LENGTH('a) - 1) (sint a + sint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2708
    and "sint (a - b) = signed_take_bit (LENGTH('a) - 1) (sint a - sint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2709
    and "sint (a * b) = signed_take_bit (LENGTH('a) - 1) (sint a * sint b)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2710
    and "sint (- a) = signed_take_bit (LENGTH('a) - 1) (- sint a)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2711
    and "sint (word_succ a) = signed_take_bit (LENGTH('a) - 1) (sint a + 1)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2712
    and "sint (word_pred a) = signed_take_bit (LENGTH('a) - 1) (sint a - 1)"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2713
    and "sint (0 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 0"
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  2714
    and "sint (1 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 1"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2715
  subgoal
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2716
    by transfer (simp add: signed_take_bit_add)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2717
  subgoal
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2718
    by transfer (simp add: signed_take_bit_diff)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2719
  subgoal
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2720
    by transfer (simp add: signed_take_bit_mult)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2721
  subgoal
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2722
    by transfer (simp add: signed_take_bit_minus)
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2723
     apply (metis of_int_sint scast_id sint_sbintrunc' wi_hom_succ)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2724
    apply (metis of_int_sint scast_id sint_sbintrunc' wi_hom_pred)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2725
   apply (simp_all add: sint_uint)
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64243
diff changeset
  2726
  done
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  2727
58410
6d46ad54a2ab explicit separation of signed and unsigned numerals using existing lexical categories num and xnum
haftmann
parents: 58061
diff changeset
  2728
lemma word_pred_0_n1: "word_pred 0 = word_of_int (- 1)"
47374
9475d524bafb set up and use lift_definition for word operations
huffman
parents: 47372
diff changeset
  2729
  unfolding word_pred_m1 by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2730
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2731
lemma succ_pred_no [simp]:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2732
    "word_succ (numeral w) = numeral w + 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2733
    "word_pred (numeral w) = numeral w - 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2734
    "word_succ (- numeral w) = - numeral w + 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2735
    "word_pred (- numeral w) = - numeral w - 1"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2736
  by (simp_all add: word_succ_p1 word_pred_m1)
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2737
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2738
lemma word_sp_01 [simp]:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2739
  "word_succ (- 1) = 0 \<and> word_succ 0 = 1 \<and> word_pred 0 = - 1 \<and> word_pred 1 = 0"
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2740
  by (simp_all add: word_succ_p1 word_pred_m1)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2741
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  2742
\<comment> \<open>alternative approach to lifting arithmetic equalities\<close>
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2743
lemma word_of_int_Ex: "\<exists>y. x = word_of_int y"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2744
  by (rule_tac x="uint x" in exI) simp
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2745
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2746
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2747
subsection \<open>Order on fixed-length words\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2748
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2749
lift_definition udvd :: \<open>'a::len word \<Rightarrow> 'a::len word \<Rightarrow> bool\<close> (infixl \<open>udvd\<close> 50)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2750
  is \<open>\<lambda>k l. take_bit LENGTH('a) k dvd take_bit LENGTH('a) l\<close> by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2751
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2752
lemma udvd_iff_dvd:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2753
  \<open>x udvd y \<longleftrightarrow> unat x dvd unat y\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2754
  by transfer (simp add: nat_dvd_iff)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2755
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2756
lemma udvd_iff_dvd_int:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2757
  \<open>v udvd w \<longleftrightarrow> uint v dvd uint w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2758
  by transfer rule
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2759
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2760
lemma udvdI [intro]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2761
  \<open>v udvd w\<close> if \<open>unat w = unat v * unat u\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2762
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2763
  from that have \<open>unat v dvd unat w\<close> ..
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2764
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2765
    by (simp add: udvd_iff_dvd)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2766
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2767
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2768
lemma udvdE [elim]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2769
  fixes v w :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2770
  assumes \<open>v udvd w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2771
  obtains u :: \<open>'a word\<close> where \<open>unat w = unat v * unat u\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2772
proof (cases \<open>v = 0\<close>)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2773
  case True
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2774
  moreover from True \<open>v udvd w\<close> have \<open>w = 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2775
    by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2776
  ultimately show thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2777
    using that by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2778
next
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2779
  case False
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2780
  then have \<open>unat v > 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2781
    by (simp add: unat_gt_0)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2782
  from \<open>v udvd w\<close> have \<open>unat v dvd unat w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2783
    by (simp add: udvd_iff_dvd)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2784
  then obtain n where \<open>unat w = unat v * n\<close> ..
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2785
  moreover have \<open>n < 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2786
  proof (rule ccontr)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2787
    assume \<open>\<not> n < 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2788
    then have \<open>n \<ge> 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2789
      by (simp add: not_le)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2790
    then have \<open>unat v * n \<ge> 2 ^ LENGTH('a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2791
      using \<open>unat v > 0\<close> mult_le_mono [of 1 \<open>unat v\<close> \<open>2 ^ LENGTH('a)\<close> n]
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2792
      by simp
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2793
    with \<open>unat w = unat v * n\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2794
    have \<open>unat w \<ge> 2 ^ LENGTH('a)\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2795
      by simp
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2796
    with unsigned_less [of w, where ?'a = nat] show False
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2797
      by linarith
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2798
  qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2799
  ultimately have \<open>unat w = unat v * unat (word_of_nat n :: 'a word)\<close>
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  2800
    by (auto simp add: take_bit_nat_eq_self_iff unsigned_of_nat intro: sym)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2801
  with that show thesis .
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2802
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2803
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2804
lemma udvd_imp_mod_eq_0:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2805
  \<open>w mod v = 0\<close> if \<open>v udvd w\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2806
  using that by transfer simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2807
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2808
lemma mod_eq_0_imp_udvd [intro?]:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2809
  \<open>v udvd w\<close> if \<open>w mod v = 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2810
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2811
  from that have \<open>unat (w mod v) = unat 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2812
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2813
  then have \<open>unat w mod unat v = 0\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2814
    by (simp add: unat_mod_distrib)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2815
  then have \<open>unat v dvd unat w\<close> ..
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2816
  then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2817
    by (simp add: udvd_iff_dvd)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2818
qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2819
72280
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2820
lemma udvd_imp_dvd:
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2821
  \<open>v dvd w\<close> if \<open>v udvd w\<close> for v w :: \<open>'a::len word\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2822
proof -
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2823
  from that obtain u :: \<open>'a word\<close> where \<open>unat w = unat v * unat u\<close> ..
72280
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2824
  then have \<open>(word_of_nat (unat w) :: 'a word) = word_of_nat (unat v * unat u)\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2825
    by simp
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2826
  then have \<open>w = v * u\<close>
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2827
    by simp
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2828
  then show \<open>v dvd w\<close> ..
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2829
qed
db43ee05066d canonical enum instance for word
haftmann
parents: 72265
diff changeset
  2830
72281
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2831
lemma exp_dvd_iff_exp_udvd:
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2832
  \<open>2 ^ n dvd w \<longleftrightarrow> 2 ^ n udvd w\<close> for v w :: \<open>'a::len word\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2833
proof
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2834
  assume \<open>2 ^ n udvd w\<close> then show \<open>2 ^ n dvd w\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2835
    by (rule udvd_imp_dvd) 
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2836
next
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2837
  assume \<open>2 ^ n dvd w\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2838
  then obtain u :: \<open>'a word\<close> where \<open>w = 2 ^ n * u\<close> ..
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2839
  then have \<open>w = push_bit n u\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2840
    by (simp add: push_bit_eq_mult)
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2841
  then show \<open>2 ^ n udvd w\<close>
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2842
    by transfer (simp add: take_bit_push_bit dvd_eq_mod_eq_0 flip: take_bit_eq_mod)
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2843
qed
beeadb35e357 more thorough treatment of division, particularly signed division on int and word
haftmann
parents: 72280
diff changeset
  2844
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2845
lemma udvd_nat_alt:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2846
  \<open>a udvd b \<longleftrightarrow> (\<exists>n. unat b = n * unat a)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2847
  by (auto simp add: udvd_iff_dvd)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2848
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2849
lemma udvd_unfold_int:
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2850
  \<open>a udvd b \<longleftrightarrow> (\<exists>n\<ge>0. uint b = n * uint a)\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2851
  unfolding udvd_iff_dvd_int
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2852
  by (metis dvd_div_mult_self dvd_triv_right uint_div_distrib uint_ge_0)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2853
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2854
lemma unat_minus_one:
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2855
  \<open>unat (w - 1) = unat w - 1\<close> if \<open>w \<noteq> 0\<close>
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2856
proof -
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2857
  have "0 \<le> uint w" by (fact uint_nonnegative)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2858
  moreover from that have "0 \<noteq> uint w"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2859
    by (simp add: uint_0_iff)
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2860
  ultimately have "1 \<le> uint w"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2861
    by arith
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2862
  from uint_lt2p [of w] have "uint w - 1 < 2 ^ LENGTH('a)"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2863
    by arith
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2864
  with \<open>1 \<le> uint w\<close> have "(uint w - 1) mod 2 ^ LENGTH('a) = uint w - 1"
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2865
    by (auto intro: mod_pos_pos_trivial)
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2866
  with \<open>1 \<le> uint w\<close> have "nat ((uint w - 1) mod 2 ^ LENGTH('a)) = nat (uint w) - 1"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  2867
    by (auto simp del: nat_uint_eq)
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2868
  then show ?thesis
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2869
    by (simp only: unat_eq_nat_uint word_arith_wis mod_diff_right_eq)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2870
      (metis of_int_1 uint_word_of_int unsigned_1)
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2871
qed
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2872
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2873
lemma measure_unat: "p \<noteq> 0 \<Longrightarrow> unat (p - 1) < unat p"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2874
  by (simp add: unat_minus_one) (simp add: unat_0_iff [symmetric])
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2875
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  2876
lemmas uint_add_ge0 [simp] = add_nonneg_nonneg [OF uint_ge_0 uint_ge_0]
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  2877
lemmas uint_mult_ge0 [simp] = mult_nonneg_nonneg [OF uint_ge_0 uint_ge_0]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2878
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2879
lemma uint_sub_lt2p [simp]: "uint x - uint y < 2 ^ LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2880
  for x :: "'a::len word" and y :: "'b::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2881
  using uint_ge_0 [of y] uint_lt2p [of x] by arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2882
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2883
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  2884
subsection \<open>Conditions for the addition (etc) of two words to overflow\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2885
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2886
lemma uint_add_lem:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2887
  "(uint x + uint y < 2 ^ LENGTH('a)) =
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2888
    (uint (x + y) = uint x + uint y)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2889
  for x y :: "'a::len word"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  2890
  by (metis add.right_neutral add_mono_thms_linordered_semiring(1) mod_pos_pos_trivial of_nat_0_le_iff uint_lt2p uint_nat uint_word_ariths(1))
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2891
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  2892
lemma uint_mult_lem:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2893
  "(uint x * uint y < 2 ^ LENGTH('a)) =
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2894
    (uint (x * y) = uint x * uint y)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2895
  for x y :: "'a::len word"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  2896
  by (metis mod_pos_pos_trivial uint_lt2p uint_mult_ge0 uint_word_ariths(3))
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2897
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2898
lemma uint_sub_lem: "uint x \<ge> uint y \<longleftrightarrow> uint (x - y) = uint x - uint y"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  2899
  by (metis diff_ge_0_iff_ge of_nat_0_le_iff uint_nat uint_sub_lt2p uint_word_of_int unique_euclidean_semiring_numeral_class.mod_less word_sub_wi)
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2900
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2901
lemma uint_add_le: "uint (x + y) \<le> uint x + uint y"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  2902
  unfolding uint_word_ariths by (simp add: zmod_le_nonneg_dividend) 
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2903
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2904
lemma uint_sub_ge: "uint (x - y) \<ge> uint x - uint y"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2905
  unfolding uint_word_ariths
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2906
  by (simp flip: take_bit_eq_mod add: take_bit_int_greater_eq_self_iff)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2907
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2908
lemma int_mod_ge: \<open>a \<le> a mod n\<close> if \<open>a < n\<close> \<open>0 < n\<close>
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2909
  for a n :: int
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2910
proof (cases \<open>a < 0\<close>)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2911
  case True
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2912
  with \<open>0 < n\<close> show ?thesis
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2913
    by (metis less_trans not_less pos_mod_conj)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2914
    
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2915
next
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2916
  case False
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2917
  with \<open>a < n\<close> show ?thesis
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2918
    by simp
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2919
qed
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  2920
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2921
lemma mod_add_if_z:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2922
  "\<lbrakk>x < z; y < z; 0 \<le> y; 0 \<le> x; 0 \<le> z\<rbrakk> \<Longrightarrow>
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2923
    (x + y) mod z = (if x + y < z then x + y else x + y - z)"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2924
  for x y z :: int
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2925
  apply (simp add: not_less)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2926
  by (metis (no_types) add_strict_mono diff_ge_0_iff_ge diff_less_eq minus_mod_self2 mod_pos_pos_trivial)
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2927
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2928
lemma uint_plus_if':
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2929
  "uint (a + b) =
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2930
    (if uint a + uint b < 2 ^ LENGTH('a) then uint a + uint b
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2931
     else uint a + uint b - 2 ^ LENGTH('a))"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2932
  for a b :: "'a::len word"
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2933
  using mod_add_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2934
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2935
lemma mod_sub_if_z:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2936
  "\<lbrakk>x < z; y < z; 0 \<le> y; 0 \<le> x; 0 \<le> z\<rbrakk> \<Longrightarrow>
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2937
    (x - y) mod z = (if y \<le> x then x - y else x - y + z)"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2938
  for x y z :: int
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2939
  using mod_pos_pos_trivial [of "x - y + z" z] by (auto simp add: not_le)
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2940
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2941
lemma uint_sub_if':
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2942
  "uint (a - b) =
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  2943
    (if uint b \<le> uint a then uint a - uint b
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2944
     else uint a - uint b + 2 ^ LENGTH('a))"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2945
  for a b :: "'a::len word"
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2946
  using mod_sub_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  2947
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2948
lemma word_of_int_inverse:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2949
  "word_of_int r = a \<Longrightarrow> 0 \<le> r \<Longrightarrow> r < 2 ^ LENGTH('a) \<Longrightarrow> uint a = r"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2950
  for a :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  2951
  by transfer (simp add: take_bit_int_eq_self)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2952
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2953
lemma unat_split: "P (unat x) \<longleftrightarrow> (\<forall>n. of_nat n = x \<and> n < 2^LENGTH('a) \<longrightarrow> P n)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2954
  for x :: "'a::len word"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2955
  by (auto simp add: unsigned_of_nat take_bit_nat_eq_self)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2956
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2957
lemma unat_split_asm: "P (unat x) \<longleftrightarrow> (\<nexists>n. of_nat n = x \<and> n < 2^LENGTH('a) \<and> \<not> P n)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2958
  for x :: "'a::len word"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2959
  by (auto simp add: unsigned_of_nat take_bit_nat_eq_self)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2960
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2961
lemma un_ui_le:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2962
  \<open>unat a \<le> unat b \<longleftrightarrow> uint a \<le> uint b\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2963
  by transfer (simp add: nat_le_iff) 
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2964
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2965
lemma unat_plus_if':
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2966
  \<open>unat (a + b) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2967
    (if unat a + unat b < 2 ^ LENGTH('a)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2968
    then unat a + unat b
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2969
    else unat a + unat b - 2 ^ LENGTH('a))\<close> for a b :: \<open>'a::len word\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2970
  apply (auto simp add: not_less le_iff_add)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2971
   apply (metis (mono_tags, lifting) of_nat_add of_nat_unat take_bit_nat_eq_self_iff unsigned_less unsigned_of_nat unsigned_word_eqI)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2972
  apply (smt (verit, ccfv_SIG) dbl_simps(3) dbl_simps(5) numerals(1) of_nat_0_le_iff of_nat_add of_nat_eq_iff of_nat_numeral of_nat_power of_nat_unat uint_plus_if' unsigned_1)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2973
  done
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2974
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2975
lemma unat_sub_if_size:
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2976
  "unat (x - y) =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2977
    (if unat y \<le> unat x
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2978
     then unat x - unat y
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2979
     else unat x + 2 ^ size x - unat y)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2980
proof -
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2981
  { assume xy: "\<not> uint y \<le> uint x"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2982
    have "nat (uint x - uint y + 2 ^ LENGTH('a)) = nat (uint x + 2 ^ LENGTH('a) - uint y)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2983
      by simp
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2984
    also have "... = nat (uint x + 2 ^ LENGTH('a)) - nat (uint y)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2985
      by (simp add: nat_diff_distrib')
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2986
    also have "... = nat (uint x) + 2 ^ LENGTH('a) - nat (uint y)"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2987
      by (metis nat_add_distrib nat_eq_numeral_power_cancel_iff order_less_imp_le unsigned_0 unsigned_greater_eq unsigned_less)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2988
    finally have "nat (uint x - uint y + 2 ^ LENGTH('a)) = nat (uint x) + 2 ^ LENGTH('a) - nat (uint y)" .
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2989
  }
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2990
  then show ?thesis
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2991
    by (simp add: word_size) (metis nat_diff_distrib' uint_sub_if' un_ui_le unat_eq_nat_uint unsigned_greater_eq)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2992
qed
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2993
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2994
lemmas unat_sub_if' = unat_sub_if_size [unfolded word_size]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  2995
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  2996
lemma uint_split:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  2997
  "P (uint x) = (\<forall>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<longrightarrow> P i)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  2998
  for x :: "'a::len word"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  2999
  by transfer (auto simp add: take_bit_eq_mod)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3000
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3001
lemma uint_split_asm:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3002
  "P (uint x) = (\<nexists>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<and> \<not> P i)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3003
  for x :: "'a::len word"
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  3004
  by (auto simp add: unsigned_of_int take_bit_int_eq_self)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3005
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3006
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3007
subsection \<open>Some proof tool support\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3008
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3009
\<comment> \<open>use this to stop, eg. \<open>2 ^ LENGTH(32)\<close> being simplified\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3010
lemma power_False_cong: "False \<Longrightarrow> a ^ b = c ^ d"
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3011
  by auto
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3012
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3013
lemmas unat_splits = unat_split unat_split_asm
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3014
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3015
lemmas unat_arith_simps =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3016
  word_le_nat_alt word_less_nat_alt
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3017
  word_unat_eq_iff
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3018
  unat_sub_if' unat_plus_if' unat_div unat_mod
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3019
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3020
lemmas uint_splits = uint_split uint_split_asm
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3021
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3022
lemmas uint_arith_simps =
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3023
  word_le_def word_less_alt
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3024
  word_uint_eq_iff
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3025
  uint_sub_if' uint_plus_if'
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3026
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3027
\<comment> \<open>\<open>unat_arith_tac\<close>: tactic to reduce word arithmetic to \<open>nat\<close>, try to solve via \<open>arith\<close>\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3028
ML \<open>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3029
val unat_arith_simpset =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3030
  @{context} (* TODO: completely explicitly determined simpset *)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3031
  |> fold Simplifier.add_simp @{thms unat_arith_simps}
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3032
  |> fold Splitter.add_split @{thms if_split_asm}
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3033
  |> fold Simplifier.add_cong @{thms power_False_cong}
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3034
  |> simpset_of
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3035
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3036
fun unat_arith_tacs ctxt =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3037
  let
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3038
    fun arith_tac' n t =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3039
      Arith_Data.arith_tac ctxt n t
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3040
        handle Cooper.COOPER _ => Seq.empty;
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3041
  in
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3042
    [ clarify_tac ctxt 1,
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3043
      full_simp_tac (put_simpset unat_arith_simpset ctxt) 1,
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3044
      ALLGOALS (full_simp_tac
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3045
        (put_simpset HOL_ss ctxt
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3046
          |> fold Splitter.add_split @{thms unat_splits}
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3047
          |> fold Simplifier.add_cong @{thms power_False_cong})),
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3048
      rewrite_goals_tac ctxt @{thms word_size},
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3049
      ALLGOALS (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3050
                         REPEAT (eresolve_tac ctxt [conjE] n) THEN
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3051
                         REPEAT (dresolve_tac ctxt @{thms of_nat_inverse} n THEN assume_tac ctxt n)),
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3052
      TRYALL arith_tac' ]
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3053
  end
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3054
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3055
fun unat_arith_tac ctxt = SELECT_GOAL (EVERY (unat_arith_tacs ctxt))
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3056
\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3057
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3058
method_setup unat_arith =
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3059
  \<open>Scan.succeed (SIMPLE_METHOD' o unat_arith_tac)\<close>
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3060
  "solving word arithmetic via natural numbers and arith"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3061
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3062
\<comment> \<open>\<open>uint_arith_tac\<close>: reduce to arithmetic on int, try to solve by arith\<close>
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3063
ML \<open>
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3064
val uint_arith_simpset =
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3065
  @{context} (* TODO: completely explicitly determined simpset *)
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3066
  |> fold Simplifier.add_simp @{thms uint_arith_simps}
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3067
  |> fold Splitter.add_split @{thms if_split_asm}
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3068
  |> fold Simplifier.add_cong @{thms power_False_cong}
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3069
  |> simpset_of;
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3070
  
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3071
fun uint_arith_tacs ctxt =
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3072
  let
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3073
    fun arith_tac' n t =
59657
2441a80fb6c1 eliminated unused arith "verbose" flag -- tools that need options can use the context;
wenzelm
parents: 59498
diff changeset
  3074
      Arith_Data.arith_tac ctxt n t
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3075
        handle Cooper.COOPER _ => Seq.empty;
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3076
  in
42793
88bee9f6eec7 proper Proof.context for classical tactics;
wenzelm
parents: 41550
diff changeset
  3077
    [ clarify_tac ctxt 1,
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3078
      full_simp_tac (put_simpset uint_arith_simpset ctxt) 1,
51717
9e7d1c139569 simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents: 51375
diff changeset
  3079
      ALLGOALS (full_simp_tac
9e7d1c139569 simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents: 51375
diff changeset
  3080
        (put_simpset HOL_ss ctxt
9e7d1c139569 simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents: 51375
diff changeset
  3081
          |> fold Splitter.add_split @{thms uint_splits}
9e7d1c139569 simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents: 51375
diff changeset
  3082
          |> fold Simplifier.add_cong @{thms power_False_cong})),
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3083
      rewrite_goals_tac ctxt @{thms word_size},
59498
50b60f501b05 proper context for resolve_tac, eresolve_tac, dresolve_tac, forward_tac etc.;
wenzelm
parents: 59487
diff changeset
  3084
      ALLGOALS  (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
60754
02924903a6fd prefer tactics with explicit context;
wenzelm
parents: 60429
diff changeset
  3085
                         REPEAT (eresolve_tac ctxt [conjE] n) THEN
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3086
                         REPEAT (dresolve_tac ctxt @{thms word_of_int_inverse} n
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3087
                                 THEN assume_tac ctxt n
58963
26bf09b95dda proper context for assume_tac (atac remains as fall-back without context);
wenzelm
parents: 58874
diff changeset
  3088
                                 THEN assume_tac ctxt n)),
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3089
      TRYALL arith_tac' ]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3090
  end
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3091
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3092
fun uint_arith_tac ctxt = SELECT_GOAL (EVERY (uint_arith_tacs ctxt))
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3093
\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3094
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3095
method_setup uint_arith =
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3096
  \<open>Scan.succeed (SIMPLE_METHOD' o uint_arith_tac)\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3097
  "solving word arithmetic via integers and arith"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3098
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3099
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3100
subsection \<open>More on overflows and monotonicity\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3101
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3102
lemma no_plus_overflow_uint_size: "x \<le> x + y \<longleftrightarrow> uint x + uint y < 2 ^ size x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3103
  for x y :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3104
  by (auto simp add: word_size word_le_def uint_add_lem uint_sub_lem)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3105
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3106
lemmas no_olen_add = no_plus_overflow_uint_size [unfolded word_size]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3107
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3108
lemma no_ulen_sub: "x \<ge> x - y \<longleftrightarrow> uint y \<le> uint x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3109
  for x y :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3110
  by (auto simp add: word_size word_le_def uint_add_lem uint_sub_lem)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3111
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3112
lemma no_olen_add': "x \<le> y + x \<longleftrightarrow> uint y + uint x < 2 ^ LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3113
  for x y :: "'a::len word"
57514
bdc2c6b40bf2 prefer ac_simps collections over separate name bindings for add and mult
haftmann
parents: 57512
diff changeset
  3114
  by (simp add: ac_simps no_olen_add)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3115
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3116
lemmas olen_add_eqv = trans [OF no_olen_add no_olen_add' [symmetric]]
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3117
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3118
lemmas uint_plus_simple_iff = trans [OF no_olen_add uint_add_lem]
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3119
lemmas uint_plus_simple = uint_plus_simple_iff [THEN iffD1]
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3120
lemmas uint_minus_simple_iff = trans [OF no_ulen_sub uint_sub_lem]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3121
lemmas uint_minus_simple_alt = uint_sub_lem [folded word_le_def]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3122
lemmas word_sub_le_iff = no_ulen_sub [folded word_le_def]
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3123
lemmas word_sub_le = word_sub_le_iff [THEN iffD2]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3124
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3125
lemma word_less_sub1: "x \<noteq> 0 \<Longrightarrow> 1 < x \<longleftrightarrow> 0 < x - 1"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3126
  for x :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3127
  by transfer (simp add: take_bit_decr_eq) 
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3128
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3129
lemma word_le_sub1: "x \<noteq> 0 \<Longrightarrow> 1 \<le> x \<longleftrightarrow> 0 \<le> x - 1"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3130
  for x :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3131
  by transfer (simp add: int_one_le_iff_zero_less less_le)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3132
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3133
lemma sub_wrap_lt: "x < x - z \<longleftrightarrow> x < z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3134
  for x z :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3135
  by (simp add: word_less_def uint_sub_lem)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3136
   (meson linorder_not_le uint_minus_simple_iff uint_sub_lem word_less_iff_unsigned)
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3137
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3138
lemma sub_wrap: "x \<le> x - z \<longleftrightarrow> z = 0 \<or> x < z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3139
  for x z :: "'a::len word"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3140
  by (simp add: le_less sub_wrap_lt ac_simps)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3141
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3142
lemma plus_minus_not_NULL_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> x + c \<noteq> 0"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3143
  for x ab c :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3144
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3145
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3146
lemma plus_minus_no_overflow_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> x \<le> x + c"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3147
  for x ab c :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3148
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3149
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3150
lemma le_minus': "a + c \<le> b \<Longrightarrow> a \<le> a + c \<Longrightarrow> c \<le> b - a"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3151
  for a b c :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3152
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3153
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3154
lemma le_plus': "a \<le> b \<Longrightarrow> c \<le> b - a \<Longrightarrow> a + c \<le> b"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3155
  for a b c :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3156
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3157
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3158
lemmas le_plus = le_plus' [rotated]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3159
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3160
lemmas le_minus = leD [THEN thin_rl, THEN le_minus'] (* FIXME *)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3161
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3162
lemma word_plus_mono_right: "y \<le> z \<Longrightarrow> x \<le> x + z \<Longrightarrow> x + y \<le> x + z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3163
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3164
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3165
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3166
lemma word_less_minus_cancel: "y - x < z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y < z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3167
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3168
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3169
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3170
lemma word_less_minus_mono_left: "y < z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x < z - x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3171
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3172
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3173
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3174
lemma word_less_minus_mono: "a < c \<Longrightarrow> d < b \<Longrightarrow> a - b < a \<Longrightarrow> c - d < c \<Longrightarrow> a - b < c - d"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3175
  for a b c d :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3176
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3177
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3178
lemma word_le_minus_cancel: "y - x \<le> z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y \<le> z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3179
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3180
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3181
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3182
lemma word_le_minus_mono_left: "y \<le> z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x \<le> z - x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3183
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3184
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3185
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3186
lemma word_le_minus_mono:
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3187
  "a \<le> c \<Longrightarrow> d \<le> b \<Longrightarrow> a - b \<le> a \<Longrightarrow> c - d \<le> c \<Longrightarrow> a - b \<le> c - d"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3188
  for a b c d :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3189
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3190
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3191
lemma plus_le_left_cancel_wrap: "x + y' < x \<Longrightarrow> x + y < x \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3192
  for x y y' :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3193
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3194
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3195
lemma plus_le_left_cancel_nowrap: "x \<le> x + y' \<Longrightarrow> x \<le> x + y \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3196
  for x y y' :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3197
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3198
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3199
lemma word_plus_mono_right2: "a \<le> a + b \<Longrightarrow> c \<le> b \<Longrightarrow> a \<le> a + c"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3200
  for a b c :: "'a::len word"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3201
  by uint_arith
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3202
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3203
lemma word_less_add_right: "x < y - z \<Longrightarrow> z \<le> y \<Longrightarrow> x + z < y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3204
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3205
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3206
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3207
lemma word_less_sub_right: "x < y + z \<Longrightarrow> y \<le> x \<Longrightarrow> x - y < z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3208
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3209
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3210
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3211
lemma word_le_plus_either: "x \<le> y \<or> x \<le> z \<Longrightarrow> y \<le> y + z \<Longrightarrow> x \<le> y + z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3212
  for x y z :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3213
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3214
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3215
lemma word_less_nowrapI: "x < z - k \<Longrightarrow> k \<le> z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3216
  for x z k :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3217
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3218
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3219
lemma inc_le: "i < m \<Longrightarrow> i + 1 \<le> m"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3220
  for i m :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3221
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3222
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3223
lemma inc_i: "1 \<le> i \<Longrightarrow> i < m \<Longrightarrow> 1 \<le> i + 1 \<and> i + 1 \<le> m"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3224
  for i m :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3225
  by uint_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3226
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3227
lemma udvd_incr_lem:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3228
  "up < uq \<Longrightarrow> up = ua + n * uint K \<Longrightarrow>
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3229
    uq = ua + n' * uint K \<Longrightarrow> up + uint K \<le> uq"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3230
  by auto (metis int_distrib(1) linorder_not_less mult.left_neutral mult_right_mono uint_nonnegative zless_imp_add1_zle)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3231
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3232
lemma udvd_incr':
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3233
  "p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow>
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3234
    uint q = ua + n' * uint K \<Longrightarrow> p + K \<le> q"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3235
  unfolding word_less_alt word_le_def
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3236
  by (metis (full_types) order_trans udvd_incr_lem uint_add_le)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3237
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3238
lemma udvd_decr':
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3239
  assumes "p < q" "uint p = ua + n * uint K" "uint q = ua + n' * uint K"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3240
    shows "uint q = ua + n' * uint K \<Longrightarrow> p \<le> q - K"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3241
proof -
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3242
  have "\<And>w wa. uint (w::'a word) \<le> uint wa + uint (w - wa)"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3243
    by (metis (no_types) add_diff_cancel_left' diff_add_cancel uint_add_le)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3244
  moreover have "uint K + uint p \<le> uint q"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3245
    using assms by (metis (no_types) add_diff_cancel_left' diff_add_cancel udvd_incr_lem word_less_def)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3246
  ultimately show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3247
    by (meson add_le_cancel_left order_trans word_less_eq_iff_unsigned)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3248
qed
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3249
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  3250
lemmas udvd_incr_lem0 = udvd_incr_lem [where ua=0, unfolded add_0_left]
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  3251
lemmas udvd_incr0 = udvd_incr' [where ua=0, unfolded add_0_left]
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  3252
lemmas udvd_decr0 = udvd_decr' [where ua=0, unfolded add_0_left]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3253
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3254
lemma udvd_minus_le': "xy < k \<Longrightarrow> z udvd xy \<Longrightarrow> z udvd k \<Longrightarrow> xy \<le> k - z"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3255
  unfolding udvd_unfold_int
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3256
  by (meson udvd_decr0)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3257
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3258
lemma udvd_incr2_K:
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3259
  "p < a + s \<Longrightarrow> a \<le> a + s \<Longrightarrow> K udvd s \<Longrightarrow> K udvd p - a \<Longrightarrow> a \<le> p \<Longrightarrow>
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3260
    0 < K \<Longrightarrow> p \<le> p + K \<and> p + K \<le> a + s"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3261
  unfolding udvd_unfold_int
62390
842917225d56 more canonical names
nipkow
parents: 62348
diff changeset
  3262
  apply (simp add: uint_arith_simps split: if_split_asm)
73932
fd21b4a93043 added opaque_combs and renamed hide_lams to opaque_lifting
desharna
parents: 73853
diff changeset
  3263
  apply (metis (no_types, opaque_lifting) le_add_diff_inverse le_less_trans udvd_incr_lem)
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3264
  using uint_lt2p [of s] by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3265
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3266
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3267
subsection \<open>Arithmetic type class instantiations\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3268
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3269
lemmas word_le_0_iff [simp] =
70749
5d06b7bb9d22 More type class generalisations. Note that linorder_antisym_conv1 and linorder_antisym_conv2 no longer exist.
paulson <lp15@cam.ac.uk>
parents: 70342
diff changeset
  3270
  word_zero_le [THEN leD, THEN antisym_conv1]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3271
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3272
lemma word_of_int_nat: "0 \<le> x \<Longrightarrow> word_of_int x = of_nat (nat x)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3273
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3274
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3275
text \<open>
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3276
  note that \<open>iszero_def\<close> is only for class \<open>comm_semiring_1_cancel\<close>,
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3277
  which requires word length \<open>\<ge> 1\<close>, ie \<open>'a::len word\<close>
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3278
\<close>
46603
83a5160e6b4d removed unnecessary lemma zero_bintrunc
huffman
parents: 46602
diff changeset
  3279
lemma iszero_word_no [simp]:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3280
  "iszero (numeral bin :: 'a::len word) =
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3281
    iszero (take_bit LENGTH('a) (numeral bin :: int))"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3282
  by (metis iszero_def uint_0_iff uint_bintrunc)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3283
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3284
text \<open>Use \<open>iszero\<close> to simplify equalities between word numerals.\<close>
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3285
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3286
lemmas word_eq_numeral_iff_iszero [simp] =
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3287
  eq_numeral_iff_iszero [where 'a="'a::len word"]
46603
83a5160e6b4d removed unnecessary lemma zero_bintrunc
huffman
parents: 46602
diff changeset
  3288
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3289
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3290
subsection \<open>Word and nat\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3291
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3292
lemma word_nchotomy: "\<forall>w :: 'a::len word. \<exists>n. w = of_nat n \<and> n < 2 ^ LENGTH('a)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3293
  by (metis of_nat_unat ucast_id unsigned_less)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3294
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3295
lemma of_nat_eq: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ LENGTH('a))"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3296
  for w :: "'a::len word"
68157
057d5b4ce47e removed some non-essential rules
haftmann
parents: 67443
diff changeset
  3297
  using mod_div_mult_eq [of n "2 ^ LENGTH('a)", symmetric]
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  3298
  by (auto simp flip: take_bit_eq_mod simp add: unsigned_of_nat)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3299
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3300
lemma of_nat_eq_size: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ size w)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3301
  unfolding word_size by (rule of_nat_eq)
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3302
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3303
lemma of_nat_0: "of_nat m = (0::'a::len word) \<longleftrightarrow> (\<exists>q. m = q * 2 ^ LENGTH('a))"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3304
  by (simp add: of_nat_eq)
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3305
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3306
lemma of_nat_2p [simp]: "of_nat (2 ^ LENGTH('a)) = (0::'a::len word)"
45805
3c609e8785f2 tidied Word.thy;
huffman
parents: 45804
diff changeset
  3307
  by (fact mult_1 [symmetric, THEN iffD2 [OF of_nat_0 exI]])
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3308
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3309
lemma of_nat_gt_0: "of_nat k \<noteq> 0 \<Longrightarrow> 0 < k"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3310
  by (cases k) auto
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3311
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3312
lemma of_nat_neq_0: "0 < k \<Longrightarrow> k < 2 ^ LENGTH('a::len) \<Longrightarrow> of_nat k \<noteq> (0 :: 'a word)"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3313
  by (auto simp add : of_nat_0)
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3314
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3315
lemma Abs_fnat_hom_add: "of_nat a + of_nat b = of_nat (a + b)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3316
  by simp
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3317
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3318
lemma Abs_fnat_hom_mult: "of_nat a * of_nat b = (of_nat (a * b) :: 'a::len word)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3319
  by (simp add: wi_hom_mult)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3320
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3321
lemma Abs_fnat_hom_Suc: "word_succ (of_nat a) = of_nat (Suc a)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3322
  by transfer (simp add: ac_simps)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3323
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3324
lemma Abs_fnat_hom_0: "(0::'a::len word) = of_nat 0"
45995
b16070689726 declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents: 45958
diff changeset
  3325
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3326
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3327
lemma Abs_fnat_hom_1: "(1::'a::len word) = of_nat (Suc 0)"
45995
b16070689726 declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents: 45958
diff changeset
  3328
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3329
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3330
lemmas Abs_fnat_homs =
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3331
  Abs_fnat_hom_add Abs_fnat_hom_mult Abs_fnat_hom_Suc
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3332
  Abs_fnat_hom_0 Abs_fnat_hom_1
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3333
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3334
lemma word_arith_nat_add: "a + b = of_nat (unat a + unat b)"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3335
  by simp
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3336
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3337
lemma word_arith_nat_mult: "a * b = of_nat (unat a * unat b)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3338
  by simp
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3339
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3340
lemma word_arith_nat_Suc: "word_succ a = of_nat (Suc (unat a))"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3341
  by (subst Abs_fnat_hom_Suc [symmetric]) simp
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3342
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3343
lemma word_arith_nat_div: "a div b = of_nat (unat a div unat b)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3344
  by (metis of_int_of_nat_eq of_nat_unat of_nat_div word_div_def)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3345
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3346
lemma word_arith_nat_mod: "a mod b = of_nat (unat a mod unat b)"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3347
  by (metis of_int_of_nat_eq of_nat_mod of_nat_unat word_mod_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3348
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3349
lemmas word_arith_nat_defs =
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3350
  word_arith_nat_add word_arith_nat_mult
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3351
  word_arith_nat_Suc Abs_fnat_hom_0
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3352
  Abs_fnat_hom_1 word_arith_nat_div
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3353
  word_arith_nat_mod
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3354
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  3355
lemma unat_cong: "x = y \<Longrightarrow> unat x = unat y"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3356
  by (fact arg_cong)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3357
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3358
lemma unat_of_nat:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3359
  \<open>unat (word_of_nat x :: 'a::len word) = x mod 2 ^ LENGTH('a)\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3360
  by transfer (simp flip: take_bit_eq_mod add: nat_take_bit_eq)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3361
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3362
lemmas unat_word_ariths = word_arith_nat_defs
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3363
  [THEN trans [OF unat_cong unat_of_nat]]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3364
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3365
lemmas word_sub_less_iff = word_sub_le_iff
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  3366
  [unfolded linorder_not_less [symmetric] Not_eq_iff]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3367
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3368
lemma unat_add_lem:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3369
  "unat x + unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x + y) = unat x + unat y"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3370
  for x y :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3371
  by (metis mod_less unat_word_ariths(1) unsigned_less)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3372
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3373
lemma unat_mult_lem:
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3374
  "unat x * unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x * y) = unat x * unat y"
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  3375
  for x y :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3376
  by (metis mod_less unat_word_ariths(2) unsigned_less)
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3377
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3378
lemma le_no_overflow: "x \<le> b \<Longrightarrow> a \<le> a + b \<Longrightarrow> x \<le> a + b"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3379
  for a b x :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3380
  using word_le_plus_either by blast
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3381
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3382
lemma uint_div:
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3383
  \<open>uint (x div y) = uint x div uint y\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3384
  by (fact uint_div_distrib)
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3385
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3386
lemma uint_mod:
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3387
  \<open>uint (x mod y) = uint x mod uint y\<close>
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3388
  by (fact uint_mod_distrib)
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3389
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3390
lemma no_plus_overflow_unat_size: "x \<le> x + y \<longleftrightarrow> unat x + unat y < 2 ^ size x"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3391
  for x y :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3392
  unfolding word_size by unat_arith
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3393
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3394
lemmas no_olen_add_nat =
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3395
  no_plus_overflow_unat_size [unfolded word_size]
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3396
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3397
lemmas unat_plus_simple =
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3398
  trans [OF no_olen_add_nat unat_add_lem]
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3399
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3400
lemma word_div_mult: "\<lbrakk>0 < y; unat x * unat y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow> x * y div y = x"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3401
  for x y :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3402
  by (simp add: unat_eq_zero unat_mult_lem word_arith_nat_div)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3403
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3404
lemma div_lt': "i \<le> k div x \<Longrightarrow> unat i * unat x < 2 ^ LENGTH('a)"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3405
  for i k x :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3406
  by unat_arith (meson le_less_trans less_mult_imp_div_less not_le unsigned_less)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3407
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3408
lemmas div_lt'' = order_less_imp_le [THEN div_lt']
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3409
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3410
lemma div_lt_mult: "\<lbrakk>i < k div x; 0 < x\<rbrakk> \<Longrightarrow> i * x < k"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3411
  for i k x :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3412
  by (metis div_le_mono div_lt'' not_le unat_div word_div_mult word_less_iff_unsigned)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3413
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3414
lemma div_le_mult: "\<lbrakk>i \<le> k div x; 0 < x\<rbrakk> \<Longrightarrow> i * x \<le> k"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3415
  for i k x :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3416
  by (metis div_lt' less_mult_imp_div_less not_less unat_arith_simps(2) unat_div unat_mult_lem)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3417
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3418
lemma div_lt_uint': "i \<le> k div x \<Longrightarrow> uint i * uint x < 2 ^ LENGTH('a)"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3419
  for i k x :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3420
  unfolding uint_nat
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3421
  by (metis div_lt' int_ops(7) of_nat_unat uint_mult_lem unat_mult_lem)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3422
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3423
lemmas div_lt_uint'' = order_less_imp_le [THEN div_lt_uint']
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3424
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  3425
lemma word_le_exists': "x \<le> y \<Longrightarrow> \<exists>z. y = x + z \<and> uint x + uint z < 2 ^ LENGTH('a)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3426
  for x y z :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3427
  by (metis add.commute diff_add_cancel no_olen_add)
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3428
  
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3429
lemmas plus_minus_not_NULL = order_less_imp_le [THEN plus_minus_not_NULL_ab]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3430
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3431
lemmas plus_minus_no_overflow =
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3432
  order_less_imp_le [THEN plus_minus_no_overflow_ab]
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3433
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3434
lemmas mcs = word_less_minus_cancel word_less_minus_mono_left
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3435
  word_le_minus_cancel word_le_minus_mono_left
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3436
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3437
lemmas word_l_diffs = mcs [where y = "w + x", unfolded add_diff_cancel] for w x
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3438
lemmas word_diff_ls = mcs [where z = "w + x", unfolded add_diff_cancel] for w x
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3439
lemmas word_plus_mcs = word_diff_ls [where y = "v + x", unfolded add_diff_cancel] for v x
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3440
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3441
lemma le_unat_uoi:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3442
  \<open>y \<le> unat z \<Longrightarrow> unat (word_of_nat y :: 'a word) = y\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3443
  for z :: \<open>'a::len word\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3444
  by transfer (simp add: nat_take_bit_eq take_bit_nat_eq_self_iff le_less_trans)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3445
66808
1907167b6038 elementary definition of division on natural numbers
haftmann
parents: 66453
diff changeset
  3446
lemmas thd = times_div_less_eq_dividend
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3447
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3448
lemmas uno_simps [THEN le_unat_uoi] = mod_le_divisor div_le_dividend
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3449
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3450
lemma word_mod_div_equality: "(n div b) * b + (n mod b) = n"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3451
  for n b :: "'a::len word"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3452
  by (fact div_mult_mod_eq)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3453
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3454
lemma word_div_mult_le: "a div b * b \<le> a"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3455
  for a b :: "'a::len word"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3456
  by (metis div_le_mult mult_not_zero order.not_eq_order_implies_strict order_refl word_zero_le)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3457
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3458
lemma word_mod_less_divisor: "0 < n \<Longrightarrow> m mod n < n"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3459
  for m n :: "'a::len word"
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3460
  by (simp add: unat_arith_simps)
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3461
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3462
lemma word_of_int_power_hom: "word_of_int a ^ n = (word_of_int (a ^ n) :: 'a::len word)"
45995
b16070689726 declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents: 45958
diff changeset
  3463
  by (induct n) (simp_all add: wi_hom_mult [symmetric])
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3464
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3465
lemma word_arith_power_alt: "a ^ n = (word_of_int (uint a ^ n) :: 'a::len word)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3466
  by (simp add : word_of_int_power_hom [symmetric])
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3467
70183
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3468
lemma unatSuc: "1 + n \<noteq> 0 \<Longrightarrow> unat (1 + n) = Suc (unat n)"
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3469
  for n :: "'a::len word"
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3470
  by unat_arith
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3471
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3472
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3473
subsection \<open>Cardinality, finiteness of set of words\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3474
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3475
lemma inj_on_word_of_int: \<open>inj_on (word_of_int :: int \<Rightarrow> 'a word) {0..<2 ^ LENGTH('a::len)}\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3476
  unfolding inj_on_def
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3477
  by (metis atLeastLessThan_iff word_of_int_inverse)
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
  3478
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3479
lemma range_uint: \<open>range (uint :: 'a word \<Rightarrow> int) = {0..<2 ^ LENGTH('a::len)}\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3480
  apply transfer
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3481
  apply (auto simp add: image_iff)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3482
  apply (metis take_bit_int_eq_self_iff)
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3483
  done
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
  3484
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3485
lemma UNIV_eq: \<open>(UNIV :: 'a word set) = word_of_int ` {0..<2 ^ LENGTH('a::len)}\<close>
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3486
  by (auto simp add: image_iff) (metis atLeastLessThan_iff linorder_not_le uint_split)
45809
2bee94cbae72 finite class instance for word type; remove unused lemmas
huffman
parents: 45808
diff changeset
  3487
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3488
lemma card_word: "CARD('a word) = 2 ^ LENGTH('a::len)"
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
  3489
  by (simp add: UNIV_eq card_image inj_on_word_of_int)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3490
70183
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3491
lemma card_word_size: "CARD('a word) = 2 ^ size x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3492
  for x :: "'a::len word"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3493
  unfolding word_size by (rule card_word)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3494
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3495
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3496
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3497
instance word :: (len) finite
71948
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
  3498
  by standard (simp add: UNIV_eq)
6ede899d26d3 fundamental construction of word type following existing transfer rules
haftmann
parents: 71947
diff changeset
  3499
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3500
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3501
subsection \<open>Bitwise Operations on Words\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3502
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3503
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3504
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3505
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  3506
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3507
lemma word_wi_log_defs:
71149
a7d1fb0c9e16 proper prefix syntax
haftmann
parents: 70901
diff changeset
  3508
  "NOT (word_of_int a) = word_of_int (NOT a)"
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3509
  "word_of_int a AND word_of_int b = word_of_int (a AND b)"
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3510
  "word_of_int a OR word_of_int b = word_of_int (a OR b)"
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3511
  "word_of_int a XOR word_of_int b = word_of_int (a XOR b)"
47374
9475d524bafb set up and use lift_definition for word operations
huffman
parents: 47372
diff changeset
  3512
  by (transfer, rule refl)+
47372
9ab4e22dac7b configure transfer method for 'a word -> int
huffman
parents: 47168
diff changeset
  3513
46011
96a5f44c22da replace 'lemmas' with explicit 'lemma'
huffman
parents: 46010
diff changeset
  3514
lemma word_no_log_defs [simp]:
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3515
  "NOT (numeral a) = word_of_int (NOT (numeral a))"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3516
  "NOT (- numeral a) = word_of_int (NOT (- numeral a))"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3517
  "numeral a AND numeral b = word_of_int (numeral a AND numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3518
  "numeral a AND - numeral b = word_of_int (numeral a AND - numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3519
  "- numeral a AND numeral b = word_of_int (- numeral a AND numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3520
  "- numeral a AND - numeral b = word_of_int (- numeral a AND - numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3521
  "numeral a OR numeral b = word_of_int (numeral a OR numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3522
  "numeral a OR - numeral b = word_of_int (numeral a OR - numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3523
  "- numeral a OR numeral b = word_of_int (- numeral a OR numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3524
  "- numeral a OR - numeral b = word_of_int (- numeral a OR - numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3525
  "numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3526
  "numeral a XOR - numeral b = word_of_int (numeral a XOR - numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3527
  "- numeral a XOR numeral b = word_of_int (- numeral a XOR numeral b)"
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3528
  "- numeral a XOR - numeral b = word_of_int (- numeral a XOR - numeral b)"
47372
9ab4e22dac7b configure transfer method for 'a word -> int
huffman
parents: 47168
diff changeset
  3529
  by (transfer, rule refl)+
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3530
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3531
text \<open>Special cases for when one of the arguments equals 1.\<close>
46064
88ef116e0522 add simp rules for bitwise word operations with 1
huffman
parents: 46057
diff changeset
  3532
88ef116e0522 add simp rules for bitwise word operations with 1
huffman
parents: 46057
diff changeset
  3533
lemma word_bitwise_1_simps [simp]:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3534
  "NOT (1::'a::len word) = -2"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3535
  "1 AND numeral b = word_of_int (1 AND numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3536
  "1 AND - numeral b = word_of_int (1 AND - numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3537
  "numeral a AND 1 = word_of_int (numeral a AND 1)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3538
  "- numeral a AND 1 = word_of_int (- numeral a AND 1)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3539
  "1 OR numeral b = word_of_int (1 OR numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3540
  "1 OR - numeral b = word_of_int (1 OR - numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3541
  "numeral a OR 1 = word_of_int (numeral a OR 1)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3542
  "- numeral a OR 1 = word_of_int (- numeral a OR 1)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3543
  "1 XOR numeral b = word_of_int (1 XOR numeral b)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3544
  "1 XOR - numeral b = word_of_int (1 XOR - numeral b)"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3545
  "numeral a XOR 1 = word_of_int (numeral a XOR 1)"
54489
03ff4d1e6784 eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents: 54225
diff changeset
  3546
  "- numeral a XOR 1 = word_of_int (- numeral a XOR 1)"
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  3547
              apply (simp_all add: word_uint_eq_iff unsigned_not_eq unsigned_and_eq unsigned_or_eq
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  3548
         unsigned_xor_eq of_nat_take_bit ac_simps unsigned_of_int)
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3549
       apply (simp_all add: minus_numeral_eq_not_sub_one)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3550
   apply (simp_all only: sub_one_eq_not_neg bit.xor_compl_right take_bit_xor bit.double_compl)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3551
   apply simp_all
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3552
  done
46064
88ef116e0522 add simp rules for bitwise word operations with 1
huffman
parents: 46057
diff changeset
  3553
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3554
text \<open>Special cases for when one of the arguments equals -1.\<close>
56979
376604d56b54 added lemmas for -1
noschinl
parents: 56078
diff changeset
  3555
376604d56b54 added lemmas for -1
noschinl
parents: 56078
diff changeset
  3556
lemma word_bitwise_m1_simps [simp]:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3557
  "NOT (-1::'a::len word) = 0"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3558
  "(-1::'a::len word) AND x = x"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3559
  "x AND (-1::'a::len word) = x"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3560
  "(-1::'a::len word) OR x = -1"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3561
  "x OR (-1::'a::len word) = -1"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3562
  " (-1::'a::len word) XOR x = NOT x"
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3563
  "x XOR (-1::'a::len word) = NOT x"
56979
376604d56b54 added lemmas for -1
noschinl
parents: 56078
diff changeset
  3564
  by (transfer, simp)+
376604d56b54 added lemmas for -1
noschinl
parents: 56078
diff changeset
  3565
74163
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3566
lemma word_of_int_not_numeral_eq [simp]:
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3567
  \<open>(word_of_int (NOT (numeral bin)) :: 'a::len word) = - numeral bin - 1\<close>
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3568
  by transfer (simp add: not_eq_complement)
afe3c8ae1624 consolidation of rules for bit operations
haftmann
parents: 74108
diff changeset
  3569
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3570
lemma uint_and:
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3571
  \<open>uint (x AND y) = uint x AND uint y\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3572
  by transfer simp
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3573
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3574
lemma uint_or:
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3575
  \<open>uint (x OR y) = uint x OR uint y\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3576
  by transfer simp
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3577
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3578
lemma uint_xor:
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3579
  \<open>uint (x XOR y) = uint x XOR uint y\<close>
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3580
  by transfer simp
47372
9ab4e22dac7b configure transfer method for 'a word -> int
huffman
parents: 47168
diff changeset
  3581
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  3582
\<comment> \<open>get from commutativity, associativity etc of \<open>int_and\<close> etc to same for \<open>word_and etc\<close>\<close>
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3583
lemmas bwsimps =
46013
d2f179d26133 remove some duplicate lemmas
huffman
parents: 46012
diff changeset
  3584
  wi_hom_add
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3585
  word_wi_log_defs
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3586
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3587
lemma word_bw_assocs:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3588
  "(x AND y) AND z = x AND y AND z"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3589
  "(x OR y) OR z = x OR y OR z"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3590
  "(x XOR y) XOR z = x XOR y XOR z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3591
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3592
  by (fact ac_simps)+
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3593
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3594
lemma word_bw_comms:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3595
  "x AND y = y AND x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3596
  "x OR y = y OR x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3597
  "x XOR y = y XOR x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3598
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3599
  by (fact ac_simps)+
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3600
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3601
lemma word_bw_lcs:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3602
  "y AND x AND z = x AND y AND z"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3603
  "y OR x OR z = x OR y OR z"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3604
  "y XOR x XOR z = x XOR y XOR z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3605
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3606
  by (fact ac_simps)+
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3607
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3608
lemma word_log_esimps:
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3609
  "x AND 0 = 0"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3610
  "x AND -1 = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3611
  "x OR 0 = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3612
  "x OR -1 = -1"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3613
  "x XOR 0 = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3614
  "x XOR -1 = NOT x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3615
  "0 AND x = 0"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3616
  "-1 AND x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3617
  "0 OR x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3618
  "-1 OR x = -1"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3619
  "0 XOR x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3620
  "-1 XOR x = NOT x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3621
  for x :: "'a::len word"
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3622
  by simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3623
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3624
lemma word_not_dist:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3625
  "NOT (x OR y) = NOT x AND NOT y"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3626
  "NOT (x AND y) = NOT x OR NOT y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3627
  for x :: "'a::len word"
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3628
  by simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3629
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3630
lemma word_bw_same:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3631
  "x AND x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3632
  "x OR x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3633
  "x XOR x = 0"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3634
  for x :: "'a::len word"
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3635
  by simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3636
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3637
lemma word_ao_absorbs [simp]:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3638
  "x AND (y OR x) = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3639
  "x OR y AND x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3640
  "x AND (x OR y) = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3641
  "y AND x OR x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3642
  "(y OR x) AND x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3643
  "x OR x AND y = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3644
  "(x OR y) AND x = x"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3645
  "x AND y OR x = x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3646
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3647
  by (auto intro: bit_eqI simp add: bit_and_iff bit_or_iff)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3648
71149
a7d1fb0c9e16 proper prefix syntax
haftmann
parents: 70901
diff changeset
  3649
lemma word_not_not [simp]: "NOT (NOT x) = x"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3650
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3651
  by (fact bit.double_compl)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3652
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3653
lemma word_ao_dist: "(x OR y) AND z = x AND z OR y AND z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3654
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3655
  by (fact bit.conj_disj_distrib2)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3656
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3657
lemma word_oa_dist: "x AND y OR z = (x OR z) AND (y OR z)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3658
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3659
  by (fact bit.disj_conj_distrib2)
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3660
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3661
lemma word_add_not [simp]: "x + NOT x = -1"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3662
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3663
  by (simp add: not_eq_complement)
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  3664
  
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3665
lemma word_plus_and_or [simp]: "(x AND y) + (x OR y) = x + y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3666
  for x :: "'a::len word"
47372
9ab4e22dac7b configure transfer method for 'a word -> int
huffman
parents: 47168
diff changeset
  3667
  by transfer (simp add: plus_and_or)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3668
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3669
lemma leoa: "w = x OR y \<Longrightarrow> y = w AND y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3670
  for x :: "'a::len word"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3671
  by auto
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3672
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3673
lemma leao: "w' = x' AND y' \<Longrightarrow> x' = x' OR w'"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3674
  for x' :: "'a::len word"
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3675
  by auto
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3676
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3677
lemma word_ao_equiv: "w = w OR w' \<longleftrightarrow> w' = w AND w'"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3678
  for w w' :: "'a::len word"
48196
b7313810b6e6 explicit is better than implicit;
wenzelm
parents: 47941
diff changeset
  3679
  by (auto intro: leoa leao)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3680
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3681
lemma le_word_or2: "x \<le> x OR y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  3682
  for x y :: "'a::len word"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3683
  by (simp add: or_greater_eq uint_or word_le_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3684
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3685
lemmas le_word_or1 = xtrans(3) [OF word_bw_comms (2) le_word_or2]
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3686
lemmas word_and_le1 = xtrans(3) [OF word_ao_absorbs (4) [symmetric] le_word_or2]
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3687
lemmas word_and_le2 = xtrans(3) [OF word_ao_absorbs (8) [symmetric] le_word_or2]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3688
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  3689
lemma bit_horner_sum_bit_word_iff [bit_simps]:
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3690
  \<open>bit (horner_sum of_bool (2 :: 'a::len word) bs) n
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3691
    \<longleftrightarrow> n < min LENGTH('a) (length bs) \<and> bs ! n\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3692
  by transfer (simp add: bit_horner_sum_bit_iff)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3693
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3694
definition word_reverse :: \<open>'a::len word \<Rightarrow> 'a word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3695
  where \<open>word_reverse w = horner_sum of_bool 2 (rev (map (bit w) [0..<LENGTH('a)]))\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3696
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  3697
lemma bit_word_reverse_iff [bit_simps]:
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  3698
  \<open>bit (word_reverse w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w (LENGTH('a) - Suc n)\<close>
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  3699
  for w :: \<open>'a::len word\<close>
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3700
  by (cases \<open>n < LENGTH('a)\<close>)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3701
    (simp_all add: word_reverse_def bit_horner_sum_bit_word_iff rev_nth)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3702
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3703
lemma word_rev_rev [simp] : "word_reverse (word_reverse w) = w"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3704
  by (rule bit_word_eqI)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3705
    (auto simp add: bit_word_reverse_iff bit_imp_le_length Suc_diff_Suc)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3706
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3707
lemma word_rev_gal: "word_reverse w = u \<Longrightarrow> word_reverse u = w"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3708
  by (metis word_rev_rev)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3709
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3710
lemma word_rev_gal': "u = word_reverse w \<Longrightarrow> w = word_reverse u"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3711
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3712
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3713
lemma uint_2p: "(0::'a::len word) < 2 ^ n \<Longrightarrow> uint (2 ^ n::'a::len word) = 2 ^ n"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3714
  by (cases \<open>n < LENGTH('a)\<close>; transfer; force)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3715
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  3716
lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a::len word) = 2 ^ n"
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64243
diff changeset
  3717
  by (induct n) (simp_all add: wi_hom_syms)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3718
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3719
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3720
subsubsection \<open>shift functions in terms of lists of bools\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3721
71997
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3722
lemma drop_bit_word_numeral [simp]:
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3723
  \<open>drop_bit (numeral n) (numeral k) =
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3724
    (word_of_int (drop_bit (numeral n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3725
  by transfer simp
4a013c92a091 factored out auxiliary theory
haftmann
parents: 71996
diff changeset
  3726
74498
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3727
lemma drop_bit_word_Suc_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3728
  \<open>drop_bit (Suc n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3729
    (word_of_int (drop_bit (Suc n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3730
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3731
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3732
lemma drop_bit_word_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3733
  \<open>drop_bit (numeral n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3734
    (word_of_int (drop_bit (numeral n) (take_bit LENGTH('a) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3735
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3736
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3737
lemma drop_bit_word_Suc_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3738
  \<open>drop_bit (Suc n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3739
    (word_of_int (drop_bit (Suc n) (take_bit LENGTH('a) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3740
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3741
73853
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  3742
lemma signed_drop_bit_word_numeral [simp]:
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  3743
  \<open>signed_drop_bit (numeral n) (numeral k) =
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  3744
    (word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (numeral k))) :: 'a::len word)\<close>
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  3745
  by transfer simp
52b829b18066 more lemmas
haftmann
parents: 73816
diff changeset
  3746
74498
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3747
lemma signed_drop_bit_word_Suc_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3748
  \<open>signed_drop_bit (Suc n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3749
    (word_of_int (drop_bit (Suc n) (signed_take_bit (LENGTH('a) - 1) (numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3750
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3751
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3752
lemma signed_drop_bit_word_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3753
  \<open>signed_drop_bit (numeral n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3754
    (word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3755
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3756
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3757
lemma signed_drop_bit_word_Suc_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3758
  \<open>signed_drop_bit (Suc n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3759
    (word_of_int (drop_bit (Suc n) (signed_take_bit (LENGTH('a) - 1) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3760
  by transfer simp
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3761
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3762
lemma take_bit_word_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3763
  \<open>take_bit (numeral n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3764
    (word_of_int (take_bit (min LENGTH('a) (numeral n)) (numeral k)) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3765
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3766
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3767
lemma take_bit_word_Suc_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3768
  \<open>take_bit (Suc n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3769
    (word_of_int (take_bit (min LENGTH('a) (Suc n)) (numeral k)) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3770
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3771
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3772
lemma take_bit_word_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3773
  \<open>take_bit (numeral n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3774
    (word_of_int (take_bit (min LENGTH('a) (numeral n)) (- numeral k)) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3775
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3776
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3777
lemma take_bit_word_Suc_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3778
  \<open>take_bit (Suc n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3779
    (word_of_int (take_bit (min LENGTH('a) (Suc n)) (- numeral k)) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3780
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3781
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3782
lemma signed_take_bit_word_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3783
  \<open>signed_take_bit (numeral n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3784
    (word_of_int (signed_take_bit (numeral n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3785
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3786
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3787
lemma signed_take_bit_word_Suc_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3788
  \<open>signed_take_bit (Suc n) (numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3789
    (word_of_int (signed_take_bit (Suc n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3790
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3791
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3792
lemma signed_take_bit_word_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3793
  \<open>signed_take_bit (numeral n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3794
    (word_of_int (signed_take_bit (numeral n) (take_bit LENGTH('a) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3795
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3796
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3797
lemma signed_take_bit_word_Suc_minus_numeral [simp]:
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3798
  \<open>signed_take_bit (Suc n) (- numeral k) =
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3799
    (word_of_int (signed_take_bit (Suc n) (take_bit LENGTH('a) (- numeral k))) :: 'a::len word)\<close>
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3800
  by transfer rule
27475e64a887 more complete simp rules
haftmann
parents: 74496
diff changeset
  3801
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3802
lemma False_map2_or: "\<lbrakk>set xs \<subseteq> {False}; length ys = length xs\<rbrakk> \<Longrightarrow> map2 (\<or>) xs ys = ys"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3803
  by (induction xs arbitrary: ys) (auto simp: length_Suc_conv)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3804
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3805
lemma align_lem_or:
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3806
  assumes "length xs = n + m" "length ys = n + m" 
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3807
    and "drop m xs = replicate n False" "take m ys = replicate m False"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3808
  shows "map2 (\<or>) xs ys = take m xs @ drop m ys"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3809
  using assms
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3810
proof (induction xs arbitrary: ys m)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3811
  case (Cons a xs)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3812
  then show ?case
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3813
    by (cases m) (auto simp: length_Suc_conv False_map2_or)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3814
qed auto
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3815
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3816
lemma False_map2_and: "\<lbrakk>set xs \<subseteq> {False}; length ys = length xs\<rbrakk> \<Longrightarrow> map2 (\<and>) xs ys = xs"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3817
  by (induction xs arbitrary: ys) (auto simp: length_Suc_conv)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3818
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3819
lemma align_lem_and:
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3820
  assumes "length xs = n + m" "length ys = n + m" 
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3821
    and "drop m xs = replicate n False" "take m ys = replicate m False"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3822
  shows "map2 (\<and>) xs ys = replicate (n + m) False"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3823
  using assms
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3824
proof (induction xs arbitrary: ys m)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3825
  case (Cons a xs)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3826
  then show ?case
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3827
    by (cases m) (auto simp: length_Suc_conv set_replicate_conv_if False_map2_and)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3828
qed auto
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3829
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  3830
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3831
subsubsection \<open>Mask\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3832
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  3833
lemma minus_1_eq_mask:
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3834
  \<open>- 1 = (mask LENGTH('a) :: 'a::len word)\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  3835
  by (rule bit_eqI) (simp add: bit_exp_iff bit_mask_iff)
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  3836
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  3837
lemma mask_eq_decr_exp:
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3838
  \<open>mask n = 2 ^ n - (1 :: 'a::len word)\<close>
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3839
  by (fact mask_eq_exp_minus_1)
71953
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3840
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3841
lemma mask_Suc_rec:
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3842
  \<open>mask (Suc n) = 2 * mask n + (1 :: 'a::len word)\<close>
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3843
  by (simp add: mask_eq_exp_minus_1)
71953
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3844
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3845
context
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3846
begin
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3847
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  3848
qualified lemma bit_mask_iff [bit_simps]:
71990
66beb9d92e43 explicit proofs for bit projections
haftmann
parents: 71986
diff changeset
  3849
  \<open>bit (mask m :: 'a::len word) n \<longleftrightarrow> n < min LENGTH('a) m\<close>
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  3850
  by (simp add: bit_mask_iff not_le)
71953
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3851
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3852
end
428609096812 more lemmas and less name space pollution
haftmann
parents: 71952
diff changeset
  3853
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3854
lemma mask_bin: "mask n = word_of_int (take_bit n (- 1))"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3855
  by transfer simp 
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3856
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3857
lemma and_mask_bintr: "w AND mask n = word_of_int (take_bit n (uint w))"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3858
  by transfer (simp add: ac_simps take_bit_eq_mask)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3859
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3860
lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (take_bit n i)"
74496
807b094a9b78 avoid overaggressive contraction of conversions
haftmann
parents: 74391
diff changeset
  3861
  by (simp add: take_bit_eq_mask of_int_and_eq of_int_mask_eq)
46023
fad87bb608fc restate some lemmas to respect int/bin distinction
huffman
parents: 46022
diff changeset
  3862
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3863
lemma and_mask_wi':
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3864
  "word_of_int i AND mask n = (word_of_int (take_bit (min LENGTH('a) n) i) :: 'a::len word)"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  3865
  by (auto simp add: and_mask_wi min_def wi_bintr)
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64243
diff changeset
  3866
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3867
lemma and_mask_no: "numeral i AND mask n = word_of_int (take_bit n (numeral i))"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  3868
  unfolding word_numeral_alt by (rule and_mask_wi)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3869
45811
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  3870
lemma and_mask_mod_2p: "w AND mask n = word_of_int (uint w mod 2 ^ n)"
72128
3707cf7b370b reduced prominence od theory Bits_Int
haftmann
parents: 72102
diff changeset
  3871
  by (simp only: and_mask_bintr take_bit_eq_mod)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3872
72130
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  3873
lemma uint_mask_eq:
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  3874
  \<open>uint (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close>
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  3875
  by transfer simp
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  3876
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3877
lemma and_mask_lt_2p: "uint (w AND mask n) < 2 ^ n"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3878
  by (metis take_bit_eq_mask take_bit_int_less_exp unsigned_take_bit_eq)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3879
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  3880
lemma mask_eq_iff: "w AND mask n = w \<longleftrightarrow> uint w < 2 ^ n"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3881
  apply (auto simp flip: take_bit_eq_mask)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3882
   apply (metis take_bit_int_eq_self_iff uint_take_bit_eq)
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  3883
  apply (simp add: take_bit_int_eq_self unsigned_take_bit_eq word_uint_eqI)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3884
  done
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3885
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3886
lemma and_mask_dvd: "2 ^ n dvd uint w \<longleftrightarrow> w AND mask n = 0"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3887
  by (simp flip: take_bit_eq_mask take_bit_eq_mod unsigned_take_bit_eq add: dvd_eq_mod_eq_0 uint_0_iff)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3888
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3889
lemma and_mask_dvd_nat: "2 ^ n dvd unat w \<longleftrightarrow> w AND mask n = 0"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3890
  by (simp flip: take_bit_eq_mask take_bit_eq_mod unsigned_take_bit_eq add: dvd_eq_mod_eq_0 unat_0_iff uint_0_iff)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3891
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3892
lemma word_2p_lem: "n < size w \<Longrightarrow> w < 2 ^ n = (uint w < 2 ^ n)"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3893
  for w :: "'a::len word"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  3894
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3895
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3896
lemma less_mask_eq:
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3897
  fixes x :: "'a::len word"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3898
  assumes "x < 2 ^ n" shows "x AND mask n = x"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3899
  by (metis (no_types) assms lt2p_lem mask_eq_iff not_less word_2p_lem word_size)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3900
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3901
lemmas mask_eq_iff_w2p = trans [OF mask_eq_iff word_2p_lem [symmetric]]
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3902
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  3903
lemmas and_mask_less' = iffD2 [OF word_2p_lem and_mask_lt_2p, simplified word_size]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3904
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3905
lemma and_mask_less_size: "n < size x \<Longrightarrow> x AND mask n < 2 ^ n"
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3906
  for x :: \<open>'a::len word\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3907
  unfolding word_size by (erule and_mask_less')
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3908
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3909
lemma word_mod_2p_is_mask [OF refl]: "c = 2 ^ n \<Longrightarrow> c > 0 \<Longrightarrow> x mod c = x AND mask n"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3910
  for c x :: "'a::len word"
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3911
  by (auto simp: word_mod_def uint_2p and_mask_mod_2p)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3912
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3913
lemma mask_eqs:
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3914
  "(a AND mask n) + b AND mask n = a + b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3915
  "a + (b AND mask n) AND mask n = a + b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3916
  "(a AND mask n) - b AND mask n = a - b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3917
  "a - (b AND mask n) AND mask n = a - b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3918
  "a * (b AND mask n) AND mask n = a * b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3919
  "(b AND mask n) * a AND mask n = b * a AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3920
  "(a AND mask n) + (b AND mask n) AND mask n = a + b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3921
  "(a AND mask n) - (b AND mask n) AND mask n = a - b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3922
  "(a AND mask n) * (b AND mask n) AND mask n = a * b AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3923
  "- (a AND mask n) AND mask n = - a AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3924
  "word_succ (a AND mask n) AND mask n = word_succ a AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3925
  "word_pred (a AND mask n) AND mask n = word_pred a AND mask n"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3926
  using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b]
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3927
  unfolding take_bit_eq_mask [symmetric]
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3928
  by (transfer; simp add: take_bit_eq_mod mod_simps)+
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3929
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  3930
lemma mask_power_eq: "(x AND mask n) ^ k AND mask n = x ^ k AND mask n"
72082
41393ecb57ac uniform mask operation
haftmann
parents: 72079
diff changeset
  3931
  for x :: \<open>'a::len word\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3932
  using word_of_int_Ex [where x=x]
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3933
  unfolding take_bit_eq_mask [symmetric]
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3934
  by (transfer; simp add: take_bit_eq_mod mod_simps)+
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3935
70183
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3936
lemma mask_full [simp]: "mask LENGTH('a) = (- 1 :: 'a::len word)"
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  3937
  by transfer simp
70183
3ea80c950023 incorporated various material from the AFP into the distribution
haftmann
parents: 70175
diff changeset
  3938
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3939
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3940
subsubsection \<open>Slices\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3941
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3942
definition slice1 :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3943
  where \<open>slice1 n w = (if n < LENGTH('a)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3944
    then ucast (drop_bit (LENGTH('a) - n) w)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3945
    else push_bit (n - LENGTH('a)) (ucast w))\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3946
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  3947
lemma bit_slice1_iff [bit_simps]:
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3948
  \<open>bit (slice1 m w :: 'b::len word) n \<longleftrightarrow> m - LENGTH('a) \<le> n \<and> n < min LENGTH('b) m
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3949
    \<and> bit w (n + (LENGTH('a) - m) - (m - LENGTH('a)))\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3950
  for w :: \<open>'a::len word\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3951
  by (auto simp add: slice1_def bit_ucast_iff bit_drop_bit_eq bit_push_bit_iff not_less not_le ac_simps
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3952
    dest: bit_imp_le_length)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3953
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3954
definition slice :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3955
  where \<open>slice n = slice1 (LENGTH('a) - n)\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3956
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  3957
lemma bit_slice_iff [bit_simps]:
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3958
  \<open>bit (slice m w :: 'b::len word) n \<longleftrightarrow> n < min LENGTH('b) (LENGTH('a) - m) \<and> bit w (n + LENGTH('a) - (LENGTH('a) - m))\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3959
  for w :: \<open>'a::len word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3960
  by (simp add: slice_def word_size bit_slice1_iff)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3961
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3962
lemma slice1_0 [simp] : "slice1 n 0 = 0"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3963
  unfolding slice1_def by simp
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3964
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3965
lemma slice_0 [simp] : "slice n 0 = 0"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3966
  unfolding slice_def by auto
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3967
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3968
lemma ucast_slice1: "ucast w = slice1 (size w) w"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3969
  unfolding slice1_def by (simp add: size_word.rep_eq)
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3970
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3971
lemma ucast_slice: "ucast w = slice 0 w"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3972
  by (simp add: slice_def slice1_def)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3973
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3974
lemma slice_id: "slice 0 t = t"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3975
  by (simp only: ucast_slice [symmetric] ucast_id)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3976
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3977
lemma rev_slice1:
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3978
  \<open>slice1 n (word_reverse w :: 'b::len word) = word_reverse (slice1 k w :: 'a::len word)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3979
  if \<open>n + k = LENGTH('a) + LENGTH('b)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3980
proof (rule bit_word_eqI)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3981
  fix m
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3982
  assume *: \<open>m < LENGTH('a)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3983
  from that have **: \<open>LENGTH('b) = n + k - LENGTH('a)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3984
    by simp
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3985
  show \<open>bit (slice1 n (word_reverse w :: 'b word) :: 'a word) m \<longleftrightarrow> bit (word_reverse (slice1 k w :: 'a word)) m\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3986
    unfolding bit_slice1_iff bit_word_reverse_iff
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3987
    using * **
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3988
    by (cases \<open>n \<le> LENGTH('a)\<close>; cases \<open>k \<le> LENGTH('a)\<close>) auto
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  3989
qed
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3990
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3991
lemma rev_slice:
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3992
  "n + k + LENGTH('a::len) = LENGTH('b::len) \<Longrightarrow>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3993
    slice n (word_reverse (w::'b word)) = word_reverse (slice k w :: 'a word)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3994
  unfolding slice_def word_size
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  3995
  by (simp add: rev_slice1)
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3996
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  3997
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  3998
subsubsection \<open>Revcast\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  3999
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4000
definition revcast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4001
  where \<open>revcast = slice1 LENGTH('b)\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4002
72611
c7bc3e70a8c7 official collection for bit projection simplifications
haftmann
parents: 72515
diff changeset
  4003
lemma bit_revcast_iff [bit_simps]:
72027
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4004
  \<open>bit (revcast w :: 'b::len word) n \<longleftrightarrow> LENGTH('b) - LENGTH('a) \<le> n \<and> n < LENGTH('b)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4005
    \<and> bit w (n + (LENGTH('a) - LENGTH('b)) - (LENGTH('b) - LENGTH('a)))\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4006
  for w :: \<open>'a::len word\<close>
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4007
  by (simp add: revcast_def bit_slice1_iff)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4008
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4009
lemma revcast_slice1 [OF refl]: "rc = revcast w \<Longrightarrow> slice1 (size rc) w = rc"
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4010
  by (simp add: revcast_def word_size)
759532ef0885 prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents: 72010
diff changeset
  4011
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4012
lemma revcast_rev_ucast [OF refl refl refl]:
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4013
  "cs = [rc, uc] \<Longrightarrow> rc = revcast (word_reverse w) \<Longrightarrow> uc = ucast w \<Longrightarrow>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4014
    rc = word_reverse uc"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4015
  by (metis rev_slice1 revcast_slice1 ucast_slice1 word_size)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4016
45811
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4017
lemma revcast_ucast: "revcast w = word_reverse (ucast (word_reverse w))"
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4018
  using revcast_rev_ucast [of "word_reverse w"] by simp
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4019
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4020
lemma ucast_revcast: "ucast w = word_reverse (revcast (word_reverse w))"
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4021
  by (fact revcast_rev_ucast [THEN word_rev_gal'])
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4022
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4023
lemma ucast_rev_revcast: "ucast (word_reverse w) = word_reverse (revcast w)"
f506015ca2dc replace many uses of 'lemmas' with 'lemma';
huffman
parents: 45810
diff changeset
  4024
  by (fact revcast_ucast [THEN word_rev_gal'])
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4025
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4026
65328
2510b0ce28da misc tuning and modernization;
wenzelm
parents: 65268
diff changeset
  4027
text "linking revcast and cast via shift"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4028
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4029
lemmas wsst_TYs = source_size target_size word_size
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4030
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4031
lemmas sym_notr =
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4032
  not_iff [THEN iffD2, THEN not_sym, THEN not_iff [THEN iffD1]]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4033
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4034
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4035
subsection \<open>Split and cat\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4036
40827
abbc05c20e24 code preprocessor setup for numerals on word type;
haftmann
parents: 39910
diff changeset
  4037
lemmas word_split_bin' = word_split_def
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4038
lemmas word_cat_bin' = word_cat_eq
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4039
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4040
\<comment> \<open>this odd result is analogous to \<open>ucast_id\<close>,
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4041
      result to the length given by the result type\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4042
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4043
lemma word_cat_id: "word_cat a b = b"
72488
ee659bca8955 factored out theory Bits_Int
haftmann
parents: 72487
diff changeset
  4044
  by transfer (simp add: take_bit_concat_bit_eq)
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4045
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4046
lemma word_cat_split_alt: "\<lbrakk>size w \<le> size u + size v; word_split w = (u,v)\<rbrakk> \<Longrightarrow> word_cat u v = w"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4047
  unfolding word_split_def
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4048
  by (rule bit_word_eqI) (auto simp add: bit_word_cat_iff not_less word_size bit_ucast_iff bit_drop_bit_eq)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4049
45604
29cf40fe8daf eliminated obsolete "standard";
wenzelm
parents: 45550
diff changeset
  4050
lemmas word_cat_split_size = sym [THEN [2] word_cat_split_alt [symmetric]]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4051
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4052
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4053
subsubsection \<open>Split and slice\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4054
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4055
lemma split_slices:
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4056
  assumes "word_split w = (u, v)"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4057
  shows "u = slice (size v) w \<and> v = slice 0 w"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4058
  unfolding word_size
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4059
proof (intro conjI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4060
  have \<section>: "\<And>n. \<lbrakk>ucast (drop_bit LENGTH('b) w) = u; LENGTH('c) < LENGTH('b)\<rbrakk> \<Longrightarrow> \<not> bit u n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4061
    by (metis bit_take_bit_iff bit_word_of_int_iff diff_is_0_eq' drop_bit_take_bit less_imp_le less_nat_zero_code of_int_uint unsigned_drop_bit_eq)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4062
  show "u = slice LENGTH('b) w"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4063
  proof (rule bit_word_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4064
    show "bit u n = bit ((slice LENGTH('b) w)::'a word) n" if "n < LENGTH('a)" for n
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4065
      using assms bit_imp_le_length
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4066
      unfolding word_split_def bit_slice_iff
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4067
      by (fastforce simp add: \<section> ac_simps word_size bit_ucast_iff bit_drop_bit_eq)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4068
  qed
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4069
  show "v = slice 0 w"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4070
    by (metis Pair_inject assms ucast_slice word_split_bin')
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4071
qed
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4072
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4073
45816
6a04efd99f25 replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents: 45811
diff changeset
  4074
lemma slice_cat1 [OF refl]:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4075
  "\<lbrakk>wc = word_cat a b; size a + size b \<le> size wc\<rbrakk> \<Longrightarrow> slice (size b) wc = a"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4076
  by (rule bit_word_eqI) (auto simp add: bit_slice_iff bit_word_cat_iff word_size)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4077
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4078
lemmas slice_cat2 = trans [OF slice_id word_cat_id]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4079
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4080
lemma cat_slices:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4081
  "\<lbrakk>a = slice n c; b = slice 0 c; n = size b; size c \<le> size a + size b\<rbrakk> \<Longrightarrow> word_cat a b = c"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4082
  by (rule bit_word_eqI) (auto simp add: bit_slice_iff bit_word_cat_iff word_size)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4083
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4084
lemma word_split_cat_alt:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4085
  assumes "w = word_cat u v" and size: "size u + size v \<le> size w"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4086
  shows "word_split w = (u,v)"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4087
proof -
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4088
  have "ucast ((drop_bit LENGTH('c) (word_cat u v))::'a word) = u" "ucast ((word_cat u v)::'a word) = v"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4089
    using assms
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4090
    by (auto simp add: word_size bit_ucast_iff bit_drop_bit_eq bit_word_cat_iff intro: bit_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4091
  then show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4092
    by (simp add: assms(1) word_split_bin')
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4093
qed
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4094
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4095
lemma horner_sum_uint_exp_Cons_eq:
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4096
  \<open>horner_sum uint (2 ^ LENGTH('a)) (w # ws) =
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4097
    concat_bit LENGTH('a) (uint w) (horner_sum uint (2 ^ LENGTH('a)) ws)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4098
  for ws :: \<open>'a::len word list\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4099
  by (simp add: bintr_uint concat_bit_eq push_bit_eq_mult)
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4100
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4101
lemma bit_horner_sum_uint_exp_iff:
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4102
  \<open>bit (horner_sum uint (2 ^ LENGTH('a)) ws) n \<longleftrightarrow>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4103
    n div LENGTH('a) < length ws \<and> bit (ws ! (n div LENGTH('a))) (n mod LENGTH('a))\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4104
  for ws :: \<open>'a::len word list\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4105
proof (induction ws arbitrary: n)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4106
  case Nil
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4107
  then show ?case
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4108
    by simp
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4109
next
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4110
  case (Cons w ws)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4111
  then show ?case
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4112
    by (cases \<open>n \<ge> LENGTH('a)\<close>)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4113
      (simp_all only: horner_sum_uint_exp_Cons_eq, simp_all add: bit_concat_bit_iff le_div_geq le_mod_geq bit_uint_iff Cons)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4114
qed
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4115
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4116
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4117
subsection \<open>Rotation\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4118
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4119
lemma word_rotr_word_rotr_eq: \<open>word_rotr m (word_rotr n w) = word_rotr (m + n) w\<close>
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4120
  by (rule bit_word_eqI) (simp add: bit_word_rotr_iff ac_simps mod_add_right_eq)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4121
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4122
lemma word_rot_lem: "\<lbrakk>l + k = d + k mod l; n < l\<rbrakk> \<Longrightarrow> ((d + n) mod l) = n" for l::nat
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4123
  by (metis (no_types, lifting) add.commute add.right_neutral add_diff_cancel_left' mod_if mod_mult_div_eq mod_mult_self2 mod_self)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4124
 
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4125
lemma word_rot_rl [simp]: \<open>word_rotl k (word_rotr k v) = v\<close>
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4126
proof (rule bit_word_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4127
  show "bit (word_rotl k (word_rotr k v)) n = bit v n" if "n < LENGTH('a)" for n
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4128
    using that
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4129
    by (auto simp: word_rot_lem word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps split: nat_diff_split)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4130
qed
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4131
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4132
lemma word_rot_lr [simp]: \<open>word_rotr k (word_rotl k v) = v\<close>
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4133
proof (rule bit_word_eqI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4134
  show "bit (word_rotr k (word_rotl k v)) n = bit v n" if "n < LENGTH('a)" for n
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4135
    using that
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4136
    by (auto simp add: word_rot_lem word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps split: nat_diff_split)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4137
qed
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4138
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4139
lemma word_rot_gal:
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4140
  \<open>word_rotr n v = w \<longleftrightarrow> word_rotl n w = v\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4141
  by auto
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4142
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4143
lemma word_rot_gal':
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4144
  \<open>w = word_rotr n v \<longleftrightarrow> v = word_rotl n w\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4145
  by auto
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4146
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4147
lemma word_rotr_rev:
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4148
  \<open>word_rotr n w = word_reverse (word_rotl n (word_reverse w))\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4149
proof (rule bit_word_eqI)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4150
  fix m
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4151
  assume \<open>m < LENGTH('a)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4152
  moreover have \<open>1 +
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4153
    ((int m + int n mod int LENGTH('a)) mod int LENGTH('a) +
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4154
     ((int LENGTH('a) * 2) mod int LENGTH('a) - (1 + (int m + int n mod int LENGTH('a)))) mod int LENGTH('a)) =
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4155
    int LENGTH('a)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4156
    apply (cases \<open>(1 + (int m + int n mod int LENGTH('a))) mod
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4157
         int LENGTH('a) = 0\<close>)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4158
    using zmod_zminus1_eq_if [of \<open>1 + (int m + int n mod int LENGTH('a))\<close> \<open>int LENGTH('a)\<close>]
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4159
    apply simp_all
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4160
     apply (auto simp add: algebra_simps)
73932
fd21b4a93043 added opaque_combs and renamed hide_lams to opaque_lifting
desharna
parents: 73853
diff changeset
  4161
    apply (metis (mono_tags, opaque_lifting) Abs_fnat_hom_add mod_Suc mod_mult_self2_is_0 of_nat_Suc of_nat_mod semiring_char_0_class.of_nat_neq_0)
fd21b4a93043 added opaque_combs and renamed hide_lams to opaque_lifting
desharna
parents: 73853
diff changeset
  4162
    apply (metis (no_types, opaque_lifting) Abs_fnat_hom_add less_not_refl mod_Suc of_nat_Suc of_nat_gt_0 of_nat_mod)
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4163
    done
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4164
  then have \<open>int ((m + n) mod LENGTH('a)) =
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4165
    int (LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a)))\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4166
    using \<open>m < LENGTH('a)\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4167
    by (simp only: of_nat_mod mod_simps)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4168
      (simp add: of_nat_diff of_nat_mod Suc_le_eq add_less_mono algebra_simps mod_simps)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4169
  then have \<open>(m + n) mod LENGTH('a) =
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4170
    LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a))\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4171
    by simp
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4172
  ultimately show \<open>bit (word_rotr n w) m \<longleftrightarrow> bit (word_reverse (word_rotl n (word_reverse w))) m\<close>
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4173
    by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff bit_word_reverse_iff)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4174
qed
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4175
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4176
lemma word_roti_0 [simp]: "word_roti 0 w = w"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  4177
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4178
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4179
lemma word_roti_add: "word_roti (m + n) w = word_roti m (word_roti n w)"
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4180
  by (rule bit_word_eqI)
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4181
    (simp add: bit_word_roti_iff nat_less_iff mod_simps ac_simps)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4182
67118
ccab07d1196c more simplification rules
haftmann
parents: 66912
diff changeset
  4183
lemma word_roti_conv_mod':
ccab07d1196c more simplification rules
haftmann
parents: 66912
diff changeset
  4184
  "word_roti n w = word_roti (n mod int (size w)) w"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  4185
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4186
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4187
lemmas word_roti_conv_mod = word_roti_conv_mod' [unfolded word_size]
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4188
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4189
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4190
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4191
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4192
subsubsection \<open>"Word rotation commutes with bit-wise operations\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4193
67408
4a4c14b24800 prefer formal comments;
wenzelm
parents: 67399
diff changeset
  4194
\<comment> \<open>using locale to not pollute lemma namespace\<close>
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4195
locale word_rotate
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4196
begin
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4197
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4198
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4199
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4200
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4201
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4202
lemma word_rot_logs:
71149
a7d1fb0c9e16 proper prefix syntax
haftmann
parents: 70901
diff changeset
  4203
  "word_rotl n (NOT v) = NOT (word_rotl n v)"
a7d1fb0c9e16 proper prefix syntax
haftmann
parents: 70901
diff changeset
  4204
  "word_rotr n (NOT v) = NOT (word_rotr n v)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4205
  "word_rotl n (x AND y) = word_rotl n x AND word_rotl n y"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4206
  "word_rotr n (x AND y) = word_rotr n x AND word_rotr n y"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4207
  "word_rotl n (x OR y) = word_rotl n x OR word_rotl n y"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4208
  "word_rotr n (x OR y) = word_rotr n x OR word_rotr n y"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4209
  "word_rotl n (x XOR y) = word_rotl n x XOR word_rotl n y"
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4210
  "word_rotr n (x XOR y) = word_rotr n x XOR word_rotr n y"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4211
  by (rule bit_word_eqI, auto simp add: bit_word_rotl_iff bit_word_rotr_iff bit_and_iff bit_or_iff bit_xor_iff bit_not_iff algebra_simps not_le)+
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4212
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4213
end
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4214
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4215
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4216
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4217
lemmas word_rot_logs = word_rotate.word_rot_logs
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4218
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4219
lemma word_rotx_0 [simp] : "word_rotr i 0 = 0 \<and> word_rotl i 0 = 0"
72088
a36db1c8238e separation of reversed bit lists from other material
haftmann
parents: 72083
diff changeset
  4220
  by transfer simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4221
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4222
lemma word_roti_0' [simp] : "word_roti n 0 = 0"
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  4223
  by transfer simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4224
72079
8c355e2dd7db more consequent transferability
haftmann
parents: 72043
diff changeset
  4225
declare word_roti_eq_word_rotr_word_rotl [simp]
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4226
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4227
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4228
subsection \<open>Maximum machine word\<close>
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4229
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4230
context
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4231
  includes bit_operations_syntax
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4232
begin
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4233
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4234
lemma word_int_cases:
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4235
  fixes x :: "'a::len word"
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  4236
  obtains n where "x = word_of_int n" and "0 \<le> n" and "n < 2^LENGTH('a)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4237
  by (rule that [of \<open>uint x\<close>]) simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4238
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4239
lemma word_nat_cases [cases type: word]:
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4240
  fixes x :: "'a::len word"
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  4241
  obtains n where "x = of_nat n" and "n < 2^LENGTH('a)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4242
  by (rule that [of \<open>unat x\<close>]) simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4243
73788
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4244
lemma max_word_max [intro!]:
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4245
  \<open>n \<le> - 1\<close> for n :: \<open>'a::len word\<close>
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  4246
  by (fact word_order.extremum)
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4247
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4248
lemma word_of_int_2p_len: "word_of_int (2 ^ LENGTH('a)) = (0::'a::len word)"
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4249
  by simp
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4250
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  4251
lemma word_pow_0: "(2::'a::len word) ^ LENGTH('a) = 0"
71957
3e162c63371a build bit operations on word on library theory on bit operations
haftmann
parents: 71955
diff changeset
  4252
  by (fact word_exp_length_eq_0)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4253
73788
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4254
lemma max_word_wrap: 
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4255
  \<open>x + 1 = 0 \<Longrightarrow> x = - 1\<close> for x :: \<open>'a::len word\<close>
71946
4d4079159be7 replaced mere alias by abbreviation
haftmann
parents: 71945
diff changeset
  4256
  by (simp add: eq_neg_iff_add_eq_0)
4d4079159be7 replaced mere alias by abbreviation
haftmann
parents: 71945
diff changeset
  4257
73788
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4258
lemma word_and_max:
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4259
  \<open>x AND - 1 = x\<close> for x :: \<open>'a::len word\<close>
71946
4d4079159be7 replaced mere alias by abbreviation
haftmann
parents: 71945
diff changeset
  4260
  by (fact word_log_esimps)
4d4079159be7 replaced mere alias by abbreviation
haftmann
parents: 71945
diff changeset
  4261
73788
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4262
lemma word_or_max:
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4263
  \<open>x OR - 1 = - 1\<close> for x :: \<open>'a::len word\<close>
71946
4d4079159be7 replaced mere alias by abbreviation
haftmann
parents: 71945
diff changeset
  4264
  by (fact word_log_esimps)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4265
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4266
lemma word_ao_dist2: "x AND (y OR z) = x AND y OR x AND z"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4267
  for x y z :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  4268
  by (fact bit.conj_disj_distrib)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4269
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4270
lemma word_oa_dist2: "x OR y AND z = (x OR y) AND (x OR z)"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4271
  for x y z :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  4272
  by (fact bit.disj_conj_distrib)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4273
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4274
lemma word_and_not [simp]: "x AND NOT x = 0"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4275
  for x :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  4276
  by (fact bit.conj_cancel_right)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4277
73788
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4278
lemma word_or_not [simp]:
35217bf33215 max word moved to Word_Lib in AFP
haftmann
parents: 73682
diff changeset
  4279
  \<open>x OR NOT x = - 1\<close> for x :: \<open>'a::len word\<close>
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  4280
  by (fact bit.disj_cancel_right)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4281
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4282
lemma word_xor_and_or: "x XOR y = x AND NOT y OR NOT x AND y"
71954
13bb3f5cdc5b pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents: 71953
diff changeset
  4283
  for x y :: "'a::len word"
72508
c89d8e8bd8c7 factored out theory Traditional_Syntax
haftmann
parents: 72489
diff changeset
  4284
  by (fact bit.xor_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4285
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4286
lemma uint_lt_0 [simp]: "uint x < 0 = False"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4287
  by (simp add: linorder_not_less)
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4288
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4289
lemma word_less_1 [simp]: "x < 1 \<longleftrightarrow> x = 0"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4290
  for x :: "'a::len word"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4291
  by (simp add: word_less_nat_alt unat_0_iff)
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4292
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4293
lemma uint_plus_if_size:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4294
  "uint (x + y) =
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4295
    (if uint x + uint y < 2^size x
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4296
     then uint x + uint y
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4297
     else uint x + uint y - 2^size x)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4298
  by (simp add: take_bit_eq_mod word_size uint_word_of_int_eq uint_plus_if')
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4299
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4300
lemma unat_plus_if_size:
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  4301
  "unat (x + y) =
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4302
    (if unat x + unat y < 2^size x
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4303
     then unat x + unat y
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4304
     else unat x + unat y - 2^size x)"
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  4305
  for x y :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4306
  by (simp add: size_word.rep_eq unat_arith_simps)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4307
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4308
lemma word_neq_0_conv: "w \<noteq> 0 \<longleftrightarrow> 0 < w"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4309
  for w :: "'a::len word"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4310
  by (fact word_coorder.not_eq_extremum)
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4311
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4312
lemma max_lt: "unat (max a b div c) = unat (max a b) div unat c"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4313
  for c :: "'a::len word"
55818
d8b2f50705d0 more precise imports;
haftmann
parents: 55817
diff changeset
  4314
  by (fact unat_div)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4315
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4316
lemma uint_sub_if_size:
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4317
  "uint (x - y) =
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4318
    (if uint y \<le> uint x
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4319
     then uint x - uint y
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4320
     else uint x - uint y + 2^size x)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4321
  by (simp add: size_word.rep_eq uint_sub_if')
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4322
72130
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  4323
lemma unat_sub:
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  4324
  \<open>unat (a - b) = unat a - unat b\<close>
9e5862223442 dedicated symbols for code generation, to pave way for generic conversions from and to word
haftmann
parents: 72128
diff changeset
  4325
  if \<open>b \<le> a\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4326
  by (meson that unat_sub_if_size word_le_nat_alt)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4327
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  4328
lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "numeral w"] for w
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  4329
lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "numeral w"] for w
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4330
70185
ac1706cdde25 clarified notation
haftmann
parents: 70183
diff changeset
  4331
lemma word_of_int_minus: "word_of_int (2^LENGTH('a) - i) = (word_of_int (-i)::'a::len word)"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4332
  by simp
72292
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4333
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4334
lemma word_of_int_inj:
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4335
  \<open>(word_of_int x :: 'a::len word) = word_of_int y \<longleftrightarrow> x = y\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4336
  if \<open>0 \<le> x \<and> x < 2 ^ LENGTH('a)\<close> \<open>0 \<le> y \<and> y < 2 ^ LENGTH('a)\<close>
4a58c38b85ff factored out typedef material
haftmann
parents: 72281
diff changeset
  4337
  using that by (transfer fixing: x y) (simp add: take_bit_int_eq_self) 
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4338
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4339
lemma word_le_less_eq: "x \<le> y \<longleftrightarrow> x = y \<or> x < y"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4340
  for x y :: "'z::len word"
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46962
diff changeset
  4341
  by (auto simp add: order_class.le_less)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4342
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4343
lemma mod_plus_cong:
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4344
  fixes b b' :: int
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4345
  assumes 1: "b = b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4346
    and 2: "x mod b' = x' mod b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4347
    and 3: "y mod b' = y' mod b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4348
    and 4: "x' + y' = z'"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4349
  shows "(x + y) mod b = z' mod b'"
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4350
proof -
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4351
  from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'"
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64243
diff changeset
  4352
    by (simp add: mod_add_eq)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4353
  also have "\<dots> = (x' + y') mod b'"
64593
50c715579715 reoriented congruence rules in non-explosive direction
haftmann
parents: 64243
diff changeset
  4354
    by (simp add: mod_add_eq)
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4355
  finally show ?thesis
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4356
    by (simp add: 4)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4357
qed
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4358
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4359
lemma mod_minus_cong:
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4360
  fixes b b' :: int
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4361
  assumes "b = b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4362
    and "x mod b' = x' mod b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4363
    and "y mod b' = y' mod b'"
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4364
    and "x' - y' = z'"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4365
  shows "(x - y) mod b = z' mod b'"
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4366
  using assms [symmetric] by (auto intro: mod_diff_cong)
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4367
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4368
lemma word_induct_less [case_names zero less]:
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4369
  \<open>P m\<close> if zero: \<open>P 0\<close> and less: \<open>\<And>n. n < m \<Longrightarrow> P n \<Longrightarrow> P (1 + n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4370
  for m :: \<open>'a::len word\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4371
proof -
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4372
  define q where \<open>q = unat m\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4373
  with less have \<open>\<And>n. n < word_of_nat q \<Longrightarrow> P n \<Longrightarrow> P (1 + n)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4374
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4375
  then have \<open>P (word_of_nat q :: 'a word)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4376
  proof (induction q)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4377
    case 0
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4378
    show ?case
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4379
      by (simp add: zero)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4380
  next
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4381
    case (Suc q)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4382
    show ?case
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4383
    proof (cases \<open>1 + word_of_nat q = (0 :: 'a word)\<close>)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4384
      case True
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4385
      then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4386
        by (simp add: zero)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4387
    next
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4388
      case False
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4389
      then have *: \<open>word_of_nat q < (word_of_nat (Suc q) :: 'a word)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4390
        by (simp add: unatSuc word_less_nat_alt)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4391
      then have **: \<open>n < (1 + word_of_nat q :: 'a word) \<longleftrightarrow> n \<le> (word_of_nat q :: 'a word)\<close> for n
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4392
        by (metis (no_types, lifting) add.commute inc_le le_less_trans not_less of_nat_Suc)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4393
      have \<open>P (word_of_nat q)\<close>
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4394
        by (simp add: "**" Suc.IH Suc.prems)
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4395
      with * have \<open>P (1 + word_of_nat q)\<close>
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4396
        by (rule Suc.prems)
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4397
      then show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4398
        by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4399
    qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4400
  qed
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4401
  with \<open>q = unat m\<close> show ?thesis
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4402
    by simp
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4403
qed
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4404
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  4405
lemma word_induct: "P 0 \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P m"
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4406
  for P :: "'a::len word \<Rightarrow> bool"
72262
a282abb07642 integrated generic conversions into word corpse
haftmann
parents: 72261
diff changeset
  4407
  by (rule word_induct_less)
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4408
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4409
lemma word_induct2 [case_names zero suc, induct type]: "P 0 \<Longrightarrow> (\<And>n. 1 + n \<noteq> 0 \<Longrightarrow> P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P n"
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4410
  for P :: "'b::len word \<Rightarrow> bool"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4411
by (induction rule: word_induct_less; force)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4412
55816
e8dd03241e86 cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents: 55415
diff changeset
  4413
61799
4cf66f21b764 isabelle update_cartouches -c -t;
wenzelm
parents: 61649
diff changeset
  4414
subsection \<open>Recursion combinator for words\<close>
46010
ebbc2d5cd720 add section headings
huffman
parents: 46009
diff changeset
  4415
54848
a303daddebbf syntactically tuned
haftmann
parents: 54847
diff changeset
  4416
definition word_rec :: "'a \<Rightarrow> ('b::len word \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'b word \<Rightarrow> 'a"
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4417
  where "word_rec forZero forSuc n = rec_nat forZero (forSuc \<circ> of_nat) (unat n)"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4418
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4419
lemma word_rec_0 [simp]: "word_rec z s 0 = z"
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4420
  by (simp add: word_rec_def)
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4421
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4422
lemma word_rec_Suc [simp]: "1 + n \<noteq> 0 \<Longrightarrow> word_rec z s (1 + n) = s n (word_rec z s n)"
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  4423
  for n :: "'a::len word"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4424
  by (simp add: unatSuc word_rec_def)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4425
65363
5eb619751b14 misc tuning and modernization;
wenzelm
parents: 65336
diff changeset
  4426
lemma word_rec_Pred: "n \<noteq> 0 \<Longrightarrow> word_rec z s n = s (n - 1) (word_rec z s (n - 1))"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4427
  by (metis add.commute diff_add_cancel word_rec_Suc)
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4428
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4429
lemma word_rec_in: "f (word_rec z (\<lambda>_. f) n) = word_rec (f z) (\<lambda>_. f) n"
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  4430
  by (induct n) simp_all
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4431
67399
eab6ce8368fa ran isabelle update_op on all sources
nipkow
parents: 67122
diff changeset
  4432
lemma word_rec_in2: "f n (word_rec z f n) = word_rec (f 0 z) (f \<circ> (+) 1) n"
74101
d804e93ae9ff moved theory Bit_Operations into Main corpus
haftmann
parents: 74097
diff changeset
  4433
  by (induct n) simp_all
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4434
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4435
lemma word_rec_twice:
67399
eab6ce8368fa ran isabelle update_op on all sources
nipkow
parents: 67122
diff changeset
  4436
  "m \<le> n \<Longrightarrow> word_rec z f n = word_rec (word_rec z f (n - m)) (f \<circ> (+) (n - m)) m"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4437
proof (induction n arbitrary: z f)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4438
  case zero
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4439
  then show ?case
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4440
    by (metis diff_0_right word_le_0_iff word_rec_0)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4441
next
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4442
  case (suc n z f)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4443
  show ?case
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4444
  proof (cases "1 + (n - m) = 0")
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4445
    case True
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4446
    then show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4447
      by (simp add: add_diff_eq)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4448
  next
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4449
    case False
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4450
    then have eq: "1 + n - m = 1 + (n - m)"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4451
      by simp
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4452
    with False have "m \<le> n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4453
      by (metis "suc.prems" add.commute dual_order.antisym eq_iff_diff_eq_0 inc_le leI)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4454
    with False "suc.hyps" show ?thesis
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4455
      using suc.IH [of "f 0 z" "f \<circ> (+) 1"] 
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4456
      by (simp add: word_rec_in2 eq add.assoc o_def)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4457
  qed
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4458
qed
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4459
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4460
lemma word_rec_id: "word_rec z (\<lambda>_. id) n = z"
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4461
  by (induct n) auto
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4462
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4463
lemma word_rec_id_eq: "(\<And>m. m < n \<Longrightarrow> f m = id) \<Longrightarrow> word_rec z f n = z"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4464
  by (induction n) (auto simp add: unatSuc unat_arith_simps(2))
37660
56e3520b68b2 one unified Word theory
haftmann
parents: 36899
diff changeset
  4465
65268
75f2aa8ecb12 misc tuning and modernization;
wenzelm
parents: 64593
diff changeset
  4466
lemma word_rec_max:
72735
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4467
  assumes "\<forall>m\<ge>n. m \<noteq> - 1 \<longrightarrow> f m = id"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4468
  shows "word_rec z f (- 1) = word_rec z f n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4469
proof -
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4470
  have \<section>: "\<And>m. \<lbrakk>m < - 1 - n\<rbrakk> \<Longrightarrow> (f \<circ> (+) n) m = id"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4471
    using assms
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4472
    by (metis (mono_tags, lifting) add.commute add_diff_cancel_left' comp_apply less_le olen_add_eqv plus_minus_no_overflow word_n1_ge)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4473
  have "word_rec z f (- 1) = word_rec (word_rec z f (- 1 - (- 1 - n))) (f \<circ> (+) (- 1 - (- 1 - n))) (- 1 - n)"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4474
    by (meson word_n1_ge word_rec_twice)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4475
  also have "... = word_rec z f n"
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4476
    by (metis (no_types, lifting) \<section> diff_add_cancel minus_diff_eq uminus_add_conv_diff word_rec_id_eq)
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4477
  finally show ?thesis .
bbe5d3ef2052 Stepan Holub's stronger version of comm_append_are_replicate, and a de-applied Word.thy
paulson <lp15@cam.ac.uk>
parents: 72611
diff changeset
  4478
qed
65336
8e5274fc0093 misc tuning and modernization;
wenzelm
parents: 65328
diff changeset
  4479
74097
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4480
end
6d7be1227d02 organize syntax for word operations in bundles
haftmann
parents: 73932
diff changeset
  4481
72512
83b5911c0164 more lemmas
haftmann
parents: 72508
diff changeset
  4482
74592
3c587b7c3d5c more generic bit/word lemmas for distribution
haftmann
parents: 74498
diff changeset
  4483
subsection \<open>Tool support\<close>
72489
a1366ce41368 early and more complete setup of tools
haftmann
parents: 72488
diff changeset
  4484
69605
a96320074298 isabelle update -u path_cartouches;
wenzelm
parents: 69064
diff changeset
  4485
ML_file \<open>Tools/smt_word.ML\<close>
36899
bcd6fce5bf06 layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents: 35049
diff changeset
  4486
41060
4199fdcfa3c0 moved smt_word.ML into the directory of the Word library
boehmes
parents: 40827
diff changeset
  4487
end