:- dynamic new_demodulator/1.
:- dynamic currentnum/2.

gen(Given_limit) :-
    set_of_support(_, _),  % make sure sos not empty
    abolish(given_count,1),
    assert(given_count(0)),
    repeat,
    retract(given_count(N)),
    M is N + 1,
    assert(given_count(M)),
    pick_lightest_sos(C),
    retract(set_of_support(_, C)),
    generate_from_given(C, E),
  ( E == false; M == Given_limit ; \+ set_of_support(_, _) ),
    !.

generate_from_given(D, E) :-
    back_demod(D, C),
    assertz(have_been_given(C)),
  ( flag(verbose) -> write('new given clause: '), write(C), nl ; true),
    gen_given(C, E),  % multiple solutions
  ( flag(verbose) -> write('resolvent: '), write(E), nl ; true),
    process_gen(E),
    E == false,
    !.
generate_from_given(_, _).

back_demod(C, D) :-
    new_demod(C, D),
  ( flag(verbose) -> write('new demodulator: '), write(D), nl ; true),
    assertz(demodulator(D)),
    back_demodulate(D),
    delete_demod(D),  % if keep, then go on and use as given clause
    !,
    fail.
back_demod(C, C).

delete_demod(A = B) :-
    atomic(A),
    retract(demodulator(A = B)),
    !.

process_gen(C) :-
  (  bagof(X, demodulator(X), L), demodulate(L, C, D) ; C = D ),
    simplify(D, E),
    proc_gen(E),
    !.

gen_given(C, R) :-
   axiom(D),
   rescl(C, D, R).
gen_given(C, R) :-
   have_been_given(D),
   C \== D,
   rescl(C, D, R).

proc_gen(C) :-
  ( flag(verbose) -> write('processing: '), write(C), nl ; true),
    f_subsume(C),
  ( flag(verbose) -> write('forward subsumed: '), write(C), nl ; true),
    !.
proc_gen(C) :-
    b_subsume(C),
    symct(C, N),
    assert(set_of_support(N, C)),
    !.

new_demod(A = B, A = B) :-
    tpskolem(A),
    !.
new_demod(B = A, A = B) :-
    tpskolem(A), % flip so skolem is at left
    !.

back_demodulate(C) :-
    axiom(D),
    demodulate([C], D, E),
    \+ (D == E),
  ( flag(verbose) -> write('back demodulating: '), write(D), write(' --> '), write(E), nl ; true),
    retract(axiom(D)),
    process_gen(D),
    fail.
back_demodulate(C) :-
    have_been_given(D),
    demodulate([C], D, E),
    \+ (D == E),
  ( flag(verbose) -> write('back demodulating: '), write(D), write(' --> '), write(E), nl ; true),
    retract(have_been_given(D)),
    process_gen(D),
    fail.
back_demodulate(C) :-
    set_of_support(_, D),
    demodulate([C], D, E),
    \+ (D == E),
  ( flag(verbose) -> write('back demodulating: '), write(D), write(' --> '), write(E), nl ; true),
    retract(set_of_support(_, D)),
    process_gen(D),
    fail.
back_demodulate(C) :-
    demodulator(D),
    \+ (C == D),  % prevent a clause from demodulating itself
    demodulate([C], D, E),
    \+ (D == E),
  ( flag(verbose) -> write('back demodulating: '), write(D), write(' --> '), write(E), nl ; true),
    retract(demodulator(D)),
    process_gen(D),
    fail.
back_demodulate(_).


f_subsume(C) :-
    axiom(D),
    subsume(D, C, [[],[]], _),
    !.
f_subsume(C) :-
    have_been_given(D),
    subsume(D, C, [[],[]], _),
    !.
f_subsume(C) :-
    set_of_support(_, D),
    subsume(D, C, [[],[]], _),
    !.
f_subsume(C) :-
    demodulator(D),
    subsume(D, C, [[],[]], _),
    !.

b_subsume(C) :-
    axiom(D),
    subsume(C, D, [[],[]], _),
  ( flag(verbose) -> write('back subsumed: '), write(D), nl ; true),
    retract(axiom(D)),
    fail.
b_subsume(C) :-
    have_been_given(D),
    subsume(C, D, [[],[]], _),
  ( flag(verbose) -> write('back subsumed: '), write(D), nl ; true),
    retract(have_been_given(D)),
    fail.
b_subsume(C) :-
    set_of_support(_, D),
    subsume(C, D, [[],[]], _),
  ( flag(verbose) -> write('back subsumed: '), write(D), nl ; true),
    retract(set_of_support(_, D)),
    fail.
b_subsume(C) :-
    demodulator(D),
    subsume(C, D, [[],[]], _),
  ( flag(verbose) -> write('back subsumed: '), write(D), nl ; true),
    retract(demodulator(D)),
    fail.
b_subsume(_).

pick_lightest_sos(C) :-
    bagof(X, set_of_support(X, _), L),
    min_list(L, N),
    set_of_support(N, C),
    !.

min_list([A], A).
min_list([_|T], M) :-
    min_list(T, N),
    min(T, N, M).

min(A, B, A) :-
    A =< B,
    !.
min(_, B, B).

clauses :-
    nl, write('axioms:'), nl,
    axiom(C), write(C), nl,
    fail.
clauses :-
    nl, write('have_been_given:'), nl,
    have_been_given(C), write(C), nl,
    fail.
clauses :-
    nl, write('set_of_support:'), nl,
    set_of_support(_, C), write(C), nl,
    fail.
clauses :-
    nl, write('demodulators:'), nl,
    demodulator(C), write(C), nl,
    fail.
clauses.

cl2 :-
    nl, write('stage 2 axioms:'), nl,
    stage2_axiom(C), write(C), nl,
    fail.
cl2 :-
    nl, write('stage 2 have_been_given:'), nl,
    stage2_have_been_given(C), write(C), nl,
    fail.
cl2 :-
    nl, write('stage 2 set_of_support:'), nl,
    stage2_set_of_support(C), write(C), nl,
    fail.
cl2 :-
    nl, write('stage 2 demodulators:'), nl,
    stage2_demodulator(C), write(C), nl,
    fail.
cl2.

cl1 :-
    nl, write('initial axioms:'), nl,
    initial_axiom(C), write(C), nl,
    fail.
cl1 :-
    nl, write('initial set_of_support:'), nl,
    initial_set_of_support(C), write(C), nl,
    fail.
cl1.

rescl(C1, C2, Rout) :-
    newvars(C2, C2n),
    res2cl(C1, C1, C2n, Rout).

res2cl(A or _, C1, C2, Rout) :-
    res2cl(A, C1, C2, Rout),
    !.
res2cl(_ or B, C1, C2, Rout) :-
    !,
    \+ flag(first_lit),
    res2cl(B, C1, C2, Rout).
res2cl(L1, C1, C2, Rout) :-
    res1cl(L1, C1, C2, C2, Rout).

res1cl(L1, C1, A or _, C2, Rout) :-
    res1cl(L1, C1, A, C2, Rout).
res1cl(L1, C1, _ or B, C2, Rout) :-
    !,
    res1cl(L1, C1, B, C2, Rout).
res1cl(L1, C1, L2, C2, Rout) :-
    resolvents(L1, C1, L2, C2, Rout).

resolvents(L1, C1, ~(L2), C2, Rout) :-
    increment(res_unify_attempts),
    unify(L1, L2, [[], []], Sub),
    !,
    increment(binary_resolutions),
    genres(L1, ~(L2), C1 or C2, Sub, false, R),
    normalize(R, Rout),
    !.
resolvents(~(L1), C1, L2, C2, Rout) :-
    increment(res_unify_attempts),
    unify(L1, L2, [[], []], Sub),
    !,
    increment(binary_resolutions),
    genres(~(L1), L2, C1 or C2, Sub, false, R),
    normalize(R, Rout),
    !.

genres(L1, L2, A or B, Sub, Lin, Lout) :-
    !,
    genres(L1, L2, A, Sub, Lin, LT),
    genres(L1, L2, B, Sub, LT, Lout).
genres(_, L2, L2, _, Lin, Lin) :-
    !.
genres(L1, _, L1, _, Lin, Lin) :-
    !.
genres(_, _, L3, [V, T], Lin, Lout) :-
    !,
    simsub(V, L3, T, L4),
    oron(Lin, L4, Lout).


/*
    go(Constraint_number, Update_operation, Relation_being_updated)

    Main top-level procedure to do everything.
    Example: go(1,insert,sale).
*/

go(N,Op,Rel) :-

    stage1(N,Op,Rel,TIME1),
    write('Time, stage 1 '), write(TIME1), bell,nl,

    stage2(TIME2),
    write('Time, stage 2 '), write(TIME2), bell,nl,

    stage3(TIME3),
    write('Time, stage 3 '), write(TIME3), bell,nl,

    stage4(TIME4),
    write('Time, stage 4 '), write(TIME4), bell,nl,

    log(N,Op,Rel,TIME1,TIME2,TIME3,TIME4),

    !.

/*
    go2(Constraint_number, Update_operation, Relation_being_updated)

    Another top-level procedure.  Stages 2 and 3 are skipped.
    (No resolution is done -- it goes straight to the iff test.)
    Example: go2(1,insert,sale).
*/

go2(N,Op,Rel) :-

    stage1(N,Op,Rel,TIME1),
    write('Time, stage 1 '), write(TIME1), bell,nl,

    abolish(axioms,1),
    abolish(sos,1),
    abolish(hbg,1),
    abolish(demod,1),

    init_axioms(Iax),
    init_sos(Isos),
    init_hbg(Ihbg),
    init_demod(Idemod),

    assert(axioms(Iax)),
    assert(sos(Isos)),
    assert(hbg(Ihbg)),
    assert(demod(Idemod)),
    
    append_and(Iax,Isos,RED),

    abolish(reduced,1),
    abolish(dependent,1),

    assert(reduced(RED)),
    assert(dependent(true)),

    stage4(TIME4),
    write('Time, stage 4 '), write(TIME4), bell,nl,

    log(N,Op,Rel,TIME1,0,0,TIME4),

    !.

/*
    stage1(N,Op,Rel,Time) - Convert C[RNEW] and ~C[TAX] to clauses, 
    pick an initial sos, then assert the clauses.
*/

stage1(X,Op,Rel,TIME2) :-

    get_seconds(TIME1),

    abolish(count,2),
    abolish(curr_constraint,1),
    abolish(curr_update,1),

    currentnum(log, N),
    abolish(currentnum,2),
    assert(currentnum(log, N)),

    constraint(X,Constraint),
    update(Op,Rel,Relold,Tax),

    assert(curr_constraint(Constraint)),
    assert(curr_update(Tax)),

    subst(Rel,Constraint,Relold,Cold),

    nnf(Cold,Cold1),
    unique_vars(Cold1,Coldnnf),
    abolish(coldnnf,1),
    assert(coldnnf(Coldnnf)),

    clausify(Coldnnf,V11),

    Tax =.. [iff,Left,Right],
    Left =.. [Relnew|Varlist],
    subst(Rel,Constraint,Relnew,Cnew),
    taxsub(Cnew,Relnew,Varlist,Right,Ctax),

    clausify(~Ctax,V14),

  ( flag(verbose) ->
	write('C[OLD] in clauses:'),nl,
	pcllist(V11),nl,
	write('~C[TAX] in clauses:'),nl,
	pcllist(V14),nl ; true),

    picksos(V11,V14,AX,SOS),
    
    abolish(initial_axiom,1),
    abolish(initial_set_of_support,1),

    assert_axioms(AX),
    assert_sos(SOS),
    
    get_seconds(TIME3),

    TIME2 is TIME3 - TIME1,

    !.

assert_axioms(A and B) :-
    !,
    assert_axioms(A),
    assert_axioms(B).
assert_axioms(A) :-
    assertz(initial_axiom(A)).

assert_sos(A and B) :-
    !,
    assert_sos(A),
    assert_sos(B).
assert_sos(A) :-
    assertz(initial_set_of_support(A)).

/*
    stage2(TIME) - Apply binary resolution (with forward/backward 
    subsumption, forward/back demodulation) until a proof is found 
    or the sos is empty.  (The given, have-been-given, sos algorithm 
    is used.)
*/

stage2(TIME2) :-
    
    get_seconds(TIME1),

    retract_all(axiom(_)),
    retract_all(set_of_support(_, _)),
    retract_all(have_been_given(_)),
    retract_all(demodulator(_)),

    assert_clauses,
    
    gen(100),

    retract_all(stage2_axiom(_)),
    retract_all(stage2_set_of_support(_)),
    retract_all(stage2_have_been_given(_)),
    retract_all(stage2_demodulator(_)),

    assert_stage2,

    get_seconds(TIME3),

    TIME2 is TIME3 - TIME1,

    !.

assert_clauses :-
    initial_axiom(C),
    assert(axiom(C)),
    fail.
assert_clauses :-
    initial_set_of_support(C),
    symct(C, N),
    assert(set_of_support(N, C)),
    fail.
assert_clauses.

assert_stage2 :-
    axiom(C),
    assert(stage2_axiom(C)),
    fail.
assert_stage2 :-
    have_been_given(C),
    assert(stage2_have_been_given(C)),
    fail.
assert_stage2 :-
    demodulator(C),
    assert(stage2_demodulator(C)).
assert_stage2 :-
    set_of_support(_, false),
    assert(stage2_axiom(false)).
assert_stage2.

/*
    stage3(TIME) - Pick out the dependent clauses from the 
    have-been-given list.
*/

stage3(TIME2) :-

    get_seconds(TIME1),

    abolish(reduced,1),
    abolish(dependent,1),
    axioms(AX),
    hbg(HBG),
    eqfirst(HBG,HBG1),
    delred(AX,HBG1,S1,S2),
    cleanup(S1,S15),
    cleanup(S2,S25),
    asserta(reduced(S15)),
    asserta(dependent(S25)),

    get_seconds(TIME3),

    TIME2 is TIME3 - TIME1,

    !.

/*
    stage4(TIME) - Generate the iff test from the reduced set of 
    clauses, and generate the extra tests from the dependent set.
*/

stage4(TIME2) :-

    get_seconds(TIME1),

    abolish(extra_tests,1),
    abolish(iff_test,1),

    dependent(R1),
    extratests(R1,R2),
    assert(extra_tests(R2)),

    reduced(F1),
    coldnnf(C),
    ifftest(F1,C,F2),
    assert(iff_test(F2)),

    get_seconds(TIME3),

    TIME2 is TIME3 - TIME1,

    !.

/*
    log(N,Op,Rel,T1,T2,T3,T4) - Log everything to a file.
*/

log(X,Op,Rel,TIME1,TIME2,TIME3,TIME4) :-
    flag(log),
    gensym(log,F),
    tell(F),
    write(times(X,Op,Rel)), nl,
    write('Stage 1: '), write(TIME1), nl,
    write('Stage 2: '), write(TIME2), nl,
    write('Stage 3: '), write(TIME3), nl,
    write('Stage 4: '), write(TIME4), nl,
    nl,
    curr_constraint(CONST),
    write('Constraint: '), nl,
    write(CONST), nl,
    nl,
    curr_update(UPD),
    write('Update: '), nl,
    write(UPD), nl,
    nl,
    write('***********************************************'),nl,
    initial_clauses,
    write('***********************************************'),nl,
    write('After resolution: '), nl,
    clauses,
    write('***********************************************'),nl,
    cl3,
    write('***********************************************'),nl,
    tests,
    write('***********************************************'),nl,

  ( nl,
    flag(FL),
    write(flag(FL)), nl,
    fail;
    nl,
    count(Y,N),
    write(count(Y,N)), nl,
    fail;
    nl,
    option(YY,NN),
    write(option(YY,NN)), nl,
    fail;
    true),
    
    told,
    !.
log(_,_,_,_,_,_,_) :-
    told,
    !.

/*
    ifftest(Rin,Cold,Rout) - Convert a reduced set of clauses (Rin)
    to an iff test (Rout).  Cold is the constraint -- it is used to
    simplify (subsume parts of) the test.
*/
    
ifftest(Rin,Cold,Rout) :-
    mini7(Cold,C1),
    usl(Rin,R1),
    mini7(R1,R25),
    s2list(C1,R25,R3),
    cleanup(R3,R4),
    nnf(~R4,R5),
    rcnf(R5,R55),
    s2list(C1,R55,R6),
    cleanup(R6,R7),
    rdnf(R7,Rout),
    !.

/*
    extratests(Din,Dout) -  Transform a conjunction of clauses into
    a disjunction of extra tests.  This is done by unSkolemizing
    and simplifying them individually, then negating the whole
    conjunction to get a disjunction of extra tests.
*/

extratests(Din,Dout) :-
    ex1(Din,D1),
    nnf(~D1,D2),
    cleanup(D2,Dout),
    !.

ex1(X and Y,X1 and Y1) :-
    !,
    ex1(X,X1),
    ex1(Y,Y1).
ex1(X,Y) :-
    usl(X,X1),
    !,
    mini7(X1,Y).
ex1(_,true).

retract_all(X) :-
    retract(X),
    fail.
retract_all(_).

%%%%%%%%%%%%%%
%
%   demodulate(Demods, Term_in, Term_out) 
%   
%   Standard demodulation (inside-out, revisiting demodulated subterms).  
%   option(demod_limit, N) tells the maximum number of rewrites that will 
%   be applied to a term.
%      
%       Demods - the demodulators
%       Term_in - an object to be demodulated
%       Term_out - the result
%       
%%%%%%%%%%%%%%

demodulate(Dlist, Fin, Fout) :-
    demodul(Fin, Dlist, Fout).

demodul(X and Y, Dlist, X1 and Y1) :-
    !,
    demodul(X, Dlist, X1),
    demodul(Y, Dlist, Y1).
demodul(Term_in, Demods, Term_out) :-
    option(demod_limit, Limit),
    demod(Term_in, Demods, Term_out, Limit, _).

demod(Term, _, _, _, _) :-
    var(Term),
    !,
    write('demod error: variable in term'), nl,
    fail.
demod(Term_in, Demods, Term_out, Nin, Nout) :-
    Term_in =.. [H|Args_in],
    demod_args(Args_in, Demods, Args_out, Nin, N1),
    Term    =.. [H|Args_out],
    demod_top_level(Term, Demods, Term_out, N1, Nout),
    !.

demod_args([], _, [], N, N).
demod_args([Hin|Rest_in], Demods, [Hout|Rest_out], Nin, Nout) :-
    demod(Hin, Demods, Hout, Nin, N1),
    demod_args(Rest_in, Demods, Rest_out, N1, Nout).

demod_top_level(Term_in, Demods, Term_out, Nin, Nout) :-
    Nin > 0,
    member_2(A=B, Demods),
    halfmatch(A, Term_in, [[], []], [V, T]),
    !,
    simsub(V, B, T, T1),
    M is Nin - 1,
    revisit(T1, Demods, B, Term_out, M, Nout).
demod_top_level(Term, _, Term, N, N).

%%%%%%%%%%%%
%
%   revisit - redemodulate a demodulated term.  Do not redemodulate
%   the subterms that correspond to the variables in Beta, because
%   we know that they are already fully demodulated.
%
%%%%%%%%%%%%

revisit(Term_in, _, Beta, Term_in, N, N) :-
     var(Beta),
     !.
revisit(Term_in, Demods, Beta, Term_out, Nin, Nout) :-
     Term_in =.. [H|T_tail],
     Beta    =.. [H|B_tail],
     !,
     revisit_rest(T_tail, Demods, B_tail, Term_1_tail, Nin, N1),
     Term_1 =.. [H|Term_1_tail],
     demod_top_level(Term_1, Demods, Term_out, N1, Nout).
revisit(Term_in, _, Beta, Term_in, N, N) :-
     write(['revisit: Term_in and Beta dont match ',Term_in,Beta]), nl.

revisit_rest([], _, [], [], N, N).
revisit_rest([TH|TT], Demods, [BH|BT], [TH_out|TT_out], Nin, Nout) :-
     revisit(TH, Demods, BH, TH_out, Nin, N1),
     revisit_rest(TT, Demods, BT, TT_out, N1, Nout).

member_2(A, [A|_]).
member_2(A, [_|T]) :-
    member_2(A, T).
