(* 15-815 Automated Theorem Proving *) (* Frank Pfenning, Spring 2004 *) (* Library code for Assignment 2 *) (* Propositions *) signature PROP = sig (* Propositions *) datatype Prop = (* A ::= *) Atom of string (* P *) | And of Prop * Prop (* | A1 & A2 *) | True (* | t *) | Implies of Prop * Prop (* | A1 => A2 *) | Or of Prop * Prop (* | A1 | A2 *) | False (* | f *) val Not : Prop -> Prop (* ~ A = A => f *) (* eq (A, B) = true iff A = B as propositions *) val eq : Prop * Prop -> bool end; (* signature PROP *) structure Prop :> PROP = struct (* Propositions *) datatype Prop = (* A ::= *) Atom of string (* P *) | And of Prop * Prop (* | A1 & A2 *) | True (* | t *) | Implies of Prop * Prop (* | A1 => A2 *) | Or of Prop * Prop (* | A1 | A2 *) | False (* | f *) (* ~ A = A => f *) fun Not (A) = Implies (A, False) (* eq (A, B) = true iff A = B as propositions *) (* Could use built-in equality *) fun eq (Atom(p), Atom(q)) = (p = q) | eq (And(A1, A2), And(B1, B2)) = eq (A1, B1) andalso eq (A2, B2) | eq (True, True) = true | eq (Implies(A1, A2), Implies(B1, B2)) = eq (A1, B1) andalso eq (A2, B2) | eq (Or(A1, A2), Or(B1, B2)) = eq (A1, B1) andalso eq (A2, B2) | eq (False, False) = true | eq _ = false end; (* structure Prop *) (* Global abbreviation: P = Prop *) structure P = Prop; (* Contexts *) signature CTX = sig (* Contexts *) (* Later declarations shadow earlier ones *) datatype 'a Ctx = (* G ::= *) Null (* . *) | Decl of 'a Ctx * (string * 'a) (* | G, x:A *) val lookup : 'a Ctx * string -> 'a option end; (* signature CTX *) structure Ctx :> CTX = struct (* Contexts *) (* Later declarations shadow earlier ones *) datatype 'a Ctx = (* G ::= *) Null (* . *) | Decl of 'a Ctx * (string * 'a) (* | G, x:A *) (* lookup (G, x) = NONE if x not declared in G = SOME(A) if x:A is last declaration of x in G *) fun lookup (Null, x) = NONE | lookup (Decl (G, (y, A)), x) = if (x = y) then SOME(A) else lookup (G, x) end; (* structure Ctx *) (* Global abbreviation *) structure C = Ctx; (* Natural Deductions *) (* Compact representation *) (* Proof checking alternates bottom-up and top-down *) (* See Section 3.2 of the course notes *) signature ND = sig (* Annotated proof terms *) (* Divided into introduction and elimination forms *) datatype ITerm = (* I ::= *) Pair of ITerm * ITerm (* *) | Unit (* | <> *) | Lam of string * ITerm (* | \u. I *) | Inl of ITerm (* | inl I *) | Inr of ITerm (* | inr I *) | Case of ETerm * (string * ITerm) * (string * ITerm) (* | case E of inl u1 => I1 | inr u2 => I2 *) | Abort of ETerm (* | abort E *) | Let of ETerm * (string * ITerm) (* | let u = E in I *) | Elim of ETerm (* | E *) and ETerm = (* E ::= *) Var of string (* u *) | Fst of ETerm (* | fst E *) | Snd of ETerm (* | snd E *) | App of ETerm * ITerm (* | E I *) | Intro of ITerm * P.Prop (* | I : A *) exception Invalid of string (* check (G, I, A) = () if G |- I : A, raises Invalid otherwise *) (* syn (G, E) = A if G |- E : A, raises Invalid if no such A exists *) val check : P.Prop C.Ctx * ITerm * P.Prop -> unit val syn : P.Prop C.Ctx * ETerm -> P.Prop end; (* signature ND *) structure ND :> ND = struct (* Annotated proof terms *) (* Divided into introduction and elimination forms *) (* Note the special status of Case and Abort *) datatype ITerm = (* I ::= *) Pair of ITerm * ITerm (* *) | Unit (* | <> *) | Lam of string * ITerm (* | \u. I *) | Inl of ITerm (* | inl I *) | Inr of ITerm (* | inr I *) | Case of ETerm * (string * ITerm) * (string * ITerm) (* | case E of inl u1 => I1 | inr u2 => I2 *) | Abort of ETerm (* | abort E *) | Let of ETerm * (string * ITerm) (* | let u = E in I *) | Elim of ETerm (* | E *) and ETerm = (* E ::= *) Var of string (* u *) | Fst of ETerm (* | fst E *) | Snd of ETerm (* | snd E *) | App of ETerm * ITerm (* | E I *) | Intro of ITerm * P.Prop (* | I : A *) exception Invalid of string fun check (G, Pair(I1, I2), P.And(A1, A2)) = (check (G, I1, A1); check (G, I2, A2)) | check (G, Unit, True) = () | check (G, Lam(x, I), P.Implies (A, B)) = check (C.Decl (G, (x, A)), I, B) | check (G, Inl(I), P.Or(A, B)) = check (G, I, A) | check (G, Inr(I), P.Or(A, B)) = check (G, I, B) | check (G, Case(E, (x1, I1), (x2, I2)), C) = (case syn (G, E) of P.Or (A, B) => (check (C.Decl (G, (x1, A)), I1, C); check (C.Decl (G, (x2, B)), I2, C)) | _ => raise Invalid ("Case subject does not have sum type")) | check (G, Abort(E), C) = (case syn (G, E) of P.False => () | _ => raise Invalid ("Abort subject does not have void type")) | check (G, Let(E, (x, I)), C) = check (C.Decl (G, (x, syn (G, E))), I, C) | check (G, Elim(E), C) = if P.eq (syn (G, E), C) then () else raise Invalid("Mismatch between expected and synthesized type") | check _ = raise Invalid ("Introduction term does not match expected type") and syn (G, Var(u)) = (case C.lookup (G, u) of SOME(A) => A | NONE => raise Invalid("Undeclared variable " ^ u)) | syn (G, Fst(E)) = (case syn (G, E) of P.And (A, B) => A | _ => raise Invalid("Argument to Fst not product")) | syn (G, Snd(E)) = (case syn (G, E) of P.And (A, B) => B | _ => raise Invalid("Argument to Snd not product")) | syn (G, App(E, I)) = (case syn (G, E) of P.Implies (A, B) => (check (G, I, A); B) | _ => raise Invalid("First argument to App not function")) | syn (G, Intro(I, A)) = (check (G, I, A); A) end; (* structure ND *) signature TEST = sig exception Error end; signature G4IP = sig val decide : P.Prop -> bool end; (* structure G :> G4IP = struct .. end; *) (* functor T (D : G4IP) :> TEST = struct ... end; *) (* structure X = T (G); *) (* functor application should run test cases *) (* raising X.Error if there is a problem *) signature G4IP_CERT = sig val prove : P.Prop -> ND.ITerm option (* prove(A) = NONE means no proof for A exists *) (* prove(A) = SOME(I) then . |- I : A *) end; (* structure GC :> G4IP_CERT = struct .. end; *) (* functor TC (D : G4IP_CERT) :> TEST = struct ... end; *) (* structure X = TC (GC); *)