--- /dev/null
+(* ========================================================================= *)
+(* Proof that provability is definable; weak form of Godel's theorem. *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* Auxiliary predicate: all numbers in an iterated-pair "list". *)
+(* ------------------------------------------------------------------------- *)
+
+let ALLN_DEF =
+ let th = prove
+ (`!P. ?ALLN. !z.
+ ALLN z <=>
+ if ?x y. z = NPAIR x y
+ then P (@x. ?y. NPAIR x y = z) /\
+ ALLN (@y. ?x. NPAIR x y = z)
+ else T`,
+ GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN
+ REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ BINOP_TAC THENL [ALL_TAC; FIRST_ASSUM MATCH_MP_TAC] THEN
+ FIRST_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN
+ REWRITE_TAC[NPAIR_INJ; RIGHT_EXISTS_AND_THM; EXISTS_REFL;
+ SELECT_REFL; NPAIR_LT; LEFT_EXISTS_AND_THM]) in
+ new_specification ["ALLN"] (REWRITE_RULE[SKOLEM_THM] th);;
+
+let ALLN = prove
+ (`(ALLN P 0 <=> T) /\
+ (ALLN P (NPAIR x y) <=> P x /\ ALLN P y)`,
+ REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [ALLN_DEF] THEN
+ REWRITE_TAC[NPAIR_NONZERO] THEN
+ REWRITE_TAC[NPAIR_INJ; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN
+ REWRITE_TAC[EXISTS_REFL; GSYM EXISTS_REFL]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Valid term. *)
+(* ------------------------------------------------------------------------- *)
+
+let TERM1 = new_definition
+ `TERM1 x y <=>
+ (?l u. (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/
+ (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/
+ (?n s t l. ((n = 3) \/ (n = 4)) /\
+ (x = NPAIR s (NPAIR t l)) /\
+ (y = NPAIR (NPAIR n (NPAIR s t)) l))`;;
+
+let TERM = new_definition
+ `TERM n <=> RTC TERM1 0 (NPAIR n 0)`;;
+
+let isagterm = new_definition
+ `isagterm n <=> ?t. n = gterm t`;;
+
+let TERM_LEMMA1 = prove
+ (`!x y. TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[TERM1] THEN
+ REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagterm] THEN
+ MESON_TAC[gterm; NUMBER_SURJ]);;
+
+let TERM_LEMMA2 = prove
+ (`!t a. RTC TERM1 a (NPAIR (gterm t) a)`,
+ MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[gterm] THEN
+ MESON_TAC[RTC_INC; RTC_TRANS; TERM1]);;
+
+let TERM_THM = prove
+ (`!n. TERM n <=> ?t. n = gterm t`,
+ GEN_TAC THEN REWRITE_TAC[TERM] THEN EQ_TAC THENL
+ [ALL_TAC; MESON_TAC[TERM_LEMMA2]] THEN
+ SUBGOAL_THEN `!x y. RTC TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y`
+ (fun th -> MESON_TAC[ALLN; isagterm; th]) THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[TERM_LEMMA1] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Valid formula. *)
+(* ------------------------------------------------------------------------- *)
+
+let FORM1 = new_definition
+ `FORM1 x y <=>
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/
+ (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\
+ TERM s /\ TERM t /\
+ (x = l) /\
+ (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/
+ (?p l. (x = NPAIR p l) /\
+ (y = NPAIR (NPAIR 4 p) l)) \/
+ (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\
+ (x = NPAIR p (NPAIR q l)) /\
+ (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/
+ (?n u p l. ((n = 9) \/ (n = 10)) /\
+ (x = NPAIR p l) /\
+ (y = NPAIR (NPAIR n (NPAIR u p)) l))`;;
+
+let FORM = new_definition
+ `FORM n <=> RTC FORM1 0 (NPAIR n 0)`;;
+
+let isagform = new_definition
+ `isagform n <=> ?t. n = gform t`;;
+
+let FORM_LEMMA1 = prove
+ (`!x y. FORM1 x y ==> ALLN isagform x ==> ALLN isagform y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FORM1] THEN
+ REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagform] THEN
+ MESON_TAC[gform; TERM_THM; NUMBER_SURJ]);;
+
+(*** Following really blows up if we just use FORM1
+ *** instead of manually breaking up the conjuncts
+ ***)
+
+let FORM_LEMMA2 = prove
+ (`!p a. RTC FORM1 a (NPAIR (gform p) a)`,
+ MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[gform] THEN
+ REPEAT CONJ_TAC THEN
+ MESON_TAC[RTC_INC; RTC_TRANS; TERM_THM;
+ REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`]
+ (snd(EQ_IMP_RULE (SPEC_ALL FORM1)))]);;
+
+let FORM_THM = prove
+ (`!n. FORM n <=> ?p. n = gform p`,
+ GEN_TAC THEN REWRITE_TAC[FORM] THEN EQ_TAC THENL
+ [ALL_TAC; MESON_TAC[FORM_LEMMA2]] THEN
+ SUBGOAL_THEN `!x y. RTC FORM1 x y ==> ALLN isagform x ==> ALLN isagform y`
+ (fun th -> MESON_TAC[ALLN; isagform; th]) THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FORM_LEMMA1] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Term without particular variable. *)
+(* ------------------------------------------------------------------------- *)
+
+let FREETERM1 = new_definition
+ `FREETERM1 m x y <=>
+ (?l u. ~(u = m) /\ (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/
+ (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/
+ (?n s t l. ((n = 3) \/ (n = 4)) /\
+ (x = NPAIR s (NPAIR t l)) /\
+ (y = NPAIR (NPAIR n (NPAIR s t)) l))`;;
+
+let FREETERM = new_definition
+ `FREETERM m n <=> RTC (FREETERM1 m) 0 (NPAIR n 0)`;;
+
+let isafterm = new_definition
+ `isafterm m n <=> ?t. ~(m IN IMAGE number (FVT t)) /\ (n = gterm t)`;;
+
+let ISAFTERM = prove
+ (`(~(number x = m) ==> isafterm m (NPAIR 0 (number x))) /\
+ isafterm m (NPAIR 1 0) /\
+ (isafterm m t ==> isafterm m (NPAIR 2 t)) /\
+ (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 3 (NPAIR s t))) /\
+ (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 4 (NPAIR s t)))`,
+ REWRITE_TAC[isafterm; gterm] THEN REPEAT CONJ_TAC THENL
+ [DISCH_TAC THEN EXISTS_TAC `V x`;
+ EXISTS_TAC `Z`;
+ DISCH_THEN(X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `Suc t`;
+ DISCH_THEN(CONJUNCTS_THEN2
+ (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC)
+ (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN
+ EXISTS_TAC `s ++ t`;
+ DISCH_THEN(CONJUNCTS_THEN2
+ (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC)
+ (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN
+ EXISTS_TAC `s ** t`] THEN
+ ASM_REWRITE_TAC[gterm; FVT; IMAGE_UNION; NOT_IN_EMPTY; IN_SING; IN_UNION;
+ IMAGE_CLAUSES]);;
+
+let FREETERM_LEMMA1 = prove
+ (`!m x y. FREETERM1 m x y ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM1] THEN
+ REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN
+ MESON_TAC[ISAFTERM; NUMBER_SURJ]);;
+
+let FREETERM_LEMMA2 = prove
+ (`!m t a. ~(m IN IMAGE number (FVT t))
+ ==> RTC (FREETERM1 m) a (NPAIR (gterm t) a)`,
+ GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN
+ REWRITE_TAC[gterm; FVT; NOT_IN_EMPTY; IN_SING; IN_UNION;
+ IMAGE_CLAUSES; IMAGE_UNION] THEN
+ REWRITE_TAC[DE_MORGAN_THM] THEN
+ REPEAT CONJ_TAC THEN
+ TRY(REPEAT GEN_TAC THEN DISCH_THEN
+ (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN
+ ASM_REWRITE_TAC[] THEN
+ MESON_TAC[RTC_INC; RTC_TRANS; FREETERM1]);;
+
+let FREETERM_THM = prove
+ (`!m n. FREETERM m n <=> ?t. ~(m IN IMAGE number (FVT(t))) /\ (n = gterm t)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM] THEN EQ_TAC THENL
+ [ALL_TAC; MESON_TAC[FREETERM_LEMMA2]] THEN
+ SUBGOAL_THEN `!x y. RTC (FREETERM1 m) x y
+ ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y`
+ (fun th -> MESON_TAC[ALLN; isagterm; isafterm; th]) THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREETERM_LEMMA1] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Formula without particular free variable. *)
+(* ------------------------------------------------------------------------- *)
+
+let FREEFORM1 = new_definition
+ `FREEFORM1 m x y <=>
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/
+ (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/
+ (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\
+ FREETERM m s /\ FREETERM m t /\
+ (x = l) /\
+ (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/
+ (?p l. (x = NPAIR p l) /\
+ (y = NPAIR (NPAIR 4 p) l)) \/
+ (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\
+ (x = NPAIR p (NPAIR q l)) /\
+ (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/
+ (?n u p l. ((n = 9) \/ (n = 10)) /\
+ (x = NPAIR p l) /\
+ (y = NPAIR (NPAIR n (NPAIR u p)) l)) \/
+ (?n p l. ((n = 9) \/ (n = 10)) /\
+ (x = l) /\ FORM p /\
+ (y = NPAIR (NPAIR n (NPAIR m p)) l))`;;
+
+let FREEFORM = new_definition
+ `FREEFORM m n <=> RTC (FREEFORM1 m) 0 (NPAIR n 0)`;;
+
+let isafform = new_definition
+ `isafform m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`;;
+
+let ISAFFORM = prove
+ (`isafform m (NPAIR 0 0) /\
+ isafform m (NPAIR 0 1) /\
+ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 1 (NPAIR s t))) /\
+ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 2 (NPAIR s t))) /\
+ (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 3 (NPAIR s t))) /\
+ (isafform m p ==> isafform m (NPAIR 4 p)) /\
+ (isafform m p /\ isafform m q ==> isafform m (NPAIR 5 (NPAIR p q))) /\
+ (isafform m p /\ isafform m q ==> isafform m (NPAIR 6 (NPAIR p q))) /\
+ (isafform m p /\ isafform m q ==> isafform m (NPAIR 7 (NPAIR p q))) /\
+ (isafform m p /\ isafform m q ==> isafform m (NPAIR 8 (NPAIR p q))) /\
+ (isafform m p ==> isafform m (NPAIR 9 (NPAIR x p))) /\
+ (isafform m p ==> isafform m (NPAIR 10 (NPAIR x p))) /\
+ (isagform p ==> isafform m (NPAIR 9 (NPAIR m p))) /\
+ (isagform p ==> isafform m (NPAIR 10 (NPAIR m p)))`,
+ let tac0 = DISCH_THEN(X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC)
+ and tac1 =
+ DISCH_THEN(CONJUNCTS_THEN2
+ (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC)
+ (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC))
+ and tac2 =
+ DISCH_THEN(CONJUNCTS_THEN2
+ (X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC)
+ (X_CHOOSE_THEN `q:form` STRIP_ASSUME_TAC)) in
+ REWRITE_TAC[isafform; gform; isagform; isafterm] THEN REPEAT CONJ_TAC THENL
+ [EXISTS_TAC `False`;
+ EXISTS_TAC `True`;
+ tac1 THEN EXISTS_TAC `s === t`;
+ tac1 THEN EXISTS_TAC `s << t`;
+ tac1 THEN EXISTS_TAC `s <<= t`;
+ tac0 THEN EXISTS_TAC `Not p`;
+ tac2 THEN EXISTS_TAC `p && q`;
+ tac2 THEN EXISTS_TAC `p || q`;
+ tac2 THEN EXISTS_TAC `p --> q`;
+ tac2 THEN EXISTS_TAC `p <-> q`;
+ tac0 THEN EXISTS_TAC `!!(denumber x) p`;
+ tac0 THEN EXISTS_TAC `??(denumber x) p`;
+ tac0 THEN EXISTS_TAC `!!(denumber m) p`;
+ tac0 THEN EXISTS_TAC `??(denumber m) p`] THEN
+ ASM_REWRITE_TAC[FV; IN_DELETE; NOT_IN_EMPTY; IN_SING; IN_UNION; gform;
+ NUMBER_DENUMBER; IMAGE_CLAUSES; IMAGE_UNION] THEN
+ ASM SET_TAC[NUMBER_DENUMBER]);;
+
+let FREEFORM_LEMMA1 = prove
+ (`!x y. FREEFORM1 m x y ==> ALLN (isafform m) x ==> ALLN (isafform m) y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM1] THEN
+ REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN
+ REWRITE_TAC[FREETERM_THM; GSYM isafterm] THEN
+ REWRITE_TAC[FORM_THM; GSYM isagform] THEN MESON_TAC[ISAFFORM]);;
+
+let FREEFORM_LEMMA2 = prove
+ (`!m p a. ~(m IN IMAGE number (FV p))
+ ==> RTC (FREEFORM1 m) a (NPAIR (gform p) a)`,
+ let lemma = prove
+ (`m IN IMAGE number (s DELETE k) <=>
+ m IN IMAGE number s /\ ~(m = number k)`,
+ SET_TAC[NUMBER_INJ]) in
+ GEN_TAC THEN MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[gform; FV; NOT_IN_EMPTY; IN_DELETE; IN_SING; IN_UNION;
+ lemma; IMAGE_UNION; IMAGE_CLAUSES] THEN
+ REWRITE_TAC[DE_MORGAN_THM] THEN
+ REPEAT CONJ_TAC THEN
+ TRY(REPEAT GEN_TAC THEN DISCH_THEN
+ (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN
+ ASM_REWRITE_TAC[] THEN
+ MESON_TAC[RTC_INC; RTC_TRANS; FORM_THM;
+ REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`;
+ FREETERM_THM]
+ (snd(EQ_IMP_RULE (SPEC_ALL FREEFORM1)))]);;
+
+let FREEFORM_THM = prove
+ (`!m n. FREEFORM m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM] THEN EQ_TAC THENL
+ [ALL_TAC; MESON_TAC[FREEFORM_LEMMA2]] THEN
+ SUBGOAL_THEN `!x y. RTC (FREEFORM1 m) x y
+ ==> ALLN (isafform m) x ==> ALLN (isafform m) y`
+ (fun th -> MESON_TAC[ALLN; isagform; isafform; th]) THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREEFORM_LEMMA1] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetization of logical axioms --- autogenerated. *)
+(* ------------------------------------------------------------------------- *)
+
+let AXIOM,AXIOM_THM =
+ let th0 = prove
+ (`((?x p. P (number x) (gform p) /\ ~(x IN FV(p))) <=>
+ (?x p. FREEFORM x p /\ P x p)) /\
+ ((?x t. P (number x) (gterm t) /\ ~(x IN FVT(t))) <=>
+ (?x t. FREETERM x t /\ P x t))`,
+ REWRITE_TAC[FREETERM_THM; FREEFORM_THM] THEN CONJ_TAC THEN
+ REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+ ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN
+ GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
+ REWRITE_TAC[UNWIND_THM2; IN_IMAGE] THEN
+ ASM_MESON_TAC[IN_IMAGE; NUMBER_DENUMBER])
+ and th1 = prove
+ (`((?p. P(gform p)) <=> (?p. FORM(p) /\ P p)) /\
+ ((?t. P(gterm t)) <=> (?t. TERM(t) /\ P t))`,
+ MESON_TAC[FORM_THM; TERM_THM])
+ and th2 = prove
+ (`(?x. P(number x)) <=> (?x. P x)`,
+ MESON_TAC[NUMBER_DENUMBER]) in
+ let th = (REWRITE_CONV[GSYM GFORM_INJ] THENC
+ REWRITE_CONV[gform; gterm] THENC
+ REWRITE_CONV[th0] THENC REWRITE_CONV[th1] THENC
+ REWRITE_CONV[th2] THENC
+ REWRITE_CONV[RIGHT_AND_EXISTS_THM])
+ (rhs(concl(SPEC `a:form` axiom_CASES))) in
+ let dtm = mk_eq(`(AXIOM:num->bool) a`,
+ subst [`a:num`,`gform a`] (rhs(concl th))) in
+ let AXIOM = new_definition dtm in
+ let AXIOM_THM = prove
+ (`!p. AXIOM(gform p) <=> axiom p`,
+ REWRITE_TAC[axiom_CASES; AXIOM; th]) in
+ AXIOM,AXIOM_THM;;
+
+(* ------------------------------------------------------------------------- *)
+(* Prove also that all AXIOMs are in fact numbers of formulas. *)
+(* ------------------------------------------------------------------------- *)
+
+let GTERM_CASES_ALT = prove
+ (`(gterm u = NPAIR 0 x <=> u = V(denumber x))`,
+ REWRITE_TAC[GSYM GTERM_CASES; NUMBER_DENUMBER]);;
+
+let GFORM_CASES_ALT = prove
+ (`(gform r = NPAIR 9 (NPAIR x n) <=>
+ (?p. r = !!(denumber x) p /\ gform p = n)) /\
+ (gform r = NPAIR 10 (NPAIR x n) <=>
+ (?p. r = ??(denumber x) p /\ gform p = n))`,
+ REWRITE_TAC[GSYM GFORM_CASES; NUMBER_DENUMBER]);;
+
+let AXIOM_FORMULA = prove
+ (`!a. AXIOM a ==> ?p. a = gform p`,
+ REWRITE_TAC[AXIOM; FREEFORM_THM; FREETERM_THM; FORM_THM; TERM_THM] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ CONV_TAC(BINDER_CONV SYM_CONV) THEN
+ REWRITE_TAC[GFORM_CASES; GTERM_CASES;
+ GTERM_CASES_ALT; GFORM_CASES_ALT] THEN
+ MESON_TAC[NUMBER_DENUMBER]);;
+
+let AXIOM_THM_STRONG = prove
+ (`!a. AXIOM a <=> ?p. axiom p /\ (a = gform p)`,
+ MESON_TAC[AXIOM_THM; AXIOM_FORMULA]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetization of the full logical inference rules. *)
+(* ------------------------------------------------------------------------- *)
+
+let PROV1 = new_definition
+ `PROV1 A x y <=>
+ (?a. (AXIOM a \/ a IN A) /\ (y = NPAIR a x)) \/
+ (?p q l. (x = NPAIR (NPAIR 7 (NPAIR p q)) (NPAIR p l)) /\
+ (y = NPAIR q l)) \/
+ (?p u l. (x = NPAIR p l) /\ (y = NPAIR (NPAIR 9 (NPAIR u p)) l))`;;
+
+let PROV = new_definition
+ `PROV A n <=> RTC (PROV1 A) 0 (NPAIR n 0)`;;
+
+let isaprove = new_definition
+ `isaprove A n <=> ?p. (gform p = n) /\ A |-- p`;;
+
+let PROV_LEMMA1 = prove
+ (`!A p q. PROV1 (IMAGE gform A) x y
+ ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[PROV1] THEN
+ REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN
+ REWRITE_TAC[isaprove] THEN REPEAT CONJ_TAC THEN
+ REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
+ [ASM_MESON_TAC[AXIOM_THM_STRONG; proves_RULES];
+ ASM_MESON_TAC[IN_IMAGE; GFORM_INJ; proves_RULES; gform];
+ ALL_TAC;
+ ASM_MESON_TAC[NUMBER_DENUMBER;
+ IN_IMAGE; GFORM_INJ; proves_RULES; gform]] THEN
+ REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+ ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+ MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ] THEN
+ MAP_EVERY X_GEN_TAC [`P:form`; `Q:form`] THEN
+ DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 (STRIP_ASSUME_TAC o GSYM) MP_TAC) THEN
+ ASM_REWRITE_TAC[GFORM_INJ] THEN
+ REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2] THEN
+ ASM_MESON_TAC[proves_RULES]);;
+
+let PROV_LEMMA2 = prove
+ (`!A p. A |-- p ==> !a. RTC (PROV1 (IMAGE gform A)) a (NPAIR (gform p) a)`,
+ GEN_TAC THEN MATCH_MP_TAC proves_INDUCT THEN REWRITE_TAC[gform] THEN
+ MESON_TAC[RTC_INC; RTC_TRANS; PROV1; IN_IMAGE; AXIOM_THM]);;
+
+let PROV_THM_STRONG = prove
+ (`!A n. PROV (IMAGE gform A) n <=> ?p. A |-- p /\ (gform p = n)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[PROV] THEN EQ_TAC THENL
+ [ALL_TAC; MESON_TAC[PROV_LEMMA2]] THEN
+ SUBGOAL_THEN
+ `!x y. RTC (PROV1 (IMAGE gform A)) x y
+ ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y`
+ (fun th -> MESON_TAC[ALLN; isaprove; GFORM_INJ; th]) THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[PROV_LEMMA1] THEN MESON_TAC[]);;
+
+let PROV_THM = prove
+ (`!A p. PROV (IMAGE gform A) (gform p) <=> A |-- p`,
+ MESON_TAC[PROV_THM_STRONG; GFORM_INJ]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Now really objectify all that. *)
+(* ------------------------------------------------------------------------- *)
+
+let arith_term1,ARITH_TERM1 = OBJECTIFY [] "arith_term1" TERM1;;
+
+let FV_TERM1 = prove
+ (`!s t. FV(arith_term1 s t) = (FVT s) UNION (FVT t)`,
+ FV_TAC[arith_term1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_term,ARITH_TERM = OBJECTIFY_RTC ARITH_TERM1 "arith_term" TERM;;
+
+let FV_TERM = prove
+ (`!t. FV(arith_term t) = FVT t`,
+ FV_TAC[arith_term; FV_RTC; FV_TERM1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_form1,ARITH_FORM1 =
+ OBJECTIFY [ARITH_TERM] "arith_form1" FORM1;;
+
+let FV_FORM1 = prove
+ (`!s t. FV(arith_form1 s t) = (FVT s) UNION (FVT t)`,
+ FV_TAC[arith_form1; FV_TERM; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_form,ARITH_FORM = OBJECTIFY_RTC ARITH_FORM1 "arith_form" FORM;;
+
+let FV_FORM = prove
+ (`!t. FV(arith_form t) = FVT t`,
+ FV_TAC[arith_form; FV_RTC; FV_FORM1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_freeterm1,ARITH_FREETERM1 =
+ OBJECTIFY [] "arith_freeterm1" FREETERM1;;
+
+let FV_FREETERM1 = prove
+ (`!s t u. FV(arith_freeterm1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`,
+ FV_TAC[arith_freeterm1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_freeterm,ARITH_FREETERM =
+ OBJECTIFY_RTCP ARITH_FREETERM1 "arith_freeterm" FREETERM;;
+
+let FV_FREETERM = prove
+ (`!s t. FV(arith_freeterm s t) = (FVT s) UNION (FVT t)`,
+ FV_TAC[arith_freeterm; FV_RTCP; FV_FREETERM1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_freeform1,ARITH_FREEFORM1 =
+ OBJECTIFY [ARITH_FREETERM; ARITH_FORM] "arith_freeform1" FREEFORM1;;
+
+let FV_FREEFORM1 = prove
+ (`!s t u. FV(arith_freeform1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`,
+ FV_TAC[arith_freeform1; FV_FREETERM; FV_FORM; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_freeform,ARITH_FREEFORM =
+ OBJECTIFY_RTCP ARITH_FREEFORM1 "arith_freeform" FREEFORM;;
+
+let FV_FREEFORM = prove
+ (`!s t. FV(arith_freeform s t) = (FVT s) UNION (FVT t)`,
+ FV_TAC[arith_freeform; FV_RTCP; FV_FREEFORM1; FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_axiom,ARITH_AXIOM =
+ OBJECTIFY [ARITH_FORM; ARITH_FREEFORM; ARITH_FREETERM; ARITH_TERM]
+ "arith_axiom" AXIOM;;
+
+let FV_AXIOM = prove
+ (`!t. FV(arith_axiom t) = FVT t`,
+ FV_TAC[arith_axiom; FV_FREETERM; FV_FREEFORM; FV_TERM; FV_FORM;
+ FVT_PAIR; FVT_NUMERAL]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Parametrization by A means it's easier to do these cases manually. *)
+(* ------------------------------------------------------------------------- *)
+
+let arith_prov1,ARITH_PROV1 =
+ let PROV1' = REWRITE_RULE[IN] PROV1 in
+ OBJECTIFY [ASSUME `!v n. holds v (A n) <=> Ax (termval v n)`; ARITH_AXIOM]
+ "arith_prov1" PROV1';;
+
+let ARITH_PROV1 = prove
+ (`(!v t. holds v (A t) <=> Ax(termval v t))
+ ==> (!v s t.
+ holds v (arith_prov1 A s t) <=>
+ PROV1 Ax (termval v s) (termval v t))`,
+ REWRITE_TAC[arith_prov1; holds; HOLDS_FORMSUBST] THEN
+ REPEAT STRIP_TAC THEN
+ ASM_REWRITE_TAC[termval; valmod; o_THM; ARITH_EQ; ARITH_PAIR;
+ TERMVAL_NUMERAL; ARITH_AXIOM] THEN
+ REWRITE_TAC[PROV1; IN]);;
+
+let FV_PROV1 = prove
+ (`(!t. FV(A t) = FVT t) ==> !s t. FV(arith_prov1 A s t) = FVT(s) UNION FVT(t)`,
+ FV_TAC[arith_prov1; FV_AXIOM; FVT_NUMERAL; FVT_PAIR]);;
+
+let arith_prov = new_definition
+ `arith_prov A n =
+ formsubst ((0 |-> n) V)
+ (arith_rtc (arith_prov1 A) (numeral 0)
+ (arith_pair (V 0) (numeral 0)))`;;
+
+let ARITH_PROV = prove
+ (`!Ax A. (!v t. holds v (A t) <=> Ax(termval v t))
+ ==> !v n. holds v (arith_prov A n) <=> PROV Ax (termval v n)`,
+ REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ARITH_PROV1) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN
+ CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN DISCH_TAC THEN
+ ASM_REWRITE_TAC[arith_prov; HOLDS_FORMSUBST] THEN
+ REWRITE_TAC[termval; valmod; o_DEF; TERMVAL_NUMERAL; ARITH_PAIR] THEN
+ REWRITE_TAC[PROV]);;
+
+let FV_PROV = prove
+ (`(!t. FV(A t) = FVT t) ==> !t. FV(arith_prov A t) = FVT t`,
+ FV_TAC[arith_prov; FV_PROV1; FV_RTC; FVT_NUMERAL; FVT_PAIR]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Our final conclusion. *)
+(* ------------------------------------------------------------------------- *)
+
+let PROV_DEFINABLE = prove
+ (`!Ax. definable {gform p | p IN Ax} ==> definable {gform p | Ax |-- p}`,
+ GEN_TAC THEN REWRITE_TAC[definable; IN_ELIM_THM] THEN
+ DISCH_THEN(X_CHOOSE_THEN `A:form` (X_CHOOSE_TAC `x:num`)) THEN
+ MP_TAC(SPECL [`IMAGE gform Ax`; `\t. formsubst ((x |-> t) V) A`]
+ ARITH_PROV) THEN
+ REWRITE_TAC[] THEN ANTS_TAC THENL
+ [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN
+ REWRITE_TAC[o_THM; VALMOD_BASIC; IMAGE; IN_ELIM_THM];
+ ALL_TAC] THEN
+ REWRITE_TAC[PROV_THM_STRONG] THEN DISCH_TAC THEN
+ EXISTS_TAC `arith_prov (\t. formsubst ((x |-> t) V) A) (V x)` THEN
+ ASM_REWRITE_TAC[termval] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* The crudest conclusion: truth undefinable, provability not, so: *)
+(* ------------------------------------------------------------------------- *)
+
+let GODEL_CRUDE = prove
+ (`!Ax. definable {gform p | p IN Ax} ==> ?p. ~(true p <=> Ax |-- p)`,
+ REPEAT STRIP_TAC THEN MP_TAC TARSKI_THEOREM THEN
+ FIRST_X_ASSUM(MP_TAC o MATCH_MP PROV_DEFINABLE) THEN
+ MATCH_MP_TAC(TAUT `(~c ==> (a <=> b)) ==> a ==> ~b ==> c`) THEN
+ SIMP_TAC[NOT_EXISTS_THM]);;
--- /dev/null
+(* ========================================================================= *)
+(* Definability in arithmetic of important notions. *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* Pairing operation. *)
+(* ------------------------------------------------------------------------- *)
+
+let NPAIR = new_definition
+ `NPAIR x y = (x + y) EXP 2 + x + 1`;;
+
+let NPAIR_NONZERO = prove
+ (`!x y. ~(NPAIR x y = 0)`,
+ REWRITE_TAC[NPAIR; ADD_EQ_0; ARITH]);;
+
+let NPAIR_INJ_LEMMA = prove
+ (`x1 + y1 < x2 + y2 ==> NPAIR x1 y1 < NPAIR x2 y2`,
+ STRIP_TAC THEN REWRITE_TAC[NPAIR; EXP_2] THEN
+ REWRITE_TAC[ARITH_RULE `x + y + 1 < u + v + 1 <=> x + y < u + v`] THEN
+ MATCH_MP_TAC LTE_TRANS THEN
+ EXISTS_TAC `SUC(x1 + y1) * SUC(x1 + y1)` THEN CONJ_TAC THENL
+ [ARITH_TAC; ASM_MESON_TAC[LE_TRANS; LE_ADD; LE_MULT2; LE_SUC_LT]]);;
+
+let NPAIR_INJ = prove
+ (`(NPAIR x y = NPAIR x' y') <=> (x = x') /\ (y = y')`,
+ EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `x' + y' = x + y` ASSUME_TAC THENL
+ [ASM_MESON_TAC[LT_CASES; NPAIR_INJ_LEMMA; LT_REFL];
+ UNDISCH_TAC `NPAIR x y = NPAIR x' y'` THEN
+ UNDISCH_TAC `x' + y' = x + y` THEN
+ SIMP_TAC[NPAIR; EXP_2] THEN ARITH_TAC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Decreasingness. *)
+(* ------------------------------------------------------------------------- *)
+
+let NPAIR_LT = prove
+ (`!x y. x < NPAIR x y /\ y < NPAIR x y`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[NPAIR] THEN
+ REWRITE_TAC[ARITH_RULE `x < a + x + 1`] THEN
+ MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `(x + y) + x + 1` THEN
+ REWRITE_TAC[LE_ADD_RCANCEL; EXP_2; LE_SQUARE_REFL] THEN
+ ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Auxiliary concepts needed. NB: these are Delta so can be negated freely. *)
+(* ------------------------------------------------------------------------- *)
+
+let primepow = new_definition
+ `primepow p x <=> prime(p) /\ ?n. x = p EXP n`;;
+
+let divides_DELTA = prove
+ (`m divides n <=> ?x. x <= n /\ n = m * x`,
+ REWRITE_TAC[divides] THEN ASM_CASES_TAC `m = 0` THENL
+ [ASM_REWRITE_TAC[MULT_CLAUSES] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN
+ AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(m = 0) ==> 1 <= m`)) THEN
+ SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM;
+ RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN
+ MESON_TAC[]);;
+
+let prime_DELTA = prove
+ (`prime(p) <=> 2 <= p /\ !n. n < p ==> n divides p ==> n = 1`,
+ ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[ARITH; PRIME_0] THEN
+ ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[ARITH; PRIME_1] THEN EQ_TAC THENL
+ [ASM_MESON_TAC[prime; LT_REFL; PRIME_GE_2];
+ ASM_MESON_TAC[prime; DIVIDES_LE; LE_LT]]);;
+
+let primepow_DELTA = prove
+ (`primepow p x <=>
+ prime(p) /\ ~(x = 0) /\
+ !z. z <= x ==> z divides x ==> z = 1 \/ p divides z`,
+ REWRITE_TAC[primepow; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
+ ASM_CASES_TAC `prime(p)` THEN
+ ASM_REWRITE_TAC[] THEN EQ_TAC THENL
+ [DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN
+ ASM_REWRITE_TAC[EXP_EQ_0] THEN
+ ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THENL
+ [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `z:num` o MATCH_MP PRIME_COPRIME) THEN
+ ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `p divides z` THEN ASM_REWRITE_TAC[] THEN
+ ONCE_REWRITE_TAC[COPRIME_SYM] THEN
+ DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP) THEN
+ ASM_MESON_TAC[COPRIME; DIVIDES_REFL];
+ SPEC_TAC(`x:num`,`x:num`) THEN MATCH_MP_TAC num_WF THEN
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = 1` THENL
+ [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[EXP]; ALL_TAC] THEN
+ FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN
+ STRIP_TAC THEN
+ UNDISCH_TAC `!z. z <= x ==> z divides x /\ ~(z = 1) ==> p divides z` THEN
+ DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
+ DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `q = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `q <= x` ASSUME_TAC THENL
+ [ASM_MESON_TAC[DIVIDES_LE]; ASM_REWRITE_TAC[]] THEN
+ SUBGOAL_THEN `p divides x` MP_TAC THENL
+ [ASM_MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN
+ REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_TAC `y:num`) THEN
+ SUBGOAL_THEN `y < x` (ANTE_RES_THEN MP_TAC) THENL
+ [MATCH_MP_TAC PRIME_FACTOR_LT THEN
+ EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
+ ASM_CASES_TAC `y = 0` THENL
+ [UNDISCH_TAC `x = p * y` THEN ASM_REWRITE_TAC[MULT_CLAUSES]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `!z. z <= y ==> z divides y /\ ~(z = 1) ==> p divides z`
+ (fun th -> REWRITE_TAC[th]) THENL
+ [REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE
+ [IMP_IMP]) THEN
+ REPEAT CONJ_TAC THENL
+ [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `y:num` THEN
+ ASM_REWRITE_TAC[] THEN
+ GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `y = 1 * y`] THEN
+ REWRITE_TAC[LE_MULT_RCANCEL] THEN
+ ASM_REWRITE_TAC[GSYM NOT_LT] THEN
+ REWRITE_TAC[num_CONV `1`; LT; DE_MORGAN_THM] THEN
+ ASM_MESON_TAC[PRIME_0; PRIME_1];
+ ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVIDES_LMUL THEN
+ ASM_REWRITE_TAC[];
+ ASM_REWRITE_TAC[]];
+ DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN
+ EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[EXP]]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Sigma-representability of reflexive transitive closure. *)
+(* ------------------------------------------------------------------------- *)
+
+let PSEQ = new_recursive_definition num_RECURSION
+ `(PSEQ p f m 0 = 0) /\
+ (PSEQ p f m (SUC n) = f m + p * PSEQ p f (SUC m) n)`;;
+
+let PSEQ_SPLIT = prove
+ (`!f p n m r.
+ PSEQ p f m (n + r) = PSEQ p f m n + p EXP n * PSEQ p f (m + n) r`,
+ GEN_TAC THEN GEN_TAC THEN
+ INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP; MULT_CLAUSES; PSEQ] THEN
+ ASM_REWRITE_TAC[GSYM ADD_ASSOC; EQ_ADD_LCANCEL] THEN
+ REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_AC; ADD_CLAUSES]);;
+
+let PSEQ_1 = prove
+ (`PSEQ p f m 1 = f m`,
+ REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; MULT_CLAUSES; PSEQ]);;
+
+let PSEQ_BOUND = prove
+ (`!n. ~(p = 0) /\ (!i. i < n ==> f i < p) ==> PSEQ p f 0 n < p EXP n`,
+ ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN
+ INDUCT_TAC THENL [REWRITE_TAC[PSEQ; EXP; ARITH]; ALL_TAC] THEN
+ DISCH_TAC THEN
+ MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`]
+ PSEQ_SPLIT) THEN
+ SIMP_TAC[ADD1; ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN
+ MATCH_MP_TAC LTE_TRANS THEN
+ EXISTS_TAC `p EXP n + p EXP n * PSEQ p f n 1` THEN
+ ASM_SIMP_TAC[LT_ADD_RCANCEL; ARITH_RULE `i < n ==> i < SUC n`] THEN
+ REWRITE_TAC[ARITH_RULE `p + p * q = p * (q + 1)`] THEN
+ ASM_REWRITE_TAC[EXP_ADD; LE_MULT_LCANCEL; EXP_EQ_0] THEN
+ MATCH_MP_TAC(ARITH_RULE `x < p ==> x + 1 <= p`) THEN
+ ASM_SIMP_TAC[EXP_1; PSEQ_1; LT]);;
+
+let RELPOW_LEMMA_1 = prove
+ (`(f 0 = x) /\
+ (f n = y) /\
+ (!i. i < n ==> R (f i) (f(SUC i)))
+ ==> ?p. (?i. i <= n /\ p <= SUC(FACT(f i))) /\
+ prime p /\
+ (?m. m < p EXP (SUC n) /\
+ x < p /\ y < p /\
+ (?qx. m = x + p * qx) /\
+ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\
+ !q. q < p EXP n
+ ==> primepow p q
+ ==> ?r. r < q /\
+ ?a. a < p /\
+ ?b. b < p /\
+ R a b /\
+ ?s. s <= m /\
+ (m =
+ r + q * (a + p * (b + p * s))))`,
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `?j. j <= n /\ !i. i <= n ==> f i <= f j` MP_TAC THENL
+ [SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN
+ INDUCT_TAC THENL
+ [SIMP_TAC[LE] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN
+ FIRST_ASSUM(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN
+ DISJ_CASES_TAC(ARITH_RULE `f(SUC n) <= f(j) \/ f(j) <= f(SUC n)`) THENL
+ [EXISTS_TAC `j:num` THEN
+ ASM_SIMP_TAC[ARITH_RULE `j <= n ==> j <= SUC n`] THEN
+ REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN
+ ASM_SIMP_TAC[] THEN ASM_MESON_TAC[];
+ EXISTS_TAC `SUC n` THEN REWRITE_TAC[LE_REFL] THEN
+ REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN
+ ASM_SIMP_TAC[LE_REFL] THEN ASM_MESON_TAC[LE_TRANS]];
+ ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `ibig:num` STRIP_ASSUME_TAC) THEN
+ MP_TAC(SPEC `(f:num->num) ibig` EUCLID_BOUND) THEN
+ DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `p:num` THEN CONJ_TAC THENL
+ [EXISTS_TAC `ibig:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
+ SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL
+ [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN
+ CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
+ SUBGOAL_THEN `!i. i <= n ==> f i < p` ASSUME_TAC THENL
+ [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN
+ EXISTS_TAC `PSEQ p f 0 (SUC n)` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC PSEQ_BOUND THEN ASM_SIMP_TAC[LT_SUC_LE]; ALL_TAC] THEN
+ CONJ_TAC THENL [ASM_MESON_TAC[LE_0]; ALL_TAC] THEN
+ CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN
+ REPEAT CONJ_TAC THENL
+ [ASM_REWRITE_TAC[PSEQ] THEN MESON_TAC[];
+ MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`] PSEQ_SPLIT) THEN
+ ASM_SIMP_TAC[ADD1; ADD_CLAUSES] THEN
+ DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f 0 n` THEN
+ ASM_SIMP_TAC[PSEQ_BOUND; PSEQ_1; LT_IMP_LE];
+ ALL_TAC] THEN
+ ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN
+ ASM_SIMP_TAC[primepow; LEFT_IMP_EXISTS_THM] THEN
+ GEN_TAC THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN
+ ASM_REWRITE_TAC[LT_EXP] THEN STRIP_TAC THEN
+ MP_TAC(SPECL [`f:num->num`; `p:num`; `i:num`; `0`; `SUC n - i`]
+ PSEQ_SPLIT) THEN
+ ASM_SIMP_TAC[ARITH_RULE `i < n ==> (i + SUC n - i = SUC n)`] THEN
+ DISCH_THEN(K ALL_TAC) THEN
+ EXISTS_TAC `PSEQ p f 0 i` THEN REWRITE_TAC[EQ_ADD_LCANCEL] THEN
+ ASM_REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ADD_CLAUSES] THEN
+ CONJ_TAC THENL
+ [ASM_MESON_TAC[PSEQ_BOUND; LT_TRANS; LT_IMP_LE]; ALL_TAC] THEN
+ MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i:num`; `n - i`]
+ PSEQ_SPLIT) THEN
+ ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i = SUC n - i)`] THEN
+ DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f i 1` THEN
+ ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN
+ ASM_SIMP_TAC[PSEQ_1; LT_IMP_LE] THEN
+ MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i + 1`; `n - i - 1`]
+ PSEQ_SPLIT) THEN
+ ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i - 1 = n - i)`] THEN
+ DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f (i + 1) 1` THEN
+ ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN
+ ASM_SIMP_TAC[PSEQ_1; ARITH_RULE `i < n ==> i + 1 <= n`] THEN
+ ASM_SIMP_TAC[GSYM ADD1] THEN REWRITE_TAC[ADD1] THEN
+ ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN
+ REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC; ADD_ASSOC] THEN
+ MATCH_MP_TAC(ARITH_RULE `1 * a <= c ==> a <= b + c`) THEN
+ REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN
+ ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; EXP_EQ_0]);;
+
+let RELPOW_LEMMA_2 = prove
+ (`prime p /\ x < p /\ y < p /\
+ (?qx. m = x + p * qx) /\
+ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\
+ (!q. q < p EXP n
+ ==> primepow p q
+ ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\
+ r < q /\ a < p /\ b < p /\ R a b)
+ ==> RELPOW n R x y`,
+ STRIP_TAC THEN REWRITE_TAC[RELPOW_SEQUENCE] THEN
+ EXISTS_TAC `\i. (m DIV (p EXP i)) MOD p` THEN
+ SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL
+ [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN
+ REWRITE_TAC[EXP; DIV_1] THEN REPEAT CONJ_TAC THENL
+ [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `qx:num` THEN
+ ASM_REWRITE_TAC[ADD_AC; MULT_AC];
+ MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN
+ REWRITE_TAC[ASSUME `y < p`; MULT_CLAUSES; ADD_CLAUSES] THEN
+ MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `ry:num` THEN
+ REWRITE_TAC[ASSUME `m = ry + p EXP n * y`] THEN
+ ASM_REWRITE_TAC[ADD_AC; MULT_AC];
+ ALL_TAC] THEN
+ X_GEN_TAC `i:num` THEN DISCH_TAC THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `p EXP i`) THEN
+ ASM_SIMP_TAC[LT_EXP; PRIME_GE_2] THEN
+ ASM_REWRITE_TAC[primepow] THEN
+ W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL
+ [MESON_TAC[]; ALL_TAC] THEN
+ DISCH_THEN(REPEAT_TCL CHOOSE_THEN MP_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC) THEN
+ UNDISCH_TAC `(R:num->num->bool) a b` THEN
+ MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN BINOP_TAC THENL
+ [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `b + p * s` THEN
+ ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[ADD_AC; MULT_AC];
+ MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `s:num` THEN ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r + a * p EXP i` THEN
+ CONJ_TAC THENL
+ [REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN
+ REWRITE_TAC[ADD_AC; MULT_AC]; ALL_TAC] THEN
+ MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `p EXP i + a * p EXP i` THEN
+ ASM_REWRITE_TAC[LT_ADD_RCANCEL] THEN
+ REWRITE_TAC[ARITH_RULE `p + q * p = (q + 1) * p`] THEN
+ ASM_REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0] THEN
+ UNDISCH_TAC `a < p` THEN ARITH_TAC]);;
+
+let RELPOW_LEMMA = prove
+ (`RELPOW n R x y <=>
+ ?m p. prime p /\ x < p /\ y < p /\
+ (?qx. m = x + p * qx) /\
+ (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\
+ !q. q < p EXP n
+ ==> primepow p q
+ ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\
+ r < q /\ a < p /\ b < p /\ R a b`,
+ EQ_TAC THENL
+ [ALL_TAC; REWRITE_TAC[RELPOW_LEMMA_2; LEFT_IMP_EXISTS_THM]] THEN
+ REWRITE_TAC[RELPOW_SEQUENCE] THEN
+ DISCH_THEN(CHOOSE_THEN(MP_TAC o GEN_ALL o MATCH_MP RELPOW_LEMMA_1)) THEN
+ REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
+ GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN
+ GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
+ SIMP_TAC[] THEN MESON_TAC[]);;
+
+let RTC_SIGMA = prove
+ (`RTC R x y <=>
+ ?m p Q. primepow p Q /\ x < p /\ y < p /\
+ (?s. m = x + p * s) /\
+ (?r. r < Q /\ (m = r + Q * y)) /\
+ !q. q < Q
+ ==> primepow p q
+ ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\
+ r < q /\ a < p /\ b < p /\ R a b`,
+ REWRITE_TAC[RTC_RELPOW] THEN EQ_TAC THENL
+ [DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
+ REWRITE_TAC[RELPOW_LEMMA] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
+ MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
+ DISCH_TAC THEN EXISTS_TAC `p EXP n` THEN ASM_REWRITE_TAC[primepow] THEN
+ MESON_TAC[];
+ REWRITE_TAC[primepow] THEN
+ ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN
+ REWRITE_TAC[GSYM primepow] THEN
+ GEN_REWRITE_TAC (LAND_CONV o funpow 3 BINDER_CONV)
+ [LEFT_AND_EXISTS_THM] THEN
+ GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV)
+ [SWAP_EXISTS_THM] THEN
+ REWRITE_TAC[UNWIND_THM2] THEN
+ GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
+ GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
+ REWRITE_TAC[GSYM RELPOW_LEMMA]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Partially automate actual definability in object language. *)
+(* ------------------------------------------------------------------------- *)
+
+let arith_pair = new_definition
+ `arith_pair s t = (s ++ t) ** (s ++ t) ++ s ++ Suc Z`;;
+
+let ARITH_PAIR = prove
+ (`!s t v. termval v (arith_pair s t) = NPAIR (termval v s) (termval v t)`,
+ REWRITE_TAC[termval; arith_pair; NPAIR; EXP_2; ARITH_SUC]);;
+
+let FVT_PAIR = prove
+ (`FVT(arith_pair s t) = FVT(s) UNION FVT(t)`,
+ REWRITE_TAC[arith_pair; FVT] THEN SET_TAC[]);;
+
+let OBJECTIFY =
+ let is_add = is_binop `(+):num->num->num`
+ and is_mul = is_binop `(*):num->num->num`
+ and is_le = is_binop `(<=):num->num->bool`
+ and is_lt = is_binop `(<):num->num->bool`
+ and zero_tm = `0`
+ and suc_tm = `SUC`
+ and osuc_tm = `Suc`
+ and oz_tm = `Z`
+ and ov_tm = `V`
+ and oadd_tm = `(++)`
+ and omul_tm = `(**)`
+ and oeq_tm = `(===)`
+ and ole_tm = `(<<=)`
+ and olt_tm = `(<<)`
+ and oiff_tm = `(<->)`
+ and oimp_tm = `(-->)`
+ and oand_tm = `(&&)`
+ and oor_tm = `(||)`
+ and onot_tm = `Not`
+ and oall_tm = `!!`
+ and oex_tm = `??`
+ and numeral_tm = `numeral`
+ and assign_tm = `(|->):num->term->(num->term)->(num->term)`
+ and term_ty = `:term`
+ and form_ty = `:form`
+ and num_ty = `:num`
+ and formsubst_tm = `formsubst`
+ and holdsv_tm = `holds v`
+ and v_tm = `v:num->num` in
+ let objectify1 fn op env tm = mk_comb(op,fn env (rand tm)) in
+ let objectify2 fn op env tm =
+ mk_comb(mk_comb(op,fn env (lhand tm)),fn env (rand tm)) in
+ fun defs ->
+ let defs' = [TERMVAL_NUMERAL; ARITH_PAIR] @ defs in
+ let rec objectify_term env tm =
+ if is_var tm then mk_comb(ov_tm,apply env tm)
+ else if tm = zero_tm then oz_tm
+ else if is_numeral tm then mk_comb(numeral_tm,tm)
+ else if is_add tm then objectify2 objectify_term oadd_tm env tm
+ else if is_mul tm then objectify2 objectify_term omul_tm env tm
+ else if is_comb tm & rator tm = suc_tm
+ then objectify1 objectify_term osuc_tm env tm
+ else
+ let f,args = strip_comb tm in
+ let args' = map (objectify_term env) args in
+ try let dth = find
+ (fun th -> fst(strip_comb(rand(snd(strip_forall(concl th))))) = f)
+ defs' in
+ let l,r = dest_eq(snd(strip_forall(concl dth))) in
+ list_mk_comb(fst(strip_comb(rand l)),args')
+ with Failure _ ->
+ let ty = itlist (mk_fun_ty o type_of) args' form_ty in
+ let v = mk_var(fst(dest_var f),ty) in
+ list_mk_comb(v,args') in
+ let rec objectify_formula env fm =
+ if is_forall fm then
+ let x,bod = dest_forall fm in
+ let n = mk_small_numeral
+ (itlist (max o dest_small_numeral) (ran env) 0 + 1) in
+ mk_comb(mk_comb(oall_tm,n),objectify_formula ((x |-> n) env) bod)
+ else if is_exists fm then
+ let x,bod = dest_exists fm in
+ let n = mk_small_numeral
+ (itlist (max o dest_small_numeral) (ran env) 0 + 1) in
+ mk_comb(mk_comb(oex_tm,n),objectify_formula ((x |-> n) env) bod)
+ else if is_iff fm then objectify2 objectify_formula oiff_tm env fm
+ else if is_imp fm then objectify2 objectify_formula oimp_tm env fm
+ else if is_conj fm then objectify2 objectify_formula oand_tm env fm
+ else if is_disj fm then objectify2 objectify_formula oor_tm env fm
+ else if is_neg fm then objectify1 objectify_formula onot_tm env fm
+ else if is_le fm then objectify2 objectify_term ole_tm env fm
+ else if is_lt fm then objectify2 objectify_term olt_tm env fm
+ else if is_eq fm then objectify2 objectify_term oeq_tm env fm
+ else objectify_term env fm in
+ fun nam th ->
+ let ptm,tm = dest_eq(snd(strip_forall(concl th))) in
+ let vs = filter (fun v -> type_of v = num_ty) (snd(strip_comb ptm)) in
+ let ns = 1--(length vs) in
+ let env = itlist2 (fun v n -> v |-> mk_small_numeral n) vs ns undefined in
+ let otm = objectify_formula env tm in
+ let vs' = map (fun v -> mk_var(fst(dest_var v),term_ty)) vs in
+ let stm = itlist2
+ (fun v n a -> mk_comb(mk_comb(mk_comb(assign_tm,mk_small_numeral
+ n),v),a))
+ vs' ns ov_tm in
+ let rside = mk_comb(mk_comb(formsubst_tm,stm),otm) in
+ let vs'' = subtract (frees rside) vs' @ vs' in
+ let lty = itlist (mk_fun_ty o type_of) vs'' (type_of rside) in
+ let lside = list_mk_comb(mk_var(nam,lty),vs'') in
+ let def = mk_eq(lside,rside) in
+ let dth = new_definition def in
+ let clside = lhs(snd(strip_forall(concl dth))) in
+ let etm = mk_comb(holdsv_tm,clside) in
+ let thm =
+ (REWRITE_CONV ([dth; holds; HOLDS_FORMSUBST] @ defs') THENC
+ REWRITE_CONV [termval; ARITH_EQ; o_THM; valmod] THENC
+ GEN_REWRITE_CONV I [GSYM th]) etm in
+ dth,DISCH_ALL (GENL (v_tm::vs') thm);;
+
+(* ------------------------------------------------------------------------- *)
+(* Some sort of common tactic for free variables. *)
+(* ------------------------------------------------------------------------- *)
+
+let FV_TAC ths =
+ let ths' = ths @
+ [FV; FORMSUBST_FV; FVT; TERMSUBST_FVT; IN_ELIM_THM;
+ NOT_IN_EMPTY; IN_UNION; IN_DELETE; IN_SING]
+ and tac =
+ REWRITE_TAC[DISJ_ACI; TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN
+ REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN
+ REWRITE_TAC[valmod; ARITH_EQ; FVT] THEN REWRITE_TAC[DISJ_ACI] in
+ REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
+ ASM_REWRITE_TAC ths' THEN tac THEN ASM_SIMP_TAC ths' THEN tac;;
+
+(* ------------------------------------------------------------------------- *)
+(* So do the formula-level stuff (more) automatically. *)
+(* ------------------------------------------------------------------------- *)
+
+let arith_divides,ARITH_DIVIDES =
+ OBJECTIFY [] "arith_divides" divides_DELTA;;
+
+let FV_DIVIDES = prove
+ (`!s t. FV(arith_divides s t) = FVT(s) UNION FVT(t)`,
+ FV_TAC[arith_divides]);;
+
+let arith_prime,ARITH_PRIME =
+ OBJECTIFY [ARITH_DIVIDES] "arith_prime" prime_DELTA;;
+
+let FV_PRIME = prove
+ (`!t. FV(arith_prime t) = FVT(t)`,
+ FV_TAC[arith_prime; FVT_NUMERAL; FV_DIVIDES]);;
+
+let arith_primepow,ARITH_PRIMEPOW =
+ OBJECTIFY [ARITH_PRIME; ARITH_DIVIDES] "arith_primepow" primepow_DELTA;;
+
+let FV_PRIMEPOW = prove
+ (`!s t. FV(arith_primepow s t) = FVT(s) UNION FVT(t)`,
+ FV_TAC[arith_primepow; FVT_NUMERAL; FV_DIVIDES; FV_PRIME]);;
+
+let arith_rtc,ARITH_RTC =
+ OBJECTIFY
+ [ARITH_PRIMEPOW;
+ ASSUME `!v s t. holds v (R s t) <=> r (termval v s) (termval v t)`]
+ "arith_rtc" RTC_SIGMA;;
+
+let FV_RTC = prove
+ (`!R. (!s t. FV(R s t) = FVT(s) UNION FVT(t))
+ ==> !s t. FV(arith_rtc R s t) = FVT(s) UNION FVT(t)`,
+ FV_TAC[arith_rtc; FV_PRIMEPOW]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Automate RTC constructions, including parametrized ones. *)
+(* ------------------------------------------------------------------------- *)
+
+let OBJECTIFY_RTC =
+ let pth = prove
+ (`(!v x y. holds v (f x y) <=> f' (termval v x) (termval v y))
+ ==> !g. (!n. g n = formsubst ((0 |-> n) V)
+ (arith_rtc f (numeral 0)
+ (arith_pair (V 0) (numeral 0))))
+ ==> !v n. holds v (g n) <=> RTC f' 0 (NPAIR (termval v n) 0)`,
+ DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN SIMP_TAC[HOLDS_FORMSUBST] THEN
+ REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod;
+ ARITH_PAIR; TERMVAL_NUMERAL]) in
+ fun def nam th ->
+ let th1 = MATCH_MP pth def in
+ let v = fst(dest_forall(concl th1)) in
+ let th2 = SPEC (mk_var(nam,type_of v)) th1 in
+ let dth = new_definition (fst(dest_imp(concl th2))) in
+ dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);;
+
+let RTCP = new_definition
+ `RTCP R m x y <=> RTC (R m) x y`;;
+
+let RTCP_SIGMA = REWRITE_RULE[GSYM RTCP]
+ (INST [`(R:num->num->num->bool) m`,`R:num->num->bool`] RTC_SIGMA);;
+
+let arith_rtcp,ARITH_RTCP =
+ OBJECTIFY
+ [ARITH_PRIMEPOW;
+ ASSUME `!v m s t. holds v (R m s t) <=>
+ r (termval v m) (termval v s) (termval v t)`]
+ "arith_rtcp" RTCP_SIGMA;;
+
+let ARITH_RTC_PARAMETRIZED = REWRITE_RULE[RTCP] ARITH_RTCP;;
+
+let FV_RTCP = prove
+ (`!R. (!s t u. FV(R s t u) = FVT(s) UNION FVT(t) UNION FVT(u))
+ ==> !s t u. FV(arith_rtcp R s t u) = FVT(s) UNION FVT(t) UNION FVT(u)`,
+ FV_TAC[arith_rtcp; FV_PRIMEPOW]);;
+
+let OBJECTIFY_RTCP =
+ let pth = prove
+ (`(!v m x y. holds v (f m x y) <=>
+ f' (termval v m) (termval v x) (termval v y))
+ ==> !g. (!m n. g m n = formsubst ((1 |-> m) ((0 |-> n) V))
+ (arith_rtcp f (V 1) (numeral 0)
+ (arith_pair (V 0) (numeral 0))))
+ ==> !v m n. holds v (g m n) <=>
+ RTC (f' (termval v m)) 0 (NPAIR (termval v n) 0)`,
+ DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC_PARAMETRIZED) THEN
+ SIMP_TAC[HOLDS_FORMSUBST] THEN
+ REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod;
+ ARITH_PAIR; TERMVAL_NUMERAL]) in
+ fun def nam th ->
+ let th1 = MATCH_MP pth def in
+ let v = fst(dest_forall(concl th1)) in
+ let th2 = SPEC (mk_var(nam,type_of v)) th1 in
+ let dth = new_definition (fst(dest_imp(concl th2))) in
+ dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);;
+
+(* ------------------------------------------------------------------------- *)
+(* Generic result about primitive recursion. *)
+(* ------------------------------------------------------------------------- *)
+
+let PRIMREC_SIGMA = prove
+ (`(fn 0 = e) /\
+ (!n. fn (SUC n) = f (fn n) n)
+ ==> !x y. RTC (\x y. ?n r. (x = NPAIR n r) /\ (y = NPAIR (SUC n) (f r n)))
+ (NPAIR 0 e) (NPAIR x y) <=>
+ (fn(x) = y)`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN
+ ONCE_REWRITE_TAC[RTC_CASES_L] THEN ASM_REWRITE_TAC[NPAIR_INJ; NOT_SUC] THEN
+ REWRITE_TAC[SUC_INJ; RIGHT_AND_EXISTS_THM] THEN GEN_TAC THEN
+ ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+ GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
+ ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
+ ASM_REWRITE_TAC[UNWIND_THM2] THEN ASM_MESON_TAC[]);;
+
+let arith_primrecstep = new_definition
+ `arith_primrecstep R s t =
+ (formsubst ((0 |-> s) ((1 |-> t) V))
+ (?? 2 (?? 3 (?? 4
+ (V 0 === arith_pair (V 2) (V 3) &&
+ V 1 === arith_pair (Suc(V 2)) (V 4) &&
+ R (V 3) (V 2) (V 4))))))`;;
+
+let ARITH_PRIMRECSTEP = prove
+ (`(!v x y z. holds v (R x y z) <=>
+ (f (termval v x) (termval v y) = termval v z))
+ ==> !v s t. holds v (arith_primrecstep R s t) <=>
+ ?n r. (termval v s = NPAIR n r) /\
+ (termval v t = NPAIR (SUC n) (f r n))`,
+ STRIP_TAC THEN
+ ASM_REWRITE_TAC[arith_primrecstep; holds; HOLDS_FORMSUBST] THEN
+ ASM_REWRITE_TAC[termval; valmod; o_DEF; ARITH_EQ; ARITH_PAIR] THEN
+ MESON_TAC[]);;
+
+let FV_PRIMRECSTEP = prove
+ (`!R. (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u)))
+ ==> !s t. FV(arith_primrecstep R s t) = FVT(s) UNION FVT(t)`,
+ REWRITE_TAC[SUBSET; IN_UNION] THEN FV_TAC[arith_primrecstep; FVT_PAIR] THEN
+ GEN_TAC THEN MATCH_MP_TAC(TAUT `~a ==> (a \/ b <=> b)`) THEN
+ DISCH_THEN(CHOOSE_THEN
+ (CONJUNCTS_THEN2(ANTE_RES_THEN MP_TAC) ASSUME_TAC)) THEN
+ ASM_REWRITE_TAC[FVT; IN_SING]);;
+
+let arith_primrec = new_definition
+ `arith_primrec R c s t =
+ arith_rtc (arith_primrecstep R)
+ (arith_pair Z c) (arith_pair s t)`;;
+
+let ARITH_PRIMREC = prove
+ (`!fn e f R c.
+ (fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) /\
+ (!v. termval v c = e) /\
+ (!v x y z. holds v (R x y z) <=>
+ (f (termval v x) (termval v y) = termval v z))
+ ==> !v s t. holds v (arith_primrec R c s t) <=>
+ (fn(termval v s) = termval v t)`,
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PRIMRECSTEP) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN
+ CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN
+ SIMP_TAC[arith_primrec; ARITH_PAIR; termval] THEN
+ ASM_SIMP_TAC[PRIMREC_SIGMA]);;
+
+let FV_PRIMREC = prove
+ (`!R c. (FVT c = {}) /\
+ (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u)))
+ ==> !s t. FV(arith_primrec R c s t) = FVT(s) UNION FVT(t)`,
+ REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[arith_primrec] THEN
+ ASM_SIMP_TAC[FV_RTC; FVT_PAIR; FV_PRIMRECSTEP;
+ UNION_EMPTY; UNION_ACI; FVT]);;
--- /dev/null
+(* ========================================================================= *)
+(* Derived properties of provability. *)
+(* ========================================================================= *)
+
+let negativef = new_definition
+ `negativef p = ?q. p = q --> False`;;
+
+let negatef = new_definition
+ `negatef p = if negativef p then @q. p = q --> False else p --> False`;;
+
+(* ------------------------------------------------------------------------- *)
+(* The primitive basis, separated into its named components. *)
+(* ------------------------------------------------------------------------- *)
+
+let axiom_addimp = prove
+ (`!A p q. A |-- p --> (q --> p)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_distribimp = prove
+ (`!A p q r. A |-- (p --> q --> r) --> (p --> q) --> (p --> r)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_doubleneg = prove
+ (`!A p. A |-- ((p --> False) --> False) --> p`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_allimp = prove
+ (`!A x p q. A |-- (!!x (p --> q)) --> (!!x p) --> (!!x q)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_impall = prove
+ (`!A x p. ~(x IN FV p) ==> A |-- p --> !!x p`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_existseq = prove
+ (`!A x t. ~(x IN FVT t) ==> A |-- ??x (V x === t)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_eqrefl = prove
+ (`!A t. A |-- t === t`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_funcong = prove
+ (`(!A s t. A |-- s === t --> Suc s === Suc t) /\
+ (!A s t u v. A |-- s === t --> u === v --> s ++ u === t ++ v) /\
+ (!A s t u v. A |-- s === t --> u === v --> s ** u === t ** v)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_predcong = prove
+ (`(!A s t u v. A |-- s === t --> u === v --> s === u --> t === v) /\
+ (!A s t u v. A |-- s === t --> u === v --> s << u --> t << v) /\
+ (!A s t u v. A |-- s === t --> u === v --> s <<= u --> t <<= v)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_iffimp1 = prove
+ (`!A p q. A |-- (p <-> q) --> p --> q`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_iffimp2 = prove
+ (`!A p q. A |-- (p <-> q) --> q --> p`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_impiff = prove
+ (`!A p q. A |-- (p --> q) --> (q --> p) --> (p <-> q)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_true = prove
+ (`A |-- True <-> (False --> False)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_not = prove
+ (`!A p. A |-- Not p <-> (p --> False)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_and = prove
+ (`!A p q. A |-- (p && q) <-> (p --> q --> False) --> False`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_or = prove
+ (`!A p q. A |-- (p || q) <-> Not(Not p && Not q)`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let axiom_exists = prove
+ (`!A x p. A |-- (??x p) <-> Not(!!x (Not p))`,
+ MESON_TAC[proves_RULES; axiom_RULES]);;
+
+let assume = prove
+ (`!A p. p IN A ==> A |-- p`,
+ MESON_TAC[proves_RULES]);;
+
+let modusponens = prove
+ (`!A p. A |-- (p --> q) /\ A |-- p ==> A |-- q`,
+ MESON_TAC[proves_RULES]);;
+
+let gen = prove
+ (`!A p x. A |-- p ==> A |-- !!x p`,
+ MESON_TAC[proves_RULES]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Now some theorems corresponding to derived rules. *)
+(* ------------------------------------------------------------------------- *)
+
+let iff_imp1 = prove
+ (`!A p q. A |-- p <-> q ==> A |-- p --> q`,
+ MESON_TAC[modusponens; axiom_iffimp1]);;
+
+let iff_imp2 = prove
+ (`!A p q. A |-- p <-> q ==> A |-- q --> p`,
+ MESON_TAC[modusponens; axiom_iffimp2]);;
+
+let imp_antisym = prove
+ (`!A p q. A |-- p --> q /\ A |-- q --> p ==> A |-- p <-> q`,
+ MESON_TAC[modusponens; axiom_impiff]);;
+
+let add_assum = prove
+ (`!A p q. A |-- q ==> A |-- p --> q`,
+ MESON_TAC[modusponens; axiom_addimp]);;
+
+let imp_refl = prove
+ (`!A p. A |-- p --> p`,
+ MESON_TAC[modusponens; axiom_distribimp; axiom_addimp]);;
+
+let imp_add_assum = prove
+ (`!A p q r. A |-- q --> r ==> A |-- (p --> q) --> (p --> r)`,
+ MESON_TAC[modusponens; axiom_distribimp; add_assum]);;
+
+let imp_unduplicate = prove
+ (`!A p q. A |-- p --> p --> q ==> A |-- p --> q`,
+ MESON_TAC[modusponens; axiom_distribimp; imp_refl]);;
+
+let imp_trans = prove
+ (`!A p q. A |-- p --> q /\ A |-- q --> r ==> A |-- p --> r`,
+ MESON_TAC[modusponens; imp_add_assum]);;
+
+let imp_swap = prove
+ (`!A p q r. A |-- p --> q --> r ==> A |-- q --> p --> r`,
+ MESON_TAC[imp_trans; axiom_addimp; modusponens; axiom_distribimp]);;
+
+let imp_trans_chain_2 = prove
+ (`!A p q1 q2 r. A |-- p --> q1 /\ A |-- p --> q2 /\ A |-- q1 --> q2 --> r
+ ==> A |-- p --> r`,
+ ASM_MESON_TAC[imp_trans; imp_swap; imp_unduplicate]);;
+
+
+
+(*****
+
+let imp_trans_chain = prove
+ (`!A p qs r. ALL (\q. A |-- p --> q) qs /\
+ A |-- ITLIST (-->) qs r
+ ==> A |-- p --> r`,
+ GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN
+ REWRITE_TAC[ALL; ITLIST] THENL
+ [ASM_MESON_TAC[add_assum]; ALL_TAC] THEN
+ REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC
+
+
+ASM_MESON_TAC[imp_trans; imp_swap; imp_unduplicate; axiom_distribimp;
+ modusponens; add_assum]
+
+add_assum] THEN
+ ... needs more thought. Maybe the REV
+
+ *****)
+
+
+let imp_trans_th = prove
+ (`!A p q r. A |-- (q --> r) --> (p --> q) --> (p --> r)`,
+ MESON_TAC[imp_trans; axiom_addimp; axiom_distribimp]);;
+
+let imp_add_concl = prove
+ (`!A p q r. A |-- p --> q ==> A |-- (q --> r) --> (p --> r)`,
+ MESON_TAC[modusponens; imp_swap; imp_trans_th]);;
+
+let imp_trans2 = prove
+ (`!A p q r s. A |-- p --> q --> r /\ A |-- r --> s ==> A |-- p --> q --> s`,
+ MESON_TAC[imp_add_assum; modusponens; imp_trans_th]);;
+
+let imp_swap_th = prove
+ (`!A p q r. A |-- (p --> q --> r) --> (q --> p --> r)`,
+ MESON_TAC[imp_trans; axiom_distribimp; imp_add_concl; axiom_addimp]);;
+
+let contrapos = prove
+ (`!A p q. A |-- p --> q ==> A |-- Not q --> Not p`,
+ MESON_TAC[imp_trans; iff_imp1; axiom_not; imp_add_concl; iff_imp2]);;
+
+let imp_truefalse = prove
+ (`!p q. A |-- (q --> False) --> p --> (p --> q) --> False`,
+ MESON_TAC[imp_trans; imp_trans_th; imp_swap_th]);;
+
+let imp_insert = prove
+ (`!A p q r. A |-- p --> r ==> A |-- p --> q --> r`,
+ MESON_TAC[imp_trans; axiom_addimp]);;
+
+let ex_falso = prove
+ (`!A p. A |-- False --> p`,
+ MESON_TAC[imp_trans; axiom_addimp; axiom_doubleneg]);;
+
+let imp_contr = prove
+ (`!A p q. A |-- (p --> False) --> (p --> r)`,
+ MESON_TAC[imp_add_assum; ex_falso]);;
+
+let imp_contrf = prove
+ (`!A p r. A |-- p --> negatef p --> r`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[negatef; negativef] THEN
+ COND_CASES_TAC THEN POP_ASSUM STRIP_ASSUME_TAC THEN
+ ASM_REWRITE_TAC[form_INJ] THEN
+ ASM_MESON_TAC[imp_contr; imp_swap]);;
+
+let contrad = prove
+ (`!A p. A |-- (p --> False) --> p ==> A |-- p`,
+ MESON_TAC[modusponens; axiom_distribimp; imp_refl; axiom_doubleneg]);;
+
+let bool_cases = prove
+ (`!p q. A |-- p --> q /\ A |-- (p --> False) --> q ==> A |-- q`,
+ MESON_TAC[contrad; imp_trans; imp_add_concl]);;
+
+(****
+
+let imp_front = prove
+ (`...` a bi more structure);;
+
+****)
+
+(*** This takes about a minute, but it does work ***)
+
+let imp_false_rule = prove
+ (`!p q r. A |-- (q --> False) --> p --> r
+ ==> A |-- ((p --> q) --> False) --> r`,
+ MESON_TAC[imp_add_concl; imp_add_assum; ex_falso; axiom_addimp; imp_swap;
+ imp_trans; axiom_doubleneg; imp_unduplicate]);;
+
+let imp_true_rule = prove
+ (`!A p q r. A |-- (p --> False) --> r /\ A |-- q --> r
+ ==> A |-- (p --> q) --> r`,
+ MESON_TAC[imp_insert; imp_swap; modusponens; imp_trans_th; bool_cases]);;
+
+let iff_def = prove
+ (`!A p q. A |-- (p <-> q) <-> (p --> q) && (q --> p)`,
+ REPEAT GEN_TAC THEN MATCH_MP_TAC imp_antisym THEN CONJ_TAC THENL
+ [SUBGOAL_THEN
+ `A |-- ((p --> q) --> (q --> p) --> False) --> (p <-> q) --> False`
+ ASSUME_TAC THENL
+ [ASM_MESON_TAC[imp_add_concl; imp_trans; axiom_distribimp; modusponens;
+ imp_swap; axiom_iffimp1; axiom_iffimp2];
+ ALL_TAC] THEN
+ ASM_MESON_TAC[imp_add_concl; imp_trans; imp_swap; imp_refl;
+ iff_imp2; axiom_and];
+ SUBGOAL_THEN
+ `A |-- (((p --> q) --> (q --> p) --> False) --> False)
+ --> ((p <-> q) --> False) --> False`
+ ASSUME_TAC THENL
+ [ASM_MESON_TAC[imp_swap; imp_trans_th; modusponens; imp_add_assum;
+ axiom_impiff; imp_add_concl];
+ ALL_TAC] THEN
+ ASM_MESON_TAC[imp_trans; iff_imp1; axiom_and; axiom_doubleneg]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Equality rules. *)
+(* ------------------------------------------------------------------------- *)
+
+let eq_sym = prove
+ (`!A s t. A |-- s === t --> t === s`,
+ MESON_TAC[axiom_eqrefl; modusponens; imp_swap; axiom_predcong]);;
+
+let icongruence_general = prove
+ (`!A p x s t tm.
+ A |-- s === t -->
+ termsubst ((x |-> s) v) tm === termsubst ((x |-> t) v) tm`,
+ GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
+ MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termsubst] THEN
+ REPEAT CONJ_TAC THENL
+ [MESON_TAC[axiom_eqrefl; add_assum];
+ GEN_TAC THEN REWRITE_TAC[valmod] THEN
+ COND_CASES_TAC THEN REWRITE_TAC[imp_refl] THEN
+ MESON_TAC[axiom_eqrefl; add_assum];
+ MESON_TAC[imp_trans; axiom_funcong];
+ MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate];
+ MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate]]);;
+
+let icongruence = prove
+ (`!A x s t tm.
+ A |-- s === t --> termsubst (x |=> s) tm === termsubst (x |=> t) tm`,
+ REWRITE_TAC[assign; icongruence_general]);;
+
+let icongruence_var = prove
+ (`!A x t tm.
+ A |-- V x === t --> tm === termsubst (x |=> t) tm`,
+ MESON_TAC[icongruence; TERMSUBST_TRIV; ASSIGN_TRIV]);;
+
+(* ------------------------------------------------------------------------- *)
+(* First-order rules. *)
+(* ------------------------------------------------------------------------- *)
+
+let gen_right = prove
+ (`!A x p q. ~(x IN FV(p)) /\ A |-- p --> q
+ ==> A |-- p --> !!x q`,
+ MESON_TAC[axiom_allimp; modusponens; gen; imp_trans; axiom_impall]);;
+
+let genimp = prove
+ (`!x p q. A |-- p --> q ==> A |-- (!!x p) --> (!!x q)`,
+ MESON_TAC[modusponens; axiom_allimp; gen]);;
+
+let eximp = prove
+ (`!x p q. A |-- p --> q ==> A |-- (??x p) --> (??x q)`,
+ MESON_TAC[contrapos; genimp; contrapos; imp_trans; iff_imp1; iff_imp2;
+ axiom_exists]);;
+
+let exists_imp = prove
+ (`!A x p q. A |-- ??x (p --> q) /\ ~(x IN FV(q)) ==> A |-- (!!x p) --> q`,
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `A |-- (q --> False) --> !!x (p --> Not(p --> q))`
+ ASSUME_TAC THENL
+ [MATCH_MP_TAC gen_right THEN
+ ASM_REWRITE_TAC[FV; IN_UNION; NOT_IN_EMPTY] THEN
+ ASM_MESON_TAC[iff_imp2; axiom_not; imp_trans2; imp_truefalse];
+ ALL_TAC] THEN
+ SUBGOAL_THEN `A |-- (q --> False) --> !!x p --> !!x (Not(p --> q))`
+ ASSUME_TAC THENL
+ [ASM_MESON_TAC[imp_trans; axiom_allimp]; ALL_TAC] THEN
+ SUBGOAL_THEN `A |-- ((q --> False) --> !!x (Not(p --> q)))
+ --> (q --> False) --> False`
+ ASSUME_TAC THENL
+ [ASM_MESON_TAC[modusponens; iff_imp1; axiom_exists; axiom_not; imp_trans_th];
+ ALL_TAC] THEN
+ ASM_MESON_TAC[imp_trans; imp_swap; axiom_doubleneg]);;
+
+let subspec = prove
+ (`!A x t p q. ~(x IN FVT(t)) /\ ~(x IN FV(q)) /\ A |-- V x === t --> p --> q
+ ==> A |-- (!!x p) --> q`,
+ MESON_TAC[exists_imp; modusponens; eximp; axiom_existseq]);;
+
+let subalpha = prove
+ (`!A x y p q. ((x = y) \/ ~(x IN FV(q)) /\ ~(y IN FV(p))) /\
+ A |-- V x === V y --> p --> q
+ ==> A |-- (!!x p) --> (!!y q)`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `x = y:num` THEN ASM_REWRITE_TAC[] THEN
+ STRIP_TAC THENL
+ [FIRST_X_ASSUM SUBST_ALL_TAC THEN
+ ASM_MESON_TAC[genimp; modusponens; axiom_eqrefl];
+ ALL_TAC] THEN
+ MATCH_MP_TAC gen_right THEN ASM_REWRITE_TAC[FV; IN_DELETE] THEN
+ MATCH_MP_TAC subspec THEN EXISTS_TAC `V y` THEN
+ ASM_REWRITE_TAC[FVT; IN_SING]);;
+
+let imp_mono_th = prove
+ (`A |-- (p' --> p) --> (q --> q') --> (p --> q) --> (p' --> q')`,
+ MESON_TAC[imp_trans; imp_swap; imp_trans_th]);;
+
+(* ------------------------------------------------------------------------- *)
+(* We'll perform induction on this measure. *)
+(* ------------------------------------------------------------------------- *)
+
+let complexity = new_recursive_definition form_RECURSION
+ `(complexity False = 1) /\
+ (complexity True = 1) /\
+ (!s t. complexity (s === t) = 1) /\
+ (!s t. complexity (s << t) = 1) /\
+ (!s t. complexity (s <<= t) = 1) /\
+ (!p. complexity (Not p) = complexity p + 3) /\
+ (!p q. complexity (p && q) = complexity p + complexity q + 6) /\
+ (!p q. complexity (p || q) = complexity p + complexity q + 16) /\
+ (!p q. complexity (p --> q) = complexity p + complexity q + 1) /\
+ (!p q. complexity (p <-> q) = 2 * (complexity p + complexity q) + 9) /\
+ (!x p. complexity (!!x p) = complexity p + 1) /\
+ (!x p. complexity (??x p) = complexity p + 8)`;;
+
+let COMPLEXITY_FORMSUBST = prove
+ (`!p i. complexity(formsubst i p) = complexity p`,
+ MATCH_MP_TAC form_INDUCT THEN
+ SIMP_TAC[formsubst; complexity; LET_DEF; LET_END_DEF]);;
+
+let isubst_general = prove
+ (`!A p x v s t. A |-- s === t
+ --> formsubst ((x |-> s) v) p
+ --> formsubst ((x |-> t) v) p`,
+ GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `complexity p` THEN
+ POP_ASSUM MP_TAC THEN SPEC_TAC(`p:form`,`p:form`) THEN
+ MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[formsubst; complexity] THEN
+ REPEAT CONJ_TAC THENL
+ [MESON_TAC[imp_refl; add_assum];
+ MESON_TAC[imp_refl; add_assum];
+ MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general];
+ MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general];
+ MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general];
+ X_GEN_TAC `p:form` THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `p --> False`) THEN
+ REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[formsubst] THEN
+ MESON_TAC[axiom_not; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2];
+ MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `(p --> q --> False) --> False`) THEN
+ REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[formsubst] THEN
+ MESON_TAC[axiom_and; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2];
+ MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `Not(Not p && Not q)`) THEN
+ REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[formsubst] THEN
+ MESON_TAC[axiom_or; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2];
+ MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(fun th -> MP_TAC(SPEC `p:form` th) THEN
+ MP_TAC(SPEC `q:form` th)) THEN
+ REWRITE_TAC[ARITH_RULE `p < p + q + 1 /\ q < p + q + 1`] THEN
+ MESON_TAC[imp_mono_th; eq_sym; imp_trans; imp_trans_chain_2];
+ MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `(p --> q) && (q --> p)`) THEN
+ REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[formsubst] THEN
+ MESON_TAC[iff_def; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2];
+ ALL_TAC;
+ MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `Not(!!x (Not p))`) THEN
+ REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[formsubst] THEN
+ REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
+ REWRITE_TAC[FV] THEN REPEAT LET_TAC THEN
+ ASM_MESON_TAC[axiom_exists; iff_imp1; iff_imp2; imp_swap; imp_trans;
+ imp_trans2]] THEN
+ MAP_EVERY X_GEN_TAC [`u:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN
+ REWRITE_TAC[ARITH_RULE `a < b + 1 <=> a <= b`] THEN DISCH_TAC THEN
+ MAP_EVERY X_GEN_TAC [`v:num`; `i:num->term`; `s:term`; `t:term`] THEN
+ MAP_EVERY ABBREV_TAC
+ [`x = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> s) i y)
+ then VARIANT (FV (formsubst ((u |-> V u) ((v |-> s) i)) p))
+ else u`;
+ `y = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> t) i y)
+ then VARIANT (FV (formsubst ((u |-> V u) ((v |-> t) i)) p))
+ else u`] THEN
+ REWRITE_TAC[LET_DEF; LET_END_DEF] THEN
+ SUBGOAL_THEN `~(x IN FV(formsubst ((v |-> s) i) (!!u p))) /\
+ ~(y IN FV(formsubst ((v |-> t) i) (!!u p)))`
+ STRIP_ASSUME_TAC THENL
+ [MAP_EVERY EXPAND_TAC ["x"; "y"] THEN CONJ_TAC THEN
+ (COND_CASES_TAC THENL
+ [ALL_TAC; ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM]] THEN
+ MATCH_MP_TAC NOT_IN_VARIANT THEN REWRITE_TAC[FV_FINITE] THEN
+ REWRITE_TAC[SUBSET; FORMSUBST_FV; IN_ELIM_THM; FV; IN_DELETE] THEN
+ REWRITE_TAC[valmod] THEN MESON_TAC[FVT; IN_SING]);
+ ALL_TAC] THEN
+ ASM_CASES_TAC `v:num = u` THENL
+ [ASM_REWRITE_TAC[VALMOD_VALMOD_BASIC] THEN
+ MATCH_MP_TAC add_assum THEN MATCH_MP_TAC subalpha THEN
+ ASM_SIMP_TAC[LE_REFL] THEN
+ ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
+ [UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`;
+ UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN
+ ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN
+ MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN
+ X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN
+ ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN
+ ASM_REWRITE_TAC[valmod; FVT; IN_SING];
+ ALL_TAC] THEN
+ SUBGOAL_THEN
+ `?z. ~(z IN FVT s) /\ ~(z IN FVT t) /\
+ A |-- !!x (formsubst ((u |-> V x) ((v |-> s) i)) p)
+ --> !!z (formsubst ((u |-> V z) ((v |-> s) i)) p) /\
+ A |-- !!z (formsubst ((u |-> V z) ((v |-> t) i)) p)
+ --> !!y (formsubst ((u |-> V y) ((v |-> t) i)) p)`
+ MP_TAC THENL
+ [ALL_TAC;
+ DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN
+ MATCH_MP_TAC imp_trans THEN
+ EXISTS_TAC `(!!z (formsubst ((v |-> s) ((u |-> V z) i)) p))
+ --> (!!z (formsubst ((v |-> t) ((u |-> V z) i)) p))` THEN
+ CONJ_TAC THENL
+ [MATCH_MP_TAC imp_trans THEN
+ EXISTS_TAC `!!z (formsubst ((v |-> s) ((u |-> V z) i)) p
+ --> formsubst ((v |-> t) ((u |-> V z) i)) p)` THEN
+ REWRITE_TAC[axiom_allimp] THEN
+ ASM_SIMP_TAC[complexity; LE_REFL; FV; IN_UNION; gen_right];
+ ALL_TAC] THEN
+ FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP VALMOD_SWAP th]) THEN
+ ASM_MESON_TAC[imp_mono_th; modusponens]] THEN
+ MP_TAC(SPEC
+ `FVT(s) UNION FVT(t) UNION
+ FV(formsubst ((u |-> V x) ((v |-> s) i)) p) UNION
+ FV(formsubst ((u |-> V y) ((v |-> t) i)) p)` VARIANT_FINITE) THEN
+ REWRITE_TAC[FINITE_UNION; FV_FINITE; FVT_FINITE] THEN
+ W(fun (_,w) -> ABBREV_TAC(mk_comb(`(=) (z:num)`,lhand(rand(lhand w))))) THEN
+ REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN
+ EXISTS_TAC `z:num` THEN ASM_REWRITE_TAC[] THEN
+ CONJ_TAC THEN MATCH_MP_TAC subalpha THEN ASM_SIMP_TAC[LE_REFL] THENL
+ [ASM_CASES_TAC `z:num = x` THEN ASM_REWRITE_TAC[] THEN
+ UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`;
+ ASM_CASES_TAC `z:num = y` THEN ASM_REWRITE_TAC[] THEN
+ UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN
+ ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN
+ MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN
+ X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN
+ ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN
+ ASM_REWRITE_TAC[valmod; FVT; IN_SING]);;
+
+let isubst = prove
+ (`!A p x s t. A |-- s === t
+ --> formsubst (x |=> s) p --> formsubst (x |=> t) p`,
+ REWRITE_TAC[assign; isubst_general]);;
+
+let isubst_var = prove
+ (`!A p x t. A |-- V x === t --> p --> formsubst (x |=> t) p`,
+ MESON_TAC[FORMSUBST_TRIV; ASSIGN_TRIV; isubst]);;
+
+let alpha = prove
+ (`!A x z p. ~(z IN FV p) ==> A |-- (!!x p) --> !!z (formsubst (x |=> V z) p)`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC subalpha THEN CONJ_TAC THENL
+ [ALL_TAC; MESON_TAC[isubst_var]] THEN
+ REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN
+ ASM_MESON_TAC[IN_SING; FVT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* To conclude cleanly, useful to have all variables. *)
+(* ------------------------------------------------------------------------- *)
+
+let VARS = new_recursive_definition form_RECURSION
+ `(VARS False = {}) /\
+ (VARS True = {}) /\
+ (VARS (s === t) = FVT s UNION FVT t) /\
+ (VARS (s << t) = FVT s UNION FVT t) /\
+ (VARS (s <<= t) = FVT s UNION FVT t) /\
+ (VARS (Not p) = VARS p) /\
+ (VARS (p && q) = VARS p UNION VARS q) /\
+ (VARS (p || q) = VARS p UNION VARS q) /\
+ (VARS (p --> q) = VARS p UNION VARS q) /\
+ (VARS (p <-> q) = VARS p UNION VARS q) /\
+ (VARS (!! x p) = x INSERT VARS p) /\
+ (VARS (?? x p) = x INSERT VARS p)`;;
+
+let VARS_FINITE = prove
+ (`!p. FINITE(VARS p)`,
+ MATCH_MP_TAC form_INDUCT THEN
+ ASM_SIMP_TAC[VARS; FINITE_RULES; FVT_FINITE; FINITE_UNION; FINITE_DELETE]);;
+
+let FV_SUBSET_VARS = prove
+ (`!p. FV(p) SUBSET VARS(p)`,
+ REWRITE_TAC[SUBSET] THEN
+ MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; VARS] THEN
+ REWRITE_TAC[IN_INSERT; IN_UNION; IN_DELETE] THEN MESON_TAC[]);;
+
+let TERMSUBST_TWICE_GENERAL = prove
+ (`!x z t v s. ~(z IN FVT s)
+ ==> (termsubst ((x |-> t) v) s =
+ termsubst ((z |-> t) v) (termsubst (x |=> V z) s))`,
+ GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
+ MATCH_MP_TAC term_INDUCT THEN
+ REWRITE_TAC[termsubst; ASSIGN; valmod; FVT; IN_SING; IN_UNION] THEN
+ MESON_TAC[termsubst; ASSIGN]);;
+
+let TERMSUBST_TWICE = prove
+ (`!x z t s. ~(z IN FVT s)
+ ==> (termsubst (x |=> t) s =
+ termsubst (z |=> t) (termsubst (x |=> V z) s))`,
+ MESON_TAC[assign; TERMSUBST_TWICE_GENERAL]);;
+
+let FORMSUBST_TWICE_GENERAL = prove
+ (`!z p x t v. ~(z IN VARS p)
+ ==> (formsubst ((z |-> t) v) (formsubst (x |=> V z) p) =
+ formsubst ((x |-> t) v) p)`,
+ GEN_TAC THEN MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[CONJ_ASSOC] THEN
+ GEN_REWRITE_TAC I [GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
+ [REWRITE_TAC[formsubst; ASSIGN; VARS; IN_UNION; DE_MORGAN_THM] THEN
+ MESON_TAC[TERMSUBST_TWICE_GENERAL];
+ ALL_TAC] THEN
+ CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`y:num`; `p:form`] THEN
+ (REWRITE_TAC[VARS; IN_INSERT; DE_MORGAN_THM] THEN
+ DISCH_THEN(fun th -> REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC th) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [formsubst] THEN
+ COND_CASES_TAC THENL
+ [FIRST_X_ASSUM(CHOOSE_THEN MP_TAC) THEN
+ REWRITE_TAC[ASSIGN; FV; IN_DELETE] THEN
+ ASM_MESON_TAC[FVT; IN_SING];
+ ALL_TAC] THEN
+ REWRITE_TAC[LET_DEF; LET_END_DEF] THEN
+ ASM_CASES_TAC `x:num = y` THENL
+ [ASM_REWRITE_TAC[assign; VALMOD_VALMOD_BASIC; VALMOD_REPEAT;
+ FORMSUBST_TRIV] THEN
+ MATCH_MP_TAC FORMSUBST_EQ THEN
+ ASM_REWRITE_TAC[valmod; FV; IN_DELETE] THEN
+ ASM_MESON_TAC[FV_SUBSET_VARS; SUBSET];
+ ALL_TAC] THEN
+ SUBGOAL_THEN
+ `(!t. (y |-> V y) (x |=> t) = x |=> t) /\
+ (!t. (y |-> V y) (z |=> t) = z |=> t)`
+ STRIP_ASSUME_TAC THENL
+ [REWRITE_TAC[assign] THEN ASM_MESON_TAC[VALMOD_SWAP; VALMOD_REPEAT];
+ ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC BINOP_CONV [formsubst] THEN
+ ASM_REWRITE_TAC[FV] THEN
+ SUBGOAL_THEN
+ `(?u. u IN (FV(formsubst (x |=> V z) p) DELETE y) /\
+ y IN FVT ((z |-> t) v u)) =
+ (?u. u IN (FV p DELETE y) /\ y IN FVT ((x |-> t) v u))`
+ SUBST1_TAC THENL
+ [REWRITE_TAC[FV; FORMSUBST_FV; IN_ELIM_THM; IN_DELETE; valmod; ASSIGN] THEN
+ ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
+ REWRITE_TAC[FVT; IN_SING] THEN
+ ASM_MESON_TAC[SUBSET; FV_SUBSET_VARS; FVT; IN_SING];
+ ALL_TAC] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
+ [ALL_TAC;
+ REWRITE_TAC[LET_DEF; LET_END_DEF; form_INJ] THEN
+ ASM_MESON_TAC[VALMOD_SWAP]] THEN
+ REWRITE_TAC[LET_DEF; LET_END_DEF; form_INJ] THEN
+ MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
+ [ALL_TAC; DISCH_THEN SUBST1_TAC] THEN
+ REPEAT AP_TERM_TAC THEN ASM_MESON_TAC[VALMOD_SWAP]));;
+
+let FORMSUBST_TWICE = prove
+ (`!z p x t. ~(z IN VARS p)
+ ==> (formsubst (z |=> t) (formsubst (x |=> V z) p) =
+ formsubst (x |=> t) p)`,
+ MESON_TAC[assign; FORMSUBST_TWICE_GENERAL]);;
+
+let ispec_lemma = prove
+ (`!A x p t. ~(x IN FVT(t)) ==> A |-- !!x p --> formsubst (x |=> t) p`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC subspec THEN
+ EXISTS_TAC `t:term` THEN ASM_REWRITE_TAC[isubst_var] THEN
+ ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN
+ ASM_MESON_TAC[FVT; IN_SING]);;
+
+let ispec = prove
+ (`!A x p t. A |-- !!x p --> formsubst (x |=> t) p`,
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `x IN FVT(t)` THEN
+ ASM_SIMP_TAC[ispec_lemma] THEN
+ ABBREV_TAC `z = VARIANT (FVT t UNION VARS p)` THEN
+ MATCH_MP_TAC imp_trans THEN
+ EXISTS_TAC `!!z (formsubst (x |=> V z) p)` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC alpha THEN EXPAND_TAC "z" THEN
+ MATCH_MP_TAC NOT_IN_VARIANT THEN
+ REWRITE_TAC[FINITE_UNION; SUBSET; IN_UNION] THEN
+ MESON_TAC[SUBSET; FVT_FINITE; VARS_FINITE; FV_SUBSET_VARS];
+ SUBGOAL_THEN
+ `formsubst (x |=> t) p =
+ formsubst (z |=> t) (formsubst (x |=> V z) p)`
+ SUBST1_TAC THENL
+ [MATCH_MP_TAC(GSYM FORMSUBST_TWICE); MATCH_MP_TAC ispec_lemma] THEN
+ EXPAND_TAC "z" THEN MATCH_MP_TAC NOT_IN_VARIANT THEN
+ REWRITE_TAC[VARS_FINITE; FVT_FINITE; FINITE_UNION] THEN
+ SIMP_TAC[SUBSET; IN_UNION]]);;
+
+let spec = prove
+ (`!A x p t. A |-- !!x p ==> A |-- formsubst (x |=> t) p`,
+ MESON_TAC[ispec; modusponens]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Monotonicity and the deduction theorem. *)
+(* ------------------------------------------------------------------------- *)
+
+let PROVES_MONO = prove
+ (`!A B p. A SUBSET B /\ A |-- p ==> B |-- p`,
+ GEN_TAC THEN GEN_TAC THEN
+ REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
+ MATCH_MP_TAC proves_INDUCT THEN ASM_MESON_TAC[proves_RULES; SUBSET]);;
+
+let DEDUCTION_LEMMA = prove
+ (`!A p q. p INSERT A |-- q /\ closed p ==> A |-- p --> q`,
+ GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
+ REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
+ GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN
+ REPEAT CONJ_TAC THEN X_GEN_TAC `r:form` THENL
+ [REWRITE_TAC[IN_INSERT] THEN MESON_TAC[proves_RULES; add_assum; imp_refl];
+ MESON_TAC[modusponens; axiom_distribimp];
+ ASM_MESON_TAC[gen_right; closed; NOT_IN_EMPTY]]);;
+
+let DEDUCTION = prove
+ (`!A p q. closed p ==> (A |-- p --> q <=> p INSERT A |-- q)`,
+ MESON_TAC[DEDUCTION_LEMMA; modusponens; IN_INSERT; proves_RULES;
+ PROVES_MONO; SUBSET]);;
--- /dev/null
+(* ========================================================================= *)
+(* First order logic based on the language of arithmetic. *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* Syntax of terms. *)
+(* ------------------------------------------------------------------------- *)
+
+parse_as_infix("++",(20,"right"));;
+parse_as_infix("**",(22,"right"));;
+
+let term_INDUCT,term_RECURSION = define_type
+ "term = Z
+ | V num
+ | Suc term
+ | ++ term term
+ | ** term term";;
+
+let term_CASES = prove_cases_thm term_INDUCT;;
+
+let term_DISTINCT = distinctness "term";;
+
+let term_INJ = injectivity "term";;
+
+(* ------------------------------------------------------------------------- *)
+(* Syntax of formulas. *)
+(* ------------------------------------------------------------------------- *)
+
+parse_as_infix("===",(18,"right"));;
+parse_as_infix("<<",(18,"right"));;
+parse_as_infix("<<=",(18,"right"));;
+
+parse_as_infix("&&",(16,"right"));;
+parse_as_infix("||",(15,"right"));;
+parse_as_infix("-->",(14,"right"));;
+parse_as_infix("<->",(13,"right"));;
+
+let form_INDUCT,form_RECURSION = define_type
+ "form = False
+ | True
+ | === term term
+ | << term term
+ | <<= term term
+ | Not form
+ | && form form
+ | || form form
+ | --> form form
+ | <-> form form
+ | !! num form
+ | ?? num form";;
+
+let form_CASES = prove_cases_thm form_INDUCT;;
+
+let form_DISTINCT = distinctness "form";;
+
+let form_INJ = injectivity "form";;
+
+(* ------------------------------------------------------------------------- *)
+(* Semantics of terms and formulas in the standard model. *)
+(* ------------------------------------------------------------------------- *)
+
+parse_as_infix("|->",(22,"right"));;
+
+let valmod = new_definition
+ `(x |-> a) (v:A->B) = \y. if y = x then a else v(y)`;;
+
+let termval = new_recursive_definition term_RECURSION
+ `(termval v Z = 0) /\
+ (termval v (V n) = v(n)) /\
+ (termval v (Suc t) = SUC (termval v t)) /\
+ (termval v (s ++ t) = termval v s + termval v t) /\
+ (termval v (s ** t) = termval v s * termval v t)`;;
+
+let holds = new_recursive_definition form_RECURSION
+ `(holds v False <=> F) /\
+ (holds v True <=> T) /\
+ (holds v (s === t) <=> (termval v s = termval v t)) /\
+ (holds v (s << t) <=> (termval v s < termval v t)) /\
+ (holds v (s <<= t) <=> (termval v s <= termval v t)) /\
+ (holds v (Not p) <=> ~(holds v p)) /\
+ (holds v (p && q) <=> holds v p /\ holds v q) /\
+ (holds v (p || q) <=> holds v p \/ holds v q) /\
+ (holds v (p --> q) <=> holds v p ==> holds v q) /\
+ (holds v (p <-> q) <=> (holds v p <=> holds v q)) /\
+ (holds v (!! x p) <=> !a. holds ((x|->a) v) p) /\
+ (holds v (?? x p) <=> ?a. holds ((x|->a) v) p)`;;
+
+let true_def = new_definition
+ `true p <=> !v. holds v p`;;
+
+let VALMOD = prove
+ (`!v x y a. ((x |-> y) v) a = if a = x then y else v(a)`,
+ REWRITE_TAC[valmod]);;
+
+let VALMOD_BASIC = prove
+ (`!v x y. (x |-> y) v x = y`,
+ REWRITE_TAC[valmod]);;
+
+let VALMOD_VALMOD_BASIC = prove
+ (`!v a b x. (x |-> a) ((x |-> b) v) = (x |-> a) v`,
+ REWRITE_TAC[valmod; FUN_EQ_THM] THEN
+ REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);;
+
+let VALMOD_REPEAT = prove
+ (`!v x. (x |-> v(x)) v = v`,
+ REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);;
+
+let FORALL_VALMOD = prove
+ (`!x. (!v a. P((x |-> a) v)) <=> (!v. P v)`,
+ MESON_TAC[VALMOD_REPEAT]);;
+
+let VALMOD_SWAP = prove
+ (`!v x y a b.
+ ~(x = y) ==> ((x |-> a) ((y |-> b) v) = (y |-> b) ((x |-> a) v))`,
+ REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Assignment. *)
+(* ------------------------------------------------------------------------- *)
+
+parse_as_infix("|=>",(22,"right"));;
+
+let assign = new_definition
+ `(x |=> a) = (x |-> a) V`;;
+
+let ASSIGN = prove
+ (`!x y a. (x |=> a) y = if y = x then a else V(y)`,
+ REWRITE_TAC[assign; valmod]);;
+
+let ASSIGN_TRIV = prove
+ (`!x. (x |=> V x) = V`,
+ REWRITE_TAC[VALMOD_REPEAT; assign]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Variables in a term and free variables in a formula. *)
+(* ------------------------------------------------------------------------- *)
+
+let FVT = new_recursive_definition term_RECURSION
+ `(FVT Z = {}) /\
+ (FVT (V n) = {n}) /\
+ (FVT (Suc t) = FVT t) /\
+ (FVT (s ++ t) = (FVT s) UNION (FVT t)) /\
+ (FVT (s ** t) = (FVT s) UNION (FVT t))`;;
+
+let FV = new_recursive_definition form_RECURSION
+ `(FV False = {}) /\
+ (FV True = {}) /\
+ (FV (s === t) = (FVT s) UNION (FVT t)) /\
+ (FV (s << t) = (FVT s) UNION (FVT t)) /\
+ (FV (s <<= t) = (FVT s) UNION (FVT t)) /\
+ (FV (Not p) = FV p) /\
+ (FV (p && q) = (FV p) UNION (FV q)) /\
+ (FV (p || q) = (FV p) UNION (FV q)) /\
+ (FV (p --> q) = (FV p) UNION (FV q)) /\
+ (FV (p <-> q) = (FV p) UNION (FV q)) /\
+ (FV (!!x p) = (FV p) DELETE x) /\
+ (FV (??x p) = (FV p) DELETE x)`;;
+
+let FVT_FINITE = prove
+ (`!t. FINITE(FVT t)`,
+ MATCH_MP_TAC term_INDUCT THEN
+ SIMP_TAC[FVT; FINITE_RULES; FINITE_INSERT; FINITE_UNION]);;
+
+let FV_FINITE = prove
+ (`!p. FINITE(FV p)`,
+ MATCH_MP_TAC form_INDUCT THEN
+ SIMP_TAC[FV; FVT_FINITE; FINITE_RULES; FINITE_DELETE; FINITE_UNION]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Logical axioms. *)
+(* ------------------------------------------------------------------------- *)
+
+let axiom_RULES,axiom_INDUCT,axiom_CASES = new_inductive_definition
+ `(!p q. axiom(p --> (q --> p))) /\
+ (!p q r. axiom((p --> q --> r) --> (p --> q) --> (p --> r))) /\
+ (!p. axiom(((p --> False) --> False) --> p)) /\
+ (!x p q. axiom((!!x (p --> q)) --> (!!x p) --> (!!x q))) /\
+ (!x p. ~(x IN FV p) ==> axiom(p --> !!x p)) /\
+ (!x t. ~(x IN FVT t) ==> axiom(??x (V x === t))) /\
+ (!t. axiom(t === t)) /\
+ (!s t. axiom((s === t) --> (Suc s === Suc t))) /\
+ (!s t u v. axiom(s === t --> u === v --> s ++ u === t ++ v)) /\
+ (!s t u v. axiom(s === t --> u === v --> s ** u === t ** v)) /\
+ (!s t u v. axiom(s === t --> u === v --> s === u --> t === v)) /\
+ (!s t u v. axiom(s === t --> u === v --> s << u --> t << v)) /\
+ (!s t u v. axiom(s === t --> u === v --> s <<= u --> t <<= v)) /\
+ (!p q. axiom((p <-> q) --> p --> q)) /\
+ (!p q. axiom((p <-> q) --> q --> p)) /\
+ (!p q. axiom((p --> q) --> (q --> p) --> (p <-> q))) /\
+ axiom(True <-> (False --> False)) /\
+ (!p. axiom(Not p <-> (p --> False))) /\
+ (!p q. axiom((p && q) <-> (p --> q --> False) --> False)) /\
+ (!p q. axiom((p || q) <-> Not(Not p && Not q))) /\
+ (!x p. axiom((??x p) <-> Not(!!x (Not p))))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Deducibility from additional set of nonlogical axioms. *)
+(* ------------------------------------------------------------------------- *)
+
+parse_as_infix("|--",(11,"right"));;
+
+let proves_RULES,proves_INDUCT,proves_CASES = new_inductive_definition
+ `(!p. axiom p \/ p IN A ==> A |-- p) /\
+ (!p q. A |-- (p --> q) /\ A |-- p ==> A |-- q) /\
+ (!p x. A |-- p ==> A |-- (!!x p))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Some lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+let TERMVAL_VALUATION = prove
+ (`!t v v'. (!x. x IN FVT(t) ==> (v'(x) = v(x)))
+ ==> (termval v' t = termval v t)`,
+ MATCH_MP_TAC term_INDUCT THEN
+ REWRITE_TAC[termval; FVT; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN
+ REPEAT STRIP_TAC THEN ASM_MESON_TAC[]);;
+
+let HOLDS_VALUATION = prove
+ (`!p v v'.
+ (!x. x IN (FV p) ==> (v'(x) = v(x)))
+ ==> (holds v' p <=> holds v p)`,
+ MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[FV; holds; IN_UNION; IN_DELETE] THEN
+ SIMP_TAC[TERMVAL_VALUATION] THEN
+ REWRITE_TAC[valmod] THEN REPEAT STRIP_TAC THEN
+ AP_TERM_TAC THEN ABS_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ ASM_SIMP_TAC[]);;
+
+let TERMVAL_VALMOD_OTHER = prove
+ (`!v x a t. ~(x IN FVT t) ==> (termval ((x |-> a) v) t = termval v t)`,
+ MESON_TAC[TERMVAL_VALUATION; VALMOD]);;
+
+let HOLDS_VALMOD_OTHER = prove
+ (`!v x a p. ~(x IN FV p) ==> (holds ((x |-> a) v) p <=> holds v p)`,
+ MESON_TAC[HOLDS_VALUATION; VALMOD]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Proof of soundness. *)
+(* ------------------------------------------------------------------------- *)
+
+let AXIOMS_TRUE = prove
+ (`!p. axiom p ==> true p`,
+ MATCH_MP_TAC axiom_INDUCT THEN
+ REWRITE_TAC[true_def] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[holds] THENL
+ [CONV_TAC TAUT;
+ CONV_TAC TAUT;
+ SIMP_TAC[];
+ REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN
+ MATCH_MP_TAC EQ_IMP THEN
+ MATCH_MP_TAC HOLDS_VALUATION THEN
+ REWRITE_TAC[valmod] THEN GEN_TAC THEN COND_CASES_TAC THEN
+ ASM_MESON_TAC[];
+ EXISTS_TAC `termval v t` THEN
+ REWRITE_TAC[termval; valmod] THEN
+ MATCH_MP_TAC TERMVAL_VALUATION THEN
+ GEN_TAC THEN REWRITE_TAC[] THEN
+ COND_CASES_TAC THEN ASM_MESON_TAC[];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ SIMP_TAC[termval];
+ CONV_TAC TAUT;
+ CONV_TAC TAUT;
+ CONV_TAC TAUT;
+ MESON_TAC[]]);;
+
+let THEOREMS_TRUE = prove
+ (`!A p. (!q. q IN A ==> true q) /\ A |-- p ==> true p`,
+ GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
+ DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN
+ ASM_SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
+ REWRITE_TAC[IN; AXIOMS_TRUE] THEN
+ SIMP_TAC[holds; true_def]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Variant variables for use in renaming substitution. *)
+(* ------------------------------------------------------------------------- *)
+
+let MAX_SYM = prove
+ (`!x y. MAX x y = MAX y x`,
+ ARITH_TAC);;
+
+let MAX_ASSOC = prove
+ (`!x y z. MAX x (MAX y z) = MAX (MAX x y) z`,
+ ARITH_TAC);;
+
+let SETMAX = new_definition
+ `SETMAX s = ITSET MAX s 0`;;
+
+let VARIANT = new_definition
+ `VARIANT s = SETMAX s + 1`;;
+
+let SETMAX_LEMMA = prove
+ (`(SETMAX {} = 0) /\
+ (!x s. FINITE s ==>
+ (SETMAX (x INSERT s) = if x IN s then SETMAX s
+ else MAX x (SETMAX s)))`,
+ REWRITE_TAC[SETMAX] THEN MATCH_MP_TAC FINITE_RECURSION THEN
+ REWRITE_TAC[MAX] THEN REPEAT GEN_TAC THEN
+ MAP_EVERY ASM_CASES_TAC
+ [`x:num <= s`; `y:num <= s`; `x:num <= y`; `y <= x`] THEN
+ ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS; LE_ANTISYM]);;
+
+let SETMAX_MEMBER = prove
+ (`!s. FINITE s ==> !x. x IN s ==> x <= SETMAX s`,
+ MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
+ REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT] THEN
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ ASM_SIMP_TAC [SETMAX_LEMMA] THEN
+ ASM_REWRITE_TAC[MAX] THEN
+ REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
+ ASM_REWRITE_TAC[LE_REFL] THEN
+ ASM_MESON_TAC[LE_CASES; LE_TRANS]);;
+
+let SETMAX_THM = prove
+ (`(SETMAX {} = 0) /\
+ (!x s. FINITE s ==>
+ (SETMAX (x INSERT s) = MAX x (SETMAX s)))`,
+ REPEAT STRIP_TAC THEN ASM_SIMP_TAC [SETMAX_LEMMA] THEN
+ COND_CASES_TAC THEN REWRITE_TAC[MAX] THEN
+ COND_CASES_TAC THEN ASM_MESON_TAC[SETMAX_MEMBER]);;
+
+let SETMAX_UNION = prove
+ (`!s t. FINITE(s UNION t)
+ ==> (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))`,
+ let lemma = prove(`(x INSERT s) UNION t = x INSERT (s UNION t)`,SET_TAC[]) in
+ SUBGOAL_THEN `!t. FINITE(t) ==> !s. FINITE(s) ==>
+ (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))`
+ (fun th -> MESON_TAC[th; FINITE_UNION]) THEN
+ GEN_TAC THEN DISCH_TAC THEN
+ MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
+ REWRITE_TAC[UNION_EMPTY; SETMAX_THM] THEN CONJ_TAC THENL
+ [REWRITE_TAC[MAX; LE_0]; ALL_TAC] THEN
+ REPEAT STRIP_TAC THEN REWRITE_TAC[lemma] THEN
+ ASM_SIMP_TAC [SETMAX_THM; FINITE_UNION] THEN
+ REWRITE_TAC[MAX_ASSOC]);;
+
+let VARIANT_FINITE = prove
+ (`!s:num->bool. FINITE(s) ==> ~(VARIANT(s) IN s)`,
+ REWRITE_TAC[VARIANT] THEN
+ MESON_TAC[SETMAX_MEMBER; ARITH_RULE `~(x + 1 <= x)`]);;
+
+let VARIANT_THM = prove
+ (`!p. ~(VARIANT(FV p) IN FV(p))`,
+ GEN_TAC THEN MATCH_MP_TAC VARIANT_FINITE THEN REWRITE_TAC[FV_FINITE]);;
+
+let NOT_IN_VARIANT = prove
+ (`!s t. FINITE s /\ t SUBSET s ==> ~(VARIANT(s) IN t)`,
+ MESON_TAC[SUBSET; VARIANT_FINITE]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Substitution within terms. *)
+(* ------------------------------------------------------------------------- *)
+
+let termsubst = new_recursive_definition term_RECURSION
+ `(termsubst v Z = Z) /\
+ (!x. termsubst v (V x) = v(x)) /\
+ (!t. termsubst v (Suc t) = Suc(termsubst v t)) /\
+ (!s t. termsubst v (s ++ t) = termsubst v s ++ termsubst v t) /\
+ (!s t. termsubst v (s ** t) = termsubst v s ** termsubst v t)`;;
+
+let TERMVAL_TERMSUBST = prove
+ (`!v i t. termval v (termsubst i t) = termval (termval v o i) t`,
+ GEN_TAC THEN GEN_TAC THEN
+ MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);;
+
+let TERMSUBST_TERMSUBST = prove
+ (`!i j t. termsubst j (termsubst i t) = termsubst (termsubst j o i) t`,
+ GEN_TAC THEN GEN_TAC THEN
+ MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);;
+
+let TERMSUBST_TRIV = prove
+ (`!t. termsubst V t = t`,
+ MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termsubst]);;
+
+let TERMSUBST_EQ = prove
+ (`!t v v'. (!x. x IN (FVT t) ==> (v'(x) = v(x)))
+ ==> (termsubst v' t = termsubst v t)`,
+ MATCH_MP_TAC term_INDUCT THEN
+ SIMP_TAC[termsubst; FVT; IN_SING; IN_UNION] THEN MESON_TAC[]);;
+
+let TERMSUBST_FVT = prove
+ (`!t i. FVT(termsubst i t) = {x | ?y. y IN FVT(t) /\ x IN FVT(i y)}`,
+ REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
+ MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[FVT; termsubst] THEN
+ REWRITE_TAC[IN_UNION; IN_SING; NOT_IN_EMPTY] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Formula substitution --- somewhat less trivial. *)
+(* ------------------------------------------------------------------------- *)
+
+let formsubst = new_recursive_definition form_RECURSION
+ `(formsubst v False = False) /\
+ (formsubst v True = True) /\
+ (formsubst v (s === t) = termsubst v s === termsubst v t) /\
+ (formsubst v (s << t) = termsubst v s << termsubst v t) /\
+ (formsubst v (s <<= t) = termsubst v s <<= termsubst v t) /\
+ (formsubst v (Not p) = Not(formsubst v p)) /\
+ (formsubst v (p && q) = formsubst v p && formsubst v q) /\
+ (formsubst v (p || q) = formsubst v p || formsubst v q) /\
+ (formsubst v (p --> q) = formsubst v p --> formsubst v q) /\
+ (formsubst v (p <-> q) = formsubst v p <-> formsubst v q) /\
+ (formsubst v (!!x q) =
+ let z = if ?y. y IN FV(!!x q) /\ x IN FVT(v(y))
+ then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in
+ !!z (formsubst ((x |-> V(z)) v) q)) /\
+ (formsubst v (??x q) =
+ let z = if ?y. y IN FV(??x q) /\ x IN FVT(v(y))
+ then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in
+ ??z (formsubst ((x |-> V(z)) v) q))`;;
+
+let FORMSUBST_PROPERTIES = prove
+ (`!p. (!i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}) /\
+ (!i v. holds v (formsubst i p) = holds (termval v o i) p)`,
+ REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
+ MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[FV; holds; formsubst; TERMSUBST_FVT; IN_ELIM_THM; NOT_IN_EMPTY;
+ IN_UNION; TERMVAL_TERMSUBST] THEN
+ REPEAT(CONJ_TAC THENL [MESON_TAC[];ALL_TAC]) THEN CONJ_TAC THEN
+ (MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN STRIP_TAC THEN
+ REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num->term` THEN
+ LET_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
+ SUBGOAL_THEN `~(?y. y IN (FV(p) DELETE x) /\ z IN FVT(i y))`
+ ASSUME_TAC THENL
+ [EXPAND_TAC "z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ MP_TAC(SPEC `formsubst ((x |-> V x) i) p` VARIANT_THM) THEN
+ ASM_REWRITE_TAC[valmod; IN_DELETE; CONTRAPOS_THM] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
+ ALL_TAC] THEN
+ CONJ_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[FV; IN_DELETE; holds] THENL
+ [REWRITE_TAC[LEFT_AND_EXISTS_THM; valmod] THEN AP_TERM_TAC THEN
+ ABS_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[FVT; IN_SING; IN_DELETE];
+ AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN
+ GEN_TAC THEN REWRITE_TAC[valmod; o_DEF] THEN COND_CASES_TAC THEN
+ ASM_REWRITE_TAC[termval] THEN DISCH_TAC THEN
+ MATCH_MP_TAC TERMVAL_VALUATION THEN GEN_TAC THEN
+ REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[IN_DELETE]]));;
+
+let FORMSUBST_FV = prove
+ (`!p i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}`,
+ REWRITE_TAC[FORMSUBST_PROPERTIES]);;
+
+let HOLDS_FORMSUBST = prove
+ (`!p i v. holds v (formsubst i p) <=> holds (termval v o i) p`,
+ REWRITE_TAC[FORMSUBST_PROPERTIES]);;
+
+let FORMSUBST_EQ = prove
+ (`!p i j. (!x. x IN FV(p) ==> (i(x) = j(x)))
+ ==> (formsubst i p = formsubst j p)`,
+ MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[FV; formsubst; IN_UNION; IN_DELETE] THEN
+ SIMP_TAC[] THEN REWRITE_TAC[CONJ_ASSOC] THEN
+ GEN_REWRITE_TAC I [GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
+ [MESON_TAC[TERMSUBST_EQ]; ALL_TAC] THEN
+ CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN
+ (DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `j:num->term`] THEN
+ DISCH_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF; form_INJ] THEN
+ MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN SIMP_TAC[] THEN
+ CONJ_TAC THENL
+ [ALL_TAC;
+ DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ REWRITE_TAC[valmod] THEN ASM_SIMP_TAC[]] THEN
+ AP_THM_TAC THEN BINOP_TAC THENL
+ [ASM_MESON_TAC[];
+ AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ REWRITE_TAC[valmod] THEN ASM_MESON_TAC[]]));;
+
+let FORMSUBST_TRIV = prove
+ (`!p. formsubst V p = p`,
+ MATCH_MP_TAC form_INDUCT THEN
+ SIMP_TAC[formsubst; TERMSUBST_TRIV] THEN
+ REWRITE_TAC[FVT; IN_SING; FV; IN_DELETE] THEN
+ REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
+ ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; VALMOD_REPEAT] THEN
+ ASM_MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Quasi-substitution. *)
+(* ------------------------------------------------------------------------- *)
+
+let qsubst = new_definition
+ `qsubst (x,t) p = ??x (V x === t && p)`;;
+
+let FV_QSUBST = prove
+ (`!x n p. FV(qsubst (x,t) p) = (FV(p) UNION FVT(t)) DELETE x`,
+ REWRITE_TAC[qsubst; FV; FVT] THEN SET_TAC[]);;
+
+let HOLDS_QSUBST = prove
+ (`!v t p v. ~(x IN FVT(t))
+ ==> (holds v (qsubst (x,t) p) <=>
+ holds ((x |-> termval v t) v) p)`,
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `!v z. termval ((x |-> z) v) t = termval v t` ASSUME_TAC THENL
+ [REWRITE_TAC[valmod] THEN ASM_MESON_TAC[TERMVAL_VALUATION];
+ ASM_REWRITE_TAC[holds; qsubst; termval; VALMOD_BASIC; UNWIND_THM2]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* The numeral mapping. *)
+(* ------------------------------------------------------------------------- *)
+
+let numeral = new_recursive_definition num_RECURSION
+ `(numeral 0 = Z) /\
+ (!n. numeral (SUC n) = Suc(numeral n))`;;
+
+let TERMVAL_NUMERAL = prove
+ (`!v n. termval v (numeral n) = n`,
+ GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[termval;numeral]);;
+
+let FVT_NUMERAL = prove
+ (`!n. FVT(numeral n) = {}`,
+ INDUCT_TAC THEN ASM_REWRITE_TAC[FVT; numeral]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Closed-ness. *)
+(* ------------------------------------------------------------------------- *)
+
+let closed = new_definition
+ `closed p <=> (FV p = {})`;;
--- /dev/null
+(* ========================================================================= *)
+(* Godel's theorem in its true form. *)
+(* ========================================================================= *)
+
+(* ------------------------------------------------------------------------- *)
+(* Classes of formulas, via auxiliary "shared" inductive definition. *)
+(* ------------------------------------------------------------------------- *)
+
+let sigmapi_RULES,sigmapi_INDUCT,sigmapi_CASES = new_inductive_definition
+ `(!b n. sigmapi b n False) /\
+ (!b n. sigmapi b n True) /\
+ (!b n s t. sigmapi b n (s === t)) /\
+ (!b n s t. sigmapi b n (s << t)) /\
+ (!b n s t. sigmapi b n (s <<= t)) /\
+ (!b n p. sigmapi (~b) n p ==> sigmapi b n (Not p)) /\
+ (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p && q)) /\
+ (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p || q)) /\
+ (!b n p q. sigmapi (~b) n p /\ sigmapi b n q ==> sigmapi b n (p --> q)) /\
+ (!b n p q. (!b. sigmapi b n p) /\ (!b. sigmapi b n q)
+ ==> sigmapi b n (p <-> q)) /\
+ (!n x p. sigmapi T n p /\ ~(n = 0) ==> sigmapi T n (??x p)) /\
+ (!n x p. sigmapi F n p /\ ~(n = 0) ==> sigmapi F n (!!x p)) /\
+ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t)
+ ==> sigmapi b n (??x (V x << t && p))) /\
+ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t)
+ ==> sigmapi b n (??x (V x <<= t && p))) /\
+ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t)
+ ==> sigmapi b n (!!x (V x << t --> p))) /\
+ (!b n x p t. sigmapi b n p /\ ~(x IN FVT t)
+ ==> sigmapi b n (!!x (V x <<= t --> p))) /\
+ (!b c n p. sigmapi b n p ==> sigmapi c (n + 1) p)`;;
+
+let SIGMA = new_definition `SIGMA = sigmapi T`;;
+let PI = new_definition `PI = sigmapi F`;;
+let DELTA = new_definition `DELTA n p <=> SIGMA n p /\ PI n p`;;
+
+let SIGMAPI_PROP = prove
+ (`(!n b. sigmapi b n False <=> T) /\
+ (!n b. sigmapi b n True <=> T) /\
+ (!n b s t. sigmapi b n (s === t) <=> T) /\
+ (!n b s t. sigmapi b n (s << t) <=> T) /\
+ (!n b s t. sigmapi b n (s <<= t) <=> T) /\
+ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\
+ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\
+ (sigmapi b n q /\ sigmapi (~b) n q))`,
+ REWRITE_TAC[sigmapi_RULES] THEN
+ GEN_REWRITE_TAC DEPTH_CONV [AND_FORALL_THM] THEN
+ INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1] THEN
+ REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN
+ REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1;
+ FORALL_BOOL_THM] THEN
+ REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`] THEN
+ REWRITE_TAC[ARITH_RULE `(SUC m = n + 1) <=> (n = m)`; UNWIND_THM2] THEN
+ ASM_REWRITE_TAC[] THEN
+ BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[ADD1] THEN
+ REWRITE_TAC[CONJ_ACI] THEN
+ REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN
+ MESON_TAC[sigmapi_RULES]);;
+
+let SIGMAPI_MONO_LEMMA = prove
+ (`(!b n p. sigmapi b n p ==> sigmapi b (n + 1) p) /\
+ (!b n p. ~(n = 0) /\ sigmapi b (n - 1) p ==> sigmapi b n p) /\
+ (!b n p. ~(n = 0) /\ sigmapi (~b) (n - 1) p ==> sigmapi b n p)`,
+ CONJ_TAC THENL
+ [REPEAT STRIP_TAC;
+ REPEAT STRIP_TAC THEN
+ FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE
+ `~(n = 0) ==> (n = (n - 1) + 1)`))] THEN
+ POP_ASSUM MP_TAC THEN ASM_MESON_TAC[sigmapi_RULES]);;
+
+let SIGMAPI_REV_EXISTS = prove
+ (`!n b x p. sigmapi b n (??x p) ==> sigmapi b n p`,
+ MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN
+ REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN
+ REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN
+ ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);;
+
+let SIGMAPI_REV_FORALL = prove
+ (`!n b x p. sigmapi b n (!!x p) ==> sigmapi b n p`,
+ MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN
+ REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN
+ REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN
+ ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);;
+
+let SIGMAPI_CLAUSES_CODE = prove
+ (`(!n b. sigmapi b n False <=> T) /\
+ (!n b. sigmapi b n True <=> T) /\
+ (!n b s t. sigmapi b n (s === t) <=> T) /\
+ (!n b s t. sigmapi b n (s << t) <=> T) /\
+ (!n b s t. sigmapi b n (s <<= t) <=> T) /\
+ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\
+ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\
+ (sigmapi b n q /\ sigmapi (~b) n q)) /\
+ (!n b x p. sigmapi b n (??x p) <=>
+ if b /\ ~(n = 0) \/
+ ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\
+ ~(x IN FVT t)
+ then sigmapi b n p
+ else ~(n = 0) /\ sigmapi (~b) (n - 1) (??x p)) /\
+ (!n b x p. sigmapi b n (!!x p) <=>
+ if ~b /\ ~(n = 0) \/
+ ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\
+ ~(x IN FVT t)
+ then sigmapi b n p
+ else ~(n = 0) /\ sigmapi (~b) (n - 1) (!!x p))`,
+ REWRITE_TAC[SIGMAPI_PROP] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN
+ REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
+ ONCE_REWRITE_TAC[TAUT `a \/ b \/ c \/ d <=> (b \/ c) \/ (a \/ d)`] THEN
+ REWRITE_TAC[CONJ_ASSOC; OR_EXISTS_THM; GSYM RIGHT_OR_DISTRIB] THEN
+ REWRITE_TAC[TAUT
+ `(if b /\ c \/ d then e else c /\ f) <=>
+ d /\ e \/ c /\ ~d /\ (if b then e else f)`] THEN
+ MATCH_MP_TAC(TAUT `(a <=> a') /\ (~a' ==> (b <=> b'))
+ ==> (a \/ b <=> a' \/ b')`) THEN
+ (CONJ_TAC THENL
+ [REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+ REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
+ EQ_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
+ REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SIGMAPI_PROP] THEN
+ SIMP_TAC[];
+ ALL_TAC]) THEN
+ (ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`]) THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (n = m + 1 <=> m = n - 1)`] THEN
+ REWRITE_TAC[UNWIND_THM2] THEN
+ W(fun (asl,w) -> ASM_CASES_TAC (find_term is_exists w)) THEN
+ ASM_REWRITE_TAC[CONTRAPOS_THM] THENL
+ [DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN
+ FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN
+ ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`];
+ ASM_CASES_TAC `b:bool` THEN
+ ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL
+ [DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN
+ ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`];
+ REWRITE_TAC[EXISTS_BOOL_THM] THEN
+ REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN
+ ONCE_REWRITE_TAC[sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[]];
+ DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN
+ FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN
+ ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`];
+ ASM_CASES_TAC `b:bool` THEN
+ ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL
+ [REWRITE_TAC[EXISTS_BOOL_THM] THEN
+ REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN
+ ONCE_REWRITE_TAC[sigmapi_CASES] THEN
+ REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[];
+ DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN
+ ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]]]);;
+
+let SIGMAPI_CLAUSES = prove
+ (`(!n b. sigmapi b n False <=> T) /\
+ (!n b. sigmapi b n True <=> T) /\
+ (!n b s t. sigmapi b n (s === t) <=> T) /\
+ (!n b s t. sigmapi b n (s << t) <=> T) /\
+ (!n b s t. sigmapi b n (s <<= t) <=> T) /\
+ (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\
+ (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\
+ (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\
+ (sigmapi b n q /\ sigmapi (~b) n q)) /\
+ (!n b x p. sigmapi b n (??x p) <=>
+ if b /\ ~(n = 0) \/
+ ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\
+ ~(x IN FVT t)
+ then sigmapi b n p
+ else 2 <= n /\ sigmapi (~b) (n - 1) p) /\
+ (!n b x p. sigmapi b n (!!x p) <=>
+ if ~b /\ ~(n = 0) \/
+ ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\
+ ~(x IN FVT t)
+ then sigmapi b n p
+ else 2 <= n /\ sigmapi (~b) (n - 1) p)`,
+ REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN
+ REWRITE_TAC[] THEN
+ ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN
+ BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN
+ ASM_REWRITE_TAC[ARITH_RULE `~(n - 1 = 0) <=> 2 <= n`] THEN
+ MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Show that it respects substitution. *)
+(* ------------------------------------------------------------------------- *)
+
+let SIGMAPI_FORMSUBST = prove
+ (`!p v n b. sigmapi b n p ==> sigmapi b n (formsubst v p)`,
+ MATCH_MP_TAC form_INDUCT THEN
+ REWRITE_TAC[SIGMAPI_CLAUSES; formsubst] THEN SIMP_TAC[] THEN
+ REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN
+ MATCH_MP_TAC(TAUT `(a ==> b /\ c) ==> (a ==> b) /\ (a ==> c)`) THEN
+ DISCH_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
+ MAP_EVERY X_GEN_TAC [`i:num->term`; `n:num`; `b:bool`] THEN
+ REWRITE_TAC[FV] THEN LET_TAC THEN
+ CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN
+ REWRITE_TAC[SIGMAPI_CLAUSES] THEN
+ ONCE_REWRITE_TAC[TAUT
+ `((if p \/ q then x else y) ==> (if p \/ q' then x' else y')) <=>
+ (p /\ x ==> x') /\
+ (~p ==> (if q then x else y) ==> (if q' then x' else y'))`] THEN
+ ASM_SIMP_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
+ CONJ_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(TAUT
+ `(p ==> p') /\ (x ==> x') /\ (y ==> y') /\ (y ==> x)
+ ==> (if p then x else y) ==> (if p' then x' else y')`) THEN
+ ASM_SIMP_TAC[SIGMAPI_MONO_LEMMA; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[formsubst; form_INJ; termsubst] THEN
+ REWRITE_TAC[form_DISTINCT] THEN
+ ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ d <=> b /\ c /\ a /\ d`] THEN
+ REWRITE_TAC[UNWIND_THM1; termsubst; VALMOD_BASIC] THEN
+ REWRITE_TAC[TERMSUBST_FVT; IN_ELIM_THM; NOT_EXISTS_THM] THEN
+ X_GEN_TAC `y:num` THEN REWRITE_TAC[valmod] THEN
+ (COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SYM th]) THEN
+ FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[FV; FVT] THEN
+ REWRITE_TAC[IN_DELETE; IN_UNION; IN_SING; GSYM DISJ_ASSOC] THEN
+ REWRITE_TAC[TAUT `(a \/ b \/ c) /\ ~a <=> ~a /\ b \/ ~a /\ c`] THEN
+ (COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN
+ W(fun (asl,w) -> let t = lhand(rand w) in
+ MP_TAC(SPEC (rand(rand t)) VARIANT_THM) THEN
+ SPEC_TAC(t,`u:num`)) THEN
+ REWRITE_TAC[CONTRAPOS_THM; FORMSUBST_FV; IN_ELIM_THM; FV] THEN
+ GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `y:num` THEN
+ ASM_REWRITE_TAC[valmod; IN_UNION]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence all our main concepts are OK. *)
+(* ------------------------------------------------------------------------- *)
+
+let SIGMAPI_TAC ths =
+ REPEAT STRIP_TAC THEN
+ REWRITE_TAC ths THEN
+ TRY(MATCH_MP_TAC SIGMAPI_FORMSUBST) THEN
+ let ths' = ths @ [SIGMAPI_CLAUSES; form_DISTINCT;
+ form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; GSYM EXISTS_REFL;
+ FVT; IN_SING; ARITH_EQ] in
+ REWRITE_TAC ths' THEN ASM_SIMP_TAC ths';;
+
+let SIGMAPI_DIVIDES = prove
+ (`!n s t. sigmapi b n (arith_divides s t)`,
+ SIGMAPI_TAC[arith_divides]);;
+
+let SIGMAPI_PRIME = prove
+ (`!n t. sigmapi b n (arith_prime t)`,
+ SIGMAPI_TAC[arith_prime; SIGMAPI_DIVIDES]);;
+
+let SIGMAPI_PRIMEPOW = prove
+ (`!n s t. sigmapi b n (arith_primepow s t)`,
+ SIGMAPI_TAC[arith_primepow; SIGMAPI_DIVIDES; SIGMAPI_PRIME]);;
+
+let SIGMAPI_RTC = prove
+ (`(!s t. sigmapi T 1 (R s t))
+ ==> !s t. sigmapi T 1 (arith_rtc R s t)`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtc] THEN
+ MATCH_MP_TAC SIGMAPI_FORMSUBST THEN
+ REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1;
+ GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES;
+ SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN
+ ASM_REWRITE_TAC[]);;
+
+let SIGMAPI_RTCP = prove
+ (`(!s t u. sigmapi T 1 (R s t u))
+ ==> !s t u. sigmapi T 1 (arith_rtcp R s t u)`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtcp] THEN
+ MATCH_MP_TAC SIGMAPI_FORMSUBST THEN
+ REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1;
+ GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES;
+ SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN
+ ASM_REWRITE_TAC[]);;
+
+let SIGMAPI_TERM1 = prove
+ (`!s t. sigmapi T 1 (arith_term1 s t)`,
+ SIGMAPI_TAC[arith_term1]);;
+
+let SIGMAPI_TERM = prove
+ (`!t. sigmapi T 1 (arith_term t)`,
+ SIGMAPI_TAC[arith_term; SIGMAPI_RTC; SIGMAPI_TERM1]);;
+
+let SIGMAPI_FORM1 = prove
+ (`!s t. sigmapi T 1 (arith_form1 s t)`,
+ SIGMAPI_TAC[arith_form1; SIGMAPI_TERM]);;
+
+let SIGMAPI_FORM = prove
+ (`!t. sigmapi T 1 (arith_form t)`,
+ SIGMAPI_TAC[arith_form; SIGMAPI_RTC; SIGMAPI_FORM1]);;
+
+let SIGMAPI_FREETERM1 = prove
+ (`!s t u. sigmapi T 1 (arith_freeterm1 s t u)`,
+ SIGMAPI_TAC[arith_freeterm1]);;
+
+let SIGMAPI_FREETERM = prove
+ (`!s t. sigmapi T 1 (arith_freeterm s t)`,
+ SIGMAPI_TAC[arith_freeterm; SIGMAPI_FREETERM1; SIGMAPI_RTCP]);;
+
+let SIGMAPI_FREEFORM1 = prove
+ (`!s t u. sigmapi T 1 (arith_freeform1 s t u)`,
+ SIGMAPI_TAC[arith_freeform1; SIGMAPI_FREETERM; SIGMAPI_FORM]);;
+
+let SIGMAPI_FREEFORM = prove
+ (`!s t. sigmapi T 1 (arith_freeform s t)`,
+ SIGMAPI_TAC[arith_freeform; SIGMAPI_FREEFORM1; SIGMAPI_RTCP]);;
+
+let SIGMAPI_AXIOM = prove
+ (`!t. sigmapi T 1 (arith_axiom t)`,
+ SIGMAPI_TAC[arith_axiom; SIGMAPI_FREEFORM; SIGMAPI_FREETERM; SIGMAPI_FORM;
+ SIGMAPI_TERM]);;
+
+let SIGMAPI_PROV1 = prove
+ (`!A. (!t. sigmapi T 1 (A t)) ==> !s t. sigmapi T 1 (arith_prov1 A s t)`,
+ SIGMAPI_TAC[arith_prov1; SIGMAPI_AXIOM]);;
+
+let SIGMAPI_PROV = prove
+ (`(!t. sigmapi T 1 (A t)) ==> !t. sigmapi T 1 (arith_prov A t)`,
+ SIGMAPI_TAC[arith_prov; SIGMAPI_PROV1; SIGMAPI_RTC]);;
+
+let SIGMAPI_PRIMRECSTEP = prove
+ (`(!s t u. sigmapi T 1 (R s t u))
+ ==> !s t. sigmapi T 1 (arith_primrecstep R s t)`,
+ SIGMAPI_TAC[arith_primrecstep]);;
+
+let SIGMAPI_PRIMREC = prove
+ (`(!s t u. sigmapi T 1 (R s t u))
+ ==> !s t. sigmapi T 1 (arith_primrec R c s t)`,
+ SIGMAPI_TAC[arith_primrec; SIGMAPI_PRIMRECSTEP; SIGMAPI_RTC]);;
+
+let SIGMAPI_GNUMERAL1 = prove
+ (`!s t. sigmapi T 1 (arith_gnumeral1 s t)`,
+ SIGMAPI_TAC[arith_gnumeral1]);;
+
+let SIGMAPI_GNUMERAL = prove
+ (`!s t. sigmapi T 1 (arith_gnumeral s t)`,
+ SIGMAPI_TAC[arith_gnumeral; arith_gnumeral1';
+ SIGMAPI_GNUMERAL1; SIGMAPI_RTC]);;
+
+let SIGMAPI_QSUBST = prove
+ (`!x n p. sigmapi T 1 p ==> sigmapi T 1 (qsubst(x,n) p)`,
+ SIGMAPI_TAC[qsubst]);;
+
+let SIGMAPI_QDIAG = prove
+ (`!x s t. sigmapi T 1 (arith_qdiag x s t)`,
+ SIGMAPI_TAC[arith_qdiag; SIGMAPI_GNUMERAL]);;
+
+let SIGMAPI_DIAGONALIZE = prove
+ (`!x p. sigmapi T 1 p ==> sigmapi T 1 (diagonalize x p)`,
+ SIGMAPI_TAC[diagonalize; SIGMAPI_QDIAG;
+ SIGMAPI_FORMSUBST; LET_DEF; LET_END_DEF]);;
+
+let SIGMAPI_FIXPOINT = prove
+ (`!x p. sigmapi T 1 p ==> sigmapi T 1 (fixpoint x p)`,
+ SIGMAPI_TAC[fixpoint; qdiag; SIGMAPI_QSUBST; SIGMAPI_DIAGONALIZE]);;
+
+(* ------------------------------------------------------------------------- *)
+(* The Godel sentence, "H" being Sigma and "G" being Pi. *)
+(* ------------------------------------------------------------------------- *)
+
+let hsentence = new_definition
+ `hsentence Arep =
+ fixpoint 0 (arith_prov Arep (arith_pair (numeral 4) (V 0)))`;;
+
+let gsentence = new_definition
+ `gsentence Arep = Not(hsentence Arep)`;;
+
+let FV_HSENTENCE = prove
+ (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(hsentence Arep) = {})`,
+ SIMP_TAC[hsentence; FV_FIXPOINT; FV_PROV] THEN
+ REWRITE_TAC[FVT_PAIR; FVT_NUMERAL; FVT; UNION_EMPTY; DELETE_INSERT;
+ EMPTY_DELETE]);;
+
+let FV_GSENTENCE = prove
+ (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(gsentence Arep) = {})`,
+ SIMP_TAC[gsentence; FV_HSENTENCE; FV]);;
+
+let SIGMAPI_HSENTENCE = prove
+ (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi T 1 (hsentence Arep)`,
+ SIGMAPI_TAC[hsentence; SIGMAPI_FIXPOINT; SIGMAPI_PROV]);;
+
+let SIGMAPI_GSENTENCE = prove
+ (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi F 1 (gsentence Arep)`,
+ SIGMAPI_TAC[gsentence; SIGMAPI_HSENTENCE]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence the key fixpoint properties. *)
+(* ------------------------------------------------------------------------- *)
+
+let HSENTENCE_FIX_STRONG = prove
+ (`!A Arep.
+ (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A)
+ ==> !v. holds v (hsentence Arep) <=> A |-- Not(hsentence Arep)`,
+ REWRITE_TAC[hsentence; true_def; HOLDS_FIXPOINT] THEN
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PROV) THEN
+ REWRITE_TAC[IN] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
+ DISCH_TAC THEN ASM_REWRITE_TAC[ARITH_PAIR; TERMVAL_NUMERAL] THEN
+ REWRITE_TAC[termval; valmod; GSYM gform] THEN REWRITE_TAC[PROV_THM]);;
+
+let HSENTENCE_FIX = prove
+ (`!A Arep.
+ (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A)
+ ==> (true(hsentence Arep) <=> A |-- Not(hsentence Arep))`,
+ REWRITE_TAC[true_def] THEN MESON_TAC[HSENTENCE_FIX_STRONG]);;
+
+let GSENTENCE_FIX = prove
+ (`!A Arep.
+ (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A)
+ ==> (true(gsentence Arep) <=> ~(A |-- gsentence Arep))`,
+ REWRITE_TAC[true_def; holds; gsentence] THEN
+ MESON_TAC[HSENTENCE_FIX_STRONG]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Auxiliary concepts. *)
+(* ------------------------------------------------------------------------- *)
+
+let ground = new_definition
+ `ground t <=> (FVT t = {})`;;
+
+let complete_for = new_definition
+ `complete_for P A <=> !p. P p /\ true p ==> A |-- p`;;
+
+let sound_for = new_definition
+ `sound_for P A <=> !p. P p /\ A |-- p ==> true p`;;
+
+let consistent = new_definition
+ `consistent A <=> ~(?p. A |-- p /\ A |-- Not p)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* The purest and most symmetric and beautiful form of G1. *)
+(* ------------------------------------------------------------------------- *)
+
+let DEFINABLE_BY_ONEVAR = prove
+ (`definable_by (SIGMA 1) s <=>
+ ?p x. SIGMA 1 p /\ (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`,
+ REWRITE_TAC[definable_by; SIGMA] THEN
+ EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
+ DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN
+ EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN
+ EXISTS_TAC `x:num` THEN ASM_SIMP_TAC[SIGMAPI_CLAUSES; SIGMAPI_FORMSUBST] THEN
+ ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN
+ REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION;
+ COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN
+ MESON_TAC[]);;
+
+let CLOSED_NOT_TRUE = prove
+ (`!p. closed p ==> (true(Not p) <=> ~(true p))`,
+ REWRITE_TAC[closed; true_def; holds] THEN
+ MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);;
+
+let CONSISTENT_ALT = prove
+ (`!A p. A |-- p /\ A |-- Not p <=> A |-- False`,
+ MESON_TAC[proves_RULES; ex_falso; axiom_not; iff_imp1]);;
+
+let G1 = prove
+ (`!A. definable_by (SIGMA 1) (IMAGE gform A)
+ ==> ?G. PI 1 G /\ closed G /\
+ (sound_for (PI 1 INTER closed) A ==> true G /\ ~(A |-- G)) /\
+ (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`,
+ GEN_TAC THEN
+ REWRITE_TAC[sound_for; INTER; IN_ELIM_THM; DEFINABLE_BY_ONEVAR] THEN
+ DISCH_THEN(X_CHOOSE_THEN `Arep:form` (X_CHOOSE_THEN `a:num`
+ STRIP_ASSUME_TAC)) THEN
+ MP_TAC(SPECL [`A:form->bool`; `\t. formsubst ((a |-> t) V) Arep`]
+ GSENTENCE_FIX) THEN
+ REWRITE_TAC[] THEN ANTS_TAC THENL
+ [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; valmod; o_THM];
+ ALL_TAC] THEN
+ STRIP_TAC THEN EXISTS_TAC `gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN
+ ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN
+ REPEAT CONJ_TAC THENL
+ [REWRITE_TAC[PI] THEN MATCH_MP_TAC SIGMAPI_GSENTENCE THEN
+ RULE_ASSUM_TAC(REWRITE_RULE[SIGMA]) THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST];
+ REWRITE_TAC[closed] THEN MATCH_MP_TAC FV_GSENTENCE THEN
+ ASM_REWRITE_TAC[FORMSUBST_FV; EXTENSION; IN_ELIM_THM; IN_SING;
+ valmod; UNWIND_THM2];
+ ALL_TAC] THEN
+ ABBREV_TAC `G = gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN
+ REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN
+ SUBGOAL_THEN `true(Not G)` MP_TAC THENL
+ [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN
+ REWRITE_TAC[SIGMA; SIGMAPI_CLAUSES] THEN ASM_MESON_TAC[closed; FV; PI];
+ ALL_TAC] THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP CLOSED_NOT_TRUE) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
+ SUBGOAL_THEN `true False` MP_TAC THENL
+ [ALL_TAC; REWRITE_TAC[true_def; holds]] THEN
+ FIRST_X_ASSUM MATCH_MP_TAC THEN
+ REWRITE_TAC[closed; IN; SIGMA; SIGMAPI_CLAUSES; FV] THEN
+ ASM_MESON_TAC[CONSISTENT_ALT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Some more familiar variants. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLETE_SOUND_SENTENCE = prove
+ (`consistent A /\ complete_for (sigmapi (~b) n INTER closed) A
+ ==> sound_for (sigmapi b n INTER closed) A`,
+ REWRITE_TAC[consistent; sound_for; complete_for; IN; INTER; IN_ELIM_THM] THEN
+ REWRITE_TAC[NOT_EXISTS_THM] THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ DISCH_THEN(fun th -> X_GEN_TAC `p:form` THEN MP_TAC(SPEC `Not p` th)) THEN
+ REWRITE_TAC[SIGMAPI_CLAUSES] THEN
+ REWRITE_TAC[closed; FV; true_def; holds] THEN
+ ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);;
+
+let G1_TRAD = prove
+ (`!A. consistent A /\
+ complete_for (SIGMA 1 INTER closed) A /\
+ definable_by (SIGMA 1) (IMAGE gform A)
+ ==> ?G. PI 1 G /\ closed G /\ true G /\ ~(A |-- G) /\
+ (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`,
+ REWRITE_TAC[SIGMA] THEN REPEAT STRIP_TAC THEN
+ MP_TAC(SPEC `A:form->bool` G1) THEN ASM_REWRITE_TAC[SIGMA; PI] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[COMPLETE_SOUND_SENTENCE]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Closures and invariance of truth and provability. *)
+(* ------------------------------------------------------------------------- *)
+
+let generalize = new_definition
+ `generalize vs p = ITLIST (!!) vs p`;;
+
+let TRUE_GENERALIZE = prove
+ (`!vs p. true(generalize vs p) <=> true p`,
+ REWRITE_TAC[generalize; true_def] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST; holds] THEN GEN_TAC THEN
+ FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
+ MESON_TAC[VALMOD_REPEAT]);;
+
+let PROVABLE_GENERALIZE = prove
+ (`!A p vs. A |-- generalize vs p <=> A |-- p`,
+ GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[generalize] THEN LIST_INDUCT_TAC THEN
+ REWRITE_TAC[ITLIST] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
+ MESON_TAC[spec; gen; FORMSUBST_TRIV; ASSIGN_TRIV]);;
+
+let FV_GENERALIZE = prove
+ (`!p vs. FV(generalize vs p) = FV(p) DIFF (set_of_list vs)`,
+ GEN_TAC THEN REWRITE_TAC[generalize] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[set_of_list; DIFF_EMPTY; ITLIST] THEN
+ ASM_REWRITE_TAC[FV] THEN SET_TAC[]);;
+
+let closure = new_definition
+ `closure p = generalize (list_of_set(FV p)) p`;;
+
+let CLOSED_CLOSURE = prove
+ (`!p. closed(closure p)`,
+ REWRITE_TAC[closed; closure; FV_GENERALIZE] THEN
+ SIMP_TAC[SET_OF_LIST_OF_SET; FV_FINITE; DIFF_EQ_EMPTY]);;
+
+let TRUE_CLOSURE = prove
+ (`!p. true(closure p) <=> true p`,
+ REWRITE_TAC[closure; TRUE_GENERALIZE]);;
+
+let PROVABLE_CLOSURE = prove
+ (`!A p. A |-- closure p <=> A |-- p`,
+ REWRITE_TAC[closure; PROVABLE_GENERALIZE]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Other stuff. *)
+(* ------------------------------------------------------------------------- *)
+
+let complete = new_definition
+ `complete A <=> !p. closed p ==> A |-- p \/ A |-- Not p`;;
+
+let sound = new_definition
+ `sound A <=> !p. A |-- p ==> true p`;;
+
+let semcomplete = new_definition
+ `semcomplete A <=> !p. true p ==> A |-- p`;;
+
+let DEFINABLE_DEFINABLE_BY = prove
+ (`definable = definable_by (\x. T)`,
+ REWRITE_TAC[FUN_EQ_THM; definable; definable_by]);;
+
+let DEFINABLE_ONEVAR = prove
+ (`definable s <=> ?p x. (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`,
+ REWRITE_TAC[definable] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
+ DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN
+ EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN
+ EXISTS_TAC `x:num` THEN
+ ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN
+ REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION;
+ COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN
+ MESON_TAC[]);;
+
+let CLOSED_TRUE_OR_FALSE = prove
+ (`!p. closed p ==> true p \/ true(Not p)`,
+ REWRITE_TAC[closed; true_def; holds] THEN REPEAT STRIP_TAC THEN
+ ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);;
+
+let SEMCOMPLETE_IMP_COMPLETE = prove
+ (`!A. semcomplete A ==> complete A`,
+ REWRITE_TAC[semcomplete; complete] THEN MESON_TAC[CLOSED_TRUE_OR_FALSE]);;
+
+let SOUND_CLOSED = prove
+ (`sound A = !p. closed p /\ A |-- p ==> true p`,
+ REWRITE_TAC[sound] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
+ MESON_TAC[TRUE_CLOSURE; PROVABLE_CLOSURE; CLOSED_CLOSURE]);;
+
+let SOUND_IMP_CONSISTENT = prove
+ (`!A. sound A ==> consistent A`,
+ REWRITE_TAC[sound; consistent; CONSISTENT_ALT] THEN
+ SUBGOAL_THEN `~(true False)` (fun th -> MESON_TAC[th]) THEN
+ REWRITE_TAC[true_def; holds]);;
+
+let SEMCOMPLETE_SOUND_EQ_CONSISTENT = prove
+ (`!A. semcomplete A ==> (sound A <=> consistent A)`,
+ REWRITE_TAC[semcomplete] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
+ REWRITE_TAC[SOUND_IMP_CONSISTENT] THEN
+ REWRITE_TAC[consistent; SOUND_CLOSED] THEN
+ ASM_MESON_TAC[CLOSED_TRUE_OR_FALSE]);;
--- /dev/null
+(* ========================================================================= *)
+(* Two interesting axiom systems: full Peano Arithmetic and Robinson's Q. *)
+(* ========================================================================= *)
+
+(* ------------------------------------------------------------------------- *)
+(* We define PA as an "inductive" predicate because the pattern-matching *)
+(* is a bit nicer, but of course we could just define the term explicitly. *)
+(* In effect, the returned PA_CASES would be our explicit definition. *)
+(* *)
+(* The induction axiom is done a little strangely in order to avoid using *)
+(* substitution as a primitive concept. *)
+(* ------------------------------------------------------------------------- *)
+
+let PA_RULES,PA_INDUCT,PA_CASES = new_inductive_definition
+ `(!s. PA(Not (Z === Suc(s)))) /\
+ (!s t. PA(Suc(s) === Suc(t) --> s === t)) /\
+ (!t. PA(t ++ Z === t)) /\
+ (!s t. PA(s ++ Suc(t) === Suc(s ++ t))) /\
+ (!t. PA(t ** Z === Z)) /\
+ (!s t. PA(s ** Suc(t) === s ** t ++ s)) /\
+ (!p i j. ~(j IN FV(p))
+ ==> PA
+ ((??i (V i === Z && p)) &&
+ (!!j (??i (V i === V j && p)
+ --> ??i (V i === Suc(V j) && p)))
+ --> !!i p))`;;
+
+let PA_SOUND = prove
+ (`!A p. (!a. a IN A ==> true a) /\ (PA UNION A) |-- p ==> true p`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC THEOREMS_TRUE THEN
+ EXISTS_TAC `PA UNION A` THEN
+ ASM_SIMP_TAC[IN_UNION; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN
+ REWRITE_TAC[IN] THEN MATCH_MP_TAC PA_INDUCT THEN
+ REWRITE_TAC[true_def; holds; termval] THEN
+ REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
+ [SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; EXP; SUC_INJ; NOT_SUC] THEN ARITH_TAC;
+ ALL_TAC] THEN
+ MAP_EVERY X_GEN_TAC [`q:form`; `i:num`; `j:num`] THEN
+ ASM_CASES_TAC `j:num = i` THEN
+ ASM_REWRITE_TAC[VALMOD; VALMOD_VALMOD_BASIC] THEN
+ SIMP_TAC[HOLDS_VALMOD_OTHER] THENL [MESON_TAC[]; ALL_TAC] THEN
+ REWRITE_TAC[UNWIND_THM2] THEN DISCH_TAC THEN
+ SUBGOAL_THEN
+ `!a b v. holds ((i |-> a) ((j |-> b) v)) q <=> holds ((i |-> a) v) q`
+ (fun th -> REWRITE_TAC[th])
+ THENL
+ [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN
+ ASM_REWRITE_TAC[valmod] THEN ASM_MESON_TAC[];
+ GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Robinson's axiom system Q. *)
+(* *)
+(* <<(forall m n. S(m) = S(n) ==> m = n) /\ *)
+(* (forall n. ~(n = 0) <=> exists m. n = S(m)) /\ *)
+(* (forall n. 0 + n = n) /\ *)
+(* (forall m n. S(m) + n = S(m + n)) /\ *)
+(* (forall n. 0 * n = 0) /\ *)
+(* (forall m n. S(m) * n = n + m * n) /\ *)
+(* (forall m n. m <= n <=> exists d. m + d = n) /\ *)
+(* (forall m n. m < n <=> S(m) <= n)>>;; *)
+(* ------------------------------------------------------------------------- *)
+
+let robinson = new_definition
+ `robinson =
+ (!!0 (!!1 (Suc(V 0) === Suc(V 1) --> V 0 === V 1))) &&
+ (!!1 (Not(V 1 === Z) <-> ??0 (V 1 === Suc(V 0)))) &&
+ (!!1 (Z ++ V 1 === V 1)) &&
+ (!!0 (!!1 (Suc(V 0) ++ V 1 === Suc(V 0 ++ V 1)))) &&
+ (!!1 (Z ** V 1 === Z)) &&
+ (!!0 (!!1 (Suc(V 0) ** V 1 === V 1 ++ V 0 ** V 1))) &&
+ (!!0 (!!1 (V 0 <<= V 1 <-> ??2 (V 0 ++ V 2 === V 1)))) &&
+ (!!0 (!!1 (V 0 << V 1 <-> Suc(V 0) <<= V 1)))`;;
--- /dev/null
+(* ========================================================================= *)
+(* Arithmetization of syntax and Tarski's theorem. *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* This is to fake the fact that we might really be using strings. *)
+(* ------------------------------------------------------------------------- *)
+
+let number = new_definition
+ `number(x) = 2 * (x DIV 2) + (1 - x MOD 2)`;;
+
+let denumber = new_definition
+ `denumber = number`;;
+
+let NUMBER_DENUMBER = prove
+ (`(!s. denumber(number s) = s) /\
+ (!n. number(denumber n) = n)`,
+ REWRITE_TAC[number; denumber] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
+ SIMP_TAC[ARITH_RULE `x < 2 ==> (2 * y + x) DIV 2 = y`;
+ MOD_MULT_ADD; MOD_LT; GSYM DIVISION; ARITH_EQ;
+ ARITH_RULE `1 - m < 2`; ARITH_RULE `x < 2 ==> 1 - (1 - x) = x`]);;
+
+let NUMBER_INJ = prove
+ (`!x y. number(x) = number(y) <=> x = y`,
+ MESON_TAC[NUMBER_DENUMBER]);;
+
+let NUMBER_SURJ = prove
+ (`!y. ?x. number(x) = y`,
+ MESON_TAC[NUMBER_DENUMBER]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetization. *)
+(* ------------------------------------------------------------------------- *)
+
+let gterm = new_recursive_definition term_RECURSION
+ `(gterm (V x) = NPAIR 0 (number x)) /\
+ (gterm Z = NPAIR 1 0) /\
+ (gterm (Suc t) = NPAIR 2 (gterm t)) /\
+ (gterm (s ++ t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\
+ (gterm (s ** t) = NPAIR 4 (NPAIR (gterm s) (gterm t)))`;;
+
+let gform = new_recursive_definition form_RECURSION
+ `(gform False = NPAIR 0 0) /\
+ (gform True = NPAIR 0 1) /\
+ (gform (s === t) = NPAIR 1 (NPAIR (gterm s) (gterm t))) /\
+ (gform (s << t) = NPAIR 2 (NPAIR (gterm s) (gterm t))) /\
+ (gform (s <<= t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\
+ (gform (Not p) = NPAIR 4 (gform p)) /\
+ (gform (p && q) = NPAIR 5 (NPAIR (gform p) (gform q))) /\
+ (gform (p || q) = NPAIR 6 (NPAIR (gform p) (gform q))) /\
+ (gform (p --> q) = NPAIR 7 (NPAIR (gform p) (gform q))) /\
+ (gform (p <-> q) = NPAIR 8 (NPAIR (gform p) (gform q))) /\
+ (gform (!! x p) = NPAIR 9 (NPAIR (number x) (gform p))) /\
+ (gform (?? x p) = NPAIR 10 (NPAIR (number x) (gform p)))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Injectivity. *)
+(* ------------------------------------------------------------------------- *)
+
+let GTERM_INJ = prove
+ (`!s t. (gterm s = gterm t) <=> (s = t)`,
+ MATCH_MP_TAC term_INDUCT THEN REPEAT CONJ_TAC THENL
+ [ALL_TAC;
+ GEN_TAC;
+ GEN_TAC THEN DISCH_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC] THEN
+ MATCH_MP_TAC term_INDUCT THEN
+ ASM_REWRITE_TAC[term_DISTINCT; term_INJ; gterm;
+ NPAIR_INJ; NUMBER_INJ; ARITH_EQ]);;
+
+let GFORM_INJ = prove
+ (`!p q. (gform p = gform q) <=> (p = q)`,
+ MATCH_MP_TAC form_INDUCT THEN REPEAT CONJ_TAC THENL
+ [ALL_TAC;
+ ALL_TAC;
+ GEN_TAC THEN GEN_TAC;
+ GEN_TAC THEN GEN_TAC;
+ GEN_TAC THEN GEN_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC;
+ REPEAT GEN_TAC THEN STRIP_TAC] THEN
+ MATCH_MP_TAC form_INDUCT THEN
+ ASM_REWRITE_TAC[form_DISTINCT; form_INJ; gform; NPAIR_INJ; ARITH_EQ] THEN
+ REWRITE_TAC[GTERM_INJ; NUMBER_INJ]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Useful case theorems. *)
+(* ------------------------------------------------------------------------- *)
+
+let GTERM_CASES = prove
+ (`((gterm u = NPAIR 0 (number x)) <=> (u = V x)) /\
+ ((gterm u = NPAIR 1 0) <=> (u = Z)) /\
+ ((gterm u = NPAIR 2 n) <=> (?t. (u = Suc t) /\ (gterm t = n))) /\
+ ((gterm u = NPAIR 3 (NPAIR m n)) <=>
+ (?s t. (u = s ++ t) /\ (gterm s = m) /\ (gterm t = n))) /\
+ ((gterm u = NPAIR 4 (NPAIR m n)) <=>
+ (?s t. (u = s ** t) /\ (gterm s = m) /\ (gterm t = n)))`,
+ STRUCT_CASES_TAC(SPEC `u:term` term_CASES) THEN
+ ASM_REWRITE_TAC[gterm; NPAIR_INJ; ARITH_EQ; NUMBER_INJ;
+ term_DISTINCT; term_INJ] THEN
+ MESON_TAC[]);;
+
+let GFORM_CASES = prove
+ (`((gform r = NPAIR 0 0) <=> (r = False)) /\
+ ((gform r = NPAIR 0 1) <=> (r = True)) /\
+ ((gform r = NPAIR 1 (NPAIR m n)) <=>
+ (?s t. (r = s === t) /\ (gterm s = m) /\ (gterm t = n))) /\
+ ((gform r = NPAIR 2 (NPAIR m n)) <=>
+ (?s t. (r = s << t) /\ (gterm s = m) /\ (gterm t = n))) /\
+ ((gform r = NPAIR 3 (NPAIR m n)) <=>
+ (?s t. (r = s <<= t) /\ (gterm s = m) /\ (gterm t = n))) /\
+ ((gform r = NPAIR 4 n) = (?p. (r = Not p) /\ (gform p = n))) /\
+ ((gform r = NPAIR 5 (NPAIR m n)) <=>
+ (?p q. (r = p && q) /\ (gform p = m) /\ (gform q = n))) /\
+ ((gform r = NPAIR 6 (NPAIR m n)) <=>
+ (?p q. (r = p || q) /\ (gform p = m) /\ (gform q = n))) /\
+ ((gform r = NPAIR 7 (NPAIR m n)) <=>
+ (?p q. (r = p --> q) /\ (gform p = m) /\ (gform q = n))) /\
+ ((gform r = NPAIR 8 (NPAIR m n)) <=>
+ (?p q. (r = p <-> q) /\ (gform p = m) /\ (gform q = n))) /\
+ ((gform r = NPAIR 9 (NPAIR (number x) n)) <=>
+ (?p. (r = !!x p) /\ (gform p = n))) /\
+ ((gform r = NPAIR 10 (NPAIR (number x) n)) <=>
+ (?p. (r = ??x p) /\ (gform p = n)))`,
+ STRUCT_CASES_TAC(SPEC `r:form` form_CASES) THEN
+ ASM_REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ; NUMBER_INJ;
+ form_DISTINCT; form_INJ] THEN
+ MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Definability of "godel number of numeral n". *)
+(* ------------------------------------------------------------------------- *)
+
+let gnumeral = new_definition
+ `gnumeral m n = (gterm(numeral m) = n)`;;
+
+let arith_gnumeral1 = new_definition
+ `arith_gnumeral1 a b = formsubst ((3 |-> a) ((4 |-> b) V))
+ (??0 (??1
+ (V 3 === arith_pair (V 0) (V 1) &&
+ V 4 === arith_pair (Suc(V 0)) (arith_pair (numeral 2) (V 1)))))`;;
+
+let ARITH_GNUMERAL1 = prove
+ (`!v a b. holds v (arith_gnumeral1 a b) <=>
+ ?x y. termval v a = NPAIR x y /\
+ termval v b = NPAIR (SUC x) (NPAIR 2 y)`,
+ REWRITE_TAC[arith_gnumeral1; holds; HOLDS_FORMSUBST] THEN
+ REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod; ARITH_PAIR; TERMVAL_NUMERAL]);;
+
+let FV_GNUMERAL1 = prove
+ (`!s t. FV(arith_gnumeral1 s t) = FVT s UNION FVT t`,
+ REWRITE_TAC[arith_gnumeral1] THEN FV_TAC[FVT_PAIR; FVT_NUMERAL]);;
+
+let arith_gnumeral1' = new_definition
+ `arith_gnumeral1' x y = arith_rtc arith_gnumeral1 x y`;;
+
+let ARITH_GNUMERAL1' = prove
+ (`!v s t. holds v (arith_gnumeral1' s t) <=>
+ RTC (\a b. ?x y. a = NPAIR x y /\
+ b = NPAIR (SUC x) (NPAIR 2 y))
+ (termval v s) (termval v t)`,
+ REWRITE_TAC[arith_gnumeral1'] THEN MATCH_MP_TAC ARITH_RTC THEN
+ REWRITE_TAC[ARITH_GNUMERAL1]);;
+
+let FV_GNUMERAL1' = prove
+ (`!s t. FV(arith_gnumeral1' s t) = FVT s UNION FVT t`,
+ SIMP_TAC[arith_gnumeral1'; FV_RTC; FV_GNUMERAL1]);;
+
+let arith_gnumeral = new_definition
+ `arith_gnumeral n p =
+ formsubst ((0 |-> n) ((1 |-> p) V))
+ (arith_gnumeral1' (arith_pair Z (numeral 3))
+ (arith_pair (V 0) (V 1)))`;;
+
+let ARITH_GNUMERAL = prove
+ (`!v s t. holds v (arith_gnumeral s t) <=>
+ gnumeral (termval v s) (termval v t)`,
+ REWRITE_TAC[arith_gnumeral; holds; HOLDS_FORMSUBST;
+ ARITH_GNUMERAL1'; ARITH_PAIR; TERMVAL_NUMERAL] THEN
+ REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod] THEN
+ MP_TAC(INST
+ [`(gterm o numeral)`,`fn:num->num`;
+ `3`,`e:num`;
+ `\a:num b:num. NPAIR 2 a`,`f:num->num->num`] PRIMREC_SIGMA) THEN
+ ANTS_TAC THENL
+ [REWRITE_TAC[gterm; numeral; o_THM] THEN REWRITE_TAC[NPAIR; ARITH];
+ SIMP_TAC[gnumeral; o_THM]]);;
+
+let FV_GNUMERAL = prove
+ (`!s t. FV(arith_gnumeral s t) = FVT(s) UNION FVT(t)`,
+ REWRITE_TAC[arith_gnumeral] THEN
+ FV_TAC[FV_GNUMERAL1'; FVT_PAIR; FVT_NUMERAL]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Diagonal substitution. *)
+(* ------------------------------------------------------------------------- *)
+
+let qdiag = new_definition
+ `qdiag x q = qsubst (x,numeral(gform q)) q`;;
+
+let arith_qdiag = new_definition
+ `arith_qdiag x s t =
+ formsubst ((1 |-> s) ((2 |-> t) V))
+ (?? 3
+ (arith_gnumeral (V 1) (V 3) &&
+ arith_pair (numeral 10) (arith_pair (numeral(number x))
+ (arith_pair (numeral 5)
+ (arith_pair (arith_pair (numeral 1)
+ (arith_pair (arith_pair (numeral 0) (numeral(number x))) (V 3)))
+ (V 1)))) ===
+ V 2))`;;
+
+let QDIAG_FV = prove
+ (`FV(qdiag x q) = FV(q) DELETE x`,
+ REWRITE_TAC[qdiag; FV_QSUBST; FVT_NUMERAL; UNION_EMPTY]);;
+
+let HOLDS_QDIAG = prove
+ (`!v x q. holds v (qdiag x q) = holds ((x |-> gform q) v) q`,
+ SIMP_TAC[qdiag; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY; TERMVAL_NUMERAL]);;
+
+let ARITH_QDIAG = prove
+ (`(termval v s = gform p)
+ ==> (holds v (arith_qdiag x s t) <=> (termval v t = gform(qdiag x p)))`,
+ REPEAT STRIP_TAC THEN
+ REWRITE_TAC[qdiag; qsubst; arith_qdiag; gform; gterm] THEN
+ ASM_REWRITE_TAC[HOLDS_FORMSUBST; holds; termval; TERMVAL_NUMERAL;
+ gnumeral; ARITH_GNUMERAL; ARITH_PAIR] THEN
+ ASM_REWRITE_TAC[o_DEF; valmod; ARITH_EQ; termval] THEN MESON_TAC[]);;
+
+let FV_QDIAG = prove
+ (`!x s t. FV(arith_qdiag x s t) = FVT(s) UNION FVT(t)`,
+ REWRITE_TAC[arith_qdiag; FORMSUBST_FV; FV; FV_GNUMERAL; FVT_PAIR;
+ UNION_EMPTY; FVT_NUMERAL; FVT; TERMSUBST_FVT] THEN
+ REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
+ REWRITE_TAC[DISJ_ACI; IN_DELETE; IN_UNION; IN_SING] THEN
+ REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN
+ REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN
+ REWRITE_TAC[valmod; ARITH_EQ; DISJ_ACI]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence diagonalization of a predicate. *)
+(* ------------------------------------------------------------------------- *)
+
+let diagonalize = new_definition
+ `diagonalize x q =
+ let y = VARIANT(x INSERT FV(q)) in
+ ??y (arith_qdiag x (V x) (V y) && formsubst ((x |-> V y) V) q)`;;
+
+let FV_DIAGONALIZE = prove
+ (`!x q. FV(diagonalize x q) = x INSERT (FV q)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN
+ REWRITE_TAC[FV; FV_QDIAG; FORMSUBST_FV; EXTENSION; IN_INSERT; IN_DELETE;
+ IN_UNION; IN_ELIM_THM; FVT; NOT_IN_EMPTY] THEN
+ X_GEN_TAC `u:num` THEN
+ SUBGOAL_THEN `~(y = x) /\ !z. z IN FV(q) ==> ~(y = z)` STRIP_ASSUME_TAC THENL
+ [ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT];
+ ALL_TAC] THEN
+ ASM_CASES_TAC `u:num = x` THEN ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `u:num = y` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[valmod; COND_RAND; FVT; IN_SING; COND_EXPAND] THEN
+ ASM_MESON_TAC[]);;
+
+let ARITH_DIAGONALIZE = prove
+ (`(v x = gform p)
+ ==> !q. holds v (diagonalize x q) <=> holds ((x |-> gform(qdiag x p)) v) q`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN
+ REWRITE_TAC[holds] THEN
+ SUBGOAL_THEN `!a. holds ((y |-> a) v) (arith_qdiag x (V x) (V y)) <=>
+ (termval ((y |-> a) v) (V y) = gform(qdiag x p))`
+ (fun th -> REWRITE_TAC[th])
+ THENL
+ [GEN_TAC THEN MATCH_MP_TAC ARITH_QDIAG THEN REWRITE_TAC[termval; valmod] THEN
+ SUBGOAL_THEN `~(x:num = y)` (fun th -> ASM_REWRITE_TAC[th]) THEN
+ ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT];
+ ALL_TAC] THEN
+ REWRITE_TAC[HOLDS_FORMSUBST; termval; VALMOD_BASIC; UNWIND_THM2] THEN
+ MATCH_MP_TAC HOLDS_VALUATION THEN
+ X_GEN_TAC `u:num` THEN DISCH_TAC THEN
+ REWRITE_TAC[o_THM; termval; valmod] THEN
+ COND_CASES_TAC THEN REWRITE_TAC[termval] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* And hence the fixed point. *)
+(* ------------------------------------------------------------------------- *)
+
+let fixpoint = new_definition
+ `fixpoint x q = qdiag x (diagonalize x q)`;;
+
+let FV_FIXPOINT = prove
+ (`!x p. FV(fixpoint x p) = FV(p) DELETE x`,
+ REWRITE_TAC[fixpoint; FV_QDIAG; QDIAG_FV; FV_DIAGONALIZE;
+ FVT_NUMERAL] THEN
+ SET_TAC[]);;
+
+let HOLDS_FIXPOINT = prove
+ (`!x p v. holds v (fixpoint x p) <=>
+ holds ((x |-> gform(fixpoint x p)) v) p`,
+ REPEAT GEN_TAC THEN SIMP_TAC[fixpoint; holds; HOLDS_QDIAG] THEN
+ SUBGOAL_THEN
+ `((x |-> gform(diagonalize x p)) v) x = gform (diagonalize x p)`
+ MP_TAC THENL [REWRITE_TAC[VALMOD_BASIC]; ALL_TAC] THEN
+ DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ARITH_DIAGONALIZE th]) THEN
+ REWRITE_TAC[VALMOD_VALMOD_BASIC]);;
+
+let HOLDS_IFF_FIXPOINT = prove
+ (`!x p v. holds v
+ (fixpoint x p <-> qsubst (x,numeral(gform(fixpoint x p))) p)`,
+ SIMP_TAC[holds; HOLDS_FIXPOINT; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY;
+ TERMVAL_NUMERAL]);;
+
+let CARNAP = prove
+ (`!x q. ?p. (FV(p) = FV(q) DELETE x) /\
+ true (p <-> qsubst (x,numeral(gform p)) q)`,
+ REPEAT GEN_TAC THEN EXISTS_TAC `fixpoint x q` THEN
+ REWRITE_TAC[true_def; HOLDS_IFF_FIXPOINT; FV_FIXPOINT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence Tarski's theorem on the undefinability of truth. *)
+(* ------------------------------------------------------------------------- *)
+
+let definable_by = new_definition
+ `definable_by P s <=> ?p x. P p /\ (!v. holds v p <=> (v(x)) IN s)`;;
+
+let definable = new_definition
+ `definable s <=> ?p x. !v. holds v p <=> (v(x)) IN s`;;
+
+let TARSKI_THEOREM = prove
+ (`~(definable {gform p | true p})`,
+ REWRITE_TAC[definable; IN_ELIM_THM; NOT_EXISTS_THM] THEN
+ MAP_EVERY X_GEN_TAC [`p:form`; `x:num`] THEN DISCH_TAC THEN
+ MP_TAC(SPECL [`x:num`; `Not p`] CARNAP) THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:form` (MP_TAC o CONJUNCT2)) THEN
+ SIMP_TAC[true_def; holds; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY] THEN
+ ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[VALMOD_BASIC; TERMVAL_NUMERAL] THEN
+ REWRITE_TAC[true_def; GFORM_INJ] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Misc. stuff to sanity-check the book. *)
+(* ------------------------------------------------------------------------- *)
+
+(*****
+let pairpair = new_definition
+ `pair(x,y) = NPAIR x y`;;
+
+let BREAK =
+ rand o concl o (ONCE_REWRITE_CONV[gform; gterm] THENC
+ REWRITE_CONV[GSYM pairpair]);;
+
+let tm0 = `gform(?? x (V x === k && p))`;;
+let tm1 = BREAK tm0;;
+let tm2 = BREAK tm1;;
+let tm3 = BREAK tm2;;
+let tm4 = BREAK tm3;;
+
+******)
--- /dev/null
+(* ========================================================================= *)
+(* Basic theory of divisibility, gcd, coprimality and primality (over N). *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* HOL88 compatibility (since all this is a port of old HOL88 stuff). *)
+(* ------------------------------------------------------------------------- *)
+
+let MULT_MONO_EQ = prove
+ (`!m i n. ((SUC n) * m = (SUC n) * i) <=> (m = i)`,
+ REWRITE_TAC[EQ_MULT_LCANCEL; NOT_SUC]);;
+
+let LESS_ADD_1 = prove
+ (`!m n. n < m ==> (?p. m = n + (p + 1))`,
+ REWRITE_TAC[LT_EXISTS; ADD1; ADD_ASSOC]);;
+
+let LESS_ADD_SUC = ARITH_RULE `!m n. m < (m + (SUC n))`;;
+
+let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;;
+
+let LESS_MONO_ADD = ARITH_RULE `!m n p. m < n ==> (m + p) < (n + p)`;;
+
+let LESS_EQ_0 = prove
+ (`!n. n <= 0 <=> (n = 0)`,
+ REWRITE_TAC[LE]);;
+
+let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;;
+
+let LESS_ADD_NONZERO = ARITH_RULE `!m n. ~(n = 0) ==> m < (m + n)`;;
+
+let NOT_EXP_0 = prove
+ (`!m n. ~((SUC n) EXP m = 0)`,
+ REWRITE_TAC[EXP_EQ_0; NOT_SUC]);;
+
+let LESS_THM = ARITH_RULE `!m n. m < (SUC n) <=> (m = n) \/ m < n`;;
+
+let NOT_LESS_0 = ARITH_RULE `!n. ~(n < 0)`;;
+
+let ZERO_LESS_EXP = prove
+ (`!m n. 0 < ((SUC n) EXP m)`,
+ REWRITE_TAC[LT_NZ; NOT_EXP_0]);;
+
+(* ------------------------------------------------------------------------- *)
+(* General arithmetic lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+let MULT_FIX = prove(
+ `!x y. (x * y = x) <=> (x = 0) \/ (y = 1)`,
+ REPEAT GEN_TAC THEN
+ STRUCT_CASES_TAC(SPEC `x:num` num_CASES) THEN
+ REWRITE_TAC[MULT_CLAUSES; NOT_SUC] THEN
+ REWRITE_TAC[GSYM(el 4 (CONJUNCTS (SPEC_ALL MULT_CLAUSES)))] THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
+ [GSYM(el 3 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN
+ MATCH_ACCEPT_TAC MULT_MONO_EQ);;
+
+let LESS_EQ_MULT = prove(
+ `!m n p q. m <= n /\ p <= q ==> (m * p) <= (n * q)`,
+ REPEAT GEN_TAC THEN
+ DISCH_THEN(STRIP_ASSUME_TAC o REWRITE_RULE[LE_EXISTS]) THEN
+ ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB;
+ GSYM ADD_ASSOC; LE_ADD]);;
+
+let LESS_MULT = prove(
+ `!m n p q. m < n /\ p < q ==> (m * p) < (n * q)`,
+ REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN
+ ((CHOOSE_THEN SUBST_ALL_TAC) o MATCH_MP LESS_ADD_1)) THEN
+ REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN
+ REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; ADD_CLAUSES; GSYM ADD_ASSOC] THEN
+ ONCE_REWRITE_TAC[GSYM (el 3 (CONJUNCTS ADD_CLAUSES))] THEN
+ MATCH_ACCEPT_TAC LESS_ADD_SUC);;
+
+let MULT_LCANCEL = prove(
+ `!a b c. ~(a = 0) /\ (a * b = a * c) ==> (b = c)`,
+ REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `a:num` num_CASES) THEN
+ REWRITE_TAC[NOT_SUC; MULT_MONO_EQ]);;
+
+let LT_POW2_REFL = prove
+ (`!n. n < 2 EXP n`,
+ INDUCT_TAC THEN REWRITE_TAC[EXP] THEN TRY(POP_ASSUM MP_TAC) THEN ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Properties of the exponential function. *)
+(* ------------------------------------------------------------------------- *)
+
+let EXP_0 = prove
+ (`!n. 0 EXP (SUC n) = 0`,
+ REWRITE_TAC[EXP; MULT_CLAUSES]);;
+
+let EXP_MONO_LT_SUC = prove
+ (`!n x y. (x EXP (SUC n)) < (y EXP (SUC n)) <=> (x < y)`,
+ REWRITE_TAC[EXP_MONO_LT; NOT_SUC]);;
+
+let EXP_MONO_LE_SUC = prove
+ (`!x y n. (x EXP (SUC n)) <= (y EXP (SUC n)) <=> x <= y`,
+ REWRITE_TAC[EXP_MONO_LE; NOT_SUC]);;
+
+let EXP_MONO_EQ_SUC = prove
+ (`!x y n. (x EXP (SUC n) = y EXP (SUC n)) <=> (x = y)`,
+ REWRITE_TAC[EXP_MONO_EQ; NOT_SUC]);;
+
+let EXP_EXP = prove
+ (`!x m n. (x EXP m) EXP n = x EXP (m * n)`,
+ REWRITE_TAC[EXP_MULT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* More ad-hoc arithmetic lemmas unlikely to be useful elsewhere. *)
+(* ------------------------------------------------------------------------- *)
+
+let DIFF_LEMMA = prove(
+ `!a b. a < b ==> (a = 0) \/ (a + (b - a)) < (a + b)`,
+ REPEAT GEN_TAC THEN
+ DISJ_CASES_TAC(SPEC `a:num` LESS_0_CASES) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN
+ DISJ2_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM (CONJUNCT1 ADD_CLAUSES)] THEN
+ REWRITE_TAC[ADD_ASSOC] THEN
+ REPEAT(MATCH_MP_TAC LESS_MONO_ADD) THEN POP_ASSUM ACCEPT_TAC);;
+
+let NOT_EVEN_EQ_ODD = prove(
+ `!m n. ~(2 * m = SUC(2 * n))`,
+ REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN
+ REWRITE_TAC[EVEN; EVEN_MULT; ARITH]);;
+
+let CANCEL_TIMES2 = prove(
+ `!x y. (2 * x = 2 * y) <=> (x = y)`,
+ REWRITE_TAC[num_CONV `2`; MULT_MONO_EQ]);;
+
+let EVEN_SQUARE = prove(
+ `!n. EVEN(n) ==> ?x. n EXP 2 = 4 * x`,
+ GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
+ EXISTS_TAC `m * m` THEN REWRITE_TAC[EXP_2] THEN
+ REWRITE_TAC[SYM(REWRITE_CONV[ARITH] `2 * 2`)] THEN
+ REWRITE_TAC[MULT_AC]);;
+
+let ODD_SQUARE = prove(
+ `!n. ODD(n) ==> ?x. n EXP 2 = (4 * x) + 1`,
+ GEN_TAC THEN REWRITE_TAC[ODD_EXISTS] THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
+ ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN
+ REWRITE_TAC[GSYM ADD1; SUC_INJ] THEN
+ EXISTS_TAC `(m * m) + m` THEN
+ REWRITE_TAC(map num_CONV [`4`; `3`; `2`; `1`]) THEN
+ REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN
+ REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN
+ REWRITE_TAC[ADD_AC]);;
+
+let DIFF_SQUARE = prove(
+ `!x y. (x EXP 2) - (y EXP 2) = (x + y) * (x - y)`,
+ REPEAT GEN_TAC THEN
+ DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL
+ [SUBGOAL_THEN `(x * x) <= (y * y)` MP_TAC THENL
+ [MATCH_MP_TAC LESS_EQ_MULT THEN ASM_REWRITE_TAC[];
+ POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM SUB_EQ_0] THEN
+ REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES]];
+ POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN
+ REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN
+ REWRITE_TAC[EXP_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN
+ REWRITE_TAC[GSYM ADD_ASSOC; ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN
+ AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [ADD_SYM] THEN
+ AP_TERM_TAC THEN MATCH_ACCEPT_TAC MULT_SYM]);;
+
+let ADD_IMP_SUB = prove(
+ `!x y z. (x + y = z) ==> (x = z - y)`,
+ REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
+ REWRITE_TAC[ADD_SUB]);;
+
+let ADD_SUM_DIFF = prove(
+ `!v w. v <= w ==> ((w + v) - (w - v) = 2 * v) /\
+ ((w + v) + (w - v) = 2 * w)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN
+ DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN
+ REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN
+ REWRITE_TAC[MULT_2; GSYM ADD_ASSOC] THEN
+ ONCE_REWRITE_TAC[ADD_SYM] THEN
+ REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB; GSYM ADD_ASSOC]);;
+
+let EXP_4 = prove(
+ `!n. n EXP 4 = (n EXP 2) EXP 2`,
+ GEN_TAC THEN REWRITE_TAC[EXP_EXP] THEN
+ REWRITE_TAC[ARITH]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Elementary theory of divisibility *)
+(* ------------------------------------------------------------------------- *)
+
+let divides = prove
+ (`a divides b <=> ?x. b = a * x`,
+ EQ_TAC THENL [REWRITE_TAC[num_divides; int_divides]; NUMBER_TAC] THEN
+ DISCH_THEN(X_CHOOSE_TAC `x:int`) THEN EXISTS_TAC `num_of_int(abs x)` THEN
+ SIMP_TAC[GSYM INT_OF_NUM_EQ;
+ INT_ARITH `&m:int = &n <=> abs(&m :int) = abs(&n)`] THEN
+ ASM_REWRITE_TAC[GSYM INT_OF_NUM_MUL; INT_ABS_MUL] THEN
+ SIMP_TAC[INT_OF_NUM_OF_INT; INT_ABS_POS; INT_ABS_ABS]);;
+
+let DIVIDES_0 = prove
+ (`!x. x divides 0`,
+ NUMBER_TAC);;
+
+let DIVIDES_ZERO = prove
+ (`!x. 0 divides x <=> (x = 0)`,
+ NUMBER_TAC);;
+
+let DIVIDES_1 = prove
+ (`!x. 1 divides x`,
+ NUMBER_TAC);;
+
+let DIVIDES_ONE = prove(
+ `!x. (x divides 1) <=> (x = 1)`,
+ GEN_TAC THEN REWRITE_TAC[divides] THEN
+ CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
+ REWRITE_TAC[MULT_EQ_1] THEN EQ_TAC THEN STRIP_TAC THEN
+ ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN REFL_TAC);;
+
+let DIVIDES_REFL = prove
+ (`!x. x divides x`,
+ NUMBER_TAC);;
+
+let DIVIDES_TRANS = prove
+ (`!a b c. a divides b /\ b divides c ==> a divides c`,
+ NUMBER_TAC);;
+
+let DIVIDES_ANTISYM = prove
+ (`!x y. x divides y /\ y divides x <=> (x = y)`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (CHOOSE_THEN SUBST1_TAC)) THEN
+ DISCH_THEN(CHOOSE_THEN MP_TAC) THEN
+ CONV_TAC(LAND_CONV SYM_CONV) THEN
+ REWRITE_TAC[GSYM MULT_ASSOC; MULT_FIX; MULT_EQ_1] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[];
+ DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[DIVIDES_REFL]]);;
+
+let DIVIDES_ADD = prove
+ (`!d a b. d divides a /\ d divides b ==> d divides (a + b)`,
+ NUMBER_TAC);;
+
+let DIVIDES_SUB = prove
+ (`!d a b. d divides a /\ d divides b ==> d divides (a - b)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN (CHOOSE_THEN SUBST1_TAC)) THEN
+ REWRITE_TAC[GSYM LEFT_SUB_DISTRIB] THEN
+ W(EXISTS_TAC o rand o lhs o snd o dest_exists o snd) THEN
+ REFL_TAC);;
+
+let DIVIDES_LMUL = prove
+ (`!d a x. d divides a ==> d divides (x * a)`,
+ NUMBER_TAC);;
+
+let DIVIDES_RMUL = prove
+ (`!d a x. d divides a ==> d divides (a * x)`,
+ NUMBER_TAC);;
+
+let DIVIDES_ADD_REVR = prove
+ (`!d a b. d divides a /\ d divides (a + b) ==> d divides b`,
+ NUMBER_TAC);;
+
+let DIVIDES_ADD_REVL = prove
+ (`!d a b. d divides b /\ d divides (a + b) ==> d divides a`,
+ NUMBER_TAC);;
+
+let DIVIDES_DIV = prove
+ (`!n x. 0 < n /\ (x MOD n = 0) ==> n divides x`,
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `x:num` o MATCH_MP DIVISION o
+ MATCH_MP (ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN
+ ASM_REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN
+ REWRITE_TAC[divides] THEN EXISTS_TAC `x DIV n` THEN
+ ONCE_REWRITE_TAC[MULT_SYM] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);;
+
+let DIVIDES_MUL_L = prove
+ (`!a b c. a divides b ==> (c * a) divides (c * b)`,
+ NUMBER_TAC);;
+
+let DIVIDES_MUL_R = prove
+ (`!a b c. a divides b ==> (a * c) divides (b * c)`,
+ NUMBER_TAC);;
+
+let DIVIDES_LMUL2 = prove
+ (`!d a x. (x * d) divides a ==> d divides a`,
+ NUMBER_TAC);;
+
+let DIVIDES_RMUL2 = prove
+ (`!d a x. (d * x) divides a ==> d divides a`,
+ NUMBER_TAC);;
+
+let DIVIDES_CMUL2 = prove
+ (`!a b c. (c * a) divides (c * b) /\ ~(c = 0) ==> a divides b`,
+ NUMBER_TAC);;
+
+let DIVIDES_LMUL2_EQ = prove
+ (`!a b c. ~(c = 0) ==> ((c * a) divides (c * b) <=> a divides b)`,
+ NUMBER_TAC);;
+
+let DIVIDES_RMUL2_EQ = prove
+ (`!a b c. ~(c = 0) ==> ((a * c) divides (b * c) <=> a divides b)`,
+ NUMBER_TAC);;
+
+let DIVIDES_CASES = prove
+ (`!m n. n divides m ==> m = 0 \/ m = n \/ 2 * n <= m`,
+ SIMP_TAC[ARITH_RULE `m = n \/ 2 * n <= m <=> m = n * 1 \/ n * 2 <= m`] THEN
+ SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN
+ REWRITE_TAC[MULT_EQ_0; EQ_MULT_LCANCEL; LE_MULT_LCANCEL] THEN ARITH_TAC);;
+
+let DIVIDES_LE = prove
+ (`!m n. m divides n ==> m <= n \/ (n = 0)`,
+ REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_CASES) THEN
+ ARITH_TAC);;
+
+let DIVIDES_LE_STRONG = prove
+ (`!m n. m divides n ==> 1 <= m /\ m <= n \/ n = 0`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THEN
+ ASM_REWRITE_TAC[DIVIDES_ZERO; ARITH] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ POP_ASSUM MP_TAC THEN ARITH_TAC);;
+
+let DIVIDES_DIV_NOT = prove(
+ `!n x q r. (x = (q * n) + r) /\ 0 < r /\ r < n ==> ~(n divides x)`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ MP_TAC(SPEC `n:num` DIVIDES_REFL) THEN
+ DISCH_THEN(MP_TAC o SPEC `q:num` o MATCH_MP DIVIDES_LMUL) THEN
+ PURE_REWRITE_TAC[TAUT `a ==> ~b <=> a /\ b ==> F`] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_ADD_REVR) THEN
+ DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ ASM_REWRITE_TAC[DE_MORGAN_THM; NOT_LE; GSYM LESS_EQ_0]);;
+
+let DIVIDES_MUL2 = prove
+ (`!a b c d. a divides b /\ c divides d ==> (a * c) divides (b * d)`,
+ NUMBER_TAC);;
+
+let DIVIDES_EXP = prove(
+ `!x y n. x divides y ==> (x EXP n) divides (y EXP n)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN
+ EXISTS_TAC `d EXP n` THEN MATCH_ACCEPT_TAC MULT_EXP);;
+
+let DIVIDES_EXP2 = prove(
+ `!n x y. ~(n = 0) /\ (x EXP n) divides y ==> x divides y`,
+ INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EXP] THEN NUMBER_TAC);;
+
+let DIVIDES_EXP_LE = prove
+ (`!p m n. 2 <= p ==> ((p EXP m) divides (p EXP n) <=> m <= n)`,
+ REPEAT STRIP_TAC THEN EQ_TAC THENL
+ [DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ ASM_REWRITE_TAC[LE_EXP; EXP_EQ_0] THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
+ SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; EXP_ADD] THEN NUMBER_TAC]);;
+
+let DIVIDES_TRIVIAL_UPPERBOUND = prove
+ (`!p n. ~(n = 0) /\ 2 <= p ==> ~((p EXP n) divides n)`,
+ REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ ASM_REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LTE_TRANS THEN
+ EXISTS_TAC `2 EXP n` THEN REWRITE_TAC[LT_POW2_REFL] THEN
+ UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN
+ INDUCT_TAC THEN ASM_REWRITE_TAC[EXP_MONO_LE_SUC]);;
+
+let FACTORIZATION_INDEX = prove
+ (`!n p. ~(n = 0) /\ 2 <= p
+ ==> ?k. (p EXP k) divides n /\
+ !l. k < l ==> ~((p EXP l) divides n)`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM] THEN
+ REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL
+ [EXISTS_TAC `0` THEN REWRITE_TAC[EXP; DIVIDES_1];
+ EXISTS_TAC `n:num` THEN
+ GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN
+ MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP l` THEN
+ SIMP_TAC[LT_POW2_REFL; LT_IMP_LE] THEN
+ SPEC_TAC(`l:num`,`l:num`) THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[ARITH; CONJUNCT1 EXP; EXP_MONO_LE_SUC]]);;
+
+let DIVIDES_FACT = prove
+ (`!n p. 1 <= p /\ p <= n ==> p divides (FACT n)`,
+ INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL
+ [ARITH_TAC; ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL]]);;
+
+let DIVIDES_2 = prove(
+ `!n. 2 divides n <=> EVEN(n)`,
+ REWRITE_TAC[divides; EVEN_EXISTS]);;
+
+let DIVIDES_REXP_SUC = prove
+ (`!x y n. x divides y ==> x divides (y EXP (SUC n))`,
+ REWRITE_TAC[EXP; DIVIDES_RMUL]);;
+
+let DIVIDES_REXP = prove
+ (`!x y n. x divides y /\ ~(n = 0) ==> x divides (y EXP n)`,
+ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[DIVIDES_REXP_SUC]);;
+
+let DIVIDES_MOD = prove
+ (`!m n. ~(m = 0) ==> (m divides n <=> (n MOD m = 0))`,
+ REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
+ [ASM_MESON_TAC[MOD_MULT]; DISCH_TAC] THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN
+ ASM_REWRITE_TAC[ADD_CLAUSES] THEN MESON_TAC[MULT_AC]);;
+
+let DIVIDES_DIV_MULT = prove
+ (`!m n. m divides n <=> ((n DIV m) * m = n)`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THENL
+ [ASM_REWRITE_TAC[DIVIDES_ZERO; MULT_CLAUSES; EQ_SYM_EQ]; ALL_TAC] THEN
+ EQ_TAC THENL [ALL_TAC; MESON_TAC[DIVIDES_LMUL; DIVIDES_REFL]] THEN
+ DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
+ EXISTS_TAC `n DIV m * m + n MOD m` THEN CONJ_TAC THENL
+ [ASM_MESON_TAC[DIVIDES_MOD; ADD_CLAUSES];
+ ASM_MESON_TAC[DIVISION]]);;
+
+let FINITE_DIVISORS = prove
+ (`!n. ~(n = 0) ==> FINITE {d | d divides n}`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
+ EXISTS_TAC `{d:num | d <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN
+ REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);;
+
+let FINITE_SPECIAL_DIVISORS = prove
+ (`!n. ~(n = 0) ==> FINITE {d | P d /\ d divides n}`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
+ EXISTS_TAC `{d | d divides n}` THEN ASM_SIMP_TAC[FINITE_DIVISORS] THEN
+ SET_TAC[]);;
+
+let DIVIDES_DIVIDES_DIV = prove
+ (`!n d. 1 <= n /\ d divides n
+ ==> (e divides (n DIV d) <=> (d * e) divides n)`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DIVIDES_DIV_MULT] THEN
+ ABBREV_TAC `q = n DIV d` THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ ASM_CASES_TAC `d = 0` THENL
+ [ASM_SIMP_TAC[MULT_CLAUSES; LE_1];
+ ASM_MESON_TAC[DIVIDES_LMUL2_EQ; MULT_SYM]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* The Bezout theorem is a bit ugly for N; it'd be easier for Z *)
+(* ------------------------------------------------------------------------- *)
+
+let IND_EUCLID = prove(
+ `!P. (!a b. P a b <=> P b a) /\
+ (!a. P a 0) /\
+ (!a b. P a b ==> P a (a + b)) ==>
+ !a b. P a b`,
+ REPEAT STRIP_TAC THEN
+ W(fun (asl,w) -> SUBGOAL_THEN `!n a b. (a + b = n) ==> P a b`
+ MATCH_MP_TAC) THENL
+ [ALL_TAC; EXISTS_TAC `a + b` THEN REFL_TAC] THEN
+ MATCH_MP_TAC num_WF THEN
+ REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC
+ (SPECL [`a:num`; `b:num`] LESS_LESS_CASES) THENL
+ [DISCH_THEN SUBST1_TAC THEN
+ GEN_REWRITE_TAC RAND_CONV [GSYM ADD_0] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
+ ALL_TAC; ALL_TAC] THEN
+ DISCH_THEN(fun th -> SUBST1_TAC(SYM(MATCH_MP SUB_ADD
+ (MATCH_MP LT_IMP_LE th))) THEN
+ DISJ_CASES_THEN MP_TAC (MATCH_MP DIFF_LEMMA th)) THENL
+ [DISCH_THEN SUBST1_TAC THEN
+ FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN
+ FIRST_ASSUM MATCH_ACCEPT_TAC;
+ REWRITE_TAC[ASSUME `a + b = n`] THEN
+ DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN
+ UNDISCH_TAC `a + b - a < n` THEN
+ DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC);
+ DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC;
+ REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (ASSUME `a + b = n`)] THEN
+ DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
+ FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN
+ UNDISCH_TAC `b + a - b < n` THEN
+ DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC)] THEN
+ REWRITE_TAC[]);;
+
+let BEZOUT_LEMMA = prove(
+ `!a b. (?d x y. (d divides a /\ d divides b) /\
+ ((a * x = (b * y) + d) \/
+ (b * x = (a * y) + d)))
+ ==> (?d x y. (d divides a /\ d divides (a + b)) /\
+ ((a * x = ((a + b) * y) + d) \/
+ ((a + b) * x = (a * y) + d)))`,
+ REPEAT STRIP_TAC THEN EXISTS_TAC `d:num` THENL
+ [MAP_EVERY EXISTS_TAC [`x + y`; `y:num`];
+ MAP_EVERY EXISTS_TAC [`x:num`; `x + y`]] THEN
+ ASM_REWRITE_TAC[] THEN
+ (CONJ_TAC THENL [MATCH_MP_TAC DIVIDES_ADD; ALL_TAC]) THEN
+ ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN
+ REWRITE_TAC[ADD_ASSOC] THEN DISJ1_TAC THEN
+ REWRITE_TAC[ADD_AC]);;
+
+let BEZOUT_ADD = prove(
+ `!a b. ?d x y. (d divides a /\ d divides b) /\
+ ((a * x = (b * y) + d) \/
+ (b * x = (a * y) + d))`,
+ W(fun (asl,w) -> MP_TAC(SPEC (list_mk_abs([`a:num`; `b:num`],
+ snd(strip_forall w)))
+ IND_EUCLID)) THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN
+ REPEAT CONJ_TAC THENL
+ [REPEAT GEN_TAC THEN REPEAT
+ (AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
+ GEN_TAC THEN BETA_TAC) THEN
+ GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [DISJ_SYM] THEN
+ GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [CONJ_SYM] THEN REFL_TAC;
+ GEN_TAC THEN MAP_EVERY EXISTS_TAC [`a:num`; `1`; `0`] THEN
+ REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVIDES_0; DIVIDES_REFL];
+ MATCH_ACCEPT_TAC BEZOUT_LEMMA]);;
+
+let BEZOUT = prove(
+ `!a b. ?d x y. (d divides a /\ d divides b) /\
+ (((a * x) - (b * y) = d) \/
+ ((b * x) - (a * y) = d))`,
+ REPEAT GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN ASSUME_TAC
+ (SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN
+ REPEAT(W(EXISTS_TAC o fst o dest_exists o snd)) THEN
+ ASM_REWRITE_TAC[] THEN
+ ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]);;
+
+(* ------------------------------------------------------------------------- *)
+(* We can get a stronger version with a nonzeroness assumption. *)
+(* ------------------------------------------------------------------------- *)
+
+let BEZOUT_ADD_STRONG = prove
+ (`!a b. ~(a = 0)
+ ==> ?d x y. d divides a /\ d divides b /\ (a * x = b * y + d)`,
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN
+ REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`] THEN
+ REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC] THEN
+ MATCH_MP_TAC(TAUT `(b ==> a) ==> a \/ b ==> a`) THEN
+ DISCH_THEN(X_CHOOSE_THEN `d:num` (X_CHOOSE_THEN `x:num`
+ (X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC))) THEN
+ FIRST_X_ASSUM(MP_TAC o SYM) THEN
+ ASM_CASES_TAC `b = 0` THENL
+ [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0; ADD_CLAUSES] THEN
+ STRIP_TAC THEN UNDISCH_TAC `d divides a` THEN
+ ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN
+ MP_TAC(SPECL [`d:num`; `b:num`] DIVIDES_LE) THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL
+ [ALL_TAC;
+ DISCH_TAC THEN EXISTS_TAC `b:num` THEN EXISTS_TAC `b:num` THEN
+ EXISTS_TAC `a - 1` THEN
+ UNDISCH_TAC `d divides a` THEN ASM_SIMP_TAC[DIVIDES_REFL] THEN
+ REWRITE_TAC[ARITH_RULE `b * x + b = (x + 1) * b`] THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(a = 0) ==> ((a - 1) + 1 = a)`]] THEN
+ ASM_CASES_TAC `x = 0` THENL
+ [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0] THEN STRIP_TAC THEN
+ UNDISCH_TAC `d divides a` THEN ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN
+ DISCH_THEN(MP_TAC o AP_TERM `( * ) (b - 1)`) THEN
+ DISCH_THEN(MP_TAC o AP_TERM `(+) (d:num)`) THEN
+ GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV)
+ [LEFT_ADD_DISTRIB] THEN
+ REWRITE_TAC[ARITH_RULE `d + bay + b1 * d = (1 + b1) * d + bay`] THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(b = 0) ==> (1 + (b - 1) = b)`] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
+ `(a + b = c + d) ==> a <= d ==> (b = (d - a) + c:num)`)) THEN
+ ANTS_TAC THENL
+ [ONCE_REWRITE_TAC[AC MULT_AC `(b - 1) * b * x = b * (b - 1) * x`] THEN
+ REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN
+ GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `d = d * 1`] THEN
+ MATCH_MP_TAC LE_MULT2 THEN
+ MAP_EVERY UNDISCH_TAC [`d < b:num`; `~(x = 0)`] THEN ARITH_TAC;
+ ALL_TAC] THEN
+ DISCH_THEN(fun th ->
+ MAP_EVERY EXISTS_TAC [`d:num`; `y * (b - 1)`; `(b - 1) * x - d`] THEN
+ MP_TAC th) THEN
+ ASM_REWRITE_TAC[] THEN
+ GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [LEFT_SUB_DISTRIB] THEN
+ REWRITE_TAC[MULT_AC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Greatest common divisor. *)
+(* ------------------------------------------------------------------------- *)
+
+let GCD = prove
+ (`!a b. (gcd(a,b) divides a /\ gcd(a,b) divides b) /\
+ (!e. e divides a /\ e divides b ==> e divides gcd(a,b))`,
+ NUMBER_TAC);;
+
+let DIVIDES_GCD = prove
+ (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`,
+ NUMBER_TAC);;
+
+let GCD_UNIQUE = prove(
+ `!d a b. (d divides a /\ d divides b) /\
+ (!e. e divides a /\ e divides b ==> e divides d) <=>
+ (d = gcd(a,b))`,
+ REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GCD] THEN
+ ONCE_REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN
+ ASM_REWRITE_TAC[DIVIDES_GCD] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GCD]);;
+
+let GCD_EQ = prove
+ (`(!d. d divides x /\ d divides y <=> d divides u /\ d divides v)
+ ==> gcd(x,y) = gcd(u,v)`,
+ REWRITE_TAC[DIVIDES_GCD; GSYM DIVIDES_ANTISYM] THEN MESON_TAC[GCD]);;
+
+let GCD_SYM = prove
+ (`!a b. gcd(a,b) = gcd(b,a)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);;
+
+let GCD_ASSOC = prove(
+ `!a b c. gcd(a,gcd(b,c)) = gcd(gcd(a,b),c)`,
+ REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ REWRITE_TAC[DIVIDES_GCD; CONJ_ASSOC; GCD] THEN
+ CONJ_TAC THEN MATCH_MP_TAC DIVIDES_TRANS THEN
+ EXISTS_TAC `gcd(b,c)` THEN ASM_REWRITE_TAC[GCD]);;
+
+let BEZOUT_GCD = prove(
+ `!a b. ?x y. ((a * x) - (b * y) = gcd(a,b)) \/
+ ((b * x) - (a * y) = gcd(a,b))`,
+ REPEAT GEN_TAC THEN
+ MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT) THEN
+ DISCH_THEN(EVERY_TCL (map X_CHOOSE_THEN [`d:num`; `x:num`; `y:num`])
+ (CONJUNCTS_THEN ASSUME_TAC)) THEN
+ SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL
+ [MATCH_MP_TAC(last(CONJUNCTS(SPEC_ALL GCD))) THEN ASM_REWRITE_TAC[];
+ DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN
+ MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN
+ ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN
+ FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);;
+
+let BEZOUT_GCD_STRONG = prove
+ (`!a b. ~(a = 0) ==> ?x y. a * x = b * y + gcd(a,b)`,
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `b:num` o MATCH_MP BEZOUT_ADD_STRONG) THEN
+ REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+ MAP_EVERY X_GEN_TAC [`d:num`; `x:num`; `y:num`] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL
+ [ASM_MESON_TAC[GCD]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN
+ MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN
+ ASM_REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; MULT_ASSOC]);;
+
+let GCD_LMUL = prove(
+ `!a b c. gcd(c * a, c * b) = c * gcd(a,b)`,
+ REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
+ ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC DIVIDES_MUL_L) THEN
+ REWRITE_TAC[GCD] THEN REPEAT STRIP_TAC THEN
+ REPEAT_TCL STRIP_THM_THEN (SUBST1_TAC o SYM)
+ (SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN
+ REWRITE_TAC[LEFT_SUB_DISTRIB; MULT_ASSOC] THEN
+ MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN
+ MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]);;
+
+let GCD_RMUL = prove(
+ `!a b c. gcd(a * c, b * c) = c * gcd(a,b)`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN
+ MATCH_ACCEPT_TAC GCD_LMUL);;
+
+let GCD_BEZOUT = prove(
+ `!a b d. (?x y. ((a * x) - (b * y) = d) \/ ((b * x) - (a * y) = d)) <=>
+ gcd(a,b) divides d`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [STRIP_TAC THEN POP_ASSUM(SUBST1_TAC o SYM) THEN
+ MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN
+ MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD];
+ DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN
+ STRIP_ASSUME_TAC(SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN
+ MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN
+ ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN
+ FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);;
+
+let GCD_BEZOUT_SUM = prove(
+ `!a b d x y. ((a * x) + (b * y) = d) ==> gcd(a,b) divides d`,
+ REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
+ MATCH_MP_TAC DIVIDES_ADD THEN CONJ_TAC THEN
+ MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD]);;
+
+let GCD_0 = prove(
+ `!a. gcd(0,a) = a`,
+ GEN_TAC THEN CONV_TAC SYM_CONV THEN
+ REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ REWRITE_TAC[DIVIDES_0; DIVIDES_REFL] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);;
+
+let GCD_ZERO = prove(
+ `!a b. (gcd(a,b) = 0) <=> (a = 0) /\ (b = 0)`,
+ REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
+ ASM_REWRITE_TAC[GCD_0] THEN
+ MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN
+ ASM_REWRITE_TAC[DIVIDES_ZERO] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[]);;
+
+let GCD_REFL = prove(
+ `!a. gcd(a,a) = a`,
+ GEN_TAC THEN CONV_TAC SYM_CONV THEN
+ ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ REWRITE_TAC[DIVIDES_REFL]);;
+
+let GCD_1 = prove(
+ `!a. gcd(1,a) = 1`,
+ GEN_TAC THEN CONV_TAC SYM_CONV THEN
+ ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ REWRITE_TAC[DIVIDES_1] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);;
+
+let GCD_MULTIPLE = prove(
+ `!a b. gcd(b,a * b) = b`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV)
+ [GSYM(el 2 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN
+ REWRITE_TAC[GCD_RMUL; GCD_1] THEN
+ REWRITE_TAC[MULT_CLAUSES]);;
+
+let GCD_ADD = prove
+ (`(!a b. gcd(a + b,b) = gcd(a,b)) /\
+ (!a b. gcd(b + a,b) = gcd(a,b)) /\
+ (!a b. gcd(a,a + b) = gcd(a,b)) /\
+ (!a b. gcd(a,b + a) = gcd(a,b))`,
+ REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);;
+
+let GCD_SUB = prove
+ (`(!a b. b <= a ==> gcd(a - b,b) = gcd(a,b)) /\
+ (!a b. a <= b ==> gcd(a,b - a) = gcd(a,b))`,
+ MESON_TAC[SUB_ADD; GCD_ADD]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Coprimality *)
+(* ------------------------------------------------------------------------- *)
+
+let coprime = prove
+ (`coprime(a,b) <=> !d. d divides a /\ d divides b ==> (d = 1)`,
+ EQ_TAC THENL
+ [REWRITE_TAC[GSYM DIVIDES_ONE];
+ DISCH_THEN(MP_TAC o SPEC `gcd(a,b)`) THEN REWRITE_TAC[GCD]] THEN
+ NUMBER_TAC);;
+
+let COPRIME = prove(
+ `!a b. coprime(a,b) <=> !d. d divides a /\ d divides b <=> (d = 1)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN
+ REPEAT(EQ_TAC ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[DIVIDES_1] THENL
+ [FIRST_ASSUM MATCH_MP_TAC;
+ FIRST_ASSUM(CONV_TAC o REWR_CONV o GSYM) THEN CONJ_TAC] THEN
+ ASM_REWRITE_TAC[]);;
+
+let COPRIME_GCD = prove
+ (`!a b. coprime(a,b) <=> (gcd(a,b) = 1)`,
+ REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);;
+
+let COPRIME_SYM = prove
+ (`!a b. coprime(a,b) <=> coprime(b,a)`,
+ NUMBER_TAC);;
+
+let COPRIME_BEZOUT = prove(
+ `!a b. coprime(a,b) <=> ?x y. ((a * x) - (b * y) = 1) \/
+ ((b * x) - (a * y) = 1)`,
+ REWRITE_TAC[GCD_BEZOUT; DIVIDES_ONE; COPRIME_GCD]);;
+
+let COPRIME_DIVPROD = prove
+ (`!d a b. d divides (a * b) /\ coprime(d,a) ==> d divides b`,
+ NUMBER_TAC);;
+
+let COPRIME_1 = prove
+ (`!a. coprime(a,1)`,
+ NUMBER_TAC);;
+
+let GCD_COPRIME = prove
+ (`!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b)
+ ==> coprime(a',b')`,
+ NUMBER_TAC);;
+
+let GCD_COPRIME_EXISTS = prove(
+ `!a b. ~(gcd(a,b) = 0) ==>
+ ?a' b'. (a = a' * gcd(a,b)) /\
+ (b = b' * gcd(a,b)) /\
+ coprime(a',b')`,
+ REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN
+ DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a':num` o GSYM)
+ (X_CHOOSE_TAC `b':num` o GSYM)) THEN
+ MAP_EVERY EXISTS_TAC [`a':num`; `b':num`] THEN
+ ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC GCD_COPRIME THEN
+ MAP_EVERY EXISTS_TAC [`a:num`; `b:num`] THEN
+ ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]);;
+
+let COPRIME_0 = prove
+ (`(!d. coprime(d,0) <=> d = 1) /\
+ (!d. coprime(0,d) <=> d = 1)`,
+ REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);;
+
+let COPRIME_MUL = prove
+ (`!d a b. coprime(d,a) /\ coprime(d,b) ==> coprime(d,a * b)`,
+ NUMBER_TAC);;
+
+let COPRIME_LMUL2 = prove
+ (`!d a b. coprime(d,a * b) ==> coprime(d,b)`,
+ NUMBER_TAC);;
+
+let COPRIME_RMUL2 = prove
+ (`!d a b. coprime(d,a * b) ==> coprime(d,a)`,
+ NUMBER_TAC);;
+
+let COPRIME_LMUL = prove
+ (`!d a b. coprime(a * b,d) <=> coprime(a,d) /\ coprime(b,d)`,
+ NUMBER_TAC);;
+
+let COPRIME_RMUL = prove
+ (`!d a b. coprime(d,a * b) <=> coprime(d,a) /\ coprime(d,b)`,
+ NUMBER_TAC);;
+
+let COPRIME_EXP = prove
+ (`!n a d. coprime(d,a) ==> coprime(d,a EXP n)`,
+ INDUCT_TAC THEN REWRITE_TAC[EXP; COPRIME_1] THEN
+ REPEAT GEN_TAC THEN DISCH_TAC THEN
+ MATCH_MP_TAC COPRIME_MUL THEN ASM_REWRITE_TAC[] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);;
+
+let COPRIME_EXP_IMP = prove
+ (`!n a b. coprime(a,b) ==> coprime(a EXP n,b EXP n)`,
+ REPEAT GEN_TAC THEN DISCH_TAC THEN
+ MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN
+ MATCH_MP_TAC COPRIME_EXP THEN
+ ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]);;
+
+let COPRIME_REXP = prove
+ (`!m n k. coprime(m,n EXP k) <=> coprime(m,n) \/ k = 0`,
+ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
+ REWRITE_TAC[CONJUNCT1 EXP; COPRIME_1] THEN
+ REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[COPRIME_EXP; NOT_SUC] THEN
+ REWRITE_TAC[EXP] THEN CONV_TAC NUMBER_RULE);;
+
+let COPRIME_LEXP = prove
+ (`!m n k. coprime(m EXP k,n) <=> coprime(m,n) \/ k = 0`,
+ ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_REXP]);;
+
+let COPRIME_EXP2 = prove
+ (`!m n k. coprime(m EXP k,n EXP k) <=> coprime(m,n) \/ k = 0`,
+ REWRITE_TAC[COPRIME_REXP; COPRIME_LEXP; DISJ_ACI]);;
+
+let COPRIME_EXP2_SUC = prove
+ (`!n a b. coprime(a EXP (SUC n),b EXP (SUC n)) <=> coprime(a,b)`,
+ REWRITE_TAC[COPRIME_EXP2; NOT_SUC]);;
+
+let COPRIME_REFL = prove
+ (`!n. coprime(n,n) <=> (n = 1)`,
+ REWRITE_TAC[COPRIME_GCD; GCD_REFL]);;
+
+let COPRIME_PLUS1 = prove
+ (`!n. coprime(n + 1,n)`,
+ NUMBER_TAC);;
+
+let COPRIME_MINUS1 = prove
+ (`!n. ~(n = 0) ==> coprime(n - 1,n)`,
+ REPEAT STRIP_TAC THEN SIMP_TAC[coprime] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
+ GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_SUB) THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - (n - 1) = 1`; DIVIDES_ONE]);;
+
+let BEZOUT_GCD_POW = prove(
+ `!n a b. ?x y. (((a EXP n) * x) - ((b EXP n) * y) = gcd(a,b) EXP n) \/
+ (((b EXP n) * x) - ((a EXP n) * y) = gcd(a,b) EXP n)`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL
+ [STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN
+ ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THENL
+ [MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REWRITE_TAC[SUB_0];
+ REPEAT(EXISTS_TAC `0`) THEN REWRITE_TAC[MULT_CLAUSES; SUB_0]];
+ MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(X_CHOOSE_THEN `b':num` ASSUME_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `a':num` ASSUME_TAC) THEN
+ MP_TAC(SPECL [`a:num`; `b:num`; `a':num`; `b':num`] GCD_COPRIME) THEN
+ RULE_ASSUM_TAC GSYM THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o GSYM) THEN
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP_IMP) THEN
+ REWRITE_TAC[COPRIME_BEZOUT] THEN
+ DISCH_THEN(X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` MP_TAC)) THEN
+ DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN
+ DISCH_THEN (MP_TAC o AP_TERM `(*) (gcd(a,b) EXP n)`) THEN
+ REWRITE_TAC[MULT_CLAUSES; LEFT_SUB_DISTRIB] THEN
+ DISCH_THEN(SUBST1_TAC o SYM) THEN
+ MAP_EVERY EXISTS_TAC [`x:num`; `y:num`] THEN
+ REWRITE_TAC[MULT_ASSOC; GSYM MULT_EXP] THEN
+ RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN
+ ASM_REWRITE_TAC[]]);;
+
+let GCD_EXP = prove(
+ `!n a b. gcd(a EXP n,b EXP n) = gcd(a,b) EXP n`,
+ REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
+ ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REPEAT CONJ_TAC THENL
+ [MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD];
+ MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD];
+ X_GEN_TAC `d:num` THEN STRIP_TAC THEN
+ MP_TAC(SPECL [`n:num`; `a:num`; `b:num`] BEZOUT_GCD_POW) THEN
+ DISCH_THEN(REPEAT_TCL CHOOSE_THEN (DISJ_CASES_THEN
+ (SUBST1_TAC o SYM))) THEN
+ MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN
+ MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]]);;
+
+let DIVISION_DECOMP = prove(
+ `!a b c. a divides (b * c) ==>
+ ?b' c'. (a = b' * c') /\ b' divides b /\ c' divides c`,
+ REPEAT GEN_TAC THEN DISCH_TAC THEN
+ EXISTS_TAC `gcd(a,b)` THEN REWRITE_TAC[GCD] THEN
+ MP_TAC(SPECL [`a:num`; `b:num`] GCD_COPRIME_EXISTS) THEN
+ ASM_CASES_TAC `gcd(a,b) = 0` THENL
+ [ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN
+ RULE_ASSUM_TAC(REWRITE_RULE[GCD_ZERO]) THEN
+ ASM_REWRITE_TAC[MULT_CLAUSES; DIVIDES_1];
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `a':num` (X_CHOOSE_THEN `b':num`
+ (STRIP_ASSUME_TAC o GSYM o ONCE_REWRITE_RULE[MULT_SYM]))) THEN
+ EXISTS_TAC `a':num` THEN ASM_REWRITE_TAC[] THEN
+ UNDISCH_TAC `a divides (b * c)` THEN
+ FIRST_ASSUM(fun th -> GEN_REWRITE_TAC
+ (LAND_CONV o LAND_CONV) [GSYM th]) THEN
+ FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV)
+ [GSYM th]) THEN REWRITE_TAC[MULT_ASSOC] THEN
+ DISCH_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN
+ EXISTS_TAC `b':num` THEN ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC DIVIDES_CMUL2 THEN EXISTS_TAC `gcd(a,b)` THEN
+ REWRITE_TAC[MULT_ASSOC] THEN CONJ_TAC THEN
+ FIRST_ASSUM MATCH_ACCEPT_TAC]);;
+
+let DIVIDES_EXP2_REV = prove
+ (`!n a b. (a EXP n) divides (b EXP n) /\ ~(n = 0) ==> a divides b`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL
+ [ASM_MESON_TAC[GCD_ZERO; DIVIDES_REFL]; ALL_TAC] THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP GCD_COPRIME_EXISTS) THEN
+ STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
+ ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_EXP] THEN
+ ASM_SIMP_TAC[EXP_EQ_0; DIVIDES_RMUL2_EQ] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE
+ `a divides b ==> coprime(a,b) ==> a divides 1`)) THEN
+ ASM_SIMP_TAC[COPRIME_EXP2; DIVIDES_ONE; DIVIDES_1; EXP_EQ_1]);;
+
+let DIVIDES_EXP2_EQ = prove
+ (`!n a b. ~(n = 0) ==> ((a EXP n) divides (b EXP n) <=> a divides b)`,
+ MESON_TAC[DIVIDES_EXP2_REV; DIVIDES_EXP]);;
+
+let DIVIDES_MUL = prove
+ (`!m n r. m divides r /\ n divides r /\ coprime(m,n) ==> (m * n) divides r`,
+ NUMBER_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* A binary form of the Chinese Remainder Theorem. *)
+(* ------------------------------------------------------------------------- *)
+
+let CHINESE_REMAINDER = prove
+ (`!a b u v. coprime(a,b) /\ ~(a = 0) /\ ~(b = 0)
+ ==> ?x q1 q2. (x = u + q1 * a) /\ (x = v + q2 * b)`,
+ let lemma = prove
+ (`(?d x y. (d = 1) /\ P x y d) <=> (?x y. P x y 1)`,
+ MESON_TAC[]) in
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPECL [`b:num`; `a:num`] BEZOUT_ADD_STRONG) THEN
+ MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD_STRONG) THEN
+ ASM_REWRITE_TAC[CONJ_ASSOC] THEN
+ SUBGOAL_THEN `!d. d divides a /\ d divides b <=> (d = 1)`
+ (fun th -> REWRITE_TAC[th; ONCE_REWRITE_RULE[CONJ_SYM] th])
+ THENL
+ [UNDISCH_TAC `coprime(a,b)` THEN
+ SIMP_TAC[GSYM DIVIDES_GCD; COPRIME_GCD; DIVIDES_ONE]; ALL_TAC] THEN
+ REWRITE_TAC[lemma] THEN
+ DISCH_THEN(X_CHOOSE_THEN `x1:num` (X_CHOOSE_TAC `y1:num`)) THEN
+ DISCH_THEN(X_CHOOSE_THEN `x2:num` (X_CHOOSE_TAC `y2:num`)) THEN
+ EXISTS_TAC `v * a * x1 + u * b * x2:num` THEN
+ EXISTS_TAC `v * x1 + u * y2:num` THEN
+ EXISTS_TAC `v * y1 + u * x2:num` THEN CONJ_TAC THENL
+ [SUBST1_TAC(ASSUME `b * x2 = a * y2 + 1`);
+ SUBST1_TAC(ASSUME `a * x1 = b * y1 + 1`)] THEN
+ REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN
+ REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Primality *)
+(* ------------------------------------------------------------------------- *)
+
+let prime = new_definition
+ `prime(p) <=> ~(p = 1) /\ !x. x divides p ==> (x = 1) \/ (x = p)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* A few useful theorems about primes *)
+(* ------------------------------------------------------------------------- *)
+
+let PRIME_0 = prove(
+ `~prime(0)`,
+ REWRITE_TAC[prime] THEN
+ DISCH_THEN(MP_TAC o SPEC `2` o CONJUNCT2) THEN
+ REWRITE_TAC[DIVIDES_0; ARITH]);;
+
+let PRIME_1 = prove(
+ `~prime(1)`,
+ REWRITE_TAC[prime]);;
+
+let PRIME_2 = prove(
+ `prime(2)`,
+ REWRITE_TAC[prime; ARITH] THEN
+ REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN
+ REWRITE_TAC[ARITH] THEN REWRITE_TAC[LE_LT] THEN
+ REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN
+ DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN
+ REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DIVIDES_ZERO] THEN
+ REWRITE_TAC[ARITH] THEN REWRITE_TAC[]);;
+
+let PRIME_GE_2 = prove(
+ `!p. prime(p) ==> 2 <= p`,
+ GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN
+ REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN
+ DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN
+ REWRITE_TAC[SYM(num_CONV `1`); PRIME_0; PRIME_1]);;
+
+let PRIME_FACTOR = prove(
+ `!n. ~(n = 1) ==> ?p. prime(p) /\ p divides n`,
+ MATCH_MP_TAC num_WF THEN
+ X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN
+ ASM_CASES_TAC `prime(n)` THENL
+ [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL];
+ UNDISCH_TAC `~prime(n)` THEN
+ DISCH_THEN(MP_TAC o REWRITE_RULE[prime]) THEN
+ ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN
+ REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN STRIP_TAC THEN
+ FIRST_ASSUM(DISJ_CASES_THEN MP_TAC o MATCH_MP DIVIDES_LE) THENL
+ [ASM_REWRITE_TAC[LE_LT] THEN
+ DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN
+ MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `m:num` THEN
+ ASM_REWRITE_TAC[];
+ DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `2` THEN
+ REWRITE_TAC[PRIME_2; DIVIDES_0]]]);;
+
+let PRIME_FACTOR_LT = prove(
+ `!n m p. prime(p) /\ ~(n = 0) /\ (n = p * m) ==> m < n`,
+ REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN
+ ASM_REWRITE_TAC[LE_EXISTS] THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN
+ REWRITE_TAC[num_CONV `2`; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN
+ REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC LESS_ADD_NONZERO THEN
+ REWRITE_TAC[ADD_EQ_0] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN
+ FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN
+ ASM_REWRITE_TAC[MULT_CLAUSES]);;
+
+let PRIME_FACTOR_INDUCT = prove
+ (`!P. P 0 /\ P 1 /\
+ (!p n. prime p /\ ~(n = 0) /\ P n ==> P(p * n))
+ ==> !n. P n`,
+ GEN_TAC THEN STRIP_TAC THEN
+ MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
+ DISCH_TAC THEN MAP_EVERY ASM_CASES_TAC [`n = 0`; `n = 1`] THEN
+ ASM_REWRITE_TAC[] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num`
+ STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN
+ FIRST_X_ASSUM(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o
+ GEN_REWRITE_RULE I [divides]) THEN
+ FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `d:num`]) THEN
+ RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN
+ DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
+ FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[PRIME_FACTOR_LT; MULT_EQ_0]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Infinitude of primes. *)
+(* ------------------------------------------------------------------------- *)
+
+let EUCLID_BOUND = prove
+ (`!n. ?p. prime(p) /\ n < p /\ p <= SUC(FACT n)`,
+ GEN_TAC THEN MP_TAC(SPEC `FACT n + 1` PRIME_FACTOR) THEN
+ SIMP_TAC[ARITH_RULE `0 < n ==> ~(n + 1 = 1)`; ADD1; FACT_LT] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
+ [ASM_MESON_TAC[DIVIDES_ADD_REVR; DIVIDES_ONE; PRIME_1; NOT_LT; PRIME_0;
+ ARITH_RULE `(p = 0) \/ 1 <= p`; DIVIDES_FACT];
+ ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(x + 1 = 0)`]]);;
+
+let EUCLID = prove
+ (`!n. ?p. prime(p) /\ p > n`,
+ REWRITE_TAC[GT] THEN MESON_TAC[EUCLID_BOUND]);;
+
+let PRIMES_INFINITE = prove
+ (`INFINITE {p | prime p}`,
+ REWRITE_TAC[INFINITE; num_FINITE; IN_ELIM_THM] THEN
+ MESON_TAC[EUCLID; NOT_LE; GT]);;
+
+let COPRIME_PRIME = prove(
+ `!p a b. coprime(a,b) ==> ~(prime(p) /\ p divides a /\ p divides b)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `p = 1` SUBST_ALL_TAC THENL
+ [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
+ UNDISCH_TAC `prime 1` THEN REWRITE_TAC[PRIME_1]]);;
+
+let COPRIME_PRIME_EQ = prove(
+ `!a b. coprime(a,b) <=> !p. ~(prime(p) /\ p divides a /\ p divides b)`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP COPRIME_PRIME th]);
+ CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[coprime] THEN
+ ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN
+ DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN
+ FIRST_ASSUM(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN
+ EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
+ MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `d:num` THEN
+ ASM_REWRITE_TAC[]]);;
+
+let PRIME_COPRIME = prove(
+ `!n p. prime(p) ==> (n = 1) \/ p divides n \/ coprime(p,n)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[prime; COPRIME_GCD] THEN
+ STRIP_ASSUME_TAC(SPECL [`p:num`; `n:num`] GCD) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `gcd(p,n)`) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN
+ ASM_REWRITE_TAC[]);;
+
+let PRIME_COPRIME_STRONG = prove
+ (`!n p. prime(p) ==> p divides n \/ coprime(p,n)`,
+ MESON_TAC[PRIME_COPRIME; COPRIME_1]);;
+
+let PRIME_COPRIME_EQ = prove
+ (`!p n. prime p ==> (coprime(p,n) <=> ~(p divides n))`,
+ REPEAT STRIP_TAC THEN
+ MATCH_MP_TAC(TAUT `(b \/ a) /\ ~(a /\ b) ==> (a <=> ~b)`) THEN
+ ASM_SIMP_TAC[PRIME_COPRIME_STRONG] THEN
+ ASM_MESON_TAC[COPRIME_REFL; PRIME_1; NUMBER_RULE
+ `coprime(p,n) /\ p divides n ==> coprime(p,p)`]);;
+
+let COPRIME_PRIMEPOW = prove
+ (`!p k m. prime p /\ ~(k = 0) ==> (coprime(m,p EXP k) <=> ~(p divides m))`,
+ SIMP_TAC[COPRIME_REXP] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN
+ SIMP_TAC[PRIME_COPRIME_EQ]);;
+
+let COPRIME_BEZOUT_STRONG = prove
+ (`!a b. coprime(a,b) /\ ~(b = 1) ==> ?x y. a * x = b * y + 1`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN
+ DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN
+ ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);;
+
+let COPRIME_BEZOUT_ALT = prove
+ (`!a b. coprime(a,b) /\ ~(a = 0) ==> ?x y. a * x = b * y + 1`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN
+ DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN
+ ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);;
+
+let BEZOUT_PRIME = prove
+ (`!a p. prime p /\ ~(p divides a) ==> ?x y. a * x = p * y + 1`,
+ MESON_TAC[PRIME_COPRIME_STRONG; COPRIME_SYM;
+ COPRIME_BEZOUT_STRONG; PRIME_1]);;
+
+let PRIME_DIVPROD = prove(
+ `!p a b. prime(p) /\ p divides (a * b) ==> p divides a \/ p divides b`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME) THEN
+ DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
+ ASM_REWRITE_TAC[] THENL
+ [DISJ2_TAC THEN UNDISCH_TAC `p divides (a * b)` THEN
+ ASM_REWRITE_TAC[MULT_CLAUSES];
+ DISJ2_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN
+ EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[]]);;
+
+let PRIME_DIVPROD_EQ = prove
+ (`!p a b. prime(p) ==> (p divides (a * b) <=> p divides a \/ p divides b)`,
+ MESON_TAC[PRIME_DIVPROD; DIVIDES_LMUL; DIVIDES_RMUL]);;
+
+let PRIME_DIVEXP = prove(
+ `!n p x. prime(p) /\ p divides (x EXP n) ==> p divides x`,
+ INDUCT_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXP; DIVIDES_ONE] THENL
+ [DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[DIVIDES_1];
+ DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN
+ DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN
+ ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ ASM_REWRITE_TAC[]]);;
+
+let PRIME_DIVEXP_N = prove(
+ `!n p x. prime(p) /\ p divides (x EXP n) ==> (p EXP n) divides (x EXP n)`,
+ REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_DIVEXP) THEN
+ MATCH_ACCEPT_TAC DIVIDES_EXP);;
+
+let PRIME_DIVEXP_EQ = prove
+ (`!n p x. prime p ==> (p divides x EXP n <=> p divides x /\ ~(n = 0))`,
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN
+ ASM_REWRITE_TAC[EXP; DIVIDES_ONE] THEN
+ ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_REXP; PRIME_1]);;
+
+let PARITY_EXP = prove(
+ `!n x. EVEN(x EXP (SUC n)) = EVEN(x)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DIVIDES_2] THEN EQ_TAC THENL
+ [DISCH_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN
+ EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[PRIME_2];
+ REWRITE_TAC[EXP] THEN MATCH_ACCEPT_TAC DIVIDES_RMUL]);;
+
+let COPRIME_SOS = prove
+ (`!x y. coprime(x,y) ==> coprime(x * y,(x EXP 2) + (y EXP 2))`,
+ NUMBER_TAC);;
+
+let PRIME_IMP_NZ = prove
+ (`!p. prime(p) ==> ~(p = 0)`,
+ MESON_TAC[PRIME_0]);;
+
+let DISTINCT_PRIME_COPRIME = prove
+ (`!p q. prime p /\ prime q /\ ~(p = q) ==> coprime(p,q)`,
+ MESON_TAC[prime; coprime; PRIME_1]);;
+
+let PRIME_COPRIME_LT = prove
+ (`!x p. prime p /\ 0 < x /\ x < p ==> coprime(x,p)`,
+ REWRITE_TAC[coprime; prime] THEN
+ MESON_TAC[LT_REFL; DIVIDES_LE; NOT_LT; PRIME_0]);;
+
+let DIVIDES_PRIME_PRIME = prove
+ (`!p q. prime p /\ prime q ==> (p divides q <=> p = q)`,
+ MESON_TAC[DIVIDES_REFL; DISTINCT_PRIME_COPRIME; PRIME_COPRIME_EQ]);;
+
+let DIVIDES_PRIME_EXP_LE = prove
+ (`!p q m n. prime p /\ prime q
+ ==> ((p EXP m) divides (q EXP n) <=> m = 0 \/ p = q /\ m <= n)`,
+ GEN_TAC THEN GEN_TAC THEN REPEAT INDUCT_TAC THEN
+ ASM_SIMP_TAC[EXP; DIVIDES_1; DIVIDES_ONE; MULT_EQ_1; NOT_SUC] THENL
+ [MESON_TAC[PRIME_1; ARITH_RULE `~(SUC m <= 0)`]; ALL_TAC] THEN
+ ASM_CASES_TAC `p:num = q` THEN
+ ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2; GSYM(CONJUNCT2 EXP)] THEN
+ ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_PRIME_PRIME; EXP; DIVIDES_RMUL2]);;
+
+let EQ_PRIME_EXP = prove
+ (`!p q m n. prime p /\ prime q
+ ==> (p EXP m = q EXP n <=> m = 0 /\ n = 0 \/ p = q /\ m = n)`,
+ REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM DIVIDES_ANTISYM] THEN
+ ASM_SIMP_TAC[DIVIDES_PRIME_EXP_LE] THEN ARITH_TAC);;
+
+let PRIME_ODD = prove
+ (`!p. prime p ==> p = 2 \/ ODD p`,
+ GEN_TAC THEN REWRITE_TAC[prime; GSYM NOT_EVEN; EVEN_EXISTS] THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `2`)) THEN
+ REWRITE_TAC[divides; ARITH] THEN MESON_TAC[]);;
+
+let DIVIDES_FACT_PRIME = prove
+ (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`,
+ GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL
+ [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1];
+ ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL;
+ ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);;
+
+let EQ_PRIMEPOW = prove
+ (`!p m n. prime p ==> (p EXP m = p EXP n <=> m = n)`,
+ ONCE_REWRITE_TAC[GSYM LE_ANTISYM] THEN
+ SIMP_TAC[LE_EXP; PRIME_IMP_NZ] THEN MESON_TAC[PRIME_1]);;
+
+let COPRIME_2 = prove
+ (`(!n. coprime(2,n) <=> ODD n) /\ (!n. coprime(n,2) <=> ODD n)`,
+ GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [COPRIME_SYM] THEN
+ SIMP_TAC[PRIME_COPRIME_EQ; PRIME_2; DIVIDES_2; NOT_EVEN]);;
+
+let DIVIDES_EXP_PLUS1 = prove
+ (`!n k. ODD k ==> (n + 1) divides (n EXP k + 1)`,
+ GEN_TAC THEN REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN
+ ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN
+ INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN
+ REWRITE_TAC[EXP_1; DIVIDES_REFL] THEN
+ REWRITE_TAC[ARITH_RULE `SUC(2 * SUC n) = SUC(2 * n) + 2`] THEN
+ REWRITE_TAC[EXP_ADD; EXP_2] THEN POP_ASSUM MP_TAC THEN NUMBER_TAC);;
+
+let DIVIDES_EXP_MINUS1 = prove
+ (`!k n. (n - 1) divides (n EXP k - 1)`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL
+ [STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN
+ ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN
+ REWRITE_TAC[DIVIDES_REFL];
+ REWRITE_TAC[num_divides] THEN
+ ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; LE_1; EXP_EQ_0; ARITH] THEN
+ POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[GSYM INT_OF_NUM_POW] THEN
+ SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[INT_POW] THEN
+ REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* One property of coprimality is easier to prove via prime factors. *)
+(* ------------------------------------------------------------------------- *)
+
+let COPRIME_EXP_DIVPROD = prove
+ (`!d n a b.
+ (d EXP n) divides (a * b) /\ coprime(d,a) ==> (d EXP n) divides b`,
+ MESON_TAC[COPRIME_DIVPROD; COPRIME_EXP; COPRIME_SYM]);;
+
+let PRIME_COPRIME_CASES = prove
+ (`!p a b. prime p /\ coprime(a,b) ==> coprime(p,a) \/ coprime(p,b)`,
+ MESON_TAC[COPRIME_PRIME; PRIME_COPRIME_EQ]);;
+
+let PRIME_DIVPROD_POW = prove
+ (`!n p a b. prime(p) /\ coprime(a,b) /\ (p EXP n) divides (a * b)
+ ==> (p EXP n) divides a \/ (p EXP n) divides b`,
+ MESON_TAC[COPRIME_EXP_DIVPROD; PRIME_COPRIME_CASES; MULT_SYM]);;
+
+let EXP_MULT_EXISTS = prove
+ (`!m n p k. ~(m = 0) /\ m EXP k * n = p EXP k ==> ?q. n = q EXP k`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN
+ ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN
+ MP_TAC(SPECL [`k:num`; `m:num`; `p:num`] DIVIDES_EXP2_REV) THEN
+ ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
+ [ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN
+ REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN
+ FIRST_X_ASSUM(MP_TAC o SYM) THEN
+ ASM_REWRITE_TAC[MULT_EXP; GSYM MULT_ASSOC; EQ_MULT_LCANCEL; EXP_EQ_0] THEN
+ MESON_TAC[]);;
+
+let COPRIME_POW = prove
+ (`!n a b c. coprime(a,b) /\ a * b = c EXP n
+ ==> ?r s. a = r EXP n /\ b = s EXP n`,
+ GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
+ GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN ASM_CASES_TAC `n = 0` THEN
+ ASM_SIMP_TAC[EXP; MULT_EQ_1] THEN MATCH_MP_TAC PRIME_FACTOR_INDUCT THEN
+ REPEAT CONJ_TAC THENL
+ [ASM_REWRITE_TAC[EXP_ZERO; MULT_EQ_0] THEN
+ ASM_MESON_TAC[COPRIME_0; EXP_ZERO; COPRIME_0; EXP_ONE];
+ SIMP_TAC[EXP_ONE; MULT_EQ_1] THEN MESON_TAC[EXP_ONE];
+ REWRITE_TAC[MULT_EXP] THEN REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `p EXP n divides a \/ p EXP n divides b` MP_TAC THENL
+ [ASM_MESON_TAC[PRIME_DIVPROD_POW; divides]; ALL_TAC] THEN
+ REWRITE_TAC[divides] THEN
+ DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THEN
+ FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_SYM]) THEN
+ ASM_SIMP_TAC[COPRIME_RMUL; COPRIME_LMUL; COPRIME_LEXP; COPRIME_REXP] THEN
+ STRIP_TAC THENL
+ [FIRST_X_ASSUM(MP_TAC o SPECL [`b:num`; `d:num`]);
+ FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `a:num`])] THEN
+ ASM_REWRITE_TAC[] THEN
+ (ANTS_TAC THENL
+ [MATCH_MP_TAC(NUM_RING `!p. ~(p = 0) /\ a * p = b * p ==> a = b`) THEN
+ EXISTS_TAC `p EXP n` THEN ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN
+ FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC NUM_RING;
+ STRIP_TAC THEN ASM_REWRITE_TAC[GSYM MULT_EXP] THEN MESON_TAC[]])]);;
+
+(* ------------------------------------------------------------------------- *)
+(* More useful lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+let PRIME_EXP = prove
+ (`!p n. prime(p EXP n) <=> prime(p) /\ (n = 1)`,
+ GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; PRIME_1; ARITH_EQ] THEN
+ POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN
+ ASM_CASES_TAC `p = 0` THENL
+ [ASM_REWRITE_TAC[PRIME_0; EXP; MULT_CLAUSES]; ALL_TAC] THEN
+ INDUCT_TAC THEN REWRITE_TAC[ARITH; EXP_1; EXP; MULT_CLAUSES] THEN
+ REWRITE_TAC[ARITH_RULE `~(SUC(SUC n) = 1)`] THEN
+ REWRITE_TAC[prime; DE_MORGAN_THM] THEN
+ ASM_REWRITE_TAC[MULT_EQ_1; EXP_EQ_1] THEN ASM_CASES_TAC `p = 1` THEN
+ ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN
+ DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN
+ CONJ_TAC THENL [MESON_TAC[EXP; divides]; ALL_TAC] THEN
+ MATCH_MP_TAC(ARITH_RULE `p < pn:num ==> ~(p = pn)`) THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN
+ REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN
+ ASM_REWRITE_TAC[LT_EXP; ARITH_EQ] THEN
+ MAP_EVERY UNDISCH_TAC [`~(p = 0)`; `~(p = 1)`] THEN ARITH_TAC);;
+
+let PRIME_POWER_MULT = prove
+ (`!k x y p. prime p /\ (x * y = p EXP k)
+ ==> ?i j. (x = p EXP i) /\ (y = p EXP j)`,
+ INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_EQ_1] THENL
+ [MESON_TAC[EXP]; ALL_TAC] THEN
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `p divides x \/ p divides y` MP_TAC THENL
+ [ASM_MESON_TAC[PRIME_DIVPROD; divides; MULT_AC]; ALL_TAC] THEN
+ REWRITE_TAC[divides] THEN
+ SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL
+ [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN
+ DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THENL
+ [UNDISCH_TAC `(p * d) * y = p * p EXP k`;
+ UNDISCH_TAC `x * p * d = p * p EXP k` THEN
+ GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [MULT_SYM]] THEN
+ REWRITE_TAC[GSYM MULT_ASSOC] THEN
+ ASM_REWRITE_TAC[EQ_MULT_LCANCEL] THEN DISCH_TAC THENL
+ [FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `y:num`; `p:num`]);
+ FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `x:num`; `p:num`])] THEN
+ ASM_REWRITE_TAC[] THEN MESON_TAC[EXP]);;
+
+let PRIME_POWER_EXP = prove
+ (`!n x p k. prime p /\ ~(n = 0) /\ (x EXP n = p EXP k) ==> ?i. x = p EXP i`,
+ INDUCT_TAC THEN REWRITE_TAC[EXP] THEN
+ REPEAT GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN
+ ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP] THEN
+ ASM_MESON_TAC[PRIME_POWER_MULT]);;
+
+let DIVIDES_PRIMEPOW = prove
+ (`!p. prime p ==> !d. d divides (p EXP k) <=> ?i. i <= k /\ d = p EXP i`,
+ GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL
+ [REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:num` THEN
+ DISCH_TAC THEN
+ MP_TAC(SPECL [`k:num`; `d:num`; `e:num`; `p:num`] PRIME_POWER_MULT) THEN
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
+ FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[GSYM EXP_ADD] THEN
+ REWRITE_TAC[GSYM LE_ANTISYM; LE_EXP] THEN REWRITE_TAC[LE_ANTISYM] THEN
+ POP_ASSUM MP_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_SIMP_TAC[PRIME_0] THEN
+ ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1; LE_ANTISYM] THEN
+ MESON_TAC[LE_ADD];
+ REWRITE_TAC[LE_EXISTS] THEN STRIP_TAC THEN
+ ASM_REWRITE_TAC[EXP_ADD] THEN MESON_TAC[DIVIDES_RMUL; DIVIDES_REFL]]);;
+
+let COPRIME_DIVISORS = prove
+ (`!a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e)`,
+ NUMBER_TAC);;
+
+let PRIMEPOW_FACTOR = prove
+ (`!n. 2 <= n
+ ==> ?p k m. prime p /\ 1 <= k /\ coprime(p,m) /\ n = p EXP k * m`,
+ REPEAT STRIP_TAC THEN MP_TAC(ISPEC `n:num` PRIME_FACTOR) THEN
+ ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN
+ MP_TAC(ISPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN
+ ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
+ REWRITE_TAC[divides; LEFT_AND_EXISTS_THM] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k + 1`)) THEN
+ ASM_REWRITE_TAC[ARITH_RULE `k < k + 1`; EXP_ADD; GSYM MULT_ASSOC] THEN
+ ASM_SIMP_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; PRIME_IMP_NZ] THEN
+ REWRITE_TAC[EXP_1; GSYM divides] THEN UNDISCH_TAC `(p:num) divides n` THEN
+ ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES; LE_1] THEN
+ ASM_MESON_TAC[PRIME_COPRIME_STRONG]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Induction principle for multiplicative functions etc. *)
+(* ------------------------------------------------------------------------- *)
+
+let INDUCT_COPRIME = prove
+ (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\
+ (!p k. prime p ==> P(p EXP k))
+ ==> !n. 1 < n ==> P n`,
+ GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN
+ X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 1)`)) THEN
+ DISCH_THEN(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN
+ MP_TAC(SPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN
+ ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `1 < n ==> ~(n = 0)`] THEN
+ REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
+ MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN STRIP_TAC THEN
+ FIRST_X_ASSUM SUBST_ALL_TAC THEN
+ ASM_CASES_TAC `m = 1` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN
+ FIRST_X_ASSUM(CONJUNCTS_THEN2 MATCH_MP_TAC MP_TAC) THEN
+ ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
+ MATCH_MP_TAC(TAUT
+ `!p. (a /\ b /\ ~p) /\ c /\ (a /\ ~p ==> b ==> d)
+ ==> a /\ b /\ c /\ d`) THEN
+ EXISTS_TAC `m = 0` THEN
+ SUBGOAL_THEN `~(k = 0)` ASSUME_TAC THENL
+ [DISCH_THEN SUBST_ALL_TAC THEN
+ FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `0 < 1`)) THEN
+ FIRST_X_ASSUM(MP_TAC o CONJUNCT2) THEN
+ REWRITE_TAC[EXP; EXP_1; MULT_CLAUSES; divides];
+ ALL_TAC] THEN
+ CONJ_TAC THENL
+ [UNDISCH_TAC `1 < p EXP k * m` THEN
+ ASM_REWRITE_TAC[ARITH_RULE `1 < x <=> ~(x = 0) /\ ~(x = 1)`] THEN
+ ASM_REWRITE_TAC[EXP_EQ_0; EXP_EQ_1; MULT_EQ_0; MULT_EQ_1] THEN
+ FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2 o CONJUNCT1) THEN
+ ASM_ARITH_TAC;
+ ALL_TAC] THEN
+ CONJ_TAC THENL
+ [FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `k < k + 1`)) THEN
+ REWRITE_TAC[EXP_ADD; EXP_1; GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN
+ ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ; GSYM divides] THEN DISCH_TAC THEN
+ ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN
+ ASM_MESON_TAC[PRIME_COPRIME; COPRIME_SYM];
+ DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
+ GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `m = 1 * m`] THEN
+ ASM_REWRITE_TAC[LT_MULT_RCANCEL]]);;
+
+let INDUCT_COPRIME_STRONG = prove
+ (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\
+ (!p k. prime p /\ ~(k = 0) ==> P(p EXP k))
+ ==> !n. 1 < n ==> P n`,
+ GEN_TAC THEN STRIP_TAC THEN
+ ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a ==> b`] THEN
+ MATCH_MP_TAC INDUCT_COPRIME THEN CONJ_TAC THENL
+ [ASM_MESON_TAC[];
+ MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN ASM_CASES_TAC `k = 0` THEN
+ ASM_REWRITE_TAC[LT_REFL; EXP] THEN ASM_MESON_TAC[]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* A conversion for divisibility. *)
+(* ------------------------------------------------------------------------- *)
+
+let DIVIDES_CONV =
+ let pth_0 = SPEC `b:num` DIVIDES_ZERO
+ and pth_1 = prove
+ (`~(a = 0) ==> (a divides b <=> (b MOD a = 0))`,
+ REWRITE_TAC[DIVIDES_MOD])
+ and a_tm = `a:num` and b_tm = `b:num` and zero_tm = `0`
+ and dest_divides = dest_binop `(divides)` in
+ fun tm ->
+ let a,b = dest_divides tm in
+ if a = zero_tm then
+ CONV_RULE (RAND_CONV NUM_EQ_CONV) (INST [b,b_tm] pth_0)
+ else
+ let th1 = INST [a,a_tm; b,b_tm] pth_1 in
+ let th2 = MP th1 (EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1))))) in
+ CONV_RULE (RAND_CONV (LAND_CONV NUM_MOD_CONV THENC NUM_EQ_CONV)) th2;;
+
+(* ------------------------------------------------------------------------- *)
+(* A conversion for coprimality. *)
+(* ------------------------------------------------------------------------- *)
+
+let COPRIME_CONV =
+ let pth_yes_l = prove
+ (`(m * x = n * y + 1) ==> (coprime(m,n) <=> T)`,
+ MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE])
+ and pth_yes_r = prove
+ (`(m * x = n * y + 1) ==> (coprime(n,m) <=> T)`,
+ MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE])
+ and pth_no = prove
+ (`(m = x * d) /\ (n = y * d) /\ ~(d = 1) ==> (coprime(m,n) <=> F)`,
+ REWRITE_TAC[coprime; divides] THEN MESON_TAC[MULT_AC])
+ and pth_oo = prove
+ (`coprime(0,0) <=> F`,
+ MESON_TAC[coprime; DIVIDES_REFL; NUM_REDUCE_CONV `1 = 0`])
+ and m_tm = `m:num` and n_tm = `n:num`
+ and x_tm = `x:num` and y_tm = `y:num`
+ and d_tm = `d:num` and coprime_tm = `coprime` in
+ let rec bezout (m,n) =
+ if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0)
+ else if m <=/ n then
+ let q = quo_num n m and r = mod_num n m in
+ let (x,y) = bezout(m,r) in
+ (x -/ q */ y,y)
+ else let (x,y) = bezout(n,m) in (y,x) in
+ fun tm ->
+ let pop,ptm = dest_comb tm in
+ if pop <> coprime_tm then failwith "COPRIME_CONV" else
+ let l,r = dest_pair ptm in
+ let m = dest_numeral l and n = dest_numeral r in
+ if m =/ Int 0 & n =/ Int 0 then pth_oo else
+ let (x,y) = bezout(m,n) in
+ let d = x */ m +/ y */ n in
+ let th =
+ if d =/ Int 1 then
+ if x >/ Int 0 then
+ INST [l,m_tm; r,n_tm; mk_numeral x,x_tm;
+ mk_numeral(minus_num y),y_tm] pth_yes_l
+ else
+ INST [r,m_tm; l,n_tm; mk_numeral(minus_num x),y_tm;
+ mk_numeral y,x_tm] pth_yes_r
+ else
+ INST [l,m_tm; r,n_tm; mk_numeral d,d_tm;
+ mk_numeral(m // d),x_tm; mk_numeral(n // d),y_tm] pth_no in
+ MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));;
+
+(* ------------------------------------------------------------------------- *)
+(* More general (slightly less efficiently coded) GCD_CONV. *)
+(* ------------------------------------------------------------------------- *)
+
+let GCD_CONV =
+ let pth0 = prove(`gcd(0,0) = 0`,REWRITE_TAC[GCD_0]) in
+ let pth1 = prove
+ (`!m n x y d m' n'.
+ (m * x = n * y + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`,
+ REPEAT GEN_TAC THEN
+ DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
+ CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[GSYM GCD_UNIQUE] THEN
+ ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL;
+ DIVIDES_ADD_REVR; DIVIDES_REFL]) in
+ let pth2 = prove
+ (`!m n x y d m' n'.
+ (n * y = m * x + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`,
+ MESON_TAC[pth1; GCD_SYM]) in
+ let gcd_tm = `gcd` in
+ let rec bezout (m,n) =
+ if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0)
+ else if m <=/ n then
+ let q = quo_num n m and r = mod_num n m in
+ let (x,y) = bezout(m,r) in
+ (x -/ q */ y,y)
+ else let (x,y) = bezout(n,m) in (y,x) in
+ fun tm -> let gt,lr = dest_comb tm in
+ if gt <> gcd_tm then failwith "GCD_CONV" else
+ let mtm,ntm = dest_pair lr in
+ let m = dest_numeral mtm and n = dest_numeral ntm in
+ if m =/ Int 0 & n =/ Int 0 then pth0 else
+ let x0,y0 = bezout(m,n) in
+ let x = abs_num x0 and y = abs_num y0 in
+ let xtm = mk_numeral x and ytm = mk_numeral y in
+ let d = abs_num(x */ m -/ y */ n) in
+ let dtm = mk_numeral d in
+ let m' = m // d and n' = n // d in
+ let mtm' = mk_numeral m' and ntm' = mk_numeral n' in
+ let th = SPECL [mtm;ntm;xtm;ytm;dtm;mtm';ntm']
+ (if m */ x =/ n */ y +/ d then pth1 else pth2) in
+ MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));;
--- /dev/null
+(* ========================================================================= *)
+(* All you wanted to know about reflexive symmetric and transitive closures. *)
+(* ========================================================================= *)
+
+prioritize_num();;
+
+let RULE_INDUCT_TAC =
+ MATCH_MP_TAC o DISCH_ALL o SPEC_ALL o UNDISCH o SPEC_ALL;;
+
+(* ------------------------------------------------------------------------- *)
+(* Little lemmas about equivalent forms of symmetry and transitivity. *)
+(* ------------------------------------------------------------------------- *)
+
+let SYM_ALT = prove
+ (`!R:A->A->bool. (!x y. R x y ==> R y x) <=> (!x y. R x y <=> R y x)`,
+ GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
+ [EQ_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC;
+ FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [th])] THEN
+ FIRST_ASSUM MATCH_ACCEPT_TAC);;
+
+let TRANS_ALT = prove
+ (`!(R:A->A->bool) (S:A->A->bool) U.
+ (!x z. (?y. R x y /\ S y z) ==> U x z) <=>
+ (!x y z. R x y /\ S y z ==> U x z)`,
+ REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+ EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Reflexive closure *)
+(* ------------------------------------------------------------------------- *)
+
+let RC_RULES,RC_INDUCT,RC_CASES = new_inductive_definition
+ `(!x y. R x y ==> RC R x y) /\
+ (!x:A. RC R x x)`;;
+
+let RC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> RC R x y`,
+ REWRITE_TAC[RC_RULES]);;
+
+let RC_REFL = prove
+ (`!(R:A->A->bool) x. RC R x x`,
+ REWRITE_TAC[RC_RULES]);;
+
+let RC_EXPLICIT = prove
+ (`!(R:A->A->bool) x y. RC R x y <=> R x y \/ (x = y)`,
+ REWRITE_TAC[RC_CASES; EQ_SYM_EQ]);;
+
+let RC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. RC R x y ==> RC S x y)`,
+ MESON_TAC[RC_CASES]);;
+
+let RC_CLOSED = prove
+ (`!R:A->A->bool. (RC R = R) <=> !x. R x x`,
+ REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT] THEN MESON_TAC[]);;
+
+let RC_IDEMP = prove
+ (`!R:A->A->bool. RC(RC R) = RC R`,
+ REWRITE_TAC[RC_CLOSED; RC_REFL]);;
+
+let RC_SYM = prove
+ (`!R:A->A->bool.
+ (!x y. R x y ==> R y x) ==> (!x y. RC R x y ==> RC R y x)`,
+ MESON_TAC[RC_CASES]);;
+
+let RC_TRANS = prove
+ (`!R:A->A->bool.
+ (!x y z. R x y /\ R y z ==> R x z) ==>
+ (!x y z. RC R x y /\ RC R y z ==> RC R x z)`,
+ REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Symmetric closure *)
+(* ------------------------------------------------------------------------- *)
+
+let SC_RULES,SC_INDUCT,SC_CASES = new_inductive_definition
+ `(!x y. R x y ==> SC R x y) /\
+ (!x:A y. SC R x y ==> SC R y x)`;;
+
+let SC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> SC R x y`,
+ REWRITE_TAC[SC_RULES]);;
+
+let SC_SYM = prove
+ (`!(R:A->A->bool) x y. SC R x y ==> SC R y x`,
+ REWRITE_TAC[SC_RULES]);;
+
+let SC_EXPLICIT = prove
+ (`!R:A->A->bool. SC(R) x y <=> R x y \/ R y x`,
+ GEN_TAC THEN EQ_TAC THENL
+ [RULE_INDUCT_TAC SC_INDUCT THEN MESON_TAC[]; MESON_TAC[SC_CASES]]);;
+
+let SC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. SC R x y ==> SC S x y)`,
+ MESON_TAC[SC_EXPLICIT]);;
+
+let SC_CLOSED = prove
+ (`!R:A->A->bool. (SC R = R) <=> !x y. R x y ==> R y x`,
+ REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT] THEN MESON_TAC[]);;
+
+let SC_IDEMP = prove
+ (`!R:A->A->bool. SC(SC R) = SC R`,
+ REWRITE_TAC[SC_CLOSED; SC_SYM]);;
+
+let SC_REFL = prove
+ (`!R:A->A->bool. (!x. R x x) ==> (!x. SC R x x)`,
+ MESON_TAC[SC_EXPLICIT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Transitive closure *)
+(* ------------------------------------------------------------------------- *)
+
+let TC_RULES,TC_INDUCT,TC_CASES = new_inductive_definition
+ `(!x y. R x y ==> TC R x y) /\
+ (!(x:A) y z. TC R x y /\ TC R y z ==> TC R x z)`;;
+
+let TC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> TC R x y`,
+ REWRITE_TAC[TC_RULES]);;
+
+let TC_TRANS = prove
+ (`!(R:A->A->bool) x y z. TC R x y /\ TC R y z ==> TC R x z`,
+ REWRITE_TAC[TC_RULES]);;
+
+let TC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. TC R x y ==> TC S x y)`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_RULES]);;
+
+let TC_CLOSED = prove
+ (`!R:A->A->bool. (TC R = R) <=> !x y z. R x y /\ R y z ==> R x z`,
+ GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL
+ [MESON_TAC[TC_RULES]; REPEAT STRIP_TAC] THEN
+ EQ_TAC THENL [RULE_INDUCT_TAC TC_INDUCT; ALL_TAC] THEN
+ ASM_MESON_TAC[TC_RULES]);;
+
+let TC_IDEMP = prove
+ (`!R:A->A->bool. TC(TC R) = TC R`,
+ REWRITE_TAC[TC_CLOSED; TC_TRANS]);;
+
+let TC_REFL = prove
+ (`!R:A->A->bool. (!x. R x x) ==> (!x. TC R x x)`,
+ MESON_TAC[TC_INC]);;
+
+let TC_SYM = prove
+ (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. TC R x y ==> TC R y x)`,
+ GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC TC_INDUCT THEN
+ ASM_MESON_TAC[TC_RULES]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Commutativity properties of the three basic closure operations *)
+(* ------------------------------------------------------------------------- *)
+
+let RC_SC = prove
+ (`!R:A->A->bool. RC(SC R) = SC(RC R)`,
+ REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);;
+
+let SC_RC = prove
+ (`!R:A->A->bool. SC(RC R) = RC(SC R)`,
+ REWRITE_TAC[RC_SC]);;
+
+let RC_TC = prove
+ (`!R:A->A->bool. RC(TC R) = TC(RC R)`,
+ REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL
+ [RULE_INDUCT_TAC RC_INDUCT THEN MESON_TAC[TC_RULES; RC_RULES; TC_MONO];
+ RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[RC_TRANS; TC_RULES; RC_MONO]]);;
+
+let TC_RC = prove
+ (`!R:A->A->bool. TC(RC R) = RC(TC R)`,
+ REWRITE_TAC[RC_TC]);;
+
+let TC_SC = prove
+ (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`,
+ GEN_TAC THEN MATCH_MP_TAC SC_INDUCT THEN
+ MESON_TAC[TC_MONO; TC_SYM; SC_RULES]);;
+
+let SC_TC = prove
+ (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`,
+ REWRITE_TAC[TC_SC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Left and right variants of TC. *)
+(* ------------------------------------------------------------------------- *)
+
+let TC_TRANS_L = prove
+ (`!(R:A->A->bool) x y z. TC R x y /\ R y z ==> TC R x z`,
+ MESON_TAC[TC_RULES]);;
+
+let TC_TRANS_R = prove
+ (`!(R:A->A->bool) x y z. R x y /\ TC R y z ==> TC R x z`,
+ MESON_TAC[TC_RULES]);;
+
+let TC_CASES_L = prove
+ (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. TC R x y /\ R y z)`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);;
+
+let TC_CASES_R = prove
+ (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. R x y /\ TC R y z)`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);;
+
+let TC_INDUCT_L = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x y z. P x y /\ R y z ==> P x z) ==>
+ (!x y. TC R x y ==> P x y)`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ SUBGOAL_THEN `!y:A z. TC(R) y z ==> !x:A. P x y ==> P x z` MP_TAC THENL
+ [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_R]]);;
+
+let TC_INDUCT_R = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x z. (?y. R x y /\ P y z) ==> P x z) ==>
+ (!x y. TC R x y ==> P x y)`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ SUBGOAL_THEN `!x:A y. TC(R) x y ==> !z:A. P y z ==> P x z` MP_TAC THENL
+ [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_L]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Reflexive symmetric closure *)
+(* ------------------------------------------------------------------------- *)
+
+let RSC = new_definition
+ `RSC(R:A->A->bool) = RC(SC R)`;;
+
+let RSC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> RSC R x y`,
+ REWRITE_TAC[RSC] THEN MESON_TAC[RC_INC; SC_INC]);;
+
+let RSC_REFL = prove
+ (`!(R:A->A->bool) x. RSC R x x`,
+ REWRITE_TAC[RSC; RC_REFL]);;
+
+let RSC_SYM = prove
+ (`!(R:A->A->bool) x y. RSC R x y ==> RSC R y x`,
+ REWRITE_TAC[RSC; RC_SC; SC_SYM]);;
+
+let RSC_CASES = prove
+ (`!(R:A->A->bool) x y. RSC R x y <=> (x = y) \/ R x y \/ R y x`,
+ REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT; DISJ_ACI]);;
+
+let RSC_INDUCT = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x. P x x) /\
+ (!x y. P x y ==> P y x)
+ ==> !x y. RSC R x y ==> P x y`,
+ REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);;
+
+let RSC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. RSC R x y ==> RSC S x y)`,
+ REWRITE_TAC[RSC] THEN MESON_TAC[SC_MONO; RC_MONO]);;
+
+let RSC_CLOSED = prove
+ (`!R:A->A->bool. (RSC R = R) <=> (!x. R x x) /\ (!x y. R x y ==> R y x)`,
+ REWRITE_TAC[FUN_EQ_THM; RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);;
+
+let RSC_IDEMP = prove
+ (`!R:A->A->bool. RSC(RSC R) = RSC R`,
+ REWRITE_TAC[RSC_CLOSED; RSC_REFL; RSC_SYM]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Reflexive transitive closure *)
+(* ------------------------------------------------------------------------- *)
+
+let RTC = new_definition
+ `RTC(R:A->A->bool) = RC(TC R)`;;
+
+let RTC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> RTC R x y`,
+ REWRITE_TAC[RTC] THEN MESON_TAC[RC_INC; TC_INC]);;
+
+let RTC_REFL = prove
+ (`!(R:A->A->bool) x. RTC R x x`,
+ REWRITE_TAC[RTC; RC_REFL]);;
+
+let RTC_TRANS = prove
+ (`!(R:A->A->bool) x y z. RTC R x y /\ RTC R y z ==> RTC R x z`,
+ REWRITE_TAC[RTC; RC_TC; TC_TRANS]);;
+
+let RTC_RULES = prove
+ (`!(R:A->A->bool).
+ (!x y. R x y ==> RTC R x y) /\
+ (!x. RTC R x x) /\
+ (!x y z. RTC R x y /\ RTC R y z ==> RTC R x z)`,
+ REWRITE_TAC[RTC_INC; RTC_REFL; RTC_TRANS]);;
+
+let RTC_TRANS_L = prove
+ (`!(R:A->A->bool) x y z. RTC R x y /\ R y z ==> RTC R x z`,
+ REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC]);;
+
+let RTC_TRANS_R = prove
+ (`!(R:A->A->bool) x y z. R x y /\ RTC R y z ==> RTC R x z`,
+ REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC]);;
+
+let RTC_CASES = prove
+ (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ RTC R y z`,
+ REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_TRANS]);;
+
+let RTC_CASES_L = prove
+ (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ R y z`,
+ REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_L; TC_TRANS_L]);;
+
+let RTC_CASES_R = prove
+ (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. R x y /\ RTC R y z`,
+ REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_R; TC_TRANS_R]);;
+
+let RTC_INDUCT = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x. P x x) /\
+ (!x y z. P x y /\ P y z ==> P x z)
+ ==> !x y. RTC R x y ==> P x y`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN
+ MATCH_MP_TAC TC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);;
+
+let RTC_INDUCT_L = prove
+ (`!(R:A->A->bool) P.
+ (!x. P x x) /\
+ (!x y z. P x y /\ R y z ==> P x z)
+ ==> !x y. RTC R x y ==> P x y`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN
+ MATCH_MP_TAC TC_INDUCT_L THEN REWRITE_TAC[RC_EXPLICIT] THEN
+ ASM_MESON_TAC[]);;
+
+let RTC_INDUCT_R = prove
+ (`!(R:A->A->bool) P.
+ (!x. P x x) /\
+ (!x y z. R x y /\ P y z ==> P x z)
+ ==> !x y. RTC R x y ==> P x y`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN
+ MATCH_MP_TAC TC_INDUCT_R THEN REWRITE_TAC[RC_EXPLICIT] THEN
+ ASM_MESON_TAC[]);;
+
+let RTC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. RTC R x y ==> RTC S x y)`,
+ REWRITE_TAC[RTC] THEN MESON_TAC[RC_MONO; TC_MONO]);;
+
+let RTC_CLOSED = prove
+ (`!R:A->A->bool. (RTC R = R) <=> (!x. R x x) /\
+ (!x y z. R x y /\ R y z ==> R x z)`,
+ REWRITE_TAC[FUN_EQ_THM; RTC; RC_EXPLICIT] THEN
+ MESON_TAC[TC_CLOSED; TC_RULES]);;
+
+let RTC_IDEMP = prove
+ (`!R:A->A->bool. RTC(RTC R) = RTC R`,
+ REWRITE_TAC[RTC_CLOSED; RTC_REFL; RTC_TRANS]);;
+
+let RTC_SYM = prove
+ (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. RTC R x y ==> RTC R y x)`,
+ REWRITE_TAC[RTC] THEN MESON_TAC[RC_SYM; TC_SYM]);;
+
+let RTC_STUTTER = prove
+ (`RTC R = RTC (\x y. R x y /\ ~(x = y))`,
+ REWRITE_TAC[RC_TC; RTC] THEN
+ AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
+ REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);;
+
+let TC_RTC_CASES_L = prove
+ (`TC R x z <=> ?y. RTC R x y /\ R y z`,
+ REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_L; TC_INC]);;
+
+let TC_RTC_CASES_R = prove
+ (`!R x z. TC R x z <=> ?y. R x y /\ RTC R y z`,
+ REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_R; TC_INC]);;
+
+let TC_TC_RTC_CASES = prove
+ (`!R x z. TC R x z <=> ?y. TC R x y /\ RTC R y z`,
+ REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);;
+
+let TC_RTC_TC_CASES = prove
+ (`!R x z. TC R x z <=> ?y. RTC R x y /\ TC R y z`,
+ REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);;
+
+let RTC_NE_IMP_TC = prove
+ (`!R x y. RTC R x y /\ ~(x = y) ==> TC R x y`,
+ GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN
+ MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[] THEN
+ MESON_TAC[TC_INC; TC_CASES]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Symmetric transitive closure *)
+(* ------------------------------------------------------------------------- *)
+
+let STC = new_definition
+ `STC(R:A->A->bool) = TC(SC R)`;;
+
+let STC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> STC R x y`,
+ REWRITE_TAC[STC] THEN MESON_TAC[SC_INC; TC_INC]);;
+
+let STC_SYM = prove
+ (`!(R:A->A->bool) x y. STC R x y ==> STC R y x`,
+ REWRITE_TAC[STC] THEN MESON_TAC[TC_SYM; SC_SYM]);;
+
+let STC_TRANS = prove
+ (`!(R:A->A->bool) x y z. STC R x y /\ STC R y z ==> STC R x z`,
+ REWRITE_TAC[STC; TC_TRANS]);;
+
+let STC_TRANS_L = prove
+ (`!(R:A->A->bool) x y z. STC R x y /\ R y z ==> STC R x z`,
+ REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_L; SC_INC]);;
+
+let STC_TRANS_R = prove
+ (`!(R:A->A->bool) x y z. R x y /\ STC R y z ==> STC R x z`,
+ REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_R; SC_INC]);;
+
+let STC_CASES = prove
+ (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/
+ ?y. STC R x y /\ STC R y z`,
+ REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);;
+
+let STC_CASES_L = prove
+ (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/
+ ?y. STC R x y /\ R y z`,
+ REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);;
+
+let STC_CASES_R = prove
+ (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/
+ ?y. R x y /\ STC R y z`,
+ REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);;
+
+let STC_INDUCT = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x y. P x y ==> P y x) /\
+ (!x y z. P x y /\ P y z ==> P x z) ==>
+ !x y. STC R x y ==> P x y`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[STC] THEN
+ MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[SC_EXPLICIT]);;
+
+let STC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. STC R x y ==> STC S x y)`,
+ REWRITE_TAC[STC] THEN MESON_TAC[SC_MONO; TC_MONO]);;
+
+let STC_CLOSED = prove
+ (`!R:A->A->bool. (STC R = R) <=> (!x y. R x y ==> R y x) /\
+ (!x y z. R x y /\ R y z ==> R x z)`,
+ GEN_TAC THEN REWRITE_TAC[STC; SC_EXPLICIT] THEN EQ_TAC THENL
+ [DISCH_THEN(SUBST1_TAC o SYM) THEN MESON_TAC[TC_TRANS; TC_SYM; SC_SYM];
+ REWRITE_TAC[GSYM SC_CLOSED; GSYM TC_CLOSED] THEN MESON_TAC[]]);;
+
+let STC_IDEMP = prove
+ (`!R:A->A->bool. STC(STC R) = STC R`,
+ REWRITE_TAC[STC_CLOSED; STC_SYM; STC_TRANS]);;
+
+let STC_REFL = prove
+ (`!R:A->A->bool. (!x. R x x) ==> !x. STC R x x`,
+ MESON_TAC[STC_INC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Reflexive symmetric transitive closure (smallest equivalence relation) *)
+(* ------------------------------------------------------------------------- *)
+
+let RSTC = new_definition
+ `RSTC(R:A->A->bool) = RC(TC(SC R))`;;
+
+let RSTC_INC = prove
+ (`!(R:A->A->bool) x y. R x y ==> RSTC R x y`,
+ REWRITE_TAC[RSTC] THEN MESON_TAC[RC_INC; TC_INC; SC_INC]);;
+
+let RSTC_REFL = prove
+ (`!(R:A->A->bool) x. RSTC R x x`,
+ REWRITE_TAC[RSTC; RC_REFL]);;
+
+let RSTC_SYM = prove
+ (`!(R:A->A->bool) x y. RSTC R x y ==> RSTC R y x`,
+ REWRITE_TAC[RSTC] THEN MESON_TAC[SC_SYM; TC_SYM; RC_SYM]);;
+
+let RSTC_TRANS = prove
+ (`!(R:A->A->bool) x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z`,
+ REWRITE_TAC[RSTC; RC_TC; TC_TRANS]);;
+
+let RSTC_RULES = prove
+ (`!(R:A->A->bool).
+ (!x y. R x y ==> RSTC R x y) /\
+ (!x. RSTC R x x) /\
+ (!x y. RSTC R x y ==> RSTC R y x) /\
+ (!x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z)`,
+ REWRITE_TAC[RSTC_INC; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);;
+
+let RSTC_TRANS_L = prove
+ (`!(R:A->A->bool) x y z. RSTC R x y /\ R y z ==> RSTC R x z`,
+ REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC; SC_INC]);;
+
+let RSTC_TRANS_R = prove
+ (`!(R:A->A->bool) x y z. R x y /\ RSTC R y z ==> RSTC R x z`,
+ REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC; SC_INC]);;
+
+let RSTC_CASES = prove
+ (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/
+ ?y. RSTC R x y /\ RSTC R y z`,
+ REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN
+ MESON_TAC[STC_CASES; RC_CASES]);;
+
+let RSTC_CASES_L = prove
+ (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/
+ ?y. RSTC R x y /\ R y z`,
+ REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN
+ MESON_TAC[STC_CASES_L; RC_CASES]);;
+
+let RSTC_CASES_R = prove
+ (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/
+ ?y. R x y /\ RSTC R y z`,
+ REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN
+ MESON_TAC[STC_CASES_R; RC_CASES]);;
+
+let RSTC_INDUCT = prove
+ (`!(R:A->A->bool) P.
+ (!x y. R x y ==> P x y) /\
+ (!x. P x x) /\
+ (!x y. P x y ==> P y x) /\
+ (!x y z. P x y /\ P y z ==> P x z)
+ ==> !x y. RSTC R x y ==> P x y`,
+ REPEAT GEN_TAC THEN STRIP_TAC THEN
+ REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN
+ MATCH_MP_TAC STC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);;
+
+let RSTC_MONO = prove
+ (`!(R:A->A->bool) S.
+ (!x y. R x y ==> S x y) ==>
+ (!x y. RSTC R x y ==> RSTC S x y)`,
+ REWRITE_TAC[RSTC] THEN MESON_TAC[RC_MONO; SC_MONO; TC_MONO]);;
+
+let RSTC_CLOSED = prove
+ (`!R:A->A->bool. (RSTC R = R) <=> (!x. R x x) /\
+ (!x y. R x y ==> R y x) /\
+ (!x y z. R x y /\ R y z ==> R x z)`,
+ REWRITE_TAC[RSTC] THEN REWRITE_TAC[GSYM STC; GSYM STC_CLOSED] THEN
+ REWRITE_TAC[RC_EXPLICIT; FUN_EQ_THM] THEN MESON_TAC[STC_INC]);;
+
+let RSTC_IDEMP = prove
+ (`!R:A->A->bool. RSTC(RSTC R) = RSTC R`,
+ REWRITE_TAC[RSTC_CLOSED; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Finally, we prove the inclusion properties for composite closures *)
+(* ------------------------------------------------------------------------- *)
+
+let RSC_INC_RC = prove
+ (`!R:A->A->bool. !x y. RC R x y ==> RSC R x y`,
+ REWRITE_TAC[RSC; RC_SC; SC_INC]);;
+
+let RSC_INC_SC = prove
+ (`!R:A->A->bool. !x y. SC R x y ==> RSC R x y`,
+ REWRITE_TAC[RSC; RC_INC]);;
+
+let RTC_INC_RC = prove
+ (`!R:A->A->bool. !x y. RC R x y ==> RTC R x y`,
+ REWRITE_TAC[RTC; RC_TC; TC_INC]);;
+
+let RTC_INC_TC = prove
+ (`!R:A->A->bool. !x y. TC R x y ==> RTC R x y`,
+ REWRITE_TAC[RTC; RC_INC]);;
+
+let STC_INC_SC = prove
+ (`!R:A->A->bool. !x y. SC R x y ==> STC R x y`,
+ REWRITE_TAC[STC; TC_INC]);;
+
+let STC_INC_TC = prove
+ (`!R:A->A->bool. !x y. TC R x y ==> STC R x y`,
+ REWRITE_TAC[STC] THEN MESON_TAC[TC_MONO; SC_INC]);;
+
+let RSTC_INC_RC = prove
+ (`!R:A->A->bool. !x y. RC R x y ==> RSTC R x y`,
+ REWRITE_TAC[RSTC; RC_TC; RC_SC; GSYM STC; STC_INC]);;
+
+let RSTC_INC_SC = prove
+ (`!R:A->A->bool. !x y. SC R x y ==> RSTC R x y`,
+ REWRITE_TAC[RSTC; GSYM RTC; RTC_INC]);;
+
+let RSTC_INC_TC = prove
+ (`!R:A->A->bool. !x y. TC R x y ==> RSTC R x y`,
+ REWRITE_TAC[RSTC; RC_TC; GSYM RSC] THEN MESON_TAC[TC_MONO; RSC_INC]);;
+
+let RSTC_INC_RSC = prove
+ (`!R:A->A->bool. !x y. RSC R x y ==> RSTC R x y`,
+ REWRITE_TAC[RSC; RSTC; RC_TC; TC_INC]);;
+
+let RSTC_INC_RTC = prove
+ (`!R:A->A->bool. !x y. RTC R x y ==> RSTC R x y`,
+ REWRITE_TAC[GSYM RTC; RSTC] THEN MESON_TAC[RTC_MONO; SC_INC]);;
+
+let RSTC_INC_STC = prove
+ (`!R:A->A->bool. !x y. STC R x y ==> RSTC R x y`,
+ REWRITE_TAC[GSYM STC; RSTC; RC_INC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Handy things about reverse relations. *)
+(* ------------------------------------------------------------------------- *)
+
+let INV = new_definition
+ `INV R (x:A) (y:B) <=> R y x`;;
+
+let RC_INV = prove
+ (`RC(INV R) = INV(RC R)`,
+ REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; INV; EQ_SYM_EQ]);;
+
+let SC_INV = prove
+ (`SC(INV R) = INV(SC R)`,
+ REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);;
+
+let SC_INV_STRONG = prove
+ (`SC(INV R) = SC R`,
+ REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);;
+
+let TC_INV = prove
+ (`TC(INV R) = INV(TC R)`,
+ REWRITE_TAC[FUN_EQ_THM; INV] THEN REPEAT GEN_TAC THEN EQ_TAC THEN
+ RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[INV; TC_RULES]);;
+
+let RSC_INV = prove
+ (`RSC(INV R) = INV(RSC R)`,
+ REWRITE_TAC[RSC; RC_INV; SC_INV]);;
+
+let RTC_INV = prove
+ (`RTC(INV R) = INV(RTC R)`,
+ REWRITE_TAC[RTC; RC_INV; TC_INV]);;
+
+let STC_INV = prove
+ (`STC(INV R) = INV(STC R)`,
+ REWRITE_TAC[STC; SC_INV; TC_INV]);;
+
+let RSTC_INV = prove
+ (`RSTC(INV R) = INV(RSTC R)`,
+ REWRITE_TAC[RSTC; RC_INV; SC_INV; TC_INV]);;
+
+(* ------------------------------------------------------------------------- *)
+(* An iterative version of (R)TC. *)
+(* ------------------------------------------------------------------------- *)
+
+let RELPOW = new_recursive_definition num_RECURSION
+ `(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\
+ (RELPOW (SUC n) R x y <=> ?z. RELPOW n R x z /\ R z y)`;;
+
+let RELPOW_R = prove
+ (`(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\
+ (RELPOW (SUC n) R x y <=> ?z. R x z /\ RELPOW n R z y)`,
+ CONJ_TAC THENL [REWRITE_TAC[RELPOW]; ALL_TAC] THEN
+ MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`x:A`; `y:A`; `n:num`] THEN
+ INDUCT_TAC THEN ASM_MESON_TAC[RELPOW]);;
+
+let RELPOW_M = prove
+ (`!m n x:A y. RELPOW (m + n) R x y <=> ?z. RELPOW m R x z /\ RELPOW n R z y`,
+ INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; RELPOW_R; UNWIND_THM1] THEN
+ MESON_TAC[]);;
+
+let RTC_RELPOW = prove
+ (`!R (x:A) y. RTC R x y <=> ?n. RELPOW n R x y`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [RULE_INDUCT_TAC RTC_INDUCT_L THEN MESON_TAC[RELPOW];
+ REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`y:A`,`y:A`) THEN
+ ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN
+ REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[RTC_REFL; RTC_TRANS_L]]);;
+
+let TC_RELPOW = prove
+ (`!R (x:A) y. TC R x y <=> ?n. RELPOW (SUC n) R x y`,
+ REWRITE_TAC[RELPOW] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+ REWRITE_TAC[LEFT_EXISTS_AND_THM; GSYM RTC_RELPOW] THEN
+ ONCE_REWRITE_TAC[TC_CASES_L] THEN REWRITE_TAC[RTC; RC_EXPLICIT] THEN
+ MESON_TAC[]);;
+
+let RELPOW_SEQUENCE = prove
+ (`!R n x y. RELPOW n R x y <=> ?f. (f(0) = x:A) /\ (f(n) = y) /\
+ !i. i < n ==> R (f i) (f(SUC i))`,
+ GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; RELPOW] THENL
+ [REPEAT GEN_TAC THEN EQ_TAC THENL
+ [DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `\n:num. y:A` THEN REWRITE_TAC[];
+ MESON_TAC[]];
+ REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
+ [DISJ_CASES_TAC(ARITH_RULE `(n = 0) \/ 0 < n`) THENL
+ [EXISTS_TAC `\i. if i = 0 then x else y:A` THEN
+ ASM_REWRITE_TAC[ARITH; LT] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN
+ ASM_MESON_TAC[];
+ EXISTS_TAC `\i. if i <= n then f(i) else (y:A)` THEN
+ ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN
+ REPEAT STRIP_TAC THEN
+ ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC n <= n)`] THEN
+ ASM_REWRITE_TAC[LE_SUC_LT] THEN
+ ASM_REWRITE_TAC[LE_LT] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]];
+ EXISTS_TAC `(f:num->A) n` THEN CONJ_TAC THENL
+ [EXISTS_TAC `f:num->A` THEN ASM_REWRITE_TAC[] THEN
+ REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ ASM_REWRITE_TAC[];
+ ASM_MESON_TAC[]]]]);;
--- /dev/null
+prioritize_num();;
+
+(* ------------------------------------------------------------------------- *)
+(* Some additional mathematical background. *)
+(* ------------------------------------------------------------------------- *)
+
+loadt "Library/rstc.ml";;
+loadt "Library/prime.ml";;
+
+(* ------------------------------------------------------------------------- *)
+(* The basics of first order logic and our inference system. *)
+(* ------------------------------------------------------------------------- *)
+
+loadt "Arithmetic/fol.ml";;
+loadt "Arithmetic/derived.ml";;
+
+(* ------------------------------------------------------------------------- *)
+(* The incompleteness results. *)
+(* ------------------------------------------------------------------------- *)
+
+loadt "Arithmetic/definability.ml";;
+loadt "Arithmetic/tarski.ml";;
+loadt "Arithmetic/arithprov.ml";;
+loadt "Arithmetic/godel.ml";;
git://colo12-c703.uibk.ac.at / Gödel's incompleteness theorem/.git / commitdiff