From: Cezary Kaliszyk Date: Thu, 29 Aug 2013 13:24:16 +0000 (+0200) Subject: Update from HH X-Git-Url: http://colo12-c703.uibk.ac.at/git/?a=commitdiff_plain;h=67928fe38836205ca8d0705b3695186e998e3e29;p=G%C3%B6del%27s%20incompleteness%20theorem%2F.git Update from HH --- 67928fe38836205ca8d0705b3695186e998e3e29 diff --git a/HH/Arithmetic/arithprov.ml b/HH/Arithmetic/arithprov.ml new file mode 100644 index 0000000..ab308ff --- /dev/null +++ b/HH/Arithmetic/arithprov.ml @@ -0,0 +1,570 @@ +(* ========================================================================= *) +(* 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]);; diff --git a/HH/Arithmetic/definability.ml b/HH/Arithmetic/definability.ml new file mode 100644 index 0000000..03a7f07 --- /dev/null +++ b/HH/Arithmetic/definability.ml @@ -0,0 +1,644 @@ +(* ========================================================================= *) +(* 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]);; diff --git a/HH/Arithmetic/derived.ml b/HH/Arithmetic/derived.ml new file mode 100644 index 0000000..8037251 --- /dev/null +++ b/HH/Arithmetic/derived.ml @@ -0,0 +1,668 @@ +(* ========================================================================= *) +(* 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]);; diff --git a/HH/Arithmetic/fol.ml b/HH/Arithmetic/fol.ml new file mode 100644 index 0000000..4465e87 --- /dev/null +++ b/HH/Arithmetic/fol.ml @@ -0,0 +1,524 @@ +(* ========================================================================= *) +(* 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 = {})`;; diff --git a/HH/Arithmetic/godel.ml b/HH/Arithmetic/godel.ml new file mode 100644 index 0000000..01266a8 --- /dev/null +++ b/HH/Arithmetic/godel.ml @@ -0,0 +1,628 @@ +(* ========================================================================= *) +(* 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]);; diff --git a/HH/Arithmetic/pa.ml b/HH/Arithmetic/pa.ml new file mode 100644 index 0000000..8bd35c7 --- /dev/null +++ b/HH/Arithmetic/pa.ml @@ -0,0 +1,73 @@ +(* ========================================================================= *) +(* 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)))`;; diff --git a/HH/Arithmetic/tarski.ml b/HH/Arithmetic/tarski.ml new file mode 100644 index 0000000..246eb47 --- /dev/null +++ b/HH/Arithmetic/tarski.ml @@ -0,0 +1,364 @@ +(* ========================================================================= *) +(* 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;; + +******) diff --git a/HH/Library/prime.ml b/HH/Library/prime.ml new file mode 100644 index 0000000..e86780a --- /dev/null +++ b/HH/Library/prime.ml @@ -0,0 +1,1575 @@ +(* ========================================================================= *) +(* 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))));; diff --git a/HH/Library/rstc.ml b/HH/Library/rstc.ml new file mode 100644 index 0000000..06947ad --- /dev/null +++ b/HH/Library/rstc.ml @@ -0,0 +1,700 @@ +(* ========================================================================= *) +(* 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[]]]]);; diff --git a/HH/make.ml b/HH/make.ml new file mode 100644 index 0000000..acbacd1 --- /dev/null +++ b/HH/make.ml @@ -0,0 +1,24 @@ +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";;