(* ========================================================================= *)
(* 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.                                        *)
(* ------------------------------------------------------------------------- *)
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))`,
 
 
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))`,
 
 
(* ------------------------------------------------------------------------- *)
(* Auxiliary concepts.                                                       *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* The purest and most symmetric and beautiful form of G1.                   *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Some more familiar variants.                                              *)
(* ------------------------------------------------------------------------- *)