src/HOL/Int.thy
author huffman
Sat, 03 Sep 2011 16:00:09 -0700
changeset 45566 075327b8e841
parent 44468 7ae4a23b5be6
child 45569 487ae6317f7b
permissions -rw-r--r--
remove duplicate lemma nat_zero in favor of nat_0
     1 (*  Title:      HOL/Int.thy
     2     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     3     Author:     Tobias Nipkow, Florian Haftmann, TU Muenchen
     4 *)
     5 
     6 header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
     7 
     8 theory Int
     9 imports Equiv_Relations Nat Wellfounded
    10 uses
    11   ("Tools/numeral.ML")
    12   ("Tools/numeral_syntax.ML")
    13   ("Tools/int_arith.ML")
    14 begin
    15 
    16 subsection {* The equivalence relation underlying the integers *}
    17 
    18 definition intrel :: "((nat \<times> nat) \<times> (nat \<times> nat)) set" where
    19   "intrel = {((x, y), (u, v)) | x y u v. x + v = u +y }"
    20 
    21 typedef (Integ)
    22   int = "UNIV//intrel"
    23   by (auto simp add: quotient_def)
    24 
    25 instantiation int :: "{zero, one, plus, minus, uminus, times, ord, abs, sgn}"
    26 begin
    27 
    28 definition
    29   Zero_int_def: "0 = Abs_Integ (intrel `` {(0, 0)})"
    30 
    31 definition
    32   One_int_def: "1 = Abs_Integ (intrel `` {(1, 0)})"
    33 
    34 definition
    35   add_int_def: "z + w = Abs_Integ
    36     (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u, v) \<in> Rep_Integ w.
    37       intrel `` {(x + u, y + v)})"
    38 
    39 definition
    40   minus_int_def:
    41     "- z = Abs_Integ (\<Union>(x, y) \<in> Rep_Integ z. intrel `` {(y, x)})"
    42 
    43 definition
    44   diff_int_def:  "z - w = z + (-w \<Colon> int)"
    45 
    46 definition
    47   mult_int_def: "z * w = Abs_Integ
    48     (\<Union>(x, y) \<in> Rep_Integ z. \<Union>(u,v ) \<in> Rep_Integ w.
    49       intrel `` {(x*u + y*v, x*v + y*u)})"
    50 
    51 definition
    52   le_int_def:
    53    "z \<le> w \<longleftrightarrow> (\<exists>x y u v. x+v \<le> u+y \<and> (x, y) \<in> Rep_Integ z \<and> (u, v) \<in> Rep_Integ w)"
    54 
    55 definition
    56   less_int_def: "(z\<Colon>int) < w \<longleftrightarrow> z \<le> w \<and> z \<noteq> w"
    57 
    58 definition
    59   zabs_def: "\<bar>i\<Colon>int\<bar> = (if i < 0 then - i else i)"
    60 
    61 definition
    62   zsgn_def: "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
    63 
    64 instance ..
    65 
    66 end
    67 
    68 
    69 subsection{*Construction of the Integers*}
    70 
    71 lemma intrel_iff [simp]: "(((x,y),(u,v)) \<in> intrel) = (x+v = u+y)"
    72 by (simp add: intrel_def)
    73 
    74 lemma equiv_intrel: "equiv UNIV intrel"
    75 by (simp add: intrel_def equiv_def refl_on_def sym_def trans_def)
    76 
    77 text{*Reduces equality of equivalence classes to the @{term intrel} relation:
    78   @{term "(intrel `` {x} = intrel `` {y}) = ((x,y) \<in> intrel)"} *}
    79 lemmas equiv_intrel_iff [simp] = eq_equiv_class_iff [OF equiv_intrel UNIV_I UNIV_I]
    80 
    81 text{*All equivalence classes belong to set of representatives*}
    82 lemma [simp]: "intrel``{(x,y)} \<in> Integ"
    83 by (auto simp add: Integ_def intrel_def quotient_def)
    84 
    85 text{*Reduces equality on abstractions to equality on representatives:
    86   @{prop "\<lbrakk>x \<in> Integ; y \<in> Integ\<rbrakk> \<Longrightarrow> (Abs_Integ x = Abs_Integ y) = (x=y)"} *}
    87 declare Abs_Integ_inject [simp,no_atp]  Abs_Integ_inverse [simp,no_atp]
    88 
    89 text{*Case analysis on the representation of an integer as an equivalence
    90       class of pairs of naturals.*}
    91 lemma eq_Abs_Integ [case_names Abs_Integ, cases type: int]:
    92      "(!!x y. z = Abs_Integ(intrel``{(x,y)}) ==> P) ==> P"
    93 apply (rule Abs_Integ_cases [of z]) 
    94 apply (auto simp add: Integ_def quotient_def) 
    95 done
    96 
    97 
    98 subsection {* Arithmetic Operations *}
    99 
   100 lemma minus: "- Abs_Integ(intrel``{(x,y)}) = Abs_Integ(intrel `` {(y,x)})"
   101 proof -
   102   have "(\<lambda>(x,y). intrel``{(y,x)}) respects intrel"
   103     by (auto simp add: congruent_def)
   104   thus ?thesis
   105     by (simp add: minus_int_def UN_equiv_class [OF equiv_intrel])
   106 qed
   107 
   108 lemma add:
   109      "Abs_Integ (intrel``{(x,y)}) + Abs_Integ (intrel``{(u,v)}) =
   110       Abs_Integ (intrel``{(x+u, y+v)})"
   111 proof -
   112   have "(\<lambda>z w. (\<lambda>(x,y). (\<lambda>(u,v). intrel `` {(x+u, y+v)}) w) z) 
   113         respects2 intrel"
   114     by (auto simp add: congruent2_def)
   115   thus ?thesis
   116     by (simp add: add_int_def UN_UN_split_split_eq
   117                   UN_equiv_class2 [OF equiv_intrel equiv_intrel])
   118 qed
   119 
   120 text{*Congruence property for multiplication*}
   121 lemma mult_congruent2:
   122      "(%p1 p2. (%(x,y). (%(u,v). intrel``{(x*u + y*v, x*v + y*u)}) p2) p1)
   123       respects2 intrel"
   124 apply (rule equiv_intrel [THEN congruent2_commuteI])
   125  apply (force simp add: mult_ac, clarify) 
   126 apply (simp add: congruent_def mult_ac)  
   127 apply (rename_tac u v w x y z)
   128 apply (subgoal_tac "u*y + x*y = w*y + v*y  &  u*z + x*z = w*z + v*z")
   129 apply (simp add: mult_ac)
   130 apply (simp add: add_mult_distrib [symmetric])
   131 done
   132 
   133 lemma mult:
   134      "Abs_Integ((intrel``{(x,y)})) * Abs_Integ((intrel``{(u,v)})) =
   135       Abs_Integ(intrel `` {(x*u + y*v, x*v + y*u)})"
   136 by (simp add: mult_int_def UN_UN_split_split_eq mult_congruent2
   137               UN_equiv_class2 [OF equiv_intrel equiv_intrel])
   138 
   139 text{*The integers form a @{text comm_ring_1}*}
   140 instance int :: comm_ring_1
   141 proof
   142   fix i j k :: int
   143   show "(i + j) + k = i + (j + k)"
   144     by (cases i, cases j, cases k) (simp add: add add_assoc)
   145   show "i + j = j + i" 
   146     by (cases i, cases j) (simp add: add_ac add)
   147   show "0 + i = i"
   148     by (cases i) (simp add: Zero_int_def add)
   149   show "- i + i = 0"
   150     by (cases i) (simp add: Zero_int_def minus add)
   151   show "i - j = i + - j"
   152     by (simp add: diff_int_def)
   153   show "(i * j) * k = i * (j * k)"
   154     by (cases i, cases j, cases k) (simp add: mult algebra_simps)
   155   show "i * j = j * i"
   156     by (cases i, cases j) (simp add: mult algebra_simps)
   157   show "1 * i = i"
   158     by (cases i) (simp add: One_int_def mult)
   159   show "(i + j) * k = i * k + j * k"
   160     by (cases i, cases j, cases k) (simp add: add mult algebra_simps)
   161   show "0 \<noteq> (1::int)"
   162     by (simp add: Zero_int_def One_int_def)
   163 qed
   164 
   165 lemma int_def: "of_nat m = Abs_Integ (intrel `` {(m, 0)})"
   166 by (induct m) (simp_all add: Zero_int_def One_int_def add)
   167 
   168 
   169 subsection {* The @{text "\<le>"} Ordering *}
   170 
   171 lemma le:
   172   "(Abs_Integ(intrel``{(x,y)}) \<le> Abs_Integ(intrel``{(u,v)})) = (x+v \<le> u+y)"
   173 by (force simp add: le_int_def)
   174 
   175 lemma less:
   176   "(Abs_Integ(intrel``{(x,y)}) < Abs_Integ(intrel``{(u,v)})) = (x+v < u+y)"
   177 by (simp add: less_int_def le order_less_le)
   178 
   179 instance int :: linorder
   180 proof
   181   fix i j k :: int
   182   show antisym: "i \<le> j \<Longrightarrow> j \<le> i \<Longrightarrow> i = j"
   183     by (cases i, cases j) (simp add: le)
   184   show "(i < j) = (i \<le> j \<and> \<not> j \<le> i)"
   185     by (auto simp add: less_int_def dest: antisym) 
   186   show "i \<le> i"
   187     by (cases i) (simp add: le)
   188   show "i \<le> j \<Longrightarrow> j \<le> k \<Longrightarrow> i \<le> k"
   189     by (cases i, cases j, cases k) (simp add: le)
   190   show "i \<le> j \<or> j \<le> i"
   191     by (cases i, cases j) (simp add: le linorder_linear)
   192 qed
   193 
   194 instantiation int :: distrib_lattice
   195 begin
   196 
   197 definition
   198   "(inf \<Colon> int \<Rightarrow> int \<Rightarrow> int) = min"
   199 
   200 definition
   201   "(sup \<Colon> int \<Rightarrow> int \<Rightarrow> int) = max"
   202 
   203 instance
   204   by intro_classes
   205     (auto simp add: inf_int_def sup_int_def min_max.sup_inf_distrib1)
   206 
   207 end
   208 
   209 instance int :: ordered_cancel_ab_semigroup_add
   210 proof
   211   fix i j k :: int
   212   show "i \<le> j \<Longrightarrow> k + i \<le> k + j"
   213     by (cases i, cases j, cases k) (simp add: le add)
   214 qed
   215 
   216 
   217 text{*Strict Monotonicity of Multiplication*}
   218 
   219 text{*strict, in 1st argument; proof is by induction on k>0*}
   220 lemma zmult_zless_mono2_lemma:
   221      "(i::int)<j ==> 0<k ==> of_nat k * i < of_nat k * j"
   222 apply (induct k)
   223 apply simp
   224 apply (simp add: left_distrib)
   225 apply (case_tac "k=0")
   226 apply (simp_all add: add_strict_mono)
   227 done
   228 
   229 lemma zero_le_imp_eq_int: "(0::int) \<le> k ==> \<exists>n. k = of_nat n"
   230 apply (cases k)
   231 apply (auto simp add: le add int_def Zero_int_def)
   232 apply (rule_tac x="x-y" in exI, simp)
   233 done
   234 
   235 lemma zero_less_imp_eq_int: "(0::int) < k ==> \<exists>n>0. k = of_nat n"
   236 apply (cases k)
   237 apply (simp add: less int_def Zero_int_def)
   238 apply (rule_tac x="x-y" in exI, simp)
   239 done
   240 
   241 lemma zmult_zless_mono2: "[| i<j;  (0::int) < k |] ==> k*i < k*j"
   242 apply (drule zero_less_imp_eq_int)
   243 apply (auto simp add: zmult_zless_mono2_lemma)
   244 done
   245 
   246 text{*The integers form an ordered integral domain*}
   247 instance int :: linordered_idom
   248 proof
   249   fix i j k :: int
   250   show "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
   251     by (rule zmult_zless_mono2)
   252   show "\<bar>i\<bar> = (if i < 0 then -i else i)"
   253     by (simp only: zabs_def)
   254   show "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
   255     by (simp only: zsgn_def)
   256 qed
   257 
   258 lemma zless_imp_add1_zle: "w < z \<Longrightarrow> w + (1\<Colon>int) \<le> z"
   259 apply (cases w, cases z) 
   260 apply (simp add: less le add One_int_def)
   261 done
   262 
   263 lemma zless_iff_Suc_zadd:
   264   "(w \<Colon> int) < z \<longleftrightarrow> (\<exists>n. z = w + of_nat (Suc n))"
   265 apply (cases z, cases w)
   266 apply (auto simp add: less add int_def)
   267 apply (rename_tac a b c d) 
   268 apply (rule_tac x="a+d - Suc(c+b)" in exI) 
   269 apply arith
   270 done
   271 
   272 lemmas int_distrib =
   273   left_distrib [of "z1::int" "z2" "w", standard]
   274   right_distrib [of "w::int" "z1" "z2", standard]
   275   left_diff_distrib [of "z1::int" "z2" "w", standard]
   276   right_diff_distrib [of "w::int" "z1" "z2", standard]
   277 
   278 
   279 subsection {* Embedding of the Integers into any @{text ring_1}: @{text of_int}*}
   280 
   281 context ring_1
   282 begin
   283 
   284 definition of_int :: "int \<Rightarrow> 'a" where
   285   "of_int z = the_elem (\<Union>(i, j) \<in> Rep_Integ z. { of_nat i - of_nat j })"
   286 
   287 lemma of_int: "of_int (Abs_Integ (intrel `` {(i,j)})) = of_nat i - of_nat j"
   288 proof -
   289   have "(\<lambda>(i,j). { of_nat i - (of_nat j :: 'a) }) respects intrel"
   290     by (auto simp add: congruent_def) (simp add: algebra_simps of_nat_add [symmetric]
   291             del: of_nat_add) 
   292   thus ?thesis
   293     by (simp add: of_int_def UN_equiv_class [OF equiv_intrel])
   294 qed
   295 
   296 lemma of_int_0 [simp]: "of_int 0 = 0"
   297 by (simp add: of_int Zero_int_def)
   298 
   299 lemma of_int_1 [simp]: "of_int 1 = 1"
   300 by (simp add: of_int One_int_def)
   301 
   302 lemma of_int_add [simp]: "of_int (w+z) = of_int w + of_int z"
   303 by (cases w, cases z) (simp add: algebra_simps of_int add)
   304 
   305 lemma of_int_minus [simp]: "of_int (-z) = - (of_int z)"
   306 by (cases z) (simp add: algebra_simps of_int minus)
   307 
   308 lemma of_int_diff [simp]: "of_int (w - z) = of_int w - of_int z"
   309 by (simp add: diff_minus Groups.diff_minus)
   310 
   311 lemma of_int_mult [simp]: "of_int (w*z) = of_int w * of_int z"
   312 apply (cases w, cases z)
   313 apply (simp add: algebra_simps of_int mult of_nat_mult)
   314 done
   315 
   316 text{*Collapse nested embeddings*}
   317 lemma of_int_of_nat_eq [simp]: "of_int (of_nat n) = of_nat n"
   318 by (induct n) auto
   319 
   320 lemma of_int_power:
   321   "of_int (z ^ n) = of_int z ^ n"
   322   by (induct n) simp_all
   323 
   324 end
   325 
   326 text{*Class for unital rings with characteristic zero.
   327  Includes non-ordered rings like the complex numbers.*}
   328 class ring_char_0 = ring_1 + semiring_char_0
   329 begin
   330 
   331 lemma of_int_eq_iff [simp]:
   332    "of_int w = of_int z \<longleftrightarrow> w = z"
   333 apply (cases w, cases z)
   334 apply (simp add: of_int)
   335 apply (simp only: diff_eq_eq diff_add_eq eq_diff_eq)
   336 apply (simp only: of_nat_add [symmetric] of_nat_eq_iff)
   337 done
   338 
   339 text{*Special cases where either operand is zero*}
   340 lemma of_int_eq_0_iff [simp]:
   341   "of_int z = 0 \<longleftrightarrow> z = 0"
   342   using of_int_eq_iff [of z 0] by simp
   343 
   344 lemma of_int_0_eq_iff [simp]:
   345   "0 = of_int z \<longleftrightarrow> z = 0"
   346   using of_int_eq_iff [of 0 z] by simp
   347 
   348 end
   349 
   350 context linordered_idom
   351 begin
   352 
   353 text{*Every @{text linordered_idom} has characteristic zero.*}
   354 subclass ring_char_0 ..
   355 
   356 lemma of_int_le_iff [simp]:
   357   "of_int w \<le> of_int z \<longleftrightarrow> w \<le> z"
   358   by (cases w, cases z)
   359     (simp add: of_int le minus algebra_simps of_nat_add [symmetric] del: of_nat_add)
   360 
   361 lemma of_int_less_iff [simp]:
   362   "of_int w < of_int z \<longleftrightarrow> w < z"
   363   by (simp add: less_le order_less_le)
   364 
   365 lemma of_int_0_le_iff [simp]:
   366   "0 \<le> of_int z \<longleftrightarrow> 0 \<le> z"
   367   using of_int_le_iff [of 0 z] by simp
   368 
   369 lemma of_int_le_0_iff [simp]:
   370   "of_int z \<le> 0 \<longleftrightarrow> z \<le> 0"
   371   using of_int_le_iff [of z 0] by simp
   372 
   373 lemma of_int_0_less_iff [simp]:
   374   "0 < of_int z \<longleftrightarrow> 0 < z"
   375   using of_int_less_iff [of 0 z] by simp
   376 
   377 lemma of_int_less_0_iff [simp]:
   378   "of_int z < 0 \<longleftrightarrow> z < 0"
   379   using of_int_less_iff [of z 0] by simp
   380 
   381 end
   382 
   383 lemma of_int_eq_id [simp]: "of_int = id"
   384 proof
   385   fix z show "of_int z = id z"
   386     by (cases z) (simp add: of_int add minus int_def diff_minus)
   387 qed
   388 
   389 
   390 subsection {* Magnitude of an Integer, as a Natural Number: @{text nat} *}
   391 
   392 definition nat :: "int \<Rightarrow> nat" where
   393   "nat z = the_elem (\<Union>(x, y) \<in> Rep_Integ z. {x-y})"
   394 
   395 lemma nat: "nat (Abs_Integ (intrel``{(x,y)})) = x-y"
   396 proof -
   397   have "(\<lambda>(x,y). {x-y}) respects intrel"
   398     by (auto simp add: congruent_def)
   399   thus ?thesis
   400     by (simp add: nat_def UN_equiv_class [OF equiv_intrel])
   401 qed
   402 
   403 lemma nat_int [simp]: "nat (of_nat n) = n"
   404 by (simp add: nat int_def)
   405 
   406 lemma int_nat_eq [simp]: "of_nat (nat z) = (if 0 \<le> z then z else 0)"
   407 by (cases z) (simp add: nat le int_def Zero_int_def)
   408 
   409 corollary nat_0_le: "0 \<le> z ==> of_nat (nat z) = z"
   410 by simp
   411 
   412 lemma nat_le_0 [simp]: "z \<le> 0 ==> nat z = 0"
   413 by (cases z) (simp add: nat le Zero_int_def)
   414 
   415 lemma nat_le_eq_zle: "0 < w | 0 \<le> z ==> (nat w \<le> nat z) = (w\<le>z)"
   416 apply (cases w, cases z) 
   417 apply (simp add: nat le linorder_not_le [symmetric] Zero_int_def, arith)
   418 done
   419 
   420 text{*An alternative condition is @{term "0 \<le> w"} *}
   421 corollary nat_mono_iff: "0 < z ==> (nat w < nat z) = (w < z)"
   422 by (simp add: nat_le_eq_zle linorder_not_le [symmetric]) 
   423 
   424 corollary nat_less_eq_zless: "0 \<le> w ==> (nat w < nat z) = (w<z)"
   425 by (simp add: nat_le_eq_zle linorder_not_le [symmetric]) 
   426 
   427 lemma zless_nat_conj [simp]: "(nat w < nat z) = (0 < z & w < z)"
   428 apply (cases w, cases z) 
   429 apply (simp add: nat le Zero_int_def linorder_not_le [symmetric], arith)
   430 done
   431 
   432 lemma nonneg_eq_int:
   433   fixes z :: int
   434   assumes "0 \<le> z" and "\<And>m. z = of_nat m \<Longrightarrow> P"
   435   shows P
   436   using assms by (blast dest: nat_0_le sym)
   437 
   438 lemma nat_eq_iff: "(nat w = m) = (if 0 \<le> w then w = of_nat m else m=0)"
   439 by (cases w) (simp add: nat le int_def Zero_int_def, arith)
   440 
   441 corollary nat_eq_iff2: "(m = nat w) = (if 0 \<le> w then w = of_nat m else m=0)"
   442 by (simp only: eq_commute [of m] nat_eq_iff)
   443 
   444 lemma nat_less_iff: "0 \<le> w ==> (nat w < m) = (w < of_nat m)"
   445 apply (cases w)
   446 apply (simp add: nat le int_def Zero_int_def linorder_not_le[symmetric], arith)
   447 done
   448 
   449 lemma nat_0_iff[simp]: "nat(i::int) = 0 \<longleftrightarrow> i\<le>0"
   450 by(simp add: nat_eq_iff) arith
   451 
   452 lemma int_eq_iff: "(of_nat m = z) = (m = nat z & 0 \<le> z)"
   453 by (auto simp add: nat_eq_iff2)
   454 
   455 lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
   456 by (insert zless_nat_conj [of 0], auto)
   457 
   458 lemma nat_add_distrib:
   459      "[| (0::int) \<le> z;  0 \<le> z' |] ==> nat (z+z') = nat z + nat z'"
   460 by (cases z, cases z') (simp add: nat add le Zero_int_def)
   461 
   462 lemma nat_diff_distrib:
   463      "[| (0::int) \<le> z';  z' \<le> z |] ==> nat (z-z') = nat z - nat z'"
   464 by (cases z, cases z')
   465   (simp add: nat add minus diff_minus le Zero_int_def)
   466 
   467 lemma nat_zminus_int [simp]: "nat (- (of_nat n)) = 0"
   468 by (simp add: int_def minus nat Zero_int_def) 
   469 
   470 lemma zless_nat_eq_int_zless: "(m < nat z) = (of_nat m < z)"
   471 by (cases z) (simp add: nat less int_def, arith)
   472 
   473 context ring_1
   474 begin
   475 
   476 lemma of_nat_nat: "0 \<le> z \<Longrightarrow> of_nat (nat z) = of_int z"
   477   by (cases z rule: eq_Abs_Integ)
   478    (simp add: nat le of_int Zero_int_def of_nat_diff)
   479 
   480 end
   481 
   482 text {* For termination proofs: *}
   483 lemma measure_function_int[measure_function]: "is_measure (nat o abs)" ..
   484 
   485 
   486 subsection{*Lemmas about the Function @{term of_nat} and Orderings*}
   487 
   488 lemma negative_zless_0: "- (of_nat (Suc n)) < (0 \<Colon> int)"
   489 by (simp add: order_less_le del: of_nat_Suc)
   490 
   491 lemma negative_zless [iff]: "- (of_nat (Suc n)) < (of_nat m \<Colon> int)"
   492 by (rule negative_zless_0 [THEN order_less_le_trans], simp)
   493 
   494 lemma negative_zle_0: "- of_nat n \<le> (0 \<Colon> int)"
   495 by (simp add: minus_le_iff)
   496 
   497 lemma negative_zle [iff]: "- of_nat n \<le> (of_nat m \<Colon> int)"
   498 by (rule order_trans [OF negative_zle_0 of_nat_0_le_iff])
   499 
   500 lemma not_zle_0_negative [simp]: "~ (0 \<le> - (of_nat (Suc n) \<Colon> int))"
   501 by (subst le_minus_iff, simp del: of_nat_Suc)
   502 
   503 lemma int_zle_neg: "((of_nat n \<Colon> int) \<le> - of_nat m) = (n = 0 & m = 0)"
   504 by (simp add: int_def le minus Zero_int_def)
   505 
   506 lemma not_int_zless_negative [simp]: "~ ((of_nat n \<Colon> int) < - of_nat m)"
   507 by (simp add: linorder_not_less)
   508 
   509 lemma negative_eq_positive [simp]: "((- of_nat n \<Colon> int) = of_nat m) = (n = 0 & m = 0)"
   510 by (force simp add: order_eq_iff [of "- of_nat n"] int_zle_neg)
   511 
   512 lemma zle_iff_zadd: "(w\<Colon>int) \<le> z \<longleftrightarrow> (\<exists>n. z = w + of_nat n)"
   513 proof -
   514   have "(w \<le> z) = (0 \<le> z - w)"
   515     by (simp only: le_diff_eq add_0_left)
   516   also have "\<dots> = (\<exists>n. z - w = of_nat n)"
   517     by (auto elim: zero_le_imp_eq_int)
   518   also have "\<dots> = (\<exists>n. z = w + of_nat n)"
   519     by (simp only: algebra_simps)
   520   finally show ?thesis .
   521 qed
   522 
   523 lemma zadd_int_left: "of_nat m + (of_nat n + z) = of_nat (m + n) + (z\<Colon>int)"
   524 by simp
   525 
   526 lemma int_Suc0_eq_1: "of_nat (Suc 0) = (1\<Colon>int)"
   527 by simp
   528 
   529 text{*This version is proved for all ordered rings, not just integers!
   530       It is proved here because attribute @{text arith_split} is not available
   531       in theory @{text Rings}.
   532       But is it really better than just rewriting with @{text abs_if}?*}
   533 lemma abs_split [arith_split,no_atp]:
   534      "P(abs(a::'a::linordered_idom)) = ((0 \<le> a --> P a) & (a < 0 --> P(-a)))"
   535 by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)
   536 
   537 lemma negD: "(x \<Colon> int) < 0 \<Longrightarrow> \<exists>n. x = - (of_nat (Suc n))"
   538 apply (cases x)
   539 apply (auto simp add: le minus Zero_int_def int_def order_less_le)
   540 apply (rule_tac x="y - Suc x" in exI, arith)
   541 done
   542 
   543 
   544 subsection {* Cases and induction *}
   545 
   546 text{*Now we replace the case analysis rule by a more conventional one:
   547 whether an integer is negative or not.*}
   548 
   549 theorem int_cases [case_names nonneg neg, cases type: int]:
   550   "[|!! n. (z \<Colon> int) = of_nat n ==> P;  !! n. z =  - (of_nat (Suc n)) ==> P |] ==> P"
   551 apply (cases "z < 0")
   552 apply (blast dest!: negD)
   553 apply (simp add: linorder_not_less del: of_nat_Suc)
   554 apply auto
   555 apply (blast dest: nat_0_le [THEN sym])
   556 done
   557 
   558 theorem int_of_nat_induct [case_names nonneg neg, induct type: int]:
   559      "[|!! n. P (of_nat n \<Colon> int);  !!n. P (- (of_nat (Suc n))) |] ==> P z"
   560   by (cases z) auto
   561 
   562 text{*Contributed by Brian Huffman*}
   563 theorem int_diff_cases:
   564   obtains (diff) m n where "(z\<Colon>int) = of_nat m - of_nat n"
   565 apply (cases z rule: eq_Abs_Integ)
   566 apply (rule_tac m=x and n=y in diff)
   567 apply (simp add: int_def minus add diff_minus)
   568 done
   569 
   570 
   571 subsection {* Binary representation *}
   572 
   573 text {*
   574   This formalization defines binary arithmetic in terms of the integers
   575   rather than using a datatype. This avoids multiple representations (leading
   576   zeroes, etc.)  See @{text "ZF/Tools/twos-compl.ML"}, function @{text
   577   int_of_binary}, for the numerical interpretation.
   578 
   579   The representation expects that @{text "(m mod 2)"} is 0 or 1,
   580   even if m is negative;
   581   For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
   582   @{text "-5 = (-3)*2 + 1"}.
   583   
   584   This two's complement binary representation derives from the paper 
   585   "An Efficient Representation of Arithmetic for Term Rewriting" by
   586   Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
   587   Springer LNCS 488 (240-251), 1991.
   588 *}
   589 
   590 subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
   591 
   592 definition Pls :: int where
   593   "Pls = 0"
   594 
   595 definition Min :: int where
   596   "Min = - 1"
   597 
   598 definition Bit0 :: "int \<Rightarrow> int" where
   599   "Bit0 k = k + k"
   600 
   601 definition Bit1 :: "int \<Rightarrow> int" where
   602   "Bit1 k = 1 + k + k"
   603 
   604 class number = -- {* for numeric types: nat, int, real, \dots *}
   605   fixes number_of :: "int \<Rightarrow> 'a"
   606 
   607 use "Tools/numeral.ML"
   608 
   609 syntax
   610   "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
   611 
   612 use "Tools/numeral_syntax.ML"
   613 setup Numeral_Syntax.setup
   614 
   615 abbreviation
   616   "Numeral0 \<equiv> number_of Pls"
   617 
   618 abbreviation
   619   "Numeral1 \<equiv> number_of (Bit1 Pls)"
   620 
   621 lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
   622   -- {* Unfold all @{text let}s involving constants *}
   623   unfolding Let_def ..
   624 
   625 definition succ :: "int \<Rightarrow> int" where
   626   "succ k = k + 1"
   627 
   628 definition pred :: "int \<Rightarrow> int" where
   629   "pred k = k - 1"
   630 
   631 lemmas
   632   max_number_of [simp] = max_def
   633     [of "number_of u" "number_of v", standard]
   634 and
   635   min_number_of [simp] = min_def 
   636     [of "number_of u" "number_of v", standard]
   637   -- {* unfolding @{text minx} and @{text max} on numerals *}
   638 
   639 lemmas numeral_simps = 
   640   succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
   641 
   642 text {* Removal of leading zeroes *}
   643 
   644 lemma Bit0_Pls [simp, code_post]:
   645   "Bit0 Pls = Pls"
   646   unfolding numeral_simps by simp
   647 
   648 lemma Bit1_Min [simp, code_post]:
   649   "Bit1 Min = Min"
   650   unfolding numeral_simps by simp
   651 
   652 lemmas normalize_bin_simps =
   653   Bit0_Pls Bit1_Min
   654 
   655 
   656 subsubsection {* Successor and predecessor functions *}
   657 
   658 text {* Successor *}
   659 
   660 lemma succ_Pls:
   661   "succ Pls = Bit1 Pls"
   662   unfolding numeral_simps by simp
   663 
   664 lemma succ_Min:
   665   "succ Min = Pls"
   666   unfolding numeral_simps by simp
   667 
   668 lemma succ_Bit0:
   669   "succ (Bit0 k) = Bit1 k"
   670   unfolding numeral_simps by simp
   671 
   672 lemma succ_Bit1:
   673   "succ (Bit1 k) = Bit0 (succ k)"
   674   unfolding numeral_simps by simp
   675 
   676 lemmas succ_bin_simps [simp] =
   677   succ_Pls succ_Min succ_Bit0 succ_Bit1
   678 
   679 text {* Predecessor *}
   680 
   681 lemma pred_Pls:
   682   "pred Pls = Min"
   683   unfolding numeral_simps by simp
   684 
   685 lemma pred_Min:
   686   "pred Min = Bit0 Min"
   687   unfolding numeral_simps by simp
   688 
   689 lemma pred_Bit0:
   690   "pred (Bit0 k) = Bit1 (pred k)"
   691   unfolding numeral_simps by simp 
   692 
   693 lemma pred_Bit1:
   694   "pred (Bit1 k) = Bit0 k"
   695   unfolding numeral_simps by simp
   696 
   697 lemmas pred_bin_simps [simp] =
   698   pred_Pls pred_Min pred_Bit0 pred_Bit1
   699 
   700 
   701 subsubsection {* Binary arithmetic *}
   702 
   703 text {* Addition *}
   704 
   705 lemma add_Pls:
   706   "Pls + k = k"
   707   unfolding numeral_simps by simp
   708 
   709 lemma add_Min:
   710   "Min + k = pred k"
   711   unfolding numeral_simps by simp
   712 
   713 lemma add_Bit0_Bit0:
   714   "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
   715   unfolding numeral_simps by simp
   716 
   717 lemma add_Bit0_Bit1:
   718   "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
   719   unfolding numeral_simps by simp
   720 
   721 lemma add_Bit1_Bit0:
   722   "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
   723   unfolding numeral_simps by simp
   724 
   725 lemma add_Bit1_Bit1:
   726   "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
   727   unfolding numeral_simps by simp
   728 
   729 lemma add_Pls_right:
   730   "k + Pls = k"
   731   unfolding numeral_simps by simp
   732 
   733 lemma add_Min_right:
   734   "k + Min = pred k"
   735   unfolding numeral_simps by simp
   736 
   737 lemmas add_bin_simps [simp] =
   738   add_Pls add_Min add_Pls_right add_Min_right
   739   add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
   740 
   741 text {* Negation *}
   742 
   743 lemma minus_Pls:
   744   "- Pls = Pls"
   745   unfolding numeral_simps by simp
   746 
   747 lemma minus_Min:
   748   "- Min = Bit1 Pls"
   749   unfolding numeral_simps by simp
   750 
   751 lemma minus_Bit0:
   752   "- (Bit0 k) = Bit0 (- k)"
   753   unfolding numeral_simps by simp
   754 
   755 lemma minus_Bit1:
   756   "- (Bit1 k) = Bit1 (pred (- k))"
   757   unfolding numeral_simps by simp
   758 
   759 lemmas minus_bin_simps [simp] =
   760   minus_Pls minus_Min minus_Bit0 minus_Bit1
   761 
   762 text {* Subtraction *}
   763 
   764 lemma diff_bin_simps [simp]:
   765   "k - Pls = k"
   766   "k - Min = succ k"
   767   "Pls - (Bit0 l) = Bit0 (Pls - l)"
   768   "Pls - (Bit1 l) = Bit1 (Min - l)"
   769   "Min - (Bit0 l) = Bit1 (Min - l)"
   770   "Min - (Bit1 l) = Bit0 (Min - l)"
   771   "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
   772   "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
   773   "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
   774   "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
   775   unfolding numeral_simps by simp_all
   776 
   777 text {* Multiplication *}
   778 
   779 lemma mult_Pls:
   780   "Pls * w = Pls"
   781   unfolding numeral_simps by simp
   782 
   783 lemma mult_Min:
   784   "Min * k = - k"
   785   unfolding numeral_simps by simp
   786 
   787 lemma mult_Bit0:
   788   "(Bit0 k) * l = Bit0 (k * l)"
   789   unfolding numeral_simps int_distrib by simp
   790 
   791 lemma mult_Bit1:
   792   "(Bit1 k) * l = (Bit0 (k * l)) + l"
   793   unfolding numeral_simps int_distrib by simp
   794 
   795 lemmas mult_bin_simps [simp] =
   796   mult_Pls mult_Min mult_Bit0 mult_Bit1
   797 
   798 
   799 subsubsection {* Binary comparisons *}
   800 
   801 text {* Preliminaries *}
   802 
   803 lemma even_less_0_iff:
   804   "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
   805 proof -
   806   have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
   807   also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
   808     by (simp add: mult_less_0_iff zero_less_two 
   809                   order_less_not_sym [OF zero_less_two])
   810   finally show ?thesis .
   811 qed
   812 
   813 lemma le_imp_0_less: 
   814   assumes le: "0 \<le> z"
   815   shows "(0::int) < 1 + z"
   816 proof -
   817   have "0 \<le> z" by fact
   818   also have "... < z + 1" by (rule less_add_one) 
   819   also have "... = 1 + z" by (simp add: add_ac)
   820   finally show "0 < 1 + z" .
   821 qed
   822 
   823 lemma odd_less_0_iff:
   824   "(1 + z + z < 0) = (z < (0::int))"
   825 proof (cases z)
   826   case (nonneg n)
   827   thus ?thesis by (simp add: linorder_not_less add_assoc add_increasing
   828                              le_imp_0_less [THEN order_less_imp_le])  
   829 next
   830   case (neg n)
   831   thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
   832     add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
   833 qed
   834 
   835 lemma bin_less_0_simps:
   836   "Pls < 0 \<longleftrightarrow> False"
   837   "Min < 0 \<longleftrightarrow> True"
   838   "Bit0 w < 0 \<longleftrightarrow> w < 0"
   839   "Bit1 w < 0 \<longleftrightarrow> w < 0"
   840   unfolding numeral_simps
   841   by (simp_all add: even_less_0_iff odd_less_0_iff)
   842 
   843 lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
   844   by simp
   845 
   846 lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
   847   unfolding numeral_simps
   848   proof
   849     have "k - 1 < k" by simp
   850     also assume "k \<le> l"
   851     finally show "k - 1 < l" .
   852   next
   853     assume "k - 1 < l"
   854     hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
   855     thus "k \<le> l" by simp
   856   qed
   857 
   858 lemma succ_pred: "succ (pred x) = x"
   859   unfolding numeral_simps by simp
   860 
   861 text {* Less-than *}
   862 
   863 lemma less_bin_simps [simp]:
   864   "Pls < Pls \<longleftrightarrow> False"
   865   "Pls < Min \<longleftrightarrow> False"
   866   "Pls < Bit0 k \<longleftrightarrow> Pls < k"
   867   "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
   868   "Min < Pls \<longleftrightarrow> True"
   869   "Min < Min \<longleftrightarrow> False"
   870   "Min < Bit0 k \<longleftrightarrow> Min < k"
   871   "Min < Bit1 k \<longleftrightarrow> Min < k"
   872   "Bit0 k < Pls \<longleftrightarrow> k < Pls"
   873   "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
   874   "Bit1 k < Pls \<longleftrightarrow> k < Pls"
   875   "Bit1 k < Min \<longleftrightarrow> k < Min"
   876   "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
   877   "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
   878   "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
   879   "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
   880   unfolding le_iff_pred_less
   881     less_bin_lemma [of Pls]
   882     less_bin_lemma [of Min]
   883     less_bin_lemma [of "k"]
   884     less_bin_lemma [of "Bit0 k"]
   885     less_bin_lemma [of "Bit1 k"]
   886     less_bin_lemma [of "pred Pls"]
   887     less_bin_lemma [of "pred k"]
   888   by (simp_all add: bin_less_0_simps succ_pred)
   889 
   890 text {* Less-than-or-equal *}
   891 
   892 lemma le_bin_simps [simp]:
   893   "Pls \<le> Pls \<longleftrightarrow> True"
   894   "Pls \<le> Min \<longleftrightarrow> False"
   895   "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
   896   "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
   897   "Min \<le> Pls \<longleftrightarrow> True"
   898   "Min \<le> Min \<longleftrightarrow> True"
   899   "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
   900   "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
   901   "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
   902   "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
   903   "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
   904   "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
   905   "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
   906   "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
   907   "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
   908   "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
   909   unfolding not_less [symmetric]
   910   by (simp_all add: not_le)
   911 
   912 text {* Equality *}
   913 
   914 lemma eq_bin_simps [simp]:
   915   "Pls = Pls \<longleftrightarrow> True"
   916   "Pls = Min \<longleftrightarrow> False"
   917   "Pls = Bit0 l \<longleftrightarrow> Pls = l"
   918   "Pls = Bit1 l \<longleftrightarrow> False"
   919   "Min = Pls \<longleftrightarrow> False"
   920   "Min = Min \<longleftrightarrow> True"
   921   "Min = Bit0 l \<longleftrightarrow> False"
   922   "Min = Bit1 l \<longleftrightarrow> Min = l"
   923   "Bit0 k = Pls \<longleftrightarrow> k = Pls"
   924   "Bit0 k = Min \<longleftrightarrow> False"
   925   "Bit1 k = Pls \<longleftrightarrow> False"
   926   "Bit1 k = Min \<longleftrightarrow> k = Min"
   927   "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
   928   "Bit0 k = Bit1 l \<longleftrightarrow> False"
   929   "Bit1 k = Bit0 l \<longleftrightarrow> False"
   930   "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
   931   unfolding order_eq_iff [where 'a=int]
   932   by (simp_all add: not_less)
   933 
   934 
   935 subsection {* Converting Numerals to Rings: @{term number_of} *}
   936 
   937 class number_ring = number + comm_ring_1 +
   938   assumes number_of_eq: "number_of k = of_int k"
   939 
   940 class number_semiring = number + comm_semiring_1 +
   941   assumes number_of_int: "number_of (of_nat n) = of_nat n"
   942 
   943 instance number_ring \<subseteq> number_semiring
   944 proof
   945   fix n show "number_of (of_nat n) = (of_nat n :: 'a)"
   946     unfolding number_of_eq by (rule of_int_of_nat_eq)
   947 qed
   948 
   949 text {* self-embedding of the integers *}
   950 
   951 instantiation int :: number_ring
   952 begin
   953 
   954 definition
   955   int_number_of_def: "number_of w = (of_int w \<Colon> int)"
   956 
   957 instance proof
   958 qed (simp only: int_number_of_def)
   959 
   960 end
   961 
   962 lemma number_of_is_id:
   963   "number_of (k::int) = k"
   964   unfolding int_number_of_def by simp
   965 
   966 lemma number_of_succ:
   967   "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
   968   unfolding number_of_eq numeral_simps by simp
   969 
   970 lemma number_of_pred:
   971   "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
   972   unfolding number_of_eq numeral_simps by simp
   973 
   974 lemma number_of_minus:
   975   "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
   976   unfolding number_of_eq by (rule of_int_minus)
   977 
   978 lemma number_of_add:
   979   "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
   980   unfolding number_of_eq by (rule of_int_add)
   981 
   982 lemma number_of_diff:
   983   "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
   984   unfolding number_of_eq by (rule of_int_diff)
   985 
   986 lemma number_of_mult:
   987   "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
   988   unfolding number_of_eq by (rule of_int_mult)
   989 
   990 text {*
   991   The correctness of shifting.
   992   But it doesn't seem to give a measurable speed-up.
   993 *}
   994 
   995 lemma double_number_of_Bit0:
   996   "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
   997   unfolding number_of_eq numeral_simps left_distrib by simp
   998 
   999 text {*
  1000   Converting numerals 0 and 1 to their abstract versions.
  1001 *}
  1002 
  1003 lemma semiring_numeral_0_eq_0:
  1004   "Numeral0 = (0::'a::number_semiring)"
  1005   using number_of_int [where 'a='a and n=0]
  1006   unfolding numeral_simps by simp
  1007 
  1008 lemma semiring_numeral_1_eq_1:
  1009   "Numeral1 = (1::'a::number_semiring)"
  1010   using number_of_int [where 'a='a and n=1]
  1011   unfolding numeral_simps by simp
  1012 
  1013 lemma numeral_0_eq_0 [simp, code_post]:
  1014   "Numeral0 = (0::'a::number_ring)"
  1015   by (rule semiring_numeral_0_eq_0)
  1016 
  1017 lemma numeral_1_eq_1 [simp, code_post]:
  1018   "Numeral1 = (1::'a::number_ring)"
  1019   by (rule semiring_numeral_1_eq_1)
  1020 
  1021 text {*
  1022   Special-case simplification for small constants.
  1023 *}
  1024 
  1025 text{*
  1026   Unary minus for the abstract constant 1. Cannot be inserted
  1027   as a simprule until later: it is @{text number_of_Min} re-oriented!
  1028 *}
  1029 
  1030 lemma numeral_m1_eq_minus_1:
  1031   "(-1::'a::number_ring) = - 1"
  1032   unfolding number_of_eq numeral_simps by simp
  1033 
  1034 lemma mult_minus1 [simp]:
  1035   "-1 * z = -(z::'a::number_ring)"
  1036   unfolding number_of_eq numeral_simps by simp
  1037 
  1038 lemma mult_minus1_right [simp]:
  1039   "z * -1 = -(z::'a::number_ring)"
  1040   unfolding number_of_eq numeral_simps by simp
  1041 
  1042 (*Negation of a coefficient*)
  1043 lemma minus_number_of_mult [simp]:
  1044    "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
  1045    unfolding number_of_eq by simp
  1046 
  1047 text {* Subtraction *}
  1048 
  1049 lemma diff_number_of_eq:
  1050   "number_of v - number_of w =
  1051     (number_of (v + uminus w)::'a::number_ring)"
  1052   unfolding number_of_eq by simp
  1053 
  1054 lemma number_of_Pls:
  1055   "number_of Pls = (0::'a::number_ring)"
  1056   unfolding number_of_eq numeral_simps by simp
  1057 
  1058 lemma number_of_Min:
  1059   "number_of Min = (- 1::'a::number_ring)"
  1060   unfolding number_of_eq numeral_simps by simp
  1061 
  1062 lemma number_of_Bit0:
  1063   "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
  1064   unfolding number_of_eq numeral_simps by simp
  1065 
  1066 lemma number_of_Bit1:
  1067   "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
  1068   unfolding number_of_eq numeral_simps by simp
  1069 
  1070 
  1071 subsubsection {* Equality of Binary Numbers *}
  1072 
  1073 text {* First version by Norbert Voelker *}
  1074 
  1075 definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
  1076   "iszero z \<longleftrightarrow> z = 0"
  1077 
  1078 lemma iszero_0: "iszero 0"
  1079   by (simp add: iszero_def)
  1080 
  1081 lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
  1082   by (simp add: iszero_0)
  1083 
  1084 lemma not_iszero_1: "\<not> iszero 1"
  1085   by (simp add: iszero_def)
  1086 
  1087 lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
  1088   by (simp add: not_iszero_1)
  1089 
  1090 lemma eq_number_of_eq [simp]:
  1091   "((number_of x::'a::number_ring) = number_of y) =
  1092      iszero (number_of (x + uminus y) :: 'a)"
  1093 unfolding iszero_def number_of_add number_of_minus
  1094 by (simp add: algebra_simps)
  1095 
  1096 lemma iszero_number_of_Pls:
  1097   "iszero ((number_of Pls)::'a::number_ring)"
  1098 unfolding iszero_def numeral_0_eq_0 ..
  1099 
  1100 lemma nonzero_number_of_Min:
  1101   "~ iszero ((number_of Min)::'a::number_ring)"
  1102 unfolding iszero_def numeral_m1_eq_minus_1 by simp
  1103 
  1104 
  1105 subsubsection {* Comparisons, for Ordered Rings *}
  1106 
  1107 lemmas double_eq_0_iff = double_zero
  1108 
  1109 lemma odd_nonzero:
  1110   "1 + z + z \<noteq> (0::int)"
  1111 proof (cases z)
  1112   case (nonneg n)
  1113   have le: "0 \<le> z+z" by (simp add: nonneg add_increasing) 
  1114   thus ?thesis using  le_imp_0_less [OF le]
  1115     by (auto simp add: add_assoc) 
  1116 next
  1117   case (neg n)
  1118   show ?thesis
  1119   proof
  1120     assume eq: "1 + z + z = 0"
  1121     have "(0::int) < 1 + (of_nat n + of_nat n)"
  1122       by (simp add: le_imp_0_less add_increasing) 
  1123     also have "... = - (1 + z + z)" 
  1124       by (simp add: neg add_assoc [symmetric]) 
  1125     also have "... = 0" by (simp add: eq) 
  1126     finally have "0<0" ..
  1127     thus False by blast
  1128   qed
  1129 qed
  1130 
  1131 lemma iszero_number_of_Bit0:
  1132   "iszero (number_of (Bit0 w)::'a) = 
  1133    iszero (number_of w::'a::{ring_char_0,number_ring})"
  1134 proof -
  1135   have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
  1136   proof -
  1137     assume eq: "of_int w + of_int w = (0::'a)"
  1138     then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
  1139     then have "w + w = 0" by (simp only: of_int_eq_iff)
  1140     then show "w = 0" by (simp only: double_eq_0_iff)
  1141   qed
  1142   thus ?thesis
  1143     by (auto simp add: iszero_def number_of_eq numeral_simps)
  1144 qed
  1145 
  1146 lemma iszero_number_of_Bit1:
  1147   "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
  1148 proof -
  1149   have "1 + of_int w + of_int w \<noteq> (0::'a)"
  1150   proof
  1151     assume eq: "1 + of_int w + of_int w = (0::'a)"
  1152     hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp 
  1153     hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
  1154     with odd_nonzero show False by blast
  1155   qed
  1156   thus ?thesis
  1157     by (auto simp add: iszero_def number_of_eq numeral_simps)
  1158 qed
  1159 
  1160 lemmas iszero_simps [simp] =
  1161   iszero_0 not_iszero_1
  1162   iszero_number_of_Pls nonzero_number_of_Min
  1163   iszero_number_of_Bit0 iszero_number_of_Bit1
  1164 (* iszero_number_of_Pls would never normally be used
  1165    because its lhs simplifies to "iszero 0" *)
  1166 
  1167 subsubsection {* The Less-Than Relation *}
  1168 
  1169 lemma double_less_0_iff:
  1170   "(a + a < 0) = (a < (0::'a::linordered_idom))"
  1171 proof -
  1172   have "(a + a < 0) = ((1+1)*a < 0)" by (simp add: left_distrib)
  1173   also have "... = (a < 0)"
  1174     by (simp add: mult_less_0_iff zero_less_two 
  1175                   order_less_not_sym [OF zero_less_two]) 
  1176   finally show ?thesis .
  1177 qed
  1178 
  1179 lemma odd_less_0:
  1180   "(1 + z + z < 0) = (z < (0::int))"
  1181 proof (cases z)
  1182   case (nonneg n)
  1183   then show ?thesis
  1184     by (simp add: linorder_not_less add_assoc add_increasing
  1185       le_imp_0_less [THEN order_less_imp_le])
  1186 next
  1187   case (neg n)
  1188   then show ?thesis
  1189     by (simp del: of_nat_Suc of_nat_add of_nat_1
  1190       add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
  1191 qed
  1192 
  1193 text {* Less-Than or Equals *}
  1194 
  1195 text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
  1196 
  1197 lemmas le_number_of_eq_not_less =
  1198   linorder_not_less [of "number_of w" "number_of v", symmetric, 
  1199   standard]
  1200 
  1201 
  1202 text {* Absolute value (@{term abs}) *}
  1203 
  1204 lemma abs_number_of:
  1205   "abs(number_of x::'a::{linordered_idom,number_ring}) =
  1206    (if number_of x < (0::'a) then -number_of x else number_of x)"
  1207   by (simp add: abs_if)
  1208 
  1209 
  1210 text {* Re-orientation of the equation nnn=x *}
  1211 
  1212 lemma number_of_reorient:
  1213   "(number_of w = x) = (x = number_of w)"
  1214   by auto
  1215 
  1216 
  1217 subsubsection {* Simplification of arithmetic operations on integer constants. *}
  1218 
  1219 lemmas arith_extra_simps [standard, simp] =
  1220   number_of_add [symmetric]
  1221   number_of_minus [symmetric]
  1222   numeral_m1_eq_minus_1 [symmetric]
  1223   number_of_mult [symmetric]
  1224   diff_number_of_eq abs_number_of 
  1225 
  1226 text {*
  1227   For making a minimal simpset, one must include these default simprules.
  1228   Also include @{text simp_thms}.
  1229 *}
  1230 
  1231 lemmas arith_simps = 
  1232   normalize_bin_simps pred_bin_simps succ_bin_simps
  1233   add_bin_simps minus_bin_simps mult_bin_simps
  1234   abs_zero abs_one arith_extra_simps
  1235 
  1236 text {* Simplification of relational operations *}
  1237 
  1238 lemma less_number_of [simp]:
  1239   "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
  1240   unfolding number_of_eq by (rule of_int_less_iff)
  1241 
  1242 lemma le_number_of [simp]:
  1243   "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
  1244   unfolding number_of_eq by (rule of_int_le_iff)
  1245 
  1246 lemma eq_number_of [simp]:
  1247   "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
  1248   unfolding number_of_eq by (rule of_int_eq_iff)
  1249 
  1250 lemmas rel_simps =
  1251   less_number_of less_bin_simps
  1252   le_number_of le_bin_simps
  1253   eq_number_of_eq eq_bin_simps
  1254   iszero_simps
  1255 
  1256 
  1257 subsubsection {* Simplification of arithmetic when nested to the right. *}
  1258 
  1259 lemma add_number_of_left [simp]:
  1260   "number_of v + (number_of w + z) =
  1261    (number_of(v + w) + z::'a::number_ring)"
  1262   by (simp add: add_assoc [symmetric])
  1263 
  1264 lemma mult_number_of_left [simp]:
  1265   "number_of v * (number_of w * z) =
  1266    (number_of(v * w) * z::'a::number_ring)"
  1267   by (simp add: mult_assoc [symmetric])
  1268 
  1269 lemma add_number_of_diff1:
  1270   "number_of v + (number_of w - c) = 
  1271   number_of(v + w) - (c::'a::number_ring)"
  1272   by (simp add: diff_minus)
  1273 
  1274 lemma add_number_of_diff2 [simp]:
  1275   "number_of v + (c - number_of w) =
  1276    number_of (v + uminus w) + (c::'a::number_ring)"
  1277 by (simp add: algebra_simps diff_number_of_eq [symmetric])
  1278 
  1279 
  1280 
  1281 
  1282 subsection {* The Set of Integers *}
  1283 
  1284 context ring_1
  1285 begin
  1286 
  1287 definition Ints  :: "'a set" where
  1288   "Ints = range of_int"
  1289 
  1290 notation (xsymbols)
  1291   Ints  ("\<int>")
  1292 
  1293 lemma Ints_of_int [simp]: "of_int z \<in> \<int>"
  1294   by (simp add: Ints_def)
  1295 
  1296 lemma Ints_of_nat [simp]: "of_nat n \<in> \<int>"
  1297 apply (simp add: Ints_def)
  1298 apply (rule range_eqI)
  1299 apply (rule of_int_of_nat_eq [symmetric])
  1300 done
  1301 
  1302 lemma Ints_0 [simp]: "0 \<in> \<int>"
  1303 apply (simp add: Ints_def)
  1304 apply (rule range_eqI)
  1305 apply (rule of_int_0 [symmetric])
  1306 done
  1307 
  1308 lemma Ints_1 [simp]: "1 \<in> \<int>"
  1309 apply (simp add: Ints_def)
  1310 apply (rule range_eqI)
  1311 apply (rule of_int_1 [symmetric])
  1312 done
  1313 
  1314 lemma Ints_add [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a + b \<in> \<int>"
  1315 apply (auto simp add: Ints_def)
  1316 apply (rule range_eqI)
  1317 apply (rule of_int_add [symmetric])
  1318 done
  1319 
  1320 lemma Ints_minus [simp]: "a \<in> \<int> \<Longrightarrow> -a \<in> \<int>"
  1321 apply (auto simp add: Ints_def)
  1322 apply (rule range_eqI)
  1323 apply (rule of_int_minus [symmetric])
  1324 done
  1325 
  1326 lemma Ints_diff [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a - b \<in> \<int>"
  1327 apply (auto simp add: Ints_def)
  1328 apply (rule range_eqI)
  1329 apply (rule of_int_diff [symmetric])
  1330 done
  1331 
  1332 lemma Ints_mult [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a * b \<in> \<int>"
  1333 apply (auto simp add: Ints_def)
  1334 apply (rule range_eqI)
  1335 apply (rule of_int_mult [symmetric])
  1336 done
  1337 
  1338 lemma Ints_power [simp]: "a \<in> \<int> \<Longrightarrow> a ^ n \<in> \<int>"
  1339 by (induct n) simp_all
  1340 
  1341 lemma Ints_cases [cases set: Ints]:
  1342   assumes "q \<in> \<int>"
  1343   obtains (of_int) z where "q = of_int z"
  1344   unfolding Ints_def
  1345 proof -
  1346   from `q \<in> \<int>` have "q \<in> range of_int" unfolding Ints_def .
  1347   then obtain z where "q = of_int z" ..
  1348   then show thesis ..
  1349 qed
  1350 
  1351 lemma Ints_induct [case_names of_int, induct set: Ints]:
  1352   "q \<in> \<int> \<Longrightarrow> (\<And>z. P (of_int z)) \<Longrightarrow> P q"
  1353   by (rule Ints_cases) auto
  1354 
  1355 end
  1356 
  1357 text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}
  1358 
  1359 lemma Ints_double_eq_0_iff:
  1360   assumes in_Ints: "a \<in> Ints"
  1361   shows "(a + a = 0) = (a = (0::'a::ring_char_0))"
  1362 proof -
  1363   from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  1364   then obtain z where a: "a = of_int z" ..
  1365   show ?thesis
  1366   proof
  1367     assume "a = 0"
  1368     thus "a + a = 0" by simp
  1369   next
  1370     assume eq: "a + a = 0"
  1371     hence "of_int (z + z) = (of_int 0 :: 'a)" by (simp add: a)
  1372     hence "z + z = 0" by (simp only: of_int_eq_iff)
  1373     hence "z = 0" by (simp only: double_eq_0_iff)
  1374     thus "a = 0" by (simp add: a)
  1375   qed
  1376 qed
  1377 
  1378 lemma Ints_odd_nonzero:
  1379   assumes in_Ints: "a \<in> Ints"
  1380   shows "1 + a + a \<noteq> (0::'a::ring_char_0)"
  1381 proof -
  1382   from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  1383   then obtain z where a: "a = of_int z" ..
  1384   show ?thesis
  1385   proof
  1386     assume eq: "1 + a + a = 0"
  1387     hence "of_int (1 + z + z) = (of_int 0 :: 'a)" by (simp add: a)
  1388     hence "1 + z + z = 0" by (simp only: of_int_eq_iff)
  1389     with odd_nonzero show False by blast
  1390   qed
  1391 qed 
  1392 
  1393 lemma Ints_number_of [simp]:
  1394   "(number_of w :: 'a::number_ring) \<in> Ints"
  1395   unfolding number_of_eq Ints_def by simp
  1396 
  1397 lemma Nats_number_of [simp]:
  1398   "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
  1399 unfolding Int.Pls_def number_of_eq
  1400 by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
  1401 
  1402 lemma Ints_odd_less_0: 
  1403   assumes in_Ints: "a \<in> Ints"
  1404   shows "(1 + a + a < 0) = (a < (0::'a::linordered_idom))"
  1405 proof -
  1406   from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  1407   then obtain z where a: "a = of_int z" ..
  1408   hence "((1::'a) + a + a < 0) = (of_int (1 + z + z) < (of_int 0 :: 'a))"
  1409     by (simp add: a)
  1410   also have "... = (z < 0)" by (simp only: of_int_less_iff odd_less_0)
  1411   also have "... = (a < 0)" by (simp add: a)
  1412   finally show ?thesis .
  1413 qed
  1414 
  1415 
  1416 subsection {* @{term setsum} and @{term setprod} *}
  1417 
  1418 lemma of_nat_setsum: "of_nat (setsum f A) = (\<Sum>x\<in>A. of_nat(f x))"
  1419   apply (cases "finite A")
  1420   apply (erule finite_induct, auto)
  1421   done
  1422 
  1423 lemma of_int_setsum: "of_int (setsum f A) = (\<Sum>x\<in>A. of_int(f x))"
  1424   apply (cases "finite A")
  1425   apply (erule finite_induct, auto)
  1426   done
  1427 
  1428 lemma of_nat_setprod: "of_nat (setprod f A) = (\<Prod>x\<in>A. of_nat(f x))"
  1429   apply (cases "finite A")
  1430   apply (erule finite_induct, auto simp add: of_nat_mult)
  1431   done
  1432 
  1433 lemma of_int_setprod: "of_int (setprod f A) = (\<Prod>x\<in>A. of_int(f x))"
  1434   apply (cases "finite A")
  1435   apply (erule finite_induct, auto)
  1436   done
  1437 
  1438 lemmas int_setsum = of_nat_setsum [where 'a=int]
  1439 lemmas int_setprod = of_nat_setprod [where 'a=int]
  1440 
  1441 
  1442 subsection{*Inequality Reasoning for the Arithmetic Simproc*}
  1443 
  1444 lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
  1445 by simp 
  1446 
  1447 lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
  1448 by simp
  1449 
  1450 lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
  1451 by simp 
  1452 
  1453 lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
  1454 by simp
  1455 
  1456 lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
  1457 by simp
  1458 
  1459 lemma inverse_numeral_1:
  1460   "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
  1461 by simp
  1462 
  1463 text{*Theorem lists for the cancellation simprocs. The use of binary numerals
  1464 for 0 and 1 reduces the number of special cases.*}
  1465 
  1466 lemmas add_0s = add_numeral_0 add_numeral_0_right
  1467 lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
  1468                  mult_minus1 mult_minus1_right
  1469 
  1470 
  1471 subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
  1472 
  1473 text{*Arithmetic computations are defined for binary literals, which leaves 0
  1474 and 1 as special cases. Addition already has rules for 0, but not 1.
  1475 Multiplication and unary minus already have rules for both 0 and 1.*}
  1476 
  1477 
  1478 lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
  1479 by simp
  1480 
  1481 
  1482 lemmas add_number_of_eq = number_of_add [symmetric]
  1483 
  1484 text{*Allow 1 on either or both sides*}
  1485 lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
  1486   using number_of_int [where 'a='a and n="Suc (Suc 0)"]
  1487   by (simp add: numeral_simps)
  1488 
  1489 lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
  1490 by (rule semiring_one_add_one_is_two)
  1491 
  1492 lemmas add_special =
  1493     one_add_one_is_two
  1494     binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl, standard]
  1495     binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1, standard]
  1496 
  1497 text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
  1498 lemmas diff_special =
  1499     binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl, standard]
  1500     binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1, standard]
  1501 
  1502 text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  1503 lemmas eq_special =
  1504     binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl, standard]
  1505     binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl, standard]
  1506     binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0, standard]
  1507     binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1, standard]
  1508 
  1509 text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  1510 lemmas less_special =
  1511   binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl, standard]
  1512   binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl, standard]
  1513   binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0, standard]
  1514   binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1, standard]
  1515 
  1516 text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  1517 lemmas le_special =
  1518     binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl, standard]
  1519     binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl, standard]
  1520     binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0, standard]
  1521     binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1, standard]
  1522 
  1523 lemmas arith_special[simp] = 
  1524        add_special diff_special eq_special less_special le_special
  1525 
  1526 
  1527 text {* Legacy theorems *}
  1528 
  1529 lemmas zle_int = of_nat_le_iff [where 'a=int]
  1530 lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
  1531 
  1532 subsection {* Setting up simplification procedures *}
  1533 
  1534 lemmas int_arith_rules =
  1535   neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
  1536   minus_zero diff_minus left_minus right_minus
  1537   mult_zero_left mult_zero_right mult_Bit1 mult_1_left mult_1_right
  1538   mult_minus_left mult_minus_right
  1539   minus_add_distrib minus_minus mult_assoc
  1540   of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
  1541   of_int_0 of_int_1 of_int_add of_int_mult
  1542 
  1543 use "Tools/int_arith.ML"
  1544 declaration {* K Int_Arith.setup *}
  1545 
  1546 simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
  1547   "(m::'a::{linordered_idom,number_ring}) <= n" |
  1548   "(m::'a::{linordered_idom,number_ring}) = n") =
  1549   {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
  1550 
  1551 setup {*
  1552   Reorient_Proc.add
  1553     (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
  1554 *}
  1555 
  1556 simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
  1557 
  1558 
  1559 subsection{*Lemmas About Small Numerals*}
  1560 
  1561 lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
  1562 proof -
  1563   have "(of_int -1 :: 'a) = of_int (- 1)" by simp
  1564   also have "... = - of_int 1" by (simp only: of_int_minus)
  1565   also have "... = -1" by simp
  1566   finally show ?thesis .
  1567 qed
  1568 
  1569 lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
  1570 by (simp add: abs_if)
  1571 
  1572 lemma abs_power_minus_one [simp]:
  1573   "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
  1574 by (simp add: power_abs)
  1575 
  1576 lemma of_int_number_of_eq [simp]:
  1577      "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  1578 by (simp add: number_of_eq) 
  1579 
  1580 text{*Lemmas for specialist use, NOT as default simprules*}
  1581 (* TODO: see if semiring duplication can be removed without breaking proofs *)
  1582 lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
  1583 unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
  1584 
  1585 lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
  1586 by (subst mult_commute, rule semiring_mult_2)
  1587 
  1588 lemma mult_2: "2 * z = (z+z::'a::number_ring)"
  1589 by (rule semiring_mult_2)
  1590 
  1591 lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
  1592 by (rule semiring_mult_2_right)
  1593 
  1594 
  1595 subsection{*More Inequality Reasoning*}
  1596 
  1597 lemma zless_add1_eq: "(w < z + (1::int)) = (w<z | w=z)"
  1598 by arith
  1599 
  1600 lemma add1_zle_eq: "(w + (1::int) \<le> z) = (w<z)"
  1601 by arith
  1602 
  1603 lemma zle_diff1_eq [simp]: "(w \<le> z - (1::int)) = (w<z)"
  1604 by arith
  1605 
  1606 lemma zle_add1_eq_le [simp]: "(w < z + (1::int)) = (w\<le>z)"
  1607 by arith
  1608 
  1609 lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
  1610 by arith
  1611 
  1612 
  1613 subsection{*The functions @{term nat} and @{term int}*}
  1614 
  1615 text{*Simplify the terms @{term "int 0"}, @{term "int(Suc 0)"} and
  1616   @{term "w + - z"}*}
  1617 declare Zero_int_def [symmetric, simp]
  1618 declare One_int_def [symmetric, simp]
  1619 
  1620 lemmas diff_int_def_symmetric = diff_int_def [symmetric, simp]
  1621 
  1622 lemma nat_0 [simp]: "nat 0 = 0"
  1623 by (simp add: nat_eq_iff)
  1624 
  1625 lemma nat_1: "nat 1 = Suc 0"
  1626 by (subst nat_eq_iff, simp)
  1627 
  1628 lemma nat_2: "nat 2 = Suc (Suc 0)"
  1629 by (subst nat_eq_iff, simp)
  1630 
  1631 lemma one_less_nat_eq [simp]: "(Suc 0 < nat z) = (1 < z)"
  1632 apply (insert zless_nat_conj [of 1 z])
  1633 apply (auto simp add: nat_1)
  1634 done
  1635 
  1636 text{*This simplifies expressions of the form @{term "int n = z"} where
  1637       z is an integer literal.*}
  1638 lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v", standard]
  1639 
  1640 lemma split_nat [arith_split]:
  1641   "P(nat(i::int)) = ((\<forall>n. i = of_nat n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
  1642   (is "?P = (?L & ?R)")
  1643 proof (cases "i < 0")
  1644   case True thus ?thesis by auto
  1645 next
  1646   case False
  1647   have "?P = ?L"
  1648   proof
  1649     assume ?P thus ?L using False by clarsimp
  1650   next
  1651     assume ?L thus ?P using False by simp
  1652   qed
  1653   with False show ?thesis by simp
  1654 qed
  1655 
  1656 context ring_1
  1657 begin
  1658 
  1659 lemma of_int_of_nat [nitpick_simp]:
  1660   "of_int k = (if k < 0 then - of_nat (nat (- k)) else of_nat (nat k))"
  1661 proof (cases "k < 0")
  1662   case True then have "0 \<le> - k" by simp
  1663   then have "of_nat (nat (- k)) = of_int (- k)" by (rule of_nat_nat)
  1664   with True show ?thesis by simp
  1665 next
  1666   case False then show ?thesis by (simp add: not_less of_nat_nat)
  1667 qed
  1668 
  1669 end
  1670 
  1671 lemma nat_mult_distrib:
  1672   fixes z z' :: int
  1673   assumes "0 \<le> z"
  1674   shows "nat (z * z') = nat z * nat z'"
  1675 proof (cases "0 \<le> z'")
  1676   case False with assms have "z * z' \<le> 0"
  1677     by (simp add: not_le mult_le_0_iff)
  1678   then have "nat (z * z') = 0" by simp
  1679   moreover from False have "nat z' = 0" by simp
  1680   ultimately show ?thesis by simp
  1681 next
  1682   case True with assms have ge_0: "z * z' \<ge> 0" by (simp add: zero_le_mult_iff)
  1683   show ?thesis
  1684     by (rule injD [of "of_nat :: nat \<Rightarrow> int", OF inj_of_nat])
  1685       (simp only: of_nat_mult of_nat_nat [OF True]
  1686          of_nat_nat [OF assms] of_nat_nat [OF ge_0], simp)
  1687 qed
  1688 
  1689 lemma nat_mult_distrib_neg: "z \<le> (0::int) ==> nat(z*z') = nat(-z) * nat(-z')"
  1690 apply (rule trans)
  1691 apply (rule_tac [2] nat_mult_distrib, auto)
  1692 done
  1693 
  1694 lemma nat_abs_mult_distrib: "nat (abs (w * z)) = nat (abs w) * nat (abs z)"
  1695 apply (cases "z=0 | w=0")
  1696 apply (auto simp add: abs_if nat_mult_distrib [symmetric] 
  1697                       nat_mult_distrib_neg [symmetric] mult_less_0_iff)
  1698 done
  1699 
  1700 
  1701 subsection "Induction principles for int"
  1702 
  1703 text{*Well-founded segments of the integers*}
  1704 
  1705 definition
  1706   int_ge_less_than  ::  "int => (int * int) set"
  1707 where
  1708   "int_ge_less_than d = {(z',z). d \<le> z' & z' < z}"
  1709 
  1710 theorem wf_int_ge_less_than: "wf (int_ge_less_than d)"
  1711 proof -
  1712   have "int_ge_less_than d \<subseteq> measure (%z. nat (z-d))"
  1713     by (auto simp add: int_ge_less_than_def)
  1714   thus ?thesis 
  1715     by (rule wf_subset [OF wf_measure]) 
  1716 qed
  1717 
  1718 text{*This variant looks odd, but is typical of the relations suggested
  1719 by RankFinder.*}
  1720 
  1721 definition
  1722   int_ge_less_than2 ::  "int => (int * int) set"
  1723 where
  1724   "int_ge_less_than2 d = {(z',z). d \<le> z & z' < z}"
  1725 
  1726 theorem wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
  1727 proof -
  1728   have "int_ge_less_than2 d \<subseteq> measure (%z. nat (1+z-d))" 
  1729     by (auto simp add: int_ge_less_than2_def)
  1730   thus ?thesis 
  1731     by (rule wf_subset [OF wf_measure]) 
  1732 qed
  1733 
  1734 abbreviation
  1735   int :: "nat \<Rightarrow> int"
  1736 where
  1737   "int \<equiv> of_nat"
  1738 
  1739 (* `set:int': dummy construction *)
  1740 theorem int_ge_induct [case_names base step, induct set: int]:
  1741   fixes i :: int
  1742   assumes ge: "k \<le> i" and
  1743     base: "P k" and
  1744     step: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
  1745   shows "P i"
  1746 proof -
  1747   { fix n
  1748     have "\<And>i::int. n = nat (i - k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i"
  1749     proof (induct n)
  1750       case 0
  1751       hence "i = k" by arith
  1752       thus "P i" using base by simp
  1753     next
  1754       case (Suc n)
  1755       then have "n = nat((i - 1) - k)" by arith
  1756       moreover
  1757       have ki1: "k \<le> i - 1" using Suc.prems by arith
  1758       ultimately
  1759       have "P (i - 1)" by (rule Suc.hyps)
  1760       from step [OF ki1 this] show ?case by simp
  1761     qed
  1762   }
  1763   with ge show ?thesis by fast
  1764 qed
  1765 
  1766 (* `set:int': dummy construction *)
  1767 theorem int_gr_induct [case_names base step, induct set: int]:
  1768   assumes gr: "k < (i::int)" and
  1769         base: "P(k+1)" and
  1770         step: "\<And>i. \<lbrakk>k < i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
  1771   shows "P i"
  1772 apply(rule int_ge_induct[of "k + 1"])
  1773   using gr apply arith
  1774  apply(rule base)
  1775 apply (rule step, simp+)
  1776 done
  1777 
  1778 theorem int_le_induct [consumes 1, case_names base step]:
  1779   assumes le: "i \<le> (k::int)" and
  1780         base: "P(k)" and
  1781         step: "\<And>i. \<lbrakk>i \<le> k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
  1782   shows "P i"
  1783 proof -
  1784   { fix n
  1785     have "\<And>i::int. n = nat(k-i) \<Longrightarrow> i \<le> k \<Longrightarrow> P i"
  1786     proof (induct n)
  1787       case 0
  1788       hence "i = k" by arith
  1789       thus "P i" using base by simp
  1790     next
  1791       case (Suc n)
  1792       hence "n = nat (k - (i + 1))" by arith
  1793       moreover
  1794       have ki1: "i + 1 \<le> k" using Suc.prems by arith
  1795       ultimately
  1796       have "P (i + 1)" by(rule Suc.hyps)
  1797       from step[OF ki1 this] show ?case by simp
  1798     qed
  1799   }
  1800   with le show ?thesis by fast
  1801 qed
  1802 
  1803 theorem int_less_induct [consumes 1, case_names base step]:
  1804   assumes less: "(i::int) < k" and
  1805         base: "P(k - 1)" and
  1806         step: "\<And>i. \<lbrakk>i < k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
  1807   shows "P i"
  1808 apply(rule int_le_induct[of _ "k - 1"])
  1809   using less apply arith
  1810  apply(rule base)
  1811 apply (rule step, simp+)
  1812 done
  1813 
  1814 theorem int_induct [case_names base step1 step2]:
  1815   fixes k :: int
  1816   assumes base: "P k"
  1817     and step1: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
  1818     and step2: "\<And>i. k \<ge> i \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
  1819   shows "P i"
  1820 proof -
  1821   have "i \<le> k \<or> i \<ge> k" by arith
  1822   then show ?thesis
  1823   proof
  1824     assume "i \<ge> k"
  1825     then show ?thesis using base
  1826       by (rule int_ge_induct) (fact step1)
  1827   next
  1828     assume "i \<le> k"
  1829     then show ?thesis using base
  1830       by (rule int_le_induct) (fact step2)
  1831   qed
  1832 qed
  1833 
  1834 subsection{*Intermediate value theorems*}
  1835 
  1836 lemma int_val_lemma:
  1837      "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->  
  1838       f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
  1839 unfolding One_nat_def
  1840 apply (induct n)
  1841 apply simp
  1842 apply (intro strip)
  1843 apply (erule impE, simp)
  1844 apply (erule_tac x = n in allE, simp)
  1845 apply (case_tac "k = f (Suc n)")
  1846 apply force
  1847 apply (erule impE)
  1848  apply (simp add: abs_if split add: split_if_asm)
  1849 apply (blast intro: le_SucI)
  1850 done
  1851 
  1852 lemmas nat0_intermed_int_val = int_val_lemma [rule_format (no_asm)]
  1853 
  1854 lemma nat_intermed_int_val:
  1855      "[| \<forall>i. m \<le> i & i < n --> abs(f(i + 1::nat) - f i) \<le> 1; m < n;  
  1856          f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
  1857 apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k 
  1858        in int_val_lemma)
  1859 unfolding One_nat_def
  1860 apply simp
  1861 apply (erule exE)
  1862 apply (rule_tac x = "i+m" in exI, arith)
  1863 done
  1864 
  1865 
  1866 subsection{*Products and 1, by T. M. Rasmussen*}
  1867 
  1868 lemma zabs_less_one_iff [simp]: "(\<bar>z\<bar> < 1) = (z = (0::int))"
  1869 by arith
  1870 
  1871 lemma abs_zmult_eq_1:
  1872   assumes mn: "\<bar>m * n\<bar> = 1"
  1873   shows "\<bar>m\<bar> = (1::int)"
  1874 proof -
  1875   have 0: "m \<noteq> 0 & n \<noteq> 0" using mn
  1876     by auto
  1877   have "~ (2 \<le> \<bar>m\<bar>)"
  1878   proof
  1879     assume "2 \<le> \<bar>m\<bar>"
  1880     hence "2*\<bar>n\<bar> \<le> \<bar>m\<bar>*\<bar>n\<bar>"
  1881       by (simp add: mult_mono 0) 
  1882     also have "... = \<bar>m*n\<bar>" 
  1883       by (simp add: abs_mult)
  1884     also have "... = 1"
  1885       by (simp add: mn)
  1886     finally have "2*\<bar>n\<bar> \<le> 1" .
  1887     thus "False" using 0
  1888       by auto
  1889   qed
  1890   thus ?thesis using 0
  1891     by auto
  1892 qed
  1893 
  1894 lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
  1895 by (insert abs_zmult_eq_1 [of m n], arith)
  1896 
  1897 lemma pos_zmult_eq_1_iff:
  1898   assumes "0 < (m::int)" shows "(m * n = 1) = (m = 1 & n = 1)"
  1899 proof -
  1900   from assms have "m * n = 1 ==> m = 1" by (auto dest: pos_zmult_eq_1_iff_lemma)
  1901   thus ?thesis by (auto dest: pos_zmult_eq_1_iff_lemma)
  1902 qed
  1903 
  1904 lemma zmult_eq_1_iff: "(m*n = (1::int)) = ((m = 1 & n = 1) | (m = -1 & n = -1))"
  1905 apply (rule iffI) 
  1906  apply (frule pos_zmult_eq_1_iff_lemma)
  1907  apply (simp add: mult_commute [of m]) 
  1908  apply (frule pos_zmult_eq_1_iff_lemma, auto) 
  1909 done
  1910 
  1911 lemma infinite_UNIV_int: "\<not> finite (UNIV::int set)"
  1912 proof
  1913   assume "finite (UNIV::int set)"
  1914   moreover have "inj (\<lambda>i\<Colon>int. 2 * i)"
  1915     by (rule injI) simp
  1916   ultimately have "surj (\<lambda>i\<Colon>int. 2 * i)"
  1917     by (rule finite_UNIV_inj_surj)
  1918   then obtain i :: int where "1 = 2 * i" by (rule surjE)
  1919   then show False by (simp add: pos_zmult_eq_1_iff)
  1920 qed
  1921 
  1922 
  1923 subsection {* Further theorems on numerals *}
  1924 
  1925 subsubsection{*Special Simplification for Constants*}
  1926 
  1927 text{*These distributive laws move literals inside sums and differences.*}
  1928 
  1929 lemmas left_distrib_number_of [simp] =
  1930   left_distrib [of _ _ "number_of v", standard]
  1931 
  1932 lemmas right_distrib_number_of [simp] =
  1933   right_distrib [of "number_of v", standard]
  1934 
  1935 lemmas left_diff_distrib_number_of [simp] =
  1936   left_diff_distrib [of _ _ "number_of v", standard]
  1937 
  1938 lemmas right_diff_distrib_number_of [simp] =
  1939   right_diff_distrib [of "number_of v", standard]
  1940 
  1941 text{*These are actually for fields, like real: but where else to put them?*}
  1942 
  1943 lemmas zero_less_divide_iff_number_of [simp, no_atp] =
  1944   zero_less_divide_iff [of "number_of w", standard]
  1945 
  1946 lemmas divide_less_0_iff_number_of [simp, no_atp] =
  1947   divide_less_0_iff [of "number_of w", standard]
  1948 
  1949 lemmas zero_le_divide_iff_number_of [simp, no_atp] =
  1950   zero_le_divide_iff [of "number_of w", standard]
  1951 
  1952 lemmas divide_le_0_iff_number_of [simp, no_atp] =
  1953   divide_le_0_iff [of "number_of w", standard]
  1954 
  1955 
  1956 text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
  1957   strange, but then other simprocs simplify the quotient.*}
  1958 
  1959 lemmas inverse_eq_divide_number_of [simp] =
  1960   inverse_eq_divide [of "number_of w", standard]
  1961 
  1962 text {*These laws simplify inequalities, moving unary minus from a term
  1963 into the literal.*}
  1964 
  1965 lemmas less_minus_iff_number_of [simp, no_atp] =
  1966   less_minus_iff [of "number_of v", standard]
  1967 
  1968 lemmas le_minus_iff_number_of [simp, no_atp] =
  1969   le_minus_iff [of "number_of v", standard]
  1970 
  1971 lemmas equation_minus_iff_number_of [simp, no_atp] =
  1972   equation_minus_iff [of "number_of v", standard]
  1973 
  1974 lemmas minus_less_iff_number_of [simp, no_atp] =
  1975   minus_less_iff [of _ "number_of v", standard]
  1976 
  1977 lemmas minus_le_iff_number_of [simp, no_atp] =
  1978   minus_le_iff [of _ "number_of v", standard]
  1979 
  1980 lemmas minus_equation_iff_number_of [simp, no_atp] =
  1981   minus_equation_iff [of _ "number_of v", standard]
  1982 
  1983 
  1984 text{*To Simplify Inequalities Where One Side is the Constant 1*}
  1985 
  1986 lemma less_minus_iff_1 [simp,no_atp]:
  1987   fixes b::"'b::{linordered_idom,number_ring}"
  1988   shows "(1 < - b) = (b < -1)"
  1989 by auto
  1990 
  1991 lemma le_minus_iff_1 [simp,no_atp]:
  1992   fixes b::"'b::{linordered_idom,number_ring}"
  1993   shows "(1 \<le> - b) = (b \<le> -1)"
  1994 by auto
  1995 
  1996 lemma equation_minus_iff_1 [simp,no_atp]:
  1997   fixes b::"'b::number_ring"
  1998   shows "(1 = - b) = (b = -1)"
  1999 by (subst equation_minus_iff, auto)
  2000 
  2001 lemma minus_less_iff_1 [simp,no_atp]:
  2002   fixes a::"'b::{linordered_idom,number_ring}"
  2003   shows "(- a < 1) = (-1 < a)"
  2004 by auto
  2005 
  2006 lemma minus_le_iff_1 [simp,no_atp]:
  2007   fixes a::"'b::{linordered_idom,number_ring}"
  2008   shows "(- a \<le> 1) = (-1 \<le> a)"
  2009 by auto
  2010 
  2011 lemma minus_equation_iff_1 [simp,no_atp]:
  2012   fixes a::"'b::number_ring"
  2013   shows "(- a = 1) = (a = -1)"
  2014 by (subst minus_equation_iff, auto)
  2015 
  2016 
  2017 text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
  2018 
  2019 lemmas mult_less_cancel_left_number_of [simp, no_atp] =
  2020   mult_less_cancel_left [of "number_of v", standard]
  2021 
  2022 lemmas mult_less_cancel_right_number_of [simp, no_atp] =
  2023   mult_less_cancel_right [of _ "number_of v", standard]
  2024 
  2025 lemmas mult_le_cancel_left_number_of [simp, no_atp] =
  2026   mult_le_cancel_left [of "number_of v", standard]
  2027 
  2028 lemmas mult_le_cancel_right_number_of [simp, no_atp] =
  2029   mult_le_cancel_right [of _ "number_of v", standard]
  2030 
  2031 
  2032 text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
  2033 
  2034 lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w", standard]
  2035 lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w", standard]
  2036 lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w", standard]
  2037 lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w", standard]
  2038 lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w", standard]
  2039 lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w", standard]
  2040 
  2041 
  2042 subsubsection{*Optional Simplification Rules Involving Constants*}
  2043 
  2044 text{*Simplify quotients that are compared with a literal constant.*}
  2045 
  2046 lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w", standard]
  2047 lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w", standard]
  2048 lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w", standard]
  2049 lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w", standard]
  2050 lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w", standard]
  2051 lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w", standard]
  2052 
  2053 
  2054 text{*Not good as automatic simprules because they cause case splits.*}
  2055 lemmas divide_const_simps =
  2056   le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
  2057   divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
  2058   le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
  2059 
  2060 text{*Division By @{text "-1"}*}
  2061 
  2062 lemma divide_minus1 [simp]:
  2063      "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
  2064 by simp
  2065 
  2066 lemma minus1_divide [simp]:
  2067      "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
  2068 by (simp add: divide_inverse)
  2069 
  2070 lemma half_gt_zero_iff:
  2071      "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
  2072 by auto
  2073 
  2074 lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2, standard]
  2075 
  2076 lemma divide_Numeral1:
  2077   "(x::'a::{field, number_ring}) / Numeral1 = x"
  2078   by simp
  2079 
  2080 lemma divide_Numeral0:
  2081   "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
  2082   by simp
  2083 
  2084 
  2085 subsection {* The divides relation *}
  2086 
  2087 lemma zdvd_antisym_nonneg:
  2088     "0 <= m ==> 0 <= n ==> m dvd n ==> n dvd m ==> m = (n::int)"
  2089   apply (simp add: dvd_def, auto)
  2090   apply (auto simp add: mult_assoc zero_le_mult_iff zmult_eq_1_iff)
  2091   done
  2092 
  2093 lemma zdvd_antisym_abs: assumes "(a::int) dvd b" and "b dvd a" 
  2094   shows "\<bar>a\<bar> = \<bar>b\<bar>"
  2095 proof cases
  2096   assume "a = 0" with assms show ?thesis by simp
  2097 next
  2098   assume "a \<noteq> 0"
  2099   from `a dvd b` obtain k where k:"b = a*k" unfolding dvd_def by blast 
  2100   from `b dvd a` obtain k' where k':"a = b*k'" unfolding dvd_def by blast 
  2101   from k k' have "a = a*k*k'" by simp
  2102   with mult_cancel_left1[where c="a" and b="k*k'"]
  2103   have kk':"k*k' = 1" using `a\<noteq>0` by (simp add: mult_assoc)
  2104   hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
  2105   thus ?thesis using k k' by auto
  2106 qed
  2107 
  2108 lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
  2109   apply (subgoal_tac "m = n + (m - n)")
  2110    apply (erule ssubst)
  2111    apply (blast intro: dvd_add, simp)
  2112   done
  2113 
  2114 lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
  2115 apply (rule iffI)
  2116  apply (erule_tac [2] dvd_add)
  2117  apply (subgoal_tac "n = (n + k * m) - k * m")
  2118   apply (erule ssubst)
  2119   apply (erule dvd_diff)
  2120   apply(simp_all)
  2121 done
  2122 
  2123 lemma dvd_imp_le_int:
  2124   fixes d i :: int
  2125   assumes "i \<noteq> 0" and "d dvd i"
  2126   shows "\<bar>d\<bar> \<le> \<bar>i\<bar>"
  2127 proof -
  2128   from `d dvd i` obtain k where "i = d * k" ..
  2129   with `i \<noteq> 0` have "k \<noteq> 0" by auto
  2130   then have "1 \<le> \<bar>k\<bar>" and "0 \<le> \<bar>d\<bar>" by auto
  2131   then have "\<bar>d\<bar> * 1 \<le> \<bar>d\<bar> * \<bar>k\<bar>" by (rule mult_left_mono)
  2132   with `i = d * k` show ?thesis by (simp add: abs_mult)
  2133 qed
  2134 
  2135 lemma zdvd_not_zless:
  2136   fixes m n :: int
  2137   assumes "0 < m" and "m < n"
  2138   shows "\<not> n dvd m"
  2139 proof
  2140   from assms have "0 < n" by auto
  2141   assume "n dvd m" then obtain k where k: "m = n * k" ..
  2142   with `0 < m` have "0 < n * k" by auto
  2143   with `0 < n` have "0 < k" by (simp add: zero_less_mult_iff)
  2144   with k `0 < n` `m < n` have "n * k < n * 1" by simp
  2145   with `0 < n` `0 < k` show False unfolding mult_less_cancel_left by auto
  2146 qed
  2147 
  2148 lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
  2149   shows "m dvd n"
  2150 proof-
  2151   from d obtain h where h: "k*n = k*m * h" unfolding dvd_def by blast
  2152   {assume "n \<noteq> m*h" hence "k* n \<noteq> k* (m*h)" using kz by simp
  2153     with h have False by (simp add: mult_assoc)}
  2154   hence "n = m * h" by blast
  2155   thus ?thesis by simp
  2156 qed
  2157 
  2158 theorem zdvd_int: "(x dvd y) = (int x dvd int y)"
  2159 proof -
  2160   have "\<And>k. int y = int x * k \<Longrightarrow> x dvd y"
  2161   proof -
  2162     fix k
  2163     assume A: "int y = int x * k"
  2164     then show "x dvd y"
  2165     proof (cases k)
  2166       case (nonneg n)
  2167       with A have "y = x * n" by (simp add: of_nat_mult [symmetric])
  2168       then show ?thesis ..
  2169     next
  2170       case (neg n)
  2171       with A have "int y = int x * (- int (Suc n))" by simp
  2172       also have "\<dots> = - (int x * int (Suc n))" by (simp only: mult_minus_right)
  2173       also have "\<dots> = - int (x * Suc n)" by (simp only: of_nat_mult [symmetric])
  2174       finally have "- int (x * Suc n) = int y" ..
  2175       then show ?thesis by (simp only: negative_eq_positive) auto
  2176     qed
  2177   qed
  2178   then show ?thesis by (auto elim!: dvdE simp only: dvd_triv_left of_nat_mult)
  2179 qed
  2180 
  2181 lemma zdvd1_eq[simp]: "(x::int) dvd 1 = (\<bar>x\<bar> = 1)"
  2182 proof
  2183   assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by simp
  2184   hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
  2185   hence "nat \<bar>x\<bar> = 1"  by simp
  2186   thus "\<bar>x\<bar> = 1" by (cases "x < 0") auto
  2187 next
  2188   assume "\<bar>x\<bar>=1"
  2189   then have "x = 1 \<or> x = -1" by auto
  2190   then show "x dvd 1" by (auto intro: dvdI)
  2191 qed
  2192 
  2193 lemma zdvd_mult_cancel1: 
  2194   assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
  2195 proof
  2196   assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m" 
  2197     by (cases "n >0") (auto simp add: minus_equation_iff)
  2198 next
  2199   assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
  2200   from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
  2201 qed
  2202 
  2203 lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
  2204   unfolding zdvd_int by (cases "z \<ge> 0") simp_all
  2205 
  2206 lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
  2207   unfolding zdvd_int by (cases "z \<ge> 0") simp_all
  2208 
  2209 lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
  2210   by (auto simp add: dvd_int_iff)
  2211 
  2212 lemma eq_nat_nat_iff:
  2213   "0 \<le> z \<Longrightarrow> 0 \<le> z' \<Longrightarrow> nat z = nat z' \<longleftrightarrow> z = z'"
  2214   by (auto elim!: nonneg_eq_int)
  2215 
  2216 lemma nat_power_eq:
  2217   "0 \<le> z \<Longrightarrow> nat (z ^ n) = nat z ^ n"
  2218   by (induct n) (simp_all add: nat_mult_distrib)
  2219 
  2220 lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
  2221   apply (cases n)
  2222   apply (auto simp add: dvd_int_iff)
  2223   apply (cases z)
  2224   apply (auto simp add: dvd_imp_le)
  2225   done
  2226 
  2227 lemma zdvd_period:
  2228   fixes a d :: int
  2229   assumes "a dvd d"
  2230   shows "a dvd (x + t) \<longleftrightarrow> a dvd ((x + c * d) + t)"
  2231 proof -
  2232   from assms obtain k where "d = a * k" by (rule dvdE)
  2233   show ?thesis
  2234   proof
  2235     assume "a dvd (x + t)"
  2236     then obtain l where "x + t = a * l" by (rule dvdE)
  2237     then have "x = a * l - t" by simp
  2238     with `d = a * k` show "a dvd x + c * d + t" by simp
  2239   next
  2240     assume "a dvd x + c * d + t"
  2241     then obtain l where "x + c * d + t = a * l" by (rule dvdE)
  2242     then have "x = a * l - c * d - t" by simp
  2243     with `d = a * k` show "a dvd (x + t)" by simp
  2244   qed
  2245 qed
  2246 
  2247 
  2248 subsection {* Configuration of the code generator *}
  2249 
  2250 code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
  2251 
  2252 lemmas pred_succ_numeral_code [code] =
  2253   pred_bin_simps succ_bin_simps
  2254 
  2255 lemmas plus_numeral_code [code] =
  2256   add_bin_simps
  2257   arith_extra_simps(1) [where 'a = int]
  2258 
  2259 lemmas minus_numeral_code [code] =
  2260   minus_bin_simps
  2261   arith_extra_simps(2) [where 'a = int]
  2262   arith_extra_simps(5) [where 'a = int]
  2263 
  2264 lemmas times_numeral_code [code] =
  2265   mult_bin_simps
  2266   arith_extra_simps(4) [where 'a = int]
  2267 
  2268 instantiation int :: equal
  2269 begin
  2270 
  2271 definition
  2272   "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
  2273 
  2274 instance by default (simp add: equal_int_def)
  2275 
  2276 end
  2277 
  2278 lemma eq_number_of_int_code [code]:
  2279   "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
  2280   unfolding equal_int_def number_of_is_id ..
  2281 
  2282 lemma eq_int_code [code]:
  2283   "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
  2284   "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
  2285   "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
  2286   "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
  2287   "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
  2288   "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
  2289   "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
  2290   "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
  2291   "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
  2292   "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
  2293   "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
  2294   "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
  2295   "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
  2296   "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
  2297   "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
  2298   "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
  2299   unfolding equal_eq by simp_all
  2300 
  2301 lemma eq_int_refl [code nbe]:
  2302   "HOL.equal (k::int) k \<longleftrightarrow> True"
  2303   by (rule equal_refl)
  2304 
  2305 lemma less_eq_number_of_int_code [code]:
  2306   "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
  2307   unfolding number_of_is_id ..
  2308 
  2309 lemma less_eq_int_code [code]:
  2310   "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
  2311   "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
  2312   "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
  2313   "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
  2314   "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
  2315   "Int.Min \<le> Int.Min \<longleftrightarrow> True"
  2316   "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
  2317   "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
  2318   "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
  2319   "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
  2320   "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
  2321   "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
  2322   "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
  2323   "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
  2324   "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
  2325   "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
  2326   by simp_all
  2327 
  2328 lemma less_number_of_int_code [code]:
  2329   "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
  2330   unfolding number_of_is_id ..
  2331 
  2332 lemma less_int_code [code]:
  2333   "Int.Pls < Int.Pls \<longleftrightarrow> False"
  2334   "Int.Pls < Int.Min \<longleftrightarrow> False"
  2335   "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
  2336   "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
  2337   "Int.Min < Int.Pls \<longleftrightarrow> True"
  2338   "Int.Min < Int.Min \<longleftrightarrow> False"
  2339   "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
  2340   "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
  2341   "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
  2342   "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
  2343   "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
  2344   "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
  2345   "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
  2346   "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
  2347   "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
  2348   "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
  2349   by simp_all
  2350 
  2351 definition
  2352   nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
  2353   "nat_aux i n = nat i + n"
  2354 
  2355 lemma [code]:
  2356   "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))"  -- {* tail recursive *}
  2357   by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
  2358     dest: zless_imp_add1_zle)
  2359 
  2360 lemma [code]: "nat i = nat_aux i 0"
  2361   by (simp add: nat_aux_def)
  2362 
  2363 hide_const (open) nat_aux
  2364 
  2365 lemma zero_is_num_zero [code, code_unfold_post]:
  2366   "(0\<Colon>int) = Numeral0" 
  2367   by simp
  2368 
  2369 lemma one_is_num_one [code, code_unfold_post]:
  2370   "(1\<Colon>int) = Numeral1" 
  2371   by simp
  2372 
  2373 code_modulename SML
  2374   Int Arith
  2375 
  2376 code_modulename OCaml
  2377   Int Arith
  2378 
  2379 code_modulename Haskell
  2380   Int Arith
  2381 
  2382 types_code
  2383   "int" ("int")
  2384 attach (term_of) {*
  2385 val term_of_int = HOLogic.mk_number HOLogic.intT;
  2386 *}
  2387 attach (test) {*
  2388 fun gen_int i =
  2389   let val j = one_of [~1, 1] * random_range 0 i
  2390   in (j, fn () => term_of_int j) end;
  2391 *}
  2392 
  2393 setup {*
  2394 let
  2395 
  2396 fun strip_number_of (@{term "Int.number_of :: int => int"} $ t) = t
  2397   | strip_number_of t = t;
  2398 
  2399 fun numeral_codegen thy mode defs dep module b t gr =
  2400   let val i = HOLogic.dest_numeral (strip_number_of t)
  2401   in
  2402     SOME (Codegen.str (string_of_int i),
  2403       snd (Codegen.invoke_tycodegen thy mode defs dep module false HOLogic.intT gr))
  2404   end handle TERM _ => NONE;
  2405 
  2406 in
  2407 
  2408 Codegen.add_codegen "numeral_codegen" numeral_codegen
  2409 
  2410 end
  2411 *}
  2412 
  2413 consts_code
  2414   "number_of :: int \<Rightarrow> int"    ("(_)")
  2415   "0 :: int"                   ("0")
  2416   "1 :: int"                   ("1")
  2417   "uminus :: int => int"       ("~")
  2418   "op + :: int => int => int"  ("(_ +/ _)")
  2419   "op * :: int => int => int"  ("(_ */ _)")
  2420   "op \<le> :: int => int => bool" ("(_ <=/ _)")
  2421   "op < :: int => int => bool" ("(_ </ _)")
  2422 
  2423 quickcheck_params [default_type = int]
  2424 
  2425 hide_const (open) Pls Min Bit0 Bit1 succ pred
  2426 
  2427 
  2428 subsection {* Legacy theorems *}
  2429 
  2430 lemmas zminus_zminus = minus_minus [of "z::int", standard]
  2431 lemmas zminus_0 = minus_zero [where 'a=int]
  2432 lemmas zminus_zadd_distrib = minus_add_distrib [of "z::int" "w", standard]
  2433 lemmas zadd_commute = add_commute [of "z::int" "w", standard]
  2434 lemmas zadd_assoc = add_assoc [of "z1::int" "z2" "z3", standard]
  2435 lemmas zadd_left_commute = add_left_commute [of "x::int" "y" "z", standard]
  2436 lemmas zadd_ac = zadd_assoc zadd_commute zadd_left_commute
  2437 lemmas zmult_ac = mult_ac
  2438 lemmas zadd_0 = add_0_left [of "z::int", standard]
  2439 lemmas zadd_0_right = add_0_right [of "z::int", standard]
  2440 lemmas zadd_zminus_inverse2 = left_minus [of "z::int", standard]
  2441 lemmas zmult_zminus = mult_minus_left [of "z::int" "w", standard]
  2442 lemmas zmult_commute = mult_commute [of "z::int" "w", standard]
  2443 lemmas zmult_assoc = mult_assoc [of "z1::int" "z2" "z3", standard]
  2444 lemmas zadd_zmult_distrib = left_distrib [of "z1::int" "z2" "w", standard]
  2445 lemmas zadd_zmult_distrib2 = right_distrib [of "w::int" "z1" "z2", standard]
  2446 lemmas zdiff_zmult_distrib = left_diff_distrib [of "z1::int" "z2" "w", standard]
  2447 lemmas zdiff_zmult_distrib2 = right_diff_distrib [of "w::int" "z1" "z2", standard]
  2448 
  2449 lemmas zmult_1 = mult_1_left [of "z::int", standard]
  2450 lemmas zmult_1_right = mult_1_right [of "z::int", standard]
  2451 
  2452 lemmas zle_refl = order_refl [of "w::int", standard]
  2453 lemmas zle_trans = order_trans [where 'a=int and x="i" and y="j" and z="k", standard]
  2454 lemmas zle_antisym = order_antisym [of "z::int" "w", standard]
  2455 lemmas zle_linear = linorder_linear [of "z::int" "w", standard]
  2456 lemmas zless_linear = linorder_less_linear [where 'a = int]
  2457 
  2458 lemmas zadd_left_mono = add_left_mono [of "i::int" "j" "k", standard]
  2459 lemmas zadd_strict_right_mono = add_strict_right_mono [of "i::int" "j" "k", standard]
  2460 lemmas zadd_zless_mono = add_less_le_mono [of "w'::int" "w" "z'" "z", standard]
  2461 
  2462 lemmas int_0_less_1 = zero_less_one [where 'a=int]
  2463 lemmas int_0_neq_1 = zero_neq_one [where 'a=int]
  2464 
  2465 lemmas inj_int = inj_of_nat [where 'a=int]
  2466 lemmas zadd_int = of_nat_add [where 'a=int, symmetric]
  2467 lemmas int_mult = of_nat_mult [where 'a=int]
  2468 lemmas zmult_int = of_nat_mult [where 'a=int, symmetric]
  2469 lemmas int_eq_0_conv = of_nat_eq_0_iff [where 'a=int and m="n", standard]
  2470 lemmas zless_int = of_nat_less_iff [where 'a=int]
  2471 lemmas int_less_0_conv = of_nat_less_0_iff [where 'a=int and m="k", standard]
  2472 lemmas zero_less_int_conv = of_nat_0_less_iff [where 'a=int]
  2473 lemmas zero_zle_int = of_nat_0_le_iff [where 'a=int]
  2474 lemmas int_le_0_conv = of_nat_le_0_iff [where 'a=int and m="n", standard]
  2475 lemmas int_0 = of_nat_0 [where 'a=int]
  2476 lemmas int_1 = of_nat_1 [where 'a=int]
  2477 lemmas int_Suc = of_nat_Suc [where 'a=int]
  2478 lemmas abs_int_eq = abs_of_nat [where 'a=int and n="m", standard]
  2479 lemmas of_int_int_eq = of_int_of_nat_eq [where 'a=int]
  2480 lemmas zdiff_int = of_nat_diff [where 'a=int, symmetric]
  2481 lemmas zless_le = less_int_def
  2482 lemmas int_eq_of_nat = TrueI
  2483 
  2484 lemma zpower_zadd_distrib:
  2485   "x ^ (y + z) = ((x ^ y) * (x ^ z)::int)"
  2486   by (rule power_add)
  2487 
  2488 lemma zero_less_zpower_abs_iff:
  2489   "(0 < abs x ^ n) \<longleftrightarrow> (x \<noteq> (0::int) | n = 0)"
  2490   by (rule zero_less_power_abs_iff)
  2491 
  2492 lemma zero_le_zpower_abs: "(0::int) \<le> abs x ^ n"
  2493   by (rule zero_le_power_abs)
  2494 
  2495 lemma zpower_zpower:
  2496   "(x ^ y) ^ z = (x ^ (y * z)::int)"
  2497   by (rule power_mult [symmetric])
  2498 
  2499 lemma int_power:
  2500   "int (m ^ n) = int m ^ n"
  2501   by (rule of_nat_power)
  2502 
  2503 lemmas zpower_int = int_power [symmetric]
  2504 
  2505 end