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