From paul@tina.ucdavis.edu@munnari.cs.mu.oz Tue Mar 14 12:27:55 1989
Date: Fri, 10 Mar 89 09:40:53 PST
From: paul%tina.stanford.edu@munnari.oz (Paul N. Loewenstein)
To: info-hol@clover.ucdavis.edu
Subject: More arithmetic theorems
Status: RO

I have recently collected together my ad-hoc collection of arithmetic
theorems. Since some of them took some time to prove I thought some
people might be interested. I have just adjusted it to load into
HOL88V1.0.

********move_out.ml*********


%-----------------------------------------------------------------------%
% AUTHOR        : Paul Loewenstein                                      %
% DATE          : 89.03.10                                              %
%                                                                       %
% Collect up binder conversions                                         %
%                                                                       %
%-----------------------------------------------------------------------%

%
             t3 ((\x. t1[x]) t2) = (\x'. t3 t1[x'/x]) t2

             where x' is not free in either (\x. t1) or t3.
%

let MOVE_LAMBDA_OUT_CONV t =
 let t3,t1t2 = dest_comb t in
  let t1',t2 = dest_comb t1t2 in
   let x,t1 = dest_abs t1' in
    let x' = (variant (union (frees t1') (frees t3))) x in
     let t' = mk_comb (mk_abs (x',mk_comb (t3, subst [x',x] t1)),t2) in
       SUBS[SYM (BETA_CONV t')] (RAND_CONV BETA_CONV t);;

%
             UNTESTED!!!!

             ((\x. t1[x]) t2)t3 = (\x'. t1 t3[x'/x]) t2

             where x' is not free in either (\x. t1) or t3.
%

let MOVE_LAMBDA_ARG_OUT_CONV t =
 let t1t2,t3 = dest_comb t in
  let t1',t2 = dest_comb t1t2 in
   let x,t1 = dest_abs t1' in
    let x' = (variant (union (frees t1') (frees t3))) x in
     let t' = mk_comb (mk_abs (x',mk_comb (subst [x',x] t1, t3)),t2) in
       SUBS[SYM (BETA_CONV t')] (RATOR_CONV BETA_CONV t);;


%-----------------------------------------------------------------------%
% AUTHOR        : Paul Loewenstein                                      %
% DATE          : 88.05.09                                              %
% modified version of Tom Melham's MOVE_EXISTS_OUT_CONV to allow for    %
% x free in t1                                                          %
%                                                                       %
% RIGHT_COLLECT_EXISTS_CONV: term -> thm                                %
%                                                                       %
%   RIGHT_COLLECT_EXISTS_CONV "t1 /\ ?x.t2"                             %
%                                                                       %
%   |- t1 /\ ?x.t2[x] = ?x'. t1 /\ t2[x'/x]                             %
%     (where x' is not free in t1 /\ ?x.t2)                             %
%                                                                       %
%-----------------------------------------------------------------------%


let RIGHT_COLLECT_EXISTS_CONV t =
 (let t1,xt2 = dest_conj t in
   let x,t2 = dest_exists xt2 in
    let x' = variant (frees t) x in
     let t2' = subst [x',x] t2 in
      (let conj_thm = ASSUME "^t1 /\ ^t2'"
       and t' = "?^x'.^t1 /\ ^t2'" in
        IMP_ANTISYM_RULE
         (DISCH t
          (CHOOSE
           (x', CONJUNCT2 (ASSUME t))
           (EXISTS(t',x')(CONJ(CONJUNCT1 (ASSUME t))(ASSUME t2')))))
         (DISCH t'
          (CHOOSE
           (x', ASSUME t')
           (CONJ(CONJUNCT1 conj_thm)(EXISTS(xt2,x') (CONJUNCT2 conj_thm))))))
 ) ? failwith `RIGHT_COLLECT_EXISTS_CONV`;;

%-----------------------------------------------------------------------%
% AUTHOR        : Paul Loewenstein                                      %
% DATE          : 88.05.09                                              %
%                                                                       %
% LEFT_COLLECT_EXISTS_CONV: term -> thm                                 %
%                                                                       %
%   LEFT_COLLECT_EXISTS_CONV "t1 /\ ?x.t2"                              %
%                                                                       %
%   |- (?x.t1[x]) /\ t2 = ?x'. t1[x'/x] /\ t2                           %
%     (where x' is not free in (?x.t1) /\ t2)                           %
%                                                                       %
%-----------------------------------------------------------------------%

let LEFT_COLLECT_EXISTS_CONV t =
 (let xt1,t2 = dest_conj t in
   let x,t1 = dest_exists xt1 in
    let x' = variant (frees t) x in
     let t1' = subst [x',x] t1 in
      (let conj_thm = ASSUME "^t1' /\ ^t2"
       and t' = "?^x'.^t1' /\ ^t2" in
        IMP_ANTISYM_RULE
         (DISCH t
          (CHOOSE
           (x', CONJUNCT1 (ASSUME t))
           (EXISTS(t',x')(CONJ (ASSUME t1') (CONJUNCT2 (ASSUME t))))))
          (DISCH t'
           (CHOOSE
            (x', ASSUME t')
            (CONJ(EXISTS(xt1,x')(CONJUNCT1 conj_thm))(CONJUNCT2 conj_thm)))))
 ) ? failwith `LEFT_COLLECT_EXISTS_CONV`;;

let COLLECT_EXISTS_CONV =
 RIGHT_COLLECT_EXISTS_CONV ORELSEC LEFT_COLLECT_EXISTS_CONV;;

************mk_num_thms.ml***************


%-----------------------------------------------------------------------%
% AUTHOR        : Paul Loewenstein                                      %
% DATE          : 89.03.10                                              %
%                                                                       %
% Extra num theorems - eventually to be cleaned up                      %
%                                                                       %
%-----------------------------------------------------------------------%

new_theory `num_thms`;;

% |- !m. 0 <= m %

let LEQ_0 =
 REWRITE_RULE[SYM(SPEC_ALL (PURE_ONCE_REWRITE_RULE[DISJ_SYM] LESS_OR_EQ))] LESS_0_CASES;;

let LESS_LEQ_TRANS = TAC_PROOF (([], "! m n p. m < n /\ n <= p ==> m < p"),
 REPEAT STRIP_TAC THEN
 POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
 [
  IMP_RES_TAC LESS_TRANS
 ;
  POP_ASSUM (\x. POP_ASSUM (\y. ACCEPT_TAC (SUBS [x] y)))
 ]);;

let LEQ_LESS_TRANS = TAC_PROOF (([], "! m n p. m <= n /\ n < p ==> m < p"),
 REPEAT GEN_TAC THEN
 DISCH_THEN (\x. ASSUME_TAC (CONJUNCT2 x) THEN
  DISJ_CASES_TAC (REWRITE_RULE[LESS_OR_EQ] (CONJUNCT1 x))) THENL
 [
  IMP_RES_TAC LESS_TRANS
 ;
  ASM_REWRITE_TAC[]
 ]);;

% |- !m n. m < (SUC n) = m <= n %

let LESS_SUC_LESS_EQ =
 GEN_ALL (REWRITE_RULE[SYM (SPEC_ALL ADD1)] (REWRITE_RULE[ADD1;LESS_EQ_MONO_ADD_EQ]
  (REWRITE_RULE[ADD1;LESS_EQ_MONO_ADD_EQ] (SPECL ["m:num";"SUC n"] LESS_EQ))));;


let SUB_ADD_SUB = TAC_PROOF (([],"! m n p. n <= m ==> ((m - n) + p = (m + p) - n)"),
 GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL
 [
  REWRITE_TAC[ADD_CLAUSES;SUB_0]
 ;
  DISCH_TAC THEN RES_TAC THEN
  IMP_RES_TAC (SPECL ["n:num";"p:num";"m:num"] (REWRITE_RULE[ADD_CLAUSES;LEQ_0]
   (SPEC "0" LESS_EQ_LESS_EQ_MONO))) THEN
  POP_ASSUM (ASSUME_TAC o REWRITE_RULE[SYM (SPEC_ALL NOT_LESS)] o
   PURE_ONCE_REWRITE_RULE[ADD_SYM]) THEN
  ASM_REWRITE_TAC[ADD_CLAUSES;SUB]
 ]);;


% There must be a simpler proof for this %

let LESS_LESS_MONO_ADD = TAC_PROOF (([],
  "! m n p q. (m < n) /\ (p < q) ==> (m + p) < (n + q)"),
 INDUCT_TAC THEN INDUCT_TAC THENL
 [
  REWRITE_TAC[NOT_LESS_0]
 ;
  REWRITE_TAC[LESS_0] THEN
  UNDISCH_TAC "!p q. 0 < n /\ p < q ==> (0 + p) < (n + q)" THEN
  STRUCT_CASES_TAC (SPEC "n:num" num_CASES) THENL
  [
   REWRITE_TAC[NOT_LESS_0;ADD_CLAUSES;LESS_SUC]
  ;
   REWRITE_TAC[LESS_0;ADD_CLAUSES] THEN
   REPEAT STRIP_TAC THEN
   RES_TAC THEN
   IMP_RES_TAC LESS_SUC
  ]
 ;
  REWRITE_TAC[NOT_LESS_0]
 ;
  REWRITE_TAC[LESS_MONO_EQ] THEN
  REPEAT STRIP_TAC THEN
  RES_TAC THEN
  ASM_REWRITE_TAC[ADD_CLAUSES;LESS_MONO_EQ]
 ]);;


let LEQ_LESS_MONO_ADD = TAC_PROOF (([],
  "! m n p q. (m <= n) /\ (p < q) ==> (m + p) < (n + q)"),
 REPEAT STRIP_TAC THEN
 ASSUM_LIST (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ] o el 2) THENL
 [
  IMP_RES_TAC LESS_LESS_MONO_ADD
 ;
  ASM_REWRITE_TAC[PURE_ONCE_REWRITE_RULE[ADD_SYM] LESS_MONO_ADD_EQ]
 ]);;


let ADD_SUB_ADD = TAC_PROOF (([], "! m n p. m - (n + p) = (m - n) - p"),
 INDUCT_TAC THEN
 REPEAT GEN_TAC THENL
 [
  REWRITE_TAC[SUB_0]
 ;
  REWRITE_TAC[SUB] THEN
  ASM_CASES_TAC "m < n" THENL
  [
   IMP_RES_TAC (SPECL ["p:num";"m:num";"n:num"] (PURE_ONCE_REWRITE_RULE[ADD_SYM]
    (REWRITE_RULE[ADD_CLAUSES;LEQ_0] (SPEC "0" LEQ_LESS_MONO_ADD)))) THEN
   ASM_REWRITE_TAC[SUB_0]
  ;
   ASM_REWRITE_TAC[SUB] THEN
   SUBST_TAC [SYM (SPECL["m - n";"p:num";"n:num"] LESS_MONO_ADD_EQ)] THEN
   POP_ASSUM (ASSUME_TAC o REWRITE_RULE[NOT_LESS]) THEN
   IMP_RES_TAC SUB_ADD THEN
   ASM_REWRITE_TAC[] THEN
   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [] [ADD_SYM] THEN
   REFL_TAC
  ]
 ]);;


let INV_SUB_ADD = TAC_PROOF (([],
  "! m n p. (p <= m) /\ (n <= p) ==> ((m - p) + (p - n) = m - n)"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC SUB_ADD THEN
 SUBST_TAC[SYM (SPECL["(m - p) + (p - n)";"m - n";"n:num"] EQ_MONO_ADD_EQ)] THEN
 REWRITE_TAC[SYM (SPEC_ALL ADD_ASSOC)] THEN
 ASSUM_LIST (\x. ASSUME_TAC (MATCH_MP LESS_EQ_TRANS (CONJ (el 3 x) (el 4 x)))) THEN
 POP_ASSUM (ASSUME_TAC o MATCH_MP SUB_ADD) THEN
 ASM_REWRITE_TAC[]);;


let INV_SUC_SUB = TAC_PROOF (([], "!m n. SUC m - SUC n = m - n"),
 REPEAT GEN_TAC THEN
 ASM_CASES_TAC "m < (SUC n)" THEN ASM_REWRITE_TAC[SUB] THENL
 [
  POP_ASSUM (\x. SUBST_TAC[REWRITE_RULE[SYM(SPEC_ALL SUB_EQ_0);LESS_SUC_LESS_EQ] x]) THEN
  REFL_TAC
 ;
  REWRITE_TAC[ADD1;ADD_SUB_ADD] THEN
  POP_ASSUM (\x.ASSUME_TAC (REWRITE_RULE [CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)
    (REWRITE_RULE [LESS_SUC_LESS_EQ;SYM (SPEC_ALL SUB_EQ_0)] x);LESS_EQ;ADD1;ADD_CLAUSES]
   (SPEC "m - n" LESS_0_CASES))) THEN
  IMP_RES_TAC SUB_ADD
 ]);;


let INV_ADD_SUB = TAC_PROOF (([], "!m n p. (m + p) - (n + p) = m - n"),
 GEN_TAC THEN
 GEN_TAC THEN
 INDUCT_TAC THEN
 ASM_REWRITE_TAC[ADD_CLAUSES;INV_SUC_SUB]);;

let LEQ_MONO_EQ = TAC_PROOF (([], "! m n. (SUC m) <= (SUC n) = m <= n"),
 REPEAT GEN_TAC THEN
 EQ_TAC THEN
 DISCH_THEN (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
 [
  POP_ASSUM (ASSUME_TAC o REWRITE_RULE[LESS_MONO_EQ])
 ;
  POP_ASSUM (ASSUME_TAC o REWRITE_RULE[INV_SUC_EQ])
 ;
  POP_ASSUM (ASSUME_TAC o MATCH_MP LESS_MONO)
 ;
  ALL_TAC
 ] THEN
 ASM_REWRITE_TAC[LESS_OR_EQ]);;

let SUB_LEQ = TAC_PROOF (([], "! m n. (m - n) <= m"),
 INDUCT_TAC THEN REWRITE_TAC[SUB] THENL
 [
  REWRITE_TAC[LEQ_0]
 ;
  GEN_TAC THEN BOOL_CASES_TAC "m < n" THENL
  [
   REWRITE_TAC[LEQ_0]
  ;
   ASM_REWRITE_TAC[LEQ_MONO_EQ]
  ]
 ]);;

let SUB_REFL = TAC_PROOF (([], "!n. n - n = 0"),
 INDUCT_TAC THEN REWRITE_TAC[SUB;LESS_SUC_REFL]);;

let LEQ_ADD = TAC_PROOF (([], "! m n. m <= (m + n)"),
 INDUCT_TAC THENL
 [
  REWRITE_TAC[ADD_CLAUSES;LEQ_0]
 ;
  ASM_REWRITE_TAC[ADD_CLAUSES;LEQ_MONO_EQ]
 ]);;

let ADD_SUB = TAC_PROOF (([], "! m n. (m + n) - n = m"),
 INDUCT_TAC THENL
 [
  REWRITE_TAC[ADD_CLAUSES;SUB_REFL]
 ;
  ASM_REWRITE_TAC[ADD_CLAUSES;SUB;REWRITE_RULE[SYM (SPEC_ALL NOT_LESS)]
   (PURE_ONCE_REWRITE_RULE[ADD_SYM] LEQ_ADD)]
 ]);;

let ADD_SUB_SUB = TAC_PROOF (([],
  "!m n p. p <= n ==> ((m + p) - n = m - (n - p))"),
 INDUCT_TAC THEN
 REPEAT STRIP_TAC THENL
 [
  ASM_REWRITE_TAC[ADD_CLAUSES;SUB;SUB_EQ_0]
 ;
  RES_TAC THEN
  REWRITE_TAC[ADD_CLAUSES;SUB] THEN
  ASM_CASES_TAC "(m + p) < n" THEN
  ASM_CASES_TAC "m < (n - p)" THEN
  ASM_REWRITE_TAC[ADD1;INV_ADD_SUB] THEN
  IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN
  POP_ASSUM (ASSUME_TAC o REWRITE_RULE[SYM (SPEC_ALL SUB_EQ_0)]) THENL
  [
   ASSUM_LIST (\x. ASSUME_TAC (REWRITE_RULE[SUB_EQ_0;el 1 x] (SYM (el 4 x)))) THEN
   POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
   [
    RES_TAC
   ;
    ASSUM_LIST (\x.ASSUME_TAC (SUBS[el 1 x] (el 4 x))) THEN
    IMP_RES_TAC SUB_ADD THEN
    POP_ASSUM (\x. POP_ASSUM (\y. CONTR_TAC (REWRITE_RULE[LESS_REFL] (SUBS[x] y))))
   ]
  ;
   ASSUM_LIST (\x. ASSUME_TAC (REWRITE_RULE[SUB_EQ_0;el 1 x] (el 4 x))) THEN
   POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
   [
    RES_TAC
   ;
    ASSUM_LIST (\x.ASSUME_TAC (SUBS [SYM (el 1 x)] (el 3 x))) THEN
    POP_ASSUM (CONTR_TAC o REWRITE_RULE[ADD_SUB;LESS_REFL])
   ]
  ]
 ]);;

let SUB_ADD_SUB_SUB = TAC_PROOF (([],
  "! m n p. (n <= m) /\ (p <= n) ==> ((m - n) + p = m - (n - p))"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC SUB_ADD_SUB THEN
 IMP_RES_TAC ADD_SUB_SUB THEN
 ASM_REWRITE_TAC[]);;

let LEFT_SUB_DISTRIB = PURE_ONCE_REWRITE_RULE[MULT_SYM] RIGHT_SUB_DISTRIB;;

let ADD_REFL = TAC_PROOF (([], "!n. n + n = 2 * n"),
 REWRITE_TAC[num_CONV "2";MULT_CLAUSES]);;

loadt `move_out`;;

let MONO_LESS_MULT = TAC_PROOF (([],
  "!m n p. 0 < m ==> n < p ==> (m * n) < (m * p)"),
 INDUCT_TAC THENL
 [
  REWRITE_TAC[NOT_LESS_0]
 ;
  REWRITE_TAC[LESS_0] THEN
  REWRITE_TAC[MULT_CLAUSES] THEN
  UNDISCH_TAC "!n p. 0 < m ==> n < p ==> (m * n) < (m * p)" THEN
  STRUCT_CASES_TAC (SPEC "m:num" num_CASES) THENL
  [
   REWRITE_TAC[NOT_LESS_0;MULT_CLAUSES;ADD_CLAUSES]
  ;
   REWRITE_TAC[LESS_0] THEN
   REPEAT STRIP_TAC THEN
   RES_TAC THEN
   IMP_RES_TAC
    (SPECL ["((SUC n) * n')";"((SUC n) * p)";"n':num";"p:num"] LESS_LESS_MONO_ADD)
  ]
 ]);;

let LESS_EQ_ADD_EQ = TAC_PROOF (([], "! m n. m <= n = (?p. n = m + p)"),
 REPEAT GEN_TAC THEN
 EQ_TAC THENL
 [
  REWRITE_TAC[LESS_OR_EQ] THEN STRIP_TAC THENL
  [
   IMP_RES_TAC LESS_ADD THEN
   POP_ASSUM STRIP_ASSUME_TAC THEN
   EXISTS_TAC "p:num" THEN
   PURE_ONCE_REWRITE_TAC[ADD_SYM] THEN
   ASM_REWRITE_TAC[]
  ;
   EXISTS_TAC "0" THEN
   ASM_REWRITE_TAC[ADD_CLAUSES]
  ]
 ;
  STRIP_TAC THEN
  DISJ_CASES_TAC (SPEC "p:num" num_CASES) THENL
  [
   ASM_REWRITE_TAC[LESS_OR_EQ] THEN
   REWRITE_TAC[ADD_CLAUSES]
  ;
   POP_ASSUM STRIP_ASSUME_TAC THEN
   ASM_REWRITE_TAC[] THEN
   REWRITE_TAC[LESS_OR_EQ;
    REWRITE_RULE[NOT_SUC] (SPECL["m:num"; "SUC n"] LESS_ADD_NONZERO)]
  ]
 ]);;

% |- !m n. m < n = (?p. n = SUC(m + p)) %

let LESS_ADD_EQ = GEN_ALL
 (PURE_REWRITE_RULE [CONV_RULE(ONCE_DEPTH_CONV SYM_CONV) LESS_EQ;ADD_CLAUSES]
  (SPEC "SUC m" LESS_EQ_ADD_EQ));;


let MOD_exists_unique = TAC_PROOF (([],
  "!k. 0 < n ==> ?!r. ?q. (k = (q * n) + r) /\ r < n"),
 let thm1 = REWRITE_RULE[ADD_CLAUSES] (SPEC "0" LESS_ADD_EQ)
 and thm2 = PURE_ONCE_REWRITE_RULE[ADD_SYM] EQ_MONO_ADD_EQ in
  REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN
  CONV_TAC (REDEPTH_CONV BETA_CONV) THEN
  REPEAT STRIP_TAC THENL
  [
   SPEC_TAC ("k:num","k:num") THEN
   INDUCT_THEN INDUCTION STRIP_ASSUME_TAC THENL
   [
    EXISTS_TAC "0" THEN
    EXISTS_TAC "0" THEN
    ASM_REWRITE_TAC[MULT_CLAUSES;ADD_CLAUSES]
   ;
    ASM_CASES_TAC "SUC r < n" THENL
    [
     EXISTS_TAC "SUC r" THEN EXISTS_TAC "q:num" THEN
     ASM_REWRITE_TAC[ADD_CLAUSES]
    ;
     EXISTS_TAC "0" THEN EXISTS_TAC "SUC q" THEN
     POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[NOT_LESS;LESS_OR_EQ]) THENL
     [
      POP_ASSUM (IMP_RES_TAC o
       PURE_REWRITE_RULE[SYM (SPEC_ALL NOT_LESS);LESS_MONO_EQ] o
       PURE_REWRITE_RULE[LESS_EQ])
     ;
      ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]
     ]
    ]
   ]
  ;
   UNDISCH_TAC "k = (q * n) + x" THEN
   PURE_ASM_REWRITE_TAC[] THEN
   DISJ_CASES_TAC (SPECL["q:num";"q':num"]LESS_CASES) THEN
   DISJ_CASES_TAC (SPECL["x:num";"y:num"]LESS_CASES) THENL
   [
    ASSUM_LIST
     (\x.REWRITE_TAC [CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) (MATCH_MP LESS_NOT_EQ
      (MATCH_MP LESS_LESS_MONO_ADD (CONJ (MP (MP (SPECL
       ["n:num";"q:num";"q':num"]
       (PURE_ONCE_REWRITE_RULE[MULT_SYM]MONO_LESS_MULT)) (el (length x) x))
       (el 2 x)) (el 1 x))))])
   ;
    POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
    [
     ASSUM_LIST (STRIP_ASSUME_TAC o (REWRITE_RULE[LESS_ADD_EQ] o el 2)) THEN
     PURE_ASM_REWRITE_TAC[MULT_CLAUSES;RIGHT_ADD_DISTRIB] THEN
     PURE_REWRITE_TAC[SYM (SPEC_ALL ADD_ASSOC);thm2] THEN
     ASSUM_LIST (\x. STRIP_ASSUME_TAC
      (PURE_REWRITE_RULE[thm1](el (length x) x))) THEN
     PURE_ASM_REWRITE_TAC[ADD_ASSOC;ADD_CLAUSES;MULT_CLAUSES] THEN
     SUBST_TAC[SPECL ["p + (p * p')";"p':num"]ADD_SYM] THEN
     PURE_REWRITE_TAC[SYM (SPEC_ALL ADD_ASSOC);
      SYM(CONJUNCT1(CONJUNCT2(CONJUNCT2 ADD_CLAUSES)))] THEN
     POP_ASSUM (\x.SUBST_TAC[SYM x]) THEN
     DISCH_THEN (IMP_RES_TAC o REWRITE_RULE
      (map (CONV_RULE(ONCE_DEPTH_CONV SYM_CONV)) [NOT_LESS;LESS_EQ_ADD_EQ]) o
      EXISTS ("?p. x = n + p","(p + ((p * p') + y))") o SYM)
    ;
     ASM_REWRITE_TAC[]
    ]
   ;
    ASSUM_LIST (DISJ_CASES_TAC o PURE_REWRITE_RULE[LESS_OR_EQ] o el 2) THENL
    [
     POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE[LESS_ADD_EQ])) THEN
     PURE_ASM_REWRITE_TAC[MULT_CLAUSES;RIGHT_ADD_DISTRIB] THEN
     PURE_REWRITE_TAC[SYM (SPEC_ALL ADD_ASSOC);thm2] THEN
     ASSUM_LIST
      (\x. STRIP_ASSUME_TAC (PURE_REWRITE_RULE[thm1](el (length x) x))) THEN
     PURE_ASM_REWRITE_TAC[ADD_ASSOC;ADD_CLAUSES;MULT_CLAUSES] THEN
     SUBST_TAC[SPECL ["p + (p * p')";"p':num"]ADD_SYM] THEN
     PURE_REWRITE_TAC[SYM (SPEC_ALL ADD_ASSOC);
      SYM(CONJUNCT1(CONJUNCT2(CONJUNCT2 ADD_CLAUSES)))] THEN
     POP_ASSUM (\x.SUBST_TAC[SYM x]) THEN
     DISCH_THEN (IMP_RES_TAC o PURE_REWRITE_RULE
      (map (CONV_RULE(ONCE_DEPTH_CONV SYM_CONV)) [NOT_LESS;LESS_EQ_ADD_EQ]) o
      EXISTS ("?p. y = n + p","(p + ((p * p') + x))"))
    ;
     PURE_ASM_REWRITE_TAC[thm2] THEN
     DISCH_THEN (\x.SUBST_TAC[x]) THEN
     REFL_TAC
    ]
   ;
    POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ]) THENL
    [
     ASSUM_LIST (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ] o el 2) THENL
     [
      ASSUM_LIST
       (\x.REWRITE_TAC [(MATCH_MP LESS_NOT_EQ
        (MATCH_MP LESS_LESS_MONO_ADD (CONJ (MP (MP (SPECL
         ["n:num";"q':num";"q:num"]
         (PURE_ONCE_REWRITE_RULE[MULT_SYM]MONO_LESS_MULT)) (el (length x) x))
         (el 1 x)) (el 2 x))))])
     ;
      PURE_ASM_REWRITE_TAC[thm2] THEN
      DISCH_THEN (\x.SUBST_TAC[x]) THEN
      REFL_TAC
     ]
    ;
     ASM_REWRITE_TAC[]
    ]
   ]
  ]);;

let imp_not_conj_eq = TAC_PROOF (([], "! x y. x ==> y = ~(x /\ ~y)"),
 REPEAT GEN_TAC THEN BOOL_CASES_TAC "x:bool" THEN REWRITE_TAC[]);;

let temp = CONJUNCTS (CONV_RULE (REDEPTH_CONV BETA_CONV)
 (REWRITE_RULE[EXISTS_UNIQUE_DEF] (UNDISCH (SPEC_ALL MOD_exists_unique))));;

let MOD_select = GEN_ALL
 (DISCH_ALL (REWRITE_RULE[SYM (SPEC_ALL MOD)] (SELECT_RULE (el 1 temp))));;

let MOD_unique = (SPEC_ALL (el 2 temp));;

let LESS_IMP_LESS_0 = TAC_PROOF (([], "! m n. m < n ==> 0 < n"),
 REPEAT GEN_TAC THEN
 STRUCT_CASES_TAC (SPEC "n:num" num_CASES) THEN
 REWRITE_TAC[NOT_LESS_0;LESS_0]);;

let INV_MULT = TAC_PROOF (([],
  "! m n p. 0 < p ==> (m * p = n * p) ==> (m = n)"),
 INDUCT_TAC THEN
 INDUCT_TAC THEN
 GEN_TAC THEN
 REWRITE_TAC[MULT_CLAUSES;EQ_MONO_ADD_EQ;INV_SUC_EQ] THEN
 REPEAT STRIP_TAC THENL
 [
  POP_ASSUM (ASSUME_TAC o EXISTS ("?q. 0 = q + p", "n * p"))
 ;
  POP_ASSUM (ASSUME_TAC o (EXISTS ("?q. 0 = q + p", "m * p") o
      CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)))
 ;
  RES_TAC
 ] THEN
 POP_ASSUM (IMP_RES_TAC o (REWRITE_RULE
  [CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) NOT_LESS;
   CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) LESS_EQ_ADD_EQ] o
   PURE_ONCE_REWRITE_RULE[ADD_SYM])));;


let DIV_MOD_UNIQUE = TAC_PROOF (([],
  "! n q q' r r'. ((q * n) + r = (q' * n) + r') /\ r < n /\ r' < n ==>
   (r = r') /\ (q = q')"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC LESS_IMP_LESS_0 THEN
 IMP_RES_TAC
  (REWRITE_RULE[CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) imp_not_conj_eq]
   (SPEC "(q * n) + y"
   (GEN "k:num" (DISCH_ALL (SPEC_ALL
    (CONV_RULE
     (REDEPTH_CONV COLLECT_EXISTS_CONV THENC REDEPTH_CONV NOT_EXISTS_CONV)
     (PURE_REWRITE_RULE[imp_not_conj_eq] (SPEC_ALL (el 2 temp))))))))) THENL
 [
  ASM_REWRITE_TAC[]
 ;
  ASSUM_LIST (\x. ACCEPT_TAC (MP (MP
   (SPECL ["q:num";"q':num";"n:num"] INV_MULT) (el 5 x))
   (PURE_REWRITE_RULE[EQ_MONO_ADD_EQ] (SUBS [el 1 x] (el (length x) x)))))
 ]);;

let DIV_exists = TAC_PROOF (([], "0 < n ==> ?q. k = (q * n) + (k MOD n)"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC MOD_select THEN
 POP_ASSUM STRIP_ASSUME_TAC THEN
 EXISTS_TAC "q:num" THEN
 ASSUM_LIST (\x.REWRITE_TAC[SYM (el 2 x)]));;

% |- !n k. 0 < n ==> (k = ((k DIV n) * n) + (k MOD n)) %

let DIV_select = GEN_ALL (DISCH_ALL
 (REWRITE_RULE[SYM (SPEC_ALL DIV)] (SELECT_RULE (UNDISCH DIV_exists))));;

let DIV_MOD = TAC_PROOF (([],
  "!m n. 0 < n ==> (m = ((m DIV n) * n) + (m MOD n)) /\ (m MOD n) < n"),
 REPEAT STRIP_TAC THENL
 [
  IMP_RES_TAC (SPECL ["n:num";"m:num"] DIV_select)
 ;
  IMP_RES_TAC (SPECL ["n:num";"m:num"] MOD_select) THEN
  POP_ASSUM STRIP_ASSUME_TAC
 ]);;

let DIV_MOD_MULT_ADD = TAC_PROOF (([],
  "! m n p. 0 < n ==>
   (((m * n) + p) MOD n = p MOD n) /\ (((m * n) + p) DIV n = m + (p DIV n))"),
 REPEAT GEN_TAC THEN
 DISCH_TAC THEN
 IMP_RES_TAC (SPEC "p:num" DIV_MOD) THEN
 IMP_RES_TAC (SPECL ["(m * n) + p";"n:num"] DIV_MOD) THEN
 ASSUM_LIST (\x. ASSUME_TAC
  (PURE_REWRITE_RULE[SYM (SPEC_ALL RIGHT_ADD_DISTRIB);ADD_ASSOC]
   (SUBS_OCCS[[1],el 4 x] (el 2 x)))) THEN
 IMP_RES_TAC (SPECL ["n:num";"m + (p DIV n)";"((m * n) + p) DIV n";
  "p MOD n";"((m * n) + p) MOD n"] DIV_MOD_UNIQUE) THEN
 ASSUM_LIST (\x.SUBST_TAC[el 4 x;el 1 x]) THEN
 CONJ_TAC THEN
 REFL_TAC);;

let DIV_MOD_LESS = TAC_PROOF (([],
  "! m n. m < n ==> (m DIV n = 0) /\ (m MOD n = m)"),
 REPEAT GEN_TAC THEN
 DISCH_TAC THEN
 IMP_RES_TAC LESS_IMP_LESS_0 THEN
 IMP_RES_TAC DIV_MOD THEN
 IMP_RES_TAC (PURE_REWRITE_RULE[MULT_CLAUSES;ADD_CLAUSES]
  (SPECL ["n:num";"0";"m DIV n";"m:num";"m MOD n"] DIV_MOD_UNIQUE)) THEN
 ASSUM_LIST (\x.SUBST_TAC[el 1 x;SYM (el 4 x)]) THEN
 CONJ_TAC THEN
 REFL_TAC);;

% |- !n. 0 < n ==> (0 DIV n = 0) /\ (0 MOD n = 0) %

let DIV_MOD_0 = SPEC "0" DIV_MOD_LESS;;

let DIV_MOD_SUC = TAC_PROOF (([],
  "! m n. 0 < n ==> SUC (m MOD n) < n =>
    (((SUC m) DIV n = m DIV n) /\ ((SUC m) MOD n = SUC (m MOD n))) |
    (((SUC m) DIV n = SUC (m DIV n)) /\ ((SUC m) MOD n = 0))"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC DIV_MOD THEN
 IMP_RES_TAC (SPEC "SUC m" DIV_MOD) THEN
 ASM_CASES_TAC "SUC (m MOD n) < n" THEN FIRST_ASSUM (\x. REWRITE_TAC[x]) THENL
 [
  ASSUM_LIST (\x. ASSUME_TAC (SUBS[el 3 x]
   (PURE_ONCE_REWRITE_RULE[SYM (CONJUNCT2 (CONJUNCT2 (CONJUNCT2 ADD_CLAUSES)))]
    (PURE_ONCE_REWRITE_RULE [SYM (SPEC_ALL INV_SUC_EQ)] (el 5 x))))) THEN
  CONJ_TAC THEN
  IMP_RES_TAC DIV_MOD_UNIQUE
 ;
  POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[NOT_LESS;LESS_OR_EQ]) THENL
  [
   POP_ASSUM (DISJ_CASES_TAC o REWRITE_RULE[LESS_OR_EQ] o REWRITE_RULE[LESS_EQ]) THENL
   [
    POP_ASSUM (ASSUME_TAC o REWRITE_RULE[SYM (SPEC_ALL NOT_LESS)] o
     MATCH_MP LESS_IMP_LESS_OR_EQ o REWRITE_RULE[LESS_MONO_EQ]) THEN
    RES_TAC
   ;
    ASSUM_LIST (\x. CONTR_TAC
     (REWRITE_RULE[SYM(REWRITE_RULE [INV_SUC_EQ] (el 1 x));LESS_REFL] (el 4 x)))
   ]
  ;
   ASSUM_LIST (\x. ASSUME_TAC (SUBS[el 3 x]
    (GEN_REWRITE_RULE RAND_CONV [] [SYM (CONJUNCT1 (CONJUNCT2 ADD_CLAUSES))]
     (REWRITE_RULE [SYM (CONJUNCT1 (CONJUNCT2 (CONJUNCT2 (CONJUNCT2 (CONJUNCT2
       (SPEC_ALL MULT_CLAUSES))))))]
      (SUBS [SYM (el 1 x)] (PURE_ONCE_REWRITE_RULE[SYM (CONJUNCT2
        (CONJUNCT2 (CONJUNCT2 ADD_CLAUSES)))]
       (PURE_ONCE_REWRITE_RULE [SYM (SPEC_ALL INV_SUC_EQ)] (el 5 x)))))))) THEN
   CONJ_TAC THEN IMP_RES_TAC DIV_MOD_UNIQUE
  ]
 ]);;

let DIV_MOD_SUC_CASES = TAC_PROOF  (([],
  "! m n. 0 < n ==>
    (((SUC m) DIV n = m DIV n) /\ ((SUC m) MOD n = SUC (m MOD n))) \/
    (((SUC m) DIV n = SUC (m DIV n)) /\ ((SUC m) MOD n = 0))"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC DIV_MOD_SUC THEN
 ASM_CASES_TAC "SUC (m MOD n) < n" THENL
 [
  DISJ1_TAC
 ;
  DISJ2_TAC
 ] THEN
 ASSUM_LIST (\x.ACCEPT_TAC (REWRITE_RULE[el 1 x] (el 2 x))));;

let DIV_SUC_LESS_OR_EQ = TAC_PROOF (([], "! m n. 0 < n ==> (m DIV n) <= (SUC m DIV n)"),
 REPEAT STRIP_TAC THEN
 IMP_RES_TAC DIV_MOD_SUC_CASES THEN
 ASM_REWRITE_TAC[LESS_OR_EQ;LESS_SUC_REFL]);;

let DIV_ADD_LESS_OR_EQ = TAC_PROOF (([], "!m n p. 0 < n ==> (m DIV n) <= ((m + p) DIV n)"),
 GEN_TAC THEN
 GEN_TAC THEN
 INDUCT_TAC THENL
 [
  REWRITE_TAC[ADD_CLAUSES;LESS_OR_EQ]
 ;
  STRIP_TAC THEN
  RES_TAC THEN
  REWRITE_TAC[ADD_CLAUSES] THEN
  IMP_RES_TAC (SPEC "m + p" DIV_SUC_LESS_OR_EQ) THEN
  POP_ASSUM (\x. POP_ASSUM (\y. ACCEPT_TAC (MATCH_MP LESS_EQ_TRANS (CONJ y x))))
 ]);;

let LESS_EQ_MONO_DIV = TAC_PROOF ( ([],
  "! m n p. 0 < n ==> m <= p ==> (m DIV n) <= (p DIV n)"),
 REPEAT STRIP_TAC THEN
 POP_ASSUM (STRIP_ASSUME_TAC o REWRITE_RULE[LESS_EQ_ADD_EQ]) THEN
 ASM_REWRITE_TAC[] THEN
 IMP_RES_TAC (SPECL ["m:num";"n:num";"p':num"] DIV_ADD_LESS_OR_EQ));;

let LEQ_MULT = TAC_PROOF (([], "! m n. 0 < n ==> m <= (m * n)"),
 INDUCT_TAC THENL
 [
  REWRITE_TAC[LEQ_0]
 ;
  REPEAT STRIP_TAC THEN RES_TAC THEN
  REWRITE_TAC[MULT_CLAUSES] THEN
  POP_ASSUM (\x.POP_ASSUM (\y. ASSUME_TAC (REWRITE_RULE[SPEC "m * n" ADD1]
   (PURE_ONCE_REWRITE_RULE[SYM (SPEC_ALL LEQ_MONO_EQ)] x))
    THEN ASSUME_TAC
     (EQ_MP (PURE_ONCE_REWRITE_RULE[ADD_SYM] (SYM (SPECL ["1";"n:num";"m * n"]
       LESS_EQ_MONO_ADD_EQ)))
      (REWRITE_RULE[LESS_EQ;SYM (num_CONV "1")] y)))) THEN
  IMP_RES_TAC LESS_EQ_TRANS
 ]);;

let LEQ_MONO_EXP = TAC_PROOF (([],
  "! m n p. 0 < p ==> m <= n ==> (p EXP m) <= (p EXP n)"),
 INDUCT_TAC THEN
 INDUCT_TAC THENL
 [
  REWRITE_TAC[LESS_OR_EQ]
 ;
  GEN_TAC THEN
  DISCH_THEN (\x. POP_ASSUM (\y.
   STRIP_ASSUME_TAC (REWRITE_RULE[LESS_EQ_ADD_EQ]
    (REWRITE_RULE[LEQ_0;EXP] (MP (SPEC_ALL y) x))) THEN
   STRIP_ASSUME_TAC (REWRITE_RULE[LESS_ADD_EQ;ADD_CLAUSES] x))) THEN
  REWRITE_TAC[EXP;LEQ_0] THEN
  POP_ASSUM
   (\x. GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o RAND_CONV) [] [x]) THEN
  REWRITE_TAC[MULT_CLAUSES;LESS_EQ_ADD_EQ] THEN
  EXISTS_TAC "(p'' * (1 + p')) + p'" THEN
  ASM_REWRITE_TAC[num_CONV "1";ADD_CLAUSES]
 ;
  REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]
 ;
  REPEAT STRIP_TAC THEN
  POP_ASSUM (ASSUME_TAC o REWRITE_RULE[LEQ_MONO_EQ]) THEN
  RES_TAC THEN
  REWRITE_TAC[EXP] THEN
  IMP_RES_TAC (PURE_ONCE_REWRITE_RULE[MULT_SYM] LESS_MONO_MULT)
 ]);;

save_thm (`LEQ_0`,LEQ_0);;
save_thm (`LESS_LEQ_TRANS`,LESS_LEQ_TRANS);;
save_thm (`LEQ_LESS_TRANS`,LEQ_LESS_TRANS);;
save_thm (`LESS_SUC_LESS_EQ`,LESS_SUC_LESS_EQ);;
save_thm (`SUB_ADD_SUB`,SUB_ADD_SUB);;
save_thm (`LESS_LESS_MONO_ADD`,LESS_LESS_MONO_ADD);;
save_thm (`LEQ_LESS_MONO_ADD`,LEQ_LESS_MONO_ADD);;
save_thm (`ADD_SUB_ADD`,ADD_SUB_ADD);;
save_thm (`INV_SUB_ADD`,INV_SUB_ADD);;
save_thm (`INV_SUC_SUB`,INV_SUC_SUB);;
save_thm (`INV_ADD_SUB`,INV_ADD_SUB);;
save_thm (`LEQ_MONO_EQ`,LEQ_MONO_EQ);;
save_thm (`SUB_LEQ`,SUB_LEQ);;
save_thm (`SUB_REFL`,SUB_REFL);;
save_thm (`LEQ_ADD`,LEQ_ADD);;
save_thm (`ADD_SUB`,ADD_SUB);;
save_thm (`ADD_SUB_SUB`,ADD_SUB_SUB);;
save_thm (`SUB_ADD_SUB_SUB`,SUB_ADD_SUB_SUB);;
save_thm (`LEFT_SUB_DISTRIB`,LEFT_SUB_DISTRIB);;
save_thm (`ADD_REFL`,ADD_REFL);;
save_thm (`LEQ_MULT`,LEQ_MULT);;
save_thm (`MONO_LESS_MULT`,MONO_LESS_MULT);;
save_thm (`LESS_EQ_ADD_EQ`,LESS_EQ_ADD_EQ);;
save_thm (`LESS_ADD_EQ`,LESS_ADD_EQ);;
save_thm (`LEQ_MONO_EXP`,LEQ_MONO_EXP);;
save_thm (`LESS_IMP_LESS_0`,LESS_IMP_LESS_0);;
save_thm (`INV_MULT`,INV_MULT);;
save_thm (`DIV_MOD`,DIV_MOD);;
save_thm (`DIV_MOD_UNIQUE`,DIV_MOD_UNIQUE);;
save_thm (`DIV_MOD_MULT_ADD`,DIV_MOD_MULT_ADD);;
save_thm (`DIV_MOD_LESS`,DIV_MOD_LESS);;
save_thm (`DIV_MOD_0`,DIV_MOD_0);;
save_thm (`DIV_MOD_SUC`,DIV_MOD_SUC);;
save_thm (`DIV_MOD_SUC_CASES`,DIV_MOD_SUC_CASES);;
save_thm (`DIV_SUC_LESS_OR_EQ`,DIV_SUC_LESS_OR_EQ);;
save_thm (`DIV_ADD_LESS_OR_EQ`,DIV_ADD_LESS_OR_EQ);;
save_thm (`LESS_EQ_MONO_DIV`,LESS_EQ_MONO_DIV);;


quit();;



















