theory Demo5 = CPure: text {* Defining HOL *} text {* Technical Setup, introducing a new logic *} classes type < logic defaultsort type typedecl bool typedecl ind arities bool :: type ind :: type fun :: (type, type) type judgment Trueprop :: "bool \ prop" ("(_)" 5) -- --------------------------------- consts Eq :: "'a \ 'a \ bool" (infixl "=" 50) Imp :: "bool \ bool \ bool" (infixr "\" 25) Eps :: "('a \ bool) \ 'a" (binder "SOME " 10) consts Not :: "bool \ bool" ("\ _" [40] 40) True :: bool False :: bool If :: "bool \ 'a \ 'a \ 'a" ("(if (_)/ then (_)/ else (_))" 10) All :: "('a \ bool) \ bool" (binder "\" 10) Ex :: "('a \ bool) \ bool" (binder "\" 10) And :: "bool \ bool \ bool" (infixr "\" 35) Or :: "bool \ bool \ bool" (infixr "\" 30) inj :: "('a \ 'b) \ bool" surj :: "('a \ 'b) \ bool" text {* Additional concrete syntax *} syntax "_not_equal" :: "'a \ 'a \ bool" (infixl "\" 50) translations "x \ y" == "\(x = y)" text {* Axioms and basic definitions *} axioms refl: "t = t" subst: "\ s = t; P s \ \ P t" ext: "(\x. f x = g x) \ (\x. f x) = (\x. g x)" impI: "(P \ Q) \ P \ Q" mp: "\ P\Q; P \ \ Q" iff: "(P\Q) \ (Q\P) \ (P=Q)" someI: "P x \ P (SOME x. P x)" True_or_False: "(P=True) \ (P=False)" infinity: "\f :: ind \ ind. inj f \ \surj f" defs True_def: "True \ ((\x::bool. x) = (\x. x))" All_def: "All P \ (P = (\x. True))" Ex_def: "Ex P \ \Q. (\x. P x \ Q) \ Q" False_def: "False \ (\P. P)" not_def: "\ P \ P \ False" and_def: "P \ Q \ \R. (P\Q\R) \ R" or_def: "P \ Q \ \R. (P\R) \ (Q\R) \ R" if_def: "If P x y \ SOME z. (P=True \ z=x) \ (P=False \ z=y)" inj_def: "inj f \ \x y. f x = f y \ x = y" surj_def: "surj f \ \y. \x. y = f x" text {* Deriving the standard proof rules in HOL *} text {* Implication *} -- {* we want to show @{text "\ P \ Q; P; Q \ R \ \ R"} *} lemma impE: assumes PQ: "P \ Q" assumes P: "P" assumes R: "Q \ R" shows "R" apply (rule R) apply (insert PQ) apply (drule mp) apply (rule P) apply assumption done -- ------------------------------- text {* True *} lemma TrueI: "True" apply (unfold True_def) apply (rule refl) done text {* side track: Equality *} lemma sym: "s = t \ t = s" apply (erule subst) apply (rule refl) done lemma fun_cong: "f = g \ f x = g x" apply (erule subst) apply (rule refl) done lemma iffI: assumes PQ: "P \ Q" assumes QP: "Q \ P" shows "P = Q" apply (rule mp) apply (rule mp) apply (insert iff [where P=P and Q=Q]) apply assumption apply (rule impI) apply (rule PQ) apply assumption apply (rule impI) apply (rule QP) apply assumption done lemma iffD1: "Q = P \ Q \ P" apply (rule subst) apply assumption apply assumption done lemma iffD2: "P = Q \ Q \ P" apply (drule sym) apply (drule iffD1) apply assumption apply assumption done text {* back to True *} lemma eqTrueI: "P \ P = True" apply (rule iffI) apply (rule TrueI) apply assumption done lemma eqTrueE: "P = True \ P" apply (drule iffD2) apply (rule TrueI) apply assumption done -- ------------------------------- text {* Universial Quantifier *} lemma allI: assumes P: "\x. P x" shows "\x. P x" apply (unfold All_def) apply (rule ext) apply (rule eqTrueI) apply (rule P) done lemma spec: "\x. P x \ P x" apply (unfold All_def) apply (rule eqTrueE) apply (drule fun_cong) apply assumption done lemma allE: assumes all: "\x. P x" assumes R: "P x \ R" shows "R" apply (rule R) apply (rule spec, assumption) done -- ------------------------------- text {* False *} lemma FalseE: "False \ P" apply (unfold False_def) apply (erule allE) apply assumption done lemma False_neq_True: "False = True \ P" apply (drule eqTrueE) apply (erule FalseE) done -- ------------------------------- text {* Negation *} lemma notI: assumes P: "P \ False" shows "\P" apply (unfold not_def) apply (rule impI) apply (rule P) apply assumption done lemma notE: "\ \P; P \ \ R" apply (unfold not_def) apply (erule impE) apply assumption apply (erule FalseE) done lemma False_not_True: "False \ True" apply (rule notI) apply (erule False_neq_True) done -- ------------------------------- text {* Existential Quantifier *} lemma exI: "P x \ \x. P x" apply (unfold Ex_def) apply (rule allI) apply (rule impI) apply (erule allE) apply (erule impE) apply assumption apply assumption done lemma exE: assumes ex: "\x. P x" assumes R: "\x. P x \ R" shows "R" apply (insert ex) apply (unfold Ex_def) apply (drule spec) apply (drule mp) apply (rule allI) apply (rule impI) apply (rule R) apply assumption apply assumption done -- ------------------------------- text {* Conjunction *} lemma conjI: "\ P; Q \ \ P \ Q" apply (unfold and_def) apply (rule allI) apply (rule impI) apply (erule impE) apply assumption apply (erule impE) apply assumption apply assumption done lemma conjE: assumes PQ: "P \ Q" assumes R: "\ P; Q \ \ R" shows R apply (insert PQ) apply (unfold and_def) apply (erule allE) apply (erule impE) apply (rule impI) apply (rule impI) apply (rule R) apply assumption apply assumption apply assumption done -- ------------------------------- text {* Disjunction *} lemma disjI1: "P \ P \ Q" apply (unfold or_def) apply (rule allI) apply (rule impI) apply (rule impI) apply (erule impE) apply assumption apply assumption done lemma disjI2: "Q \ P \ Q" apply (unfold or_def) apply (rule allI) apply (rule impI) apply (rule impI) apply (erule impE, assumption, assumption) done lemma disjE: assumes PQ: "P \ Q" assumes P: "P \ R" assumes Q: "Q \ R" shows "R" apply (insert PQ) apply (unfold or_def) apply (erule allE) apply (erule impE) apply (rule impI) apply (rule P) apply assumption apply (erule impE) apply (rule impI) apply (rule Q) apply assumption apply assumption done -- ------------------------------- text {* Classical Logic *} lemma classical: assumes P: "\P \ P" shows P apply (insert True_or_False [where P=P]) apply (erule disjE) apply (erule eqTrueE) apply (rule P) apply (rule notI) apply (rule subst) apply assumption apply assumption done lemma notnotD: "\\P \ P" apply (rule classical) apply (erule notE) apply assumption done lemma disjCI: assumes P: "\Q \ P" shows "P \ Q" apply (rule classical) apply (rule disjI1) apply (rule P) apply (rule notI) apply (erule notE) apply (rule disjI2) apply assumption done lemma tertium_non_datur: "P \ \P" apply (rule disjCI) apply (drule notnotD) apply assumption done -- ------------------------------- text {* Choice *} lemma someI_ex: "\x. P x \ P (SOME x. P x)" apply (erule exE) apply (erule someI) done lemma someI2: assumes a: "P a" assumes PQ: "\x. P x \ Q x" shows "Q (SOME x. P x)" apply (insert a) apply (drule someI, drule PQ) apply assumption done lemma some_equality: assumes a: "P a" assumes P: "\x. P x \ x=a" shows "(SOME x. P x) = a" apply (rule someI2) apply (rule a) apply (rule P) apply assumption done lemma some_eq_ex: "P (SOME x. P x) = (\x. P x)" apply (rule iffI) apply (rule exI) apply assumption apply (erule someI_ex) done -- ------------------------------- text {* if-then-else *} lemma if_True: "(if True then s else t) = s" apply (unfold if_def) apply (rule some_equality) apply (rule conjI) apply (rule impI) apply (rule refl) apply (rule impI) apply (drule sym) apply (erule False_neq_True) apply (erule conjE) apply (erule impE) apply (rule refl) apply assumption done lemma if_False: "(if False then s else t) = t" apply (unfold if_def) apply (rule some_equality) apply (rule conjI) apply (rule impI) apply (erule False_neq_True) apply (rule impI) apply (rule refl) apply (erule conjE) apply (erule impE, rule refl) apply assumption done end