%%%%%%%%%%%%%%%
%
%    cnf(Fin, Fout) - naive conversion to conjunctive normal form 
%
%    Fin can be associated any way; Fout is left associated.
%    When formulas are copied, quantified variables are renamed.
%    See procedure `rcnf' for "smart" conversion to cnf.
%
%%%%%%%%%%%%%%%

cnf(and(X, Y), Fout) :-
    !,
    cnf(X, X1), 
    cnf(Y, Y1), 
    append_and(X1, Y1, Fout).
cnf(or(X, Y), Z) :-
    !,
    cnf(X, X1), 
    cnf(Y, Y1), 
    cnf_1(X1, Y1, Z).
cnf(imp(X, Y), Z) :-
    !,
    cnf(or(~(X), Y), Z).
cnf(iff(X, Y), Z) :-
    !,
    copy_new_vars(X, X1),
    copy_new_vars(Y, Y1),
    cnf(and(or(~(X), Y), or(X1, ~(Y1))), Z).
cnf(~(X), X2) :-
    nnf(~(X), X1), 
    ~(X) \== X1, 
    !,
    cnf(X1, X2).
cnf(X, X) :-
    !.

cnf_1(and(X, Y), Z, Fout) :-
    !,
    copy_new_vars(Z, Z1),
    cnf(or(X, Z), W1), 
    cnf(or(Y, Z1), W2),
    append_and(W1, W2, Fout).
cnf_1(Z, and(X, Y), Fout) :-
    !,
    copy_new_vars(Z, Z1),
    cnf(or(Z, X), W1), 
    cnf(or(Z1, Y), W2),
    append_and(W1, W2, Fout).
cnf_1(X, Y, Fout) :-
    !,
    append_or(X, Y, Fout).

%%%%%%%%%%%%%%%
%
%    dnf(Fin, Fout) - naive conversion to disjunctive normal form
%
%    Fin can be associated any way; Fout is left associated.
%    When formulas are copied, quantified variables are renamed.
%    See procedure `rdnf' for "smart" conversion to dnf.
%
%%%%%%%%%%%%%%%

dnf(or(X, Y), Fout) :-
    !,
    dnf(X, X1), 
    dnf(Y, Y1), 
    append_or(X1, Y1, Fout).
dnf(and(X, Y), Z) :-
    !,
    dnf(X, X1), 
    dnf(Y, Y1), 
    dnf_1(X1, Y1, Z).
dnf(imp(X, Y), Z) :-
    !,
    dnf(and(~(X), Y), Z).
dnf(iff(X, Y), Z) :-
    !,
    copy_new_vars(X, X1),
    copy_new_vars(Y, Y1),
    dnf(or(and(~(X), Y), and(X1, ~(Y1))), Z).
dnf(~(X), X2) :-
    nnf(~(X), X1), 
    ~(X) \== X1, 
    !,
    dnf(X1, X2).
dnf(X, X) :-
    !.

dnf_1(or(X, Y), Z, Fout) :-
    !,
    copy_new_vars(Z, Z1),
    dnf(and(X, Z), W1), 
    dnf(and(Y, Z1), W2),
    append_or(W1, W2, Fout).
dnf_1(Z, or(X, Y), Fout) :-
    !,
    copy_new_vars(Z, Z1),
    dnf(and(Z, X), W1), 
    dnf(and(Z1, Y), W2),
    append_or(W1, W2, Fout).
dnf_1(X, Y, Fout) :-
    !,
    append_and(X, Y, Fout).

%%%%%%%%%%%%%
%
%   rcnf_compact(Fin, Fout) 
%   rdnf_compact(Fin, Fout)
%
%      Similar to rcnf and rdnf, except that the compaction
%      optimization is preformed first.
%
%%%%%%%%%%%%%

rcnf_compact(A, B) :-
    !,
    compact_or(A, C),
    rcnf(C, B).

rdnf_compact(A, B) :-
    !,
    compact_and(A, C),
    rdnf(C, B).

%%%%%%%%%%%%%%
%
%   rcnf(Fin,Fout) - Transform Fin to reduced conjunctive normal 
%   form (rcnf).  `Literals' can be quantified formulas.  rcnf 
%   means that no disjunct g_subsumes another, and that no disjunct 
%   g_reduces.  If quantified variables are unique, then that
%   property is preserved.
%
%%%%%%%%%%%%%%

rcnf(A or (B and C), Fout) :-
    !,
    rcnf(A, A1),
    rcnf(B, B1),
    rcnf(C, C1),
    copy_new_vars(A1, A2),
    s6_and(A1, B1, D1),
    s6_and(A2, C1, D2),
    s3_and(D1, D2, Fout).
rcnf((B and C) or A, Fout) :-
    !,
    rcnf(A, A1),
    rcnf(B, B1),
    rcnf(C, C1),
    copy_new_vars(A1, A2),
    s6_and(B1, A1, D1),
    s6_and(C1, A2, D2),
    s3_and(D1, D2, Fout).
rcnf(A or B, Fout) :-
    !,
    rcnf(A, A1),
    rcnf(B, B1),
    s6_and(A1, B1, Fout).
rcnf(A and B, Fout) :-
    !,
    rcnf(A, A1),
    rcnf(B, B1),
    s3_and(A1, B1, Fout).
rcnf(X, X).

%%%%%%%%%%%%%%%
%
%    rdnf(Fin,Fout) - Transform to reduced disjunctive normal form.
%    Dual of rcnf.
%
%%%%%%%%%%%%%%%

rdnf(A and (B or C), Fout) :-
    !,
    rdnf(A, A1),
    rdnf(B, B1),
    rdnf(C, C1),
    copy_new_vars(A1, A2),
    s6_or(A1, B1, D1),
    s6_or(A2, C1, D2),
    s3_or(D1, D2, Fout).
rdnf((B or C) and A, Fout) :-
    !,
    rdnf(A, A1),
    rdnf(B, B1),
    rdnf(C, C1),
    copy_new_vars(A1, A2),
    s6_or(B1, A1, D1),
    s6_or(C1, A2, D2),
    s3_or(D1, D2, Fout).
rdnf(A and B, Fout) :-
    !,
    rdnf(A, A1),
    rdnf(B, B1),
    s6_or(A1, B1, Fout).
rdnf(A or B, Fout) :-
    !,
    rdnf(A, A1),
    rdnf(B, B1),
    s3_or(A1, B1, Fout).
rdnf(X, X).

%%%%%%%%%%%%%%%%%
%
%    s3_and(A,B,Fout)   Transform (A and B) into rcnf.  It is assumed that
%    each of A and B are in rcnf.
%
%%%%%%%%%%%%%%%%%

s3_and(A, B, C) :-
    s3_a(A, B, Aout, Bout),
    append_and(Aout, Bout, C),
    !.

s3_a(false, _, false, false) :- !.
s3_a(_, false, false, false) :- !.
s3_a(A, true, A, true) :- !.
s3_a(true, B, true, B) :- !.
s3_a(A1 and A2, B, Aout, Bout) :-
    !,
    s3_a(A1, B, At, Bt),
    s3_a(A2, Bt, As, Bout),
    reduce4(At and As, Aout).
s3_a(A, B1 and B2, Aout, Bout) :-
    !,
    s3_a(A, B1, At, Bt),
    s3_a(At, B2, Aout, Bs),
    reduce4(Bt and Bs, Bout).
s3_a(A, B, A, true) :-
    gensub(A, B),
    !.
s3_a(A, B, true, B) :-
    gensub(B, A),
    !.
s3_a(A, B, false, false) :-
    nnf(~B, B1),
    gensub(A, B1),
    !.
s3_a(A, B, A, B).

%%%%%%%%%%%%%%%%%
%
%    s3_or(A,B,Fout)   Transform (A or B) into rdnf.  It is assumed that
%    each of A and B are in rdnf.
%
%%%%%%%%%%%%%%%%%

s3_or(A, B, C) :-
    s3_o(A, B, Aout, Bout),
    append_or(Aout, Bout, C),
    !.

s3_o(true, _, true, true) :- !.
s3_o(_, true, true, true) :- !.
s3_o(false, B, false, B) :- !.
s3_o(A, false, A, false) :- !.
s3_o(A1 or A2, B, Aout, Bout) :-
    !,
    s3_o(A1, B, At, Bt),
    s3_o(A2, Bt, As, Bout),
    reduce4(At or As, Aout).
s3_o(A, B1 or B2, Aout, Bout) :-
    !,
    s3_o(A, B1, At, Bt),
    s3_o(At, B2, Aout, Bs),
    reduce4(Bt or Bs, Bout).
s3_o(A, B, false, B) :-
    gensub(A, B),
    !.
s3_o(A, B, A, false) :-
    gensub(B, A),
    !.
s3_o(A, B, true, true) :-
    nnf(~A, A1),
    gensub(A1, B),
    !.
s3_o(A, B, A, B).

%%%%%%%%%%%%%%%%%
%
%    s6_and(A,B,Fout)   Transform (A or B) into rcnf.  It is assumed that
%    each of A and B are in rcnf.
%
%%%%%%%%%%%%%%%%%

s6_and(A, B and C, Fout) :-
    !,
    copy_new_vars(A, A1),
    s6_and(A,  B, D1),
    s6_and(A1, C, D2),
    s3_and(D1, D2, Fout).
s6_and(B and C, A, Fout) :-
    !,
    copy_new_vars(A, A1),
    s6_and(B, A,  D1),
    s6_and(C, A1, D2),
    s3_and(D1, D2, Fout).
s6_and(A, B, Fout) :-
    s3_or(A, B, Fout).

%%%%%%%%%%%%%%%%%
%
%    s6_or(A,B,Fout)   Transform (A and B) into rdnf.  It is assumed that
%    each of A and B are in rdnf.
%
%%%%%%%%%%%%%%%%%

s6_or(A, B or C, Fout) :-
    !,
    copy_new_vars(A, A1),
    s6_or(A,  B, D1),
    s6_or(A1, C, D2),
    s3_or(D1, D2, Fout).
s6_or(B or C, A, Fout) :-
    !,
    copy_new_vars(A, A1),
    s6_or(B, A,  D1),
    s6_or(C, A1, D2),
    s3_or(D1, D2, Fout).
s6_or(A, B, Fout) :-
    s3_and(A, B, Fout).

%%%%%%%%%%%%%
%
%  compact a cnf formula
%
%%%%%%%%%%%%%

compact_and(F, Result) :-
    cm_and_0(1, F, [], L),
    cm_pick(L, N, o(A, P)),
    N > 1,
    !,
    reverse(P, [], Pr),
    compress_and(1, Pr, A, F, C, NC),
    compact_and(C, C2),
    compact_and(NC, NC2),
    reduce4(C2 or A, C2A),
    reduce4(NC2 and C2A, Result).
compact_and(F, F).

compress_and(N, [M|R], A, T and F, Cout, Nout) :-
    N < M,
    !,
    N1 is N + 1,
    compress_and(N1, [M|R], A, T, Cout, G),
    reduce4(G and F, Nout).
compress_and(N, [N|R], A, T and F, Cout, Nout) :-
    !,
    extract_or(A, F, F1),
    N1 is N + 1,
    compress_and(N1, R, A, T, C, Nout),
    reduce4(C and F1, Cout).
compress_and(N, [N], A, F, F1, true) :-
    !,
    extract_or(A, F, F1).
compress_and(_, [], _, F, true, F).

extract_or(A, L or A, L) :-
    !.
extract_or(A, L or B, Lout) :-
    !,
    extract_or(A, L, L1),
    reduce4(L1 or B, Lout).
extract_or(A, A, false) :-
    !.
extract_or(_, A, A).

cm_and_0(N, A and B, Lin, Lout) :-
    !,
    cm_and_1(N, B, Lin, L1),
    M is N + 1,
    cm_and_0(M, A, L1, Lout).
cm_and_0(N, B, Lin, Lout) :-
    cm_and_1(N, B, Lin, Lout).

cm_and_1(N, A or B, Lin, Lout) :-
    !,
    cm_insert(N, B, Lin, L1),
    cm_and_1(N, A, L1, Lout).
cm_and_1(N, B, Lin, Lout) :-
    cm_insert(N, B, Lin, Lout).

%%%%%%%%%%%%
%
%  compress_or is the dual of compress_and
%
%%%%%%%%%%%%

compact_or(F, Result) :-
    cm_or_0(1, F, [], L),
    cm_pick(L, N, o(A, P)),
    N > 1,
    !,
    reverse(P, [], Pr),
    compress_or(1, Pr, A, F, C, NC),
    compact_or(C, C2),
    compact_or(NC, NC2),
    reduce4(C2 and A, C2A),
    reduce4(NC2 or C2A, Result).
compact_or(F, F).

compress_or(N, [M|R], A, T or F, Cout, Nout) :-
    N < M,
    !,
    N1 is N + 1,
    compress_or(N1, [M|R], A, T, Cout, G),
    reduce4(G or F, Nout).
compress_or(N, [N|R], A, T or F, Cout, Nout) :-
    !,
    extract_and(A, F, F1),
    N1 is N + 1,
    compress_or(N1, R, A, T, C, Nout),
    reduce4(C or F1, Cout).
compress_or(N, [N], A, F, F1, false) :-
    !,
    extract_and(A, F, F1).
compress_or(_, [], _, F, false, F).

extract_and(A, L and A, L) :-
    !.
extract_and(A, L and B, Lout) :-
    !,
    extract_and(A, L, L1),
    reduce4(L1 and B, Lout).
extract_and(A, A, true) :-
    !.
extract_and(_, A, A).

cm_or_0(N, A or B, Lin, Lout) :-
    !,
    cm_or_1(N, B, Lin, L1),
    M is N + 1,
    cm_or_0(M, A, L1, Lout).
cm_or_0(N, B, Lin, Lout) :-
    cm_or_1(N, B, Lin, Lout).

cm_or_1(N, A and B, Lin, Lout) :-
    !,
    cm_insert(N, B, Lin, L1),
    cm_or_1(N, A, L1, Lout).
cm_or_1(N, B, Lin, Lout) :-
    cm_insert(N, B, Lin, Lout).

%%%%%%%%%%%%%
%
%  support for both sides of compaction dual
%
%%%%%%%%%%%%%

cm_insert(N, B, [o(B, L)|T], [o(B, [N|L])|T]) :-
    !.
cm_insert(N, B, [o(A, L)|T], [o(A, L)|T1]) :-
    B @> A,
    !,
    cm_insert(N, B, T, T1).
cm_insert(N, B, T, [o(B, [N])|T]).

cm_pick([o(A, L)|T], Nout, Oout) :-
     cm_pick(T, N, O),
     length(L, M),
     cm_max(N, M, Nout, O, o(A, L), Oout).
cm_pick([], 0, _).

cm_max(N, M, N, On, _, On) :-
    N > M,
    !.
cm_max(_, M, M, _, Om, Om).

%%%%%%%%%%%%%%
%
%    gensub(F, G) - Does F subsume G?  This is subsumption on
%    unrestricted fully quantified (closed) first-order formulas.
%    All quantified variables must be distinct.  Any prolog term
%    (including a prolog variable) can be a variable.
%
%%%%%%%%%%%%%%

gensub(F, G) :-
  % call s2 with nil variable list and nil substitution
  % don't care about resulting substitution
    skolem(F, [], g, Fs),
    nnf(~G, G1),
    skolem(G1, [], g, G2),
    nnf(~G2, Gs),
    s2(Fs, Gs, [], [[], []], _),
    !.

s2(all(X, F), G, Vlist, Sin, Sout) :-
    !,
    s2(F, G, [X|Vlist], Sin, Sout).
s2(F, exists(X, G), Vlist, Sin, Sout) :-
    !,
    s2(F, G, [X|Vlist], Sin, Sout).
s2(F, all(_, G), Vlist, Sin, Sout) :-
    !,
    write('s2 ERROR '), nl,
    s2(F, G, Vlist, Sin, Sout).
s2(exists(_, F), G, Vlist, Sin, Sout) :-
    !,
    write('s2 ERROR '), nl,
    s2(F, G, Vlist, Sin, Sout).

s2(F1 or F2, G, Vlist, Sin, Sout) :-
    !,
    s2(F2, G, Vlist, Sin, S1),
    s2(F1, G, Vlist, S1, Sout).
s2(F, G1 and G2, Vlist, Sin, Sout) :-
    !,
    s2(F, G2, Vlist, Sin, S1),
    s2(F, G1, Vlist, S1, Sout).

%  Important backtracking occurs in the next four clauses

s2(_ and F2, G, Vlist, Sin, Sout) :-
    s2(F2, G, Vlist, Sin, Sout).
s2(F1 and _, G, Vlist, Sin, Sout) :-
    s2(F1, G, Vlist, Sin, Sout).
s2(F, _ or G2, Vlist, Sin, Sout) :-
    s2(F, G2, Vlist, Sin, Sout).
s2(F, G1 or _, Vlist, Sin, Sout) :-
    !,
    s2(F, G1, Vlist, Sin, Sout).

s2(false, _, _, S, S) :-
    !.
s2(_, true, _, S, S) :-
    !.

s2(F, G, Vlist, Sin, Sout) :-
    !,
    increment(gensub_unify2_attempts),
    unify2(F, G, Vlist, Sin, Sout),
    increment(gensub_unify2_successes).

%%%%%%%%%%%%%%%%%%
%
%   s2_conj(C, Fin, Fout) - Fin is a conjunctive formula.  It is
%   transformed to Fout by deleting the conjuncts that
%   are subsumed (gensub) by C.
%
%%%%%%%%%%%%%%%%%%

s2_conj(C, X and Y, Cout) :-
    !,
    s2_conj(C, X, X1),
    s2_conj(C, Y, Y1),
    reduce4(X1 and Y1, Cout), % just to get rid of trues
    !.
s2_conj(C, X, true) :-
    gensub(C, X),
    !.
s2_conj(_, X, X).

%%%%%%%%%%%%%%%%%%
%
%   s2_disj(C, Fin, Fout) - Fin is a disjunctive formula.  It is
%   transformed to Fout by rewriting to false the conjuncts that
%   are subsumed (gensub) by C.
%
%%%%%%%%%%%%%%%%%%

s2_disj(C, X or Y, Cout) :-
    !,
    s2_disj(C, X, X1),
    s2_disj(C, Y, Y1),
    reduce4(X1 or Y1, Cout), % just to get rid of falses
    !.
s2_disj(C, X, false) :-
    gensub(X, C),
    !.
s2_disj(_, X, X).

