(* ========================================================================= *)
(* 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 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_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';;
SIGMAPI_GNUMERAL1; SIGMAPI_RTC]);;
(* ------------------------------------------------------------------------- *)
(* The Godel sentence, "H" being Sigma and "G" being Pi. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Hence the key fixpoint properties. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Auxiliary concepts. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* The purest and most symmetric and beautiful form of G1. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Some more familiar variants. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Closures and invariance of truth and provability. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Other stuff. *)
(* ------------------------------------------------------------------------- *)
let sound = new_definition
`sound A <=> !p. A |-- p ==> true p`;;