%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Decision procedure for intuitonistic propositional logic %%% based on contraction-free sequent calculus and inversion. %%% Author: Frank Pfenning %%% October 2009 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Auxiliary predicates on lists %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % append is an efficient built-in % use append_ here for completeness % append_(+[X], +[Y], -[Z]). append_([], Ys, Ys). append_([X|Xs], Ys, [X|Zs]) :- append_(Xs, Ys, Zs). % memberchk is an efficient built-in % use memberchk_ here for completeness % memberchk_(+X, +[X]). memberchk_(X, [X|Ys]) :- !. memberchk_(X, [Y|Ys]) :- memberchk_(X, Ys). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Language and type definitions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % operator precedence declarations, % in increasing binding strength (= decreasing priority) :- op(850, xfx, <=>). % iff, non-assoc :- op(840, xfy, =>). % implies, right assoc :- op(840, yfx, <=). % if, left assoc :- op(830, xfy, \/). % or, right assoc :- op(820, xfy, /\). % and, right assoc :- op(810, fy, ~). % not, prefix :- op(800, fy, ?). % atom, prefix % propositions F, G, with definitions prop_def(?P). prop_def(F /\ G) :- prop_def(F), prop_def(G). prop_def(tt). prop_def(F \/ G) :- prop_def(F), prop_def(G). prop_def(ff). prop_def(F => G) :- prop_def(F), prop_def(G). prop_def(F <= G) :- prop_def(F), prop_def(G). prop_def(F <=> G) :- prop_def(F), prop_def(G). prop_def(~F) :- prop_def(F). % propositions A, B, C, ..., without defs prop(?P). prop(A /\ B) :- prop(A), prop(B). prop(tt). prop(A \/ B) :- prop(A), prop(B). prop(ff). prop(A => B) :- prop(A), prop(B). % right synchronous propositions rsyn(?P). rsyn(A \/ B) :- prop(A), prop(B). rsyn(ff). % left synchronous propositions lsyn( ?P => B) :- prop(B). lsyn((D => E) => B) :- prop(D), prop(E), prop(B). % atoms P atm(?P). % expand_defs(+prop_def, -prop). % expand_defs(F, A) % if A is the result of expanding definitions in F expand_defs(?P, ?P). expand_defs(F /\ G, A /\ B) :- expand_defs(F, A), expand_defs(G, B). expand_defs(tt, tt). expand_defs(F \/ G, A \/ B) :- expand_defs(F, A), expand_defs(G, B). expand_defs(ff, ff). expand_defs(F => G, A => B) :- expand_defs(F, A), expand_defs(G, B). expand_defs(F <= G, B => A) :- expand_defs(F, A), expand_defs(G, B). expand_defs(F <=> G, (A => B) /\ (B => A)) :- expand_defs(F, A), expand_defs(G, B). expand_defs(~F, A => ff) :- expand_defs(F, A). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Decision procedure %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % top-level predicates prove(F) and refute(F) % prove(+prop_def). prove(F) :- expand_defs(F, A), seqR([], [], [], A). % refute(+prop_def). refute(F) :- expand_defs(F, A), \+ seqR([], [], [], A). % Contraction-free sequent calculus with inversion % All arguments are inputs % seqR(+[atm], +[lsyn], +[prop], +prop). % seqL(+[atm], +[lsyn], +[prop], +rsyn). % chooseR(+[atm], +[lsyn], +rsyn). % chooseL(+[atm], +[lsyn], +[lsyn], +rsyn). % seqR(Ps, Is, Hs, A) % break down right asynchronous proposition A % right asynchronous cases /\R, ttR, =>R seqR(Ps, Is, Hs, A /\ B) :- seqR(Ps, Is, Hs, A), seqR(Ps, Is, Hs, B). seqR(Ps, Is, Hs, tt). seqR(Ps, Is, Hs, A => B) :- seqR(Ps, Is, [A|Hs], B). % right synchronous cases \/, ff, ? seqR(Ps, Is, Hs, A \/ B) :- seqL(Ps, Is, Hs, A \/ B). seqR(Ps, Is, Hs, ff) :- seqL(Ps, Is, Hs, ff). seqR(Ps, Is, Hs, ?P) :- seqL(Ps, Is, Hs, ?P). % seqL(Ps, Is, Hs, C) % break down left asynchronous propositions Hs % left asynchronous cases /\L, ttL, \/L, ffL seqL(Ps, Is, [A /\ B|Hs], C) :- seqL(Ps, Is, [A,B|Hs], C). seqL(Ps, Is, [tt|Hs], C) :- seqL(Ps, Is, Hs, C). seqL(Ps, Is, [A \/ B|Hs], C) :- seqL(Ps, Is, [A|Hs], C), seqL(Ps, Is, [B|Hs], C). seqL(Ps, Is, [ff|Hs], C). % left asynchronous cases /\=>L, tt=>L, \/=>L, ff=>L seqL(Ps, Is, [(D /\ E) => B|Hs], C) :- seqL(Ps, Is, [D => (E => B)|Hs], C). seqL(Ps, Is, [tt => B|Hs], C) :- seqL(Ps, Is, [B|Hs], C). seqL(Ps, Is, [(D \/ E) => B|Hs], C) :- seqL(Ps, Is, [D => B, E => B|Hs], C). seqL(Ps, Is, [ff => B|Hs], C) :- seqL(Ps, Is, Hs, C). % left synchronous cases ?, ?=>, =>=> seqL(Ps, Is, [?P|Hs], C) :- seqL([?P|Ps], Is, Hs, C). seqL(Ps, Is, [(?P => B)|Hs], C) :- seqL(Ps, [(?P => B)|Is], Hs, C). seqL(Ps, Is, [(D => E) => B|Hs], C) :- seqL(Ps, [(D => E) => B|Is], Hs, C). % asynchronous phase complete (Hs = []) % now apply synchronous rule on right or left seqL(Ps, Is, [], C) :- chooseR(Ps, Is, C). seqL(Ps, Is, [], C) :- chooseL(Ps, Is, [], C). % chooseR(Ps, Is, C) % break down a synchronous proposition on right chooseR(Ps, Is, A \/ B) :- seqR(Ps, Is, [], A). chooseR(Ps, Is, A \/ B) :- seqR(Ps, Is, [], B). % chooseR(Ps, Is, ff) fails - no right rule chooseR(Ps, Is, ?P) :- memberchk_(?P,Ps). % init rule % chooseL(Ps, Is, Js, C) % break down a synchronous proposition on left % Js accumulates unused synchronous propositions chooseL(Ps, [?P => B|Is], Js, C) :- memberchk_(?P,Ps), !, % in this case, rule is invertible append_(Is, Js, Ks), seqL(Ps, Ks, [B], C). % now decompose B asynchronously chooseL(Ps, [?P => B|Is], Js, C) :- chooseL(Ps, Is, [?P => B|Js], C). chooseL(Ps, [(D => E) => B|Is], Js, C) :- append_(Is, Js, Ks), seqR(Ps, Ks, [E => B, D], E), % now decompose E, then E => B and D seqL(Ps, Ks, [B], C). % now decompose B (C is r-synchronous already) chooseL(Ps, [(D => E) => B|Is], Js, C) :- chooseL(Ps, Is, [(D => E) => B|Js], C). % chooseL(Ps, [], Js, C) fails - all possibilities tried %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Test cases %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % note: space or parens are needed for ~ ~A and ~ ?P :- initialization(prove(?p => ?p)). :- initialization(refute(?p \/ ~ ?p)). :- initialization(prove(~ ~(?p \/ ~ ?p))). :- initialization(prove(~ ~(((?p => ?q) => ?p) => ?p))). % from SML test harness :- initialization(prove( ?a => ?a )). :- initialization(prove( ?a => (?b => ?a) )). :- initialization(prove( (?a => ?b) => (?a => (?b => ?c)) => (?a => ?c) )). :- initialization(prove( ~ (~ (((?a => ?b) => ?a) => ?a)) )). :- initialization(prove( ?a /\ ?b => ?b /\ ?a )). :- initialization(prove( ?a \/ ?b => ?b \/ ?a )). :- initialization(prove( (?p => (?c /\ ?k) \/ (?d /\ ?l)) => (~ ?k => ?s) => (?d \/ ?l) => (?p => ~ ?s) /\ (?s => ~ ?p) => (?c => ~ ?d) /\ (?d => ~ ?c) => (?k => ~ ?l) /\ (?l => ~ ?k) => ~ ?p )). :- initialization(prove( (?a \/ ?c) /\ (?b => ?c) => (?a => ?b) => ?c )). :- initialization(prove( (?a => ?b => ?c) <=> (?a /\ ?b => ?c) )). :- initialization(prove( (?a => ?b /\ ?c) <=> (?a => ?b) /\ (?a => ?c) )). :- initialization(refute( (?a => ?b \/ ?c) => (?a => ?b) \/ (?a => ?c) )). :- initialization(prove( (?a => ?b \/ ?c) <= (?a => ?b) \/ (?a => ?c) )). :- initialization(refute( ((?a => ?b) => ?c) => ((?a \/ ?b) /\ (?b => ?c)) )). :- initialization(prove( ((?a => ?b) => ?c) <= ((?a \/ ?b) /\ (?b => ?c)) )). :- initialization(prove( (?a \/ ?b => ?c) <=> (?a => ?c) /\ (?b => ?c) )). :- initialization(prove( (?a /\ (?b \/ ?c)) <=> (?a /\ ?b) \/ (?a /\ ?c) )). :- initialization(prove( (?a \/ (?b /\ ?c)) <=> (?a \/ ?b) /\ (?a \/ ?c) )). :- initialization(refute( ~ (?a /\ ?b) => ~ ?a \/ ~ ?b )). :- initialization(prove( ~ (?a /\ ?b) <= ~ ?a \/ ~ ?b )). :- initialization(prove( ~ (?a \/ ?b) <=> ~ ?a /\ ~ ?b )). :- initialization(refute( ~ (?a => ?b) => ?a /\ ~ ?b )). :- initialization(prove( ~ (?a => ?b) <= ?a /\ ~ ?b )). :- initialization(refute( ~ (~ ?a) => ?a )). :- initialization(prove( ~ (~ ?a) <= ?a )). :- initialization(prove( ~ tt <=> ff )). :- initialization(prove( ~ ff <=> tt )). :- initialization(prove( ~ (~ (~ ?a)) <=> ~ ?a )). :- initialization(prove( (?a => ?b) => (?b => ?c) => (?c => ?d) => (?a => ?d) )). :- initialization(prove( (?a => ?b) => (?a => ?c) => ?a => ?b )). :- initialization(prove( (?a => ?b) => (?a => ?c) => ?a => ?c )). :- initialization(prove( ?a => (?a => ?b) => (?a => ?c) => ?b )). :- initialization(prove( ?a => (?a => ?b) => (?a => ?c) => ?c )). :- initialization(prove( (?a => ?b => ?c) => ?a => ?b => ?c )). :- initialization(prove( (?a => ?b => ?c) => ?b => ?a => ?c )). :- initialization(prove( ?a => ?b => (?a => ?b => ?c) => ?c )). :- initialization(prove( ?b => ?a => (?a => ?b => ?c) => ?c )). :- initialization(prove( (?a => ?b) => ?a => ?b )). :- initialization(prove( ((?a => ?b) => ?c) => ((?a => ?b) => ?c) )). :- initialization(prove( (((?a => ?b) => ?c) => ?d) => (((?a => ?b) => ?c) => ?d) )). :- initialization(prove( ((((?a => ?b) => ?c) => ?d) => ?e) => (((?a => ?b) => ?c) => ?d) => ?e )). :- initialization(prove( (((((?a => ?b) => ?c) => ?d) => ?e) => ?f) => ((((?a => ?b) => ?c) => ?d) => ?e) => ?f )). :- initialization(prove( (((((?a => ?b) => ?c) => ?d) => ?e) => ?f) => (((((?a => ?b) => ?c) => ?d) => ?e) => ?f) \/ (((((?a => ?b) => ?c) => ?d) => ?e) => ?f) )). :- initialization(prove( ((?a => ?b) => ?c) => ?d => ?d \/ ?d )). :- initialization(prove(( ( ?p1 <=> ?p2) => ( ?p1 /\ ?p2 /\ ?p3 )) => ( ( ?p2 <=> ?p3) => ( ?p1 /\ ?p2 /\ ?p3 )) => ( ( ?p3 <=> ?p1) => ( ?p1 /\ ?p2 /\ ?p3 )) => ( ?p1 /\ ?p2 /\ ?p3 ))).