%%%%%%%%%%%%%%%
%
%    Operator declarations:
%
%    :- op(740,fx,~).      not (no parens needed, lowest precedence)
%    :- op(750,yfx,and).   (a and b and c) is left associated
%    :- op(760,yfx,or).    (a or b or c) is left associated
%
%    Example conjunction of clauses:
%
%        ( p(x,f(x)) or ~a=x ) and
%        ( q or ~r(y) or ~f(y)=f(b) ) and
%          r(f(f(b)))
%
%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%
%
%    unsk_conj(C_in, F_out) - Unskolemize a conjunction of clauses.
%    It is assumed that C_in is an unquantified cnf formula that does 
%    not contain any variables starting with 'yy'.  Skolem expressions
%    are identified by tpskolem(F).  If C_in can be unskolemized by
%    this procedure,  then F_out is the fully quantified formula.  
%    Variables in C_in are identified by tpvar(F).  Variables in
%    separate clauses of C_in need not be distinct.  All quantified
%    variables in F_out are distinct.
%
%%%%%%%%%%%%%%%

unsk_conj(C_in, F_out) :-
    part_skolem(C_in, L1),  % partition into a list of blocks
    unsk_blocks(L1, F1),    % unskolemize blocks
    assand(F1, [], F2),     % left_associate conjunction
    unique_vars(F2, F_out). % make sure quantified variables are unique

unsk_blocks([E], F) :-
    !,
    unsk_1_block(E, F).
unsk_blocks([H|T], F1 and F2) :-
    unsk_1_block(H, F1),
    unsk_blocks(T, F2).

unsk_1_block(Lin, Lout) :-

    clean_currentnum(yy),   % reset counter

    us_clauses(Lin, L1, [], A), % steps A and B: rewrite clauses and
                                % get rewritten Skolem expressions

    step_2(A, [], [], V, T), % for each symbol, unify all argument lists 
    simsub(V, A, T, A1),   % apply unifying substitution 
    compact(A1, A2),       % merge. result is one expression per symbol 

    check_args(A2), % check that args for a given expression are unique 
                    % if this check fails, then everything fails 

    step_3(A2, V, T, V1, T1), % for expressions of = length, unify permutations 

    simsub(V1, A2, T1, A4), % apply the substitution 

    check_args(A4), % for each expression, check that args are still unique; 
                    % if this check fails, backtrack to usf2 to permute 
                    % one of the arg lists and get another substitution 

    subset_property(A4), % check that each arg list is a subset of the next
                         % if this check fails, backtrack to usf2 to permute 
                         % one of the arg lists and get another substitution 

    !,                   % commit here 

    simsub(V1, L1, T1, L2), % apply unifying substitution to list of clauses 

    other_vars(L2, L3),  % for each clause, renumber (starting with zz1) 
                         % variables not in Skolem expressions 

    add_all(L3, L4),     % insert universal quantifiers 

    clean_currentnum(ww),   % reset counter

    add_exists(0, L4, L5, A4, VL), % insert existential quantifiers and
                                   % return a list of vars to be substituted 
                                   % for skolem expressions 

    simsub2(A4, L5, VL, L6),   % substitute existentially quantified 
                               % variables for Skolem expressions 
    Lout = L6.

%%%%%%%%%%%%%%%
%
%    us_clauses(Lin, Lout, Ain, Aout) - Collect and rewrite the Skolem
%    expressions for a list of clauses, making some checks for each clause.
%
%%%%%%%%%%%%%%%

us_clauses(X and Y, X1 and Y1, Ain, Aout) :-
    !,
    us_clauses(X, X1, Ain, A1),
    us_clauses(Y, Y1, A1, Aout).
us_clauses(X, X1, Ain, Aout) :-
    us_cl(X, X1, Ain, Aout).

%%%%%%%%%%%%%%%
%
%    us_cl(Cin, Cout, Ain, Aout) - Collect the Skolem expressions for
%    clause Cin, and merge with Ain.  Check that Cin can be unskolemized.
%    The variables in Skolem expressions are renamed, and negative
%    equalities are added to the clause if there are non-variables or
%    repeated variables in Skolem expressions.
%
%    Here are the steps:
%      
%      unsk1 - Get the list of skolem expressions, making sure that
%      if a Skolem function occurs more than once, then the argument
%      lists are all identical.
%
%      unsk2 - Sort the list of skolem expressions and check that
%      the argument list for each expression is a subset of the
%      argument list for the next expression.
%
%      unsk3 - With the list of Skolem expressions, replace the
%      arguments with new variables and return a disjunction of
%      negative equalities.
%
%      replace old Skolem expressions with new ones.
%
%      unsk4 - eliminate as many as possible of the negative
%      equalities while making sure that Skolem expressions
%      retain lists of unique arguments.
%
%%%%%%%%%%%%%%%

us_cl(false, false, Ain, Ain) :-
    !.
us_cl(Cin, Cout, Ain, Aout) :-
    unsk1(Cin, [], A),
    unsk2(A, A1),
    unsk3(A1, A2, D),
    simsub2(A1, Cin, A2, C1),
    simsub2(A1, D, A2, D1),
    unsk4(D1, false, C1, D2, C2),
    append_or(C2, D2, C3),
    cleanup(C3, Cout),
    merge1(A2, Ain, Aout).

%%%%%%%%%%%%%%%
%
%    unsk1(F, Ain, Aout) - append Skolem expressions in F to Ain to
%    produce Aout.  Fails if a Skolem symbol has 2 different are lists.
%
%%%%%%%%%%%%%%%

unsk1(Fin, Tin, Tout) :-
    tpskolem(Fin),
    !,
    checkargs(Fin, Tin, TT),
    Fin =.. [_|FT],
    unsk1_args(FT, TT, Tout).
unsk1(Fin, Tin, Tout) :-
    Fin =.. [_|FT],
    unsk1_args(FT, Tin, Tout).

unsk1_args([H|T], Tin, Tout) :-
    unsk1(H, Tin, TT),
    unsk1_args(T, TT, Tout).
unsk1_args([], Tin, Tin).

checkargs(Fin, [H|T], [H|T]) :-
    Fin =.. [FH|FT],
    H =.. [FH|HT],
    !,
    FT == HT.
checkargs(Fin, [H|T], [H|T1]) :-
    checkargs(Fin, T, T1).
checkargs(Fin, [], [Fin]).

%%%%%%%%%%%%%%%
%
%    unsk2(Ain, Aout) - sort list of expressions (standard Prolog order,
%    smaller arities first).  Fails if any arg list is not a subset of
%    its successor.
%
%%%%%%%%%%%%%%%

unsk2(L, L1) :-
    isort(L, L1),
    subset_property(L1).

subset_property([X1|[X2|T]]) :-
    X1 =.. [_|Z1],
    X2 =.. [_|Z2],
    sublist(Z1, Z2),
    subset_property([X2|T]).
subset_property([_]).
subset_property([]).

%%%%%%%%%%%%%%%
%
%    unsk3(Ain, Aout, D) - Replace all arguments with new variables,
%    and append negated equalities.  Example:
%
%    unsk3(  [f1(a),  f2(a,  a,  x),   f3(x,  x,  a,  a)],
%            [f1(yy1),f2(yy1,yy2,yy3), f3(yy3,yy4,yy1,yy2)],
%            ~a=yy1 or ~x=yy3 or ~a=yy2 or ~x=yy4              ).
%
%%%%%%%%%%%%%%%

unsk3([H|T], [H2|T2], E) :-
    H =.. [_|A],
    unsk3a(A, [H|T], [H2|T1], C),
    unsk3(T1, T2, D),
    append_or(C, D, E).      % append disjunctions of negated equalities
unsk3([], [], false).

unsk3a([H|T], A1, A2, D) :-
    atomic(H),
    name(H, [121|[121|_]]),  % starts with "yy", so skip it
    !,
    unsk3a(T, A1, A2, D).
unsk3a([H|T], A1, A3, C) :-
    gensym(yy, S),           % generate a new yy variable
    sub_first(H, A1, S, A2), % substitute first occurrence in each Sk expr
    unsk3a(T, A2, A3, D),
    oron(D, ~(H=S), C).      % append negative equality
unsk3a([], A, A, false).

sub_first(A, [H|T], B, [H1|T1]) :-
    H =.. [F|G],
    s_f_1(A, G, B, G1),
    H1 =.. [F|G1],
    sub_first(A, T, B, T1).
sub_first(_, [], _, []).

s_f_1(A, [H|T], B, [B|T]) :-
    A == H,
    !.
s_f_1(A, [H|T], B, [H|T1]) :-
    s_f_1(A, T, B, T1).

%%%%%%%%%%%%%%%
%
%    unsk4(D, Din, Cin, Dout, Cout) - eliminate as many as possible of
%    the negative equalities without causing duplicate arguments.
%
%%%%%%%%%%%%%%%

unsk4(D or ~(A = B), F, C, D2, C2) :-
    tpvar(A),
    \+ name(A, [121|[121|_]]), % doesn't start with "yy"
    !, % A not occur in B, so no occurcheck problem
    subst(A, F or D or C, B, F1 or D1 or C1),
    unsk4(D1, F1, C1, D2, C2).
unsk4(D or E, F, C, D1, C1) :-
    !,
    unsk4(D, F or E, C, D1, C1).
unsk4(~(A = B), F, C, D2, C2) :-
    tpvar(A),
    \+ name(A, [121|[121|_]]), % doesn't start with "yy"
    !, % A not occur in B, so no occurcheck problem
    subst(A, F or C, B, D2 or C2).
unsk4(D, F, C, F or D, C).

%%%%%%%%%%%%%%%
%
%    step_2(A, Vin, Tin, Vout, Tout) - With a list of Skolem expressions
%    that came from a list of clauses, unify each pair of expressions
%    with the same Skolem function.  Vin, Tin is the incoming
%    substitution, and Vout, Tout is the outgoing substitution.
%
%%%%%%%%%%%%%%%

step_2([X|[Y|Z]], Vin, Tin, Vout, Tout) :-
    X =.. [H|_],
    Y =.. [H|_],
    !,
    unify(X, Y, [Vin, Tin], [V1, T1]),
    step_2([Y|Z], V1, T1, Vout, Tout).
step_2([_|[Y|Z]], Vin, Tin, Vout, Tout) :-
    !,
    step_2([Y|Z], Vin, Tin, Vout, Tout).
step_2(_, V, T, V, T).

%%%%%%%%%%%%%%%
%
%    step_3(A, Vin, Tin, Vout, Tout) -  A is a list of Skolem expressions
%    in which there is only one expression for each Skolem function
%    (because they have been unified and merged), and the arguments
%    for a given expression are all different variables, (because 
%    they have been checked).   This routine unifies all pairs of
%    expressions of equal length.  On backtracking, permutations of
%    one of the lists are unified.
%
%%%%%%%%%%%%%%%

step_3([X|[Y|Z]], Vin, Tin, Vout, Tout) :-
    X =.. [_|X2],
    Y =.. [_|Y2],
    length(X2, N),
    length(Y2, N),
    !,
    permute(Y2, Y3),
    unify(X2, Y3, [Vin, Tin], [V1, T1]),
    step_3([Y|Z], V1, T1, Vout, Tout).
step_3([_|[Y|Z]], Vin, Tin, Vout, Tout) :-
    !,
    step_3([Y|Z], Vin, Tin, Vout, Tout).
step_3(_, Vin, Tin, Vin, Tin).

%%%%%%%%%%%%%%%
%
%    other_vars(Fin, Fout) - For each clause in a conjunction of
%    clauses, rename those variables not starting with "yy"
%    to zz1, zz2, zz3, ... .
%
%%%%%%%%%%%%%%%

other_vars(X and Y, X1 and Y1) :-
    !,
    other_vars(X, X1),
    other_vars(Y, Y1).
other_vars(Xin, Xout) :-
    clean_currentnum(zz),  % reset counter
    othervars2(Xin, [], _, Xin, Xout).

othervars2(G, Lin, [G|Lin], Fin, Fout) :-
    tpvar(G),
    \+ name(G, [121|[121|_]]), % yy
    \+ member(G, Lin),
    !,
    gensym(zz, VS),           % generate a new zz variable
    subst(G, Fin, VS, Fout).
othervars2(G, Lin, Lin, Fin, Fin) :-
    tpvar(G),
    !.
othervars2(G, Lin, Lout, Fin, Fout) :-
    G =.. [_|A],
    ov_args(A, Lin, Lout, Fin, Fout).

ov_args([H|T], Lin, Lout, Fin, Fout) :-
    othervars2(H, Lin, L1, Fin, F1),
    ov_args(T, L1, Lout, F1, Fout).
ov_args([], Lin, Lin, Fin, Fin).

%%%%%%%%%%%%%%%
%
%    add_exists(N, Fin, Fout, Ain, Vout) - Add existential quantifiers
%    in the appropriate places and also return a list of existentially
%    quantified variables that should be substituted for the
%    Skolem expressions.
%
%%%%%%%%%%%%%%%

add_exists(N, X, exists(V, X1), [S|TS], [V|TV]) :-
    S =.. SL,
    length(SL, M),
    N is M - 1,
    !,
    gensym(ww, V),           % generate a new ww variable
    add_exists(N, X, X1, TS, TV).
add_exists(N, all(X, Y), all(X, Y1), SL, VL) :-
    !,
    M is N + 1,
    add_exists(M, Y, Y1, SL, VL).
add_exists(_, X, X, [], []) :-
    !.
add_exists(N, X, _, SL, _) :-
    write('addexists: N= '), write(N),
    write(' X='), write(X),
    write(' SL='), write(SL), nl.

%%%%%%%%%%%%%%%
%
%    part_skolem(Fin, Lout) - Find a maximal partition such that no two
%    elements share any skolem symbols.
%
%%%%%%%%%%%%%%%

part_skolem(Fin, Lout) :-
    cltolist(Fin, L1),
    smash(L1, Lout).

cltolist(A and B, Lout) :-
    !,
    cltolist(A, L1),
    cltolist(B, L2),
    append(L1, L2, Lout).
cltolist(X, [X]).

smash([H|T], Lout) :-
    putin(H, T, L1),
    !,
    smash(L1, Lout).
smash([H|T1], [H|T2]) :-
    smash(T1, T2).
smash([], []).

putin(F, [H|T], [F and H|T]) :-
    sharesk(F, H),
    !.
putin(F, [H|T1], [H|T2]) :-
    putin(F, T1, T2).

sharesk(A, B) :-
    sksym(A, [], L1),
    sksym(B, [], L2),
    intersect(L1, L2, [_|_]). %   just make sure intersection not empty 

sksym(Fin, Lin, Lout) :-
    tpskolem(Fin),
    !,
    Fin =.. [H|T],
    insert(H, Lin, L1),
    sksym_args(T, L1, Lout).
sksym(Fin, Lin, Lout) :-
    Fin =.. [_|T],
    sksym_args(T, Lin, Lout).

sksym_args([H|T], Lin, Lout) :-
    sksym(H, Lin, L1),
    sksym_args(T, L1, Lout).
sksym_args([], Lin, Lin).

%%%%%%%%%%%%%%%
%
%    check_args(L) - With a list of expressions, check that for each
%    one, all the arguments are different.
%
%%%%%%%%%%%%%%%

check_args([H|T]) :-
    H =..[_|Y],
    alldiff(Y),
    check_args(T).
check_args([]).

alldiff([H|T]) :-
    \+ member(H, T),
    alldiff(T).
alldiff([]).

%%%%%%%%%%%%%%%
%
%    compact(Lin, Lout) - Remove duplicates from a sorted list.
%
%%%%%%%%%%%%%%%

compact([X|[X|Y]], Z) :-
    !,
    compact([X|Y], Z).
compact([X|Y], [X|Y1]) :-
    compact(Y, Y1).
compact([], []).

%%%%%%%%%%%%%%%
%
%    merge1(L1, L2, Lout) - Merge 2 sorted lists (Prolog term order),
%    eliminating duplicates.
%
%%%%%%%%%%%%%%%

merge1([H|T], Lin, Lout) :-
    merge1(T, Lin, L1),
    insert(H, L1, Lout).
merge1([], Lin, Lin).

%%%%%%%%%%%%%%%
%
%   add_all(Fin, Fout) - attach universal quantifiers to the front
%   of a formula.  Universally quantified variables are identified
%   by tpvar(X).
%
%%%%%%%%%%%%%%%

add_all(Fin, Fout) :-
    whatvars(Fin, [], VL), 
    put_all(Fin, VL, Fout), 
    !.

%%%%%%%%%%%%%%%
%
%    whatvars(F, Lin, Lout) - Get the set of variables in a clause.
%    Example:
%      whatvars(p(x) or q(x, y), [], [x, y]).
%
%%%%%%%%%%%%%%%

whatvars(F, Lin, Lout) :-
    tpvar(F), 
    !, 
    insert(F, Lin, Lout).
whatvars(F, Lin, Lin) :-
    atomic(F), 
    !.
whatvars(F, Lin, Lout) :-
    F =.. FL, 
    wv_args(FL, Lin, Lout).

wv_args([H|T], Lin, Lout) :-
    whatvars(H, Lin, L1), 
    wv_args(T, L1, Lout).
wv_args([], Lin, Lin).

put_all(Fin, [H|T], all(H, Fout)) :-
    put_all(Fin, T, Fout).
put_all(Fin, [], Fin).

%%%%%%%%%%%%%%%
%
%    Code for the following procedures has been omitted.
%
%    append - append two lists
%    append_or - append two disjunctions
%    assand - left associate a conjunction
%    clean_currentnum - reset gensym counter
%    cleanup - trivial simplification of logical formula
%    gensym - generate a new symbol
%    insert - insert element into an ordered list (standard prolog order)
%    intersect - intersect teo lists
%    isort - insertion sort (standard prolog order)
%    length - length of list
%    oron - disjoin two formulas
%    permute - permute a list
%    simsub - simultaneous substitution
%    simsub2 - simultaneous substitution (replaced terms need not be atomic)
%    sublist - first list is a subset of the second list
%    subst - substitute terms
%    tpskolem - determine if a term is a Skolem expression
%    tpvar - determine if a term is a Skolem variable
%    unify - unify two terms
%    unique_vars - make sure that quantified variables are unique
%
%%%%%%%%%%%%%%%
