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