%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Decision procedure for intuitonistic propositional logic %%% based on contraction-free sequent calculus and inversion. %%% %%% As written in lecture, so it does not have disjunction %%% %%% Author: Frank Pfenning %%% October 2009 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% requires: prop.elf, list.elf %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% justification : type. just : prop -> proof -> justification. %%% Lists of propositions list : type. nil : list. cons : justification -> list -> list. %%% Appending two lists append : list -> list -> list -> type. append/nil : append nil Bs Bs. append/cons : append (cons A As) Bs (cons A Cs) <- append As Bs Cs. % Standard direction: appending two lists %mode append +As +Bs -Cs. %worlds () (append As Bs Cs). % mumbo-jumbo needed for totality checking %terminates As (append As Bs Cs). %total As (append As Bs Cs). % Membership member : justification -> list -> type. member/hd : member A (cons A Bs). member/tl : member A (cons B Bs) <- member A Bs. %mode member -A +As. %worlds () (member A Bs). % mumbo-jumbo needed for totality checking %terminates Bs (member A Bs). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Decision procedure %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% seqR : list -> list -> list -> prop -> proof -> type. seqL : list -> list -> list -> prop -> proof -> type. chooseR : list -> list -> prop -> proof -> type. chooseL : list -> list -> list -> prop -> proof -> type. % seqR Ps Is Hs A % break down right asynchronous proposition A %mode seqR +Ps +Is +Hs +A -M. %mode seqL +Ps +Is +Hs +C -N. %mode chooseR +Ps +Is +C -N. %mode chooseL +Ps +Is +Js +C -N. % right asynchronous cases /\R, =>R /\R : seqR Ps Is Hs (A /\ B) (pair M N) <- seqR Ps Is Hs A M <- seqR Ps Is Hs B N. =>R : seqR Ps Is Hs (A => B) (fn A [x] M x) <- ({x:proof} seqR Ps Is (cons (just A x) Hs) B (M x)). % right synchronous cases ? j2 : seqR Ps Is Hs (? P) N <- seqL Ps Is Hs (? P) N. % seqL Ps Is Hs C N % break down left asynchronous propositions Hs % left asynchronous cases /\L /\L : seqL Ps Is (cons (just (A /\ B) M) Hs) C N <- seqL Ps Is (cons (just A (fst M)) (cons (just B (snd M)) Hs)) C N. % left asynchronous cases /\=>L /\=>L : seqL Ps Is (cons (just ((D /\ E) => B) M) Hs) C N <- seqL Ps Is (cons (just (D => (E => B)) (fn D [x] fn E [y] app M (pair x y))) Hs) C N. % left synchronous cases ?, ?=>, =>=> j3 : seqL Ps Is (cons (just (? P) M) Hs) C N <- seqL (cons (just (? P) M) Ps) Is Hs C N. j4 : seqL Ps Is (cons (just (? P => B) M) Hs) C N <- seqL Ps (cons (just (? P => B) M) Is) Hs C N. j5 : seqL Ps Is (cons (just ((D => E) => B) M) Hs) C N <- seqL Ps (cons (just ((D => E) => B) M) Is) Hs C N. % asynchronous phase complete (Hs = nil) % now apply synchronous rule on right or left j6 : seqL Ps Is nil C N <- chooseR Ps Is C N. j7 : seqL Ps Is nil C N <- chooseL Ps Is nil C N. % chooseR Ps Is C % break down a synchronous proposition on right init : chooseR Ps Is (? P) M <- member (just (? P) M) Ps. % chooseL Ps Is Js C % break down a synchronous proposition on left % Js accumulates unused synchronous propositions ?=>L : chooseL Ps (cons (just ((? P) => B) M) Is) Js C N <- member (just (? P) M') Ps <- append Is Js Ks <- seqL Ps Ks (cons (just B (app M M')) nil) C N. j8 : chooseL Ps (cons (just ((? P) => B) M) Is) Js C N <- chooseL Ps Is (cons (just ((? P) => B) M) Js) C N. =>=>L : chooseL Ps (cons (just ((D => E) => B) M) Is) Js C N <- append Is Js Ks <- ({z:proof} seqR Ps Ks (cons (just (E => B) (fn E [x] app M (fn D [y] x))) (cons (just D z) nil)) E (M' z)) <- seqL Ps Ks (cons (just B (app M (fn D [z] M' z))) nil) C N. j9 : chooseL Ps (cons (just ((D => E) => B) M) Is) Js C N <- chooseL Ps Is (cons (just ((D => E) => B) M) Js) C N. % chooseL Ps nil Js C N fails - all possibilities tried % prove prove : prop -> proof -> type. prove/0 : prove A M <- seqR nil nil nil A M. %mode prove +A -M. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Test cases %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %query 1 1 prove (? a => ? a) M. %query 1 1 prove( ? a => (? b => ? a) ) M. %query 1 1 prove( (? a => ? b) => (? a => (? b => ? c)) => (? a => ? c) ) M. %query 1 1 prove( ? a /\ ? b => ? b /\ ? a ) M. %{ %query 1 1 prove( ? a \/ ? b => ? b \/ ? a ) M. %query 1 1 prove( (? a \/ ? c) /\ (? b => ? c) => (? a => ? b) => ? c ) M. }% %query 1 1 prove( (? a => ? b => ? c) <=> (? a /\ ? b => ? c) ) M. %query 1 1 prove( (? a => ? b /\ ? c) <=> (? a => ? b) /\ (? a => ? c) ) M. %query 0 1 prove( (? a => ? b \/ ? c) => (? a => ? b) \/ (? a => ? c) ) M. % %query 1 1 prove( (? a => ? b \/ ? c) <= (? a => ? b) \/ (? a => ? c) ) M. %query 0 1 prove( ((? a => ? b) => ? c) => ((? a \/ ? b) /\ (? b => ? c)) ) M. % %query 1 1 prove( ((? a => ? b) => ? c) <= ((? a \/ ? b) /\ (? b => ? c)) ) M. % %query 1 1 prove( (? a \/ ? b => ? c) <=> (? a => ? c) /\ (? b => ? c) ) M. % %query 1 1 prove( (? a /\ (? b \/ ? c)) <=> (? a /\ ? b) \/ (? a /\ ? c) ) M. % %query 1 1 prove( (? a \/ (? b /\ ? c)) <=> (? a \/ ? b) /\ (? a \/ ? c) ) M. %query 1 1 prove( (? a => ? b) => (? b => ? c) => (? c => ? d) => (? a => ? d) ) M. %query 1 1 prove( (? a => ? b) => (? a => ? c) => ? a => ? b ) M. %query 1 1 prove( (? a => ? b) => (? a => ? c) => ? a => ? c ) M. %query 1 1 prove( ? a => (? a => ? b) => (? a => ? c) => ? b ) M. %query 1 1 prove( ? a => (? a => ? b) => (? a => ? c) => ? c ) M. %query 1 1 prove( (? a => ? b => ? c) => ? a => ? b => ? c ) M. %query 1 1 prove( (? a => ? b => ? c) => ? b => ? a => ? c ) M. %query 1 1 prove( ? a => ? b => (? a => ? b => ? c) => ? c ) M. %query 1 1 prove( ? b => ? a => (? a => ? b => ? c) => ? c ) M. %query 1 1 prove( (? a => ? b) => ? a => ? b ) M. %query 1 1 prove( ((? a => ? b) => ? c) => ((? a => ? b) => ? c) ) M. %query 1 1 prove( (((? a => ? b) => ? c) => ? d) => (((? a => ? b) => ? c) => ? d) ) M. %query 1 1 prove( ((((? a => ? b) => ? c) => ? d) => ? e) => (((? a => ? b) => ? c) => ? d) => ? e ) M. %query 1 1 prove( (((((? a => ? b) => ? c) => ? d) => ? e) => ? f) => ((((? a => ? b) => ? c) => ? d) => ? e) => ? f ) M. %{ %query 1 1 prove( (((((? a => ? b) => ? c) => ? d) => ? e) => ? f) => (((((? a => ? b) => ? c) => ? d) => ? e) => ? f) \/ (((((? a => ? b) => ? c) => ? d) => ? e) => ? f) ) M. %query 1 1 prove( ((? a => ? b) => ? c) => ? d => ? d \/ ? d ) M. }% %query 1 1 prove(( ( ? a <=> ? b) => ( ? a /\ ? b /\ ? c )) => ( ( ? b <=> ? c) => ( ? a /\ ? b /\ ? c )) => ( ( ? c <=> ? a) => ( ? a /\ ? b /\ ? c )) => ( ? a /\ ? b /\ ? c )) M. % next query verifies the term M from the previous query %query 1 1 fn ((? a <=> ? b) => ? a /\ ? b /\ ? c) ([x:proof] fn ((? b <=> ? c) => ? a /\ ? b /\ ? c) ([x3:proof] fn ((? c <=> ? a) => ? a /\ ? b /\ ? c) ([x4:proof] pair (fst (app (app (fn (? a => ? b) ([x5:proof] fn (? b => ? a) ([y:proof] app x (pair x5 y)))) ( fn (? a) ([z:proof] fst (snd (app (app (fn (? b => ? c) ([x6:proof] fn (? c => ? b) ([y:proof] app x3 (pair x6 y)))) (fn (? b) ([z37:proof] snd (snd (app (app (fn (? c => ? a) ([x7:proof] fn (? a => ? c) ([y:proof] app x4 (pair x7 y)))) (fn (? c) ([z38:proof] z))) (fn (? a) ([z39:proof] snd (snd (app (app (fn (? b) ([x8:proof] app (fn (? a => ? b) ([x9:proof] fn (? b => ? a) ([y:proof] app x (pair x9 y)))) (fn (? a) ([y:proof] x8)))) z37) (fn (? b) ([z40:proof] z39))))))))))) (fn (? c) ([z41:proof] fst (snd (app (app (fn (? c => ? a) ([x10:proof] fn (? a => ? c) ([y:proof] app x4 (pair x10 y)))) (fn (? c) ([z42:proof] z))) (fn (? a) ([z43:proof] z41))))))))))) (fn (? b) ( [z:proof] fst (app (app (fn (? b => ? c) ([x11:proof] fn (? c => ? b) ([y:proof] app x3 (pair x11 y)))) (fn (? b) ([z44:proof] snd (snd (app (app (fn (? c => ? a) ([x12:proof] fn (? a => ? c) ([y:proof] app x4 (pair x12 y)))) (fn (? c) ([z45:proof] fst (app (app (fn (? c) ([x13:proof] app (fn (? b => ? c) ([x14:proof] fn (? c => ? b) ([y:proof] app x3 (pair x14 y)))) (fn (? b) ([y:proof] x13)))) z45) (fn (? c) ([z46:proof] z44)))))) (fn (? a) ([z47:proof] snd (snd (app (fn (? a) ([x15:proof] app (app (fn (? a => ? b) ([x16:proof] fn (? b => ? a) ([y:proof] app x (pair x16 y)))) (fn (? a) ([z48:proof] fst (snd (app (app (fn (? b => ? c) ([x17:proof] fn (? c => ? b) ([y:proof] app x3 (pair x17 y)))) (fn (? b) ([z49:proof] snd (snd (app (app (fn (? c => ? a) ([x18:proof] fn (? a => ? c) ([y:proof] app x4 (pair x18 y)))) (fn (? c) ([z50:proof] z48))) (fn (? a) ([z51:proof] snd (snd (app (app (fn (? b) ([x19:proof] app (fn (? a => ? b) ([x20:proof] fn (? b => ? a) ([y:proof] app x (pair x20 y)))) (fn (? a) ([y:proof] x19)))) z49) (fn (? b) ([z52:proof] z51))))))))))) (fn (? c) ([z53:proof] fst (snd (app (app (fn (? c => ? a) ([x21:proof] fn (? a => ? c) ([y:proof] app x4 (pair x21 y)))) (fn (? c) ([z54:proof] z48))) (fn (? a) ([z55:proof] z53))))))))))) (fn (? b) ([y:proof] x15)))) z47))))))))) (fn (? c) ([z56:proof] z))))))) (pair (fst (snd ( app (app (fn (? a => ? b) ([x22:proof] fn (? b => ? a) ([y:proof] app x (pair x22 y)))) (fn (? a) ([z:proof] fst (snd (app (app (fn (? b => ? c) ([x23:proof] fn (? c => ? b) ([y:proof] app x3 (pair x23 y)))) (fn (? b) ([z57:proof] snd (snd (app (app (fn (? c => ? a) ([x24:proof] fn (? a => ? c) ([y:proof] app x4 (pair x24 y)))) (fn (? c) ([z58:proof] z))) (fn (? a) ([z59:proof] snd (snd (app (app (fn (? b) ([x25:proof] app (fn (? a => ? b) ([x26:proof] fn (? b => ? a) ([y:proof] app x (pair x26 y)))) (fn (? a) ([y:proof] x25)))) z57) (fn (? b) ([z60:proof] z59))))))))))) (fn (? c) ([z61:proof] fst (snd (app (app (fn (? c => ? a) ([x27:proof] fn (? a => ? c) ([y:proof] app x4 (pair x27 y)))) (fn (? c) ([z62:proof] z))) (fn (? a) ([z63:proof] z61))))))))))) (fn (? b) ([z:proof] fst (app (app (fn (? b => ? c) ([x28:proof] fn (? c => ? b) ([y:proof] app x3 (pair x28 y)))) (fn (? b) ([z64:proof] snd (snd (app (app (fn (? c => ? a) ([x29:proof] fn (? a => ? c) ([y:proof] app x4 (pair x29 y)))) (fn (? c) ([z65:proof] fst (app (app (fn (? c) ([x30:proof] app (fn (? b => ? c) ([x31:proof] fn (? c => ? b) ([y:proof] app x3 (pair x31 y)))) (fn (? b) ([y:proof] x30)))) z65) (fn (? c) ([z66:proof] z64)))))) (fn (? a) ([z67:proof] snd (snd (app (fn (? a) ([x32:proof] app (app (fn (? a => ? b) ([x33:proof] fn (? b => ? a) ([y:proof] app x (pair x33 y)))) (fn (? a) ([z68:proof] fst (snd (app (app (fn (? b => ? c) ([x34:proof] fn (? c => ? b) ([y:proof] app x3 (pair x34 y)))) (fn (? b) ([z69:proof] snd (snd (app (app (fn (? c => ? a) ([x35:proof] fn (? a => ? c) ([y:proof] app x4 (pair x35 y)))) (fn (? c) ([z70:proof] z68))) (fn (? a) ([z71:proof] snd (snd (app (app (fn (? b) ([x36:proof] app (fn (? a => ? b) ([x37:proof] fn (? b => ? a) ([y:proof] app x (pair x37 y)))) (fn (? a) ([y:proof] x36)))) z69) (fn (? b) ([z72:proof] z71))))))))))) (fn (? c) ([z73:proof] fst (snd (app (app (fn (? c => ? a) ([x38:proof] fn (? a => ? c) ([y:proof] app x4 (pair x38 y)))) (fn (? c) ([z74:proof] z68))) (fn (? a) ([z75:proof] z73))))))))))) (fn (? b) ([y:proof] x32)))) z67))))))))) (fn (? c) ([z76:proof] z)))))))) (snd (snd ( app (app (fn (? a => ? b) ([x39:proof] fn (? b => ? a) ([y:proof] app x (pair x39 y)))) (fn (? a) ([z:proof] fst (snd (app (app (fn (? b => ? c) ([x40:proof] fn (? c => ? b) ([y:proof] app x3 (pair x40 y)))) (fn (? b) ([z77:proof] snd (snd (app (app (fn (? c => ? a) ([x41:proof] fn (? a => ? c) ([y:proof] app x4 (pair x41 y)))) (fn (? c) ([z78:proof] z))) (fn (? a) ([z79:proof] snd (snd (app (app (fn (? b) ([x42:proof] app (fn (? a => ? b) ([x43:proof] fn (? b => ? a) ([y:proof] app x (pair x43 y)))) (fn (? a) ([y:proof] x42)))) z77) (fn (? b) ([z80:proof] z79))))))))))) (fn (? c) ([z81:proof] fst (snd (app (app (fn (? c => ? a) ([x44:proof] fn (? a => ? c) ([y:proof] app x4 (pair x44 y)))) (fn (? c) ([z82:proof] z))) (fn (? a) ([z83:proof] z81))))))))))) (fn (? b) ([z:proof] fst (app (app (fn (? b => ? c) ([x45:proof] fn (? c => ? b) ([y:proof] app x3 (pair x45 y)))) (fn (? b) ([z84:proof] snd (snd (app (app (fn (? c => ? a) ([x46:proof] fn (? a => ? c) ([y:proof] app x4 (pair x46 y)))) (fn (? c) ([z85:proof] fst (app (app (fn (? c) ([x47:proof] app (fn (? b => ? c) ([x48:proof] fn (? c => ? b) ([y:proof] app x3 (pair x48 y)))) (fn (? b) ([y:proof] x47)))) z85) (fn (? c) ([z86:proof] z84)))))) (fn (? a) ([z87:proof] snd (snd (app (fn (? a) ([x49:proof] app (app (fn (? a => ? b) ([x50:proof] fn (? b => ? a) ([y:proof] app x (pair x50 y)))) (fn (? a) ([z88:proof] fst (snd (app (app (fn (? b => ? c) ([x51:proof] fn (? c => ? b) ([y:proof] app x3 (pair x51 y)))) (fn (? b) ([z89:proof] snd (snd (app (app (fn (? c => ? a) ([x52:proof] fn (? a => ? c) ([y:proof] app x4 (pair x52 y)))) (fn (? c) ([z90:proof] z88))) (fn (? a) ([z91:proof] snd (snd (app (app (fn (? b) ([x53:proof] app (fn (? a => ? b) ([x54:proof] fn (? b => ? a) ([y:proof] app x (pair x54 y)))) (fn (? a) ([y:proof] x53)))) z89) (fn (? b) ([z92:proof] z91))))))))))) (fn (? c) ([z93:proof] fst (snd (app (app (fn (? c => ? a) ([x55:proof] fn (? a => ? c) ([y:proof] app x4 (pair x55 y)))) (fn (? c) ([z94:proof] z88))) (fn (? a) ([z95:proof] z93))))))))))) (fn (? b) ([y:proof] x49)))) z87))))))))) (fn (? c) ([z96:proof] z)))))))))))) $ A.