% DCA back end.

:- dynamic( fact/2 ).
:- dynamic( pred/2 ).

% init
% ----

dca_init :- 
   global_abolish( fact/1 ),
   global_abolish( pred/1 ).

% interface for setting the fact/pred data.
% F is a list of predicates, each predicate
% is a name followed by the key data.
% e.g. [ [married, false, true], [male, false] ].
% -----------------------------------------

dca_assert_pred( F, A, K ) :-
    global_assert( pred( F/A, K ) ).

% interface to assert/retract a fact
% ----------------------------------

copy_assert_to_connected( PT ) :-
    cs_method( 'DCAServer.DCAServer', 'BroadcastAssert'( PT ), _ ).
    
copy_retract_to_connected( PT ) :-
    cs_method( 'DCAServer.DCAServer', 'BroadcastRetract'( PT ), _ ).

get_term_jjc( T, TO ) :-
    cs_method( 'DCAServer.DCAServer', 'GetStringReader'( T ), SR ),
    read( SR, TO ).

dca_assert_no_copy( T ) :-
    get_term_jjc( T, PT ),  
    functor( PT, F, A ), !,
    \+( global_call( fact( F/A, PT ) ) ),
    global_assert( fact( F/A, PT ) ).
    
dca_assert_no_copy( T ) :-
    get_term_jjc( T, PT ),
    \+( global_call( fact( PT/0, PT ) ) ),
    global_assert( fact( PT/0, PT ) ).

dca_assert_with_conflict_detect( F/A, PT, T ) :-
    global_assert( fact( F/A, PT ) ),
    backtrackable_lock( F/A ),
    findall( FF, global_call( fact( F/A, FF ) ), L ),
    ( \+( any_conflicts( L ) ) ->
      global_retract( fact( F/A, PT ) )
     ;
      copy_assert_to_connected( T )
    ).

dca_assert( T ) :-
    get_term_jjc( T, PT ),  
    functor( PT, F, A ), !,
    dca_assert_with_conflict_detect( F/A, PT, T ).

dca_assert( T ) :-
    get_term_jjc( T, PT ),
    dca_assert_with_conflict_detect( PT/0, PT, T ). % fixed bug 11/2/2003

dca_assert_on_server( T ) :-
    get_term_jjc( T, PT ),  
    functor( PT, F, A ), !,
    global_assert( fact( F/A, PT ) ).

dca_assert_on_server( T ) :-
    get_term_jjc( T, PT ),
    global_assert( fact( PT/0, PT ) ).

dca_retract( T ) :-
    get_term_jjc( T, PT ),
	functor( PT, F, A ), !,
    global_retract( fact( F/A, PT ) ),
    copy_retract_to_connected( T ).

dca_retract( T ) :-
    get_term_jjc( T, PT ),
    global_retract( fact( PT/0, PT ) ),
    copy_retract_to_connected( T ).

dca_retract_on_server( T ) :-
    get_term_jjc( T, PT ),
	functor( PT, F, A ), !,
    global_retract( fact( F/A, PT ) ).
    
dca_retract_on_server( T ) :-
    get_term_jjc( T, PT ),
    global_retract( fact( PT/0, PT ) ).
    
dca_special_retract( PT ) :-
    functor( PT, F, A ), !, 
    global_retract( fact( F/A, PT ) ).
    
dca_special_retract( PT ) :-
    global_retract( fact( PT/0, PT ) ).

%====================================================================
% The new scheme: (> 2 conflicts)
%====================================================================  

resolve_all( Reader, Writer ) :-
   findall( P, global_call( pred( P, _ ) ), L ),
   resolve_all_in_list( Reader, Writer, L, WaitVar ),
   wait_for( WaitVar ).
resolve_all( _, _ ).

resolve_all_in_list( R, W, [], WaitVar ) :- !.
resolve_all_in_list( R, W, [H|T], WaitVar ) :-
    resolve_predicate( H, R, W, WaitVar ),
    resolve_all_in_list( R, W, T, WaitVar ).

resolve_predicate( P, R, W, WaitVar ) :-
    backtrackable_lock( P ),
    findall( F, global_call( fact( P, F ) ), L ),
    \+( any_conflicts( L ) ),
    fork( resolve( L, R, W, WaitVar ) ),
    wait_for( WaitVar ).
resolve_predicate( _, _, _, _ ). % bug (I think) fixed 11/2/2003
    
check_for_conflict( [], [], [], _ ) :- !.
check_for_conflict( [H1|T1], [H2|T2], [Key|Tk], K ) :-
    Key = K,
    H1 = H2,
    check_for_conflict( T1, T2, Tk, K ).
check_for_conflict( [H1|T1], [H2|T2], [Key|Tk], K ) :-
    \+( Key = K ),
    check_for_conflict( T1, T2, Tk, K ).
   
there_are_some_keys( [] ) :- fail.
there_are_some_keys( [key|T] ) :- !.
there_are_some_keys( [nonkey|T] ) :- there_are_some_keys( T ).
   
conflict( P, X, Y ) :-
    X =.. [F1|A1], 
    Y =.. [F2|A2],
    global_call( pred( P, Keys ) ),
    there_are_some_keys( Keys ),
    check_for_conflict( A1, A2, Keys, key ),
    \+( check_for_conflict( A1, A2, Keys, nonkey ) ).

filter_conflicts( H, [], [] ) :- !.
filter_conflicts( H, [HH|T], [HH|T2] ) :-
    functor( H, F, A ),
    conflict( F/A, H, HH ), !, filter_conflicts( H, T, T2 ).
filter_conflicts( H, [HH|T], T2 ) :-
    filter_conflicts( H, T, T2 ).

any_conflicts( [] ) :- !.
any_conflicts( [H|T] ) :-
	write( H ), nl,
    filter_conflicts( H, T, C ), % one item, list to filter, resultant list.
    write( C ), nl,
    setdiff( T, C, D ),
    ( C = [] ->
      true
    ;
      !, fail % fail on finding first conflict.
    ),
    any_conflicts( D ).

resolve( [], R, W, WaitVar ) :- !.
resolve( [H|T], R, W, WaitVar ) :- 
	write( H ), nl,
    filter_conflicts( H, T, C ),
    write( C ), nl,
    setdiff( T, C, D ),
    ( C = [] ->
      true
    ; 
      resolve_conflict( [H|C], R, W, WaitVar )
    ),
    resolve( D, R, W, WaitVar ).

resolve_conflict( L, R, W, WaitVar ) :-
	list_to_object( L, LO ),
    cs_method( 'DCAServer.DCAServer', 'ResolveConflict'( LO, R, W ), N ),
    int_term_to_int( N, N2 ),
    retract_all_except_one( L, N2 ).
    
retract_all_except_one( L, N ) :-
    retract_all_except_one( L, 0, N ).
    
retract_all_except_one( [], _, _ ) :- !.
retract_all_except_one( [H|T], N, N ) :- !,    
    N1 is N + 1,
    retract_all_except_one( T, N1, N ).
retract_all_except_one( [H|T], M, N ) :-
    M1 is M + 1,
    dca_special_retract( H ),
    retract_all_except_one( T, M1, N ).

% setdiff( A, B, C ):  C = A \ B.  B is a correctly ordered subset of A.
% ----------------------------------------------------------------------

setdiff( L, [], L ) :- !.
setdiff( [H|T1], [H|T2], T3 ) :-
    setdiff( T1, T2, T3 ),
    !.
setdiff( [H1|T1], [H2|T2], [H1|T3] ) :-
    \+( H1 = H2 ),
    setdiff( T1, [H2|T2], T3 ).

% get all facts
% -------------

get_all_facts( L ) :-
    findall( F, global_call( fact( _, F ) ), L ).
    
% broadcast facts to all
% ----------------------

reset_all_agents :-
    cs_method( 'DCAServer.DCAServer', 'BroadcastAllRetract', _ ),
    get_all_facts( L ),
    list_to_object( L, LO ),
    cs_method( 'DCAServer.DCAServer', 'ResetAllPorts'( LO ), _ ).

reset_all_agents_OLD :- 
    cs_method( 'DCAServer.DCAServer', 'BroadcastAllRetract', _ ),
    get_all_facts( L ),
    broadcast_all_facts( L ).
    
broadcast_all_facts( [] ) :- !.
broadcast_all_facts( [H|T] ) :-
	write( 'broadcast: ' ), write( H ), nl,
    cs_method( 'DCAServer.DCAServer', 'BroadcastAssertTerm'( H ), _ ),
    broadcast_all_facts( T ).
    
% list difference
% ---------------

member( [H|T], H ) :- !.
member( [H|T], H2 ) :- member( T, H2 ).

diff( [], L2, [] ) :- !.
diff( [H|T], L2, [H|LO] ) :- \+( member( L2, H ) ), !, diff( T, L2, LO ).
diff( [H|T], L2, LO ) :- diff( T, L2, LO ).