1(* Title: HOL/Num.thy 2 Author: Florian Haftmann 3 Author: Brian Huffman 4*) 5 6section \<open>Binary Numerals\<close> 7 8theory Num 9 imports BNF_Least_Fixpoint Transfer 10begin 11 12subsection \<open>The \<open>num\<close> type\<close> 13 14datatype num = One | Bit0 num | Bit1 num 15 16text \<open>Increment function for type \<^typ>\<open>num\<close>\<close> 17 18primrec inc :: "num \<Rightarrow> num" 19 where 20 "inc One = Bit0 One" 21 | "inc (Bit0 x) = Bit1 x" 22 | "inc (Bit1 x) = Bit0 (inc x)" 23 24text \<open>Converting between type \<^typ>\<open>num\<close> and type \<^typ>\<open>nat\<close>\<close> 25 26primrec nat_of_num :: "num \<Rightarrow> nat" 27 where 28 "nat_of_num One = Suc 0" 29 | "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" 30 | "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)" 31 32primrec num_of_nat :: "nat \<Rightarrow> num" 33 where 34 "num_of_nat 0 = One" 35 | "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)" 36 37lemma nat_of_num_pos: "0 < nat_of_num x" 38 by (induct x) simp_all 39 40lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0" 41 by (induct x) simp_all 42 43lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)" 44 by (induct x) simp_all 45 46lemma num_of_nat_double: "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)" 47 by (induct n) simp_all 48 49text \<open>Type \<^typ>\<open>num\<close> is isomorphic to the strictly positive natural numbers.\<close> 50 51lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x" 52 by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos) 53 54lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n" 55 by (induct n) (simp_all add: nat_of_num_inc) 56 57lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y" 58 apply safe 59 apply (drule arg_cong [where f=num_of_nat]) 60 apply (simp add: nat_of_num_inverse) 61 done 62 63lemma num_induct [case_names One inc]: 64 fixes P :: "num \<Rightarrow> bool" 65 assumes One: "P One" 66 and inc: "\<And>x. P x \<Longrightarrow> P (inc x)" 67 shows "P x" 68proof - 69 obtain n where n: "Suc n = nat_of_num x" 70 by (cases "nat_of_num x") (simp_all add: nat_of_num_neq_0) 71 have "P (num_of_nat (Suc n))" 72 proof (induct n) 73 case 0 74 from One show ?case by simp 75 next 76 case (Suc n) 77 then have "P (inc (num_of_nat (Suc n)))" by (rule inc) 78 then show "P (num_of_nat (Suc (Suc n)))" by simp 79 qed 80 with n show "P x" 81 by (simp add: nat_of_num_inverse) 82qed 83 84text \<open> 85 From now on, there are two possible models for \<^typ>\<open>num\<close>: as positive 86 naturals (rule \<open>num_induct\<close>) and as digit representation (rules 87 \<open>num.induct\<close>, \<open>num.cases\<close>). 88\<close> 89 90 91subsection \<open>Numeral operations\<close> 92 93instantiation num :: "{plus,times,linorder}" 94begin 95 96definition [code del]: "m + n = num_of_nat (nat_of_num m + nat_of_num n)" 97 98definition [code del]: "m * n = num_of_nat (nat_of_num m * nat_of_num n)" 99 100definition [code del]: "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n" 101 102definition [code del]: "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n" 103 104instance 105 by standard (auto simp add: less_num_def less_eq_num_def num_eq_iff) 106 107end 108 109lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y" 110 unfolding plus_num_def 111 by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos) 112 113lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y" 114 unfolding times_num_def 115 by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos) 116 117lemma add_num_simps [simp, code]: 118 "One + One = Bit0 One" 119 "One + Bit0 n = Bit1 n" 120 "One + Bit1 n = Bit0 (n + One)" 121 "Bit0 m + One = Bit1 m" 122 "Bit0 m + Bit0 n = Bit0 (m + n)" 123 "Bit0 m + Bit1 n = Bit1 (m + n)" 124 "Bit1 m + One = Bit0 (m + One)" 125 "Bit1 m + Bit0 n = Bit1 (m + n)" 126 "Bit1 m + Bit1 n = Bit0 (m + n + One)" 127 by (simp_all add: num_eq_iff nat_of_num_add) 128 129lemma mult_num_simps [simp, code]: 130 "m * One = m" 131 "One * n = n" 132 "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))" 133 "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)" 134 "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)" 135 "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))" 136 by (simp_all add: num_eq_iff nat_of_num_add nat_of_num_mult distrib_right distrib_left) 137 138lemma eq_num_simps: 139 "One = One \<longleftrightarrow> True" 140 "One = Bit0 n \<longleftrightarrow> False" 141 "One = Bit1 n \<longleftrightarrow> False" 142 "Bit0 m = One \<longleftrightarrow> False" 143 "Bit1 m = One \<longleftrightarrow> False" 144 "Bit0 m = Bit0 n \<longleftrightarrow> m = n" 145 "Bit0 m = Bit1 n \<longleftrightarrow> False" 146 "Bit1 m = Bit0 n \<longleftrightarrow> False" 147 "Bit1 m = Bit1 n \<longleftrightarrow> m = n" 148 by simp_all 149 150lemma le_num_simps [simp, code]: 151 "One \<le> n \<longleftrightarrow> True" 152 "Bit0 m \<le> One \<longleftrightarrow> False" 153 "Bit1 m \<le> One \<longleftrightarrow> False" 154 "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n" 155 "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n" 156 "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n" 157 "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n" 158 using nat_of_num_pos [of n] nat_of_num_pos [of m] 159 by (auto simp add: less_eq_num_def less_num_def) 160 161lemma less_num_simps [simp, code]: 162 "m < One \<longleftrightarrow> False" 163 "One < Bit0 n \<longleftrightarrow> True" 164 "One < Bit1 n \<longleftrightarrow> True" 165 "Bit0 m < Bit0 n \<longleftrightarrow> m < n" 166 "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n" 167 "Bit1 m < Bit1 n \<longleftrightarrow> m < n" 168 "Bit1 m < Bit0 n \<longleftrightarrow> m < n" 169 using nat_of_num_pos [of n] nat_of_num_pos [of m] 170 by (auto simp add: less_eq_num_def less_num_def) 171 172lemma le_num_One_iff: "x \<le> num.One \<longleftrightarrow> x = num.One" 173 by (simp add: antisym_conv) 174 175text \<open>Rules using \<open>One\<close> and \<open>inc\<close> as constructors.\<close> 176 177lemma add_One: "x + One = inc x" 178 by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc) 179 180lemma add_One_commute: "One + n = n + One" 181 by (induct n) simp_all 182 183lemma add_inc: "x + inc y = inc (x + y)" 184 by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc) 185 186lemma mult_inc: "x * inc y = x * y + x" 187 by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc) 188 189text \<open>The \<^const>\<open>num_of_nat\<close> conversion.\<close> 190 191lemma num_of_nat_One: "n \<le> 1 \<Longrightarrow> num_of_nat n = One" 192 by (cases n) simp_all 193 194lemma num_of_nat_plus_distrib: 195 "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n" 196 by (induct n) (auto simp add: add_One add_One_commute add_inc) 197 198text \<open>A double-and-decrement function.\<close> 199 200primrec BitM :: "num \<Rightarrow> num" 201 where 202 "BitM One = One" 203 | "BitM (Bit0 n) = Bit1 (BitM n)" 204 | "BitM (Bit1 n) = Bit1 (Bit0 n)" 205 206lemma BitM_plus_one: "BitM n + One = Bit0 n" 207 by (induct n) simp_all 208 209lemma one_plus_BitM: "One + BitM n = Bit0 n" 210 unfolding add_One_commute BitM_plus_one .. 211 212text \<open>Squaring and exponentiation.\<close> 213 214primrec sqr :: "num \<Rightarrow> num" 215 where 216 "sqr One = One" 217 | "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" 218 | "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))" 219 220primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" 221 where 222 "pow x One = x" 223 | "pow x (Bit0 y) = sqr (pow x y)" 224 | "pow x (Bit1 y) = sqr (pow x y) * x" 225 226lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x" 227 by (induct x) (simp_all add: algebra_simps nat_of_num_add) 228 229lemma sqr_conv_mult: "sqr x = x * x" 230 by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult) 231 232lemma num_double [simp]: 233 "num.Bit0 num.One * n = num.Bit0 n" 234 by (simp add: num_eq_iff nat_of_num_mult) 235 236 237subsection \<open>Binary numerals\<close> 238 239text \<open> 240 We embed binary representations into a generic algebraic 241 structure using \<open>numeral\<close>. 242\<close> 243 244class numeral = one + semigroup_add 245begin 246 247primrec numeral :: "num \<Rightarrow> 'a" 248 where 249 numeral_One: "numeral One = 1" 250 | numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" 251 | numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1" 252 253lemma numeral_code [code]: 254 "numeral One = 1" 255 "numeral (Bit0 n) = (let m = numeral n in m + m)" 256 "numeral (Bit1 n) = (let m = numeral n in m + m + 1)" 257 by (simp_all add: Let_def) 258 259lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1" 260proof (induct x) 261 case One 262 then show ?case by simp 263next 264 case Bit0 265 then show ?case by (simp add: add.assoc [symmetric]) (simp add: add.assoc) 266next 267 case Bit1 268 then show ?case by (simp add: add.assoc [symmetric]) (simp add: add.assoc) 269qed 270 271lemma numeral_inc: "numeral (inc x) = numeral x + 1" 272proof (induct x) 273 case One 274 then show ?case by simp 275next 276 case Bit0 277 then show ?case by simp 278next 279 case (Bit1 x) 280 have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1" 281 by (simp only: one_plus_numeral_commute) 282 with Bit1 show ?case 283 by (simp add: add.assoc) 284qed 285 286declare numeral.simps [simp del] 287 288abbreviation "Numeral1 \<equiv> numeral One" 289 290declare numeral_One [code_post] 291 292end 293 294text \<open>Numeral syntax.\<close> 295 296syntax 297 "_Numeral" :: "num_const \<Rightarrow> 'a" ("_") 298 299ML_file \<open>Tools/numeral.ML\<close> 300 301parse_translation \<open> 302 let 303 fun numeral_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] = 304 c $ numeral_tr [t] $ u 305 | numeral_tr [Const (num, _)] = 306 (Numeral.mk_number_syntax o #value o Lexicon.read_num) num 307 | numeral_tr ts = raise TERM ("numeral_tr", ts); 308 in [(\<^syntax_const>\<open>_Numeral\<close>, K numeral_tr)] end 309\<close> 310 311typed_print_translation \<open> 312 let 313 fun num_tr' ctxt T [n] = 314 let 315 val k = Numeral.dest_num_syntax n; 316 val t' = 317 Syntax.const \<^syntax_const>\<open>_Numeral\<close> $ 318 Syntax.free (string_of_int k); 319 in 320 (case T of 321 Type (\<^type_name>\<open>fun\<close>, [_, T']) => 322 if Printer.type_emphasis ctxt T' then 323 Syntax.const \<^syntax_const>\<open>_constrain\<close> $ t' $ 324 Syntax_Phases.term_of_typ ctxt T' 325 else t' 326 | _ => if T = dummyT then t' else raise Match) 327 end; 328 in 329 [(\<^const_syntax>\<open>numeral\<close>, num_tr')] 330 end 331\<close> 332 333 334subsection \<open>Class-specific numeral rules\<close> 335 336text \<open>\<^const>\<open>numeral\<close> is a morphism.\<close> 337 338 339subsubsection \<open>Structures with addition: class \<open>numeral\<close>\<close> 340 341context numeral 342begin 343 344lemma numeral_add: "numeral (m + n) = numeral m + numeral n" 345 by (induct n rule: num_induct) 346 (simp_all only: numeral_One add_One add_inc numeral_inc add.assoc) 347 348lemma numeral_plus_numeral: "numeral m + numeral n = numeral (m + n)" 349 by (rule numeral_add [symmetric]) 350 351lemma numeral_plus_one: "numeral n + 1 = numeral (n + One)" 352 using numeral_add [of n One] by (simp add: numeral_One) 353 354lemma one_plus_numeral: "1 + numeral n = numeral (One + n)" 355 using numeral_add [of One n] by (simp add: numeral_One) 356 357lemma one_add_one: "1 + 1 = 2" 358 using numeral_add [of One One] by (simp add: numeral_One) 359 360lemmas add_numeral_special = 361 numeral_plus_one one_plus_numeral one_add_one 362 363end 364 365 366subsubsection \<open>Structures with negation: class \<open>neg_numeral\<close>\<close> 367 368class neg_numeral = numeral + group_add 369begin 370 371lemma uminus_numeral_One: "- Numeral1 = - 1" 372 by (simp add: numeral_One) 373 374text \<open>Numerals form an abelian subgroup.\<close> 375 376inductive is_num :: "'a \<Rightarrow> bool" 377 where 378 "is_num 1" 379 | "is_num x \<Longrightarrow> is_num (- x)" 380 | "is_num x \<Longrightarrow> is_num y \<Longrightarrow> is_num (x + y)" 381 382lemma is_num_numeral: "is_num (numeral k)" 383 by (induct k) (simp_all add: numeral.simps is_num.intros) 384 385lemma is_num_add_commute: "is_num x \<Longrightarrow> is_num y \<Longrightarrow> x + y = y + x" 386 apply (induct x rule: is_num.induct) 387 apply (induct y rule: is_num.induct) 388 apply simp 389 apply (rule_tac a=x in add_left_imp_eq) 390 apply (rule_tac a=x in add_right_imp_eq) 391 apply (simp add: add.assoc) 392 apply (simp add: add.assoc [symmetric]) 393 apply (simp add: add.assoc) 394 apply (rule_tac a=x in add_left_imp_eq) 395 apply (rule_tac a=x in add_right_imp_eq) 396 apply (simp add: add.assoc) 397 apply (simp add: add.assoc) 398 apply (simp add: add.assoc [symmetric]) 399 done 400 401lemma is_num_add_left_commute: "is_num x \<Longrightarrow> is_num y \<Longrightarrow> x + (y + z) = y + (x + z)" 402 by (simp only: add.assoc [symmetric] is_num_add_commute) 403 404lemmas is_num_normalize = 405 add.assoc is_num_add_commute is_num_add_left_commute 406 is_num.intros is_num_numeral 407 minus_add 408 409definition dbl :: "'a \<Rightarrow> 'a" 410 where "dbl x = x + x" 411 412definition dbl_inc :: "'a \<Rightarrow> 'a" 413 where "dbl_inc x = x + x + 1" 414 415definition dbl_dec :: "'a \<Rightarrow> 'a" 416 where "dbl_dec x = x + x - 1" 417 418definition sub :: "num \<Rightarrow> num \<Rightarrow> 'a" 419 where "sub k l = numeral k - numeral l" 420 421lemma numeral_BitM: "numeral (BitM n) = numeral (Bit0 n) - 1" 422 by (simp only: BitM_plus_one [symmetric] numeral_add numeral_One eq_diff_eq) 423 424lemma dbl_simps [simp]: 425 "dbl (- numeral k) = - dbl (numeral k)" 426 "dbl 0 = 0" 427 "dbl 1 = 2" 428 "dbl (- 1) = - 2" 429 "dbl (numeral k) = numeral (Bit0 k)" 430 by (simp_all add: dbl_def numeral.simps minus_add) 431 432lemma dbl_inc_simps [simp]: 433 "dbl_inc (- numeral k) = - dbl_dec (numeral k)" 434 "dbl_inc 0 = 1" 435 "dbl_inc 1 = 3" 436 "dbl_inc (- 1) = - 1" 437 "dbl_inc (numeral k) = numeral (Bit1 k)" 438 by (simp_all add: dbl_inc_def dbl_dec_def numeral.simps numeral_BitM is_num_normalize algebra_simps 439 del: add_uminus_conv_diff) 440 441lemma dbl_dec_simps [simp]: 442 "dbl_dec (- numeral k) = - dbl_inc (numeral k)" 443 "dbl_dec 0 = - 1" 444 "dbl_dec 1 = 1" 445 "dbl_dec (- 1) = - 3" 446 "dbl_dec (numeral k) = numeral (BitM k)" 447 by (simp_all add: dbl_dec_def dbl_inc_def numeral.simps numeral_BitM is_num_normalize) 448 449lemma sub_num_simps [simp]: 450 "sub One One = 0" 451 "sub One (Bit0 l) = - numeral (BitM l)" 452 "sub One (Bit1 l) = - numeral (Bit0 l)" 453 "sub (Bit0 k) One = numeral (BitM k)" 454 "sub (Bit1 k) One = numeral (Bit0 k)" 455 "sub (Bit0 k) (Bit0 l) = dbl (sub k l)" 456 "sub (Bit0 k) (Bit1 l) = dbl_dec (sub k l)" 457 "sub (Bit1 k) (Bit0 l) = dbl_inc (sub k l)" 458 "sub (Bit1 k) (Bit1 l) = dbl (sub k l)" 459 by (simp_all add: dbl_def dbl_dec_def dbl_inc_def sub_def numeral.simps 460 numeral_BitM is_num_normalize del: add_uminus_conv_diff add: diff_conv_add_uminus) 461 462lemma add_neg_numeral_simps: 463 "numeral m + - numeral n = sub m n" 464 "- numeral m + numeral n = sub n m" 465 "- numeral m + - numeral n = - (numeral m + numeral n)" 466 by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize 467 del: add_uminus_conv_diff add: diff_conv_add_uminus) 468 469lemma add_neg_numeral_special: 470 "1 + - numeral m = sub One m" 471 "- numeral m + 1 = sub One m" 472 "numeral m + - 1 = sub m One" 473 "- 1 + numeral n = sub n One" 474 "- 1 + - numeral n = - numeral (inc n)" 475 "- numeral m + - 1 = - numeral (inc m)" 476 "1 + - 1 = 0" 477 "- 1 + 1 = 0" 478 "- 1 + - 1 = - 2" 479 by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize right_minus numeral_inc 480 del: add_uminus_conv_diff add: diff_conv_add_uminus) 481 482lemma diff_numeral_simps: 483 "numeral m - numeral n = sub m n" 484 "numeral m - - numeral n = numeral (m + n)" 485 "- numeral m - numeral n = - numeral (m + n)" 486 "- numeral m - - numeral n = sub n m" 487 by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize 488 del: add_uminus_conv_diff add: diff_conv_add_uminus) 489 490lemma diff_numeral_special: 491 "1 - numeral n = sub One n" 492 "numeral m - 1 = sub m One" 493 "1 - - numeral n = numeral (One + n)" 494 "- numeral m - 1 = - numeral (m + One)" 495 "- 1 - numeral n = - numeral (inc n)" 496 "numeral m - - 1 = numeral (inc m)" 497 "- 1 - - numeral n = sub n One" 498 "- numeral m - - 1 = sub One m" 499 "1 - 1 = 0" 500 "- 1 - 1 = - 2" 501 "1 - - 1 = 2" 502 "- 1 - - 1 = 0" 503 by (simp_all add: sub_def numeral_add numeral.simps is_num_normalize numeral_inc 504 del: add_uminus_conv_diff add: diff_conv_add_uminus) 505 506end 507 508 509subsubsection \<open>Structures with multiplication: class \<open>semiring_numeral\<close>\<close> 510 511class semiring_numeral = semiring + monoid_mult 512begin 513 514subclass numeral .. 515 516lemma numeral_mult: "numeral (m * n) = numeral m * numeral n" 517 by (induct n rule: num_induct) 518 (simp_all add: numeral_One mult_inc numeral_inc numeral_add distrib_left) 519 520lemma numeral_times_numeral: "numeral m * numeral n = numeral (m * n)" 521 by (rule numeral_mult [symmetric]) 522 523lemma mult_2: "2 * z = z + z" 524 by (simp add: one_add_one [symmetric] distrib_right) 525 526lemma mult_2_right: "z * 2 = z + z" 527 by (simp add: one_add_one [symmetric] distrib_left) 528 529lemma left_add_twice: 530 "a + (a + b) = 2 * a + b" 531 by (simp add: mult_2 ac_simps) 532 533end 534 535 536subsubsection \<open>Structures with a zero: class \<open>semiring_1\<close>\<close> 537 538context semiring_1 539begin 540 541subclass semiring_numeral .. 542 543lemma of_nat_numeral [simp]: "of_nat (numeral n) = numeral n" 544 by (induct n) (simp_all only: numeral.simps numeral_class.numeral.simps of_nat_add of_nat_1) 545 546lemma numeral_unfold_funpow: 547 "numeral k = ((+) 1 ^^ numeral k) 0" 548 unfolding of_nat_def [symmetric] by simp 549 550end 551 552context 553 includes lifting_syntax 554begin 555 556lemma transfer_rule_numeral: 557 "((=) ===> R) numeral numeral" 558 if [transfer_rule]: "R 0 0" "R 1 1" 559 "(R ===> R ===> R) (+) (+)" 560 for R :: "'a::semiring_1 \<Rightarrow> 'b::semiring_1 \<Rightarrow> bool" 561proof - 562 have "((=) ===> R) (\<lambda>k. ((+) 1 ^^ numeral k) 0) (\<lambda>k. ((+) 1 ^^ numeral k) 0)" 563 by transfer_prover 564 then show ?thesis 565 by (simp flip: numeral_unfold_funpow [abs_def]) 566qed 567 568end 569 570lemma nat_of_num_numeral [code_abbrev]: "nat_of_num = numeral" 571proof 572 fix n 573 have "numeral n = nat_of_num n" 574 by (induct n) (simp_all add: numeral.simps) 575 then show "nat_of_num n = numeral n" 576 by simp 577qed 578 579lemma nat_of_num_code [code]: 580 "nat_of_num One = 1" 581 "nat_of_num (Bit0 n) = (let m = nat_of_num n in m + m)" 582 "nat_of_num (Bit1 n) = (let m = nat_of_num n in Suc (m + m))" 583 by (simp_all add: Let_def) 584 585 586subsubsection \<open>Equality: class \<open>semiring_char_0\<close>\<close> 587 588context semiring_char_0 589begin 590 591lemma numeral_eq_iff: "numeral m = numeral n \<longleftrightarrow> m = n" 592 by (simp only: of_nat_numeral [symmetric] nat_of_num_numeral [symmetric] 593 of_nat_eq_iff num_eq_iff) 594 595lemma numeral_eq_one_iff: "numeral n = 1 \<longleftrightarrow> n = One" 596 by (rule numeral_eq_iff [of n One, unfolded numeral_One]) 597 598lemma one_eq_numeral_iff: "1 = numeral n \<longleftrightarrow> One = n" 599 by (rule numeral_eq_iff [of One n, unfolded numeral_One]) 600 601lemma numeral_neq_zero: "numeral n \<noteq> 0" 602 by (simp add: of_nat_numeral [symmetric] nat_of_num_numeral [symmetric] nat_of_num_pos) 603 604lemma zero_neq_numeral: "0 \<noteq> numeral n" 605 unfolding eq_commute [of 0] by (rule numeral_neq_zero) 606 607lemmas eq_numeral_simps [simp] = 608 numeral_eq_iff 609 numeral_eq_one_iff 610 one_eq_numeral_iff 611 numeral_neq_zero 612 zero_neq_numeral 613 614end 615 616 617subsubsection \<open>Comparisons: class \<open>linordered_nonzero_semiring\<close>\<close> 618 619context linordered_nonzero_semiring 620begin 621 622lemma numeral_le_iff: "numeral m \<le> numeral n \<longleftrightarrow> m \<le> n" 623proof - 624 have "of_nat (numeral m) \<le> of_nat (numeral n) \<longleftrightarrow> m \<le> n" 625 by (simp only: less_eq_num_def nat_of_num_numeral of_nat_le_iff) 626 then show ?thesis by simp 627qed 628 629lemma one_le_numeral: "1 \<le> numeral n" 630 using numeral_le_iff [of num.One n] by (simp add: numeral_One) 631 632lemma numeral_le_one_iff: "numeral n \<le> 1 \<longleftrightarrow> n \<le> num.One" 633 using numeral_le_iff [of n num.One] by (simp add: numeral_One) 634 635lemma numeral_less_iff: "numeral m < numeral n \<longleftrightarrow> m < n" 636proof - 637 have "of_nat (numeral m) < of_nat (numeral n) \<longleftrightarrow> m < n" 638 unfolding less_num_def nat_of_num_numeral of_nat_less_iff .. 639 then show ?thesis by simp 640qed 641 642lemma not_numeral_less_one: "\<not> numeral n < 1" 643 using numeral_less_iff [of n num.One] by (simp add: numeral_One) 644 645lemma one_less_numeral_iff: "1 < numeral n \<longleftrightarrow> num.One < n" 646 using numeral_less_iff [of num.One n] by (simp add: numeral_One) 647 648lemma zero_le_numeral: "0 \<le> numeral n" 649 using dual_order.trans one_le_numeral zero_le_one by blast 650 651lemma zero_less_numeral: "0 < numeral n" 652 using less_linear not_numeral_less_one order.strict_trans zero_less_one by blast 653 654lemma not_numeral_le_zero: "\<not> numeral n \<le> 0" 655 by (simp add: not_le zero_less_numeral) 656 657lemma not_numeral_less_zero: "\<not> numeral n < 0" 658 by (simp add: not_less zero_le_numeral) 659 660lemmas le_numeral_extra = 661 zero_le_one not_one_le_zero 662 order_refl [of 0] order_refl [of 1] 663 664lemmas less_numeral_extra = 665 zero_less_one not_one_less_zero 666 less_irrefl [of 0] less_irrefl [of 1] 667 668lemmas le_numeral_simps [simp] = 669 numeral_le_iff 670 one_le_numeral 671 numeral_le_one_iff 672 zero_le_numeral 673 not_numeral_le_zero 674 675lemmas less_numeral_simps [simp] = 676 numeral_less_iff 677 one_less_numeral_iff 678 not_numeral_less_one 679 zero_less_numeral 680 not_numeral_less_zero 681 682lemma min_0_1 [simp]: 683 fixes min' :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" 684 defines "min' \<equiv> min" 685 shows 686 "min' 0 1 = 0" 687 "min' 1 0 = 0" 688 "min' 0 (numeral x) = 0" 689 "min' (numeral x) 0 = 0" 690 "min' 1 (numeral x) = 1" 691 "min' (numeral x) 1 = 1" 692 by (simp_all add: min'_def min_def le_num_One_iff) 693 694lemma max_0_1 [simp]: 695 fixes max' :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" 696 defines "max' \<equiv> max" 697 shows 698 "max' 0 1 = 1" 699 "max' 1 0 = 1" 700 "max' 0 (numeral x) = numeral x" 701 "max' (numeral x) 0 = numeral x" 702 "max' 1 (numeral x) = numeral x" 703 "max' (numeral x) 1 = numeral x" 704 by (simp_all add: max'_def max_def le_num_One_iff) 705 706end 707 708text \<open>Unfold \<open>min\<close> and \<open>max\<close> on numerals.\<close> 709 710lemmas max_number_of [simp] = 711 max_def [of "numeral u" "numeral v"] 712 max_def [of "numeral u" "- numeral v"] 713 max_def [of "- numeral u" "numeral v"] 714 max_def [of "- numeral u" "- numeral v"] for u v 715 716lemmas min_number_of [simp] = 717 min_def [of "numeral u" "numeral v"] 718 min_def [of "numeral u" "- numeral v"] 719 min_def [of "- numeral u" "numeral v"] 720 min_def [of "- numeral u" "- numeral v"] for u v 721 722 723subsubsection \<open>Multiplication and negation: class \<open>ring_1\<close>\<close> 724 725context ring_1 726begin 727 728subclass neg_numeral .. 729 730lemma mult_neg_numeral_simps: 731 "- numeral m * - numeral n = numeral (m * n)" 732 "- numeral m * numeral n = - numeral (m * n)" 733 "numeral m * - numeral n = - numeral (m * n)" 734 by (simp_all only: mult_minus_left mult_minus_right minus_minus numeral_mult) 735 736lemma mult_minus1 [simp]: "- 1 * z = - z" 737 by (simp add: numeral.simps) 738 739lemma mult_minus1_right [simp]: "z * - 1 = - z" 740 by (simp add: numeral.simps) 741 742end 743 744 745subsubsection \<open>Equality using \<open>iszero\<close> for rings with non-zero characteristic\<close> 746 747context ring_1 748begin 749 750definition iszero :: "'a \<Rightarrow> bool" 751 where "iszero z \<longleftrightarrow> z = 0" 752 753lemma iszero_0 [simp]: "iszero 0" 754 by (simp add: iszero_def) 755 756lemma not_iszero_1 [simp]: "\<not> iszero 1" 757 by (simp add: iszero_def) 758 759lemma not_iszero_Numeral1: "\<not> iszero Numeral1" 760 by (simp add: numeral_One) 761 762lemma not_iszero_neg_1 [simp]: "\<not> iszero (- 1)" 763 by (simp add: iszero_def) 764 765lemma not_iszero_neg_Numeral1: "\<not> iszero (- Numeral1)" 766 by (simp add: numeral_One) 767 768lemma iszero_neg_numeral [simp]: "iszero (- numeral w) \<longleftrightarrow> iszero (numeral w)" 769 unfolding iszero_def by (rule neg_equal_0_iff_equal) 770 771lemma eq_iff_iszero_diff: "x = y \<longleftrightarrow> iszero (x - y)" 772 unfolding iszero_def by (rule eq_iff_diff_eq_0) 773 774text \<open> 775 The \<open>eq_numeral_iff_iszero\<close> lemmas are not declared \<open>[simp]\<close> by default, 776 because for rings of characteristic zero, better simp rules are possible. 777 For a type like integers mod \<open>n\<close>, type-instantiated versions of these rules 778 should be added to the simplifier, along with a type-specific rule for 779 deciding propositions of the form \<open>iszero (numeral w)\<close>. 780 781 bh: Maybe it would not be so bad to just declare these as simp rules anyway? 782 I should test whether these rules take precedence over the \<open>ring_char_0\<close> 783 rules in the simplifier. 784\<close> 785 786lemma eq_numeral_iff_iszero: 787 "numeral x = numeral y \<longleftrightarrow> iszero (sub x y)" 788 "numeral x = - numeral y \<longleftrightarrow> iszero (numeral (x + y))" 789 "- numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))" 790 "- numeral x = - numeral y \<longleftrightarrow> iszero (sub y x)" 791 "numeral x = 1 \<longleftrightarrow> iszero (sub x One)" 792 "1 = numeral y \<longleftrightarrow> iszero (sub One y)" 793 "- numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))" 794 "1 = - numeral y \<longleftrightarrow> iszero (numeral (One + y))" 795 "numeral x = 0 \<longleftrightarrow> iszero (numeral x)" 796 "0 = numeral y \<longleftrightarrow> iszero (numeral y)" 797 "- numeral x = 0 \<longleftrightarrow> iszero (numeral x)" 798 "0 = - numeral y \<longleftrightarrow> iszero (numeral y)" 799 unfolding eq_iff_iszero_diff diff_numeral_simps diff_numeral_special 800 by simp_all 801 802end 803 804 805subsubsection \<open>Equality and negation: class \<open>ring_char_0\<close>\<close> 806 807context ring_char_0 808begin 809 810lemma not_iszero_numeral [simp]: "\<not> iszero (numeral w)" 811 by (simp add: iszero_def) 812 813lemma neg_numeral_eq_iff: "- numeral m = - numeral n \<longleftrightarrow> m = n" 814 by simp 815 816lemma numeral_neq_neg_numeral: "numeral m \<noteq> - numeral n" 817 by (simp add: eq_neg_iff_add_eq_0 numeral_plus_numeral) 818 819lemma neg_numeral_neq_numeral: "- numeral m \<noteq> numeral n" 820 by (rule numeral_neq_neg_numeral [symmetric]) 821 822lemma zero_neq_neg_numeral: "0 \<noteq> - numeral n" 823 by simp 824 825lemma neg_numeral_neq_zero: "- numeral n \<noteq> 0" 826 by simp 827 828lemma one_neq_neg_numeral: "1 \<noteq> - numeral n" 829 using numeral_neq_neg_numeral [of One n] by (simp add: numeral_One) 830 831lemma neg_numeral_neq_one: "- numeral n \<noteq> 1" 832 using neg_numeral_neq_numeral [of n One] by (simp add: numeral_One) 833 834lemma neg_one_neq_numeral: "- 1 \<noteq> numeral n" 835 using neg_numeral_neq_numeral [of One n] by (simp add: numeral_One) 836 837lemma numeral_neq_neg_one: "numeral n \<noteq> - 1" 838 using numeral_neq_neg_numeral [of n One] by (simp add: numeral_One) 839 840lemma neg_one_eq_numeral_iff: "- 1 = - numeral n \<longleftrightarrow> n = One" 841 using neg_numeral_eq_iff [of One n] by (auto simp add: numeral_One) 842 843lemma numeral_eq_neg_one_iff: "- numeral n = - 1 \<longleftrightarrow> n = One" 844 using neg_numeral_eq_iff [of n One] by (auto simp add: numeral_One) 845 846lemma neg_one_neq_zero: "- 1 \<noteq> 0" 847 by simp 848 849lemma zero_neq_neg_one: "0 \<noteq> - 1" 850 by simp 851 852lemma neg_one_neq_one: "- 1 \<noteq> 1" 853 using neg_numeral_neq_numeral [of One One] by (simp only: numeral_One not_False_eq_True) 854 855lemma one_neq_neg_one: "1 \<noteq> - 1" 856 using numeral_neq_neg_numeral [of One One] by (simp only: numeral_One not_False_eq_True) 857 858lemmas eq_neg_numeral_simps [simp] = 859 neg_numeral_eq_iff 860 numeral_neq_neg_numeral neg_numeral_neq_numeral 861 one_neq_neg_numeral neg_numeral_neq_one 862 zero_neq_neg_numeral neg_numeral_neq_zero 863 neg_one_neq_numeral numeral_neq_neg_one 864 neg_one_eq_numeral_iff numeral_eq_neg_one_iff 865 neg_one_neq_zero zero_neq_neg_one 866 neg_one_neq_one one_neq_neg_one 867 868end 869 870 871subsubsection \<open>Structures with negation and order: class \<open>linordered_idom\<close>\<close> 872 873context linordered_idom 874begin 875 876subclass ring_char_0 .. 877 878lemma neg_numeral_le_iff: "- numeral m \<le> - numeral n \<longleftrightarrow> n \<le> m" 879 by (simp only: neg_le_iff_le numeral_le_iff) 880 881lemma neg_numeral_less_iff: "- numeral m < - numeral n \<longleftrightarrow> n < m" 882 by (simp only: neg_less_iff_less numeral_less_iff) 883 884lemma neg_numeral_less_zero: "- numeral n < 0" 885 by (simp only: neg_less_0_iff_less zero_less_numeral) 886 887lemma neg_numeral_le_zero: "- numeral n \<le> 0" 888 by (simp only: neg_le_0_iff_le zero_le_numeral) 889 890lemma not_zero_less_neg_numeral: "\<not> 0 < - numeral n" 891 by (simp only: not_less neg_numeral_le_zero) 892 893lemma not_zero_le_neg_numeral: "\<not> 0 \<le> - numeral n" 894 by (simp only: not_le neg_numeral_less_zero) 895 896lemma neg_numeral_less_numeral: "- numeral m < numeral n" 897 using neg_numeral_less_zero zero_less_numeral by (rule less_trans) 898 899lemma neg_numeral_le_numeral: "- numeral m \<le> numeral n" 900 by (simp only: less_imp_le neg_numeral_less_numeral) 901 902lemma not_numeral_less_neg_numeral: "\<not> numeral m < - numeral n" 903 by (simp only: not_less neg_numeral_le_numeral) 904 905lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> - numeral n" 906 by (simp only: not_le neg_numeral_less_numeral) 907 908lemma neg_numeral_less_one: "- numeral m < 1" 909 by (rule neg_numeral_less_numeral [of m One, unfolded numeral_One]) 910 911lemma neg_numeral_le_one: "- numeral m \<le> 1" 912 by (rule neg_numeral_le_numeral [of m One, unfolded numeral_One]) 913 914lemma not_one_less_neg_numeral: "\<not> 1 < - numeral m" 915 by (simp only: not_less neg_numeral_le_one) 916 917lemma not_one_le_neg_numeral: "\<not> 1 \<le> - numeral m" 918 by (simp only: not_le neg_numeral_less_one) 919 920lemma not_numeral_less_neg_one: "\<not> numeral m < - 1" 921 using not_numeral_less_neg_numeral [of m One] by (simp add: numeral_One) 922 923lemma not_numeral_le_neg_one: "\<not> numeral m \<le> - 1" 924 using not_numeral_le_neg_numeral [of m One] by (simp add: numeral_One) 925 926lemma neg_one_less_numeral: "- 1 < numeral m" 927 using neg_numeral_less_numeral [of One m] by (simp add: numeral_One) 928 929lemma neg_one_le_numeral: "- 1 \<le> numeral m" 930 using neg_numeral_le_numeral [of One m] by (simp add: numeral_One) 931 932lemma neg_numeral_less_neg_one_iff: "- numeral m < - 1 \<longleftrightarrow> m \<noteq> One" 933 by (cases m) simp_all 934 935lemma neg_numeral_le_neg_one: "- numeral m \<le> - 1" 936 by simp 937 938lemma not_neg_one_less_neg_numeral: "\<not> - 1 < - numeral m" 939 by simp 940 941lemma not_neg_one_le_neg_numeral_iff: "\<not> - 1 \<le> - numeral m \<longleftrightarrow> m \<noteq> One" 942 by (cases m) simp_all 943 944lemma sub_non_negative: "sub n m \<ge> 0 \<longleftrightarrow> n \<ge> m" 945 by (simp only: sub_def le_diff_eq) simp 946 947lemma sub_positive: "sub n m > 0 \<longleftrightarrow> n > m" 948 by (simp only: sub_def less_diff_eq) simp 949 950lemma sub_non_positive: "sub n m \<le> 0 \<longleftrightarrow> n \<le> m" 951 by (simp only: sub_def diff_le_eq) simp 952 953lemma sub_negative: "sub n m < 0 \<longleftrightarrow> n < m" 954 by (simp only: sub_def diff_less_eq) simp 955 956lemmas le_neg_numeral_simps [simp] = 957 neg_numeral_le_iff 958 neg_numeral_le_numeral not_numeral_le_neg_numeral 959 neg_numeral_le_zero not_zero_le_neg_numeral 960 neg_numeral_le_one not_one_le_neg_numeral 961 neg_one_le_numeral not_numeral_le_neg_one 962 neg_numeral_le_neg_one not_neg_one_le_neg_numeral_iff 963 964lemma le_minus_one_simps [simp]: 965 "- 1 \<le> 0" 966 "- 1 \<le> 1" 967 "\<not> 0 \<le> - 1" 968 "\<not> 1 \<le> - 1" 969 by simp_all 970 971lemmas less_neg_numeral_simps [simp] = 972 neg_numeral_less_iff 973 neg_numeral_less_numeral not_numeral_less_neg_numeral 974 neg_numeral_less_zero not_zero_less_neg_numeral 975 neg_numeral_less_one not_one_less_neg_numeral 976 neg_one_less_numeral not_numeral_less_neg_one 977 neg_numeral_less_neg_one_iff not_neg_one_less_neg_numeral 978 979lemma less_minus_one_simps [simp]: 980 "- 1 < 0" 981 "- 1 < 1" 982 "\<not> 0 < - 1" 983 "\<not> 1 < - 1" 984 by (simp_all add: less_le) 985 986lemma abs_numeral [simp]: "\<bar>numeral n\<bar> = numeral n" 987 by simp 988 989lemma abs_neg_numeral [simp]: "\<bar>- numeral n\<bar> = numeral n" 990 by (simp only: abs_minus_cancel abs_numeral) 991 992lemma abs_neg_one [simp]: "\<bar>- 1\<bar> = 1" 993 by simp 994 995end 996 997 998subsubsection \<open>Natural numbers\<close> 999 1000lemma numeral_num_of_nat: 1001 "numeral (num_of_nat n) = n" if "n > 0" 1002 using that nat_of_num_numeral num_of_nat_inverse by simp 1003 1004lemma Suc_1 [simp]: "Suc 1 = 2" 1005 unfolding Suc_eq_plus1 by (rule one_add_one) 1006 1007lemma Suc_numeral [simp]: "Suc (numeral n) = numeral (n + One)" 1008 unfolding Suc_eq_plus1 by (rule numeral_plus_one) 1009 1010definition pred_numeral :: "num \<Rightarrow> nat" 1011 where "pred_numeral k = numeral k - 1" 1012 1013declare [[code drop: pred_numeral]] 1014 1015lemma numeral_eq_Suc: "numeral k = Suc (pred_numeral k)" 1016 by (simp add: pred_numeral_def) 1017 1018lemma eval_nat_numeral: 1019 "numeral One = Suc 0" 1020 "numeral (Bit0 n) = Suc (numeral (BitM n))" 1021 "numeral (Bit1 n) = Suc (numeral (Bit0 n))" 1022 by (simp_all add: numeral.simps BitM_plus_one) 1023 1024lemma pred_numeral_simps [simp]: 1025 "pred_numeral One = 0" 1026 "pred_numeral (Bit0 k) = numeral (BitM k)" 1027 "pred_numeral (Bit1 k) = numeral (Bit0 k)" 1028 by (simp_all only: pred_numeral_def eval_nat_numeral diff_Suc_Suc diff_0) 1029 1030lemma pred_numeral_inc [simp]: 1031 "pred_numeral (Num.inc k) = numeral k" 1032 by (simp only: pred_numeral_def numeral_inc diff_add_inverse2) 1033 1034lemma numeral_2_eq_2: "2 = Suc (Suc 0)" 1035 by (simp add: eval_nat_numeral) 1036 1037lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))" 1038 by (simp add: eval_nat_numeral) 1039 1040lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0" 1041 by (simp only: numeral_One One_nat_def) 1042 1043lemma Suc_nat_number_of_add: "Suc (numeral v + n) = numeral (v + One) + n" 1044 by simp 1045 1046lemma numerals: "Numeral1 = (1::nat)" "2 = Suc (Suc 0)" 1047 by (rule numeral_One) (rule numeral_2_eq_2) 1048 1049lemmas numeral_nat = eval_nat_numeral BitM.simps One_nat_def 1050 1051text \<open>Comparisons involving \<^term>\<open>Suc\<close>.\<close> 1052 1053lemma eq_numeral_Suc [simp]: "numeral k = Suc n \<longleftrightarrow> pred_numeral k = n" 1054 by (simp add: numeral_eq_Suc) 1055 1056lemma Suc_eq_numeral [simp]: "Suc n = numeral k \<longleftrightarrow> n = pred_numeral k" 1057 by (simp add: numeral_eq_Suc) 1058 1059lemma less_numeral_Suc [simp]: "numeral k < Suc n \<longleftrightarrow> pred_numeral k < n" 1060 by (simp add: numeral_eq_Suc) 1061 1062lemma less_Suc_numeral [simp]: "Suc n < numeral k \<longleftrightarrow> n < pred_numeral k" 1063 by (simp add: numeral_eq_Suc) 1064 1065lemma le_numeral_Suc [simp]: "numeral k \<le> Suc n \<longleftrightarrow> pred_numeral k \<le> n" 1066 by (simp add: numeral_eq_Suc) 1067 1068lemma le_Suc_numeral [simp]: "Suc n \<le> numeral k \<longleftrightarrow> n \<le> pred_numeral k" 1069 by (simp add: numeral_eq_Suc) 1070 1071lemma diff_Suc_numeral [simp]: "Suc n - numeral k = n - pred_numeral k" 1072 by (simp add: numeral_eq_Suc) 1073 1074lemma diff_numeral_Suc [simp]: "numeral k - Suc n = pred_numeral k - n" 1075 by (simp add: numeral_eq_Suc) 1076 1077lemma max_Suc_numeral [simp]: "max (Suc n) (numeral k) = Suc (max n (pred_numeral k))" 1078 by (simp add: numeral_eq_Suc) 1079 1080lemma max_numeral_Suc [simp]: "max (numeral k) (Suc n) = Suc (max (pred_numeral k) n)" 1081 by (simp add: numeral_eq_Suc) 1082 1083lemma min_Suc_numeral [simp]: "min (Suc n) (numeral k) = Suc (min n (pred_numeral k))" 1084 by (simp add: numeral_eq_Suc) 1085 1086lemma min_numeral_Suc [simp]: "min (numeral k) (Suc n) = Suc (min (pred_numeral k) n)" 1087 by (simp add: numeral_eq_Suc) 1088 1089text \<open>For \<^term>\<open>case_nat\<close> and \<^term>\<open>rec_nat\<close>.\<close> 1090 1091lemma case_nat_numeral [simp]: "case_nat a f (numeral v) = (let pv = pred_numeral v in f pv)" 1092 by (simp add: numeral_eq_Suc) 1093 1094lemma case_nat_add_eq_if [simp]: 1095 "case_nat a f ((numeral v) + n) = (let pv = pred_numeral v in f (pv + n))" 1096 by (simp add: numeral_eq_Suc) 1097 1098lemma rec_nat_numeral [simp]: 1099 "rec_nat a f (numeral v) = (let pv = pred_numeral v in f pv (rec_nat a f pv))" 1100 by (simp add: numeral_eq_Suc Let_def) 1101 1102lemma rec_nat_add_eq_if [simp]: 1103 "rec_nat a f (numeral v + n) = (let pv = pred_numeral v in f (pv + n) (rec_nat a f (pv + n)))" 1104 by (simp add: numeral_eq_Suc Let_def) 1105 1106text \<open>Case analysis on \<^term>\<open>n < 2\<close>.\<close> 1107lemma less_2_cases: "n < 2 \<Longrightarrow> n = 0 \<or> n = Suc 0" 1108 by (auto simp add: numeral_2_eq_2) 1109 1110lemma less_2_cases_iff: "n < 2 \<longleftrightarrow> n = 0 \<or> n = Suc 0" 1111 by (auto simp add: numeral_2_eq_2) 1112 1113text \<open>Removal of Small Numerals: 0, 1 and (in additive positions) 2.\<close> 1114text \<open>bh: Are these rules really a good idea? LCP: well, it already happens for 0 and 1!\<close> 1115 1116lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)" 1117 by simp 1118 1119lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)" 1120 by simp 1121 1122text \<open>Can be used to eliminate long strings of Sucs, but not by default.\<close> 1123lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n" 1124 by simp 1125 1126lemmas nat_1_add_1 = one_add_one [where 'a=nat] (* legacy *) 1127 1128 1129subsection \<open>Particular lemmas concerning \<^term>\<open>2\<close>\<close> 1130 1131context linordered_field 1132begin 1133 1134subclass field_char_0 .. 1135 1136lemma half_gt_zero_iff: "0 < a / 2 \<longleftrightarrow> 0 < a" 1137 by (auto simp add: field_simps) 1138 1139lemma half_gt_zero [simp]: "0 < a \<Longrightarrow> 0 < a / 2" 1140 by (simp add: half_gt_zero_iff) 1141 1142end 1143 1144 1145subsection \<open>Numeral equations as default simplification rules\<close> 1146 1147declare (in numeral) numeral_One [simp] 1148declare (in numeral) numeral_plus_numeral [simp] 1149declare (in numeral) add_numeral_special [simp] 1150declare (in neg_numeral) add_neg_numeral_simps [simp] 1151declare (in neg_numeral) add_neg_numeral_special [simp] 1152declare (in neg_numeral) diff_numeral_simps [simp] 1153declare (in neg_numeral) diff_numeral_special [simp] 1154declare (in semiring_numeral) numeral_times_numeral [simp] 1155declare (in ring_1) mult_neg_numeral_simps [simp] 1156 1157 1158subsubsection \<open>Special Simplification for Constants\<close> 1159 1160text \<open>These distributive laws move literals inside sums and differences.\<close> 1161 1162lemmas distrib_right_numeral [simp] = distrib_right [of _ _ "numeral v"] for v 1163lemmas distrib_left_numeral [simp] = distrib_left [of "numeral v"] for v 1164lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v 1165lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v 1166 1167text \<open>These are actually for fields, like real\<close> 1168 1169lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w 1170lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w 1171lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w 1172lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w 1173 1174text \<open>Replaces \<open>inverse #nn\<close> by \<open>1/#nn\<close>. It looks 1175 strange, but then other simprocs simplify the quotient.\<close> 1176 1177lemmas inverse_eq_divide_numeral [simp] = 1178 inverse_eq_divide [of "numeral w"] for w 1179 1180lemmas inverse_eq_divide_neg_numeral [simp] = 1181 inverse_eq_divide [of "- numeral w"] for w 1182 1183text \<open>These laws simplify inequalities, moving unary minus from a term 1184 into the literal.\<close> 1185 1186lemmas equation_minus_iff_numeral [no_atp] = 1187 equation_minus_iff [of "numeral v"] for v 1188 1189lemmas minus_equation_iff_numeral [no_atp] = 1190 minus_equation_iff [of _ "numeral v"] for v 1191 1192lemmas le_minus_iff_numeral [no_atp] = 1193 le_minus_iff [of "numeral v"] for v 1194 1195lemmas minus_le_iff_numeral [no_atp] = 1196 minus_le_iff [of _ "numeral v"] for v 1197 1198lemmas less_minus_iff_numeral [no_atp] = 1199 less_minus_iff [of "numeral v"] for v 1200 1201lemmas minus_less_iff_numeral [no_atp] = 1202 minus_less_iff [of _ "numeral v"] for v 1203 1204(* FIXME maybe simproc *) 1205 1206text \<open>Cancellation of constant factors in comparisons (\<open><\<close> and \<open>\<le>\<close>)\<close> 1207 1208lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v 1209lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v 1210lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v 1211lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v 1212 1213text \<open>Multiplying out constant divisors in comparisons (\<open><\<close>, \<open>\<le>\<close> and \<open>=\<close>)\<close> 1214 1215named_theorems divide_const_simps "simplification rules to simplify comparisons involving constant divisors" 1216 1217lemmas le_divide_eq_numeral1 [simp,divide_const_simps] = 1218 pos_le_divide_eq [of "numeral w", OF zero_less_numeral] 1219 neg_le_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w 1220 1221lemmas divide_le_eq_numeral1 [simp,divide_const_simps] = 1222 pos_divide_le_eq [of "numeral w", OF zero_less_numeral] 1223 neg_divide_le_eq [of "- numeral w", OF neg_numeral_less_zero] for w 1224 1225lemmas less_divide_eq_numeral1 [simp,divide_const_simps] = 1226 pos_less_divide_eq [of "numeral w", OF zero_less_numeral] 1227 neg_less_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w 1228 1229lemmas divide_less_eq_numeral1 [simp,divide_const_simps] = 1230 pos_divide_less_eq [of "numeral w", OF zero_less_numeral] 1231 neg_divide_less_eq [of "- numeral w", OF neg_numeral_less_zero] for w 1232 1233lemmas eq_divide_eq_numeral1 [simp,divide_const_simps] = 1234 eq_divide_eq [of _ _ "numeral w"] 1235 eq_divide_eq [of _ _ "- numeral w"] for w 1236 1237lemmas divide_eq_eq_numeral1 [simp,divide_const_simps] = 1238 divide_eq_eq [of _ "numeral w"] 1239 divide_eq_eq [of _ "- numeral w"] for w 1240 1241 1242subsubsection \<open>Optional Simplification Rules Involving Constants\<close> 1243 1244text \<open>Simplify quotients that are compared with a literal constant.\<close> 1245 1246lemmas le_divide_eq_numeral [divide_const_simps] = 1247 le_divide_eq [of "numeral w"] 1248 le_divide_eq [of "- numeral w"] for w 1249 1250lemmas divide_le_eq_numeral [divide_const_simps] = 1251 divide_le_eq [of _ _ "numeral w"] 1252 divide_le_eq [of _ _ "- numeral w"] for w 1253 1254lemmas less_divide_eq_numeral [divide_const_simps] = 1255 less_divide_eq [of "numeral w"] 1256 less_divide_eq [of "- numeral w"] for w 1257 1258lemmas divide_less_eq_numeral [divide_const_simps] = 1259 divide_less_eq [of _ _ "numeral w"] 1260 divide_less_eq [of _ _ "- numeral w"] for w 1261 1262lemmas eq_divide_eq_numeral [divide_const_simps] = 1263 eq_divide_eq [of "numeral w"] 1264 eq_divide_eq [of "- numeral w"] for w 1265 1266lemmas divide_eq_eq_numeral [divide_const_simps] = 1267 divide_eq_eq [of _ _ "numeral w"] 1268 divide_eq_eq [of _ _ "- numeral w"] for w 1269 1270text \<open>Not good as automatic simprules because they cause case splits.\<close> 1271 1272lemmas [divide_const_simps] = 1273 le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1 1274 1275 1276subsection \<open>Setting up simprocs\<close> 1277 1278lemma mult_numeral_1: "Numeral1 * a = a" 1279 for a :: "'a::semiring_numeral" 1280 by simp 1281 1282lemma mult_numeral_1_right: "a * Numeral1 = a" 1283 for a :: "'a::semiring_numeral" 1284 by simp 1285 1286lemma divide_numeral_1: "a / Numeral1 = a" 1287 for a :: "'a::field" 1288 by simp 1289 1290lemma inverse_numeral_1: "inverse Numeral1 = (Numeral1::'a::division_ring)" 1291 by simp 1292 1293text \<open> 1294 Theorem lists for the cancellation simprocs. The use of a binary 1295 numeral for 1 reduces the number of special cases. 1296\<close> 1297 1298lemma mult_1s_semiring_numeral: 1299 "Numeral1 * a = a" 1300 "a * Numeral1 = a" 1301 for a :: "'a::semiring_numeral" 1302 by simp_all 1303 1304lemma mult_1s_ring_1: 1305 "- Numeral1 * b = - b" 1306 "b * - Numeral1 = - b" 1307 for b :: "'a::ring_1" 1308 by simp_all 1309 1310lemmas mult_1s = mult_1s_semiring_numeral mult_1s_ring_1 1311 1312setup \<open> 1313 Reorient_Proc.add 1314 (fn Const (\<^const_name>\<open>numeral\<close>, _) $ _ => true 1315 | Const (\<^const_name>\<open>uminus\<close>, _) $ (Const (\<^const_name>\<open>numeral\<close>, _) $ _) => true 1316 | _ => false) 1317\<close> 1318 1319simproc_setup reorient_numeral ("numeral w = x" | "- numeral w = y") = 1320 Reorient_Proc.proc 1321 1322 1323subsubsection \<open>Simplification of arithmetic operations on integer constants\<close> 1324 1325lemmas arith_special = (* already declared simp above *) 1326 add_numeral_special add_neg_numeral_special 1327 diff_numeral_special 1328 1329lemmas arith_extra_simps = (* rules already in simpset *) 1330 numeral_plus_numeral add_neg_numeral_simps add_0_left add_0_right 1331 minus_zero 1332 diff_numeral_simps diff_0 diff_0_right 1333 numeral_times_numeral mult_neg_numeral_simps 1334 mult_zero_left mult_zero_right 1335 abs_numeral abs_neg_numeral 1336 1337text \<open> 1338 For making a minimal simpset, one must include these default simprules. 1339 Also include \<open>simp_thms\<close>. 1340\<close> 1341 1342lemmas arith_simps = 1343 add_num_simps mult_num_simps sub_num_simps 1344 BitM.simps dbl_simps dbl_inc_simps dbl_dec_simps 1345 abs_zero abs_one arith_extra_simps 1346 1347lemmas more_arith_simps = 1348 neg_le_iff_le 1349 minus_zero left_minus right_minus 1350 mult_1_left mult_1_right 1351 mult_minus_left mult_minus_right 1352 minus_add_distrib minus_minus mult.assoc 1353 1354lemmas of_nat_simps = 1355 of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult 1356 1357text \<open>Simplification of relational operations.\<close> 1358 1359lemmas eq_numeral_extra = 1360 zero_neq_one one_neq_zero 1361 1362lemmas rel_simps = 1363 le_num_simps less_num_simps eq_num_simps 1364 le_numeral_simps le_neg_numeral_simps le_minus_one_simps le_numeral_extra 1365 less_numeral_simps less_neg_numeral_simps less_minus_one_simps less_numeral_extra 1366 eq_numeral_simps eq_neg_numeral_simps eq_numeral_extra 1367 1368lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)" 1369 \<comment> \<open>Unfold all \<open>let\<close>s involving constants\<close> 1370 unfolding Let_def .. 1371 1372lemma Let_neg_numeral [simp]: "Let (- numeral v) f = f (- numeral v)" 1373 \<comment> \<open>Unfold all \<open>let\<close>s involving constants\<close> 1374 unfolding Let_def .. 1375 1376declaration \<open> 1377let 1378 fun number_of ctxt T n = 1379 if not (Sign.of_sort (Proof_Context.theory_of ctxt) (T, \<^sort>\<open>numeral\<close>)) 1380 then raise CTERM ("number_of", []) 1381 else Numeral.mk_cnumber (Thm.ctyp_of ctxt T) n; 1382in 1383 K ( 1384 Lin_Arith.set_number_of number_of 1385 #> Lin_Arith.add_simps 1386 @{thms arith_simps more_arith_simps rel_simps pred_numeral_simps 1387 arith_special numeral_One of_nat_simps uminus_numeral_One 1388 Suc_numeral Let_numeral Let_neg_numeral Let_0 Let_1 1389 le_Suc_numeral le_numeral_Suc less_Suc_numeral less_numeral_Suc 1390 Suc_eq_numeral eq_numeral_Suc mult_Suc mult_Suc_right of_nat_numeral}) 1391end 1392\<close> 1393 1394 1395subsubsection \<open>Simplification of arithmetic when nested to the right\<close> 1396 1397lemma add_numeral_left [simp]: "numeral v + (numeral w + z) = (numeral(v + w) + z)" 1398 by (simp_all add: add.assoc [symmetric]) 1399 1400lemma add_neg_numeral_left [simp]: 1401 "numeral v + (- numeral w + y) = (sub v w + y)" 1402 "- numeral v + (numeral w + y) = (sub w v + y)" 1403 "- numeral v + (- numeral w + y) = (- numeral(v + w) + y)" 1404 by (simp_all add: add.assoc [symmetric]) 1405 1406lemma mult_numeral_left_semiring_numeral: 1407 "numeral v * (numeral w * z) = (numeral(v * w) * z :: 'a::semiring_numeral)" 1408 by (simp add: mult.assoc [symmetric]) 1409 1410lemma mult_numeral_left_ring_1: 1411 "- numeral v * (numeral w * y) = (- numeral(v * w) * y :: 'a::ring_1)" 1412 "numeral v * (- numeral w * y) = (- numeral(v * w) * y :: 'a::ring_1)" 1413 "- numeral v * (- numeral w * y) = (numeral(v * w) * y :: 'a::ring_1)" 1414 by (simp_all add: mult.assoc [symmetric]) 1415 1416lemmas mult_numeral_left [simp] = 1417 mult_numeral_left_semiring_numeral 1418 mult_numeral_left_ring_1 1419 1420hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec 1421 1422 1423subsection \<open>Code module namespace\<close> 1424 1425code_identifier 1426 code_module Num \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith 1427 1428subsection \<open>Printing of evaluated natural numbers as numerals\<close> 1429 1430lemma [code_post]: 1431 "Suc 0 = 1" 1432 "Suc 1 = 2" 1433 "Suc (numeral n) = numeral (Num.inc n)" 1434 by (simp_all add: numeral_inc) 1435 1436lemmas [code_post] = Num.inc.simps 1437 1438end 1439