src/ZF/Arith.thy
author wenzelm
Tue Jul 31 19:40:22 2007 +0200 (2007-07-31)
changeset 24091 109f19a13872
parent 16417 9bc16273c2d4
child 24893 b8ef7afe3a6b
permissions -rw-r--r--
added Tools/lin_arith.ML;
paulson@9654
     1
(*  Title:      ZF/Arith.thy
clasohm@0
     2
    ID:         $Id$
clasohm@1478
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
clasohm@0
     4
    Copyright   1992  University of Cambridge
clasohm@0
     5
clasohm@0
     6
*)
clasohm@0
     7
paulson@13163
     8
(*"Difference" is subtraction of natural numbers.
paulson@13163
     9
  There are no negative numbers; we have
paulson@13163
    10
     m #- n = 0  iff  m<=n   and     m #- n = succ(k) iff m>n.
paulson@13163
    11
  Also, rec(m, 0, %z w.z) is pred(m).   
paulson@13163
    12
*)
paulson@13163
    13
paulson@13328
    14
header{*Arithmetic Operators and Their Definitions*} 
paulson@13328
    15
haftmann@16417
    16
theory Arith imports Univ begin
paulson@6070
    17
paulson@13328
    18
text{*Proofs about elementary arithmetic: addition, multiplication, etc.*}
paulson@13328
    19
paulson@9491
    20
constdefs
paulson@13163
    21
  pred   :: "i=>i"    (*inverse of succ*)
paulson@13361
    22
    "pred(y) == nat_case(0, %x. x, y)"
paulson@6070
    23
paulson@13163
    24
  natify :: "i=>i"    (*coerces non-nats to nats*)
paulson@9491
    25
    "natify == Vrecursor(%f a. if a = succ(pred(a)) then succ(f`pred(a))
paulson@9491
    26
                                                    else 0)"
paulson@6070
    27
clasohm@0
    28
consts
paulson@13163
    29
  raw_add  :: "[i,i]=>i"
paulson@13163
    30
  raw_diff  :: "[i,i]=>i"
paulson@13163
    31
  raw_mult  :: "[i,i]=>i"
paulson@9492
    32
paulson@9492
    33
primrec
paulson@9492
    34
  "raw_add (0, n) = n"
paulson@9492
    35
  "raw_add (succ(m), n) = succ(raw_add(m, n))"
clasohm@0
    36
paulson@6070
    37
primrec
paulson@13163
    38
  raw_diff_0:     "raw_diff(m, 0) = m"
paulson@13163
    39
  raw_diff_succ:  "raw_diff(m, succ(n)) =
paulson@13163
    40
                     nat_case(0, %x. x, raw_diff(m, n))"
paulson@9491
    41
paulson@9491
    42
primrec
paulson@9492
    43
  "raw_mult(0, n) = 0"
paulson@9492
    44
  "raw_mult(succ(m), n) = raw_add (n, raw_mult(m, n))"
paulson@13163
    45
paulson@9491
    46
constdefs
paulson@13163
    47
  add :: "[i,i]=>i"                    (infixl "#+" 65)
paulson@9492
    48
    "m #+ n == raw_add (natify(m), natify(n))"
paulson@9491
    49
paulson@13163
    50
  diff :: "[i,i]=>i"                    (infixl "#-" 65)
paulson@9492
    51
    "m #- n == raw_diff (natify(m), natify(n))"
clasohm@0
    52
paulson@13163
    53
  mult :: "[i,i]=>i"                    (infixl "#*" 70)
paulson@9492
    54
    "m #* n == raw_mult (natify(m), natify(n))"
paulson@9492
    55
paulson@13163
    56
  raw_div  :: "[i,i]=>i"
paulson@13163
    57
    "raw_div (m, n) ==
paulson@9492
    58
       transrec(m, %j f. if j<n | n=0 then 0 else succ(f`(j#-n)))"
paulson@9492
    59
paulson@13163
    60
  raw_mod  :: "[i,i]=>i"
paulson@13163
    61
    "raw_mod (m, n) ==
paulson@9492
    62
       transrec(m, %j f. if j<n | n=0 then j else f`(j#-n))"
paulson@9491
    63
paulson@13163
    64
  div  :: "[i,i]=>i"                    (infixl "div" 70)
paulson@9492
    65
    "m div n == raw_div (natify(m), natify(n))"
paulson@9491
    66
paulson@13163
    67
  mod  :: "[i,i]=>i"                    (infixl "mod" 70)
paulson@9492
    68
    "m mod n == raw_mod (natify(m), natify(n))"
paulson@9491
    69
wenzelm@12114
    70
syntax (xsymbols)
paulson@13163
    71
  "mult"      :: "[i,i] => i"               (infixr "#\<times>" 70)
wenzelm@9964
    72
wenzelm@9964
    73
syntax (HTML output)
paulson@13163
    74
  "mult"      :: "[i, i] => i"               (infixr "#\<times>" 70)
paulson@13163
    75
paulson@13163
    76
paulson@13163
    77
declare rec_type [simp]
paulson@13163
    78
        nat_0_le [simp]
paulson@13163
    79
paulson@13163
    80
paulson@14060
    81
lemma zero_lt_lemma: "[| 0<k; k \<in> nat |] ==> \<exists>j\<in>nat. k = succ(j)"
paulson@13163
    82
apply (erule rev_mp)
paulson@13163
    83
apply (induct_tac "k", auto)
paulson@13163
    84
done
paulson@13163
    85
paulson@14060
    86
(* [| 0 < k; k \<in> nat; !!j. [| j \<in> nat; k = succ(j) |] ==> Q |] ==> Q *)
paulson@13163
    87
lemmas zero_lt_natE = zero_lt_lemma [THEN bexE, standard]
paulson@13163
    88
paulson@13163
    89
paulson@13356
    90
subsection{*@{text natify}, the Coercion to @{term nat}*}
paulson@13163
    91
paulson@13163
    92
lemma pred_succ_eq [simp]: "pred(succ(y)) = y"
paulson@13163
    93
by (unfold pred_def, auto)
paulson@13163
    94
paulson@13163
    95
lemma natify_succ: "natify(succ(x)) = succ(natify(x))"
paulson@13163
    96
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
paulson@13163
    97
paulson@13163
    98
lemma natify_0 [simp]: "natify(0) = 0"
paulson@13163
    99
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
paulson@13163
   100
paulson@14060
   101
lemma natify_non_succ: "\<forall>z. x ~= succ(z) ==> natify(x) = 0"
paulson@13163
   102
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
paulson@13163
   103
paulson@14060
   104
lemma natify_in_nat [iff,TC]: "natify(x) \<in> nat"
paulson@13163
   105
apply (rule_tac a=x in eps_induct)
paulson@14060
   106
apply (case_tac "\<exists>z. x = succ(z)")
paulson@13163
   107
apply (auto simp add: natify_succ natify_non_succ)
paulson@13163
   108
done
paulson@13163
   109
paulson@14060
   110
lemma natify_ident [simp]: "n \<in> nat ==> natify(n) = n"
paulson@13163
   111
apply (induct_tac "n")
paulson@13163
   112
apply (auto simp add: natify_succ)
paulson@13163
   113
done
paulson@13163
   114
paulson@14060
   115
lemma natify_eqE: "[|natify(x) = y;  x \<in> nat|] ==> x=y"
paulson@13163
   116
by auto
paulson@13163
   117
paulson@13163
   118
paulson@13163
   119
(*** Collapsing rules: to remove natify from arithmetic expressions ***)
paulson@13163
   120
paulson@13163
   121
lemma natify_idem [simp]: "natify(natify(x)) = natify(x)"
paulson@13163
   122
by simp
paulson@13163
   123
paulson@13163
   124
(** Addition **)
paulson@13163
   125
paulson@13163
   126
lemma add_natify1 [simp]: "natify(m) #+ n = m #+ n"
paulson@13163
   127
by (simp add: add_def)
paulson@13163
   128
paulson@13163
   129
lemma add_natify2 [simp]: "m #+ natify(n) = m #+ n"
paulson@13163
   130
by (simp add: add_def)
paulson@13163
   131
paulson@13163
   132
(** Multiplication **)
paulson@13163
   133
paulson@13163
   134
lemma mult_natify1 [simp]: "natify(m) #* n = m #* n"
paulson@13163
   135
by (simp add: mult_def)
paulson@13163
   136
paulson@13163
   137
lemma mult_natify2 [simp]: "m #* natify(n) = m #* n"
paulson@13163
   138
by (simp add: mult_def)
paulson@13163
   139
paulson@13163
   140
(** Difference **)
paulson@13163
   141
paulson@13163
   142
lemma diff_natify1 [simp]: "natify(m) #- n = m #- n"
paulson@13163
   143
by (simp add: diff_def)
paulson@13163
   144
paulson@13163
   145
lemma diff_natify2 [simp]: "m #- natify(n) = m #- n"
paulson@13163
   146
by (simp add: diff_def)
paulson@13163
   147
paulson@13163
   148
(** Remainder **)
paulson@13163
   149
paulson@13163
   150
lemma mod_natify1 [simp]: "natify(m) mod n = m mod n"
paulson@13163
   151
by (simp add: mod_def)
paulson@13163
   152
paulson@13163
   153
lemma mod_natify2 [simp]: "m mod natify(n) = m mod n"
paulson@13163
   154
by (simp add: mod_def)
paulson@13163
   155
paulson@13163
   156
paulson@13163
   157
(** Quotient **)
paulson@13163
   158
paulson@13163
   159
lemma div_natify1 [simp]: "natify(m) div n = m div n"
paulson@13163
   160
by (simp add: div_def)
paulson@13163
   161
paulson@13163
   162
lemma div_natify2 [simp]: "m div natify(n) = m div n"
paulson@13163
   163
by (simp add: div_def)
paulson@13163
   164
paulson@13163
   165
paulson@13356
   166
subsection{*Typing rules*}
paulson@13163
   167
paulson@13163
   168
(** Addition **)
paulson@13163
   169
paulson@14060
   170
lemma raw_add_type: "[| m\<in>nat;  n\<in>nat |] ==> raw_add (m, n) \<in> nat"
paulson@13163
   171
by (induct_tac "m", auto)
paulson@13163
   172
paulson@14060
   173
lemma add_type [iff,TC]: "m #+ n \<in> nat"
paulson@13163
   174
by (simp add: add_def raw_add_type)
paulson@13163
   175
paulson@13163
   176
(** Multiplication **)
paulson@13163
   177
paulson@14060
   178
lemma raw_mult_type: "[| m\<in>nat;  n\<in>nat |] ==> raw_mult (m, n) \<in> nat"
paulson@13163
   179
apply (induct_tac "m")
paulson@13163
   180
apply (simp_all add: raw_add_type)
paulson@13163
   181
done
paulson@13163
   182
paulson@14060
   183
lemma mult_type [iff,TC]: "m #* n \<in> nat"
paulson@13163
   184
by (simp add: mult_def raw_mult_type)
paulson@13163
   185
paulson@13163
   186
paulson@13163
   187
(** Difference **)
paulson@13163
   188
paulson@14060
   189
lemma raw_diff_type: "[| m\<in>nat;  n\<in>nat |] ==> raw_diff (m, n) \<in> nat"
paulson@13173
   190
by (induct_tac "n", auto)
paulson@13163
   191
paulson@14060
   192
lemma diff_type [iff,TC]: "m #- n \<in> nat"
paulson@13163
   193
by (simp add: diff_def raw_diff_type)
paulson@13163
   194
paulson@13163
   195
lemma diff_0_eq_0 [simp]: "0 #- n = 0"
paulson@13163
   196
apply (unfold diff_def)
paulson@13163
   197
apply (rule natify_in_nat [THEN nat_induct], auto)
paulson@13163
   198
done
paulson@13163
   199
paulson@13163
   200
(*Must simplify BEFORE the induction: else we get a critical pair*)
paulson@13163
   201
lemma diff_succ_succ [simp]: "succ(m) #- succ(n) = m #- n"
paulson@13163
   202
apply (simp add: natify_succ diff_def)
paulson@13784
   203
apply (rule_tac x1 = n in natify_in_nat [THEN nat_induct], auto)
paulson@13163
   204
done
paulson@13163
   205
paulson@13163
   206
(*This defining property is no longer wanted*)
paulson@13163
   207
declare raw_diff_succ [simp del]
paulson@13163
   208
paulson@13163
   209
(*Natify has weakened this law, compared with the older approach*)
paulson@13163
   210
lemma diff_0 [simp]: "m #- 0 = natify(m)"
paulson@13163
   211
by (simp add: diff_def)
paulson@13163
   212
paulson@14060
   213
lemma diff_le_self: "m\<in>nat ==> (m #- n) le m"
paulson@13163
   214
apply (subgoal_tac " (m #- natify (n)) le m")
paulson@13784
   215
apply (rule_tac [2] m = m and n = "natify (n) " in diff_induct)
paulson@13163
   216
apply (erule_tac [6] leE)
paulson@13163
   217
apply (simp_all add: le_iff)
paulson@13163
   218
done
paulson@13163
   219
paulson@13163
   220
paulson@13356
   221
subsection{*Addition*}
paulson@13163
   222
paulson@13163
   223
(*Natify has weakened this law, compared with the older approach*)
paulson@13163
   224
lemma add_0_natify [simp]: "0 #+ m = natify(m)"
paulson@13163
   225
by (simp add: add_def)
paulson@13163
   226
paulson@13163
   227
lemma add_succ [simp]: "succ(m) #+ n = succ(m #+ n)"
paulson@13163
   228
by (simp add: natify_succ add_def)
paulson@13163
   229
paulson@14060
   230
lemma add_0: "m \<in> nat ==> 0 #+ m = m"
paulson@13163
   231
by simp
paulson@13163
   232
paulson@13163
   233
(*Associative law for addition*)
paulson@13163
   234
lemma add_assoc: "(m #+ n) #+ k = m #+ (n #+ k)"
paulson@13163
   235
apply (subgoal_tac "(natify(m) #+ natify(n)) #+ natify(k) =
paulson@13163
   236
                    natify(m) #+ (natify(n) #+ natify(k))")
paulson@13163
   237
apply (rule_tac [2] n = "natify(m)" in nat_induct)
paulson@13163
   238
apply auto
paulson@13163
   239
done
paulson@13163
   240
paulson@13163
   241
(*The following two lemmas are used for add_commute and sometimes
paulson@13163
   242
  elsewhere, since they are safe for rewriting.*)
paulson@13163
   243
lemma add_0_right_natify [simp]: "m #+ 0 = natify(m)"
paulson@13163
   244
apply (subgoal_tac "natify(m) #+ 0 = natify(m)")
paulson@13163
   245
apply (rule_tac [2] n = "natify(m)" in nat_induct)
paulson@13163
   246
apply auto
paulson@13163
   247
done
paulson@13163
   248
paulson@13163
   249
lemma add_succ_right [simp]: "m #+ succ(n) = succ(m #+ n)"
paulson@13163
   250
apply (unfold add_def)
paulson@13163
   251
apply (rule_tac n = "natify(m) " in nat_induct)
paulson@13163
   252
apply (auto simp add: natify_succ)
paulson@13163
   253
done
paulson@13163
   254
paulson@14060
   255
lemma add_0_right: "m \<in> nat ==> m #+ 0 = m"
paulson@13163
   256
by auto
paulson@13163
   257
paulson@13163
   258
(*Commutative law for addition*)
paulson@13163
   259
lemma add_commute: "m #+ n = n #+ m"
paulson@13163
   260
apply (subgoal_tac "natify(m) #+ natify(n) = natify(n) #+ natify(m) ")
paulson@13163
   261
apply (rule_tac [2] n = "natify(m) " in nat_induct)
paulson@13163
   262
apply auto
paulson@13163
   263
done
paulson@13163
   264
paulson@13163
   265
(*for a/c rewriting*)
paulson@13163
   266
lemma add_left_commute: "m#+(n#+k)=n#+(m#+k)"
paulson@13163
   267
apply (rule add_commute [THEN trans])
paulson@13163
   268
apply (rule add_assoc [THEN trans])
paulson@13163
   269
apply (rule add_commute [THEN subst_context])
paulson@13163
   270
done
paulson@13163
   271
paulson@13163
   272
(*Addition is an AC-operator*)
paulson@13163
   273
lemmas add_ac = add_assoc add_commute add_left_commute
paulson@13163
   274
paulson@13163
   275
(*Cancellation law on the left*)
paulson@13163
   276
lemma raw_add_left_cancel:
paulson@14060
   277
     "[| raw_add(k, m) = raw_add(k, n);  k\<in>nat |] ==> m=n"
paulson@13163
   278
apply (erule rev_mp)
paulson@13163
   279
apply (induct_tac "k", auto)
paulson@13163
   280
done
paulson@13163
   281
paulson@13163
   282
lemma add_left_cancel_natify: "k #+ m = k #+ n ==> natify(m) = natify(n)"
paulson@13163
   283
apply (unfold add_def)
paulson@13163
   284
apply (drule raw_add_left_cancel, auto)
paulson@13163
   285
done
paulson@13163
   286
paulson@13163
   287
lemma add_left_cancel:
paulson@14060
   288
     "[| i = j;  i #+ m = j #+ n;  m\<in>nat;  n\<in>nat |] ==> m = n"
paulson@13163
   289
by (force dest!: add_left_cancel_natify)
paulson@13163
   290
paulson@13163
   291
(*Thanks to Sten Agerholm*)
paulson@13163
   292
lemma add_le_elim1_natify: "k#+m le k#+n ==> natify(m) le natify(n)"
paulson@13163
   293
apply (rule_tac P = "natify(k) #+m le natify(k) #+n" in rev_mp)
paulson@13163
   294
apply (rule_tac [2] n = "natify(k) " in nat_induct)
paulson@13163
   295
apply auto
paulson@13163
   296
done
paulson@13163
   297
paulson@14060
   298
lemma add_le_elim1: "[| k#+m le k#+n; m \<in> nat; n \<in> nat |] ==> m le n"
paulson@13163
   299
by (drule add_le_elim1_natify, auto)
paulson@13163
   300
paulson@13163
   301
lemma add_lt_elim1_natify: "k#+m < k#+n ==> natify(m) < natify(n)"
paulson@13163
   302
apply (rule_tac P = "natify(k) #+m < natify(k) #+n" in rev_mp)
paulson@13163
   303
apply (rule_tac [2] n = "natify(k) " in nat_induct)
paulson@13163
   304
apply auto
paulson@13163
   305
done
paulson@13163
   306
paulson@14060
   307
lemma add_lt_elim1: "[| k#+m < k#+n; m \<in> nat; n \<in> nat |] ==> m < n"
paulson@13163
   308
by (drule add_lt_elim1_natify, auto)
paulson@13163
   309
paulson@15201
   310
lemma zero_less_add: "[| n \<in> nat; m \<in> nat |] ==> 0 < m #+ n <-> (0<m | 0<n)"
paulson@15201
   311
by (induct_tac "n", auto)
paulson@15201
   312
paulson@13163
   313
paulson@13356
   314
subsection{*Monotonicity of Addition*}
paulson@13163
   315
paulson@13163
   316
(*strict, in 1st argument; proof is by rule induction on 'less than'.
paulson@14060
   317
  Still need j\<in>nat, for consider j = omega.  Then we can have i<omega,
paulson@14060
   318
  which is the same as i\<in>nat, but natify(j)=0, so the conclusion fails.*)
paulson@14060
   319
lemma add_lt_mono1: "[| i<j; j\<in>nat |] ==> i#+k < j#+k"
paulson@13163
   320
apply (frule lt_nat_in_nat, assumption)
paulson@13163
   321
apply (erule succ_lt_induct)
paulson@13163
   322
apply (simp_all add: leI)
paulson@13163
   323
done
paulson@13163
   324
paulson@14060
   325
text{*strict, in second argument*}
paulson@14060
   326
lemma add_lt_mono2: "[| i<j; j\<in>nat |] ==> k#+i < k#+j"
paulson@14060
   327
by (simp add: add_commute [of k] add_lt_mono1)
paulson@13163
   328
paulson@14060
   329
text{*A [clumsy] way of lifting < monotonicity to @{text "\<le>"} monotonicity*}
paulson@13163
   330
lemma Ord_lt_mono_imp_le_mono:
paulson@13163
   331
  assumes lt_mono: "!!i j. [| i<j; j:k |] ==> f(i) < f(j)"
paulson@13163
   332
      and ford:    "!!i. i:k ==> Ord(f(i))"
paulson@13163
   333
      and leij:    "i le j"
paulson@13163
   334
      and jink:    "j:k"
paulson@13163
   335
  shows "f(i) le f(j)"
paulson@13163
   336
apply (insert leij jink) 
paulson@13163
   337
apply (blast intro!: leCI lt_mono ford elim!: leE)
paulson@13163
   338
done
paulson@13163
   339
paulson@14060
   340
text{*@{text "\<le>"} monotonicity, 1st argument*}
paulson@14060
   341
lemma add_le_mono1: "[| i le j; j\<in>nat |] ==> i#+k le j#+k"
paulson@13163
   342
apply (rule_tac f = "%j. j#+k" in Ord_lt_mono_imp_le_mono, typecheck) 
paulson@13163
   343
apply (blast intro: add_lt_mono1 add_type [THEN nat_into_Ord])+
paulson@13163
   344
done
paulson@13163
   345
paulson@14060
   346
text{*@{text "\<le>"} monotonicity, both arguments*}
paulson@14060
   347
lemma add_le_mono: "[| i le j; k le l; j\<in>nat; l\<in>nat |] ==> i#+k le j#+l"
paulson@13163
   348
apply (rule add_le_mono1 [THEN le_trans], assumption+)
paulson@13163
   349
apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
paulson@13163
   350
done
paulson@13163
   351
paulson@14060
   352
text{*Combinations of less-than and less-than-or-equals*}
paulson@14060
   353
paulson@14060
   354
lemma add_lt_le_mono: "[| i<j; k\<le>l; j\<in>nat; l\<in>nat |] ==> i#+k < j#+l"
paulson@14060
   355
apply (rule add_lt_mono1 [THEN lt_trans2], assumption+)
paulson@14060
   356
apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
paulson@14060
   357
done
paulson@14060
   358
paulson@14060
   359
lemma add_le_lt_mono: "[| i\<le>j; k<l; j\<in>nat; l\<in>nat |] ==> i#+k < j#+l"
paulson@14060
   360
by (subst add_commute, subst add_commute, erule add_lt_le_mono, assumption+)
paulson@14060
   361
paulson@14060
   362
text{*Less-than: in other words, strict in both arguments*}
paulson@14060
   363
lemma add_lt_mono: "[| i<j; k<l; j\<in>nat; l\<in>nat |] ==> i#+k < j#+l"
paulson@14060
   364
apply (rule add_lt_le_mono) 
paulson@14060
   365
apply (auto intro: leI) 
paulson@14060
   366
done
paulson@14060
   367
paulson@13163
   368
(** Subtraction is the inverse of addition. **)
paulson@13163
   369
paulson@13163
   370
lemma diff_add_inverse: "(n#+m) #- n = natify(m)"
paulson@13163
   371
apply (subgoal_tac " (natify(n) #+ m) #- natify(n) = natify(m) ")
paulson@13163
   372
apply (rule_tac [2] n = "natify(n) " in nat_induct)
paulson@13163
   373
apply auto
paulson@13163
   374
done
paulson@13163
   375
paulson@13163
   376
lemma diff_add_inverse2: "(m#+n) #- n = natify(m)"
paulson@13163
   377
by (simp add: add_commute [of m] diff_add_inverse)
paulson@13163
   378
paulson@13163
   379
lemma diff_cancel: "(k#+m) #- (k#+n) = m #- n"
paulson@13163
   380
apply (subgoal_tac "(natify(k) #+ natify(m)) #- (natify(k) #+ natify(n)) =
paulson@13163
   381
                    natify(m) #- natify(n) ")
paulson@13163
   382
apply (rule_tac [2] n = "natify(k) " in nat_induct)
paulson@13163
   383
apply auto
paulson@13163
   384
done
paulson@13163
   385
paulson@13163
   386
lemma diff_cancel2: "(m#+k) #- (n#+k) = m #- n"
paulson@13163
   387
by (simp add: add_commute [of _ k] diff_cancel)
paulson@13163
   388
paulson@13163
   389
lemma diff_add_0: "n #- (n#+m) = 0"
paulson@13163
   390
apply (subgoal_tac "natify(n) #- (natify(n) #+ natify(m)) = 0")
paulson@13163
   391
apply (rule_tac [2] n = "natify(n) " in nat_induct)
paulson@13163
   392
apply auto
paulson@13163
   393
done
paulson@13163
   394
paulson@13361
   395
lemma pred_0 [simp]: "pred(0) = 0"
paulson@13361
   396
by (simp add: pred_def)
paulson@13361
   397
paulson@13361
   398
lemma eq_succ_imp_eq_m1: "[|i = succ(j); i\<in>nat|] ==> j = i #- 1 & j \<in>nat"
paulson@13361
   399
by simp 
paulson@13361
   400
paulson@13361
   401
lemma pred_Un_distrib:
paulson@13361
   402
    "[|i\<in>nat; j\<in>nat|] ==> pred(i Un j) = pred(i) Un pred(j)"
paulson@13361
   403
apply (erule_tac n=i in natE, simp) 
paulson@13361
   404
apply (erule_tac n=j in natE, simp) 
paulson@13361
   405
apply (simp add:  succ_Un_distrib [symmetric])
paulson@13361
   406
done
paulson@13361
   407
paulson@13361
   408
lemma pred_type [TC,simp]:
paulson@13361
   409
    "i \<in> nat ==> pred(i) \<in> nat"
paulson@13361
   410
by (simp add: pred_def split: split_nat_case)
paulson@13361
   411
paulson@13361
   412
lemma nat_diff_pred: "[|i\<in>nat; j\<in>nat|] ==> i #- succ(j) = pred(i #- j)";
paulson@13361
   413
apply (rule_tac m=i and n=j in diff_induct) 
paulson@13361
   414
apply (auto simp add: pred_def nat_imp_quasinat split: split_nat_case)
paulson@13361
   415
done
paulson@13361
   416
paulson@13361
   417
lemma diff_succ_eq_pred: "i #- succ(j) = pred(i #- j)";
paulson@13361
   418
apply (insert nat_diff_pred [of "natify(i)" "natify(j)"])
paulson@13361
   419
apply (simp add: natify_succ [symmetric]) 
paulson@13361
   420
done
paulson@13361
   421
paulson@13361
   422
lemma nat_diff_Un_distrib:
paulson@13361
   423
    "[|i\<in>nat; j\<in>nat; k\<in>nat|] ==> (i Un j) #- k = (i#-k) Un (j#-k)"
paulson@13361
   424
apply (rule_tac n=k in nat_induct) 
paulson@13361
   425
apply (simp_all add: diff_succ_eq_pred pred_Un_distrib) 
paulson@13361
   426
done
paulson@13361
   427
paulson@13361
   428
lemma diff_Un_distrib:
paulson@13361
   429
    "[|i\<in>nat; j\<in>nat|] ==> (i Un j) #- k = (i#-k) Un (j#-k)"
paulson@13361
   430
by (insert nat_diff_Un_distrib [of i j "natify(k)"], simp)
paulson@13361
   431
paulson@13361
   432
text{*We actually prove @{term "i #- j #- k = i #- (j #+ k)"}*}
paulson@13361
   433
lemma diff_diff_left [simplified]:
paulson@13361
   434
     "natify(i)#-natify(j)#-k = natify(i) #- (natify(j)#+k)";
paulson@13361
   435
by (rule_tac m="natify(i)" and n="natify(j)" in diff_induct, auto)
paulson@13361
   436
paulson@13163
   437
paulson@13163
   438
(** Lemmas for the CancelNumerals simproc **)
paulson@13163
   439
paulson@13163
   440
lemma eq_add_iff: "(u #+ m = u #+ n) <-> (0 #+ m = natify(n))"
paulson@13163
   441
apply auto
paulson@13163
   442
apply (blast dest: add_left_cancel_natify)
paulson@13163
   443
apply (simp add: add_def)
paulson@13163
   444
done
paulson@13163
   445
paulson@13163
   446
lemma less_add_iff: "(u #+ m < u #+ n) <-> (0 #+ m < natify(n))"
paulson@13163
   447
apply (auto simp add: add_lt_elim1_natify)
paulson@13163
   448
apply (drule add_lt_mono1)
paulson@13163
   449
apply (auto simp add: add_commute [of u])
paulson@13163
   450
done
paulson@13163
   451
paulson@13163
   452
lemma diff_add_eq: "((u #+ m) #- (u #+ n)) = ((0 #+ m) #- n)"
paulson@13163
   453
by (simp add: diff_cancel)
paulson@13163
   454
paulson@13163
   455
(*To tidy up the result of a simproc.  Only the RHS will be simplified.*)
paulson@13163
   456
lemma eq_cong2: "u = u' ==> (t==u) == (t==u')"
paulson@13163
   457
by auto
paulson@13163
   458
paulson@13163
   459
lemma iff_cong2: "u <-> u' ==> (t==u) == (t==u')"
paulson@13163
   460
by auto
paulson@13163
   461
paulson@13163
   462
paulson@13356
   463
subsection{*Multiplication*}
paulson@13163
   464
paulson@13163
   465
lemma mult_0 [simp]: "0 #* m = 0"
paulson@13163
   466
by (simp add: mult_def)
paulson@13163
   467
paulson@13163
   468
lemma mult_succ [simp]: "succ(m) #* n = n #+ (m #* n)"
paulson@13163
   469
by (simp add: add_def mult_def natify_succ raw_mult_type)
paulson@13163
   470
paulson@13163
   471
(*right annihilation in product*)
paulson@13163
   472
lemma mult_0_right [simp]: "m #* 0 = 0"
paulson@13163
   473
apply (unfold mult_def)
paulson@13163
   474
apply (rule_tac n = "natify(m) " in nat_induct)
paulson@13163
   475
apply auto
paulson@13163
   476
done
paulson@13163
   477
paulson@13163
   478
(*right successor law for multiplication*)
paulson@13163
   479
lemma mult_succ_right [simp]: "m #* succ(n) = m #+ (m #* n)"
paulson@13163
   480
apply (subgoal_tac "natify(m) #* succ (natify(n)) =
paulson@13163
   481
                    natify(m) #+ (natify(m) #* natify(n))")
paulson@13163
   482
apply (simp (no_asm_use) add: natify_succ add_def mult_def)
paulson@13163
   483
apply (rule_tac n = "natify(m) " in nat_induct)
paulson@13163
   484
apply (simp_all add: add_ac)
paulson@13163
   485
done
paulson@13163
   486
paulson@13163
   487
lemma mult_1_natify [simp]: "1 #* n = natify(n)"
paulson@13163
   488
by auto
paulson@13163
   489
paulson@13163
   490
lemma mult_1_right_natify [simp]: "n #* 1 = natify(n)"
paulson@13163
   491
by auto
paulson@13163
   492
paulson@14060
   493
lemma mult_1: "n \<in> nat ==> 1 #* n = n"
paulson@13163
   494
by simp
paulson@13163
   495
paulson@14060
   496
lemma mult_1_right: "n \<in> nat ==> n #* 1 = n"
paulson@13163
   497
by simp
paulson@13163
   498
paulson@13163
   499
(*Commutative law for multiplication*)
paulson@13163
   500
lemma mult_commute: "m #* n = n #* m"
paulson@13163
   501
apply (subgoal_tac "natify(m) #* natify(n) = natify(n) #* natify(m) ")
paulson@13163
   502
apply (rule_tac [2] n = "natify(m) " in nat_induct)
paulson@13163
   503
apply auto
paulson@13163
   504
done
paulson@13163
   505
paulson@13163
   506
(*addition distributes over multiplication*)
paulson@13163
   507
lemma add_mult_distrib: "(m #+ n) #* k = (m #* k) #+ (n #* k)"
paulson@13163
   508
apply (subgoal_tac "(natify(m) #+ natify(n)) #* natify(k) =
paulson@13163
   509
                    (natify(m) #* natify(k)) #+ (natify(n) #* natify(k))")
paulson@13163
   510
apply (rule_tac [2] n = "natify(m) " in nat_induct)
paulson@13163
   511
apply (simp_all add: add_assoc [symmetric])
paulson@13163
   512
done
paulson@13163
   513
paulson@13163
   514
(*Distributive law on the left*)
paulson@13163
   515
lemma add_mult_distrib_left: "k #* (m #+ n) = (k #* m) #+ (k #* n)"
paulson@13163
   516
apply (subgoal_tac "natify(k) #* (natify(m) #+ natify(n)) =
paulson@13163
   517
                    (natify(k) #* natify(m)) #+ (natify(k) #* natify(n))")
paulson@13163
   518
apply (rule_tac [2] n = "natify(m) " in nat_induct)
paulson@13163
   519
apply (simp_all add: add_ac)
paulson@13163
   520
done
paulson@13163
   521
paulson@13163
   522
(*Associative law for multiplication*)
paulson@13163
   523
lemma mult_assoc: "(m #* n) #* k = m #* (n #* k)"
paulson@13163
   524
apply (subgoal_tac "(natify(m) #* natify(n)) #* natify(k) =
paulson@13163
   525
                    natify(m) #* (natify(n) #* natify(k))")
paulson@13163
   526
apply (rule_tac [2] n = "natify(m) " in nat_induct)
paulson@13163
   527
apply (simp_all add: add_mult_distrib)
paulson@13163
   528
done
paulson@13163
   529
paulson@13163
   530
(*for a/c rewriting*)
paulson@13163
   531
lemma mult_left_commute: "m #* (n #* k) = n #* (m #* k)"
paulson@13163
   532
apply (rule mult_commute [THEN trans])
paulson@13163
   533
apply (rule mult_assoc [THEN trans])
paulson@13163
   534
apply (rule mult_commute [THEN subst_context])
paulson@13163
   535
done
paulson@13163
   536
paulson@13163
   537
lemmas mult_ac = mult_assoc mult_commute mult_left_commute
paulson@13163
   538
paulson@13163
   539
paulson@13163
   540
lemma lt_succ_eq_0_disj:
paulson@14060
   541
     "[| m\<in>nat; n\<in>nat |]
paulson@14060
   542
      ==> (m < succ(n)) <-> (m = 0 | (\<exists>j\<in>nat. m = succ(j) & j < n))"
paulson@13163
   543
by (induct_tac "m", auto)
paulson@13163
   544
paulson@13163
   545
lemma less_diff_conv [rule_format]:
paulson@14060
   546
     "[| j\<in>nat; k\<in>nat |] ==> \<forall>i\<in>nat. (i < j #- k) <-> (i #+ k < j)"
paulson@13784
   547
by (erule_tac m = k in diff_induct, auto)
paulson@13163
   548
paulson@13163
   549
lemmas nat_typechecks = rec_type nat_0I nat_1I nat_succI Ord_nat
paulson@13163
   550
paulson@13163
   551
ML
paulson@13163
   552
{*
paulson@13163
   553
val pred_def = thm "pred_def";
paulson@13163
   554
val raw_div_def = thm "raw_div_def";
paulson@13163
   555
val raw_mod_def = thm "raw_mod_def";
paulson@13163
   556
val div_def = thm "div_def";
paulson@13163
   557
val mod_def = thm "mod_def";
paulson@13163
   558
paulson@13163
   559
val zero_lt_natE = thm "zero_lt_natE";
paulson@13163
   560
val pred_succ_eq = thm "pred_succ_eq";
paulson@13163
   561
val natify_succ = thm "natify_succ";
paulson@13163
   562
val natify_0 = thm "natify_0";
paulson@13163
   563
val natify_non_succ = thm "natify_non_succ";
paulson@13163
   564
val natify_in_nat = thm "natify_in_nat";
paulson@13163
   565
val natify_ident = thm "natify_ident";
paulson@13163
   566
val natify_eqE = thm "natify_eqE";
paulson@13163
   567
val natify_idem = thm "natify_idem";
paulson@13163
   568
val add_natify1 = thm "add_natify1";
paulson@13163
   569
val add_natify2 = thm "add_natify2";
paulson@13163
   570
val mult_natify1 = thm "mult_natify1";
paulson@13163
   571
val mult_natify2 = thm "mult_natify2";
paulson@13163
   572
val diff_natify1 = thm "diff_natify1";
paulson@13163
   573
val diff_natify2 = thm "diff_natify2";
paulson@13163
   574
val mod_natify1 = thm "mod_natify1";
paulson@13163
   575
val mod_natify2 = thm "mod_natify2";
paulson@13163
   576
val div_natify1 = thm "div_natify1";
paulson@13163
   577
val div_natify2 = thm "div_natify2";
paulson@13163
   578
val raw_add_type = thm "raw_add_type";
paulson@13163
   579
val add_type = thm "add_type";
paulson@13163
   580
val raw_mult_type = thm "raw_mult_type";
paulson@13163
   581
val mult_type = thm "mult_type";
paulson@13163
   582
val raw_diff_type = thm "raw_diff_type";
paulson@13163
   583
val diff_type = thm "diff_type";
paulson@13163
   584
val diff_0_eq_0 = thm "diff_0_eq_0";
paulson@13163
   585
val diff_succ_succ = thm "diff_succ_succ";
paulson@13163
   586
val diff_0 = thm "diff_0";
paulson@13163
   587
val diff_le_self = thm "diff_le_self";
paulson@13163
   588
val add_0_natify = thm "add_0_natify";
paulson@13163
   589
val add_succ = thm "add_succ";
paulson@13163
   590
val add_0 = thm "add_0";
paulson@13163
   591
val add_assoc = thm "add_assoc";
paulson@13163
   592
val add_0_right_natify = thm "add_0_right_natify";
paulson@13163
   593
val add_succ_right = thm "add_succ_right";
paulson@13163
   594
val add_0_right = thm "add_0_right";
paulson@13163
   595
val add_commute = thm "add_commute";
paulson@13163
   596
val add_left_commute = thm "add_left_commute";
paulson@13163
   597
val raw_add_left_cancel = thm "raw_add_left_cancel";
paulson@13163
   598
val add_left_cancel_natify = thm "add_left_cancel_natify";
paulson@13163
   599
val add_left_cancel = thm "add_left_cancel";
paulson@13163
   600
val add_le_elim1_natify = thm "add_le_elim1_natify";
paulson@13163
   601
val add_le_elim1 = thm "add_le_elim1";
paulson@13163
   602
val add_lt_elim1_natify = thm "add_lt_elim1_natify";
paulson@13163
   603
val add_lt_elim1 = thm "add_lt_elim1";
paulson@13163
   604
val add_lt_mono1 = thm "add_lt_mono1";
paulson@14060
   605
val add_lt_mono2 = thm "add_lt_mono2";
paulson@13163
   606
val add_lt_mono = thm "add_lt_mono";
paulson@13163
   607
val Ord_lt_mono_imp_le_mono = thm "Ord_lt_mono_imp_le_mono";
paulson@13163
   608
val add_le_mono1 = thm "add_le_mono1";
paulson@13163
   609
val add_le_mono = thm "add_le_mono";
paulson@13163
   610
val diff_add_inverse = thm "diff_add_inverse";
paulson@13163
   611
val diff_add_inverse2 = thm "diff_add_inverse2";
paulson@13163
   612
val diff_cancel = thm "diff_cancel";
paulson@13163
   613
val diff_cancel2 = thm "diff_cancel2";
paulson@13163
   614
val diff_add_0 = thm "diff_add_0";
paulson@13163
   615
val eq_add_iff = thm "eq_add_iff";
paulson@13163
   616
val less_add_iff = thm "less_add_iff";
paulson@13163
   617
val diff_add_eq = thm "diff_add_eq";
paulson@13163
   618
val eq_cong2 = thm "eq_cong2";
paulson@13163
   619
val iff_cong2 = thm "iff_cong2";
paulson@13163
   620
val mult_0 = thm "mult_0";
paulson@13163
   621
val mult_succ = thm "mult_succ";
paulson@13163
   622
val mult_0_right = thm "mult_0_right";
paulson@13163
   623
val mult_succ_right = thm "mult_succ_right";
paulson@13163
   624
val mult_1_natify = thm "mult_1_natify";
paulson@13163
   625
val mult_1_right_natify = thm "mult_1_right_natify";
paulson@13163
   626
val mult_1 = thm "mult_1";
paulson@13163
   627
val mult_1_right = thm "mult_1_right";
paulson@13163
   628
val mult_commute = thm "mult_commute";
paulson@13163
   629
val add_mult_distrib = thm "add_mult_distrib";
paulson@13163
   630
val add_mult_distrib_left = thm "add_mult_distrib_left";
paulson@13163
   631
val mult_assoc = thm "mult_assoc";
paulson@13163
   632
val mult_left_commute = thm "mult_left_commute";
paulson@13163
   633
val lt_succ_eq_0_disj = thm "lt_succ_eq_0_disj";
paulson@13163
   634
val less_diff_conv = thm "less_diff_conv";
paulson@13163
   635
paulson@13163
   636
val add_ac = thms "add_ac";
paulson@13163
   637
val mult_ac = thms "mult_ac";
paulson@13163
   638
val nat_typechecks = thms "nat_typechecks";
paulson@13163
   639
*}
paulson@9654
   640
clasohm@0
   641
end