arithmeticScript.sml
1(* ===================================================================== *)
2(* FILE : arithmeticScript.sml *)
3(* DESCRIPTION : Definitions and properties of +,-,*,EXP, <=, >=, etc. *)
4(* Translated from hol88. *)
5(* *)
6(* AUTHORS : (c) Mike Gordon and *)
7(* Tom Melham, University of Cambridge *)
8(* DATE : 88.04.02 *)
9(* TRANSLATOR : Konrad Slind, University of Calgary *)
10(* DATE : September 15, 1991 *)
11(* ADDITIONS : December 22, 1992 *)
12(* ===================================================================== *)
13Theory arithmetic[bare]
14Ancestors
15 num prim_rec combin relation
16Libs
17 HolKernel boolLib Parse BasicProvers simpLib boolSimps mesonLib
18 metisLib SatisfySimps[qualified] DefnBase[qualified]
19
20
21local
22 open OpenTheoryMap
23 val ns = ["Number", "Natural"]
24in
25 fun ot0 x y = OpenTheory_const_name
26 {const = {Thy = "arithmetic", Name = x}, name = (ns, y)}
27 fun ot x = ot0 x x
28 fun otunwanted x = OpenTheory_const_name
29 {const = {Thy = "arithmetic", Name = x},
30 name = (["Unwanted"], "id")}
31end
32
33val _ = if !Globals.interactive then () else Feedback.emit_WARNING := false;
34
35Theorem num_case_def = num_case_def
36
37val metis_tac = METIS_TAC;
38fun bossify stac ths = stac (srw_ss()) ths
39val simp = bossify asm_simp_tac
40val fs = bossify full_simp_tac
41val gvs = bossify (global_simp_tac {droptrues = true, elimvars = true,
42 oldestfirst = true, strip = true})
43val rw = srw_tac[];
44val std_ss = bool_ss;
45val qabbrev_tac = Q.ABBREV_TAC;
46
47(*---------------------------------------------------------------------------*
48 * The basic arithmetic operations. *
49 *---------------------------------------------------------------------------*)
50
51val ADD = new_recursive_definition
52 {name = "ADD",
53 rec_axiom = num_Axiom,
54 def = “($+ 0 n = n) /\
55 ($+ (SUC m) n = SUC ($+ m n))”};
56
57val _ = set_fixity "+" (Infixl 500);
58val _ = ot "+"
59val _ = TeX_notation { hol = "+", TeX = ("\\ensuremath{+}", 1) };
60
61(*---------------------------------------------------------------------------*
62 * Define NUMERAL, a tag put on numeric literals, and the basic constructors *
63 * of the "numeral type". *
64 *---------------------------------------------------------------------------*)
65
66val NUMERAL_DEF = new_definition(
67 "NUMERAL_DEF[notuserdef]",
68 “NUMERAL (x:num) = x”
69);
70
71val ALT_ZERO = new_definition("ALT_ZERO[notuserdef]", “ZERO = 0”);
72
73local
74 open OpenTheoryMap
75in
76 val _ = OpenTheory_const_name {const = {Thy = "arithmetic", Name = "ZERO"},
77 name = (["Number", "Natural"], "zero")}
78 val _ = OpenTheory_const_name {const = {Thy = "num", Name = "0"},
79 name=(["Number", "Natural"], "zero")}
80end
81
82val BIT1 = new_definition("BIT1[notuserdef]", “BIT1 n = n + (n + SUC 0)”);
83val BIT2 = new_definition("BIT2[notuserdef]", “BIT2 n = n + (n + SUC (SUC 0))”);
84
85val _ = new_definition(
86 GrammarSpecials.nat_elim_term ^ "[notuserdef]",
87 ``^(mk_var(GrammarSpecials.nat_elim_term, Type`:num->num`)) n = n``);
88
89val _ = otunwanted "NUMERAL"
90val _ = ot0 "BIT1" "bit1"
91val _ = ot0 "BIT2" "bit2"
92
93(*---------------------------------------------------------------------------*
94 * After this call, numerals parse into `NUMERAL( ... )` *
95 *---------------------------------------------------------------------------*)
96
97val _ = add_numeral_form (#"n", NONE);
98
99val _ = set_fixity "-" (Infixl 500);
100val _ = Unicode.unicode_version {u = UTF8.chr 0x2212, tmnm = "-"};
101val _ = TeX_notation {hol = "-", TeX = ("\\ensuremath{-}", 1)}
102val _ = TeX_notation {hol = UTF8.chr 0x2212, TeX = ("\\ensuremath{-}", 1)}
103
104val SUB = new_recursive_definition
105 {name = "SUB",
106 rec_axiom = num_Axiom,
107 def = “(0 - m = 0) /\
108 (SUC m - n = if m < n then 0 else SUC(m - n))”};
109
110val _ = ot "-"
111
112(* Also add concrete syntax for unary negation so that future numeric types
113 can use it. We can't do anything useful with it for the natural numbers
114 of course, but it seems like this is the best ancestral place for it.
115
116 Descendents wanting to use this will include at least
117 integer, real, words, rat
118*)
119val _ = add_rule { term_name = "numeric_negate",
120 fixity = Prefix 900,
121 pp_elements = [TOK "-"],
122 paren_style = OnlyIfNecessary,
123 block_style = (AroundEachPhrase, (PP.CONSISTENT,0))};
124
125(* Similarly, add syntax for the injection from nats symbol (&). This isn't
126 required in this theory, but will be used by descendents. *)
127val _ = add_rule {term_name = GrammarSpecials.num_injection,
128 fixity = Prefix 900,
129 pp_elements = [TOK GrammarSpecials.num_injection],
130 paren_style = OnlyIfNecessary,
131 block_style = (AroundEachPhrase, (PP.CONSISTENT,0))};
132(* overload it to the nat_elim term *)
133val _ = overload_on (GrammarSpecials.num_injection,
134 mk_const(GrammarSpecials.nat_elim_term, “:num -> num”))
135
136val _ = set_fixity "*" (Infixl 600);
137val _ = TeX_notation {hol = "*", TeX = ("\\HOLTokenProd{}", 1)}
138
139val MULT = new_recursive_definition
140 {name = "MULT",
141 rec_axiom = num_Axiom,
142 def = “(0 * n = 0) /\
143 (SUC m * n = (m * n) + n)”};
144
145val _ = ot "*"
146
147val EXP = new_recursive_definition
148 {name = "EXP",
149 rec_axiom = num_Axiom,
150 def = “($EXP m 0 = 1) /\
151 ($EXP m (SUC n) = m * ($EXP m n))”};
152
153val _ = ot0 "EXP" "^"
154val _ = set_fixity "EXP" (Infixr 700);
155val _ = add_infix("**", 700, HOLgrammars.RIGHT);
156Overload "**" = Term`$EXP`
157val _ = TeX_notation {hol = "**", TeX = ("\\HOLTokenExp{}", 2)}
158
159Theorem EXP0[simp] = cj 1 EXP
160
161(* special-case squares and cubes *)
162val _ = add_rule {fixity = Suffix 2100,
163 term_name = UnicodeChars.sup_2,
164 block_style = (AroundEachPhrase,(PP.CONSISTENT, 0)),
165 paren_style = ParoundPrec,
166 pp_elements = [TOK UnicodeChars.sup_2]};
167
168val _ = overload_on (UnicodeChars.sup_2, “\x. x ** 2”);
169val _ = TeX_notation{hol = UnicodeChars.sup_2, TeX = ("\\HOLTokenSupTwo{}", 1)};
170
171val _ = add_rule {fixity = Suffix 2100,
172 term_name = UnicodeChars.sup_3,
173 block_style = (AroundEachPhrase,(PP.CONSISTENT, 0)),
174 paren_style = ParoundPrec,
175 pp_elements = [TOK UnicodeChars.sup_3]};
176
177val _ = overload_on (UnicodeChars.sup_3, “\x. x ** 3”);
178val _ = TeX_notation{hol = UnicodeChars.sup_3, TeX= ("\\HOLTokenSupThree{}",1)};
179
180val GREATER_DEF = new_definition("GREATER_DEF", “$> m n <=> n < m”)
181val _ = set_fixity ">" (Infix(NONASSOC, 450))
182val _ = TeX_notation {hol = ">", TeX = ("\\HOLTokenGt{}", 1)}
183val _ = ot ">"
184
185val LESS_OR_EQ = new_definition ("LESS_OR_EQ", “$<= m n <=> m < n \/ (m = n)”)
186val _ = set_fixity "<=" (Infix(NONASSOC, 450))
187val _ = Unicode.unicode_version { u = Unicode.UChar.leq, tmnm = "<="}
188val _ = TeX_notation {hol = Unicode.UChar.leq, TeX = ("\\HOLTokenLeq{}", 1)}
189val _ = TeX_notation {hol = "<=", TeX = ("\\HOLTokenLeq{}", 1)}
190val _ = ot "<="
191
192val GREATER_OR_EQ =
193 new_definition("GREATER_OR_EQ", “$>= m n <=> m > n \/ (m = n)”)
194val _ = set_fixity ">=" (Infix(NONASSOC, 450))
195val _ = Unicode.unicode_version { u = Unicode.UChar.geq, tmnm = ">="};
196val _ = TeX_notation {hol = ">=", TeX = ("\\HOLTokenGeq{}", 1)}
197val _ = TeX_notation {hol = Unicode.UChar.geq, TeX = ("\\HOLTokenGeq{}", 1)}
198val _ = ot ">="
199
200val EVEN = new_recursive_definition
201 {name = "EVEN",
202 rec_axiom = num_Axiom,
203 def = “(EVEN 0 = T) /\
204 (EVEN (SUC n) = ~EVEN n)”};
205val _ = ot0 "EVEN" "even"
206
207val ODD = new_recursive_definition
208 {name = "ODD",
209 rec_axiom = num_Axiom,
210 def = “(ODD 0 = F) /\
211 (ODD (SUC n) = ~ODD n)”};
212val _ = ot0 "ODD" "odd"
213
214val FUNPOW = new_recursive_definition
215 {name = "FUNPOW",
216 rec_axiom = num_Axiom,
217 def = “(FUNPOW f 0 x = x) /\
218 (FUNPOW f (SUC n) x = FUNPOW f n (f x))”};
219
220val NRC = new_recursive_definition {
221 name = "NRC",
222 rec_axiom = num_Axiom,
223 def = “(NRC R 0 x y = (x = y)) /\
224 (NRC R (SUC n) x y = ?z. R x z /\ NRC R n z y)”};
225
226val bool_to_bit_def = new_definition(
227 "bool_to_bit_def",
228 “bool_to_bit b = if b then 1 else 0”
229);
230
231Overload RELPOW = “NRC”
232Overload NRC = “NRC”
233
234(*---------------------------------------------------------------------------
235 THEOREMS
236 ---------------------------------------------------------------------------*)
237
238Theorem ONE: 1 = SUC 0
239Proof
240 REWRITE_TAC [NUMERAL_DEF, BIT1, ALT_ZERO, ADD]
241QED
242
243Theorem TWO: 2 = SUC 1
244Proof
245 REWRITE_TAC [NUMERAL_DEF, BIT2, ONE, ADD, ALT_ZERO,BIT1]
246QED
247
248Theorem NORM_0: NUMERAL ZERO = 0
249Proof
250 REWRITE_TAC [NUMERAL_DEF, ALT_ZERO]
251QED
252
253fun INDUCT_TAC g = INDUCT_THEN INDUCTION ASSUME_TAC g;
254
255val EQ_SYM_EQ' = INST_TYPE [alpha |-> Type`:num`] EQ_SYM_EQ;
256
257(*---------------------------------------------------------------------------*)
258(* Definition of num_case more suitable to call-by-value computations *)
259(*---------------------------------------------------------------------------*)
260
261Theorem num_case_compute:
262 !n. num_CASE n (f:'a) g = if n=0 then f else g (PRE n)
263Proof
264 INDUCT_TAC THEN REWRITE_TAC [num_case_def,NOT_SUC,PRE]
265QED
266
267
268(* --------------------------------------------------------------------- *)
269(* SUC_NOT = |- !n. ~(0 = SUC n) *)
270(* --------------------------------------------------------------------- *)
271
272Theorem SUC_NOT =
273 GEN (“n:num”) (NOT_EQ_SYM (SPEC (“n:num”) NOT_SUC));
274
275(* Theorem: 0 < SUC n *)
276(* Proof: by arithmetic. *)
277Theorem SUC_POS = LESS_0;
278
279(* Theorem: 0 < SUC n *)
280(* Proof: by arithmetic. *)
281Theorem SUC_NOT_ZERO = NOT_SUC;
282
283Theorem ADD_0:
284 !m. m + 0 = m
285Proof
286 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]
287QED
288
289Theorem ADD_SUC:
290 !m n. SUC(m + n) = (m + SUC n)
291Proof
292 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]
293QED
294
295Theorem ADD_CLAUSES:
296 (0 + m = m) /\
297 (m + 0 = m) /\
298 (SUC m + n = SUC(m + n)) /\
299 (m + SUC n = SUC(m + n))
300Proof
301 REWRITE_TAC[ADD, ADD_0, ADD_SUC]
302QED
303
304Theorem ADD_SYM:
305 !m n. m + n = n + m
306Proof
307 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_0, ADD, ADD_SUC]
308QED
309
310Theorem ADD_COMM = ADD_SYM;
311
312Theorem ADD_ASSOC:
313 !m n p. m + (n + p) = (m + n) + p
314Proof
315 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]
316QED
317
318Theorem num_CASES:
319 !m. (m = 0) \/ ?n. m = SUC n
320Proof
321 INDUCT_TAC
322 THEN REWRITE_TAC[NOT_SUC]
323 THEN EXISTS_TAC (“(m:num)”)
324 THEN REWRITE_TAC[]
325QED
326
327Theorem NOT_ZERO_LT_ZERO:
328 !n. n <> 0 <=> 0 < n
329Proof
330 GEN_TAC THEN STRUCT_CASES_TAC (Q.SPEC `n` num_CASES) THEN
331 REWRITE_TAC [NOT_LESS_0, LESS_0, NOT_SUC]
332QED
333
334Theorem NOT_ZERO = NOT_ZERO_LT_ZERO
335
336Theorem NOT_LT_ZERO_EQ_ZERO[simp]:
337 !n. ~(0 < n) <=> (n = 0)
338Proof REWRITE_TAC [GSYM NOT_ZERO_LT_ZERO]
339QED
340
341Theorem LESS_OR_EQ_ALT:
342 $<= = RTC (\x y. y = SUC x)
343Proof
344 REWRITE_TAC [FUN_EQ_THM, LESS_OR_EQ, relationTheory.RTC_CASES_TC, LESS_ALT]
345 THEN REPEAT (STRIP_TAC ORELSE EQ_TAC)
346 THEN ASM_REWRITE_TAC []
347QED
348
349Theorem LT_SUC:
350 n < SUC m <=> n = 0 \/ ?n0. n = SUC n0 /\ n0 < m
351Proof
352 eq_tac >> Q.SPEC_THEN ‘n’ STRUCT_CASES_TAC num_CASES >>
353 rewrite_tac [LESS_0, prim_recTheory.LESS_MONO_EQ, NOT_SUC, INV_SUC_EQ]
354 >- (disch_then (irule_at (Pos last)) >> rewrite_tac[]) >>
355 strip_tac >> asm_rewrite_tac[]
356QED
357
358Theorem SUC_LT:
359 SUC n < m <=> ?m0. m = SUC m0 /\ n < m0
360Proof
361 eq_tac
362 >- (Q.SPEC_THEN ‘m’ STRUCT_CASES_TAC num_CASES >>
363 rewrite_tac[NOT_LESS_0, prim_recTheory.LESS_MONO_EQ] >>
364 disch_then (irule_at (Pos last)) >> rewrite_tac[]) >>
365 strip_tac >> asm_rewrite_tac [prim_recTheory.LESS_MONO_EQ]
366QED
367
368(* --------------------------------------------------------------------- *)
369(* LESS_ADD proof rewritten: TFM 90.O9.21 *)
370(* --------------------------------------------------------------------- *)
371
372Theorem LESS_ADD:
373 !m n. n<m ==> ?p. p+n = m
374Proof
375 INDUCT_TAC THEN GEN_TAC THEN
376 REWRITE_TAC[NOT_LESS_0,LESS_THM] THEN
377 REPEAT STRIP_TAC THENL
378 [EXISTS_TAC (“SUC 0”) THEN ASM_REWRITE_TAC[ADD],
379 RES_THEN (STRIP_THM_THEN (SUBST1_TAC o SYM)) THEN
380 EXISTS_TAC (“SUC p”) THEN REWRITE_TAC [ADD]]
381QED
382
383Theorem LT_EXISTS:
384 !m n. m < n <=> ?d. n = m + SUC d
385Proof
386 CONV_TAC (SWAP_FORALL_CONV) >>
387 INDUCT_TAC >> simp [LT_SUC, NOT_LESS_0, ADD_CLAUSES, NOT_SUC] >>
388 GEN_TAC >> Q.SPEC_THEN ‘m’ strip_assume_tac num_CASES >>
389 simp[ADD_CLAUSES, LESS_0]
390QED
391
392Theorem transitive_LESS[simp]:
393 transitive $<
394Proof
395 REWRITE_TAC [relationTheory.TC_TRANSITIVE, LESS_ALT]
396QED
397
398Theorem LESS_TRANS:
399 !m n p. (m < n) /\ (n < p) ==> (m < p)
400Proof
401 MATCH_ACCEPT_TAC
402 (REWRITE_RULE [relationTheory.transitive_def] transitive_LESS)
403QED
404
405Theorem LESS_ANTISYM:
406 !m n. ~((m < n) /\ (n < m))
407Proof
408 REPEAT STRIP_TAC
409 THEN IMP_RES_TAC LESS_TRANS
410 THEN IMP_RES_TAC LESS_REFL
411QED
412
413(*---------------------------------------------------------------------------
414 * |- !m n. SUC m < SUC n = m < n
415 *---------------------------------------------------------------------------*)
416
417Theorem LESS_MONO_REV = prim_recTheory.LESS_MONO_REV ;
418Theorem LESS_MONO_EQ = prim_recTheory.LESS_MONO_EQ ;
419
420Theorem LESS_EQ_MONO:
421 !n m. (SUC n <= SUC m) = (n <= m)
422Proof
423 REWRITE_TAC [LESS_OR_EQ,LESS_MONO_EQ,INV_SUC_EQ]
424QED
425
426Theorem LESS_LESS_SUC:
427 !m n. ~((m < n) /\ (n < SUC m))
428Proof
429 INDUCT_TAC THEN INDUCT_TAC THEN
430 ASM_REWRITE_TAC[LESS_MONO_EQ, LESS_EQ_MONO, LESS_0, NOT_LESS_0]
431QED
432
433Theorem transitive_measure:
434 !f. transitive (measure f)
435Proof
436 SRW_TAC [][relationTheory.transitive_def,prim_recTheory.measure_thm]
437 THEN MATCH_MP_TAC LESS_TRANS
438 THEN SRW_TAC [SatisfySimps.SATISFY_ss][]
439QED
440
441Theorem LESS_EQ:
442 !m n. (m < n) = (SUC m <= n)
443Proof
444 REWRITE_TAC[LESS_OR_EQ_ALT, LESS_ALT, RTC_IM_TC]
445QED
446
447Theorem LESS_OR:
448 !m n. m < n ==> SUC m <= n
449Proof
450 REWRITE_TAC[LESS_EQ]
451QED
452
453Theorem OR_LESS:
454 !m n. (SUC m <= n) ==> (m < n)
455Proof
456 REWRITE_TAC[LESS_EQ]
457QED
458
459Theorem LESS_EQ_IFF_LESS_SUC:
460 !n m. (n <= m) = (n < (SUC m))
461Proof
462 REWRITE_TAC[LESS_OR_EQ_ALT, LESS_ALT, TC_IM_RTC_SUC]
463QED
464
465Theorem LESS_EQ_IMP_LESS_SUC:
466 !n m. (n <= m) ==> (n < (SUC m))
467Proof
468 REWRITE_TAC [LESS_EQ_IFF_LESS_SUC]
469QED
470
471Theorem ZERO_LESS_EQ:
472 !n. 0 <= n
473Proof
474 REWRITE_TAC [LESS_0,LESS_EQ_IFF_LESS_SUC]
475QED
476
477Theorem LE_0 = ZERO_LESS_EQ (* HOL-Light compatible name *)
478
479Theorem LESS_SUC_EQ_COR:
480 !m n. ((m < n) /\ (~(SUC m = n))) ==> (SUC m < n)
481Proof
482 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN
483 INDUCT_TAC THEN INDUCT_TAC THEN
484 ASM_REWRITE_TAC [LESS_MONO_EQ, INV_SUC_EQ, LESS_0, NOT_LESS_0,
485 NOT_ZERO_LT_ZERO]
486QED
487
488Theorem LESS_NOT_SUC:
489 !m n. (m < n) /\ ~(n = SUC m) ==> SUC m < n
490Proof
491 INDUCT_TAC THEN INDUCT_TAC THEN
492 ASM_REWRITE_TAC [LESS_MONO_EQ, INV_SUC_EQ, LESS_0, NOT_LESS_0,
493 NOT_ZERO_LT_ZERO]
494QED
495
496Theorem LESS_0_CASES:
497 !m. (0 = m) \/ 0<m
498Proof
499 INDUCT_TAC
500 THEN REWRITE_TAC[LESS_0]
501QED
502
503Theorem LESS_CASES_IMP:
504 !m n. ~(m < n) /\ ~(m = n) ==> (n < m)
505Proof
506 INDUCT_TAC THEN INDUCT_TAC THEN
507 ASM_REWRITE_TAC [LESS_MONO_EQ, INV_SUC_EQ, LESS_0, NOT_LESS_0]
508QED
509
510Theorem LESS_CASES:
511 !m n. (m < n) \/ (n <= m)
512Proof
513 INDUCT_TAC THEN INDUCT_TAC THEN
514 ASM_REWRITE_TAC
515 [LESS_MONO_EQ, LESS_EQ_MONO, ZERO_LESS_EQ, LESS_0, NOT_LESS_0]
516QED
517
518Theorem ADD_INV_0:
519 !m n. (m + n = m) ==> (n = 0)
520Proof
521 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES, INV_SUC_EQ]
522QED
523
524Theorem LESS_EQ_ADD:
525 !m n. m <= m + n
526Proof
527 GEN_TAC
528 THEN REWRITE_TAC[LESS_OR_EQ]
529 THEN INDUCT_TAC
530 THEN ASM_REWRITE_TAC[ADD_CLAUSES]
531 THEN MP_TAC(ASSUME (“(m < (m + n)) \/ (m = (m + n))”))
532 THEN STRIP_TAC
533 THENL
534 [IMP_RES_TAC LESS_SUC
535 THEN ASM_REWRITE_TAC[],
536 REWRITE_TAC[SYM(ASSUME (“m = m + n”)),LESS_SUC_REFL]]
537QED
538
539Theorem LESS_EQ_ADD_EXISTS:
540 !m n. n<=m ==> ?p. p+n = m
541Proof
542 SIMP_TAC bool_ss [LESS_OR_EQ, DISJ_IMP_THM, FORALL_AND_THM, LESS_ADD]
543 THEN GEN_TAC
544 THEN EXISTS_TAC (“0”)
545 THEN REWRITE_TAC[ADD]
546QED
547
548Theorem LESS_STRONG_ADD:
549 !m n. n < m ==> ?p. (SUC p)+n = m
550Proof
551 REPEAT STRIP_TAC
552 THEN IMP_RES_TAC LESS_OR
553 THEN IMP_RES_TAC LESS_EQ_ADD_EXISTS
554 THEN EXISTS_TAC (“p:num”)
555 THEN FULL_SIMP_TAC bool_ss [ADD_CLAUSES]
556QED
557
558Theorem LESS_EQ_SUC_REFL:
559 !m. m <= SUC m
560Proof
561 GEN_TAC
562 THEN REWRITE_TAC[LESS_OR_EQ,LESS_SUC_REFL]
563QED
564
565Theorem LESS_ADD_NONZERO:
566 !m n. ~(n = 0) ==> m < m + n
567Proof
568 GEN_TAC
569 THEN INDUCT_TAC
570 THEN REWRITE_TAC[NOT_SUC,ADD_CLAUSES]
571 THEN ASM_CASES_TAC (“n = 0”)
572 THEN ASSUME_TAC(SPEC (“m + n”) LESS_SUC_REFL)
573 THEN RES_TAC
574 THEN IMP_RES_TAC LESS_TRANS
575 THEN ASM_REWRITE_TAC[ADD_CLAUSES,LESS_SUC_REFL]
576QED
577
578Theorem NOT_SUC_LESS_EQ_0:
579 !n. ~(SUC n <= 0)
580Proof
581 REWRITE_TAC [NOT_LESS_0, GSYM LESS_EQ]
582QED
583
584Theorem NOT_LESS:
585 !m n. ~(m < n) = (n <= m)
586Proof
587 INDUCT_TAC THEN INDUCT_TAC THEN
588 ASM_REWRITE_TAC [LESS_MONO_EQ, LESS_EQ_MONO,
589 ZERO_LESS_EQ, LESS_0, NOT_LESS_0, NOT_SUC_LESS_EQ_0]
590QED
591
592Theorem NOT_LESS_EQUAL:
593 !m n. ~(m <= n) <=> n < m
594Proof REWRITE_TAC[GSYM NOT_LESS]
595QED
596
597Theorem LESS_EQ_ANTISYM:
598 !m n. ~(m < n /\ n <= m)
599Proof
600 INDUCT_TAC THEN INDUCT_TAC THEN
601 ASM_REWRITE_TAC [LESS_MONO_EQ, LESS_EQ_MONO,
602 ZERO_LESS_EQ, LESS_0, NOT_LESS_0, NOT_SUC_LESS_EQ_0]
603QED
604
605Theorem LTE_ANTISYM = LESS_EQ_ANTISYM (* HOL-Light compatible name *)
606Theorem LET_ANTISYM :
607 !m n. ~(m <= n /\ n < m)
608Proof
609 rpt GEN_TAC
610 >> ONCE_REWRITE_TAC [CONJ_COMM]
611 >> REWRITE_TAC [LESS_EQ_ANTISYM]
612QED
613
614Theorem LESS_EQ_0:
615 !n. (n <= 0) = (n = 0)
616Proof
617 REWRITE_TAC [LESS_OR_EQ, NOT_LESS_0]
618QED
619
620(*---------------------------------------------------------------------------
621 * HOL Light (or HOL88) compatibility
622 *---------------------------------------------------------------------------*)
623
624Theorem LT :
625 (!m:num. m < 0 <=> F) /\ (!m n. m < SUC n <=> (m = n) \/ m < n)
626Proof
627 METIS_TAC [LESS_THM, NOT_LESS_0]
628QED
629
630Theorem LT_LE :
631 !m n:num. m < n <=> m <= n /\ ~(m = n)
632Proof
633 METIS_TAC [LESS_NOT_EQ, LESS_OR_EQ]
634QED
635
636(* |- !m n. m <= n <=> m < n \/ (m = n) *)
637Theorem LE_LT = LESS_OR_EQ;
638
639(* moved here from cardinalTheory (proof is from old transc.ml *)
640Theorem LT_SUC_LE : (* was: LESS_SUC_EQ *)
641 !m n. m < SUC n <=> m <= n
642Proof
643 rpt GEN_TAC >> REWRITE_TAC[CONJUNCT2 LT, LE_LT]
644 >> EQ_TAC >> DISCH_THEN(DISJ_CASES_THEN(fn th => REWRITE_TAC[th]))
645QED
646
647Theorem LE_CASES :
648 !m n:num. m <= n \/ n <= m
649Proof
650 rpt INDUCT_TAC >> ASM_REWRITE_TAC[ZERO_LESS_EQ, LESS_EQ_MONO]
651QED
652
653Theorem LT_CASES :
654 !m n:num. (m < n) \/ (n < m) \/ (m = n)
655Proof
656 METIS_TAC [LESS_CASES, LESS_OR_EQ]
657QED
658
659(* moved here from real_topologyTheory *)
660Theorem WLOG_LT :
661 (!m:num. P m m) /\ (!m n. P m n <=> P n m) /\ (!m n. m < n ==> P m n)
662 ==> !m y. P m y
663Proof
664 METIS_TAC [LT_CASES]
665QED
666
667(* moved here from iterateTheory *)
668Theorem WLOG_LE :
669 (!m n:num. P m n <=> P n m) /\ (!m n:num. m <= n ==> P m n) ==>
670 !m n:num. P m n
671Proof
672 METIS_TAC [LE_CASES]
673QED
674
675(*---------------------------------------------------------------------------*)
676
677val _ = print "Now proving properties of subtraction\n"
678
679Theorem SUB_0:
680 !m. (0 - m = 0) /\ (m - 0 = m)
681Proof
682 INDUCT_TAC
683 THEN ASM_REWRITE_TAC[SUB, NOT_LESS_0]
684QED
685
686(* Non-confluence problem between SUB (snd clause) and LESS_MONO_EQ *)
687(* requires a change from hol2 proof. kls. *)
688
689Theorem SUB_MONO_EQ:
690 !n m. (SUC n) - (SUC m) = (n - m)
691Proof
692 INDUCT_TAC THENL
693 [REWRITE_TAC [SUB,LESS_0],
694 ONCE_REWRITE_TAC[SUB] THEN
695 PURE_ONCE_REWRITE_TAC[LESS_MONO_EQ] THEN
696 ASM_REWRITE_TAC[]]
697QED
698
699(* A better case rewrite for numeral arguments *)
700Theorem num_case_NUMERAL_compute[simp]:
701 num_CASE (NUMERAL (BIT1 n)) (z:'a) s = s (NUMERAL(BIT1 n) - 1) /\
702 num_CASE (NUMERAL (BIT2 n)) z s = s (NUMERAL(BIT1 n))
703Proof
704 REWRITE_TAC [num_case_compute, NUMERAL_DEF, BIT1, BIT2, ADD_CLAUSES,
705 NOT_SUC, PRE, ALT_ZERO, SUB_MONO_EQ, SUB_0]
706QED
707
708Theorem SUB_EQ_0:
709 !m n. (m - n = 0) = (m <= n)
710Proof
711 REPEAT INDUCT_TAC THEN
712 ASM_REWRITE_TAC [SUB_0, LESS_EQ_MONO, SUB_MONO_EQ, LESS_EQ_0, ZERO_LESS_EQ]
713QED
714
715Theorem ADD1:
716 !m. SUC m = m + 1
717Proof
718 INDUCT_TAC THENL [
719 REWRITE_TAC [ADD_CLAUSES, ONE],
720 ASM_REWRITE_TAC [] THEN REWRITE_TAC [ONE, ADD_CLAUSES]
721 ]
722QED
723
724Theorem SUC_SUB1:
725 !m. SUC m - 1 = m
726Proof
727 INDUCT_TAC THENL [
728 REWRITE_TAC [SUB, LESS_0, ONE],
729 PURE_ONCE_REWRITE_TAC[SUB] THEN
730 ASM_REWRITE_TAC[NOT_LESS_0, LESS_MONO_EQ, ONE]
731 ]
732QED
733
734Theorem PRE_SUB1:
735 !m. (PRE m = (m - 1))
736Proof
737 GEN_TAC
738 THEN STRUCT_CASES_TAC(SPEC (“m:num”) num_CASES)
739 THEN ASM_REWRITE_TAC[PRE, CONJUNCT1 SUB, SUC_SUB1]
740QED
741
742Theorem MULT_0:
743 !m. m * 0 = 0
744Proof
745 INDUCT_TAC
746 THEN ASM_REWRITE_TAC[MULT,ADD_CLAUSES]
747QED
748
749Theorem MULT_SUC:
750 !m n. m * (SUC n) = m + m*n
751Proof
752 INDUCT_TAC
753 THEN ASM_REWRITE_TAC[MULT,ADD_CLAUSES,ADD_ASSOC]
754QED
755
756Theorem MULT_LEFT_1:
757 !m. 1 * m = m
758Proof
759 GEN_TAC THEN REWRITE_TAC[ONE, MULT,ADD_CLAUSES]
760QED
761
762Theorem MULT_RIGHT_1:
763 !m. m * 1 = m
764Proof
765 REWRITE_TAC [ONE] THEN INDUCT_TAC THEN
766 ASM_REWRITE_TAC[MULT, ADD_CLAUSES]
767QED
768
769Theorem MULT_CLAUSES:
770 !m n. (0 * m = 0) /\
771 (m * 0 = 0) /\
772 (1 * m = m) /\
773 (m * 1 = m) /\
774 (SUC m * n = m * n + n) /\
775 (m * SUC n = m + m * n)
776Proof
777 REWRITE_TAC[MULT,MULT_0,MULT_LEFT_1,MULT_RIGHT_1,MULT_SUC]
778QED
779
780Theorem MULT_SYM:
781 !m n. m * n = n * m
782Proof
783 INDUCT_TAC
784 THEN GEN_TAC
785 THEN ASM_REWRITE_TAC[MULT_CLAUSES,SPECL[“m*n”,“n:num”]ADD_SYM]
786QED
787
788Theorem MULT_COMM = MULT_SYM;
789
790Theorem RIGHT_ADD_DISTRIB:
791 !m n p. (m + n) * p = (m * p) + (n * p)
792Proof
793 GEN_TAC
794 THEN GEN_TAC
795 THEN INDUCT_TAC
796 THEN ASM_REWRITE_TAC[MULT_CLAUSES,ADD_CLAUSES,ADD_ASSOC]
797 THEN REWRITE_TAC[SPECL[“m+(m*p)”,“n:num”]ADD_SYM,ADD_ASSOC]
798 THEN SUBST_TAC[SPEC_ALL ADD_SYM]
799 THEN REWRITE_TAC[]
800QED
801
802(* A better proof of LEFT_ADD_DISTRIB would be using
803 MULT_SYM and RIGHT_ADD_DISTRIB *)
804Theorem LEFT_ADD_DISTRIB:
805 !m n p. p * (m + n) = (p * m) + (p * n)
806Proof
807 GEN_TAC
808 THEN GEN_TAC
809 THEN INDUCT_TAC
810 THEN ASM_REWRITE_TAC[MULT_CLAUSES,ADD_CLAUSES,SYM(SPEC_ALL ADD_ASSOC)]
811 THEN REWRITE_TAC[SPECL[“m:num”,“(p*n)+n”]ADD_SYM,
812 SYM(SPEC_ALL ADD_ASSOC)]
813 THEN SUBST_TAC[SPEC_ALL ADD_SYM]
814 THEN REWRITE_TAC[]
815QED
816
817Theorem MULT_ASSOC:
818 !m n p. m * (n * p) = (m * n) * p
819Proof
820 INDUCT_TAC
821 THEN ASM_REWRITE_TAC[MULT_CLAUSES,RIGHT_ADD_DISTRIB]
822QED
823
824Theorem SUB_ADD:
825 !m n. (n <= m) ==> ((m - n) + n = m)
826Proof
827 REPEAT INDUCT_TAC THEN
828 ASM_REWRITE_TAC[ADD_CLAUSES, SUB_0, SUB_MONO_EQ, LESS_EQ_MONO,
829 INV_SUC_EQ, LESS_EQ_0]
830QED
831
832Theorem PRE_SUB:
833 !m n. PRE(m - n) = (PRE m) - n
834Proof
835 INDUCT_TAC
836 THEN GEN_TAC
837 THEN ASM_REWRITE_TAC[SUB,PRE]
838 THEN ASM_CASES_TAC (“m < n”)
839 THEN ASM_REWRITE_TAC
840 [PRE,LESS_OR_EQ,
841 SUBS[SPECL[“m-n”,“0”]EQ_SYM_EQ']
842 (SPECL [“m:num”,“n:num”] SUB_EQ_0)]
843QED
844
845Theorem ADD_EQ_0:
846 !m n. (m + n = 0) <=> (m = 0) /\ (n = 0)
847Proof
848 INDUCT_TAC
849 THEN GEN_TAC
850 THEN ASM_REWRITE_TAC[ADD_CLAUSES,NOT_SUC]
851QED
852
853Theorem ADD_EQ_1:
854 !m n. (m + n = 1) <=> (m = 1) /\ (n = 0) \/ (m = 0) /\ (n = 1)
855Proof
856 INDUCT_TAC THENL [
857 REWRITE_TAC [ADD_CLAUSES, ONE, GSYM NOT_SUC],
858 REWRITE_TAC [NOT_SUC, ADD_CLAUSES, ONE, INV_SUC_EQ, ADD_EQ_0]
859 ]
860QED
861
862Theorem ADD_INV_0_EQ:
863 !m n. (m + n = m) = (n = 0)
864Proof
865 REPEAT GEN_TAC
866 THEN EQ_TAC
867 THEN REWRITE_TAC[ADD_INV_0]
868 THEN STRIP_TAC
869 THEN ASM_REWRITE_TAC[ADD_CLAUSES]
870QED
871
872Theorem PRE_SUC_EQ:
873 !m n. 0<n ==> ((m = PRE n) = (SUC m = n))
874Proof
875 INDUCT_TAC
876 THEN INDUCT_TAC
877 THEN REWRITE_TAC[PRE,LESS_REFL,INV_SUC_EQ]
878QED
879
880Theorem INV_PRE_EQ:
881 !m n. 0<m /\ 0<n ==> ((PRE m = (PRE n)) = (m = n))
882Proof
883 INDUCT_TAC
884 THEN INDUCT_TAC
885 THEN REWRITE_TAC[PRE,LESS_REFL,INV_SUC_EQ]
886QED
887
888Theorem LESS_SUC_NOT:
889 !m n. (m < n) ==> ~(n < SUC m)
890Proof
891 REPEAT GEN_TAC
892 THEN ASM_REWRITE_TAC[NOT_LESS]
893 THEN REPEAT STRIP_TAC
894 THEN IMP_RES_TAC LESS_OR
895 THEN ASM_REWRITE_TAC[]
896QED
897
898Theorem ADD_EQ_SUB:
899 !m n p. (n <= p) ==> (((m + n) = p) = (m = (p - n)))
900Proof
901 GEN_TAC THEN REPEAT INDUCT_TAC THEN
902 ASM_REWRITE_TAC [ADD_CLAUSES,SUB_MONO_EQ,INV_SUC_EQ,LESS_EQ_MONO,
903 SUB_0, NOT_SUC_LESS_EQ_0]
904QED
905
906Theorem LESS_MONO_ADD:
907 !m n p. (m < n) ==> (m + p) < (n + p)
908Proof
909 GEN_TAC
910 THEN GEN_TAC
911 THEN INDUCT_TAC
912 THEN DISCH_TAC
913 THEN RES_TAC
914 THEN ASM_REWRITE_TAC[ADD_CLAUSES,LESS_MONO_EQ]
915QED
916
917Theorem LESS_MONO_ADD_INV:
918 !m n p. (m + p) < (n + p) ==> (m < n)
919Proof
920 GEN_TAC
921 THEN GEN_TAC
922 THEN INDUCT_TAC
923 THEN ASM_REWRITE_TAC[ADD_CLAUSES,LESS_MONO_EQ]
924QED
925
926Theorem LESS_MONO_ADD_EQ:
927 !m n p. ((m + p) < (n + p)) = (m < n)
928Proof
929 REPEAT GEN_TAC
930 THEN EQ_TAC
931 THEN REWRITE_TAC[LESS_MONO_ADD,LESS_MONO_ADD_INV]
932QED
933
934Theorem LT_ADD_RCANCEL = LESS_MONO_ADD_EQ
935Theorem LT_ADD_LCANCEL =
936 ONCE_REWRITE_RULE [ADD_COMM] LT_ADD_RCANCEL
937
938Theorem EQ_MONO_ADD_EQ:
939 !m n p. ((m + p) = (n + p)) = (m = n)
940Proof
941 GEN_TAC
942 THEN GEN_TAC
943 THEN INDUCT_TAC
944 THEN ASM_REWRITE_TAC[ADD_CLAUSES,INV_SUC_EQ]
945QED
946
947val _ = print "Proving properties of <=\n"
948
949Theorem LESS_EQ_MONO_ADD_EQ:
950 !m n p. ((m + p) <= (n + p)) = (m <= n)
951Proof
952 REPEAT GEN_TAC
953 THEN REWRITE_TAC[LESS_OR_EQ]
954 THEN REPEAT STRIP_TAC
955 THEN REWRITE_TAC[LESS_MONO_ADD_EQ,EQ_MONO_ADD_EQ]
956QED
957
958Theorem LESS_EQ_TRANS:
959 !m n p. (m <= n) /\ (n <= p) ==> (m <= p)
960Proof
961 REWRITE_TAC[LESS_OR_EQ_ALT, REWRITE_RULE
962 [relationTheory.transitive_def] relationTheory.transitive_RTC]
963QED
964
965Theorem transitive_LE[simp]:
966 transitive $<=
967Proof
968 REWRITE_TAC[relationTheory.transitive_def] >>
969 MATCH_ACCEPT_TAC LESS_EQ_TRANS
970QED
971
972Theorem LESS_EQ_LESS_TRANS:
973 !m n p. m <= n /\ n < p ==> m < p
974Proof
975 REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN
976 ASM_CASES_TAC (“m:num = n”) THEN ASM_REWRITE_TAC[LESS_TRANS]
977QED
978
979Theorem LESS_LESS_EQ_TRANS:
980 !m n p. m < n /\ n <= p ==> m < p
981Proof
982 REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN
983 ASM_CASES_TAC (“n:num = p”) THEN ASM_REWRITE_TAC[LESS_TRANS]
984QED
985
986Theorem LE_TRANS = LESS_EQ_TRANS (* HOL-Light compatible name *)
987Theorem LET_TRANS = LESS_EQ_LESS_TRANS (* HOL-Light compatible name *)
988Theorem LTE_TRANS = LESS_LESS_EQ_TRANS (* HOL-Light compatible name *)
989
990(* % Proof modified for new IMP_RES_TAC [TFM 90.04.25] *)
991
992Theorem LESS_EQ_LESS_EQ_MONO:
993 !m n p q. (m <= p) /\ (n <= q) ==> ((m + n) <= (p + q))
994Proof
995 REPEAT STRIP_TAC THEN
996 let val th1 = snd(EQ_IMP_RULE (SPEC_ALL LESS_EQ_MONO_ADD_EQ))
997 val th2 = PURE_ONCE_REWRITE_RULE [ADD_SYM] th1
998 in
999 IMP_RES_THEN (ASSUME_TAC o SPEC (“n:num”)) th1 THEN
1000 IMP_RES_THEN (ASSUME_TAC o SPEC (“p:num”)) th2 THEN
1001 IMP_RES_TAC LESS_EQ_TRANS
1002 end
1003QED
1004
1005Theorem LESS_EQ_REFL:
1006 !m. m <= m
1007Proof
1008 GEN_TAC
1009 THEN REWRITE_TAC[LESS_OR_EQ]
1010QED
1011
1012Theorem LE_REFL = LESS_EQ_REFL (* HOL-Light compatible name *)
1013
1014Theorem LESS_IMP_LESS_OR_EQ:
1015 !m n. (m < n) ==> (m <= n)
1016Proof
1017 REPEAT STRIP_TAC
1018 THEN ASM_REWRITE_TAC[LESS_OR_EQ]
1019QED
1020
1021Theorem LESS_MONO_MULT:
1022 !m n p. (m <= n) ==> ((m * p) <= (n * p))
1023Proof
1024 GEN_TAC
1025 THEN GEN_TAC
1026 THEN INDUCT_TAC
1027 THEN DISCH_TAC
1028 THEN ASM_REWRITE_TAC
1029 [ADD_CLAUSES,MULT_CLAUSES,LESS_EQ_MONO_ADD_EQ,LESS_EQ_REFL]
1030 THEN RES_TAC
1031 THEN IMP_RES_TAC(SPECL[“m:num”,“m*p”,“n:num”,“n*p”]
1032 LESS_EQ_LESS_EQ_MONO)
1033 THEN ASM_REWRITE_TAC[]
1034QED
1035
1036Theorem LESS_MONO_MULT2:
1037 !m n i j. m <= i /\ n <= j ==> m * n <= i * j
1038Proof
1039 mesonLib.MESON_TAC [LESS_EQ_TRANS, LESS_MONO_MULT, MULT_COMM]
1040QED
1041
1042(* Proof modified for new IMP_RES_TAC [TFM 90.04.25] *)
1043
1044Theorem RIGHT_SUB_DISTRIB:
1045 !m n p. (m - n) * p = (m * p) - (n * p)
1046Proof
1047 REPEAT GEN_TAC THEN
1048 ASM_CASES_TAC (“n <= m”) THENL
1049 [let val imp = SPECL [“(m-n)*p”,
1050 “n*p”,
1051 “m*p”] ADD_EQ_SUB
1052 in
1053 IMP_RES_THEN (SUBST1_TAC o SYM o MP imp o SPEC (“p:num”))
1054 LESS_MONO_MULT THEN
1055 REWRITE_TAC[SYM(SPEC_ALL RIGHT_ADD_DISTRIB)] THEN
1056 IMP_RES_THEN SUBST1_TAC SUB_ADD THEN REFL_TAC
1057 end,
1058 IMP_RES_TAC (REWRITE_RULE[](AP_TERM (“$~”)
1059 (SPEC_ALL NOT_LESS))) THEN
1060 IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN
1061 IMP_RES_THEN (ASSUME_TAC o SPEC (“p:num”)) LESS_MONO_MULT THEN
1062 IMP_RES_TAC SUB_EQ_0 THEN
1063 ASM_REWRITE_TAC[MULT_CLAUSES]]
1064QED
1065
1066Theorem LEFT_SUB_DISTRIB:
1067 !m n p. p * (m - n) = (p * m) - (p * n)
1068Proof
1069 PURE_ONCE_REWRITE_TAC [MULT_SYM] THEN
1070 REWRITE_TAC [RIGHT_SUB_DISTRIB]
1071QED
1072
1073(* The following theorem (and proof) are from tfm [rewritten TFM 90.09.21] *)
1074Theorem LESS_ADD_1:
1075 !m n. (n<m) ==> ?p. m = n + (p + 1)
1076Proof
1077 REWRITE_TAC [ONE] THEN INDUCT_TAC THEN
1078 REWRITE_TAC[NOT_LESS_0,LESS_THM] THEN
1079 REPEAT STRIP_TAC THENL [
1080 EXISTS_TAC (“0”) THEN ASM_REWRITE_TAC [ADD_CLAUSES],
1081 RES_THEN (STRIP_THM_THEN SUBST1_TAC) THEN
1082 EXISTS_TAC (“SUC p”) THEN REWRITE_TAC [ADD_CLAUSES]
1083]
1084QED
1085
1086(* ---------------------------------------------------------------------*)
1087(* The following arithmetic theorems were added by TFM in 88.03.31 *)
1088(* *)
1089(* These are needed to build the recursive type definition package *)
1090(* ---------------------------------------------------------------------*)
1091
1092Theorem EXP_ADD:
1093 !p q n. n EXP (p+q) = (n EXP p) * (n EXP q)
1094Proof
1095 INDUCT_TAC THEN
1096 ASM_REWRITE_TAC [EXP,ADD_CLAUSES,MULT_CLAUSES,MULT_ASSOC]
1097QED
1098
1099Theorem NUM_EXP_ADD = EXP_ADD
1100
1101Theorem NOT_ODD_EQ_EVEN:
1102 !n m. ~(SUC(n + n) = (m + m))
1103Proof
1104 REPEAT (INDUCT_TAC THEN REWRITE_TAC [ADD_CLAUSES]) THENL
1105 [MATCH_ACCEPT_TAC NOT_SUC,
1106 REWRITE_TAC [INV_SUC_EQ,NOT_EQ_SYM (SPEC_ALL NOT_SUC)],
1107 REWRITE_TAC [INV_SUC_EQ,NOT_SUC],
1108 ASM_REWRITE_TAC [INV_SUC_EQ]]
1109QED
1110
1111Theorem LESS_EQUAL_ANTISYM:
1112 !n m. n <= m /\ m <= n ==> (n = m)
1113Proof
1114 REWRITE_TAC [LESS_OR_EQ] THEN
1115 REPEAT STRIP_TAC THENL
1116 [IMP_RES_TAC LESS_ANTISYM,
1117 ASM_REWRITE_TAC[]]
1118QED
1119
1120Theorem LE_ANTISYM :
1121 !m (n :num). m <= n /\ n <= m <=> m = n
1122Proof
1123 rpt GEN_TAC
1124 >> EQ_TAC >> rpt STRIP_TAC
1125 >- (MATCH_MP_TAC LESS_EQUAL_ANTISYM \\
1126 ASM_REWRITE_TAC [])
1127 >> ASM_REWRITE_TAC [LESS_EQ_REFL]
1128QED
1129
1130Theorem LESS_ADD_SUC:
1131 !m n. m < m + SUC n
1132Proof
1133 INDUCT_TAC THENL
1134 [REWRITE_TAC [LESS_0,ADD_CLAUSES],
1135 POP_ASSUM (ASSUME_TAC o REWRITE_RULE [ADD_CLAUSES]) THEN
1136 ASM_REWRITE_TAC [LESS_MONO_EQ,ADD_CLAUSES]]
1137QED
1138
1139(* Following proof revised for version 1.12 resolution. [TFM 91.01.18] *)
1140Theorem LESS_OR_EQ_ADD:
1141 !n m. n < m \/ ?p. n = p+m
1142Proof
1143 REPEAT GEN_TAC THEN ASM_CASES_TAC (“n<m”) THENL
1144 [DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC,
1145 DISJ2_TAC THEN IMP_RES_TAC NOT_LESS THEN IMP_RES_TAC LESS_OR_EQ THENL
1146 [CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN
1147 IMP_RES_THEN MATCH_ACCEPT_TAC LESS_ADD,
1148 EXISTS_TAC (“0”) THEN ASM_REWRITE_TAC [ADD]]]
1149QED
1150
1151(*----------------------------------------------------------------------*)
1152(* Added TFM 88.03.31 *)
1153(* *)
1154(* Prove the well ordering property: *)
1155(* *)
1156(* |- !P. (?n. P n) ==> (?n. P n /\ (!m. m < n ==> ~P m)) *)
1157(* *)
1158(* I.e. considering P to be a set, that is the set of numbers, x , such *)
1159(* that P(x), then every non-empty P has a smallest element. *)
1160(* *)
1161(* We first prove that, if there does NOT exist a smallest n such that *)
1162(* P(n) is true, then for all n P is false of all numbers smaller than n.*)
1163(* The main step is an induction on n. *)
1164(*----------------------------------------------------------------------*)
1165
1166val lemma = TAC_PROOF(([],
1167 “(~?n. P n /\ !m. (m<n) ==> ~P m) ==> (!n m. (m<n) ==> ~P m)”),
1168 CONV_TAC (DEPTH_CONV NOT_EXISTS_CONV) THEN
1169 DISCH_TAC THEN
1170 INDUCT_TAC THEN
1171 REWRITE_TAC [NOT_LESS_0,LESS_THM] THEN
1172 REPEAT (FILTER_STRIP_TAC (“P:num->bool”)) THENL
1173 [POP_ASSUM SUBST1_TAC THEN DISCH_TAC,ALL_TAC] THEN
1174 RES_TAC);
1175
1176(* We now prove the well ordering property. *)
1177Theorem WOP:
1178 !P. (?n.P n) ==> (?n. P n /\ (!m. (m<n) ==> ~P m))
1179Proof
1180 GEN_TAC THEN
1181 CONV_TAC CONTRAPOS_CONV THEN
1182 DISCH_THEN (ASSUME_TAC o MP lemma) THEN
1183 CONV_TAC NOT_EXISTS_CONV THEN
1184 GEN_TAC THEN
1185 POP_ASSUM (MATCH_MP_TAC o SPECL [“SUC n”,“n:num”]) THEN
1186 MATCH_ACCEPT_TAC LESS_SUC_REFL
1187QED
1188
1189(* anything can be well-ordered if mapped into the natural numbers;
1190 take the contrapositive to make all constants positive *)
1191Theorem WOP_measure:
1192 !P m. (?a:'a. P a) ==> ?b. P b /\ !c. P c ==> m b <= m c
1193Proof
1194 rpt strip_tac >>
1195 Q.SPEC_THEN ‘m’ assume_tac prim_recTheory.WF_measure >>
1196 dxrule_then (Q.SPEC_THEN ‘P’ mp_tac) (iffLR relationTheory.WF_DEF) >>
1197 simp_tac bool_ss [PULL_EXISTS] >>
1198 disch_then dxrule >>
1199 REWRITE_TAC [prim_recTheory.measure_thm] >>
1200 METIS_TAC [NOT_LESS]
1201QED
1202
1203Theorem COMPLETE_INDUCTION:
1204 !P. (!n. (!m. m < n ==> P m) ==> P n) ==> !n. P n
1205Proof
1206 let val wopeta = CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) WOP
1207 in
1208 GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
1209 CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
1210 DISCH_THEN(MP_TAC o MATCH_MP wopeta) THEN BETA_TAC THEN
1211 REWRITE_TAC[NOT_IMP] THEN DISCH_THEN(X_CHOOSE_TAC (“n:num”)) THEN
1212 EXISTS_TAC (“n:num”) THEN ASM_REWRITE_TAC[]
1213 end
1214QED
1215
1216Theorem FORALL_NUM_THM:
1217 (!n. P n) <=> P 0 /\ !n. P n ==> P (SUC n)
1218Proof
1219 METIS_TAC [INDUCTION]
1220QED
1221
1222(* ---------------------------------------------------------------------*)
1223(* Some more theorems, mostly about subtraction. *)
1224(* ---------------------------------------------------------------------*)
1225
1226Theorem SUC_SUB[simp]:
1227 !a. SUC a - a = 1
1228Proof
1229 INDUCT_TAC THENL [
1230 REWRITE_TAC [SUB, LESS_REFL, ONE],
1231 ASM_REWRITE_TAC [SUB_MONO_EQ]
1232 ]
1233QED
1234
1235Theorem SUB_PLUS:
1236 !a b c. a - (b + c) = (a - b) - c
1237Proof
1238 REPEAT INDUCT_TAC THEN
1239 REWRITE_TAC [SUB_0,ADD_CLAUSES,SUB_MONO_EQ] THEN
1240 PURE_ONCE_REWRITE_TAC [SYM (el 4 (CONJUNCTS ADD_CLAUSES))] THEN
1241 PURE_ONCE_ASM_REWRITE_TAC [] THEN REFL_TAC
1242QED
1243
1244(* Statement of thm changed.
1245**val INV_PRE_LESS = store_thm ("INV_PRE_LESS",
1246** “!m n. 0 < m /\ 0 < n ==> ((PRE m < PRE n) = (m < n))”,
1247** REPEAT INDUCT_TAC THEN
1248** REWRITE_TAC[LESS_REFL,SUB,LESS_0,PRE] THEN
1249** MATCH_ACCEPT_TAC (SYM(SPEC_ALL LESS_MONO_EQ)));
1250*)
1251Theorem INV_PRE_LESS:
1252 !m. 0 < m ==> !n. PRE m < PRE n <=> m < n
1253Proof
1254 REPEAT (INDUCT_TAC THEN TRY DISCH_TAC) THEN
1255 REWRITE_TAC[LESS_REFL,SUB,LESS_0,PRE,NOT_LESS_0] THEN
1256 IMP_RES_TAC LESS_REFL THEN
1257 MATCH_ACCEPT_TAC (SYM(SPEC_ALL LESS_MONO_EQ))
1258QED
1259
1260Theorem INV_PRE_LESS_EQ:
1261 !n. 0 < n ==> !m. ((PRE m <= PRE n) = (m <= n))
1262Proof
1263 INDUCT_TAC THEN
1264 REWRITE_TAC [LESS_REFL,LESS_0,PRE] THEN
1265 INDUCT_TAC THEN
1266 REWRITE_TAC [PRE,ZERO_LESS_EQ] THEN
1267 REWRITE_TAC [ADD1,LESS_EQ_MONO_ADD_EQ]
1268QED
1269
1270Theorem PRE_LESS_EQ:
1271 !n. m <= n ==> PRE m <= PRE n
1272Proof
1273 INDUCT_TAC THEN1
1274 (REWRITE_TAC [LESS_EQ_0] THEN DISCH_TAC THEN
1275 ASM_REWRITE_TAC [LESS_EQ_REFL]) THEN
1276 VALIDATE (CONV_TAC (DEPTH_CONV
1277 (REWR_CONV_A (SPEC_ALL (UNDISCH (SPEC_ALL INV_PRE_LESS_EQ)))))) THEN
1278 REWRITE_TAC [LESS_0]
1279QED
1280
1281Theorem SUB_LESS_EQ:
1282 !n m. (n - m) <= n
1283Proof
1284 REWRITE_TAC [SYM(SPEC_ALL SUB_EQ_0),SYM(SPEC_ALL SUB_PLUS)] THEN
1285 CONV_TAC (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM)) THEN
1286 REWRITE_TAC [SUB_EQ_0,LESS_EQ_ADD]
1287QED
1288
1289Theorem SUB_EQ_EQ_0:
1290 !m n. (m - n = m) = ((m = 0) \/ (n = 0))
1291Proof
1292 REPEAT INDUCT_TAC THEN
1293 REWRITE_TAC [SUB_0,NOT_SUC] THEN
1294 REWRITE_TAC [SUB] THEN
1295 ASM_CASES_TAC (“m<SUC n”) THENL
1296 [CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN ASM_REWRITE_TAC [NOT_SUC],
1297 ASM_REWRITE_TAC [INV_SUC_EQ,NOT_SUC] THEN
1298 IMP_RES_THEN (ASSUME_TAC o MATCH_MP OR_LESS) NOT_LESS THEN
1299 IMP_RES_THEN (STRIP_THM_THEN SUBST1_TAC) LESS_ADD_1 THEN
1300 REWRITE_TAC [ONE, ADD_CLAUSES, NOT_SUC]]
1301QED
1302
1303Theorem SUB_LESS_0:
1304 !n m. m < n <=> 0 < n - m
1305Proof
1306 REPEAT STRIP_TAC THEN EQ_TAC THENL
1307 [DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1308 REWRITE_TAC [ONE,ADD_CLAUSES,SUB] THEN
1309 REWRITE_TAC [REWRITE_RULE [SYM(SPEC_ALL NOT_LESS)] LESS_EQ_ADD,LESS_0],
1310 CONV_TAC CONTRAPOS_CONV THEN
1311 REWRITE_TAC [NOT_LESS,LESS_OR_EQ,NOT_LESS_0,SUB_EQ_0]]
1312QED
1313
1314Theorem SUB_LESS_OR:
1315 !m n. n < m ==> n <= (m - 1)
1316Proof
1317 REPEAT GEN_TAC THEN
1318 DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1319 REWRITE_TAC [SYM (SPEC_ALL PRE_SUB1)] THEN
1320 REWRITE_TAC [PRE,ONE,ADD_CLAUSES,LESS_EQ_ADD]
1321QED
1322
1323Theorem SUB_LESS_OR_EQ :
1324 !m n. 0 < m ==> (n <= m - 1 <=> n < m)
1325Proof
1326 rpt STRIP_TAC
1327 >> reverse EQ_TAC
1328 >- REWRITE_TAC [SUB_LESS_OR]
1329 >> Cases_on ‘m’
1330 >- FULL_SIMP_TAC std_ss [LESS_REFL]
1331 >> REWRITE_TAC [SUC_SUB1, LT_SUC_LE]
1332QED
1333
1334Theorem LESS_SUB_ADD_LESS:
1335 !n m i. (i < (n - m)) ==> ((i + m) < n)
1336Proof
1337 INDUCT_TAC THENL
1338 [REWRITE_TAC [SUB_0,NOT_LESS_0],
1339 REWRITE_TAC [SUB] THEN REPEAT GEN_TAC THEN
1340 ASM_CASES_TAC (“n < m”) THEN
1341 ASM_REWRITE_TAC [NOT_LESS_0,LESS_THM] THEN
1342 let fun tac th g = SUBST1_TAC th g
1343 handle _ => ASSUME_TAC th g
1344 in
1345 DISCH_THEN (STRIP_THM_THEN tac)
1346 end THENL
1347 [DISJ1_TAC THEN MATCH_MP_TAC SUB_ADD THEN
1348 ASM_REWRITE_TAC [SYM(SPEC_ALL NOT_LESS)],
1349 RES_TAC THEN ASM_REWRITE_TAC[]]]
1350QED
1351
1352Theorem TIMES2:
1353 !n. 2 * n = n + n
1354Proof
1355 REWRITE_TAC [MULT_CLAUSES, NUMERAL_DEF, BIT2, ADD_CLAUSES,ALT_ZERO]
1356QED
1357
1358Theorem LESS_MULT_MONO:
1359 !m i n. SUC n * m < SUC n * i <=> m < i
1360Proof
1361 REWRITE_TAC [MULT_CLAUSES] THEN
1362 INDUCT_TAC THENL
1363 [INDUCT_TAC THEN REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES,LESS_0],
1364 INDUCT_TAC THENL
1365 [REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES,NOT_LESS_0],
1366 INDUCT_TAC THENL
1367 [REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES],
1368 REWRITE_TAC [LESS_MONO_EQ,ADD_CLAUSES,MULT_CLAUSES] THEN
1369 REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN
1370 PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN
1371 REWRITE_TAC [LESS_MONO_ADD_EQ] THEN
1372 REWRITE_TAC [ADD_ASSOC] THEN
1373 let val th = SYM(el 5 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))
1374 in
1375 PURE_ONCE_REWRITE_TAC [th]
1376 end THEN
1377 ASM_REWRITE_TAC[]]]]
1378QED
1379
1380Theorem MULT_MONO_EQ:
1381 !m i n. (((SUC n) * m) = ((SUC n) * i)) = (m = i)
1382Proof
1383 REWRITE_TAC [MULT_CLAUSES] THEN
1384 INDUCT_TAC THENL
1385 [INDUCT_TAC THEN
1386 REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES, NOT_EQ_SYM(SPEC_ALL NOT_SUC)],
1387 INDUCT_TAC THENL
1388 [REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES,NOT_SUC],
1389 INDUCT_TAC THENL
1390 [REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES],
1391 REWRITE_TAC [INV_SUC_EQ,ADD_CLAUSES,MULT_CLAUSES] THEN
1392 REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN
1393 PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN
1394 REWRITE_TAC [EQ_MONO_ADD_EQ] THEN
1395 REWRITE_TAC [ADD_ASSOC] THEN
1396 let val th = SYM(el 5 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))
1397 in
1398 PURE_ONCE_REWRITE_TAC [th]
1399 end THEN
1400 ASM_REWRITE_TAC[]]]]
1401QED
1402
1403Theorem MULT_SUC_EQ:
1404 !p m n. ((n * (SUC p)) = (m * (SUC p))) = (n = m)
1405Proof
1406 ONCE_REWRITE_TAC [MULT_COMM] THEN REWRITE_TAC [MULT_MONO_EQ]
1407QED
1408
1409Theorem MULT_EXP_MONO:
1410 !p q n m.((n * ((SUC q) EXP p)) = (m * ((SUC q) EXP p))) = (n = m)
1411Proof
1412 INDUCT_TAC THENL
1413 [REWRITE_TAC [EXP,MULT_CLAUSES,ADD_CLAUSES],
1414 ASM_REWRITE_TAC [EXP,MULT_ASSOC,MULT_SUC_EQ]]
1415QED
1416
1417Theorem EQ_ADD_LCANCEL:
1418 !m n p. (m + n = m + p) = (n = p)
1419Proof
1420 INDUCT_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES, INV_SUC_EQ]
1421QED
1422
1423Theorem EQ_ADD_RCANCEL:
1424 !m n p. (m + p = n + p) = (m = n)
1425Proof
1426 ONCE_REWRITE_TAC[ADD_COMM] THEN MATCH_ACCEPT_TAC EQ_ADD_LCANCEL
1427QED
1428
1429Theorem EQ_MULT_LCANCEL[simp]:
1430 !m n p. (m * n = m * p) <=> (m = 0) \/ (n = p)
1431Proof
1432 INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES, NOT_SUC] THEN
1433 REPEAT INDUCT_TAC THEN
1434 ASM_REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, GSYM NOT_SUC, NOT_SUC] THEN
1435 ASM_REWRITE_TAC[INV_SUC_EQ, GSYM ADD_ASSOC, EQ_ADD_LCANCEL]
1436QED
1437
1438Theorem EQ_MULT_RCANCEL[simp]:
1439 !m n p. (n * m = p * m) <=> (m = 0) \/ (n = p)
1440Proof ONCE_REWRITE_TAC [MULT_COMM] THEN REWRITE_TAC [EQ_MULT_LCANCEL]
1441QED
1442
1443Theorem ADD_SUB:
1444 !a c. (a + c) - c = a
1445Proof
1446 GEN_TAC THEN INDUCT_TAC THEN
1447 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ]
1448QED
1449
1450(* ported from HOL-Light *)
1451Theorem ADD_SUB2 :
1452 !m n. (m + n) - m = n
1453Proof
1454 ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC ADD_SUB
1455QED
1456
1457Theorem LESS_EQ_ADD_SUB:
1458 !c b. (c <= b) ==> !a. (((a + b) - c) = (a + (b - c)))
1459Proof
1460 REPEAT INDUCT_TAC THEN
1461 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
1462 NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
1463QED
1464
1465(* ---------------------------------------------------------------------*)
1466(* SUB_EQUAL_0 = |- !c. c - c = 0 *)
1467(* ---------------------------------------------------------------------*)
1468
1469val _ = print "More properties of subtraction...\n"
1470
1471Theorem SUB_EQUAL_0 =
1472 REWRITE_RULE [ADD_CLAUSES] (SPEC (“0”) ADD_SUB);
1473
1474Theorem LESS_EQ_SUB_LESS:
1475 !a b. (b <= a) ==> !c. ((a - b) < c) = (a < (b + c))
1476Proof
1477 REPEAT INDUCT_TAC THEN
1478 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
1479 NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, LESS_MONO_EQ]
1480QED
1481
1482Theorem NOT_SUC_LESS_EQ:
1483 !n m.~(SUC n <= m) = (m <= n)
1484Proof
1485 REWRITE_TAC [SYM (SPEC_ALL LESS_EQ),NOT_LESS]
1486QED
1487
1488Theorem SUB_SUB:
1489 !b c. (c <= b) ==> !a. ((a - (b - c)) = ((a + c) - b))
1490Proof
1491 REPEAT INDUCT_TAC THEN
1492 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
1493 NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
1494QED
1495
1496Theorem LESS_IMP_LESS_ADD:
1497 !n m. n < m ==> !p. n < (m + p)
1498Proof
1499 REPEAT GEN_TAC THEN
1500 DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
1501 REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC), ONE] THEN
1502 PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN
1503 PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN
1504 GEN_TAC THEN MATCH_ACCEPT_TAC LESS_ADD_SUC
1505QED
1506
1507Theorem SUB_LESS_EQ_ADD:
1508 !m p. (m <= p) ==> !n. (((p - m) <= n) = (p <= (m + n)))
1509Proof
1510 REPEAT INDUCT_TAC THEN
1511 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
1512 NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
1513QED
1514
1515Theorem SUB_LESS_SUC:
1516 !p m. p - m < SUC p
1517Proof
1518 REPEAT GEN_TAC THEN
1519 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN
1520 Q.EXISTS_TAC `p` THEN CONJ_TAC
1521 THENL [ MATCH_ACCEPT_TAC SUB_LESS_EQ,
1522 MATCH_ACCEPT_TAC LESS_SUC_REFL]
1523QED
1524
1525val SUB_NE_SUC = MATCH_MP LESS_NOT_EQ (SPEC_ALL SUB_LESS_SUC) ;
1526val SUB_LE_SUC = MATCH_MP LESS_IMP_LESS_OR_EQ (SPEC_ALL SUB_LESS_SUC) ;
1527
1528Theorem SUB_CANCEL:
1529 !p n m. ((n <= p) /\ (m <= p)) ==> (((p - n) = (p - m)) = (n = m))
1530Proof
1531 REPEAT INDUCT_TAC THEN
1532 ASM_REWRITE_TAC [SUB_0, ZERO_LESS_EQ, SUB_MONO_EQ, LESS_EQ_MONO, INV_SUC_EQ,
1533 NOT_SUC_LESS_EQ_0, NOT_SUC, GSYM NOT_SUC, SUB_NE_SUC, GSYM SUB_NE_SUC]
1534QED
1535
1536Theorem CANCEL_SUB:
1537 !p n m.((p <= n) /\ (p <= m)) ==> (((n - p) = (m - p)) = (n = m))
1538Proof
1539 REPEAT INDUCT_TAC THEN
1540 ASM_REWRITE_TAC [SUB_0, ZERO_LESS_EQ, SUB_MONO_EQ, LESS_EQ_MONO, INV_SUC_EQ,
1541 NOT_SUC_LESS_EQ_0]
1542QED
1543
1544Theorem NOT_EXP_0:
1545 !m n. ~(((SUC n) EXP m) = 0)
1546Proof
1547 INDUCT_TAC THEN REWRITE_TAC [EXP] THENL
1548 [REWRITE_TAC [NOT_SUC, ONE],
1549 STRIP_TAC THEN
1550 let val th = (SYM(el 2 (CONJUNCTS (SPECL [“SUC n”,“1”]
1551 MULT_CLAUSES))))
1552 in
1553 SUBST1_TAC th
1554 end THEN REWRITE_TAC [MULT_MONO_EQ] THEN
1555 FIRST_ASSUM MATCH_ACCEPT_TAC]
1556QED
1557
1558Theorem ZERO_LESS_EXP:
1559 !m n. 0 < ((SUC n) EXP m)
1560Proof
1561 REPEAT STRIP_TAC THEN
1562 let val th = SPEC (“(SUC n) EXP m”) LESS_0_CASES
1563 fun tac th g = ASSUME_TAC (SYM th) g
1564 handle _ => ACCEPT_TAC th g
1565 in
1566 STRIP_THM_THEN tac th THEN
1567 IMP_RES_TAC NOT_EXP_0
1568 end
1569QED
1570
1571Theorem ODD_OR_EVEN:
1572 !n. ?m. (n = (SUC(SUC 0) * m)) \/ (n = ((SUC(SUC 0) * m) + 1))
1573Proof
1574 REWRITE_TAC [ONE] THEN
1575 INDUCT_THEN INDUCTION STRIP_ASSUME_TAC THENL
1576 [EXISTS_TAC (“0”) THEN REWRITE_TAC [ADD_CLAUSES,MULT_CLAUSES],
1577 EXISTS_TAC (“m:num”) THEN ASM_REWRITE_TAC[ADD_CLAUSES],
1578 EXISTS_TAC (“SUC m”) THEN ASM_REWRITE_TAC[MULT_CLAUSES,ADD_CLAUSES]]
1579QED
1580
1581Theorem LESS_EXP_SUC_MONO:
1582 !n m.((SUC(SUC m)) EXP n) < ((SUC(SUC m)) EXP (SUC n))
1583Proof
1584 INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC [EXP] THENL
1585 [REWRITE_TAC [EXP,ADD_CLAUSES,MULT_CLAUSES,ONE,LESS_0, LESS_MONO_EQ],
1586 ASM_REWRITE_TAC [LESS_MULT_MONO]]
1587QED
1588
1589(*---------------------------------------------------------------------------*)
1590(* More arithmetic theorems, mainly concerning orderings [JRH 92.07.14] *)
1591(*---------------------------------------------------------------------------*)
1592
1593Theorem LESS_LESS_CASES:
1594 !m n. (m = n) \/ (m < n) \/ (n < m)
1595Proof
1596 let val th = REWRITE_RULE[LESS_OR_EQ]
1597 (SPECL[(“m:num”), (“n:num”)] LESS_CASES)
1598 in REPEAT GEN_TAC THEN
1599 REPEAT_TCL DISJ_CASES_THEN (fn t => REWRITE_TAC[t]) th
1600 end
1601QED
1602
1603Theorem num_nchotomy = LESS_LESS_CASES (* from examples/algebra *)
1604
1605Theorem GREATER_EQ:
1606 !n m. n >= m <=> m <= n
1607Proof
1608 REPEAT GEN_TAC THEN REWRITE_TAC[GREATER_OR_EQ, GREATER_DEF, LESS_OR_EQ] THEN
1609 AP_TERM_TAC THEN MATCH_ACCEPT_TAC EQ_SYM_EQ
1610QED
1611
1612Theorem GE = GREATER_EQ (* HOL Light alias *)
1613Theorem LESS_EQ_CASES = LE_CASES
1614
1615Theorem LESS_EQUAL_ADD:
1616 !m n. m <= n ==> ?p. n = m + p
1617Proof
1618 REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN
1619 DISCH_THEN(DISJ_CASES_THEN2 MP_TAC SUBST1_TAC) THENL
1620 [MATCH_ACCEPT_TAC(GSYM (ONCE_REWRITE_RULE[ADD_SYM] LESS_ADD)),
1621 EXISTS_TAC (“0”) THEN REWRITE_TAC[ADD_CLAUSES]]
1622QED
1623
1624Theorem LESS_EQ_EXISTS:
1625 !m n. m <= n <=> ?p. n = m + p
1626Proof
1627 REPEAT GEN_TAC THEN EQ_TAC THENL
1628 [MATCH_ACCEPT_TAC LESS_EQUAL_ADD,
1629 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC LESS_EQ_ADD]
1630QED
1631
1632Theorem MULT_EQ_0:
1633 !m n. (m * n = 0) <=> (m = 0) \/ (n = 0)
1634Proof
1635 REPEAT GEN_TAC THEN
1636 MAP_EVERY (STRUCT_CASES_TAC o C SPEC num_CASES) [(“m:num”),(“n:num”)]
1637 THEN REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, NOT_SUC]
1638QED
1639
1640Theorem MULT_EQ_1:
1641 !x y. (x * y = 1) <=> (x = 1) /\ (y = 1)
1642Proof
1643 REPEAT GEN_TAC THEN
1644 MAP_EVERY (STRUCT_CASES_TAC o C SPEC num_CASES)
1645 [(“x:num”),(“y:num”)] THEN
1646 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, ONE, GSYM SUC_ID, INV_SUC_EQ,
1647 ADD_EQ_0,MULT_EQ_0] THEN EQ_TAC THEN STRIP_TAC THEN
1648 ASM_REWRITE_TAC[]
1649QED
1650
1651Theorem MULT_EQ_ID[simp]:
1652 !m n. (m * n = n <=> m=1 \/ n=0) /\
1653 (n * m = n <=> m=1 \/ n=0)
1654Proof
1655 REPEAT GEN_TAC THEN REVERSE CONJ_ASM1_TAC
1656 THEN1 (ONCE_REWRITE_TAC [MULT_COMM] THEN ASM_REWRITE_TAC[]) THEN
1657 STRUCT_CASES_TAC (SPEC “m:num” num_CASES) THEN
1658 REWRITE_TAC [MULT_CLAUSES,ONE,GSYM NOT_SUC,INV_SUC_EQ] THENL
1659 [METIS_TAC[], METIS_TAC [ADD_INV_0_EQ,MULT_EQ_0,ADD_SYM]]
1660QED
1661
1662Theorem LESS_MULT2:
1663 !m n. 0 < m /\ 0 < n ==> 0 < (m * n)
1664Proof
1665 REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
1666 REWRITE_TAC[NOT_LESS, LESS_EQ_0, DE_MORGAN_THM, MULT_EQ_0]
1667QED
1668
1669Theorem MULT_POS = LESS_MULT2;
1670
1671Theorem ZERO_LESS_MULT[simp]:
1672 !m n. 0 < m * n <=> 0 < m /\ 0 < n
1673Proof
1674 REPEAT GEN_TAC THEN
1675 Q.SPEC_THEN `m` STRUCT_CASES_TAC num_CASES THEN
1676 REWRITE_TAC [MULT_CLAUSES, LESS_REFL, LESS_0] THEN
1677 Q.SPEC_THEN `n` STRUCT_CASES_TAC num_CASES THEN
1678 REWRITE_TAC [MULT_CLAUSES, LESS_REFL, LESS_0, ADD_CLAUSES]
1679QED
1680
1681Theorem ZERO_LESS_ADD:
1682 !m n. 0 < m + n <=> 0 < m \/ 0 < n
1683Proof
1684 REPEAT GEN_TAC THEN
1685 Q.SPEC_THEN `m` STRUCT_CASES_TAC num_CASES THEN
1686 REWRITE_TAC [ADD_CLAUSES, LESS_REFL, LESS_0]
1687QED
1688
1689(*---------------------------------------------------------------------------*)
1690(* Single theorem about the factorial function [JRH 92.07.14] *)
1691(*---------------------------------------------------------------------------*)
1692
1693val FACT = new_recursive_definition
1694 {name = "FACT",
1695 rec_axiom = num_Axiom,
1696 def = “(FACT 0 = 1) /\
1697 (FACT (SUC n) = (SUC n) * FACT(n))”};
1698
1699Theorem FACT_LESS:
1700 !n. 0 < FACT n
1701Proof
1702 INDUCT_TAC THEN REWRITE_TAC[FACT, ONE, LESS_SUC_REFL] THEN
1703 MATCH_MP_TAC LESS_MULT2 THEN ASM_REWRITE_TAC[LESS_0]
1704QED
1705
1706(* Theorem: 1 <= FACT n *)
1707(* Proof:
1708 Note 0 < FACT n by FACT_LESS
1709 so 1 <= FACT n by arithmetic
1710*)
1711Theorem FACT_GE_1:
1712 !n. 1 <= FACT n
1713Proof
1714 metis_tac[FACT_LESS, LESS_OR, ONE]
1715QED
1716
1717(* Idea: test if a function f is factorial. *)
1718
1719(* Theorem: f = FACT <=> f 0 = 1 /\ !n. f (SUC n) = SUC n * f n *)
1720(* Proof:
1721 If part is true by FACT
1722 Only-if part, apply FUN_EQ_THM, this is to show:
1723 !n. f n = FACT n.
1724 By induction on n.
1725 Base: f 0 = FACT 0
1726 f 0
1727 = 1 by given
1728 = FACT 0 by FACT_0
1729 Step: f n = FACT n ==> f (SUC n) = FACT (SUC n)
1730 f (SUC n)
1731 = SUC n * f n by given
1732 = SUC n * FACT n by induction hypothesis
1733 = FACT (SUC n) by FACT
1734*)
1735Theorem FACT_iff:
1736 !f. f = FACT <=> f 0 = 1 /\ !n. f (SUC n) = SUC n * f n
1737Proof
1738 rw[FACT, EQ_IMP_THM] >>
1739 rw[FUN_EQ_THM] >>
1740 Induct_on `x` >>
1741 simp[FACT]
1742QED
1743
1744(*---------------------------------------------------------------------------*)
1745(* Theorems about evenness and oddity [JRH 92.07.14] *)
1746(*---------------------------------------------------------------------------*)
1747
1748val _ = print "Theorems about evenness and oddity\n"
1749Theorem EVEN_ODD:
1750 !n. EVEN n = ~ODD n
1751Proof
1752 INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN, ODD]
1753QED
1754
1755Theorem ODD_EVEN:
1756 !n. ODD n = ~(EVEN n)
1757Proof
1758 REWRITE_TAC[EVEN_ODD]
1759QED
1760
1761Theorem EVEN_OR_ODD:
1762 !n. EVEN n \/ ODD n
1763Proof
1764 REWRITE_TAC[EVEN_ODD, REWRITE_RULE[DE_MORGAN_THM] NOT_AND]
1765QED
1766
1767Theorem EVEN_AND_ODD:
1768 !n. ~(EVEN n /\ ODD n)
1769Proof
1770 REWRITE_TAC[ODD_EVEN, NOT_AND]
1771QED
1772
1773Theorem EVEN_ADD:
1774 !m n. EVEN(m + n) = (EVEN m = EVEN n)
1775Proof
1776 INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES, EVEN] THEN
1777 BOOL_CASES_TAC (“EVEN m”) THEN REWRITE_TAC[]
1778QED
1779
1780Theorem EVEN_MULT:
1781 !m n. EVEN(m * n) <=> EVEN m \/ EVEN n
1782Proof
1783 INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES, EVEN_ADD, EVEN] THEN
1784 BOOL_CASES_TAC (“EVEN m”) THEN REWRITE_TAC[]
1785QED
1786
1787Theorem ODD_ADD:
1788 !m n. ODD(m + n) <=> ODD m <> ODD n
1789Proof
1790 REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EVEN, EVEN_ADD] THEN
1791 BOOL_CASES_TAC (“EVEN m”) THEN REWRITE_TAC[]
1792QED
1793
1794Theorem ODD_MULT:
1795 !m n. ODD(m * n) <=> ODD(m) /\ ODD(n)
1796Proof REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EVEN, EVEN_MULT, DE_MORGAN_THM]
1797QED
1798
1799Theorem two[local]:
1800 2 = SUC 1
1801Proof
1802 REWRITE_TAC [NUMERAL_DEF, BIT1, BIT2] THEN
1803 ONCE_REWRITE_TAC [SYM (SPEC (“0”) NUMERAL_DEF)] THEN
1804 REWRITE_TAC [ADD_CLAUSES]
1805QED
1806
1807Theorem EVEN_DOUBLE:
1808 !n. EVEN(2 * n)
1809Proof
1810 GEN_TAC THEN REWRITE_TAC[EVEN_MULT] THEN DISJ1_TAC THEN
1811 REWRITE_TAC[EVEN, ONE, two]
1812QED
1813
1814Theorem ODD_DOUBLE:
1815 !n. ODD(SUC(2 * n))
1816Proof
1817 REWRITE_TAC[ODD] THEN REWRITE_TAC[GSYM EVEN_ODD, EVEN_DOUBLE]
1818QED
1819
1820Theorem EVEN_ODD_EXISTS:
1821 !n. (EVEN n ==> ?m. n = 2 * m) /\ (ODD n ==> ?m. n = SUC(2 * m))
1822Proof
1823 REWRITE_TAC[ODD_EVEN] THEN INDUCT_TAC THEN REWRITE_TAC[EVEN] THENL
1824 [EXISTS_TAC (“0”) THEN REWRITE_TAC[MULT_CLAUSES],
1825 POP_ASSUM STRIP_ASSUME_TAC THEN CONJ_TAC THEN
1826 DISCH_THEN(fn th => FIRST_ASSUM(X_CHOOSE_THEN (“m:num”) SUBST1_TAC o
1827 C MATCH_MP th)) THENL
1828 [EXISTS_TAC (“SUC m”) THEN
1829 REWRITE_TAC[ONE, two, MULT_CLAUSES, ADD_CLAUSES],
1830 EXISTS_TAC (“m:num”) THEN REFL_TAC]]
1831QED
1832
1833Theorem EVEN_EXISTS:
1834 !n. EVEN n = ?m. n = 2 * m
1835Proof
1836 GEN_TAC THEN EQ_TAC THENL
1837 [REWRITE_TAC[EVEN_ODD_EXISTS],
1838 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC EVEN_DOUBLE]
1839QED
1840
1841Theorem ODD_EXISTS:
1842 !n. ODD n = ?m. n = SUC(2 * m)
1843Proof
1844 GEN_TAC THEN EQ_TAC THENL
1845 [REWRITE_TAC[EVEN_ODD_EXISTS],
1846 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC ODD_DOUBLE]
1847QED
1848
1849Theorem EVEN_EXP_IFF:
1850 !n m. EVEN (m ** n) <=> 0 < n /\ EVEN m
1851Proof
1852 INDUCT_TAC THEN
1853 ASM_REWRITE_TAC [EXP, ONE, EVEN, EVEN_MULT, LESS_0, LESS_REFL] THEN
1854 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC []
1855QED
1856
1857Theorem EVEN_EXP:
1858 !m n. 0 < n /\ EVEN m ==> EVEN (m ** n)
1859Proof
1860 METIS_TAC[EVEN_EXP_IFF]
1861QED
1862
1863Theorem ODD_EXP_IFF:
1864 !n m. ODD (m ** n) <=> (n = 0) \/ ODD m
1865Proof
1866 REWRITE_TAC [ODD_EVEN, EVEN_EXP_IFF, DE_MORGAN_THM, NOT_LT_ZERO_EQ_ZERO]
1867QED
1868
1869Theorem ODD_EXP:
1870 !m n. 0 < n /\ ODD m ==> ODD (m ** n)
1871Proof
1872 METIS_TAC[ODD_EXP_IFF, NOT_LT_ZERO_EQ_ZERO]
1873QED
1874
1875Theorem ODD_POS:
1876 !n. ODD n ==> 0 < n
1877Proof
1878 STRIP_TAC >> Cases_on ‘n’ >> REWRITE_TAC [ODD,LESS_0]
1879QED
1880
1881(* --------------------------------------------------------------------- *)
1882(* Theorems moved from the "more_arithmetic" library [RJB 92.09.28] *)
1883(* --------------------------------------------------------------------- *)
1884
1885Theorem EQ_LESS_EQ:
1886 !m n. (m = n) = ((m <= n) /\ (n <= m))
1887Proof
1888 REPEAT GEN_TAC THEN EQ_TAC
1889 THENL [STRIP_TAC THEN ASM_REWRITE_TAC [LESS_EQ_REFL],
1890 REWRITE_TAC [LESS_EQUAL_ANTISYM]]
1891QED
1892
1893Theorem ADD_MONO_LESS_EQ:
1894 !m n p. m + n <= m + p <=> n <= p
1895Proof ONCE_REWRITE_TAC [ADD_SYM]
1896 THEN REWRITE_TAC [LESS_EQ_MONO_ADD_EQ]
1897QED
1898Theorem LE_ADD_LCANCEL = ADD_MONO_LESS_EQ
1899Theorem LE_ADD_RCANCEL = ONCE_REWRITE_RULE [ADD_COMM] LE_ADD_LCANCEL
1900
1901(* ---------------------------------------------------------------------*)
1902(* Theorems to support the arithmetic proof procedure [RJB 92.09.29]*)
1903(* ---------------------------------------------------------------------*)
1904
1905val _ = print "Theorems to support the arithmetic proof procedure\n"
1906Theorem NOT_LEQ:
1907 !m n. ~(m <= n) <=> SUC n <= m
1908Proof
1909 REWRITE_TAC [SYM (SPEC_ALL LESS_EQ)] THEN
1910 REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)]
1911QED
1912
1913Theorem NOT_NUM_EQ:
1914 !m n. m <> n <=> SUC m <= n \/ SUC n <= m
1915Proof
1916 REWRITE_TAC [EQ_LESS_EQ,DE_MORGAN_THM,NOT_LEQ] THEN
1917 MATCH_ACCEPT_TAC DISJ_SYM
1918QED
1919
1920Theorem NOT_GREATER:
1921 !m n. ~(m > n) = (m <= n)
1922Proof
1923 REWRITE_TAC [GREATER_DEF,NOT_LESS]
1924QED
1925
1926Theorem NOT_GREATER_EQ:
1927 !m n. ~(m >= n) <=> SUC m <= n
1928Proof REWRITE_TAC [GREATER_EQ,NOT_LEQ]
1929QED
1930
1931Theorem SUC_ONE_ADD:
1932 !n. SUC n = 1 + n
1933Proof
1934 GEN_TAC THEN
1935 ONCE_REWRITE_TAC [ADD1,ADD_SYM] THEN
1936 REFL_TAC
1937QED
1938
1939Theorem SUC_ADD_SYM:
1940 !m n. SUC (m + n) = (SUC n) + m
1941Proof
1942 REPEAT GEN_TAC THEN
1943 REWRITE_TAC[ADD_CLAUSES] THEN
1944 AP_TERM_TAC THEN
1945 ACCEPT_TAC (SPEC_ALL ADD_SYM)
1946QED
1947
1948Theorem NOT_SUC_ADD_LESS_EQ:
1949 !m n. ~(SUC (m + n) <= m)
1950Proof
1951 REPEAT GEN_TAC THEN
1952 REWRITE_TAC [SYM (SPEC_ALL LESS_EQ)] THEN
1953 REWRITE_TAC [NOT_LESS,LESS_EQ_ADD]
1954QED
1955
1956Theorem MULT_LESS_EQ_SUC:
1957 !m n p. m <= n <=> SUC p * m <= SUC p * n
1958Proof
1959 let val th1 = SPEC (“b:num”) (SPEC (“c:num”) (SPEC (“a:num”)
1960 LESS_MONO_ADD))
1961 val th2 = SPEC (“c:num”) (SPEC (“d:num”) (SPEC (“b:num”)
1962 LESS_MONO_ADD))
1963 val th3 = ONCE_REWRITE_RULE [ADD_SYM] th2
1964 val th4 = CONJ (UNDISCH_ALL th1) (UNDISCH_ALL th3)
1965 val th5 = MATCH_MP LESS_TRANS th4
1966 val th6 = DISCH_ALL th5
1967 in
1968 REPEAT GEN_TAC THEN
1969 EQ_TAC THENL
1970 [ONCE_REWRITE_TAC [MULT_SYM] THEN
1971 REWRITE_TAC [LESS_MONO_MULT],
1972 CONV_TAC CONTRAPOS_CONV THEN
1973 REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)] THEN
1974 SPEC_TAC ((“p:num”),(“p:num”)) THEN
1975 INDUCT_TAC THENL
1976 [REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES],
1977 STRIP_TAC THEN
1978 RES_TAC THEN
1979 ONCE_REWRITE_TAC [MULT_CLAUSES] THEN
1980 IMP_RES_TAC th6]]
1981 end
1982QED
1983
1984Theorem LE_MULT_LCANCEL:
1985 !m n p. m * n <= m * p <=> (m = 0) \/ n <= p
1986Proof
1987 REPEAT GEN_TAC THEN
1988 Q.SPEC_THEN `m` STRUCT_CASES_TAC num_CASES THENL [
1989 REWRITE_TAC [LESS_EQ_REFL, MULT_CLAUSES],
1990 REWRITE_TAC [NOT_SUC, GSYM MULT_LESS_EQ_SUC]
1991 ]
1992QED
1993
1994Theorem LE_MULT_RCANCEL:
1995 !m n p. m * n <= p * n <=> n = 0 \/ m <= p
1996Proof ONCE_REWRITE_TAC [MULT_COMM] THEN REWRITE_TAC [LE_MULT_LCANCEL]
1997QED
1998
1999Theorem LT_MULT_LCANCEL:
2000 !m n p. m * n < m * p <=> 0 < m /\ n < p
2001Proof
2002 REPEAT GEN_TAC THEN
2003 Q.SPEC_THEN `m` STRUCT_CASES_TAC num_CASES THENL [
2004 REWRITE_TAC [MULT_CLAUSES, LESS_REFL],
2005 REWRITE_TAC [LESS_MULT_MONO, LESS_0]
2006 ]
2007QED
2008
2009Theorem LT_MULT_RCANCEL:
2010 !m n p. m * n < p * n <=> 0 < n /\ m < p
2011Proof
2012 ONCE_REWRITE_TAC [MULT_COMM] THEN REWRITE_TAC [LT_MULT_LCANCEL]
2013QED
2014
2015(* |- (m < m * n = 0 < m /\ 1 < n) /\ (m < n * m = 0 < m /\ 1 < n) *)
2016Theorem LT_MULT_CANCEL_LBARE =
2017 CONJ
2018 (REWRITE_RULE [MULT_CLAUSES] (Q.SPECL [`m`, `1`, `n`] LT_MULT_LCANCEL))
2019 (REWRITE_RULE [MULT_CLAUSES] (Q.SPECL [`1`,`m`, `n`] LT_MULT_RCANCEL))
2020
2021Theorem LT1_EQ0[simp]:
2022 x < 1 <=> (x = 0)
2023Proof
2024 Q.SPEC_THEN `x` STRUCT_CASES_TAC num_CASES THEN
2025 REWRITE_TAC [ONE, LESS_0, NOT_LESS_0, LESS_MONO_EQ, NOT_SUC]
2026QED
2027
2028(* |- (m * n < m = 0 < m /\ (n = 0)) /\ (m * n < n = 0 < n /\ (m = 0)) *)
2029Theorem LT_MULT_CANCEL_RBARE =
2030 CONJ
2031 (REWRITE_RULE [MULT_CLAUSES, LT1_EQ0]
2032 (Q.SPECL [`m`,`n`,`1`] LT_MULT_LCANCEL))
2033 (REWRITE_RULE [MULT_CLAUSES, LT1_EQ0]
2034 (Q.SPECL [`m`,`n`,`1`] LT_MULT_RCANCEL))
2035
2036Theorem le1_lt0[local]:
2037 1 <= n <=> 0 < n
2038Proof REWRITE_TAC [LESS_EQ, ONE]
2039QED
2040
2041(* |- (m <= m * n = (m = 0) \/ 0 < n) /\ (m <= n * m = (m = 0) \/ 0 < n) *)
2042Theorem LE_MULT_CANCEL_LBARE =
2043 CONJ
2044 (REWRITE_RULE [MULT_CLAUSES, le1_lt0]
2045 (Q.SPECL [`m`,`1`,`n`] LE_MULT_LCANCEL))
2046 (REWRITE_RULE [MULT_CLAUSES, le1_lt0]
2047 (Q.SPECL [`1`,`m`,`n`] LE_MULT_RCANCEL))
2048
2049(* |- (m * n <= m = (m = 0) \/ n <= 1) /\ (m * n <= n = (n = 0) \/ m <= 1) *)
2050Theorem LE_MULT_CANCEL_RBARE =
2051 CONJ
2052 (REWRITE_RULE [MULT_CLAUSES] (Q.SPECL [`m`,`n`,`1`] LE_MULT_LCANCEL))
2053 (REWRITE_RULE [MULT_CLAUSES] (Q.SPECL [`m`,`n`,`1`] LE_MULT_RCANCEL))
2054
2055Theorem SUB_LEFT_ADD:
2056 !m n p. m + (n - p) = (if (n <= p) then m else (m + n) - p)
2057Proof
2058 GEN_TAC THEN REPEAT INDUCT_TAC THEN
2059 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
2060 ZERO_LESS_EQ, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
2061QED
2062
2063Theorem SUB_RIGHT_ADD:
2064 !m n p. (m - n) + p = (if (m <= n) then p else (m + p) - n)
2065Proof
2066 INDUCT_TAC THEN INDUCT_TAC THEN
2067 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
2068 ZERO_LESS_EQ, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
2069QED
2070
2071Theorem SUB_LEFT_SUB:
2072 !m n p. m - (n - p) = (if (n <= p) then m else (m + p) - n)
2073Proof
2074 GEN_TAC THEN REPEAT INDUCT_TAC THEN
2075 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ,
2076 ZERO_LESS_EQ, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO]
2077QED
2078
2079Theorem SUB_RIGHT_SUB:
2080 !m n p. (m - n) - p = m - (n + p)
2081Proof
2082 INDUCT_TAC THEN INDUCT_TAC THEN
2083 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES,SUB_MONO_EQ]
2084QED
2085
2086Theorem SUB_LEFT_SUC:
2087 !m n. SUC (m - n) = (if (m <= n) then (SUC 0) else (SUC m) - n)
2088Proof
2089 REPEAT GEN_TAC THEN
2090 ASM_CASES_TAC (“m <= n”) THENL
2091 [IMP_RES_THEN (fn th => ASM_REWRITE_TAC [th]) (SYM (SPEC_ALL SUB_EQ_0)),
2092 ASM_REWRITE_TAC [SUB] THEN
2093 ASSUM_LIST (MAP_EVERY (REWRITE_TAC o CONJUNCTS o
2094 (PURE_REWRITE_RULE [LESS_OR_EQ,DE_MORGAN_THM])))]
2095QED
2096
2097Theorem pls[local]:
2098 p <= m \/ p <= 0 <=> p <= m
2099Proof
2100 REWRITE_TAC [LESS_EQ_0] THEN
2101 EQ_TAC THEN REPEAT STRIP_TAC THEN
2102 ASM_REWRITE_TAC [ZERO_LESS_EQ]
2103QED
2104
2105Theorem SUB_LEFT_LESS_EQ:
2106 !m n p. m <= (n - p) <=> m + p <= n \/ m <= 0
2107Proof
2108 GEN_TAC THEN REPEAT INDUCT_TAC THEN
2109 ASM_REWRITE_TAC [ADD_CLAUSES, SUB_0, SUB_MONO_EQ, pls,
2110 ZERO_LESS_EQ, NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, NOT_SUC]
2111QED
2112
2113Theorem SUB_RIGHT_LESS_EQ:
2114 !m n p. ((m - n) <= p) = (m <= (n + p))
2115Proof
2116 INDUCT_TAC THEN INDUCT_TAC THEN
2117 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES,
2118 SUB_MONO_EQ, LESS_EQ_MONO, ZERO_LESS_EQ]
2119QED
2120
2121Theorem SUB_LEFT_LESS:
2122 !m n p. (m < (n - p)) = ((m + p) < n)
2123Proof
2124 REPEAT GEN_TAC THEN
2125 PURE_REWRITE_TAC [LESS_EQ,SYM (SPEC_ALL (CONJUNCT2 ADD))] THEN
2126 PURE_ONCE_REWRITE_TAC [SUB_LEFT_LESS_EQ] THEN
2127 REWRITE_TAC [SYM (SPEC_ALL LESS_EQ),NOT_LESS_0]
2128QED
2129
2130Theorem BOOL_EQ_NOT_BOOL_EQ[local]:
2131 !x y. (x = y) = (~x = ~y)
2132Proof
2133 REPEAT GEN_TAC THEN
2134 BOOL_CASES_TAC (“x:bool”) THEN
2135 REWRITE_TAC []
2136QED
2137
2138Theorem SUB_RIGHT_LESS:
2139 !m n p. ((m - n) < p) = ((m < (n + p)) /\ (0 < p))
2140Proof
2141 REPEAT GEN_TAC THEN
2142 PURE_ONCE_REWRITE_TAC [BOOL_EQ_NOT_BOOL_EQ] THEN
2143 PURE_REWRITE_TAC [DE_MORGAN_THM,NOT_LESS] THEN
2144 SUBST1_TAC (SPECL [(“n:num”),(“p:num”)] ADD_SYM) THEN
2145 REWRITE_TAC [SUB_LEFT_LESS_EQ]
2146QED
2147
2148Theorem SUB_LEFT_GREATER_EQ:
2149 !m n p. (m >= (n - p)) = ((m + p) >= n)
2150Proof
2151 REWRITE_TAC [GREATER_EQ] THEN
2152 GEN_TAC THEN REPEAT INDUCT_TAC THEN
2153 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES,
2154 SUB_MONO_EQ, LESS_EQ_MONO, ZERO_LESS_EQ]
2155QED
2156
2157Theorem SUB_RIGHT_GREATER_EQ:
2158 !m n p. ((m - n) >= p) = ((m >= (n + p)) \/ (0 >= p))
2159Proof
2160 REWRITE_TAC [GREATER_EQ] THEN
2161 INDUCT_TAC THEN INDUCT_TAC THEN
2162 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES, SUB_MONO_EQ,
2163 LESS_EQ_MONO, ZERO_LESS_EQ, NOT_SUC_LESS_EQ_0, pls]
2164QED
2165
2166Theorem SUB_LEFT_GREATER:
2167 !m n p. (m > (n - p)) = (((m + p) > n) /\ (m > 0))
2168Proof
2169 REPEAT GEN_TAC THEN
2170 PURE_ONCE_REWRITE_TAC [GREATER_DEF] THEN
2171 SUBST1_TAC (SPECL [(“m:num”),(“p:num”)] ADD_SYM) THEN
2172 REWRITE_TAC [SUB_RIGHT_LESS]
2173QED
2174
2175Theorem SUB_RIGHT_GREATER:
2176 !m n p. ((m - n) > p) = (m > (n + p))
2177Proof
2178 REPEAT GEN_TAC THEN
2179 PURE_ONCE_REWRITE_TAC [GREATER_DEF] THEN
2180 SUBST1_TAC (SPECL [(“n:num”),(“p:num”)] ADD_SYM) THEN
2181 REWRITE_TAC [SUB_LEFT_LESS]
2182QED
2183
2184Theorem SUB_LEFT_EQ:
2185 !m n p. (m = (n - p)) <=> (m + p = n) \/ (m <= 0 /\ n <= p)
2186Proof
2187 GEN_TAC THEN REPEAT INDUCT_TAC THEN
2188 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES, INV_SUC_EQ,
2189 SUB_MONO_EQ, LESS_EQ_MONO, ZERO_LESS_EQ, LESS_EQ_0, NOT_SUC]
2190QED
2191
2192Theorem SUB_RIGHT_EQ:
2193 !m n p. (m - n = p) <=> (m = n + p) \/ (m <= n /\ p <= 0)
2194Proof
2195 INDUCT_TAC THEN INDUCT_TAC THEN GEN_TAC THEN
2196 ASM_REWRITE_TAC [SUB_0,ADD_CLAUSES, INV_SUC_EQ, SUB_EQ_0, SUB_MONO_EQ,
2197 LESS_EQ_MONO, ZERO_LESS_EQ, LESS_EQ_0, NOT_SUC, GSYM NOT_SUC] THEN
2198 EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []
2199QED
2200
2201Theorem LE =
2202 CONJ LESS_EQ_0
2203 (prove(“(!m n. m <= SUC n <=> (m = SUC n) \/ m <= n)”,
2204 REPEAT GEN_TAC THEN
2205 CONV_TAC (DEPTH_CONV (LHS_CONV (REWR_CONV LESS_OR_EQ))) THEN
2206 REWRITE_TAC [GSYM LESS_EQ_IFF_LESS_SUC] THEN
2207 MATCH_ACCEPT_TAC DISJ_COMM))
2208
2209val _ = print "Proving division\n"
2210
2211(* =====================================================================*)
2212(* Added TFM 90.05.24 *)
2213(* *)
2214(* Prove the division algorithm: *)
2215(* *)
2216(* |- !k n. n>0 ==> ?q r. k=qn+r /\ 0<= r < n *)
2217(* *)
2218(* The proof follows MacLane & Birkhoff, p29. *)
2219(* =====================================================================*)
2220
2221(* ---------------------------------------------------------------------*)
2222(* We first show that ?r q. k=qn+r. This is easy, with r=k and q=0. *)
2223(* ---------------------------------------------------------------------*)
2224
2225Theorem exists_lemma[local]:
2226 ?r q. (k=(q*n)+r)
2227Proof
2228 MAP_EVERY EXISTS_TAC [“k:num”,“0”] THEN
2229 REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES]
2230QED
2231
2232(* ---------------------------------------------------------------------*)
2233(* We now show, using the well ordering property, that there is a *)
2234(* SMALLEST n' such that ?q. k=qn+n'. This is the correct remainder. *)
2235(* *)
2236(* The theorem is: |- ?n'. (?q. k = q*n+n') /\ *)
2237(* (!y. y<n' ==> (!q. ~(k=q*n+y))) *)
2238(* ---------------------------------------------------------------------*)
2239val smallest_lemma =
2240 CONV_RULE (DEPTH_CONV NOT_EXISTS_CONV)
2241 (MATCH_MP (CONV_RULE (DEPTH_CONV BETA_CONV)
2242 (SPEC (“\r.?q.k=(q*n)+r”) WOP))
2243 exists_lemma);
2244
2245(* We will need the lemma |- !m n. n <= m ==> (?p. m = n + p) *)
2246Theorem leq_add_lemma[local]:
2247 !m n. (n<=m) ==> ?p.m=n+p
2248Proof
2249 REWRITE_TAC [LESS_OR_EQ] THEN
2250 REPEAT STRIP_TAC THENL
2251 [FIRST_ASSUM (STRIP_ASSUME_TAC o MATCH_MP LESS_ADD_1) THEN
2252 EXISTS_TAC (“p+1”) THEN
2253 FIRST_ASSUM ACCEPT_TAC,
2254 EXISTS_TAC (“0”) THEN
2255 ASM_REWRITE_TAC [ADD_CLAUSES]]
2256QED
2257
2258(* We will also need the lemma: |- k=qn+n+p ==> k=(q+1)*n+p *)
2259Theorem k_expr_lemma[local]:
2260 (k=(q*n)+(n+p)) ==> (k=((q+1)*n)+p)
2261Proof
2262 REWRITE_TAC [RIGHT_ADD_DISTRIB,MULT_CLAUSES,ADD_ASSOC]
2263QED
2264
2265(* We will also need the lemma: [0<n] |- p < (n + p) *)
2266val less_add = TAC_PROOF(([“0<n”], “p < (n + p)”),
2267 PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN
2268 MATCH_MP_TAC LESS_ADD_NONZERO THEN
2269 IMP_RES_THEN (STRIP_THM_THEN SUBST1_TAC) LESS_ADD_1 THEN
2270 REWRITE_TAC [ADD_CLAUSES, ONE, NOT_SUC]);
2271
2272(* Now prove the desired theorem. *)
2273Theorem DA:
2274 !k n. 0<n ==> ?r q. (k=(q*n)+r) /\ r<n
2275Proof
2276 REPEAT STRIP_TAC THEN
2277 STRIP_ASSUME_TAC smallest_lemma THEN
2278 MAP_EVERY EXISTS_TAC [“n':num”,“q:num”] THEN
2279 ASM_REWRITE_TAC [] THEN
2280 DISJ_CASES_THEN CHECK_ASSUME_TAC
2281 (SPECL [“n':num”,“n:num”] LESS_CASES) THEN
2282 IMP_RES_THEN (STRIP_THM_THEN SUBST_ALL_TAC) leq_add_lemma THEN
2283 IMP_RES_TAC k_expr_lemma THEN
2284 ANTE_RES_THEN IMP_RES_TAC less_add
2285QED
2286
2287(* ---------------------------------------------------------------------*)
2288(* We can now define MOD and DIV to have the property given by DA. *)
2289(* We prove the existence of the required functions, and then define *)
2290(* MOD and DIV using a constant specification. *)
2291(* ---------------------------------------------------------------------*)
2292
2293(* First prove the existence of MOD. *)
2294Theorem MOD_exists[local]:
2295 ?MOD. !n. (0<n) ==>
2296 !k.?q.(k=((q * n)+(MOD k n))) /\ ((MOD k n) < n)
2297Proof
2298 EXISTS_TAC (“\k n. @r. ?q. (k = (q * n) + r) /\ r < n”) THEN
2299 REPEAT STRIP_TAC THEN
2300 IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC (“k:num”)) DA THEN
2301 CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN
2302 CONV_TAC SELECT_CONV THEN
2303 MAP_EVERY EXISTS_TAC [“r:num”,“q:num”] THEN
2304 CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC
2305QED
2306
2307(* Now, prove the existence of MOD and DIV. *)
2308Theorem MOD_DIV_exist[local]:
2309 ?MOD DIV.
2310 !n. 0<n ==>
2311 !k. (k = ((DIV k n * n) + MOD k n)) /\ (MOD k n < n)
2312Proof
2313 STRIP_ASSUME_TAC MOD_exists THEN
2314 EXISTS_TAC (“MOD:num->num->num”) THEN
2315 EXISTS_TAC (“\k n. @q. (k = (q * n) + (MOD k n))”) THEN
2316 REPEAT STRIP_TAC THENL
2317 [CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN
2318 CONV_TAC SELECT_CONV THEN
2319 RES_THEN (STRIP_ASSUME_TAC o SPEC (“k:num”)) THEN
2320 EXISTS_TAC (“q:num”) THEN
2321 FIRST_ASSUM ACCEPT_TAC,
2322 RES_THEN (STRIP_ASSUME_TAC o SPEC (“k:num”))]
2323QED
2324
2325(*---------------------------------------------------------------------------
2326 Now define MOD and DIV by a constant specification.
2327 ---------------------------------------------------------------------------*)
2328
2329val OT_DIVISION =
2330 new_specification ("OT_DIVISION", ["OT_MOD", "OT_DIV"], MOD_DIV_exist);
2331
2332(* HOL4 now switches to HOL-Light compatible version of DIV and MOD *)
2333val DIV_def = new_definition
2334 ("DIV_def", “DIV m n = if n = 0 then 0 else OT_DIV m n”);
2335
2336val MOD_def = new_definition
2337 ("MOD_def", “MOD m n = if n = 0 then m else OT_MOD m n”);
2338
2339val _ = set_fixity "MOD" (Infixl 600);
2340val _ = set_fixity "DIV" (Infixl 600);
2341
2342Theorem DIVISION:
2343 !n. 0 < n ==> !k. k = k DIV n * n + k MOD n /\ k MOD n < n
2344Proof
2345 NTAC 2 STRIP_TAC
2346 THEN IMP_RES_TAC prim_recTheory.LESS_NOT_EQ
2347 THEN POP_ASSUM (ASSUME_TAC o GSYM)
2348 THEN ASM_REWRITE_TAC [DIV_def,MOD_def]
2349 THEN MATCH_MP_TAC OT_DIVISION
2350 THEN ASM_REWRITE_TAC []
2351QED
2352
2353val DIV2_def = new_definition("DIV2_def", “DIV2 n = n DIV 2”);
2354
2355local
2356 open OpenTheoryMap
2357in
2358 val _ = OpenTheory_const_name
2359 {const = {Thy = "arithmetic", Name = "DIV2"},
2360 name = (["HOL4", "arithmetic"], "DIV2")}
2361end
2362
2363(* ---------------------------------------------------------------------*)
2364(* Properties of MOD and DIV that don't depend on uniqueness. *)
2365(* ---------------------------------------------------------------------*)
2366
2367Theorem MOD_ONE:
2368 !k. k MOD (SUC 0) = 0
2369Proof
2370 STRIP_TAC THEN
2371 MP_TAC (CONJUNCT2 (SPEC (“k:num”)
2372 (REWRITE_RULE [LESS_SUC_REFL] (SPEC (“SUC 0”) DIVISION)))) THEN
2373 REWRITE_TAC [LESS_THM,NOT_LESS_0]
2374QED
2375
2376(* |- x MOD 1 = 0 *)
2377Theorem MOD_1 = REWRITE_RULE [SYM ONE] MOD_ONE;
2378
2379Theorem DIV_LESS_EQ:
2380 !n. 0<n ==> !k. (k DIV n) <= k
2381Proof
2382 REPEAT STRIP_TAC THEN
2383 IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC (“k:num”)) DIVISION THEN
2384 FIRST_ASSUM (fn th => fn g => SUBST_OCCS_TAC [([2],th)] g) THEN
2385 STRIP_ALL_THEN MP_TAC (SPEC (“n:num”) num_CASES) THENL
2386 [IMP_RES_TAC LESS_NOT_EQ THEN
2387 DISCH_THEN (ASSUME_TAC o SYM) THEN
2388 RES_TAC,
2389 DISCH_THEN (fn th => SUBST_OCCS_TAC [([3],th)]) THEN
2390 REWRITE_TAC [MULT_CLAUSES] THEN
2391 REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN
2392 MATCH_ACCEPT_TAC LESS_EQ_ADD]
2393QED
2394
2395(* ---------------------------------------------------------------------*)
2396(* Now, show that the quotient and remainder are unique. *)
2397(* *)
2398(* NB: the beastly proof given below of DIV_UNIQUE is definitely NOT *)
2399(* good HOL style. *)
2400(* ---------------------------------------------------------------------*)
2401
2402Theorem lemma[local]:
2403 !x y z. x<y ==> ~(y + z = x)
2404Proof
2405 REPEAT STRIP_TAC THEN POP_ASSUM (SUBST_ALL_TAC o SYM)
2406 THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[]
2407 THEN SPEC_TAC (“y:num”,“y:num”)
2408 THEN INDUCT_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES,NOT_LESS_0,LESS_MONO_EQ]
2409QED
2410
2411local val (eq,ls) =
2412 CONJ_PAIR (SPEC (“k:num”)
2413 (REWRITE_RULE [LESS_0] (SPEC (“SUC(r+p)”) DIVISION)))
2414in
2415Theorem DIV_UNIQUE:
2416 !n k q. (?r. (k = q*n + r) /\ r<n) ==> (k DIV n = q)
2417Proof
2418REPEAT GEN_TAC THEN
2419 DISCH_THEN (CHOOSE_THEN (CONJUNCTS_THEN2
2420 MP_TAC (STRIP_THM_THEN SUBST_ALL_TAC o MATCH_MP LESS_ADD_1))) THEN
2421 REWRITE_TAC [ONE,MULT_CLAUSES,ADD_CLAUSES] THEN
2422 DISCH_THEN
2423 (fn th1 =>
2424 MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN
2425 PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)] THEN CONJ_TAC THEN
2426 DISCH_THEN (fn th2 =>
2427 MP_TAC (TRANS (SYM eq) th1) THEN STRIP_THM_THEN SUBST_ALL_TAC
2428 (MATCH_MP LESS_ADD_1 th2))) THEN REWRITE_TAC[] THENL
2429[MATCH_MP_TAC lemma, MATCH_MP_TAC (ONCE_REWRITE_RULE [EQ_SYM_EQ] lemma)]
2430 THEN REWRITE_TAC [MULT_CLAUSES,GSYM ADD_ASSOC,
2431 ONCE_REWRITE_RULE [ADD_SYM]LESS_MONO_ADD_EQ]
2432 THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o RAND_CONV)
2433 empty_rewrites [RIGHT_ADD_DISTRIB]
2434 THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) empty_rewrites [ADD_SYM]
2435 THEN REWRITE_TAC [GSYM ADD_ASSOC]
2436 THEN GEN_REWRITE_TAC (RAND_CONV) empty_rewrites [ADD_SYM] THEN
2437 REWRITE_TAC [GSYM ADD_ASSOC, ONCE_REWRITE_RULE [ADD_SYM]LESS_MONO_ADD_EQ]
2438 THENL
2439 [REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB]
2440 THEN REWRITE_TAC [MULT_CLAUSES,GSYM ADD_ASSOC]
2441 THEN GEN_REWRITE_TAC (RAND_CONV) empty_rewrites [ADD_SYM]
2442 THEN REWRITE_TAC [GSYM ADD_ASSOC,ONE,
2443 REWRITE_RULE[ADD_CLAUSES]
2444 (ONCE_REWRITE_RULE [ADD_SYM]
2445 (SPECL [“0”,“n:num”,“r:num”]LESS_MONO_ADD_EQ))]
2446 THEN REWRITE_TAC [ADD_CLAUSES, LESS_0],
2447
2448 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN EXISTS_TAC (“SUC (r+p)”)
2449 THEN REWRITE_TAC
2450 [CONJUNCT2(SPEC_ALL(MATCH_MP DIVISION (SPEC(“r+p”) LESS_0)))]
2451 THEN REWRITE_TAC[LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB,
2452 MULT_CLAUSES,GSYM ADD_ASSOC,ADD1]
2453 THEN GEN_REWRITE_TAC (RAND_CONV) empty_rewrites [ADD_SYM]
2454 THEN REWRITE_TAC [GSYM ADD_ASSOC,
2455 ONCE_REWRITE_RULE [ADD_SYM]LESS_EQ_MONO_ADD_EQ]
2456 THEN GEN_REWRITE_TAC (RAND_CONV) empty_rewrites [ADD_SYM]
2457 THEN REWRITE_TAC [GSYM ADD_ASSOC,
2458 ONCE_REWRITE_RULE [ADD_SYM]LESS_EQ_MONO_ADD_EQ]
2459 THEN REWRITE_TAC[ZERO_LESS_EQ,
2460 REWRITE_RULE[ADD_CLAUSES]
2461 (SPECL [“1”,“0”,“p:num”]ADD_MONO_LESS_EQ)]]
2462QED
2463end;
2464
2465Theorem lemma[local]:
2466 !n k q r. ((k = (q * n) + r) /\ r < n) ==> (k DIV n = q)
2467Proof
2468 REPEAT STRIP_TAC THEN
2469 MATCH_MP_TAC DIV_UNIQUE THEN
2470 EXISTS_TAC (“r:num”) THEN
2471 ASM_REWRITE_TAC []
2472QED
2473
2474Theorem MOD_UNIQUE:
2475 !n k r. (?q. (k = (q * n) + r) /\ r < n) ==> (k MOD n = r)
2476Proof
2477 REPEAT STRIP_TAC THEN
2478 MP_TAC (DISCH_ALL (SPEC (“k:num”)
2479 (UNDISCH (SPEC (“n:num”) DIVISION)))) THEN
2480 FIRST_ASSUM (fn th => fn g =>
2481 let val thm = MATCH_MP LESS_ADD_1 th
2482 fun tcl t = (SUBST_OCCS_TAC [([1],t)])
2483 in
2484 STRIP_THM_THEN tcl thm g
2485 end
2486 ) THEN
2487 REWRITE_TAC [LESS_0, ONE, ADD_CLAUSES] THEN
2488 IMP_RES_THEN (IMP_RES_THEN SUBST1_TAC) lemma THEN
2489 FIRST_ASSUM (fn th => fn g => SUBST_OCCS_TAC [([1],th)] g) THEN
2490 let val th = PURE_ONCE_REWRITE_RULE [ADD_SYM] EQ_MONO_ADD_EQ
2491 in
2492 PURE_ONCE_REWRITE_TAC [th] THEN
2493 DISCH_THEN (STRIP_THM_THEN (fn th => fn g => ACCEPT_TAC (SYM th) g))
2494 end
2495QED
2496
2497(* A combined version of DIV_UNIQUE and MOD_UNIQUE from HOL-Light *)
2498Theorem DIVMOD_UNIQ :
2499 !m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q) /\ (m MOD n = r)
2500Proof
2501 rpt STRIP_TAC
2502 >| [ MATCH_MP_TAC DIV_UNIQUE \\
2503 Q.EXISTS_TAC ‘r’ >> ASM_REWRITE_TAC [],
2504 MATCH_MP_TAC MOD_UNIQUE \\
2505 Q.EXISTS_TAC ‘q’ >> ASM_REWRITE_TAC [] ]
2506QED
2507
2508Theorem DIV2_DOUBLE[simp]: !n. DIV2 (2 * n) = n
2509Proof
2510 GEN_TAC >> REWRITE_TAC [DIV2_def]
2511 >> MATCH_MP_TAC DIV_UNIQUE
2512 >> Q.EXISTS_TAC `0`
2513 >> `0:num < 2` by METIS_TAC [TWO, ONE, LESS_0]
2514 >> ASM_REWRITE_TAC [Once MULT_COMM, ADD_0]
2515QED
2516
2517(* ---------------------------------------------------------------------*)
2518(* Properties of MOD and DIV proved using uniqueness. *)
2519(* ---------------------------------------------------------------------*)
2520
2521Theorem DIV_MULT:
2522 !n r. r < n ==> !q. (q*n + r) DIV n = q
2523Proof
2524 REPEAT GEN_TAC THEN
2525 STRIP_ALL_THEN SUBST1_TAC (SPEC (“n:num”) num_CASES) THENL
2526 [REWRITE_TAC [NOT_LESS_0],
2527 REPEAT STRIP_TAC THEN
2528 MATCH_MP_TAC DIV_UNIQUE THEN
2529 EXISTS_TAC (“r:num”) THEN
2530 ASM_REWRITE_TAC []]
2531QED
2532
2533Theorem LESS_MOD:
2534 !n k. k < n ==> ((k MOD n) = k)
2535Proof
2536 REPEAT STRIP_TAC THEN
2537 MATCH_MP_TAC MOD_UNIQUE THEN
2538 EXISTS_TAC (“0”) THEN
2539 ASM_REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES]
2540QED
2541
2542Theorem MOD_EQ_0:
2543 !n. 0<n ==> !k. ((k * n) MOD n) = 0
2544Proof
2545 REPEAT STRIP_TAC THEN
2546 IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC (“k * n”)) DIVISION THEN
2547 MATCH_MP_TAC MOD_UNIQUE THEN
2548 EXISTS_TAC (“k:num”) THEN
2549 CONJ_TAC THENL
2550 [REWRITE_TAC [ADD_CLAUSES], FIRST_ASSUM ACCEPT_TAC]
2551QED
2552
2553Theorem ZERO_MOD:
2554 !n. 0<n ==> (0 MOD n = 0)
2555Proof
2556 REPEAT STRIP_TAC THEN
2557 IMP_RES_THEN (MP_TAC o SPEC (“0”)) MOD_EQ_0 THEN
2558 REWRITE_TAC [MULT_CLAUSES]
2559QED
2560
2561Theorem ZERO_DIV:
2562 !n. 0<n ==> (0 DIV n = 0)
2563Proof
2564 REPEAT STRIP_TAC THEN
2565 MATCH_MP_TAC DIV_UNIQUE THEN
2566 EXISTS_TAC (“0”) THEN
2567 ASM_REWRITE_TAC [MULT_CLAUSES,ADD_CLAUSES]
2568QED
2569
2570Theorem DIV_0[simp]:
2571 k DIV 0 = 0 /\ 0 DIV n = 0
2572Proof
2573 conj_tac >- REWRITE_TAC [DIV_def] >> Cases_on ‘0 < n’ >>
2574 ASM_SIMP_TAC bool_ss [ZERO_DIV] >>
2575 RULE_ASSUM_TAC (REWRITE_RULE[NOT_LT_ZERO_EQ_ZERO]) >>
2576 ASM_REWRITE_TAC [DIV_def]
2577QED
2578
2579Theorem MOD_0[simp]:
2580 k MOD 0 = k /\ 0 MOD n = 0
2581Proof
2582 conj_tac >- REWRITE_TAC [MOD_def] >> Cases_on ‘0 < n’ >>
2583 ASM_SIMP_TAC bool_ss [ZERO_MOD] >>
2584 RULE_ASSUM_TAC (REWRITE_RULE[NOT_LT_ZERO_EQ_ZERO]) >>
2585 ASM_REWRITE_TAC [MOD_def]
2586QED
2587
2588Theorem MOD_MULT:
2589 !n r. r < n ==> !q. (q * n + r) MOD n = r
2590Proof
2591 REPEAT STRIP_TAC THEN
2592 MATCH_MP_TAC MOD_UNIQUE THEN
2593 EXISTS_TAC (“q:num”) THEN
2594 ASM_REWRITE_TAC [ADD_CLAUSES,MULT_CLAUSES]
2595QED
2596
2597Theorem MOD_TIMES:
2598 !n q r. (((q * n) + r) MOD n) = (r MOD n)
2599Proof
2600 let fun SUBS th = SUBST_OCCS_TAC [([1],th)]
2601 in
2602 REPEAT STRIP_TAC THEN
2603 Cases_on `n = 0`
2604 THEN1 (ASM_REWRITE_TAC [MOD_0,MULT_CLAUSES,ADD_CLAUSES]) THEN
2605 dxrule_then assume_tac $ iffLR NOT_ZERO_LT_ZERO THEN
2606 IMP_RES_THEN (TRY o SUBS o SPEC (“r:num”)) DIVISION THEN
2607 REWRITE_TAC [ADD_ASSOC,SYM(SPEC_ALL RIGHT_ADD_DISTRIB)] THEN
2608 IMP_RES_THEN (ASSUME_TAC o SPEC (“r:num”)) DIVISION THEN
2609 IMP_RES_TAC MOD_MULT THEN
2610 FIRST_ASSUM MATCH_ACCEPT_TAC
2611 end
2612QED
2613
2614Theorem MOD_TIMES_SUB:
2615 !n q r. 0 < n /\ 0 < q /\ r <= n ==> ((q * n - r) MOD n = (n - r) MOD n)
2616Proof
2617 NTAC 2 STRIP_TAC THEN
2618 STRUCT_CASES_TAC (Q.SPEC `q` num_CASES) THEN1
2619 REWRITE_TAC [NOT_LESS_0] THEN
2620 REPEAT STRIP_TAC THEN
2621 FULL_SIMP_TAC bool_ss [MULT,LESS_EQ_ADD_SUB,MOD_TIMES]
2622QED
2623
2624Theorem MOD_PLUS:
2625 !n j k. (((j MOD n) + (k MOD n)) MOD n) = ((j+k) MOD n)
2626Proof
2627 let fun SUBS th = SUBST_OCCS_TAC [([2],th)]
2628 in
2629 REPEAT STRIP_TAC THEN
2630 Cases_on `n = 0`
2631 THEN1 (ASM_REWRITE_TAC [MOD_0]) THEN
2632 dxrule_then assume_tac $ iffLR NOT_ZERO_LT_ZERO THEN
2633 IMP_RES_THEN (TRY o SUBS o SPEC (“j:num”)) DIVISION THEN
2634 ASM_REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC),MOD_TIMES] THEN
2635 PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN
2636 IMP_RES_THEN (TRY o SUBS o SPEC (“k:num”)) DIVISION THEN
2637 ASM_REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC),MOD_TIMES]
2638 end
2639QED
2640
2641Theorem MOD_MOD:
2642 !n k. (k MOD n) MOD n = (k MOD n)
2643Proof
2644 REPEAT STRIP_TAC THEN
2645 Cases_on `n = 0`
2646 THEN1 (ASM_REWRITE_TAC [MOD_0,MULT_CLAUSES,ADD_CLAUSES]) THEN
2647 dxrule_then assume_tac $ iffLR NOT_ZERO_LT_ZERO THEN
2648 MATCH_MP_TAC LESS_MOD THEN
2649 IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC (“k:num”)) DIVISION
2650QED
2651
2652(* LESS_DIV_EQ_ZERO = |- !r n. r < n ==> (r DIV n = 0) *)
2653
2654Theorem LESS_DIV_EQ_ZERO =
2655 GENL [(“r:num”),(“n:num”)] (DISCH_ALL (PURE_REWRITE_RULE[MULT,ADD]
2656 (SPEC (“0”)(UNDISCH_ALL (SPEC_ALL DIV_MULT)))));
2657
2658(* MULT_DIV = |- !n q. 0 < n ==> ((q * n) DIV n = q) *)
2659
2660Theorem MULT_DIV =
2661 GEN_ALL (PURE_REWRITE_RULE[ADD_0]
2662 (CONV_RULE RIGHT_IMP_FORALL_CONV
2663 (SPECL[(“n:num”),(“0”)] DIV_MULT)));
2664
2665Theorem ADD_DIV_ADD_DIV:
2666 !n. 0 < n ==> !x r. ((((x * n) + r) DIV n) = x + (r DIV n))
2667Proof
2668 CONV_TAC (REDEPTH_CONV RIGHT_IMP_FORALL_CONV)
2669 THEN REPEAT GEN_TAC THEN ASM_CASES_TAC (“r < n”) THENL[
2670 IMP_RES_THEN SUBST1_TAC LESS_DIV_EQ_ZERO THEN DISCH_TAC
2671 THEN PURE_ONCE_REWRITE_TAC[ADD_0]
2672 THEN MATCH_MP_TAC DIV_MULT THEN FIRST_ASSUM ACCEPT_TAC,
2673 DISCH_THEN (CHOOSE_TAC o (MATCH_MP (SPEC (“r:num”) DA)))
2674 THEN POP_ASSUM (CHOOSE_THEN STRIP_ASSUME_TAC)
2675 THEN SUBST1_TAC (ASSUME (“r = (q * n) + r'”))
2676 THEN PURE_ONCE_REWRITE_TAC[ADD_ASSOC]
2677 THEN PURE_ONCE_REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB]
2678 THEN IMP_RES_THEN (fn t => REWRITE_TAC[t]) DIV_MULT]
2679QED
2680
2681Theorem ADD_DIV_RWT:
2682 !n. 0 < n ==>
2683 !m p. (m MOD n = 0) \/ (p MOD n = 0) ==>
2684 ((m + p) DIV n = m DIV n + p DIV n)
2685Proof
2686 REPEAT STRIP_TAC THEN
2687 IMP_RES_THEN (ASSUME_TAC o GSYM) DIVISION THEN
2688 MATCH_MP_TAC DIV_UNIQUE THENL [
2689 Q.EXISTS_TAC `p MOD n` THEN
2690 ASM_REWRITE_TAC [RIGHT_ADD_DISTRIB, GSYM ADD_ASSOC, EQ_ADD_RCANCEL] THEN
2691 SIMP_TAC bool_ss [Once (GSYM ADD_0), SimpRHS] THEN
2692 FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC [],
2693 Q.EXISTS_TAC `m MOD n` THEN
2694 ASM_REWRITE_TAC [RIGHT_ADD_DISTRIB] THEN
2695 Q.SUBGOAL_THEN `p DIV n * n = p` SUBST1_TAC THENL [
2696 SIMP_TAC bool_ss [Once (GSYM ADD_0), SimpLHS] THEN
2697 FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC [],
2698 ALL_TAC
2699 ] THEN
2700 Q.SUBGOAL_THEN `m DIV n * n + p + m MOD n = m DIV n * n + m MOD n + p`
2701 (fn th => ASM_REWRITE_TAC [th]) THEN
2702 REWRITE_TAC [GSYM ADD_ASSOC, EQ_ADD_LCANCEL] THEN
2703 MATCH_ACCEPT_TAC ADD_COMM
2704 ]
2705QED
2706
2707val NOT_MULT_LESS_0 = prove(
2708 (“!m n. 0<m /\ 0<n ==> 0 < m*n”),
2709 REPEAT INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0]
2710 THEN STRIP_TAC THEN REWRITE_TAC[MULT_CLAUSES,ADD_CLAUSES,LESS_0]);
2711
2712Theorem MOD_MULT_MOD:
2713 !m n. 0<n /\ 0<m ==> !x. ((x MOD (n * m)) MOD n = x MOD n)
2714Proof
2715REPEAT GEN_TAC THEN DISCH_TAC
2716 THEN FIRST_ASSUM (ASSUME_TAC o (MATCH_MP NOT_MULT_LESS_0)) THEN GEN_TAC
2717 THEN POP_ASSUM(CHOOSE_TAC o (MATCH_MP(SPECL[“x:num”,“m * n”] DA)))
2718 THEN POP_ASSUM (CHOOSE_THEN STRIP_ASSUME_TAC)
2719 THEN SUBST1_TAC (ASSUME(“x = (q * (n * m)) + r”))
2720 THEN POP_ASSUM (SUBST1_TAC o (SPEC (“q:num”)) o MATCH_MP MOD_MULT)
2721 THEN PURE_ONCE_REWRITE_TAC [MULT_SYM]
2722 THEN PURE_ONCE_REWRITE_TAC [GSYM MULT_ASSOC]
2723 THEN PURE_ONCE_REWRITE_TAC [MULT_SYM]
2724 THEN STRIP_ASSUME_TAC (ASSUME (“0 < n /\ 0 < m”))
2725 THEN PURE_ONCE_REWRITE_TAC[UNDISCH_ALL(SPEC_ALL MOD_TIMES)]
2726 THEN REFL_TAC
2727QED
2728
2729(* |- !q. q DIV (SUC 0) = q *)
2730Theorem DIV_ONE =
2731 GEN_ALL (REWRITE_RULE[REWRITE_RULE[ONE] MULT_RIGHT_1]
2732 (MP (SPECL [(“SUC 0”), (“q:num”)] MULT_DIV)
2733 (SPEC (“0”) LESS_0)));
2734
2735Theorem DIV_1 = REWRITE_RULE [SYM ONE] DIV_ONE;
2736
2737Theorem DIV_ID[simp]:
2738 !n. 0 < n ==> (n DIV n = 1)
2739Proof
2740 REPEAT STRIP_TAC THEN
2741 MATCH_MP_TAC DIV_UNIQUE THEN Q.EXISTS_TAC `0` THEN
2742 ASM_REWRITE_TAC [MULT_CLAUSES, ADD_CLAUSES]
2743QED
2744
2745Theorem MOD_ID[simp]:
2746 !n. (n MOD n = 0)
2747Proof
2748 REPEAT STRIP_TAC THEN
2749 Cases_on `n` THENL
2750 [
2751 ASM_REWRITE_TAC [MOD_0],
2752 MATCH_MP_TAC MOD_UNIQUE THEN Q.EXISTS_TAC `1` THEN
2753 ASM_REWRITE_TAC [MULT_CLAUSES, ADD_CLAUSES,LESS_0]
2754 ]
2755QED
2756
2757(*for backwards compatibility*)
2758Theorem DIVMOD_ID:
2759 !n. 0 < n ==> (n DIV n = 1) /\ (n MOD n = 0)
2760Proof
2761 fs[ DIV_ID,MOD_ID]
2762QED
2763
2764Theorem Less_lemma[local]:
2765 !m n. m<n ==> ?p. (n = m + p) /\ 0<p
2766Proof
2767 GEN_TAC THEN INDUCT_TAC THENL[
2768 REWRITE_TAC[NOT_LESS_0],
2769 REWRITE_TAC[LESS_THM]
2770 THEN DISCH_THEN (DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC) THENL[
2771 EXISTS_TAC (“SUC 0”)
2772 THEN REWRITE_TAC[LESS_0,ADD_CLAUSES],
2773 RES_TAC THEN EXISTS_TAC (“SUC p”)
2774 THEN ASM_REWRITE_TAC[ADD_CLAUSES,LESS_0]]]
2775QED
2776
2777val Less_MULT_lemma = prove(
2778 (“!r m p. 0<p ==> r<m ==> r < p*m”),
2779 let val lem1 = MATCH_MP LESS_LESS_EQ_TRANS
2780 (CONJ (SPEC (“m:num”) LESS_SUC_REFL)
2781 (SPECL[(“SUC m”), (“p * (SUC m)”)] LESS_EQ_ADD))
2782 in
2783 GEN_TAC THEN REPEAT INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0]
2784 THEN DISCH_TAC THEN REWRITE_TAC[LESS_THM]
2785 THEN DISCH_THEN (DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC)
2786 THEN PURE_ONCE_REWRITE_TAC[MULT]
2787 THEN PURE_ONCE_REWRITE_TAC[ADD_SYM] THENL[
2788 ACCEPT_TAC lem1,
2789 ACCEPT_TAC (MATCH_MP LESS_TRANS (CONJ (ASSUME (“r < m”)) lem1))]
2790 end);
2791
2792Theorem Less_MULT_ADD_lemma[local]:
2793 !m n r r'. 0<m /\ 0<n /\ r<m /\ r'<n ==> r'*m + r < n*m
2794Proof
2795 REPEAT STRIP_TAC
2796 THEN CHOOSE_THEN STRIP_ASSUME_TAC (MATCH_MP Less_lemma (ASSUME (“r<m”)))
2797 THEN CHOOSE_THEN STRIP_ASSUME_TAC (MATCH_MP Less_lemma (ASSUME (“r'<n”)))
2798 THEN ASM_REWRITE_TAC[]
2799 THEN PURE_ONCE_REWRITE_TAC[RIGHT_ADD_DISTRIB]
2800 THEN PURE_ONCE_REWRITE_TAC[ADD_SYM]
2801 THEN PURE_ONCE_REWRITE_TAC[LESS_MONO_ADD_EQ]
2802 THEN SUBST1_TAC (SYM (ASSUME(“m = r + p”)))
2803 THEN IMP_RES_TAC Less_MULT_lemma
2804QED
2805
2806Theorem DIV_DIV_DIV_MULT:
2807 !m n. 0<m /\ 0<n ==> !x. ((x DIV m) DIV n = x DIV (m * n))
2808Proof
2809 CONV_TAC (ONCE_DEPTH_CONV RIGHT_IMP_FORALL_CONV) THEN REPEAT STRIP_TAC
2810 THEN REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC)
2811 (SPEC (“x:num”) (MATCH_MP DA (ASSUME (“0 < m”))))
2812 THEN REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC)
2813 (SPEC (“q:num”) (MATCH_MP DA (ASSUME (“0 < n”))))
2814 THEN IMP_RES_THEN (fn t => REWRITE_TAC[t]) DIV_MULT
2815 THEN IMP_RES_THEN (fn t => REWRITE_TAC[t]) DIV_MULT
2816 THEN PURE_ONCE_REWRITE_TAC[RIGHT_ADD_DISTRIB]
2817 THEN PURE_ONCE_REWRITE_TAC[GSYM MULT_ASSOC]
2818 THEN PURE_ONCE_REWRITE_TAC[GSYM ADD_ASSOC]
2819 THEN ASSUME_TAC (MATCH_MP NOT_MULT_LESS_0
2820 (CONJ (ASSUME (“0 < n”)) (ASSUME (“0 < m”))))
2821 THEN CONV_TAC ((RAND_CONV o RAND_CONV) (REWR_CONV MULT_SYM))
2822 THEN CONV_TAC SYM_CONV THEN PURE_ONCE_REWRITE_TAC[ADD_INV_0_EQ]
2823 THEN FIRST_ASSUM (fn t => REWRITE_TAC[MATCH_MP ADD_DIV_ADD_DIV t])
2824 THEN PURE_ONCE_REWRITE_TAC[ADD_INV_0_EQ]
2825 THEN MATCH_MP_TAC LESS_DIV_EQ_ZERO
2826 THEN IMP_RES_TAC Less_MULT_ADD_lemma
2827QED
2828
2829local
2830 open prim_recTheory
2831in
2832Theorem SUC_PRE:
2833 0 < m <=> (SUC (PRE m) = m)
2834Proof
2835 STRUCT_CASES_TAC (SPEC (“m:num”) num_CASES) THEN
2836 REWRITE_TAC [PRE,NOT_LESS_0,LESS_0,NOT_SUC]
2837QED
2838end
2839
2840val LESS_MONO_LEM =
2841GEN_ALL
2842 (REWRITE_RULE [ADD_CLAUSES]
2843 (SPECL (map Term [`0`, `y:num`, `x:num`])
2844 (ONCE_REWRITE_RULE[ADD_SYM]LESS_MONO_ADD)));
2845
2846Theorem DIV_LESS:
2847 !n d. 0<n /\ 1<d ==> n DIV d < n
2848Proof
2849 REWRITE_TAC [ONE] THEN REPEAT STRIP_TAC
2850 THEN IMP_RES_TAC prim_recTheory.SUC_LESS
2851 THEN CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC
2852 (SPEC(“n:num”) (UNDISCH(SPEC(“d:num”) DIVISION)))
2853 THEN RULE_ASSUM_TAC (REWRITE_RULE [ZERO_LESS_ADD])
2854 THEN MP_TAC (SPEC (“d:num”) ADD_DIV_ADD_DIV) THEN ASM_REWRITE_TAC[]
2855 THEN DISCH_THEN (fn th => REWRITE_TAC [th])
2856 THEN MP_TAC (SPECL (map Term [`n MOD d`, `d:num`]) LESS_DIV_EQ_ZERO)
2857 THEN ASM_REWRITE_TAC []
2858 THEN DISCH_THEN (fn th => REWRITE_TAC [th,ADD_CLAUSES])
2859 THEN SUBGOAL_THEN (“?m. d = SUC m”) (CHOOSE_THEN SUBST_ALL_TAC) THENL
2860 [EXISTS_TAC (“PRE d”) THEN IMP_RES_TAC SUC_PRE THEN ASM_REWRITE_TAC[],
2861 REWRITE_TAC [MULT_CLAUSES,GSYM ADD_ASSOC]
2862 THEN MATCH_MP_TAC LESS_MONO_LEM
2863 THEN PAT_ASSUM (“x \/ y”) MP_TAC
2864 THEN REWRITE_TAC[ZERO_LESS_ADD,ZERO_LESS_MULT] THEN STRIP_TAC THENL
2865 [DISJ1_TAC THEN RULE_ASSUM_TAC (REWRITE_RULE[LESS_MONO_EQ]), ALL_TAC]
2866 THEN ASM_REWRITE_TAC[]]
2867QED
2868
2869Theorem MOD_LESS:
2870 !m n. 0 < n ==> m MOD n < n
2871Proof
2872 METIS_TAC [DIVISION]
2873QED
2874
2875Theorem MOD_MOD_LESS_EQ:
2876 0 < y /\ y <= z ==> x MOD y MOD z = x MOD y
2877Proof
2878 strip_tac
2879 \\ irule LESS_MOD
2880 \\ irule LESS_LESS_EQ_TRANS
2881 \\ goal_assum(first_assum o mp_then Any mp_tac)
2882 \\ irule MOD_LESS
2883 \\ simp[]
2884QED
2885
2886Theorem ADD_MODULUS:
2887 (!n x.(x + n) MOD n = x MOD n) /\
2888 (!n x.(n + x) MOD n = x MOD n)
2889Proof
2890 METIS_TAC [ADD_SYM,MOD_PLUS,MOD_ID,MOD_MOD,ADD_CLAUSES]
2891QED
2892
2893Theorem ADD_MODULUS_LEFT = CONJUNCT1 ADD_MODULUS;
2894Theorem ADD_MODULUS_RIGHT = CONJUNCT2 ADD_MODULUS;
2895
2896Theorem DIV_P:
2897 !P p q. 0 < q ==>
2898 (P (p DIV q) = ?k r. (p = k * q + r) /\ r < q /\ P k)
2899Proof
2900 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [
2901 MAP_EVERY Q.EXISTS_TAC [`p DIV q`, `p MOD q`] THEN
2902 ASM_REWRITE_TAC [] THEN MATCH_MP_TAC DIVISION THEN
2903 FIRST_ASSUM ACCEPT_TAC,
2904 Q.SUBGOAL_THEN `p DIV q = k` (fn th => SUBST1_TAC th THEN
2905 FIRST_ASSUM ACCEPT_TAC) THEN
2906 MATCH_MP_TAC DIV_UNIQUE THEN Q.EXISTS_TAC `r` THEN ASM_REWRITE_TAC []
2907 ]
2908QED
2909
2910Theorem DIV_P_UNIV:
2911 !P m n. 0 < n ==> (P (m DIV n) = !q r. (m = q * n + r) /\ r < n ==> P q)
2912Proof
2913 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [
2914 Q_TAC SUFF_TAC `m DIV n = q`
2915 THEN1 (DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC []) THEN
2916 MATCH_MP_TAC DIV_UNIQUE THEN Q.EXISTS_TAC `r` THEN ASM_REWRITE_TAC [],
2917 FIRST_X_ASSUM MATCH_MP_TAC THEN Q.EXISTS_TAC `m MOD n` THEN
2918 MATCH_MP_TAC DIVISION THEN ASM_REWRITE_TAC []
2919 ]
2920QED
2921
2922Theorem MOD_P:
2923 !P p q. 0 < q ==>
2924 (P (p MOD q) = ?k r. (p = k * q + r) /\ r < q /\ P r)
2925Proof
2926 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [
2927 MAP_EVERY Q.EXISTS_TAC [`p DIV q`, `p MOD q`] THEN
2928 ASM_REWRITE_TAC [] THEN MATCH_MP_TAC DIVISION THEN
2929 FIRST_ASSUM ACCEPT_TAC,
2930 Q.SUBGOAL_THEN `p MOD q = r` (fn th => SUBST1_TAC th THEN
2931 FIRST_ASSUM ACCEPT_TAC) THEN
2932 MATCH_MP_TAC MOD_UNIQUE THEN Q.EXISTS_TAC `k` THEN ASM_REWRITE_TAC []
2933 ]
2934QED
2935
2936Theorem MOD_P_UNIV:
2937 !P m n. 0 < n ==>
2938 (P (m MOD n) = !q r. (m = q * n + r) /\ r < n ==> P r)
2939Proof
2940 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [
2941 Q_TAC SUFF_TAC `m MOD n = r`
2942 THEN1 (DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC []) THEN
2943 MATCH_MP_TAC MOD_UNIQUE THEN Q.EXISTS_TAC `q` THEN ASM_REWRITE_TAC [],
2944 FIRST_X_ASSUM MATCH_MP_TAC THEN Q.EXISTS_TAC `m DIV n` THEN
2945 MATCH_MP_TAC DIVISION THEN ASM_REWRITE_TAC []
2946 ]
2947QED
2948
2949(* Could generalise this to work over arbitrary operators by making the
2950 commutativity and associativity theorems parameters. It seems OTT
2951 enough as it is. *)
2952fun move_var_left s = let
2953 val v = mk_var(s, “:num”)
2954 val th1 = GSYM (SPEC v MULT_COMM) (* xv = vx *)
2955 val th2 = GSYM (SPEC v MULT_ASSOC) (* (vx)y = v(xy) *)
2956 val th3 = CONV_RULE (* x(vy) = v(xy) *)
2957 (STRIP_QUANT_CONV
2958 (LAND_CONV (LAND_CONV (REWR_CONV MULT_COMM) THENC
2959 REWR_CONV (GSYM MULT_ASSOC)))) th2
2960in
2961 (* The complicated conversion at the heart of this could be replaced with
2962 REWRITE_CONV if that procedure was modified to dynamically throw
2963 away rewrites that on instantiation turn out to be loops, which it
2964 could do by wrapping its REWR_CONVs in CHANGED_CONVs. Perhaps this
2965 would be inefficient. *)
2966 FREEZE_THEN
2967 (fn th1 => FREEZE_THEN
2968 (fn th2 => FREEZE_THEN
2969 (fn th3 => CONV_TAC
2970 (REDEPTH_CONV
2971 (FIRST_CONV
2972 (map (CHANGED_CONV o REWR_CONV)
2973 [th1, th2, th3])))) th3) th2) th1
2974end
2975
2976Theorem MOD_TIMES2:
2977 !n j k. ((j MOD n) * (k MOD n)) MOD n = (j * k) MOD n
2978Proof
2979 REPEAT STRIP_TAC THEN
2980 Cases_on `n = 0`
2981 THEN1 (ASM_REWRITE_TAC [MOD_0,MULT_CLAUSES,ADD_CLAUSES]) THEN
2982 dxrule_then assume_tac $ iffLR NOT_ZERO_LT_ZERO THEN
2983 IMP_RES_THEN (Q.SPEC_THEN `j` STRIP_ASSUME_TAC) DIVISION THEN
2984 IMP_RES_THEN (Q.SPEC_THEN `k` STRIP_ASSUME_TAC) DIVISION THEN
2985 Q.ABBREV_TAC `q = j DIV n` THEN POP_ASSUM (K ALL_TAC) THEN
2986 Q.ABBREV_TAC `r = j MOD n` THEN POP_ASSUM (K ALL_TAC) THEN
2987 Q.ABBREV_TAC `u = k DIV n` THEN POP_ASSUM (K ALL_TAC) THEN
2988 Q.ABBREV_TAC `v = k MOD n` THEN POP_ASSUM (K ALL_TAC) THEN
2989 NTAC 2 (FIRST_X_ASSUM SUBST_ALL_TAC) THEN
2990 REWRITE_TAC [LEFT_ADD_DISTRIB, RIGHT_ADD_DISTRIB, ADD_ASSOC] THEN
2991 move_var_left "n" THEN REWRITE_TAC [GSYM LEFT_ADD_DISTRIB] THEN
2992 ONCE_REWRITE_TAC [MULT_COMM] THEN
2993 REWRITE_TAC [MOD_TIMES]
2994QED
2995
2996Theorem MOD_COMMON_FACTOR:
2997 !n p q. 0 < n /\ 0 < q ==> (n * (p MOD q) = (n * p) MOD (n * q))
2998Proof
2999 REPEAT STRIP_TAC THEN Q.SPEC_THEN `q` MP_TAC DIVISION THEN
3000 ASM_REWRITE_TAC [] THEN DISCH_THEN (Q.SPEC_THEN `p` STRIP_ASSUME_TAC) THEN
3001 Q.ABBREV_TAC `u = p DIV q` THEN POP_ASSUM (K ALL_TAC) THEN
3002 Q.ABBREV_TAC `v = p MOD q` THEN POP_ASSUM (K ALL_TAC) THEN
3003 FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC [LEFT_ADD_DISTRIB] THEN
3004 move_var_left "u" THEN
3005 ASM_SIMP_TAC bool_ss [MOD_TIMES, LESS_MULT2] THEN
3006 SUFF_TAC “n * v < n * q” THENL [mesonLib.MESON_TAC [LESS_MOD],
3007 ALL_TAC] THEN
3008 SUFF_TAC “?m. n = SUC m” THENL [
3009 STRIP_TAC THEN ASM_REWRITE_TAC [LESS_MULT_MONO],
3010 mesonLib.ASM_MESON_TAC [LESS_REFL, num_CASES]
3011 ]
3012QED
3013
3014Theorem X_MOD_Y_EQ_X:
3015 !x y. 0 < y ==> ((x MOD y = x) <=> x < y)
3016Proof
3017 REPEAT STRIP_TAC THEN EQ_TAC THENL [
3018 mesonLib.ASM_MESON_TAC [DIVISION],
3019 STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQUE THEN
3020 Q.EXISTS_TAC `0` THEN ASM_REWRITE_TAC [MULT_CLAUSES, ADD_CLAUSES]
3021 ]
3022QED
3023
3024Theorem DIV_LE_MONOTONE:
3025 !n x y. 0 < n /\ x <= y ==> x DIV n <= y DIV n
3026Proof
3027 REPEAT STRIP_TAC THEN
3028 Q.SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL [
3029 ASM_REWRITE_TAC [NOT_ZERO_LT_ZERO],
3030 ALL_TAC
3031 ] THEN
3032 Q.SPEC_THEN `n` MP_TAC DIVISION THEN ASM_REWRITE_TAC [] THEN
3033 DISCH_THEN (fn th => Q.SPEC_THEN `x` STRIP_ASSUME_TAC th THEN
3034 Q.SPEC_THEN `y` STRIP_ASSUME_TAC th) THEN
3035 Q.ABBREV_TAC `q = x DIV n` THEN POP_ASSUM (K ALL_TAC) THEN
3036 Q.ABBREV_TAC `r = y DIV n` THEN POP_ASSUM (K ALL_TAC) THEN
3037 Q.ABBREV_TAC `d = x MOD n` THEN POP_ASSUM (K ALL_TAC) THEN
3038 Q.ABBREV_TAC `e = y MOD n` THEN POP_ASSUM (K ALL_TAC) THEN
3039 SRW_TAC [][] THEN CCONTR_TAC THEN
3040 POP_ASSUM (ASSUME_TAC o REWRITE_RULE [NOT_LEQ]) THEN (* SUC r < q *)
3041 Q.SPECL_THEN [`SUC r`, `n`, `q`] MP_TAC LE_MULT_RCANCEL THEN
3042 ASM_REWRITE_TAC [] THEN STRIP_TAC THEN (* SUC r * n <= q * n *)
3043 POP_ASSUM (ASSUME_TAC o REWRITE_RULE [MULT_CLAUSES]) THEN
3044 (* r * n + n <= q * n *)
3045 Q.SPECL_THEN [`e`, `n`, `r * n`] MP_TAC LT_ADD_LCANCEL THEN
3046 ASM_REWRITE_TAC [] THEN STRIP_TAC THEN (* r * n + e < r * n + n *)
3047 Q.SPECL_THEN [`q * n`, `d`] ASSUME_TAC LESS_EQ_ADD THEN
3048 (* q * n <= q * n + d *)
3049 Q.SUBGOAL_THEN `r * n + e < r * n + e` (CONTR_TAC o MATCH_MP LESS_REFL) THEN
3050 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN Q.EXISTS_TAC `q * n + d` THEN
3051 ASM_REWRITE_TAC [] THEN MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN
3052 Q.EXISTS_TAC `r * n + n` THEN ASM_REWRITE_TAC [] THEN
3053 MATCH_MP_TAC LESS_EQ_TRANS THEN Q.EXISTS_TAC `q * n` THEN
3054 ASM_REWRITE_TAC []
3055QED
3056
3057Theorem LE_LT1:
3058 !x y. x <= y <=> x < y + 1
3059Proof
3060 REWRITE_TAC [LESS_OR_EQ, GSYM ADD1,
3061 IMP_ANTISYM_RULE (SPEC_ALL prim_recTheory.LESS_LEMMA1)
3062 (SPEC_ALL prim_recTheory.LESS_LEMMA2)] THEN
3063 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC []
3064QED
3065
3066Theorem X_LE_DIV:
3067 !x y z. 0 < z ==> (x <= y DIV z <=> x * z <= y)
3068Proof
3069 REPEAT STRIP_TAC THEN
3070 Q.SPEC_THEN `z` MP_TAC DIVISION THEN
3071 ASM_REWRITE_TAC [] THEN
3072 DISCH_THEN (Q.SPEC_THEN `y` STRIP_ASSUME_TAC) THEN
3073 Q.ABBREV_TAC `q = y DIV z` THEN
3074 Q.ABBREV_TAC `r = y MOD z` THEN ASM_REWRITE_TAC [] THEN EQ_TAC THENL [
3075 STRIP_TAC THEN MATCH_MP_TAC LESS_EQ_TRANS THEN
3076 Q.EXISTS_TAC `q * z` THEN
3077 ASM_SIMP_TAC bool_ss [LE_MULT_RCANCEL, LESS_EQ_ADD],
3078 STRIP_TAC THEN REWRITE_TAC [LE_LT1] THEN
3079 Q_TAC SUFF_TAC `x * z < (q + 1) * z`
3080 THEN1 SIMP_TAC bool_ss [LT_MULT_RCANCEL] THEN
3081 REWRITE_TAC [RIGHT_ADD_DISTRIB,
3082 MULT_CLAUSES] THEN
3083 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN
3084 Q.EXISTS_TAC `q * z + r` THEN
3085 ASM_SIMP_TAC bool_ss [LT_ADD_LCANCEL]
3086 ]
3087QED
3088
3089Theorem X_LT_DIV:
3090 !x y z. 0 < z ==> (x < y DIV z <=> (x + 1) * z <= y)
3091Proof
3092 REPEAT STRIP_TAC THEN
3093 Q.SPEC_THEN `z` MP_TAC DIVISION THEN
3094 ASM_REWRITE_TAC [] THEN
3095 DISCH_THEN (Q.SPEC_THEN `y` STRIP_ASSUME_TAC) THEN
3096 Q.ABBREV_TAC `q = y DIV z` THEN
3097 Q.ABBREV_TAC `r = y MOD z` THEN ASM_REWRITE_TAC [] THEN EQ_TAC THENL [
3098 STRIP_TAC THEN MATCH_MP_TAC LESS_EQ_TRANS THEN
3099 Q.EXISTS_TAC `q * z` THEN
3100 ASM_SIMP_TAC bool_ss [LE_MULT_RCANCEL, LESS_EQ_ADD] THEN
3101 ASM_SIMP_TAC bool_ss [LE_LT1, LT_ADD_RCANCEL],
3102 STRIP_TAC THEN
3103 CCONTR_TAC THEN
3104 POP_ASSUM (ASSUME_TAC o REWRITE_RULE [NOT_LESS]) THEN
3105 Q.SUBGOAL_THEN `(x + 1) * z <= x * z + r` ASSUME_TAC THENL [
3106 MATCH_MP_TAC LESS_EQ_TRANS THEN
3107 Q.EXISTS_TAC `q * z + r` THEN
3108 ASM_SIMP_TAC bool_ss [LE_ADD_RCANCEL, LE_MULT_RCANCEL],
3109 POP_ASSUM MP_TAC THEN
3110 ASM_REWRITE_TAC [RIGHT_ADD_DISTRIB, MULT_CLAUSES,
3111 LE_ADD_LCANCEL, GSYM NOT_LESS,
3112 LT_ADD_LCANCEL]
3113 ]
3114 ]
3115QED
3116
3117Theorem DIV_LT_X:
3118 !x y z. 0 < z ==> (y DIV z < x <=> y < x * z)
3119Proof
3120 REPEAT STRIP_TAC THEN
3121 REWRITE_TAC [GSYM NOT_LESS_EQUAL] THEN
3122 AP_TERM_TAC THEN MATCH_MP_TAC X_LE_DIV THEN
3123 ASM_REWRITE_TAC []
3124QED
3125
3126Theorem DIV_LE_X:
3127 !x y z. 0 < z ==> (y DIV z <= x <=> y < (x + 1) * z)
3128Proof
3129 REPEAT STRIP_TAC THEN
3130 CONV_TAC (FORK_CONV (REWR_CONV (GSYM NOT_LESS),
3131 REWR_CONV (GSYM NOT_LESS_EQUAL))) THEN
3132 AP_TERM_TAC THEN MATCH_MP_TAC X_LT_DIV THEN
3133 ASM_REWRITE_TAC []
3134QED
3135
3136Theorem DIV_EQ_X:
3137 !x y z. 0 < z ==> ((y DIV z = x) <=> x * z <= y /\ y < SUC x * z)
3138Proof
3139 SIMP_TAC bool_ss [EQ_LESS_EQ,DIV_LE_X,X_LE_DIV,GSYM ADD1,
3140 AC CONJ_COMM CONJ_ASSOC]
3141QED
3142
3143Theorem EQ_ADD_LCANCEL'[local]:
3144 x + y = y + z <=> x = z
3145Proof
3146 METIS_TAC[ADD_COMM, EQ_ADD_LCANCEL]
3147QED
3148
3149(* will work well under standard ARITH_ss type normalisation which makes
3150 addition right-associative, and will put the numeral/coefficient first in
3151 multiplications *)
3152Theorem DIV_NUMERAL_THM[simp]:
3153 (NUMERAL (BIT1 n) * x) DIV NUMERAL (BIT1 n) = x /\
3154 (NUMERAL (BIT2 n) * x) DIV NUMERAL (BIT2 n) = x /\
3155 (NUMERAL (BIT1 n) * x + y) DIV NUMERAL (BIT1 n) = x + y DIV NUMERAL (BIT1 n)/\
3156 (NUMERAL (BIT2 n) * x + y) DIV NUMERAL (BIT2 n) = x + y DIV NUMERAL (BIT2 n)/\
3157 (y + NUMERAL (BIT1 n) * x) DIV NUMERAL (BIT1 n) = x + y DIV NUMERAL (BIT1 n)/\
3158 (y + NUMERAL (BIT2 n) * x) DIV NUMERAL (BIT2 n) = x + y DIV NUMERAL (BIT2 n)
3159Proof
3160 Q.ABBREV_TAC ‘N1 = NUMERAL(BIT1 n)’ >>
3161 Q.ABBREV_TAC ‘N2 = NUMERAL(BIT2 n)’ >>
3162 ‘0 < N1 /\ 0 < N2’
3163 by (MAP_EVERY Q.UNABBREV_TAC [‘N1’, ‘N2’] >>
3164 REWRITE_TAC[NUMERAL_DEF, BIT1, BIT2, ADD_CLAUSES, LESS_0]) >>
3165 ‘!x. x * N1 = N1 * x /\ x * N2 = N2 * x’
3166 by REWRITE_TAC[MULT_COMM |> SPEC_ALL |> EQT_INTRO] >>
3167 simp_tac bool_ss [AC ADD_COMM ADD_ASSOC, SF CONJ_ss] >>
3168 rpt conj_tac >> irule DIV_UNIQUE
3169 >- (first_assum $ irule_at Any >> ASM_REWRITE_TAC[ADD_CLAUSES])
3170 >- (first_assum $ irule_at Any >> ASM_REWRITE_TAC[ADD_CLAUSES])
3171 >- (ASM_REWRITE_TAC [RIGHT_ADD_DISTRIB, EQ_ADD_LCANCEL', GSYM ADD_ASSOC] >>
3172 rpt (dxrule_then (mp_tac o GSYM) DIVISION) >>
3173 ASM_REWRITE_TAC[] >>
3174 rpt (disch_then (strip_assume_tac o CONV_RULE FORALL_AND_CONV)) >>
3175 first_assum $ irule_at Any >> ONCE_REWRITE_TAC [EQ_SYM_EQ] >>
3176 first_assum $ irule_at Any)
3177 >- (ASM_REWRITE_TAC [RIGHT_ADD_DISTRIB, EQ_ADD_LCANCEL', GSYM ADD_ASSOC] >>
3178 rpt (dxrule_then (mp_tac o GSYM) DIVISION) >>
3179 ASM_REWRITE_TAC[] >>
3180 rpt (disch_then (strip_assume_tac o CONV_RULE FORALL_AND_CONV)) >>
3181 first_assum $ irule_at Any >> ONCE_REWRITE_TAC [EQ_SYM_EQ] >>
3182 first_assum $ irule_at Any)
3183QED
3184
3185Theorem DIV_MOD_MOD_DIV:
3186 !m n k. 0 < n /\ 0 < k ==> ((m DIV n) MOD k = (m MOD (n * k)) DIV n)
3187Proof
3188 REPEAT STRIP_TAC THEN
3189 Q.SUBGOAL_THEN `0 < n * k` ASSUME_TAC THENL [
3190 ASM_REWRITE_TAC [ZERO_LESS_MULT],
3191 ALL_TAC
3192 ] THEN
3193 Q.SPEC_THEN `n * k` MP_TAC DIVISION THEN
3194 ASM_REWRITE_TAC [] THEN DISCH_THEN (Q.SPEC_THEN `m` STRIP_ASSUME_TAC) THEN
3195 Q.ABBREV_TAC `q = m DIV (n * k)` THEN
3196 Q.ABBREV_TAC `r = m MOD (n * k)` THEN
3197 markerLib.RM_ALL_ABBREVS_TAC THEN
3198 ASM_REWRITE_TAC [] THEN
3199 Q.SUBGOAL_THEN `q * (n * k) = (q * k) * n` SUBST1_TAC THENL [
3200 SIMP_TAC bool_ss [AC MULT_ASSOC MULT_COMM],
3201 ALL_TAC
3202 ] THEN ASM_SIMP_TAC bool_ss [ADD_DIV_ADD_DIV, MOD_TIMES] THEN
3203 MATCH_MP_TAC LESS_MOD THEN ASM_SIMP_TAC bool_ss [DIV_LT_X] THEN
3204 FULL_SIMP_TAC bool_ss [AC MULT_ASSOC MULT_COMM]
3205QED
3206
3207(* useful if x and z are both constants *)
3208Theorem MULT_EQ_DIV:
3209 0 < x ==> ((x * y = z) <=> (y = z DIV x) /\ (z MOD x = 0))
3210Proof
3211 STRIP_TAC THEN EQ_TAC THENL [
3212 DISCH_THEN (SUBST_ALL_TAC o SYM) THEN
3213 ONCE_REWRITE_TAC [MULT_COMM] THEN
3214 ASM_SIMP_TAC bool_ss [MOD_EQ_0, MULT_DIV],
3215 Q.SPEC_THEN `x` MP_TAC DIVISION THEN ASM_REWRITE_TAC [] THEN
3216 DISCH_THEN (Q.SPEC_THEN `z` STRIP_ASSUME_TAC) THEN
3217 REPEAT STRIP_TAC THEN
3218 FULL_SIMP_TAC bool_ss [ADD_CLAUSES, MULT_COMM] THEN
3219 ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN FIRST_ASSUM ACCEPT_TAC
3220 ]
3221QED
3222
3223(* as they are here *)
3224Theorem NUMERAL_MULT_EQ_DIV:
3225 ((NUMERAL (BIT1 x) * y = NUMERAL z) <=>
3226 (y = NUMERAL z DIV NUMERAL (BIT1 x)) /\
3227 (NUMERAL z MOD NUMERAL(BIT1 x) = 0)) /\
3228 ((NUMERAL (BIT2 x) * y = NUMERAL z) <=>
3229 (y = NUMERAL z DIV NUMERAL (BIT2 x)) /\
3230 (NUMERAL z MOD NUMERAL(BIT2 x) = 0))
3231Proof
3232 CONJ_TAC THEN MATCH_MP_TAC MULT_EQ_DIV THEN
3233 REWRITE_TAC [NUMERAL_DEF, BIT1, BIT2, ADD_CLAUSES, LESS_0]
3234QED
3235
3236Theorem MOD_EQ_0_DIVISOR:
3237 0 < n ==> ((k MOD n = 0) = (?d. k = d * n))
3238Proof
3239 DISCH_TAC >> EQ_TAC
3240 >- (DISCH_TAC >>
3241 EXISTS_TAC “k DIV n” >>
3242 MATCH_MP_TAC EQ_SYM >>
3243 SRW_TAC [][Once MULT_SYM] >>
3244 MATCH_MP_TAC
3245 (MP_CANON (DISCH_ALL (#2(EQ_IMP_RULE (UNDISCH MULT_EQ_DIV))))) >>
3246 SRW_TAC [][] ) >>
3247 SRW_TAC [][] THEN SRW_TAC [][MOD_EQ_0]
3248QED
3249
3250Theorem MOD_SUC:
3251 0 < y /\ (SUC x <> (SUC (x DIV y)) * y) ==> ((SUC x) MOD y = SUC (x MOD y))
3252Proof
3253STRIP_TAC THEN
3254MATCH_MP_TAC MOD_UNIQUE THEN
3255Q.EXISTS_TAC `x DIV y` THEN
3256`x = x DIV y * y + x MOD y` by PROVE_TAC [DIVISION] THEN
3257`x MOD y < y` by PROVE_TAC [MOD_LESS] THEN
3258FULL_SIMP_TAC bool_ss [prim_recTheory.INV_SUC_EQ,ADD_CLAUSES,MULT_CLAUSES] THEN
3259MATCH_MP_TAC LESS_NOT_SUC THEN
3260CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN
3261SPOSE_NOT_THEN STRIP_ASSUME_TAC THEN
3262`SUC x = SUC (x DIV y * y + x MOD y)` by (
3263 AP_TERM_TAC THEN FIRST_ASSUM ACCEPT_TAC ) THEN
3264FULL_SIMP_TAC bool_ss [ADD_SUC] THEN
3265PROVE_TAC []
3266QED
3267
3268Theorem MOD_SUC_IFF:
3269 0 < y ==> ((SUC x MOD y = SUC (x MOD y)) <=> (SUC x <> SUC (x DIV y) * y))
3270Proof
3271 PROVE_TAC [MOD_SUC,SUC_NOT,MOD_EQ_0]
3272QED
3273
3274Theorem ONE_MOD:
3275 1 < n ==> (1 MOD n = 1)
3276Proof
3277 STRIP_TAC THEN
3278 `0 < n` by (
3279 MATCH_MP_TAC LESS_TRANS THEN
3280 EXISTS_TAC “1” THEN
3281 SRW_TAC [][LESS_SUC_REFL,ONE] ) THEN
3282 SUFF_TAC “SUC 0 MOD n = SUC (0 MOD n)” THEN1
3283 SRW_TAC [][ZERO_MOD,ONE] THEN
3284 MATCH_MP_TAC MOD_SUC THEN
3285 SRW_TAC [][ZERO_DIV,MULT,ADD,LESS_NOT_EQ,GSYM ONE]
3286QED
3287
3288Theorem ONE_MOD_IFF:
3289 1 < n <=> 0 < n /\ (1 MOD n = 1)
3290Proof
3291 EQ_TAC THEN1 (
3292 SRW_TAC [][ONE_MOD] THEN
3293 MATCH_MP_TAC LESS_TRANS THEN
3294 EXISTS_TAC “1” THEN
3295 SRW_TAC [][LESS_SUC_REFL,ONE] ) THEN
3296 STRUCT_CASES_TAC (SPEC “n:num” num_CASES) THEN1 (
3297 SIMP_TAC bool_ss [LESS_REFL] ) THEN
3298 SIMP_TAC bool_ss [ONE] THEN
3299 STRIP_TAC THEN
3300 MATCH_MP_TAC LESS_MONO THEN
3301 Q.MATCH_RENAME_TAC `0 < m` THEN
3302 FULL_STRUCT_CASES_TAC (SPEC “m:num” num_CASES) THEN1 (
3303 FULL_SIMP_TAC bool_ss [MOD_ONE,SUC_NOT] ) THEN
3304 SIMP_TAC bool_ss [LESS_0]
3305QED
3306
3307Theorem MOD_LESS_EQ:
3308 0 < y ==> x MOD y <= x
3309Proof
3310 STRIP_TAC THEN
3311 Cases_on `x < y` THEN1 (
3312 MATCH_MP_TAC (snd (EQ_IMP_RULE (SPEC_ALL LESS_OR_EQ))) THEN
3313 DISJ2_TAC THEN
3314 MATCH_MP_TAC LESS_MOD THEN
3315 POP_ASSUM ACCEPT_TAC ) THEN
3316 MATCH_MP_TAC LESS_EQ_TRANS THEN
3317 Q.EXISTS_TAC `y` THEN
3318 CONJ_TAC THEN1 (
3319 MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN
3320 MATCH_MP_TAC MOD_LESS THEN
3321 FIRST_ASSUM ACCEPT_TAC ) THEN
3322 IMP_RES_TAC NOT_LESS
3323QED
3324
3325Theorem MOD_LIFT_PLUS:
3326 0 < n /\ k < n - x MOD n ==> ((x + k) MOD n = x MOD n + k)
3327Proof
3328 Q.ID_SPEC_TAC `k` THEN INDUCT_TAC THEN1 (
3329 SIMP_TAC bool_ss [ADD_0] ) THEN
3330 STRIP_TAC THEN
3331 `x + SUC k = SUC (x + k)` by (
3332 SIMP_TAC bool_ss [ADD_CLAUSES] ) THEN
3333 `k < n - x MOD n` by (
3334 MATCH_MP_TAC prim_recTheory.SUC_LESS THEN
3335 FIRST_ASSUM ACCEPT_TAC ) THEN
3336 FULL_SIMP_TAC bool_ss [] THEN
3337 MATCH_MP_TAC EQ_TRANS THEN
3338 Q.EXISTS_TAC `SUC (x MOD n + k)` THEN
3339 CONJ_TAC THEN1 (
3340 MATCH_MP_TAC EQ_TRANS THEN
3341 Q.EXISTS_TAC `SUC ((x + k) MOD n)` THEN
3342 CONJ_TAC THEN1 (
3343 MATCH_MP_TAC MOD_SUC THEN
3344 CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN
3345 FULL_SIMP_TAC bool_ss [ADD_SYM,ADD,SUB_LEFT_LESS,MULT_CLAUSES] THEN
3346 `SUC ((k + x) MOD n + (k + x) DIV n * n) < n + (k + x) DIV n * n`
3347 by PROVE_TAC [LESS_MONO_ADD,ADD_SUC,ADD_SYM] THEN
3348 PROVE_TAC [DIVISION,ADD_SYM,LESS_REFL]) THEN
3349 AP_TERM_TAC THEN
3350 FIRST_ASSUM ACCEPT_TAC) THEN
3351 SIMP_TAC bool_ss [ADD_SUC]
3352QED
3353
3354Theorem MOD_LIFT_PLUS_IFF:
3355 0 < n ==> (((x + k) MOD n = x MOD n + k) = (k < n - x MOD n))
3356Proof
3357 PROVE_TAC [SUB_LEFT_LESS,ADD_SYM,MOD_LESS,MOD_LIFT_PLUS]
3358QED
3359
3360Theorem DIV_0_IMP_LT:
3361 !b n. 1 < b /\ (n DIV b = 0) ==> n < b
3362Proof
3363 REPEAT STRIP_TAC \\ SPOSE_NOT_THEN ASSUME_TAC
3364 \\ FULL_SIMP_TAC bool_ss [NOT_LESS]
3365 \\ IMP_RES_TAC LESS_EQUAL_ADD
3366 \\ `0 < b` by (
3367 MATCH_MP_TAC LESS_TRANS THEN
3368 EXISTS_TAC “1” THEN
3369 SRW_TAC [][LESS_SUC_REFL,ONE] )
3370 \\ IMP_RES_TAC ADD_DIV_ADD_DIV
3371 \\ POP_ASSUM (Q.SPECL_THEN [`1`,`p`] (ASSUME_TAC o SIMP_RULE bool_ss []))
3372 \\ FULL_SIMP_TAC bool_ss [MULT_CLAUSES, ADD_EQ_0, ONE, SUC_NOT]
3373QED
3374
3375Theorem DIV_EQ_0:
3376 1 < b ==> ((n DIV b = 0) = (n < b))
3377Proof
3378 PROVE_TAC[DIV_0_IMP_LT, LESS_DIV_EQ_ZERO]
3379QED
3380
3381(* NOTE: in HOL-Light the original statement was:
3382
3383 |- P (m DIV n) (m MOD n) <=>
3384 (!q r. n = 0 /\ q = 0 /\ r = m \/ m = q * n + r /\ r < n ==> P q r)
3385
3386 where ‘m DIV 0 = 0’ by definition. In HOL4, ‘m DIV 0’ is unspecified, thus
3387 only the following alternative statements is possible:
3388 *)
3389Theorem DIVMOD_ELIM_THM :
3390 !P m n. 0 < n ==>
3391 (P (m DIV n) (m MOD n) <=> !q r. m = q * n + r /\ r < n ==> P q r)
3392Proof
3393 rpt STRIP_TAC
3394 >> FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION)
3395 >> PROVE_TAC[DIVMOD_UNIQ]
3396QED
3397
3398Theorem DIVMOD_ELIM_THM' :
3399 !P m n. 0 < n ==>
3400 (P (m DIV n) (m MOD n) <=> ?q r. m = q * n + r /\ r < n /\ P q r)
3401Proof
3402 rpt STRIP_TAC
3403 >> MP_TAC (Q.SPECL [‘\x y. ~P x y’,‘m’,‘n’] DIVMOD_ELIM_THM)
3404 >> PROVE_TAC []
3405QED
3406
3407Theorem MOD_DIV_SAME[simp]:
3408 0 < y ==> x MOD y DIV y = 0
3409Proof
3410 strip_tac
3411 \\ Cases_on`y=1` \\ fs[DIV_1, MOD_1]
3412 \\ `1 < y` by (
3413 simp[ONE, SUC_LT]
3414 \\ Cases_on`y` \\ fs[NOT_LESS_0, ONE]
3415 \\ drule (NOT_LT_ZERO_EQ_ZERO |> GSYM |> SPEC_ALL |> iffRL |> CONTRAPOS)
3416 \\ rw[] )
3417 \\ rw[DIV_EQ_0, MOD_LESS]
3418QED
3419
3420(* ------------------------------------------------------------------------ *)
3421(* Some miscellaneous lemmas (from transc.ml) *)
3422(* ------------------------------------------------------------------------ *)
3423
3424Theorem MULT_DIV_2 :
3425 !n. (2 * n) DIV 2 = n
3426Proof
3427 GEN_TAC THEN REWRITE_TAC[GSYM DIV2_def, DIV2_DOUBLE]
3428QED
3429
3430Theorem EVEN_DIV_2 : (* was: EVEN_DIV2 *)
3431 !n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))
3432Proof
3433 GEN_TAC THEN REWRITE_TAC[GSYM ODD_EVEN, ODD_EXISTS] THEN
3434 DISCH_THEN(Q.X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3435 REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1, GSYM ADD_ASSOC] THEN
3436 SUBST1_TAC(SYM (Q.SPEC ‘1’ TIMES2)) THEN
3437 REWRITE_TAC[GSYM LEFT_ADD_DISTRIB, MULT_DIV_2]
3438QED
3439
3440(* ----------------------------------------------------------------------
3441 Some additional theorems (nothing to do with DIV and MOD)
3442 ---------------------------------------------------------------------- *)
3443
3444Theorem num_case_cong = Prim_rec.case_cong_thm num_CASES num_case_def;
3445
3446Theorem SUC_ELIM_THM:
3447 !P. (!n. P (SUC n) n) = (!n. (0 < n ==> P n (n-1)))
3448Proof
3449 GEN_TAC THEN EQ_TAC THENL [
3450 REPEAT STRIP_TAC THEN
3451 FIRST_ASSUM (MP_TAC o SPEC (“n-1”)) THEN
3452 SIMP_TAC bool_ss [SUB_LEFT_SUC, ONE, SUB_MONO_EQ, SUB_0,
3453 GSYM NOT_LESS] THEN
3454 COND_CASES_TAC THENL [
3455 STRIP_ASSUME_TAC (SPECL [“n:num”, “SUC 0”] LESS_LESS_CASES)
3456 THENL [
3457 FULL_SIMP_TAC bool_ss [],
3458 IMP_RES_TAC LESS_LESS_SUC
3459 ],
3460 REWRITE_TAC []
3461 ],
3462 REPEAT STRIP_TAC THEN
3463 FIRST_ASSUM (MP_TAC o SPEC (“n+1”)) THEN
3464 SIMP_TAC bool_ss [GSYM ADD1, SUC_SUB1, LESS_0]
3465 ]
3466QED
3467
3468Theorem SUC_ELIM_NUMERALS:
3469 !f g. (!n. g (SUC n) = f n (SUC n)) <=>
3470 (!n. g (NUMERAL (BIT1 n)) =
3471 f (NUMERAL (BIT1 n) - 1) (NUMERAL (BIT1 n))) /\
3472 (!n. g (NUMERAL (BIT2 n)) =
3473 f (NUMERAL (BIT1 n)) (NUMERAL (BIT2 n)))
3474Proof
3475 REPEAT GEN_TAC THEN EQ_TAC THEN
3476 SIMP_TAC bool_ss [NUMERAL_DEF, BIT1, BIT2, ALT_ZERO,
3477 ADD_CLAUSES, SUB_MONO_EQ, SUB_0] THEN
3478 REPEAT STRIP_TAC THEN
3479 Q.SPEC_THEN `n` STRIP_ASSUME_TAC EVEN_OR_ODD THEN
3480 POP_ASSUM (Q.X_CHOOSE_THEN `m` SUBST_ALL_TAC o
3481 REWRITE_RULE [EVEN_EXISTS, ODD_EXISTS, TIMES2]) THEN
3482 ASM_REWRITE_TAC []
3483QED
3484
3485Theorem ADD_SUBR2[local]:
3486 !m n. m - (m + n) = 0
3487Proof
3488 REWRITE_TAC [SUB_EQ_0, LESS_EQ_ADD]
3489QED
3490
3491Theorem SUB_ELIM_THM:
3492 P (a - b) = !d. ((b = a + d) ==> P 0) /\ ((a = b + d) ==> P d)
3493Proof
3494 DISJ_CASES_TAC(SPECL [“a:num”, “b:num”] LESS_EQ_CASES) THEN
3495 FIRST_ASSUM(X_CHOOSE_TAC (“e:num”) o REWRITE_RULE[LESS_EQ_EXISTS]) THEN
3496 ASM_REWRITE_TAC[ADD_SUB, ONCE_REWRITE_RULE [ADD_SYM] ADD_SUB, ADD_SUBR2] THEN
3497 REWRITE_TAC [ONCE_REWRITE_RULE [ADD_SYM] EQ_MONO_ADD_EQ] THEN
3498 CONV_TAC (DEPTH_CONV FORALL_AND_CONV) THEN
3499 GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) empty_rewrites [EQ_SYM_EQ] THEN
3500 REWRITE_TAC[GSYM ADD_ASSOC, ADD_INV_0_EQ, ADD_EQ_0] THENL
3501 [EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
3502 FIRST_ASSUM(fn th => MATCH_MP_TAC th THEN EXISTS_TAC (“e:num”)),
3503 EQ_TAC THENL
3504 [DISCH_TAC THEN CONJ_TAC THEN GEN_TAC THEN
3505 DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN SUBST_ALL_TAC),
3506 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2)]] THEN
3507 ASM_REWRITE_TAC[]
3508QED
3509
3510(* |- P (a - b) <=> (?d. (b = a + d) /\ P 0) \/ (?d. (a = b + d) /\ P d) *)
3511Theorem SUB_ELIM_THM_EXISTS =
3512 SUB_ELIM_THM |> AP_TERM “$~”
3513 |> CONV_RULE (RAND_CONV (SIMP_CONV bool_ss [EXISTS_OR_THM]))
3514 |> Q.INST [‘P’ |-> ‘\n. ~P n’]
3515 |> SIMP_RULE bool_ss []
3516
3517(* some HOL-Light compatible theorem names *)
3518Theorem LTE_CASES = LESS_CASES
3519Theorem NOT_LT = NOT_LESS
3520Theorem NOT_LE = NOT_LESS_EQUAL
3521Theorem LT_IMP_LE = LESS_IMP_LESS_OR_EQ
3522Theorem LE_ADD = LESS_EQ_ADD
3523Theorem LE_EXISTS = LESS_EQ_EXISTS
3524
3525(* This is HOL-Light's SUB_ELIM_THM, with a single ‘P d’ at rhs. *)
3526Theorem SUB_ELIM_THM' :
3527 P (a - b) <=> (!d. a = b + d \/ a < b /\ d = 0 ==> P d)
3528Proof
3529 DISJ_CASES_TAC(Q.SPECL [‘a’, ‘b’] LTE_CASES)
3530 >- (ASM_MESON_TAC[NOT_LT, SUB_EQ_0, LT_IMP_LE, LE_ADD]) \\
3531 FIRST_ASSUM(X_CHOOSE_THEN “e:num” SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) \\
3532 SIMP_TAC bool_ss [ADD_SUB2, GSYM NOT_LE, LE_ADD, EQ_ADD_LCANCEL]
3533QED
3534
3535(* HOL-Light compatible *)
3536Theorem SUB_ELIM_THM_EXISTS' :
3537 P (a - b) <=> ?d. (a = b + d \/ a < b /\ d = 0) /\ P d
3538Proof
3539 MP_TAC(INST [“P:num->bool” |-> “\x:num. ~P x”] SUB_ELIM_THM')
3540 >> MESON_TAC[]
3541QED
3542
3543Theorem PRE_ELIM_THM:
3544 P (PRE n) = !m. ((n = 0) ==> P 0) /\ ((n = SUC m) ==> P m)
3545Proof
3546 SPEC_TAC(“n:num”,“n:num”) THEN INDUCT_TAC THEN
3547 REWRITE_TAC[NOT_SUC, INV_SUC_EQ, GSYM NOT_SUC, PRE] THEN
3548 EQ_TAC THEN REPEAT STRIP_TAC THENL
3549 [FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM ACCEPT_TAC,
3550 FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC]
3551QED
3552
3553val SUC_INJ = INV_SUC_EQ;
3554
3555Theorem PRE_ELIM_THM' :
3556 P (PRE n) <=> !m. n = SUC m \/ m = 0 /\ n = 0 ==> P m
3557Proof
3558 Q.SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
3559 SIMP_TAC bool_ss [NOT_SUC, SUC_INJ, PRE]
3560QED
3561
3562(* HOL-Light compatible *)
3563Theorem PRE_ELIM_THM_EXISTS :
3564 P (PRE n) <=> (?m. (n = SUC m \/ m = 0 /\ n = 0) /\ P m)
3565Proof
3566 MP_TAC(INST [“P:num->bool” |-> “\x:num. ~P x”] PRE_ELIM_THM')
3567 >> MESON_TAC []
3568QED
3569
3570val _ = print "Additional properties of EXP\n"
3571
3572Theorem MULT_INCREASES:
3573 !m n. 1 < m /\ 0 < n ==> SUC n <= m * n
3574Proof
3575 INDUCT_TAC THENL [
3576 REWRITE_TAC [NOT_LESS_0],
3577 REWRITE_TAC [MULT, GSYM LESS_EQ] THEN REPEAT STRIP_TAC THEN
3578 ONCE_REWRITE_TAC [ADD_COMM] THEN MATCH_MP_TAC LESS_ADD_NONZERO THEN
3579 REWRITE_TAC [MULT_EQ_0] THEN STRIP_TAC THEN
3580 POP_ASSUM SUBST_ALL_TAC THEN
3581 RULE_ASSUM_TAC (REWRITE_RULE [ONE, LESS_REFL]) THEN
3582 FIRST_ASSUM ACCEPT_TAC
3583 ]
3584QED
3585
3586Theorem EXP_ALWAYS_BIG_ENOUGH:
3587 !b. 1 < b ==> !n. ?m. n <= b EXP m
3588Proof
3589 GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [
3590 REWRITE_TAC [ZERO_LESS_EQ],
3591 POP_ASSUM STRIP_ASSUME_TAC THEN
3592 Q.ASM_CASES_TAC `SUC n <= b EXP m` THENL [
3593 mesonLib.ASM_MESON_TAC [],
3594 SUBGOAL_THEN “n = b EXP m” STRIP_ASSUME_TAC THENL [
3595 POP_ASSUM (MP_TAC o REWRITE_RULE [GSYM LESS_EQ]) THEN
3596 POP_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE [LESS_OR_EQ]) THEN
3597 ASM_REWRITE_TAC [],
3598 ALL_TAC
3599 ] THEN
3600 Q.EXISTS_TAC `SUC m` THEN REWRITE_TAC [EXP] THEN
3601 POP_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC MULT_INCREASES THEN
3602 ASM_REWRITE_TAC [] THEN
3603 STRIP_ALL_THEN SUBST_ALL_TAC (Q.SPEC `b` num_CASES) THENL [
3604 IMP_RES_TAC NOT_LESS_0,
3605 REWRITE_TAC [GSYM NOT_ZERO_LT_ZERO, NOT_EXP_0]
3606 ]
3607 ]
3608 ]
3609QED
3610
3611Theorem EXP_EQ_0[simp]:
3612 !n m. (n EXP m = 0) <=> (n = 0) /\ (0 < m)
3613Proof
3614 REPEAT GEN_TAC THEN STRUCT_CASES_TAC (Q.SPEC `m` num_CASES) THEN
3615 REWRITE_TAC [EXP, GSYM NOT_ZERO_LT_ZERO, ONE, NOT_SUC, MULT_EQ_0] THEN
3616 EQ_TAC THEN STRIP_TAC THENL [
3617 STRIP_ALL_THEN SUBST_ALL_TAC (Q.SPEC `n` num_CASES) THEN
3618 REWRITE_TAC [] THEN IMP_RES_TAC NOT_EXP_0,
3619 ASM_REWRITE_TAC []
3620 ]
3621QED
3622
3623Theorem EXP_LT_1[simp] =
3624 REWRITE_CONV [LT1_EQ0, EXP_EQ_0] “m EXP n < 1”
3625
3626Theorem ZERO_LT_EXP[simp]:
3627 0 < x EXP y <=> 0 < x \/ (y = 0)
3628Proof METIS_TAC [NOT_ZERO_LT_ZERO, EXP_EQ_0]
3629QED
3630
3631(* Theorem: m <> 0 ==> m ** n <> 0 *)
3632(* Proof: by EXP_EQ_0 *)
3633Theorem EXP_NONZERO:
3634 !m n. m <> 0 ==> m ** n <> 0
3635Proof
3636 metis_tac[EXP_EQ_0]
3637QED
3638
3639(* Theorem: 0 < m ==> 0 < m ** n *)
3640(* Proof: by EXP_NONZERO *)
3641Theorem EXP_POS:
3642 !m n. 0 < m ==> 0 < m ** n
3643Proof
3644 rw[EXP_NONZERO]
3645QED
3646
3647Theorem ONE_LE_EXP[simp]:
3648 1 <= x EXP y <=> 0 < x \/ y = 0
3649Proof
3650 REWRITE_TAC[LESS_EQ_IFF_LESS_SUC, ONE, LESS_MONO_EQ, ZERO_LT_EXP]
3651QED
3652
3653(* Theorem: n ** 0 = 1 *)
3654(* Proof: by EXP *)
3655Theorem EXP_0:
3656 !n. n ** 0 = 1
3657Proof
3658 rw_tac std_ss[EXP]
3659QED
3660
3661Theorem EXP_1[simp]:
3662 !n. (1 EXP n = 1) /\ (n EXP 1 = n)
3663Proof
3664 CONV_TAC (QUANT_CONV (FORK_CONV (ALL_CONV, REWRITE_CONV [ONE]))) THEN
3665 REWRITE_TAC [EXP, MULT_CLAUSES] THEN
3666 INDUCT_TAC THEN ASM_REWRITE_TAC [MULT_EQ_1, EXP]
3667QED
3668
3669Theorem EXP_LE_1[simp]:
3670 x ** y <= 1n ⇔ x <= 1 ∨ y = 0
3671Proof
3672 REWRITE_TAC[LE_LT, EXP_LT_1] >>
3673 Cases_on ‘y = 0’ >> simp[] >>
3674 Cases_on ‘x = 0’ >> simp[]
3675 >- simp[GSYM NOT_ZERO] >>
3676 Cases_on ‘y’ >> gvs[EXP, MULT_EQ_1] >>
3677 simp[EQ_IMP_THM, EXP_1]
3678QED
3679
3680(* Theorem: n ** 2 = n * n *)
3681(* Proof:
3682 n ** 2 = n * (n ** 1) = n * (n * (n ** 0)) = n * (n * 1) = n * n
3683 or n ** 2 = n * (n ** 1) = n * n by EXP_1: !n. (1 ** n = 1) /\ (n ** 1 = n)
3684*)
3685Theorem EXP_2:
3686 !n. n ** 2 = n * n
3687Proof
3688 metis_tac[EXP, TWO, EXP_1]
3689QED
3690
3691Theorem EXP_EQ_1[simp]:
3692 !n m. (n EXP m = 1) <=> (n = 1) \/ (m = 0)
3693Proof
3694 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [
3695 POP_ASSUM MP_TAC THEN Q.ID_SPEC_TAC `m` THEN INDUCT_TAC THEN
3696 REWRITE_TAC [EXP, MULT_EQ_1] THEN STRIP_TAC THEN
3697 ASM_REWRITE_TAC [],
3698 ASM_REWRITE_TAC [EXP_1],
3699 ASM_REWRITE_TAC [EXP]
3700 ]
3701QED
3702
3703Theorem EXP_EQ_BASE[simp]:
3704 !n m. n EXP m = n <=> m = 1 \/ n = 0 /\ 0 < m \/ n = 1
3705Proof
3706 Cases_on ‘m’ >>
3707 REWRITE_TAC[EXP, ONE, SUC_NOT, LESS_REFL, INV_SUC_EQ, LESS_0, MULT_EQ_ID] >| [
3708 GEN_TAC >> EQ_TAC >> DISCH_THEN (ACCEPT_TAC o SYM),
3709 REWRITE_TAC [GSYM ONE, EXP_EQ_1] THEN GEN_TAC THEN EQ_TAC THEN
3710 STRIP_TAC THEN ASM_REWRITE_TAC[]
3711 ]
3712QED
3713
3714(* theorems about exponentiation where the base is held constant *)
3715Theorem expbase_le_mono[local]:
3716 1 < b /\ m <= n ==> b ** m <= b ** n
3717Proof
3718 STRIP_TAC THEN
3719 Q.SUBGOAL_THEN `?q. n = m + q` STRIP_ASSUME_TAC THEN1
3720 METIS_TAC [LESS_EQUAL_ADD] THEN
3721 SRW_TAC [][EXP_ADD] THEN
3722 SRW_TAC [][Once (GSYM MULT_RIGHT_1), SimpLHS] THEN
3723 ASM_REWRITE_TAC [LE_MULT_LCANCEL, EXP_EQ_0, ONE, GSYM LESS_EQ,
3724 ZERO_LT_EXP] THEN
3725 METIS_TAC [ONE, LESS_TRANS, LESS_0]
3726QED
3727
3728Theorem expbase_lt_mono[local]:
3729 1 < b /\ m < n ==> b ** m < b ** n
3730Proof
3731 STRIP_TAC THEN
3732 Q.SUBGOAL_THEN `?q. n = m + q` STRIP_ASSUME_TAC THEN1
3733 METIS_TAC [LESS_ADD, ADD_COMM] THEN
3734 SRW_TAC [][EXP_ADD] THEN
3735 SRW_TAC [][Once (GSYM MULT_RIGHT_1), SimpLHS] THEN
3736 ASM_REWRITE_TAC [LT_MULT_LCANCEL, ZERO_LT_EXP] THEN
3737 Q.SUBGOAL_THEN `0 < b` ASSUME_TAC
3738 THEN1 METIS_TAC [ONE, LESS_TRANS, LESS_0] THEN
3739 Q.SUBGOAL_THEN `1 < b ** q \/ b ** q < 1 \/ (b ** q = 1)` STRIP_ASSUME_TAC
3740 THEN1 METIS_TAC [LESS_CASES, LESS_OR_EQ] THEN
3741 ASM_REWRITE_TAC [] THENL [
3742 Q.SUBGOAL_THEN `b ** q = 0` ASSUME_TAC THEN1
3743 METIS_TAC [LESS_MONO_EQ, NOT_LESS_0, num_CASES, ONE] THEN
3744 FULL_SIMP_TAC (srw_ss()) [EXP_EQ_0, NOT_LESS_0],
3745 FULL_SIMP_TAC (srw_ss()) [EXP_EQ_1] THEN
3746 FULL_SIMP_TAC (srw_ss()) [LESS_REFL, ADD_CLAUSES]
3747 ]
3748QED
3749
3750Theorem EXP_BASE_LE_MONO:
3751 !b. 1 < b ==> !n m. b ** m <= b ** n <=> m <= n
3752Proof METIS_TAC [expbase_lt_mono, expbase_le_mono, NOT_LESS_EQUAL]
3753QED
3754Theorem EXP_BASE_LT_MONO:
3755 !b. 1 < b ==> !n m. b ** m < b ** n <=> m < n
3756Proof METIS_TAC [expbase_lt_mono, expbase_le_mono, NOT_LESS]
3757QED
3758
3759Theorem EXP_BASE_INJECTIVE:
3760 !b. 1 < b ==> !n m. (b EXP n = b EXP m) = (n = m)
3761Proof
3762 METIS_TAC [LESS_EQUAL_ANTISYM, LESS_EQ_REFL, EXP_BASE_LE_MONO]
3763QED
3764
3765Theorem EXP_BASE_LEQ_MONO_IMP:
3766 !n m b. 0 < b /\ m <= n ==> b ** m <= b ** n
3767Proof
3768 REPEAT STRIP_TAC THEN
3769 IMP_RES_TAC LESS_EQUAL_ADD THEN ASM_REWRITE_TAC [EXP_ADD] THEN
3770 SRW_TAC [][Once (GSYM MULT_RIGHT_1), SimpLHS] THEN
3771 ASM_REWRITE_TAC [LE_MULT_LCANCEL, EXP_EQ_0, ONE, GSYM LESS_EQ] THEN
3772 FULL_SIMP_TAC bool_ss [GSYM NOT_ZERO_LT_ZERO, EXP_EQ_0]
3773QED
3774
3775(* |- m <= n ==> SUC b ** m <= SUC b ** n *)
3776Theorem EXP_BASE_LEQ_MONO_SUC_IMP =
3777 (REWRITE_RULE [LESS_0] o Q.INST [`b` |-> `SUC b`] o SPEC_ALL)
3778 EXP_BASE_LEQ_MONO_IMP;
3779
3780Theorem EXP_BASE_LE_IFF:
3781 b ** m <= b ** n <=>
3782 (b = 0) /\ (n = 0) \/ (b = 0) /\ 0 < m \/ (b = 1) \/ 1 < b /\ m <= n
3783Proof
3784 Q.SPEC_THEN `b` STRUCT_CASES_TAC num_CASES THEN
3785 ASM_REWRITE_TAC [NOT_SUC, NOT_LESS_0] THENL [
3786 Q.SPEC_THEN `m` STRUCT_CASES_TAC num_CASES THEN
3787 ASM_REWRITE_TAC [LESS_REFL, EXP, ONE, SUC_NOT] THENL [
3788 Q.SPEC_THEN `n` STRUCT_CASES_TAC num_CASES THEN
3789 ASM_REWRITE_TAC [NOT_SUC, EXP, ONE, LESS_EQ_REFL, MULT_CLAUSES,
3790 NOT_SUC_LESS_EQ_0],
3791 ASM_REWRITE_TAC [LESS_0, MULT_CLAUSES, ZERO_LESS_EQ]
3792 ],
3793 EQ_TAC THENL [
3794 ASM_CASES_TAC “1 < SUC n'” THEN SRW_TAC [][EXP_BASE_LE_MONO] THEN
3795 FULL_SIMP_TAC (srw_ss()) [ONE, LESS_MONO_EQ, INV_SUC_EQ,
3796 GSYM NOT_ZERO_LT_ZERO],
3797 STRIP_TAC THEN ASM_REWRITE_TAC [EXP_1, LESS_EQ_REFL] THEN
3798 MATCH_MP_TAC EXP_BASE_LEQ_MONO_IMP THEN ASM_REWRITE_TAC [LESS_0]
3799 ]
3800 ]
3801QED
3802
3803Theorem X_LE_X_EXP:
3804 0 < n ==> x <= x ** n
3805Proof
3806 Q.SPEC_THEN `n` STRUCT_CASES_TAC num_CASES THEN
3807 REWRITE_TAC [EXP, LESS_REFL, LESS_0] THEN
3808 Q.SPEC_THEN `x` STRUCT_CASES_TAC num_CASES THEN
3809 REWRITE_TAC [ZERO_LESS_EQ, LE_MULT_CANCEL_LBARE, NOT_SUC, ZERO_LT_EXP,
3810 LESS_0]
3811QED
3812
3813Theorem X_LE_X_SQUARED[simp]:
3814 x <= x ** 2
3815Proof
3816 irule X_LE_X_EXP >> REWRITE_TAC[TWO, prim_recTheory.LESS_0]
3817QED
3818
3819Theorem X_LT_X_SQUARED[simp]:
3820 x < x ** 2 <=> 1 < x
3821Proof
3822 REWRITE_TAC[EXP,TWO,EXP_1,LT_MULT_CANCEL_LBARE] >> EQ_TAC >> STRIP_TAC >>
3823 ASM_REWRITE_TAC[] >> irule LESS_TRANS >> Q.EXISTS_TAC ‘1’ >>
3824 ASM_REWRITE_TAC[] >> ASM_REWRITE_TAC[ONE,LESS_0]
3825QED
3826
3827Theorem X_LT_EXP_X:
3828 1 < b ==> x < b ** x
3829Proof
3830 Q.ID_SPEC_TAC `x` THEN INDUCT_TAC THEN1
3831 SIMP_TAC bool_ss [LESS_0,EXP,ONE] THEN
3832 STRIP_TAC THEN
3833 FULL_SIMP_TAC bool_ss [] THEN
3834 Cases_on `x = 0` THEN1
3835 ASM_SIMP_TAC bool_ss [EXP,MULT_RIGHT_1,SYM ONE] THEN
3836 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN
3837 EXISTS_TAC “x + x” THEN
3838 CONJ_TAC THEN1 (
3839 SIMP_TAC bool_ss [ADD1,ADD_MONO_LESS_EQ] THEN
3840 SIMP_TAC bool_ss [ONE] THEN
3841 MATCH_MP_TAC LESS_OR THEN
3842 PROVE_TAC [NOT_ZERO_LT_ZERO] ) THEN
3843 SIMP_TAC bool_ss [EXP] THEN
3844 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN
3845 EXISTS_TAC “b * x” THEN
3846 CONJ_TAC THEN1 (
3847 SIMP_TAC bool_ss [GSYM TIMES2] THEN
3848 MATCH_MP_TAC LESS_MONO_MULT THEN
3849 SIMP_TAC bool_ss [TWO] THEN
3850 MATCH_MP_TAC LESS_OR THEN
3851 FIRST_ASSUM ACCEPT_TAC ) THEN
3852 SIMP_TAC bool_ss [LT_MULT_LCANCEL] THEN
3853 CONJ_TAC THEN1 (
3854 MATCH_MP_TAC LESS_TRANS THEN
3855 EXISTS_TAC “1” THEN
3856 ASM_SIMP_TAC bool_ss [ONE,prim_recTheory.LESS_0_0] ) THEN
3857 FIRST_ASSUM ACCEPT_TAC
3858QED
3859
3860local fun Cases_on q = Q.SPEC_THEN q STRUCT_CASES_TAC num_CASES in
3861
3862Theorem ZERO_EXP:
3863 0 ** x = if x = 0 then 1 else 0
3864Proof
3865 Cases_on `x` THEN
3866 SIMP_TAC bool_ss [EXP,numTheory.NOT_SUC,MULT]
3867QED
3868
3869Theorem X_LT_EXP_X_IFF:
3870 x < b ** x <=> 1 < b \/ (x = 0)
3871Proof
3872 EQ_TAC THEN1 (
3873 Cases_on `b` THEN1 (
3874 Cases_on `x` THEN
3875 SIMP_TAC bool_ss [ZERO_EXP,SUC_NOT,NOT_LESS_0] ) THEN
3876 Q.MATCH_RENAME_TAC `x < SUC b ** x ==> 1 < SUC b \/ (x = 0)` THEN
3877 Cases_on `b` THEN1 (
3878 SIMP_TAC bool_ss [EXP_1,SYM ONE] THEN
3879 SIMP_TAC bool_ss [ONE,LESS_THM,NOT_LESS_0] ) THEN
3880 SIMP_TAC bool_ss [LESS_MONO_EQ,ONE,LESS_0] ) THEN
3881 STRIP_TAC THEN1 (
3882 POP_ASSUM MP_TAC THEN ACCEPT_TAC X_LT_EXP_X) THEN
3883 ASM_SIMP_TAC bool_ss [EXP,ONE,LESS_0]
3884QED
3885 end
3886
3887(* theorems about exponentiation where the exponent is held constant *)
3888Theorem LT_MULT_IMP[local]:
3889 a < b /\ x < y ==> a * x < b * y
3890Proof
3891 STRIP_TAC THEN
3892 Q.SUBGOAL_THEN `0 < y` ASSUME_TAC THEN1 METIS_TAC [NOT_ZERO_LT_ZERO,
3893 NOT_LESS_0] THEN
3894 METIS_TAC [LE_MULT_LCANCEL, LT_MULT_RCANCEL, LESS_EQ_LESS_TRANS,
3895 LESS_OR_EQ]
3896QED
3897Theorem LE_MULT_IMP[local]:
3898 a <= b /\ x <= y ==> a * x <= b * y
3899Proof
3900 METIS_TAC [LE_MULT_LCANCEL, LE_MULT_RCANCEL, LESS_EQ_TRANS]
3901QED
3902
3903Theorem EXP_LT_MONO_0[local]:
3904 !n. 0 < n ==> !a b. a < b ==> a EXP n < b EXP n
3905Proof
3906 INDUCT_TAC THEN SRW_TAC [][NOT_LESS_0, LESS_0, EXP] THEN
3907 Q.SPEC_THEN `n` STRIP_ASSUME_TAC num_CASES THEN
3908 FULL_SIMP_TAC (srw_ss()) [EXP, MULT_CLAUSES, LESS_0] THEN
3909 SRW_TAC [][LT_MULT_IMP]
3910QED
3911
3912Theorem EXP_LE_MONO_0[local]:
3913 !n. 0 < n ==> !a b. a <= b ==> a EXP n <= b EXP n
3914Proof
3915 INDUCT_TAC THEN SRW_TAC [][EXP, LESS_EQ_REFL] THEN
3916 Q.SPEC_THEN `n` STRIP_ASSUME_TAC num_CASES THEN
3917 FULL_SIMP_TAC (srw_ss()) [EXP, MULT_CLAUSES, LESS_0] THEN
3918 SRW_TAC [][LE_MULT_IMP]
3919QED
3920
3921Theorem EXP_EXP_LT_MONO:
3922 !a b. a EXP n < b EXP n <=> a < b /\ 0 < n
3923Proof
3924 METIS_TAC [EXP_LT_MONO_0, NOT_LESS, EXP_LE_MONO_0, EXP, LESS_REFL,
3925 NOT_ZERO_LT_ZERO]
3926QED
3927
3928Theorem EXP_EXP_LE_MONO:
3929 !a b. a EXP n <= b EXP n <=> a <= b \/ (n = 0)
3930Proof
3931 METIS_TAC [EXP_LE_MONO_0, NOT_LESS_EQUAL, EXP_LT_MONO_0, EXP, LESS_EQ_REFL,
3932 NOT_ZERO_LT_ZERO]
3933QED
3934
3935Theorem EXP_EXP_INJECTIVE:
3936 !b1 b2 x. (b1 EXP x = b2 EXP x) <=> (x = 0) \/ (b1 = b2)
3937Proof
3938 METIS_TAC [EXP_EXP_LE_MONO, LESS_EQUAL_ANTISYM, LESS_EQ_REFL]
3939QED
3940
3941Theorem EXP_SUB:
3942 !p q n. 0 < n /\ q <= p ==> (n ** (p - q) = n ** p DIV n ** q)
3943Proof
3944 REPEAT STRIP_TAC THEN
3945 “0 < n ** p /\ 0 < n ** q” via
3946 (STRIP_ASSUME_TAC (Q.SPEC`n` num_CASES) THEN
3947 RW_TAC bool_ss [] THEN
3948 FULL_SIMP_TAC bool_ss [ZERO_LESS_EXP,LESS_REFL]) THEN
3949 RW_TAC bool_ss [DIV_P] THEN
3950 Q.EXISTS_TAC `0` THEN
3951 RW_TAC bool_ss [GSYM EXP_ADD,ADD_CLAUSES] THEN
3952 METIS_TAC [SUB_ADD]
3953QED
3954
3955Theorem EXP_SUB_NUMERAL[simp]:
3956 0 < n ==>
3957 (n ** (NUMERAL (BIT1 x)) DIV n = n ** (NUMERAL (BIT1 x) - 1)) /\
3958 (n ** (NUMERAL (BIT2 x)) DIV n = n ** (NUMERAL (BIT1 x)))
3959Proof
3960 REPEAT STRIP_TAC THENL [
3961 Q.SPECL_THEN [`NUMERAL (BIT1 x)`, `1`, `n`] (MP_TAC o GSYM) EXP_SUB THEN
3962 REWRITE_TAC [EXP_1] THEN DISCH_THEN MATCH_MP_TAC THEN
3963 ASM_REWRITE_TAC [NUMERAL_DEF, BIT1, ALT_ZERO, ADD_CLAUSES,
3964 LESS_EQ_MONO, ZERO_LESS_EQ],
3965 Q.SPECL_THEN [`NUMERAL (BIT2 x)`, `1`, `n`] (MP_TAC o GSYM) EXP_SUB THEN
3966 REWRITE_TAC [EXP_1] THEN
3967 Q.SUBGOAL_THEN `NUMERAL (BIT2 x) - 1 = NUMERAL (BIT1 x)` SUBST1_TAC THENL[
3968 REWRITE_TAC [NUMERAL_DEF, BIT1, BIT2, ALT_ZERO, ADD_CLAUSES,
3969 SUB_MONO_EQ, SUB_0],
3970 ALL_TAC
3971 ] THEN DISCH_THEN MATCH_MP_TAC THEN
3972 ASM_REWRITE_TAC [NUMERAL_DEF, BIT2, BIT1, ALT_ZERO, ADD_CLAUSES,
3973 LESS_EQ_MONO, ZERO_LESS_EQ]
3974 ]
3975QED
3976
3977Theorem EXP_BASE_MULT:
3978 !z x y. (x * y) ** z = (x ** z) * (y ** z)
3979Proof
3980 INDUCT_TAC THEN
3981 ASM_SIMP_TAC bool_ss [EXP, MULT_CLAUSES, AC MULT_ASSOC MULT_COMM]
3982QED
3983
3984Theorem EXP_EXP_MULT:
3985 !z x y. x ** (y * z) = (x ** y) ** z
3986Proof
3987 INDUCT_TAC THEN ASM_REWRITE_TAC [EXP, MULT_CLAUSES, EXP_1, EXP_ADD]
3988QED
3989
3990Theorem SUM_SQUARED:
3991 (x + y) ** 2 = x ** 2 + 2 * x * y + y ** 2
3992Proof
3993 REWRITE_TAC[EXP,TWO,ONE,MULT_CLAUSES, ADD_CLAUSES, RIGHT_ADD_DISTRIB,
3994 LEFT_ADD_DISTRIB] >>
3995 SIMP_TAC bool_ss [AC ADD_COMM ADD_ASSOC, AC MULT_COMM MULT_ASSOC]
3996QED
3997
3998(* ********************************************************************** *)
3999(* Maximum and minimum *)
4000(* ********************************************************************** *)
4001
4002val _ = print "Minimums and maximums\n"
4003
4004val MAX_DEF = new_definition("MAX_DEF", “MAX m n = if m < n then n else m”);
4005val MIN_DEF = new_definition("MIN_DEF", “MIN m n = if m < n then m else n”);
4006
4007val MAX = MAX_DEF;
4008val MIN = MIN_DEF;
4009
4010(* Alternative definitions of MAX and MIN using ‘<=’ instead of ‘<’ *)
4011Theorem MIN_ALT :
4012 !m n. MIN m n = if m <= n then m else n
4013Proof
4014 rw [LESS_OR_EQ, MIN_DEF] >> fs []
4015QED
4016
4017Theorem MAX_ALT :
4018 !m n. MAX m n = if m <= n then n else m
4019Proof
4020 rw [LESS_OR_EQ, MAX_DEF] >> fs []
4021QED
4022
4023val ARW = RW_TAC bool_ss
4024
4025Theorem MAX_COMM:
4026 !m n. MAX m n = MAX n m
4027Proof
4028 ARW [MAX] THEN FULL_SIMP_TAC bool_ss [NOT_LESS] THEN
4029 IMP_RES_TAC LESS_ANTISYM THEN IMP_RES_TAC LESS_EQUAL_ANTISYM
4030QED
4031
4032Theorem MIN_COMM:
4033 !m n. MIN m n = MIN n m
4034Proof
4035 ARW [MIN] THEN FULL_SIMP_TAC bool_ss [NOT_LESS] THEN
4036 IMP_RES_TAC LESS_ANTISYM THEN IMP_RES_TAC LESS_EQUAL_ANTISYM
4037QED
4038
4039Theorem MAX_ASSOC:
4040 !m n p. MAX m (MAX n p) = MAX (MAX m n) p
4041Proof
4042 SIMP_TAC bool_ss [MAX] THEN
4043 PROVE_TAC [NOT_LESS, LESS_EQ_TRANS, LESS_TRANS]
4044QED
4045
4046Theorem MIN_ASSOC:
4047 !m n p. MIN m (MIN n p) = MIN (MIN m n) p
4048Proof
4049 SIMP_TAC bool_ss [MIN] THEN
4050 PROVE_TAC [NOT_LESS, LESS_EQ_TRANS, LESS_TRANS]
4051QED
4052
4053Theorem MIN_MAX_EQ:
4054 !m n. (MIN m n = MAX m n) = (m = n)
4055Proof
4056 SIMP_TAC bool_ss [MAX, MIN] THEN
4057 PROVE_TAC [NOT_LESS, LESS_EQUAL_ANTISYM, LESS_ANTISYM]
4058QED
4059
4060Theorem MIN_MAX_LT:
4061 !m n. (MIN m n < MAX m n) = ~(m = n)
4062Proof
4063 SIMP_TAC bool_ss [MAX, MIN] THEN
4064 PROVE_TAC [LESS_REFL, NOT_LESS, LESS_OR_EQ]
4065QED
4066
4067Theorem MIN_MAX_LE:
4068 !m n. MIN m n <= MAX m n
4069Proof
4070 SIMP_TAC bool_ss [MAX, MIN] THEN
4071 PROVE_TAC [LESS_OR_EQ, NOT_LESS]
4072QED
4073
4074Theorem MIN_MAX_PRED:
4075 !P m n. P m /\ P n ==> P (MIN m n) /\ P (MAX m n)
4076Proof
4077 PROVE_TAC [MIN, MAX]
4078QED
4079
4080Theorem MIN_LT:
4081 !n m p. (MIN m n < p <=> m < p \/ n < p) /\
4082 (p < MIN m n <=> p < m /\ p < n)
4083Proof
4084 SIMP_TAC bool_ss [MIN] THEN
4085 PROVE_TAC [NOT_LESS, LESS_OR_EQ, LESS_ANTISYM, LESS_TRANS]
4086QED
4087
4088Theorem MAX_LT:
4089 !n m p. (p < MAX m n <=> p < m \/ p < n) /\
4090 (MAX m n < p <=> m < p /\ n < p)
4091Proof
4092 SIMP_TAC bool_ss [MAX] THEN
4093 PROVE_TAC [NOT_LESS, LESS_OR_EQ, LESS_ANTISYM, LESS_TRANS]
4094QED
4095
4096Theorem MIN_LE:
4097 !n m p. (MIN m n <= p <=> m <= p \/ n <= p) /\
4098 (p <= MIN m n <=> p <= m /\ p <= n)
4099Proof SIMP_TAC bool_ss [MIN] THEN PROVE_TAC [LESS_OR_EQ, NOT_LESS, LESS_TRANS]
4100QED
4101
4102Theorem MAX_LE:
4103 !n m p. (p <= MAX m n <=> p <= m \/ p <= n) /\
4104 (MAX m n <= p <=> m <= p /\ n <= p)
4105Proof
4106 SIMP_TAC bool_ss [MAX] THEN
4107 PROVE_TAC [LESS_OR_EQ, NOT_LESS, LESS_TRANS]
4108QED
4109
4110Theorem MIN_EQ_LE:
4111 (a <= b ==> MIN a b = a) /\
4112 (b <= a ==> MIN a b = b)
4113Proof
4114 simp [MIN_DEF]
4115 >> rpt strip_tac
4116 >- fs [LESS_OR_EQ]
4117 >- (`~(a < b)` by simp [NOT_LT] >> simp [])
4118QED
4119
4120Theorem MAX_EQ_GE:
4121 (b <= a ==> MAX a b = a) /\
4122 (a <= b ==> MAX a b = b)
4123Proof
4124 simp [MAX_DEF]
4125 >> rpt strip_tac
4126 >- (`~(a < b)` by simp [NOT_LT, LT_IMP_LE] >> simp [])
4127 >- fs [LESS_OR_EQ]
4128QED
4129
4130Theorem MIN_0:
4131 !n. (MIN n 0 = 0) /\ (MIN 0 n = 0)
4132Proof
4133 REWRITE_TAC [MIN] THEN
4134 PROVE_TAC [NOT_LESS_0, NOT_LESS, LESS_OR_EQ]
4135QED
4136
4137Theorem MAX_0:
4138 !n. (MAX n 0 = n) /\ (MAX 0 n = n)
4139Proof
4140 REWRITE_TAC [MAX] THEN
4141 PROVE_TAC [NOT_LESS_0, NOT_LESS, LESS_OR_EQ]
4142QED
4143
4144Theorem MAX_EQ_0[simp]:
4145 (MAX m n = 0) <=> (m = 0) /\ (n = 0)
4146Proof
4147 SRW_TAC[][MAX,EQ_IMP_THM] THEN
4148 FULL_SIMP_TAC (srw_ss()) [NOT_LESS_0, NOT_LESS]
4149QED
4150
4151Theorem MIN_EQ_0[simp]:
4152 (MIN m n = 0) <=> (m = 0) \/ (n = 0)
4153Proof
4154 SRW_TAC[][MIN,EQ_IMP_THM] THEN
4155 FULL_SIMP_TAC (srw_ss()) [NOT_LESS_0, NOT_LESS]
4156QED
4157
4158Theorem MIN_IDEM:
4159 !n. MIN n n = n
4160Proof
4161 PROVE_TAC [MIN]
4162QED
4163
4164Theorem MAX_IDEM:
4165 !n. MAX n n = n
4166Proof
4167 PROVE_TAC [MAX]
4168QED
4169
4170(* Theorem: (MAX n m = n) \/ (MAX n m = m) *)
4171(* Proof: by MAX_DEF *)
4172Theorem MAX_CASES:
4173 !m n. (MAX n m = n) \/ (MAX n m = m)
4174Proof
4175 rw[MAX_DEF]
4176QED
4177
4178(* Theorem: (MIN n m = n) \/ (MIN n m = m) *)
4179(* Proof: by MIN_DEF *)
4180Theorem MIN_CASES:
4181 !m n. (MIN n m = n) \/ (MIN n m = m)
4182Proof
4183 rw[MIN_DEF]
4184QED
4185
4186Theorem EXISTS_GREATEST:
4187 !P. (?x. P x) /\ (?x:num. !y. y > x ==> ~P y) <=>
4188 ?x. P x /\ !y. y > x ==> ~P y
4189Proof
4190 GEN_TAC THEN EQ_TAC THENL
4191 [REWRITE_TAC[GREATER_DEF] THEN
4192 DISCH_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
4193 SUBGOAL_THEN
4194 (“(?x. !y. x < y ==> ~P y) = (?x. (\x. !y. x < y ==> ~P y) x)”)
4195 SUBST1_TAC THENL
4196 [BETA_TAC THEN REFL_TAC,
4197 DISCH_THEN (MP_TAC o MATCH_MP WOP)
4198 THEN BETA_TAC THEN CONV_TAC (DEPTH_CONV NOT_FORALL_CONV)
4199 THEN STRIP_TAC THEN EXISTS_TAC (“n:num”) THEN ASM_REWRITE_TAC[]
4200 THEN NTAC 2 (POP_ASSUM MP_TAC)
4201 THEN STRUCT_CASES_TAC (SPEC (“n:num”) num_CASES)
4202 THEN REPEAT STRIP_TAC THENL
4203 [UNDISCH_THEN (“!y. 0 < y ==> ~P y”)
4204 (MP_TAC o CONV_RULE (ONCE_DEPTH_CONV CONTRAPOS_CONV))
4205 THEN REWRITE_TAC[] THEN STRIP_TAC THEN RES_TAC
4206 THEN MP_TAC (SPEC (“x:num”) LESS_0_CASES)
4207 THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST_ALL_TAC o SYM)
4208 THEN ASM_REWRITE_TAC[],
4209 POP_ASSUM (MP_TAC o SPEC (“n':num”))
4210 THEN REWRITE_TAC [prim_recTheory.LESS_SUC_REFL]
4211 THEN DISCH_THEN (CHOOSE_THEN MP_TAC)
4212 THEN SUBGOAL_THEN (“!x y. ~(x ==> ~y) <=> x /\ y”)
4213 (fn th => REWRITE_TAC[th] THEN STRIP_TAC) THENL
4214 [REWRITE_TAC [NOT_IMP],
4215 UNDISCH_THEN (“!y. SUC n' < y ==> ~P y”)
4216 (MP_TAC o CONV_RULE (ONCE_DEPTH_CONV CONTRAPOS_CONV)
4217 o SPEC (“y:num”))
4218 THEN ASM_REWRITE_TAC[NOT_LESS,LESS_OR_EQ]
4219 THEN DISCH_THEN (DISJ_CASES_THEN2 ASSUME_TAC SUBST_ALL_TAC)
4220 THENL [IMP_RES_TAC LESS_LESS_SUC, ASM_REWRITE_TAC[]]]]],
4221 REPEAT STRIP_TAC THEN EXISTS_TAC (“x:num”) THEN ASM_REWRITE_TAC[]]
4222QED
4223
4224Theorem EXISTS_NUM:
4225 !P. (?n. P n) <=> P 0 \/ (?m. P (SUC m))
4226Proof
4227 PROVE_TAC [num_CASES]
4228QED
4229
4230Theorem FORALL_NUM:
4231 !P. (!n. P n) <=> P 0 /\ !n. P (SUC n)
4232Proof
4233 PROVE_TAC [num_CASES]
4234QED
4235
4236Theorem BOUNDED_FORALL_THM:
4237 !c. 0<c ==> ((!n. n < c ==> P n) <=> P (c-1) /\ !n. n < (c-1) ==> P n)
4238Proof
4239 RW_TAC boolSimps.bool_ss [] THEN EQ_TAC THENL
4240 [REPEAT STRIP_TAC
4241 THEN FIRST_ASSUM MATCH_MP_TAC THENL
4242 [METIS_TAC [ONE,LESS_ADD_SUC,ADD_SYM,SUB_RIGHT_LESS],
4243 MATCH_MP_TAC LESS_LESS_EQ_TRANS
4244 THEN Q.EXISTS_TAC `c-1`
4245 THEN ASM_REWRITE_TAC [SUB_LESS_EQ,SUB_LEFT_LESS]],
4246 METIS_TAC [SUB_LESS_OR,LESS_OR_EQ]]
4247QED
4248
4249Theorem BOUNDED_EXISTS_THM:
4250 !c. 0<c ==> ((?n. n < c /\ P n) <=> P (c-1) \/ ?n. n < (c-1) /\ P n)
4251Proof
4252 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL
4253 [METIS_TAC [SUB_LESS_OR,LESS_REFL,LESS_EQ_LESS_TRANS,LESS_LESS_CASES],
4254 METIS_TAC [num_CASES,LESS_REFL,SUC_SUB1,LESS_SUC_REFL],
4255 METIS_TAC [SUB_LEFT_LESS,ADD1,SUC_LESS]]
4256QED
4257
4258(*---------------------------------------------------------------------------*)
4259(* Theorems about sequences *)
4260(*---------------------------------------------------------------------------*)
4261
4262Theorem transitive_monotone:
4263 !R f. transitive R /\ (!n. R (f n) (f (SUC n))) ==>
4264 !m n. m < n ==> R (f m) (f n)
4265Proof
4266 NTAC 3 STRIP_TAC THEN INDUCT_TAC THEN
4267 (INDUCT_TAC THEN1 REWRITE_TAC [NOT_LESS_0])
4268 THEN1 (
4269 POP_ASSUM MP_TAC THEN
4270 Q.SPEC_THEN `n` STRUCT_CASES_TAC num_CASES THEN
4271 METIS_TAC [LESS_0,relationTheory.transitive_def]) THEN
4272 METIS_TAC [LESS_THM,relationTheory.transitive_def]
4273QED
4274
4275Theorem STRICTLY_INCREASING_TC =
4276 (* !f. (!n. f n < f (SUC n)) ==> !m n. m < n ==> f m < f n *)
4277 transitive_monotone |> Q.ISPEC `$<` |>
4278 SIMP_RULE bool_ss [
4279 Q.prove(`transitive $<`,
4280 METIS_TAC [relationTheory.transitive_def,LESS_TRANS])]
4281
4282Theorem STRICTLY_INCREASING_ONE_ONE:
4283 !f. (!n. f n < f (SUC n)) ==> ONE_ONE f
4284Proof
4285 REWRITE_TAC [ONE_ONE_THM] THEN
4286 METIS_TAC [STRICTLY_INCREASING_TC,NOT_LESS,LESS_OR_EQ,LESS_EQUAL_ANTISYM]
4287QED
4288
4289Theorem ONE_ONE_INV_IMAGE_BOUNDED:
4290 ONE_ONE (f:num->num) ==> !b. ?a. !x. f x <= b ==> x <= a
4291Proof
4292 REWRITE_TAC [ONE_ONE_THM] THEN DISCH_TAC THEN INDUCT_TAC
4293 THENL [
4294 (* case b of 0 *)
4295 REWRITE_TAC [LESS_EQ_0] THEN Q.ASM_CASES_TAC `?z. f z = 0`
4296 THENL [
4297 POP_ASSUM CHOOSE_TAC THEN
4298 Q.EXISTS_TAC `z` THEN REPEAT STRIP_TAC THEN
4299 VALIDATE (FIRST_X_ASSUM
4300 (ASSUME_TAC o UNDISCH o Q.SPECL [`x`, `z`])) THEN
4301 ASM_REWRITE_TAC [LESS_EQ_REFL],
4302 Q.EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN RES_TAC],
4303
4304 (* case b of SUC b *)
4305 POP_ASSUM CHOOSE_TAC THEN REWRITE_TAC [LE] THEN
4306 Q.ASM_CASES_TAC `?z. f z = SUC b`
4307 THENL [
4308 POP_ASSUM CHOOSE_TAC THEN
4309 Q.EXISTS_TAC `MAX a z` THEN
4310 REWRITE_TAC [MAX_LE] THEN REPEAT STRIP_TAC
4311 THENL [
4312 VALIDATE (FIRST_X_ASSUM
4313 (ASSUME_TAC o UNDISCH o Q.SPECL [`x`, `z`])) THEN
4314 ASM_REWRITE_TAC [LESS_EQ_REFL],
4315 RES_TAC THEN ASM_REWRITE_TAC []],
4316 Q.EXISTS_TAC `a` THEN REPEAT STRIP_TAC THEN RES_TAC] ]
4317QED
4318
4319Theorem ONE_ONE_UNBOUNDED:
4320 !f. ONE_ONE (f:num->num) ==> !b.?n. b < f n
4321Proof
4322 REPEAT STRIP_TAC THEN
4323 POP_ASSUM (CHOOSE_TAC o Q.SPEC `b` o
4324 MATCH_MP ONE_ONE_INV_IMAGE_BOUNDED) THEN
4325 Q.EXISTS_TAC `SUC a` THEN
4326 REWRITE_TAC [GSYM NOT_LESS_EQUAL] THEN
4327 DISCH_TAC THEN RES_TAC THEN
4328 POP_ASSUM (ACCEPT_TAC o REWRITE_RULE [GSYM LESS_EQ, LESS_REFL])
4329QED
4330
4331Theorem STRICTLY_INCREASING_UNBOUNDED:
4332 !f. (!n. f n < f (SUC n)) ==> !b.?n. b < f n
4333Proof
4334 METIS_TAC [STRICTLY_INCREASING_ONE_ONE,ONE_ONE_UNBOUNDED]
4335QED
4336
4337Theorem STRICTLY_DECREASING_TC[local]:
4338 !f. (!n. f (SUC n) < f n) ==> !m n. m < n ==> f n < f m
4339Proof
4340 NTAC 2 STRIP_TAC THEN
4341 (transitive_monotone |> Q.ISPECL [`\x y. y < x`,`f:num->num`] |>
4342 SIMP_RULE bool_ss [] |> MATCH_MP_TAC) THEN
4343 SRW_TAC [][relationTheory.transitive_def] THEN
4344 METIS_TAC [LESS_TRANS]
4345QED
4346
4347Theorem STRICTLY_DECREASING_ONE_ONE[local]:
4348 !f. (!n. f (SUC n) < f n) ==> ONE_ONE f
4349Proof
4350 SRW_TAC [] [ONE_ONE_THM] THEN
4351 METIS_TAC [STRICTLY_DECREASING_TC,NOT_LESS,LESS_OR_EQ,LESS_EQUAL_ANTISYM]
4352QED
4353
4354Theorem NOT_STRICTLY_DECREASING:
4355 !f. ~(!n. f (SUC n) < f n)
4356Proof
4357 NTAC 2 STRIP_TAC THEN
4358 IMP_RES_TAC STRICTLY_DECREASING_TC THEN
4359 IMP_RES_TAC STRICTLY_DECREASING_ONE_ONE THEN
4360 IMP_RES_TAC ONE_ONE_UNBOUNDED THEN
4361 POP_ASSUM (Q.SPEC_THEN `f 0` STRIP_ASSUME_TAC) THEN
4362 Q.SPEC_THEN `n` STRIP_ASSUME_TAC num_CASES THEN1
4363 METIS_TAC [LESS_NOT_EQ] THEN
4364 METIS_TAC [LESS_ANTISYM,LESS_0]
4365QED
4366
4367(* Absolute difference *)
4368val ABS_DIFF_def = new_definition ("ABS_DIFF_def",
4369 “ABS_DIFF n m = if n < m then m - n else n - m”)
4370
4371Theorem ABS_DIFF_SYM:
4372 !n m. ABS_DIFF n m = ABS_DIFF m n
4373Proof
4374 SRW_TAC [][ABS_DIFF_def] THEN
4375 METIS_TAC [LESS_ANTISYM,NOT_LESS,LESS_OR_EQ]
4376QED
4377
4378Theorem ABS_DIFF_COMM = ABS_DIFF_SYM
4379
4380Theorem ABS_DIFF_EQS[simp]:
4381 !n. ABS_DIFF n n = 0
4382Proof
4383 SRW_TAC [][ABS_DIFF_def,SUB_EQUAL_0]
4384QED
4385
4386Theorem ABS_DIFF_EQ_0:
4387 !n m. (ABS_DIFF n m = 0) <=> (n = m)
4388Proof
4389 SRW_TAC [][ABS_DIFF_def,LESS_OR_EQ,SUB_EQ_0] THEN
4390 METIS_TAC [LESS_ANTISYM]
4391QED
4392
4393Theorem ABS_DIFF_ZERO[simp]:
4394 !n. (ABS_DIFF n 0 = n) /\ (ABS_DIFF 0 n = n)
4395Proof
4396 SRW_TAC [][ABS_DIFF_def,SUB_0] THEN
4397 METIS_TAC [NOT_LESS_0,NOT_ZERO_LT_ZERO]
4398QED
4399
4400Theorem ABS_DIFF_SUC:
4401 !n m. (ABS_DIFF (SUC n) (SUC m)) = (ABS_DIFF n m)
4402Proof
4403 REWRITE_TAC [ABS_DIFF_def, LESS_MONO_EQ, SUB_MONO_EQ]
4404QED
4405
4406fun owr commth = CONV_RULE (ONCE_DEPTH_CONV (REWR_CONV commth)) ;
4407
4408val LESS_EQ_TRANS' = REWRITE_RULE [GSYM AND_IMP_INTRO] LESS_EQ_TRANS ;
4409val AND_IMP_INTRO' = owr CONJ_COMM AND_IMP_INTRO ;
4410val LESS_EQ_TRANS'' = REWRITE_RULE [GSYM AND_IMP_INTRO'] LESS_EQ_TRANS ;
4411val LESS_EQ_ADD' = owr ADD_COMM LESS_EQ_ADD ;
4412val LESS_EQ_SUC_REFL' = SPEC_ALL LESS_EQ_SUC_REFL ;
4413
4414val leq_ss = MATCH_MP (MATCH_MP LESS_EQ_TRANS'' LESS_EQ_SUC_REFL')
4415 LESS_EQ_SUC_REFL' ;
4416
4417val imp_leq_ss = MATCH_MP LESS_EQ_TRANS'' leq_ss ;
4418
4419Theorem ABS_DIFF_SUC_LE:
4420 !x z. ABS_DIFF x (SUC z) <= SUC (ABS_DIFF x z)
4421Proof
4422 REPEAT INDUCT_TAC THEN
4423 ASM_REWRITE_TAC [ABS_DIFF_ZERO, ABS_DIFF_SUC, ADD, ADD_0, GSYM ADD_SUC,
4424 LESS_EQ_REFL, LESS_EQ_MONO, ZERO_LESS_EQ, leq_ss]
4425QED
4426
4427Theorem ABS_DIFF_PLUS_LE:
4428 !x z y. ABS_DIFF x (y + z) <= y + (ABS_DIFF x z)
4429Proof
4430 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC
4431 THEN REWRITE_TAC [ADD, LESS_EQ_REFL]
4432 THEN MATCH_MP_TAC (MATCH_MP LESS_EQ_TRANS' (SPEC_ALL ABS_DIFF_SUC_LE))
4433 THEN ASM_REWRITE_TAC [LESS_EQ_MONO]
4434QED
4435
4436val ABS_DIFF_PLUS_LE' = owr ADD_COMM ABS_DIFF_PLUS_LE ;
4437val [ADT_splemx, ADT_splemx'] =
4438 map (owr ABS_DIFF_COMM) [ABS_DIFF_PLUS_LE, ABS_DIFF_PLUS_LE'] ;
4439
4440Theorem ABS_DIFF_LE_SUM:
4441 ABS_DIFF x z <= x + z
4442Proof
4443 REWRITE_TAC [ABS_DIFF_def] THEN COND_CASES_TAC
4444 THEN MATCH_MP_TAC (MATCH_MP LESS_EQ_TRANS' (SPEC_ALL SUB_LESS_EQ))
4445 THEN REWRITE_TAC [LESS_EQ_ADD, LESS_EQ_ADD']
4446QED
4447
4448val ABS_DIFF_LE_SUM' = owr ADD_COMM ABS_DIFF_LE_SUM ;
4449
4450val [ADT_sslem, ADT_sslem'] = map (MATCH_MP imp_leq_ss)
4451 [ABS_DIFF_LE_SUM, ABS_DIFF_LE_SUM'] ;
4452
4453Theorem ABS_DIFF_TRIANGLE_lem:
4454 !x y. x <= ABS_DIFF x y + y
4455Proof
4456 REPEAT INDUCT_TAC THEN
4457 ASM_REWRITE_TAC [ABS_DIFF_ZERO, ABS_DIFF_SUC, ADD, ADD_0, GSYM ADD_SUC,
4458 LESS_EQ_REFL, LESS_EQ_MONO, ZERO_LESS_EQ]
4459QED
4460
4461val ABS_DIFF_TRIANGLE_lem' =
4462 owr ABS_DIFF_COMM (owr ADD_COMM ABS_DIFF_TRIANGLE_lem) ;
4463
4464Theorem ABS_DIFF_TRIANGLE:
4465 !x y z. ABS_DIFF x z <= ABS_DIFF x y + ABS_DIFF y z
4466Proof
4467 REPEAT INDUCT_TAC THEN
4468 ASM_REWRITE_TAC [ABS_DIFF_ZERO, ABS_DIFF_SUC, ADD, ADD_0, GSYM ADD_SUC,
4469 LESS_EQ_REFL, LESS_EQ_MONO, ZERO_LESS_EQ,
4470 ABS_DIFF_TRIANGLE_lem, ABS_DIFF_TRIANGLE_lem', ADT_sslem]
4471QED
4472
4473Theorem ABS_DIFF_ADD_SAME:
4474 !n m p. ABS_DIFF (n + p) (m + p) = ABS_DIFF n m
4475Proof
4476 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC
4477 THEN ASM_REWRITE_TAC [ADD_0, GSYM ADD_SUC, ABS_DIFF_SUC]
4478QED
4479
4480Theorem LE_SUB_RCANCEL:
4481 !m n p. n - m <= p - m <=> n <= m \/ n <= p
4482Proof
4483 REPEAT INDUCT_TAC THEN
4484 ASM_REWRITE_TAC [ LESS_EQ_REFL, LESS_EQ_MONO, ZERO_LESS_EQ,
4485 NOT_SUC_LESS_EQ_0, SUB_MONO_EQ, SUB_0, SUB_EQ_0, LESS_EQ_0]
4486QED
4487
4488Theorem LT_SUB_RCANCEL:
4489 !m n p. n - m < p - m <=> n < p /\ m < p
4490Proof
4491 REPEAT GEN_TAC THEN
4492 REWRITE_TAC [GSYM NOT_LESS_EQUAL, LE_SUB_RCANCEL, DE_MORGAN_THM] THEN
4493 MATCH_ACCEPT_TAC CONJ_COMM
4494QED
4495
4496Theorem LE_SUB_LCANCEL:
4497 !z y x. x - y <= x - z <=> z <= y \/ x <= y
4498Proof
4499 REPEAT INDUCT_TAC THEN
4500 ASM_REWRITE_TAC [ SUB_MONO_EQ, LESS_EQ_MONO, LESS_EQ_REFL,
4501 SUB_0, NOT_SUC_LESS_EQ_0, ZERO_LESS_EQ,
4502 NOT_SUC_LESS_EQ, SUB_LESS_EQ, SUB_LE_SUC]
4503QED
4504
4505Theorem LT_SUB_LCANCEL:
4506 !z y x. x - y < x - z <=> z < y /\ z < x
4507Proof
4508 REWRITE_TAC [GSYM NOT_LESS_EQUAL, LE_SUB_LCANCEL, DE_MORGAN_THM]
4509QED
4510
4511Theorem ABS_DIFF_SUMS:
4512 !n1 n2 m1 m2. ABS_DIFF (n1 + n2) (m1 + m2) <= ABS_DIFF n1 m1 + ABS_DIFF n2 m2
4513Proof
4514 REPEAT INDUCT_TAC THEN
4515 ASM_REWRITE_TAC [ABS_DIFF_ZERO, ABS_DIFF_SUC, ADD, ADD_0, GSYM ADD_SUC,
4516 LESS_EQ_REFL, LESS_EQ_MONO, ZERO_LESS_EQ, ADT_sslem', ADT_sslem]
4517 THENL [
4518 REWRITE_TAC [GSYM (CONJUNCT2 ADD), ABS_DIFF_PLUS_LE],
4519 REWRITE_TAC [ADD_SUC, ABS_DIFF_PLUS_LE'],
4520 REWRITE_TAC [GSYM (CONJUNCT2 ADD), ADT_splemx],
4521 REWRITE_TAC [ADD_SUC, ADT_splemx'] ]
4522QED
4523
4524Theorem SUC_MINUS_NUMERAL:
4525 SUC n - NUMERAL (BIT1 m) = n - (NUMERAL (BIT1 m) - 1) ∧
4526 SUC n - NUMERAL (BIT2 m) = n - NUMERAL (BIT1 m)
4527Proof
4528 REWRITE_TAC [NUMERAL_DEF] >> ONCE_REWRITE_TAC[BIT1, BIT2] >>
4529 REWRITE_TAC[ALT_ZERO, ADD_CLAUSES, SUB_MONO_EQ, SUB_0]
4530QED
4531
4532(* ********************************************************************** *)
4533val _ = print "Miscellaneous theorems\n"
4534(* ********************************************************************** *)
4535
4536Theorem FUNPOW_SUC:
4537 !f n x. FUNPOW f (SUC n) x = f (FUNPOW f n x)
4538Proof
4539 GEN_TAC
4540 THEN INDUCT_TAC
4541 THENL [REWRITE_TAC [FUNPOW],
4542 ONCE_REWRITE_TAC [FUNPOW]
4543 THEN ASM_REWRITE_TAC []]
4544QED
4545
4546Theorem FUNPOW_0[simp]:
4547 FUNPOW f 0 x = x
4548Proof
4549 REWRITE_TAC [FUNPOW]
4550QED
4551
4552Theorem FUNPOW_ADD:
4553 !m n. FUNPOW f (m + n) x = FUNPOW f m (FUNPOW f n x)
4554Proof
4555 INDUCT_TAC THENL [
4556 REWRITE_TAC [ADD_CLAUSES, FUNPOW],
4557 ASM_REWRITE_TAC [ADD_CLAUSES,FUNPOW_SUC]
4558 ]
4559QED
4560
4561Theorem FUNPOW_1[simp]:
4562 FUNPOW f 1 x = f x
4563Proof
4564 REWRITE_TAC [FUNPOW, ONE]
4565QED
4566
4567(* Theorem: FUNPOW f 2 x = f (f x) *)
4568(* Proof: by definition. *)
4569Theorem FUNPOW_2:
4570 !f x. FUNPOW f 2 x = f (f x)
4571Proof
4572 simp_tac bool_ss [FUNPOW, TWO, ONE]
4573QED
4574
4575(* Theorem: FUNPOW (K c) n x = if n = 0 then x else c *)
4576(* Proof:
4577 By induction on n.
4578 Base: !x c. FUNPOW (K c) 0 x = if 0 = 0 then x else c
4579 FUNPOW (K c) 0 x
4580 = x by FUNPOW
4581 = if 0 = 0 then x else c by 0 = 0 is true
4582 Step: !x c. FUNPOW (K c) n x = if n = 0 then x else c ==>
4583 !x c. FUNPOW (K c) (SUC n) x = if SUC n = 0 then x else c
4584 FUNPOW (K c) (SUC n) x
4585 = FUNPOW (K c) n ((K c) x) by FUNPOW
4586 = if n = 0 then ((K c) c) else c by induction hypothesis
4587 = if n = 0 then c else c by K_THM
4588 = c by either case
4589 = if SUC n = 0 then x else c by SUC n = 0 is false
4590*)
4591Theorem FUNPOW_K:
4592 !n x c. FUNPOW (K c) n x = if n = 0 then x else c
4593Proof
4594 Induct >-
4595 rw[] >>
4596 metis_tac[FUNPOW, combinTheory.K_THM, SUC_NOT_ZERO]
4597QED
4598
4599Theorem FUNPOW_CONG:
4600 !n x f g.
4601 (!m. m < n ==> f (FUNPOW f m x) = g (FUNPOW f m x))
4602 ==>
4603 FUNPOW f n x = FUNPOW g n x
4604Proof
4605 INDUCT_TAC \\ SRW_TAC[][FUNPOW_SUC]
4606 THEN METIS_TAC[LESS_SUC, LESS_SUC_REFL]
4607QED
4608
4609Theorem FUNPOW_invariant:
4610 !m x.
4611 P x /\ (!x. P x ==> P (f x)) ==>
4612 P (FUNPOW f m x)
4613Proof
4614 Induct \\ SRW_TAC[][FUNPOW_SUC]
4615QED
4616
4617Theorem FUNPOW_invariant_index:
4618 !m x.
4619 P x /\
4620 (!n. n < m ==> R (FUNPOW f n x)) /\
4621 (!x. P x /\ R x ==> P (f x)) ==>
4622 P (FUNPOW f m x)
4623Proof
4624 Induct >> SRW_TAC[][FUNPOW_SUC]
4625 \\ first_assum irule
4626 \\ `m < SUC m` by SRW_TAC[][LESS_SUC_REFL]
4627 \\ SRW_TAC[][]
4628 \\ first_assum irule \\ SRW_TAC[][]
4629 \\ first_assum irule \\ SRW_TAC[][LESS_SUC]
4630QED
4631
4632(* Theorem: FUNPOW f m (FUNPOW f n x) = FUNPOW f n (FUNPOW f m x) *)
4633(* Proof: by FUNPOW_ADD, ADD_COMM *)
4634Theorem FUNPOW_COMM:
4635 !f m n x. FUNPOW f m (FUNPOW f n x) = FUNPOW f n (FUNPOW f m x)
4636Proof
4637 metis_tac[FUNPOW_ADD, ADD_COMM]
4638QED
4639
4640Theorem NRC_0[simp] = CONJUNCT1 NRC;
4641
4642Theorem NRC_1[simp]:
4643 NRC R 1 x y = R x y
4644Proof
4645 SRW_TAC [][ONE, NRC]
4646QED
4647
4648Theorem NRC_ADD_I:
4649 !m n x y z. NRC R m x y /\ NRC R n y z ==> NRC R (m + n) x z
4650Proof
4651 INDUCT_TAC THEN SRW_TAC [][NRC, ADD] THEN METIS_TAC []
4652QED
4653
4654Theorem NRC_ADD_E:
4655 !m n x z. NRC R (m + n) x z ==> ?y. NRC R m x y /\ NRC R n y z
4656Proof
4657 INDUCT_TAC THEN SRW_TAC [][NRC, ADD] THEN METIS_TAC []
4658QED
4659
4660Theorem NRC_ADD_EQN:
4661 NRC R (m + n) x z = ?y. NRC R m x y /\ NRC R n y z
4662Proof
4663 METIS_TAC [NRC_ADD_I, NRC_ADD_E]
4664QED
4665
4666Theorem NRC_SUC_RECURSE_LEFT:
4667 NRC R (SUC n) x y = ?z. NRC R n x z /\ R z y
4668Proof
4669 METIS_TAC [NRC_1, NRC_ADD_EQN, ADD1]
4670QED
4671
4672Theorem NRC_RTC:
4673 !n x y. NRC R n x y ==> RTC R x y
4674Proof
4675 INDUCT_TAC THEN SRW_TAC [][NRC, relationTheory.RTC_RULES] THEN
4676 METIS_TAC [relationTheory.RTC_RULES]
4677QED
4678
4679Theorem RTC_NRC:
4680 !x y. RTC R x y ==> ?n. NRC R n x y
4681Proof
4682 HO_MATCH_MP_TAC relationTheory.RTC_INDUCT THEN
4683 PROVE_TAC [NRC] (* METIS_TAC bombs *)
4684QED
4685
4686Theorem RTC_eq_NRC:
4687 !R x y. RTC R x y = ?n. NRC R n x y
4688Proof
4689 PROVE_TAC[RTC_NRC, NRC_RTC]
4690QED
4691
4692Theorem TC_eq_NRC:
4693 !R x y. TC R x y = ?n. NRC R (SUC n) x y
4694Proof
4695 REWRITE_TAC [relationTheory.EXTEND_RTC_TC_EQN, RTC_eq_NRC, NRC] THEN
4696 PROVE_TAC[]
4697QED
4698
4699Theorem LESS_EQUAL_DIFF:
4700 !m n : num. m <= n ==> ?k. m = n - k
4701Proof
4702 REPEAT GEN_TAC
4703 THEN SPEC_TAC (“m:num”, “m:num”)
4704 THEN SPEC_TAC (“n:num”, “n:num”)
4705 THEN INDUCT_TAC
4706 THENL [REWRITE_TAC [LESS_EQ_0, SUB_0],
4707 REWRITE_TAC [LE]
4708 THEN PROVE_TAC [SUB_0, SUB_MONO_EQ]]
4709QED
4710
4711Theorem MOD_2:
4712 !n. n MOD 2 = if EVEN n then 0 else 1
4713Proof
4714 GEN_TAC
4715 THEN MATCH_MP_TAC MOD_UNIQUE
4716 THEN ASM_CASES_TAC “EVEN n”
4717 THEN POP_ASSUM MP_TAC
4718 THEN REWRITE_TAC [EVEN_EXISTS, GSYM ODD_EVEN, ODD_EXISTS, ADD1]
4719 THEN STRIP_TAC
4720 THEN POP_ASSUM SUBST1_TAC
4721 THEN Q.EXISTS_TAC `m`
4722 THENL [PROVE_TAC [MULT_COMM, ADD_0, TWO, prim_recTheory.LESS_0],
4723 (KNOW_TAC “(?m' : num. 2 * m + 1 = 2 * m') = F”
4724 THEN1 PROVE_TAC [EVEN_EXISTS, ODD_EXISTS, ADD1, EVEN_ODD])
4725 THEN DISCH_THEN (fn th => REWRITE_TAC [th])
4726 THEN PROVE_TAC [MULT_COMM, ONE, TWO, prim_recTheory.LESS_0,
4727 LESS_MONO_EQ]]
4728QED
4729
4730Theorem EVEN_MOD2:
4731 !x. EVEN x = (x MOD 2 = 0)
4732Proof
4733 PROVE_TAC [MOD_2, SUC_NOT, ONE]
4734QED
4735
4736val GSYM_MOD_PLUS' = GSYM (SPEC_ALL (UNDISCH_ALL (SPEC_ALL MOD_PLUS))) ;
4737val MOD_LESS' = UNDISCH (Q.SPECL [`a`, `n`] MOD_LESS) ;
4738
4739Theorem SUC_MOD_lem[local]:
4740 0 < n ==> (SUC a MOD n = if SUC (a MOD n) = n then 0 else SUC (a MOD n))
4741Proof
4742 DISCH_TAC THEN REWRITE_TAC [SUC_ONE_ADD] THEN
4743 CONV_TAC (LHS_CONV (REWR_CONV_A GSYM_MOD_PLUS')) THEN
4744 MP_TAC (Q.SPECL [`n`, `1`] LESS_LESS_CASES) THEN STRIP_TAC
4745 THENL [ ASM_REWRITE_TAC [MOD_1, ADD_0],
4746 RULE_ASSUM_TAC (REWRITE_RULE
4747 [GSYM LESS_EQ_IFF_LESS_SUC, ONE, LESS_EQ_0]) THEN
4748 FULL_SIMP_TAC bool_ss [NOT_LESS_0],
4749 IMP_RES_TAC LESS_MOD THEN ASM_REWRITE_TAC [] THEN
4750 COND_CASES_TAC THEN1 ASM_SIMP_TAC bool_ss [DIVMOD_ID] THEN
4751 irule LESS_MOD THEN ASSUME_TAC MOD_LESS' THEN
4752 RULE_ASSUM_TAC (REWRITE_RULE [GSYM SUC_ONE_ADD, Once LESS_EQ,
4753 Once LESS_OR_EQ]) THEN
4754 REWRITE_TAC [GSYM SUC_ONE_ADD] THEN
4755 FIRST_X_ASSUM DISJ_CASES_TAC THEN
4756 FULL_SIMP_TAC bool_ss [NOT_LESS_0] ]
4757QED
4758
4759Theorem SUC_MOD:
4760 !n a b. 0 < n ==> ((SUC a MOD n = SUC b MOD n) = (a MOD n = b MOD n))
4761Proof
4762 ASM_SIMP_TAC bool_ss [SUC_MOD_lem] THEN
4763 REPEAT STRIP_TAC THEN
4764 REVERSE EQ_TAC THEN1 SIMP_TAC bool_ss [] THEN
4765 REPEAT COND_CASES_TAC THEN
4766 REWRITE_TAC [numTheory.NOT_SUC, SUC_NOT, INV_SUC_EQ] THEN
4767 ASM_REWRITE_TAC [Once (GSYM INV_SUC_EQ)]
4768QED
4769
4770Theorem ADD_MOD:
4771 !n a b p. (0 < n:num) ==>
4772 (((a + p) MOD n = (b + p) MOD n) =
4773 (a MOD n = b MOD n))
4774Proof
4775GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN HO_MATCH_MP_TAC INDUCTION
4776 THEN SIMP_TAC bool_ss [ADD_CLAUSES, SUC_MOD]
4777QED
4778
4779(*---------------------------------------------------------------------------*)
4780(* We should be able to use "by" construct at this phase of development, *)
4781(* surely? *)
4782(*---------------------------------------------------------------------------*)
4783
4784Theorem MOD_ELIM:
4785 !P x n. 0 < n /\ P x /\ (!y. P (y + n) ==> P y) ==> P (x MOD n)
4786Proof
4787 GEN_TAC THEN HO_MATCH_MP_TAC COMPLETE_INDUCTION
4788 THEN REPEAT STRIP_TAC
4789 THEN ASM_CASES_TAC (“x >= n”) THENL
4790 [“P ((x - n) MOD n):bool” via
4791 (Q.PAT_ASSUM `!x'. A x' ==> !n. Q x' n` (MP_TAC o Q.SPEC `x-n`) THEN
4792 “x-n < x” via FULL_SIMP_TAC bool_ss
4793 [GREATER_OR_EQ,SUB_RIGHT_LESS,GREATER_DEF] THEN
4794 METIS_TAC [NOT_ZERO_LT_ZERO,ADD_SYM,LESS_ADD_NONZERO,LESS_TRANS,
4795 SUB_ADD,GREATER_OR_EQ,GREATER_DEF,LESS_OR_EQ,SUB_RIGHT_LESS])
4796 THEN “?z. x = z + n” via (Q.EXISTS_TAC `x - n` THEN
4797 METIS_TAC [SUB_ADD,GREATER_OR_EQ,GREATER_DEF,LESS_OR_EQ])
4798 THEN RW_TAC bool_ss []
4799 THEN METIS_TAC [SUB_ADD,GREATER_OR_EQ,GREATER_DEF,LESS_OR_EQ,ADD_MODULUS],
4800 METIS_TAC [LESS_MOD,NOT_LESS,LESS_OR_EQ,GREATER_OR_EQ, GREATER_DEF]]
4801QED
4802
4803Theorem DOUBLE_LT[simp]:
4804 !p q. 2 * p + 1 < 2 * q <=> p < q
4805Proof
4806 ‘!p q. 2 * p + 1 < 2 * q <=> 2 * p < 2 * q’
4807 suffices_by (STRIP_TAC THEN ASM_REWRITE_TAC[LT_MULT_LCANCEL, TWO, LESS_0])
4808 THEN REPEAT GEN_TAC
4809 THEN EQ_TAC THEN1 PROVE_TAC [ADD1, prim_recTheory.SUC_LESS]
4810 THEN STRIP_TAC
4811 THEN SIMP_TAC boolSimps.bool_ss [GSYM ADD1]
4812 THEN MATCH_MP_TAC LESS_NOT_SUC
4813 THEN ASM_REWRITE_TAC []
4814 THEN PROVE_TAC [EVEN_ODD, EVEN_DOUBLE, ODD_DOUBLE]
4815QED
4816
4817Theorem EXP2_LT[simp]:
4818 !m n. n DIV 2 < 2 ** m <=> n < 2 ** SUC m
4819Proof
4820 REPEAT GEN_TAC
4821 THEN MP_TAC (Q.SPEC `2` DIVISION)
4822 THEN (KNOW_TAC “0n < 2” THEN1 REWRITE_TAC [TWO, prim_recTheory.LESS_0])
4823 THEN SIMP_TAC boolSimps.bool_ss []
4824 THEN STRIP_TAC
4825 THEN DISCH_THEN (MP_TAC o Q.SPEC `n`)
4826 THEN DISCH_THEN (fn th => CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [th])))
4827 THEN ONCE_REWRITE_TAC [MULT_COMM]
4828 THEN SIMP_TAC boolSimps.bool_ss [EXP, MOD_2]
4829 THEN (ASM_CASES_TAC “EVEN n” THEN ASM_SIMP_TAC boolSimps.bool_ss [])
4830 THENL [REWRITE_TAC [TWO, ADD_0, LESS_MULT_MONO],
4831 REWRITE_TAC [DOUBLE_LT]
4832 THEN REWRITE_TAC [TWO, ADD_0, LESS_MULT_MONO]]
4833QED
4834
4835Theorem SUB_LESS:
4836 !m n. 0 < n /\ n <= m ==> m-n < m
4837Proof
4838 REPEAT STRIP_TAC THEN
4839 “?p. m = p+n” via METIS_TAC [LESS_EQ_EXISTS,ADD_SYM]
4840 THEN RW_TAC bool_ss [ADD_SUB]
4841 THEN METIS_TAC [LESS_ADD_NONZERO,NOT_ZERO_LT_ZERO]
4842QED
4843
4844Theorem SUB_MOD:
4845 !m n. 0<n /\ n <= m ==> ((m-n) MOD n = m MOD n)
4846Proof
4847 METIS_TAC [ADD_MODULUS,ADD_SUB,LESS_EQ_EXISTS,ADD_SYM]
4848QED
4849
4850Theorem ONE_LT_MULT_IMP:
4851 !p q. 1 < p /\ 0 < q ==> 1 < p * q
4852Proof
4853 REPEAT Cases THEN
4854 RW_TAC bool_ss [MULT_CLAUSES,ADD_CLAUSES] THENL
4855 [METIS_TAC [LESS_REFL],
4856 POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN
4857 RW_TAC bool_ss [ONE,LESS_MONO_EQ] THEN
4858 METIS_TAC [LESS_IMP_LESS_ADD, ADD_ASSOC]]
4859QED
4860
4861Theorem ONE_LT_MULT:
4862 !x y. 1 < x * y <=> 0 < x /\ 1 < y \/ 0 < y /\ 1 < x
4863Proof
4864 REWRITE_TAC [ONE] THEN INDUCT_TAC THEN
4865 RW_TAC bool_ss [ADD_CLAUSES, MULT_CLAUSES,LESS_REFL,LESS_0] THENL
4866 [METIS_TAC [NOT_SUC_LESS_EQ_0,LESS_OR_EQ],
4867 Cases_on ‘y’ THEN
4868 RW_TAC bool_ss [MULT_CLAUSES,ADD_CLAUSES,LESS_REFL,
4869 LESS_MONO_EQ,ZERO_LESS_ADD,LESS_0] THEN
4870 METIS_TAC [ZERO_LESS_MULT]]
4871QED
4872
4873Theorem ONE_LT_EXP[simp]:
4874 !x y. 1 < x ** y <=> 1 < x /\ 0 < y
4875Proof
4876 GEN_TAC THEN INDUCT_TAC THEN
4877 RW_TAC bool_ss [EXP,ONE_LT_MULT,LESS_REFL,LESS_0,ZERO_LT_EXP] THEN
4878 METIS_TAC [SUC_LESS, ONE]
4879QED
4880
4881Theorem TWO_LE_EXP[simp]:
4882 !x y. 2 <= x ** y <=> 1 < x /\ 0 < y
4883Proof
4884 REWRITE_TAC[LESS_EQ_IFF_LESS_SUC, TWO, LESS_MONO_EQ, ONE_LT_EXP]
4885QED
4886
4887(*---------------------------------------------------------------------------*)
4888(* Calculating DIV and MOD by repeated subtraction. We define a *)
4889(* tail-recursive function DIVMOD by wellfounded recursion. We hand-roll the *)
4890(* definition and induction theorem, because, as of now, tfl is not *)
4891(* at this point in the build. *)
4892(*---------------------------------------------------------------------------*)
4893
4894Theorem findq_lemma[local]:
4895 ~(n = 0) /\ ~(m < 2 * n) ==> m - 2 * n < m - n
4896Proof
4897 REPEAT STRIP_TAC THEN
4898 POP_ASSUM (ASSUME_TAC o REWRITE_RULE [NOT_LESS]) THEN
4899 SRW_TAC [][SUB_LEFT_LESS, SUB_RIGHT_ADD, SUB_RIGHT_LESS, ADD_CLAUSES,
4900 SUB_LEFT_ADD]
4901 THENL [
4902 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN Q.EXISTS_TAC `n` THEN
4903 ASM_REWRITE_TAC [] THEN
4904 SIMP_TAC bool_ss [Once (GSYM MULT_LEFT_1), SimpLHS] THEN
4905 REWRITE_TAC [LT_MULT_RCANCEL] THEN
4906 REWRITE_TAC [TWO,ONE,LESS_MONO_EQ,prim_recTheory.LESS_0] THEN
4907 PROVE_TAC [NOT_ZERO_LT_ZERO],
4908
4909 Q.SUBGOAL_THEN `2 * n <= 1 * n` MP_TAC
4910 THEN1 PROVE_TAC [LESS_EQ_TRANS, MULT_LEFT_1] THEN
4911 ASM_REWRITE_TAC [LE_MULT_RCANCEL, TWO, ONE, LESS_EQ_MONO,
4912 NOT_SUC_LESS_EQ_0],
4913
4914 Q_TAC SUFF_TAC `n < 2 * n` THEN1
4915 PROVE_TAC [ADD_COMM, LT_ADD_LCANCEL] THEN
4916 Q_TAC SUFF_TAC `1 * n < 2 * n` THEN1 SRW_TAC [][MULT_CLAUSES] THEN
4917 SRW_TAC [][LT_MULT_RCANCEL] THENL [
4918 PROVE_TAC [NOT_ZERO_LT_ZERO],
4919 SRW_TAC [][ONE,TWO, LESS_MONO_EQ, prim_recTheory.LESS_0]
4920 ],
4921
4922 PROVE_TAC [NOT_LESS_EQUAL]
4923 ]
4924QED
4925
4926Theorem findq_thm = (let
4927 open pairTheory relationTheory
4928 val M = “\f (a,m,n). if n = 0 then a
4929 else let d = 2 * n
4930 in
4931 if m < d then a else f (2 * a, m, d)”
4932 val measure = “measure (\ (a:num,m:num,n:num). m - n)”
4933 val defn = new_definition("findq_def", “findq = WFREC ^measure ^M”)
4934 val th0 = MP (MATCH_MP WFREC_COROLLARY defn)
4935 (ISPEC (rand measure) prim_recTheory.WF_measure)
4936 val lemma = prove(
4937 “~(n = 0) ==> ((let d = 2 * n in if m < d then x
4938 else if m - d < m - n then f d else z) =
4939 (let d = 2 * n in if m < d then x else f d))”,
4940 LET_ELIM_TAC THEN Q.ASM_CASES_TAC `m < d` THEN ASM_REWRITE_TAC [] THEN
4941 Q.UNABBREV_TAC `d` THEN SRW_TAC [][findq_lemma])
4942in
4943 SIMP_RULE (srw_ss()) [RESTRICT_DEF, prim_recTheory.measure_thm, lemma]
4944 (Q.SPEC `(a,m,n)` th0)
4945end)
4946
4947Theorem findq_eq_0:
4948 !a m n. (findq (a, m, n) = 0) = (a = 0)
4949Proof
4950 REPEAT GEN_TAC THEN
4951 Q_TAC SUFF_TAC
4952 `!x a m n. (x = m - n) ==> ((findq (a, m, n) = 0) = (a = 0))` THEN1
4953 SRW_TAC [][] THEN
4954 HO_MATCH_MP_TAC COMPLETE_INDUCTION THEN REPEAT STRIP_TAC THEN
4955 ONCE_REWRITE_TAC [findq_thm] THEN SRW_TAC [][LET_THM] THEN
4956 RULE_ASSUM_TAC (SIMP_RULE (bool_ss ++ boolSimps.DNF_ss) []) THEN
4957 FIRST_X_ASSUM (Q.SPECL_THEN [`2 * a`, `m`, `2 * n`] MP_TAC) THEN
4958 SRW_TAC [][findq_lemma, MULT_EQ_0, TWO, ONE, NOT_SUC]
4959QED
4960
4961Theorem findq_divisor:
4962 n <= m ==> findq (a, m, n) * n <= a * m
4963Proof
4964 Q_TAC SUFF_TAC
4965 `!x a m n. (x = m - n) /\ n <= m ==>
4966 findq (a, m, n) * n <= a * m` THEN1
4967 SRW_TAC [][] THEN
4968 HO_MATCH_MP_TAC COMPLETE_INDUCTION THEN SRW_TAC [boolSimps.DNF_ss][] THEN
4969 ONCE_REWRITE_TAC [findq_thm] THEN
4970 SRW_TAC [][LET_THM, MULT_CLAUSES, ZERO_LESS_EQ, LE_MULT_LCANCEL,
4971 LESS_IMP_LESS_OR_EQ] THEN
4972 FIRST_X_ASSUM (Q.SPECL_THEN [`2 * a`, `m`, `2 * n`] MP_TAC) THEN
4973 ASM_SIMP_TAC (srw_ss())[findq_lemma, GSYM NOT_LESS] THEN
4974 Q.SUBGOAL_THEN `findq (2 * a,m,2 * n) * (2 * n) =
4975 2 * (findq (2 * a, m, 2 * n) * n)` SUBST_ALL_TAC THEN1
4976 SRW_TAC [][AC MULT_COMM MULT_ASSOC] THEN
4977 Q.SUBGOAL_THEN `2 * a * m = 2 * (a * m)` SUBST_ALL_TAC THEN1
4978 SRW_TAC [][AC MULT_COMM MULT_ASSOC] THEN
4979 SRW_TAC [][LT_MULT_LCANCEL, TWO, ONE, prim_recTheory.LESS_0]
4980QED
4981
4982Theorem divmod_lemma[local]:
4983 ~(n = 0) /\ ~(m < n) ==> m - n * findq (1, m, n) < m
4984Proof
4985 SRW_TAC [][NOT_LESS, SUB_RIGHT_LESS, NOT_ZERO_LT_ZERO] THENL [
4986 ONCE_REWRITE_TAC [ADD_COMM] THEN MATCH_MP_TAC LESS_ADD_NONZERO THEN
4987 SRW_TAC [][MULT_EQ_0, ONE, NOT_SUC, findq_eq_0] THEN
4988 SRW_TAC [][NOT_ZERO_LT_ZERO],
4989 PROVE_TAC [LESS_LESS_EQ_TRANS]
4990 ]
4991QED
4992
4993(*---------------------------------------------------------------------------*)
4994(* DIVMOD (a,m,n) = if n = 0 then (0,0) else *)
4995(* if m < n then (a, m) else *)
4996(* let q = findq (1, m, n) *)
4997(* in DIVMOD (a + q, m - n * q, n) *)
4998(*---------------------------------------------------------------------------*)
4999
5000Theorem DIVMOD_THM = (let
5001 open relationTheory pairTheory
5002 val M = “\f (a,m,n). if n = 0 then (0,0)
5003 else if m < n then (a, m)
5004 else let q = findq (1, m, n)
5005 in
5006 f (a + q, m - n * q, n)”
5007 val measure = “measure ((FST o SND) : num#num#num -> num)”
5008 val defn = new_definition("DIVMOD_DEF", “DIVMOD = WFREC ^measure ^M”)
5009 val th0 = REWRITE_RULE [prim_recTheory.WF_measure]
5010 (MATCH_MP WFREC_COROLLARY defn)
5011 val th1 = SIMP_RULE (srw_ss()) [RESTRICT_DEF, prim_recTheory.measure_thm]
5012 (Q.SPEC `(a,m,n)` th0)
5013 val lemma = prove(
5014 “~(n = 0) /\ ~(m < n) ==>
5015 ((let q = findq (1,m,n) in if m - n * q < m then f q else z) =
5016 (let q = findq (1,m,n) in f q))”,
5017 SRW_TAC [][LET_THM, divmod_lemma])
5018in
5019 SIMP_RULE (srw_ss()) [lemma] th1
5020end)
5021
5022(*---------------------------------------------------------------------------*)
5023(* Correctness of DIVMOD *)
5024(*---------------------------------------------------------------------------*)
5025
5026Theorem core_divmod_sub_lemma[local]:
5027 0 < n /\ n * q <= m ==>
5028 (m - n * q = if m < (q + 1) * n then m MOD n
5029 else m DIV n * n + m MOD n - q * n)
5030Proof
5031 REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [
5032 ASM_SIMP_TAC (srw_ss()) [SUB_RIGHT_EQ] THEN DISJ1_TAC THEN
5033 Q_TAC SUFF_TAC `m DIV n = q` THEN1 PROVE_TAC [DIVISION, MULT_COMM] THEN
5034 MATCH_MP_TAC DIV_UNIQUE THEN
5035 Q.EXISTS_TAC `m - n * q` THEN
5036 SRW_TAC [][SUB_LEFT_ADD] THENL [
5037 PROVE_TAC [LESS_EQUAL_ANTISYM, MULT_COMM],
5038 METIS_TAC [ADD_COMM, MULT_COMM, ADD_SUB],
5039 SRW_TAC [][SUB_RIGHT_LESS] THEN
5040 FULL_SIMP_TAC (srw_ss()) [RIGHT_ADD_DISTRIB, MULT_CLAUSES,
5041 AC MULT_COMM MULT_ASSOC,
5042 AC ADD_COMM ADD_ASSOC]
5043 ],
5044
5045 ASM_SIMP_TAC (srw_ss()) [GSYM DIVISION] THEN
5046 SIMP_TAC (srw_ss()) [AC MULT_COMM MULT_ASSOC]
5047 ]
5048QED
5049
5050Theorem MOD_SUB:
5051 0 < n /\ n * q <= m ==> ((m - n * q) MOD n = m MOD n)
5052Proof
5053 REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQUE THEN
5054 Q.EXISTS_TAC `m DIV n - q` THEN
5055 Q.SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THEN1 SRW_TAC [][NOT_ZERO_LT_ZERO] THEN
5056 ASM_SIMP_TAC (srw_ss()) [RIGHT_SUB_DISTRIB, DIVISION, SUB_RIGHT_ADD,
5057 LE_MULT_RCANCEL, DIV_LE_X, core_divmod_sub_lemma]
5058QED
5059
5060Theorem DIV_SUB:
5061 0 < n /\ n * q <= m ==> ((m - n * q) DIV n = m DIV n - q)
5062Proof
5063 REPEAT STRIP_TAC THEN
5064 MATCH_MP_TAC DIV_UNIQUE THEN Q.EXISTS_TAC `m MOD n` THEN
5065 Q.SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THEN1 SRW_TAC [][NOT_ZERO_LT_ZERO] THEN
5066 ASM_SIMP_TAC (srw_ss()) [DIVISION, RIGHT_SUB_DISTRIB, SUB_RIGHT_ADD,
5067 LE_MULT_RCANCEL, DIV_LE_X, core_divmod_sub_lemma]
5068QED
5069
5070Theorem DIVMOD_CORRECT:
5071 !m n a. 0<n ==> (DIVMOD (a,m,n) = (a + (m DIV n), m MOD n))
5072Proof
5073 HO_MATCH_MP_TAC COMPLETE_INDUCTION THEN
5074 SRW_TAC [DNF_ss][AND_IMP_INTRO] THEN
5075 PURE_ONCE_REWRITE_TAC [DIVMOD_THM] THEN
5076 RW_TAC bool_ss [] THENL [
5077 METIS_TAC [LESS_REFL],
5078 METIS_TAC [LESS_REFL],
5079 METIS_TAC [LESS_DIV_EQ_ZERO,ADD_CLAUSES],
5080 METIS_TAC [LESS_MOD,ADD_CLAUSES],
5081 FIRST_X_ASSUM (Q.SPECL_THEN [`m - n * q`, `n`, `a + q`] MP_TAC) THEN
5082 ASM_SIMP_TAC (srw_ss()) [SUB_RIGHT_LESS] THEN
5083 Q.SUBGOAL_THEN `m < n * q + m` ASSUME_TAC THENL [
5084 SIMP_TAC bool_ss [SimpRHS, Once ADD_COMM] THEN
5085 MATCH_MP_TAC LESS_ADD_NONZERO THEN
5086 SRW_TAC [][MULT_EQ_0, Abbr`q`, findq_eq_0, ONE, NOT_SUC],
5087 ALL_TAC
5088 ] THEN ASM_REWRITE_TAC [] THEN
5089 Q.SUBGOAL_THEN `0 < m` ASSUME_TAC THEN1
5090 PROVE_TAC [NOT_LESS, LESS_LESS_EQ_TRANS] THEN
5091 ASM_REWRITE_TAC [] THEN
5092 DISCH_THEN SUBST_ALL_TAC THEN
5093 Q.SUBGOAL_THEN `n * q <= m` ASSUME_TAC THEN1
5094 METIS_TAC [findq_divisor, NOT_LESS, MULT_LEFT_1, MULT_COMM] THEN
5095 Q.SUBGOAL_THEN `q <= m DIV n` ASSUME_TAC THEN1
5096 SRW_TAC [][X_LE_DIV, MULT_COMM] THEN
5097 SRW_TAC [][] THENL [
5098 ONCE_REWRITE_TAC [GSYM ADD_ASSOC] THEN
5099 REWRITE_TAC [EQ_ADD_LCANCEL] THEN
5100 ASM_SIMP_TAC (srw_ss()) [DIV_SUB] THEN
5101 SRW_TAC [][SUB_LEFT_ADD] THEN1 METIS_TAC [LESS_EQUAL_ANTISYM] THEN
5102 METIS_TAC [ADD_SUB, ADD_COMM],
5103 ASM_SIMP_TAC (srw_ss()) [MOD_SUB]
5104 ]
5105 ]
5106QED
5107
5108(*---------------------------------------------------------------------------*)
5109(* For calculation *)
5110(*---------------------------------------------------------------------------*)
5111
5112Theorem DIVMOD_CALC:
5113 (!m n. 0<n ==> (m DIV n = FST(DIVMOD(0, m, n)))) /\
5114 (!m n. 0<n ==> (m MOD n = SND(DIVMOD(0, m, n))))
5115Proof
5116 SRW_TAC [][DIVMOD_CORRECT,ADD_CLAUSES]
5117QED
5118
5119(* ----------------------------------------------------------------------
5120 Support for using congruential rewriting and MOD
5121 ---------------------------------------------------------------------- *)
5122
5123val MODEQ_DEF = new_definition(
5124 "MODEQ_DEF",
5125 “MODEQ n m1 m2 = ?a b. a * n + m1 = b * n + m2”);
5126
5127Theorem MODEQ_0_CONG:
5128 MODEQ 0 m1 m2 <=> (m1 = m2)
5129Proof
5130 SRW_TAC [][MODEQ_DEF, MULT_CLAUSES, ADD_CLAUSES]
5131QED
5132
5133Theorem MODEQ_NONZERO_MODEQUALITY:
5134 0 < n ==> (MODEQ n m1 m2 <=> (m1 MOD n = m2 MOD n))
5135Proof
5136 SRW_TAC [][MODEQ_DEF] THEN
5137 Q.SPEC_THEN `n` (fn th => th |> UNDISCH |> ASSUME_TAC) DIVISION THEN
5138 POP_ASSUM (fn th => Q.SPEC_THEN `m1` STRIP_ASSUME_TAC th THEN
5139 Q.SPEC_THEN `m2` STRIP_ASSUME_TAC th) THEN
5140 MAP_EVERY Q.ABBREV_TAC [`q1 = m1 DIV n`, `r1 = m1 MOD n`,
5141 `q2 = m2 DIV n`, `r2 = m2 MOD n`] THEN
5142 markerLib.RM_ALL_ABBREVS_TAC THEN SRW_TAC [][EQ_IMP_THM] THENL [
5143 `(a * n + (q1 * n + r1)) MOD n = r1`
5144 by (MATCH_MP_TAC MOD_UNIQUE THEN Q.EXISTS_TAC `a + q1` THEN
5145 SIMP_TAC (srw_ss()) [MULT_ASSOC, RIGHT_ADD_DISTRIB, ADD_ASSOC] THEN
5146 SRW_TAC [][]) THEN
5147 POP_ASSUM (SUBST1_TAC o SYM) THEN
5148 MATCH_MP_TAC MOD_UNIQUE THEN Q.EXISTS_TAC `b + q2` THEN
5149 SRW_TAC [][ADD_ASSOC, RIGHT_ADD_DISTRIB],
5150 MAP_EVERY Q.EXISTS_TAC [`q2`, `q1`] THEN
5151 SRW_TAC [][AC ADD_ASSOC ADD_COMM]
5152 ]
5153QED
5154
5155Theorem MODEQ_THM:
5156 MODEQ n m1 m2 <=> (n = 0) /\ (m1 = m2) \/ 0 < n /\ (m1 MOD n = m2 MOD n)
5157Proof
5158 METIS_TAC [MODEQ_0_CONG, MODEQ_NONZERO_MODEQUALITY, NOT_ZERO_LT_ZERO]
5159QED
5160
5161Theorem MODEQ_INTRO_CONG:
5162 0 < n ==> MODEQ n e0 e1 ==> (e0 MOD n = e1 MOD n)
5163Proof
5164 METIS_TAC [MODEQ_NONZERO_MODEQUALITY]
5165QED
5166
5167Theorem MODEQ_PLUS_CONG:
5168 MODEQ n x0 x1 ==> MODEQ n y0 y1 ==> MODEQ n (x0 + y0) (x1 + y1)
5169Proof
5170 Q.ID_SPEC_TAC `n` THEN SIMP_TAC (srw_ss() ++ DNF_ss)[MODEQ_THM, LESS_REFL] >>
5171 SRW_TAC [][Once (GSYM MOD_PLUS)] THEN SRW_TAC [][MOD_PLUS]
5172QED
5173
5174Theorem MODEQ_MULT_CONG:
5175 MODEQ n x0 x1 ==> MODEQ n y0 y1 ==> MODEQ n (x0 * y0) (x1 * y1)
5176Proof
5177 Q.ID_SPEC_TAC `n` THEN SIMP_TAC (srw_ss() ++ DNF_ss)[MODEQ_THM, LESS_REFL] >>
5178 SRW_TAC [][Once (GSYM MOD_TIMES2)] THEN SRW_TAC [][MOD_TIMES2]
5179QED
5180
5181Theorem MODEQ_REFL:
5182 !x. MODEQ n x x
5183Proof
5184 SRW_TAC [][MODEQ_THM, GSYM NOT_ZERO_LT_ZERO]
5185QED
5186
5187Theorem MODEQ_SUC_CONG:
5188 MODEQ n x y ==> MODEQ n (SUC x) (SUC y)
5189Proof
5190 SRW_TAC[][ADD1] >> irule MODEQ_PLUS_CONG >> SRW_TAC [][MODEQ_REFL]
5191QED
5192
5193Theorem MODEQ_EXP_CONG:
5194 MODEQ n x y ==> MODEQ n (x EXP e) (y EXP e)
5195Proof
5196 Q.ID_SPEC_TAC `e` >>
5197 INDUCT_TAC >> SRW_TAC[][EXP, MODEQ_REFL] >>
5198 irule MODEQ_MULT_CONG >> SRW_TAC[][]
5199QED
5200
5201(* Theorem: ((a MOD n) ** m) MOD n = (a ** m) MOD n *)
5202(* Proof: by induction on m.
5203 Base case: (a MOD n) ** 0 MOD n = a ** 0 MOD n
5204 (a MOD n) ** 0 MOD n
5205 = 1 MOD n by EXP
5206 = a ** 0 MOD n by EXP
5207 Step case:
5208 (a MOD n) ** m MOD n = a ** m MOD n ==>
5209 (a MOD n) ** SUC m MOD n = a ** SUC m MOD n
5210
5211 (a MOD n) ** SUC m MOD n
5212 = ((a MOD n) * (a MOD n) ** m) MOD n by EXP
5213 = ((a MOD n) * (((a MOD n) ** m) MOD n)) MOD n by MOD_TIMES2, MOD_MOD
5214 = ((a MOD n) * (a ** m MOD n)) MOD n by induction hypothesis
5215 = (a * a ** m) MOD n by MOD_TIMES2
5216 = a ** SUC m MOD n by EXP
5217*)
5218Theorem MOD_EXP:
5219 !n a m. ((a MOD n) ** m) MOD n = (a ** m) MOD n
5220Proof
5221 rpt strip_tac >>
5222 Cases_on `n = 0` >-
5223 fs[] >>
5224 Induct_on `m` >-
5225 rw[EXP] >>
5226 `(a MOD n) ** SUC m MOD n = ((a MOD n) * (a MOD n) ** m) MOD n` by rw[EXP] >>
5227 `_ = ((a MOD n) * (((a MOD n) ** m) MOD n)) MOD n`
5228 by metis_tac[MOD_TIMES2, MOD_MOD] >>
5229 `_ = ((a MOD n) * (a ** m MOD n)) MOD n` by rw[] >>
5230 `_ = (a * a ** m) MOD n` by rw[MOD_TIMES2] >>
5231 rw[EXP]
5232QED
5233
5234Theorem EXP_MOD:
5235 (x MOD n) ** e MOD n = x ** e MOD n
5236Proof
5237 MATCH_ACCEPT_TAC MOD_EXP
5238QED
5239
5240Theorem MODEQ_SYM:
5241 MODEQ n x y <=> MODEQ n y x
5242Proof
5243 SRW_TAC [][MODEQ_THM] THEN METIS_TAC []
5244QED
5245
5246Theorem MODEQ_TRANS:
5247 !x y z. MODEQ n x y /\ MODEQ n y z ==> MODEQ n x z
5248Proof
5249 Q.ID_SPEC_TAC `n` THEN SIMP_TAC (srw_ss() ++ DNF_ss) [MODEQ_THM, LESS_REFL]
5250QED
5251
5252Theorem MODEQ_NUMERAL:
5253 (NUMERAL n <= NUMERAL m ==>
5254 MODEQ (NUMERAL (BIT1 n)) (NUMERAL (BIT1 m))
5255 (NUMERAL (BIT1 m) MOD NUMERAL (BIT1 n))) /\
5256 (NUMERAL n <= NUMERAL m ==>
5257 MODEQ (NUMERAL (BIT1 n)) (NUMERAL (BIT2 m))
5258 (NUMERAL (BIT2 m) MOD NUMERAL (BIT1 n))) /\
5259 (NUMERAL n <= NUMERAL m ==>
5260 MODEQ (NUMERAL (BIT2 n)) (NUMERAL (BIT2 m))
5261 (NUMERAL (BIT2 m) MOD NUMERAL (BIT2 n))) /\
5262 (NUMERAL n < NUMERAL m ==>
5263 MODEQ (NUMERAL (BIT2 n)) (NUMERAL (BIT1 m))
5264 (NUMERAL (BIT1 m) MOD NUMERAL (BIT2 n)))
5265Proof
5266 SIMP_TAC (srw_ss())
5267 [MODEQ_NONZERO_MODEQUALITY, BIT1, BIT2, ADD_CLAUSES, ALT_ZERO,
5268 NUMERAL_DEF, MOD_MOD, LESS_0]
5269QED
5270
5271Theorem MODEQ_MOD:
5272 0 < n ==> MODEQ n (x MOD n) x
5273Proof
5274 SIMP_TAC (srw_ss()) [MODEQ_NONZERO_MODEQUALITY, MOD_MOD]
5275QED
5276
5277Theorem MODEQ_0:
5278 0 < n ==> MODEQ n n 0
5279Proof
5280 SIMP_TAC (srw_ss()) [MODEQ_NONZERO_MODEQUALITY, DIVMOD_ID, ZERO_MOD]
5281QED
5282
5283val modss = simpLib.add_relsimp {refl = MODEQ_REFL, trans = MODEQ_TRANS,
5284 weakenings = [MODEQ_INTRO_CONG],
5285 subsets = [],
5286 rewrs = [MODEQ_NUMERAL, MODEQ_MOD, MODEQ_0]}
5287 (srw_ss()) ++
5288 SSFRAG {dprocs = [], ac = [], rewrs = [],
5289 congs = [MODEQ_PLUS_CONG, MODEQ_MULT_CONG, MODEQ_SUC_CONG],
5290 filter = NONE, convs = [], name = NONE}
5291
5292val result1 =
5293 SIMP_CONV modss [ASSUME “0 < 6”, LESS_EQ_REFL, ASSUME “2 < 3”,
5294 DIVMOD_ID, MULT_CLAUSES, ADD_CLAUSES,
5295 ASSUME “7 MOD 6 = 1”] “(6 * x + 7 + 6 * y) MOD 6”;
5296
5297val result2 =
5298 SIMP_CONV modss
5299 [ASSUME “0 < n”, MULT_CLAUSES, ADD_CLAUSES]
5300 “(4 + 3 * n + 1) MOD n”
5301
5302
5303(* ----------------------------------------------------------------------
5304 set up characterisation as a standard algebraic type
5305 ---------------------------------------------------------------------- *)
5306
5307Theorem num_case_eq:
5308 (num_CASE n zc sc = v) <=>
5309 (n = 0) /\ (zc = v) \/ ?x. (n = SUC x) /\ (sc x = v)
5310Proof
5311 Q.SPEC_THEN ‘n’ STRUCT_CASES_TAC num_CASES THEN
5312 SRW_TAC [][num_case_def, SUC_NOT, INV_SUC_EQ]
5313QED
5314
5315val _ = TypeBase.general_update “:num” (
5316 TypeBasePure.put_size (
5317 “λx:num. x”,
5318 TypeBasePure.ORIG boolTheory.REFL_CLAUSE
5319 ) o
5320 TypeBasePure.put_destructors [cj 2 prim_recTheory.PRE] o
5321 TypeBasePure.put_lift (
5322 mk_var("numSyntax.lift_num",“:'type -> num -> 'term”)
5323 )
5324 )
5325
5326Theorem datatype_num:
5327 DATATYPE (num 0 SUC)
5328Proof
5329 REWRITE_TAC[DATATYPE_TAG_THM]
5330QED
5331
5332Theorem binary_induct:
5333 !P. P (0:num) /\ (!n. P n ==> P (2*n) /\ P (2*n+1)) ==> !n. P n
5334Proof
5335 gen_tac >> strip_tac >>
5336 ho_match_mp_tac COMPLETE_INDUCTION >> gen_tac >>
5337 Q.ASM_CASES_TAC‘n=0’ >> ASM_SIMP_TAC (srw_ss()) [] >>
5338 ‘n DIV 2 < n /\ ((n = 2 * (n DIV 2)) \/ (n = 2 * (n DIV 2) + 1))’ by (
5339 ‘0 < 2’ by SIMP_TAC (srw_ss()) [TWO, ONE, LESS_0] >>
5340 ASM_SIMP_TAC (srw_ss()) [DIV_LT_X, LT_MULT_CANCEL_LBARE] >> conj_tac
5341 >- (FULL_SIMP_TAC (srw_ss()) [NOT_ZERO_LT_ZERO] >>
5342 SIMP_TAC (srw_ss()) [TWO, ONE, LESS_MONO_EQ, LESS_0]) >>
5343 drule_then (Q.SPEC_THEN `n` strip_assume_tac) DIVISION >>
5344 Q.ABBREV_TAC ‘q = n DIV 2’ >>
5345 Q.ABBREV_TAC ‘r = n MOD 2’ >>
5346 ASM_SIMP_TAC (srw_ss()) [MULT_COMM, ADD_INV_0_EQ, EQ_ADD_LCANCEL] >>
5347 Q.SPEC_THEN ‘r’ FULL_STRUCT_CASES_TAC num_CASES >>
5348 ASM_SIMP_TAC (srw_ss()) [] >>
5349 FULL_SIMP_TAC (srw_ss()) [TWO, LESS_MONO_EQ, ONE] >>
5350 Q.RENAME_TAC [‘m < SUC 0’] >>
5351 Q.SPEC_THEN ‘m’ FULL_STRUCT_CASES_TAC num_CASES >>
5352 FULL_SIMP_TAC (srw_ss()) [LESS_MONO_EQ, NOT_LESS_0]) >>
5353 METIS_TAC[]
5354QED
5355
5356Theorem EVEN_SUB:
5357 !m n. m <= n ==> (EVEN (n - m) <=> (EVEN n <=> EVEN m))
5358Proof INDUCT_TAC >> ASM_SIMP_TAC (srw_ss()) [SUB_0, EVEN] >> GEN_TAC >>
5359 Q.RENAME_TAC [‘SUC m <= n’] >>
5360 Q.SPEC_THEN ‘n’ STRUCT_CASES_TAC num_CASES >>
5361 ASM_SIMP_TAC (srw_ss()) [NOT_SUC_LESS_EQ_0, LESS_EQ_MONO, SUB_MONO_EQ, EVEN]
5362QED
5363
5364Theorem ODD_SUB:
5365 !m n. m <= n ==> (ODD (n - m) <=> (ODD n <=/=> ODD m))
5366Proof
5367 SRW_TAC [][ODD_EVEN,EVEN_SUB]
5368QED
5369
5370(* CEILING_DIV and CEILING_MOD *)
5371Theorem CEILING_DIV_def[compute,allow_rebind] =
5372 curry new_definition "CEILING_DIV_def"
5373 “CEILING_DIV m n = (m + (n - 1)) DIV n”;
5374
5375Theorem CEILING_MOD_def[compute,allow_rebind] =
5376 curry new_definition "CEILING_MOD_def"
5377 “CEILING_MOD m n = (n - m MOD n) MOD n”
5378
5379Overload "\\\\" = “CEILING_DIV”; (* prints as \\ *)
5380Overload "%%" = “CEILING_MOD”;
5381
5382val _ = set_fixity "\\\\" (Infixl 600);
5383val _ = set_fixity "%%" (Infixl 650);
5384
5385Theorem CEILING_DIV_LE_X:
5386 !k m n. 0 < k ==> (CEILING_DIV n k <= m <=> n <= m * k)
5387Proof
5388 rewrite_tac [CEILING_DIV_def]
5389 \\ rpt strip_tac
5390 \\ imp_res_tac DIV_LE_X
5391 \\ asm_rewrite_tac [RIGHT_ADD_DISTRIB,MULT_CLAUSES,LESS_EQ]
5392 \\ Q.SPEC_THEN ‘k’ strip_assume_tac num_CASES
5393 \\ full_simp_tac bool_ss [prim_recTheory.LESS_REFL]
5394 \\ rewrite_tac [ADD_SUB,ADD1,LESS_EQ_MONO_ADD_EQ,ADD_ASSOC]
5395 \\ rewrite_tac [SUB_0,ADD_CLAUSES,MULT_CLAUSES,LESS_EQ_0,ADD_EQ_0]
5396QED
5397
5398Theorem CEILING_DIV:
5399 !k. 0 < k ==> !n. CEILING_DIV n k = n DIV k + MIN (n MOD k) 1
5400Proof
5401 rewrite_tac [CEILING_DIV_def]
5402 \\ rpt strip_tac
5403 \\ drule_then (Q.SPEC_THEN ‘n’ mp_tac) DIVISION
5404 \\ strip_tac
5405 \\ PAT_X_ASSUM “n = _:num”
5406 (fn th => CONV_TAC (RATOR_CONV (SIMP_CONV bool_ss [Once th])))
5407 \\ rewrite_tac [GSYM ADD_ASSOC]
5408 \\ imp_res_tac ADD_DIV_ADD_DIV
5409 \\ asm_rewrite_tac [EQ_ADD_LCANCEL]
5410 \\ Q.SPEC_THEN ‘n MOD k = 0’ strip_assume_tac EXCLUDED_MIDDLE
5411 THEN1
5412 (imp_res_tac DIV_EQ_X
5413 \\ asm_rewrite_tac [ADD_CLAUSES,MIN_0,MULT_CLAUSES,ZERO_LESS_EQ]
5414 \\ Q.SPEC_THEN ‘k’ strip_assume_tac num_CASES
5415 \\ full_simp_tac bool_ss [prim_recTheory.LESS_REFL]
5416 \\ rewrite_tac [ADD_SUB,ADD1,LESS_EQ,LESS_EQ_REFL])
5417 \\ ‘MIN (n MOD k) 1 = 1’ by
5418 (rewrite_tac [MIN,LESS_EQ]
5419 \\ Q.SPEC_THEN ‘n MOD k’ strip_assume_tac num_CASES
5420 \\ full_simp_tac bool_ss []
5421 \\ rewrite_tac [ONE,LESS_EQ_MONO,NOT_SUC_LESS_EQ_0])
5422 \\ imp_res_tac DIV_EQ_X
5423 \\ asm_rewrite_tac [MULT_CLAUSES]
5424 \\ Q.SPEC_THEN ‘n MOD k’ strip_assume_tac num_CASES
5425 \\ Q.SPEC_THEN ‘k’ strip_assume_tac num_CASES
5426 \\ full_simp_tac bool_ss [prim_recTheory.LESS_REFL]
5427 \\ rewrite_tac [ADD_SUB,ADD1,LESS_EQ,LESS_EQ_REFL]
5428 \\ full_simp_tac bool_ss [GSYM ADD1,ADD_CLAUSES,LESS_EQ_MONO]
5429 \\ once_rewrite_tac [ADD_COMM]
5430 \\ full_simp_tac bool_ss [LESS_EQ_ADD,LE_ADD_LCANCEL,LESS_MONO_EQ]
5431 \\ asm_rewrite_tac [LESS_OR_EQ]
5432QED
5433
5434Theorem CEILING_DIV_MOD:
5435 !k.
5436 0 < k ==>
5437 !n. (n = k * CEILING_DIV n k - CEILING_MOD n k) /\ CEILING_MOD n k < k
5438Proof
5439 rpt strip_tac
5440 \\ imp_res_tac CEILING_DIV
5441 \\ imp_res_tac MOD_LESS
5442 \\ asm_rewrite_tac [CEILING_MOD_def,LEFT_ADD_DISTRIB]
5443 \\ Q.SPEC_THEN ‘n MOD k = 0’ strip_assume_tac EXCLUDED_MIDDLE
5444 THEN1
5445 (imp_res_tac DIVMOD_ID
5446 \\ asm_rewrite_tac [MIN_0,MULT_CLAUSES,ADD_CLAUSES,SUB_0]
5447 \\ drule_then (Q.SPEC_THEN ‘n’ mp_tac) DIVISION
5448 \\ disch_then (fn th => simp_tac bool_ss [Once th])
5449 \\ asm_rewrite_tac [ADD_CLAUSES]
5450 \\ simp_tac bool_ss [Once MULT_COMM])
5451 \\ drule_then (Q.SPEC_THEN ‘n’ mp_tac) DIVISION
5452 \\ disch_then (fn th => simp_tac bool_ss [Once th])
5453 \\ ‘MIN (n MOD k) 1 = 1’ by
5454 (Q.SPEC_THEN ‘n MOD k’ strip_assume_tac num_CASES
5455 \\ full_simp_tac bool_ss []
5456 \\ rewrite_tac [MIN,ONE,LESS_MONO_EQ,prim_recTheory.NOT_LESS_0])
5457 \\ asm_rewrite_tac [MULT_CLAUSES]
5458 \\ ‘(k - n MOD k) < k’ by
5459 (Q.SPEC_THEN ‘n MOD k’ strip_assume_tac num_CASES
5460 \\ Q.SPEC_THEN ‘k’ strip_assume_tac num_CASES
5461 \\ full_simp_tac bool_ss [prim_recTheory.LESS_REFL]
5462 \\ rewrite_tac [SUB_MONO_EQ,SUB_LESS_SUC])
5463 \\ drule_then (rewrite_tac o single) LESS_MOD
5464 \\ asm_rewrite_tac [SUB_LEFT_SUB,GSYM NOT_LESS]
5465 \\ once_rewrite_tac [ADD_COMM]
5466 \\ rewrite_tac [ADD_ASSOC,ADD_SUB]
5467 \\ simp_tac bool_ss [Once MULT_COMM]
5468QED
5469
5470Theorem LE_MULT_CEILING_DIV:
5471 !k. 0 < k ==> !n. n <= k * CEILING_DIV n k
5472Proof
5473 rpt strip_tac
5474 \\ imp_res_tac CEILING_DIV_MOD
5475 \\ pop_assum (K ALL_TAC)
5476 \\ pop_assum (fn th => simp_tac bool_ss [Once th,SUB_LESS_EQ])
5477QED
5478
5479(* moved here from integralTheory *)
5480Theorem num_MAX :
5481 !P. (?(x:num). P x) /\ (?(M:num). !x. P x ==> x <= M) <=>
5482 ?m. P m /\ (!x. P x ==> x <= m)
5483Proof
5484 GEN_TAC >> reverse EQ_TAC
5485 >- (rpt STRIP_TAC \\
5486 Q.EXISTS_TAC ‘m’ >> ASM_REWRITE_TAC[] \\
5487 Q.EXISTS_TAC ‘m’ >> ASM_REWRITE_TAC[])
5488 >> DISCH_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)
5489 >> SUBGOAL_THEN
5490 “(?(M:num). !(x:num). P x ==> x <= M) <=>
5491 (?M. (\M. !x. P x ==> x <= M) M)” SUBST1_TAC
5492 >- (BETA_TAC >> REFL_TAC)
5493 >> DISCH_THEN (MP_TAC o MATCH_MP WOP)
5494 >> BETA_TAC >> CONV_TAC (DEPTH_CONV NOT_FORALL_CONV)
5495 >> STRIP_TAC
5496 >> Q.EXISTS_TAC ‘n’ >> ASM_REWRITE_TAC[]
5497 >> NTAC 2 (POP_ASSUM MP_TAC)
5498 >> STRUCT_CASES_TAC (Q.SPEC ‘n’ num_CASES)
5499 >> rpt STRIP_TAC
5500 >| [ (* goal 1 (of 2) *)
5501 UNDISCH_THEN “!(x:num). P x ==> x <= (0:num)”
5502 (MP_TAC o CONV_RULE (ONCE_DEPTH_CONV CONTRAPOS_CONV)) \\
5503 REWRITE_TAC[NOT_LESS_EQUAL] >> STRIP_TAC \\
5504 POP_ASSUM(MP_TAC o CONV_RULE (ONCE_DEPTH_CONV CONTRAPOS_CONV)) \\
5505 REWRITE_TAC[] >> STRIP_TAC >> RES_TAC \\
5506 MP_TAC (Q.SPEC ‘x’ LESS_0_CASES) >> ASM_REWRITE_TAC[] \\
5507 DISCH_THEN (SUBST_ALL_TAC o SYM) >> ASM_REWRITE_TAC[],
5508 (* goal 2 (of 2) *)
5509 POP_ASSUM (MP_TAC o Q.SPEC ‘n'’) \\
5510 REWRITE_TAC [LESS_SUC_REFL] \\
5511 SUBGOAL_THEN “!x y. ~(x ==> y) <=> x /\ ~y”
5512 (fn th => REWRITE_TAC[th] THEN STRIP_TAC) >- REWRITE_TAC [NOT_IMP] \\
5513 UNDISCH_THEN “!(x:num). P x ==> x <= SUC n'” (MP_TAC o Q.SPEC ‘x'’) \\
5514 ASM_REWRITE_TAC[LESS_OR_EQ] \\
5515 DISCH_THEN (DISJ_CASES_THEN2 ASSUME_TAC SUBST_ALL_TAC) >| (* 2 subgoals *)
5516 [ (* goal 2.1 (of 2) *)
5517 NTAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[NOT_LESS_EQUAL] \\
5518 REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_LESS_SUC,
5519 (* goal 2.2 (of 2) *)
5520 ASM_REWRITE_TAC[] ] ]
5521QED
5522
5523(* ------------------------------------------------------------------------- *)
5524(* Arithmetic Manipulations (from examples/algebra) *)
5525(* ------------------------------------------------------------------------- *)
5526
5527(* Theorem: n * p = m * p <=> p = 0 \/ n = m *)
5528(* Proof:
5529 n * p = m * p
5530 <=> n * p - m * p = 0 by SUB_EQUAL_0
5531 <=> (n - m) * p = 0 by RIGHT_SUB_DISTRIB
5532 <=> n - m = 0 or p = 0 by MULT_EQ_0
5533 <=> n = m or p = 0 by SUB_EQUAL_0
5534*)
5535Theorem MULT_RIGHT_CANCEL:
5536 !m n p. (n * p = m * p) <=> (p = 0) \/ (n = m)
5537Proof
5538 rw[]
5539QED
5540
5541(* Theorem: p * n = p * m <=> p = 0 \/ n = m *)
5542(* Proof: by MULT_RIGHT_CANCEL and MULT_COMM. *)
5543Theorem MULT_LEFT_CANCEL:
5544 !m n p. (p * n = p * m) <=> (p = 0) \/ (n = m)
5545Proof
5546 rw[MULT_RIGHT_CANCEL, MULT_COMM]
5547QED
5548
5549(* Theorem: m * (n * p) = n * (m * p) *)
5550(* Proof:
5551 m * (n * p)
5552 = (m * n) * p by MULT_ASSOC
5553 = (n * m) * p by MULT_COMM
5554 = n * (m * p) by MULT_ASSOC
5555*)
5556Theorem MULT_COMM_ASSOC:
5557 !m n p. m * (n * p) = n * (m * p)
5558Proof
5559 metis_tac[MULT_COMM, MULT_ASSOC]
5560QED
5561
5562(* Theorem: 0 < n ==> ((n * m) DIV n = m) *)
5563(* Proof:
5564 Since n * m = m * n by MULT_COMM
5565 = m * n + 0 by ADD_0
5566 and 0 < n by given
5567 Hence (n * m) DIV n = m by DIV_UNIQUE:
5568 |- !n k q. (?r. (k = q * n + r) /\ r < n) ==> (k DIV n = q)
5569*)
5570Theorem MULT_TO_DIV:
5571 !m n. 0 < n ==> ((n * m) DIV n = m)
5572Proof
5573 metis_tac[MULT_COMM, ADD_0, DIV_UNIQUE]
5574QED
5575(* This is commutative version of:
5576arithmeticTheory.MULT_DIV |- !n q. 0 < n ==> (q * n DIV n = q)
5577*)
5578
5579(* Theorem: m * (n * p) = m * p * n *)
5580(* Proof: by MULT_ASSOC, MULT_COMM *)
5581Theorem MULT_ASSOC_COMM:
5582 !m n p. m * (n * p) = m * p * n
5583Proof
5584 metis_tac[MULT_ASSOC, MULT_COMM]
5585QED
5586
5587(* Theorem: 0 < n ==> !m. (m * n = n) <=> (m = 1) *)
5588(* Proof: by MULT_EQ_ID *)
5589Theorem MULT_LEFT_ID:
5590 !n. 0 < n ==> !m. (m * n = n) <=> (m = 1)
5591Proof
5592 metis_tac[MULT_EQ_ID, NOT_ZERO_LT_ZERO]
5593QED
5594
5595(* Theorem: 0 < n ==> !m. (n * m = n) <=> (m = 1) *)
5596(* Proof: by MULT_EQ_ID *)
5597Theorem MULT_RIGHT_ID:
5598 !n. 0 < n ==> !m. (n * m = n) <=> (m = 1)
5599Proof
5600 metis_tac[MULT_EQ_ID, MULT_COMM, NOT_ZERO_LT_ZERO]
5601QED
5602
5603(* Theorem alias *)
5604Theorem MULT_EQ_SELF = MULT_RIGHT_ID;
5605(* val MULT_EQ_SELF = |- !n. 0 < n ==> !m. (n * m = n) <=> (m = 1): thm *)
5606
5607(* ------------------------------------------------------------------------- *)
5608(* Modulo Theorems (from examples/algebra) *)
5609(* ------------------------------------------------------------------------- *)
5610
5611(* Theorem: 0 < n ==> !a b. (a MOD n = b) <=> ?c. (a = c * n + b) /\ (b < n) *)
5612(* Proof:
5613 If part: (a MOD n = b) ==> ?c. (a = c * n + b) /\ (b < n)
5614 Or to show: ?c. (a = c * n + a MOD n) /\ a MOD n < n
5615 Taking c = a DIV n, this is true by DIVISION
5616 Only-if part: (a = c * n + b) /\ (b < n) ==> (a MOD n = b)
5617 Or to show: b < n ==> (c * n + b) MOD n = b
5618 (c * n + b) MOD n
5619 = ((c * n) MOD n + b MOD n) MOD n by MOD_PLUS
5620 = (0 + b MOD n) MOD n by MOD_EQ_0
5621 = b MOD n by MOD_MOD
5622 = b by LESS_MOD, b < n
5623*)
5624Theorem MOD_EQN:
5625 !n. 0 < n ==> !a b. (a MOD n = b) <=> ?c. (a = c * n + b) /\ (b < n)
5626Proof
5627 rw_tac std_ss[EQ_IMP_THM] >-
5628 metis_tac[DIVISION] >>
5629 metis_tac[MOD_PLUS, MOD_EQ_0, ADD, MOD_MOD, LESS_MOD]
5630QED
5631
5632(* Theorem: If n > 0, k MOD n = 0 ==> !x. (k*x) MOD n = 0 *)
5633(* Proof:
5634 (k*x) MOD n = (k MOD n * x MOD n) MOD n by MOD_TIMES2
5635 = (0 * x MOD n) MOD n by given
5636 = 0 MOD n by MULT_0 and MULT_COMM
5637 = 0 by ZERO_MOD
5638*)
5639Theorem MOD_MULTIPLE_ZERO :
5640 !n k. 0 < n /\ (k MOD n = 0) ==> !x. ((k*x) MOD n = 0)
5641Proof
5642 metis_tac[MOD_TIMES2, MULT_0, MULT_COMM, ZERO_MOD]
5643QED
5644
5645(* Theorem: (x + y + z) MOD n = (x MOD n + y MOD n + z MOD n) MOD n *)
5646(* Proof:
5647 (x + y + z) MOD n
5648 = ((x + y) MOD n + z MOD n) MOD n by MOD_PLUS
5649 = ((x MOD n + y MOD n) MOD n + z MOD n) MOD n by MOD_PLUS
5650 = (x MOD n + y MOD n + z MOD n) MOD n by MOD_MOD
5651*)
5652Theorem MOD_PLUS3:
5653 !n. 0 < n ==> !x y z. (x + y + z) MOD n = (x MOD n + y MOD n + z MOD n) MOD n
5654Proof
5655 metis_tac[MOD_PLUS, MOD_MOD]
5656QED
5657
5658(* Theorem: Addition is associative in MOD: if x, y, z all < n,
5659 ((x + y) MOD n + z) MOD n = (x + (y + z) MOD n) MOD n. *)
5660(* Proof:
5661 ((x * y) MOD n * z) MOD n
5662 = (((x * y) MOD n) MOD n * z MOD n) MOD n by MOD_TIMES2
5663 = ((x * y) MOD n * z MOD n) MOD n by MOD_MOD
5664 = (x * y * z) MOD n by MOD_TIMES2
5665 = (x * (y * z)) MOD n by MULT_ASSOC
5666 = (x MOD n * (y * z) MOD n) MOD n by MOD_TIMES2
5667 = (x MOD n * ((y * z) MOD n) MOD n) MOD n by MOD_MOD
5668 = (x * (y * z) MOD n) MOD n by MOD_TIMES2
5669 or
5670 ((x + y) MOD n + z) MOD n
5671 = ((x + y) MOD n + z MOD n) MOD n by LESS_MOD, z < n
5672 = (x + y + z) MOD n by MOD_PLUS
5673 = (x + (y + z)) MOD n by ADD_ASSOC
5674 = (x MOD n + (y + z) MOD n) MOD n by MOD_PLUS
5675 = (x + (y + z) MOD n) MOD n by LESS_MOD, x < n
5676*)
5677Theorem MOD_ADD_ASSOC:
5678 !n x y z. 0 < n /\ x < n /\ y < n /\ z < n ==>
5679 ((x + y) MOD n + z) MOD n = (x + (y + z) MOD n) MOD n
5680Proof
5681 metis_tac[LESS_MOD, MOD_PLUS, ADD_ASSOC]
5682QED
5683
5684(* Theorem: mutliplication is associative in MOD:
5685 (x*y MOD n * z) MOD n = (x * y*Z MOD n) MOD n *)
5686(* Proof:
5687 ((x * y) MOD n * z) MOD n
5688 = (((x * y) MOD n) MOD n * z MOD n) MOD n by MOD_TIMES2
5689 = ((x * y) MOD n * z MOD n) MOD n by MOD_MOD
5690 = (x * y * z) MOD n by MOD_TIMES2
5691 = (x * (y * z)) MOD n by MULT_ASSOC
5692 = (x MOD n * (y * z) MOD n) MOD n by MOD_TIMES2
5693 = (x MOD n * ((y * z) MOD n) MOD n) MOD n by MOD_MOD
5694 = (x * (y * z) MOD n) MOD n by MOD_TIMES2
5695 or
5696 ((x * y) MOD n * z) MOD n
5697 = ((x * y) MOD n * z MOD n) MOD n by LESS_MOD, z < n
5698 = (((x * y) * z) MOD n) MOD n by MOD_TIMES2
5699 = ((x * (y * z)) MOD n) MOD n by MULT_ASSOC
5700 = (x MOD n * (y * z) MOD n) MOD n by MOD_TIMES2
5701 = (x * (y * z) MOD n) MOD n by LESS_MOD, x < n
5702*)
5703Theorem MOD_MULT_ASSOC:
5704 !n x y z. 0 < n /\ x < n /\ y < n /\ z < n ==>
5705 ((x * y) MOD n * z) MOD n = (x * ((y * z) MOD n)) MOD n
5706Proof
5707 metis_tac[LESS_MOD, MOD_TIMES2, MULT_ASSOC]
5708QED
5709
5710(* Theorem: If n > 0, ((n - x) MOD n + x) MOD n = 0 for x < n. *)
5711(* Proof:
5712 ((n - x) MOD n + x) MOD n
5713 = ((n - x) MOD n + x MOD n) MOD n by LESS_MOD
5714 = (n - x + x) MOD n by MOD_PLUS
5715 = n MOD n by SUB_ADD and 0 <= n
5716 = (1*n) MOD n by MULT_LEFT_1
5717 = 0 by MOD_EQ_0
5718*)
5719Theorem MOD_ADD_INV:
5720 !n x. 0 < n /\ x < n ==> (((n - x) MOD n + x) MOD n = 0)
5721Proof
5722 metis_tac[LESS_MOD, MOD_PLUS, SUB_ADD, LESS_IMP_LESS_OR_EQ, MOD_EQ_0,
5723 MULT_LEFT_1]
5724QED
5725
5726(* Theorem: n < m ==> ((n MOD m = 0) <=> (n = 0)) *)
5727(* Proof:
5728 Note n < m ==> (n MOD m = n) by LESS_MOD
5729 Thus (n MOD m = 0) <=> (n = 0) by above
5730*)
5731Theorem MOD_EQ_0_IFF:
5732 !m n. n < m ==> ((n MOD m = 0) <=> (n = 0))
5733Proof
5734 rw_tac bool_ss[LESS_MOD]
5735QED
5736
5737Theorem ODD_bool_to_bit[simp]:
5738 ODD (bool_to_bit b) = b /\
5739 ODD (1 - bool_to_bit b) = ~b
5740Proof
5741 rw[bool_to_bit_def, ODD, ONE, SUB_MONO_EQ, SUB_0]
5742QED
5743
5744Theorem bool_to_bit_neq_add:
5745 bool_to_bit (x <> y) =
5746 (bool_to_bit x + bool_to_bit y) MOD 2
5747Proof
5748 reverse(rw[bool_to_bit_def, ADD_0, ADD])
5749 >- (
5750 rw[ONE, ADD] \\ rw[GSYM TWO, GSYM ONE]
5751 \\ irule EQ_SYM
5752 \\ irule (DIVMOD_ID |> SPEC_ALL |> UNDISCH |> cj 2 |> DISCH_ALL)
5753 \\ rw[TWO, LESS_0] )
5754 \\ irule EQ_SYM
5755 \\ irule ONE_MOD
5756 \\ rw[ONE, TWO, LESS_MONO, LESS_0]
5757QED
5758
5759Theorem bool_to_bit_MOD_2[simp]:
5760 bool_to_bit x MOD 2 = bool_to_bit x
5761Proof
5762 rw[bool_to_bit_def]
5763 \\ irule ONE_MOD
5764 \\ rw[ONE, TWO, LESS_MONO, LESS_0]
5765QED