1:- use_module(library('linda/client'),
    2    [	linda_client/1,
    3	close_client/0,
    4	in/1,
    5	%in/2, Excluded because it clashes with clpfd
    6	in_noblock/1,
    7	out/1,
    8	rd/1,
    9	rd/2,
   10	rd_noblock/1,
   11        bagof_rd_noblock/3,
   12	linda_timeout/2,
   13	shutdown_server/0]).   14:- use_module(library(system)).   15:- multifile hap/2.   16:- dynamic hap/2.   17
   18:- dynamic timestamp/1.   19timestamp(0).
   20
   21history_dyn(T,Tnew,Closed,Blocking):-
   22    hap(Event,Time),
   23    Time > T, !,
   24    write_debug('Cached event: '), writeln_debug(h(Event,Time)),
   25    h(Event,Time),
   26    history_dyn(Time,Tnew,Closed,Blocking).
   27history_dyn(T,T,Closed,Blocking):-
   28    %get_new_events(Blocking,Closed).
   29    get_single_event(Blocking,Closed,_,Event),
   30    (Event = h(_,Time)
   31      ->    history_dyn_directional(Time,_Tnew,Closed,Blocking)
   32      ;     % either history is closed -> close_history has already been 
   33            % executed (nothing to do)
   34            % or there is no new event: succeed
   35            true
   36    ).
   37
   38% get_new_events(+Blocking,-Closed)
   39get_new_events(Blocking,Closed):-
   40    get_new_events(Blocking,Closed,_).
   41get_new_events(Blocking,Closed,Pattern):-
   42    copy_term(Pattern,E),
   43    in_noblock(h(E,T)),!,
   44    assertz(hap(E,T)),
   45    write_debug('Received event: '), writeln_debug(h(E,T)),
   46    h(E,T),
   47    
   48/*    Lui mi ha detto 3 eventi H1, H2 e H3
   49    Il primo e` in un H1 -> E6 \/ E7; scelgo E6.
   50    Il secondo mi fa fallire (H2 -> EN...)
   51    allora faccio backtracking e prendo E7. 
   52    A questo punto, la get_new_events successiva va a leggere da Linda
   53    e non dalla cache;
   54    l'evento 2 non c'e` piu` e non lo inserisco.
   55    Quindi, in pratica, l'evento che
   56    mi ha fatto fallire io l'ho ignorato.
   57    Questo e` proprio quello che succede allo scientist quando il dept
   58    gli dice EN(pay(400))
   59    Quindi la get_new_events non dovrebbe richiamarsi ricorsivamente, ma andare
   60    a vedere prima se c'e` qualche evento in cache che non ho considerato
   61*/  
   62    get_new_events(Blocking,Closed,Pattern).
   63get_new_events(_,Closed,_):-
   64    rd_noblock(close_history),!, Closed=closed,
   65    close_history.
   66get_new_events(blocking,Closed,Pattern):-
   67    rd([close_history,h(_,_)],_),
   68    get_new_events(blocking,Closed,Pattern).
   69get_new_events(nonblocking,_Closed,_).
   70
   71% Acquires just one event.
   72get_single_event(_Blocking,_Closed,Pattern,h(E,T)):-
   73    copy_term(Pattern,E),
   74    in_noblock(h(E,T)),!,
   75    assertz(hap(E,T)),
   76    write_debug('Received event: '), writeln_debug(h(E,T)),
   77    h(E,T).
   78get_single_event(_,Closed,_,Event):-
   79    rd_noblock(close_history),!, Closed=closed, Event=closed,
   80    close_history.
   81get_single_event(nonblocking,_,_,none).
   82
   83out_event(Event,Time):-
   84    (var(Time)
   85      ->    compute_time(NewTime), Time=NewTime
   86            % Facendo direttamente compute_time(Time) in certi casi da` errore, quando Time e` una variabile constrained
   87            %now(Time)  % Get System time
   88      ;     true),
   89    out(h(Event,Time)),
   90    write_debug('Output event: '),
   91    writeln_debug(h(Event,Time)).
   92
   93out_event_once(Event,_):- hap(Event1,_), variant(Event,Event1), !.
   94out_event_once(Event,Time):-
   95    (var(Time)
   96      ->    compute_time(NewTime), Time=NewTime
   97      ;     true),
   98    out(h(Event,Time)),
   99    write_debug('Output event: '),
  100    writeln_debug(h(Event,Time)).
  101
  102%run_dyn(+Blocking).
  103% Blocking can be either 'blocking' or 'nonblocking'
  104run_dyn(Blocking):-
  105    load_ics,
  106    current_time(0),
  107    society_goal,
  108    history_dyn(-inf,TLast,Closed,nonblocking),
  109    % here you can invoke, if needed, other predicates that continue
  110    % the elaboration, like ground_time, make_choice, etc.
  111    (nonvar(Closed)    % last check
  112      ->    true;
  113        history_dyn(TLast,_,_,Blocking)
  114    ).
  115
  116run_dyn_argument(Blocking):-
  117    load_ics,
  118    current_time(0),
  119    society_goal,
  120    history_dyn(-inf,_TLast,_Closed,Blocking), % qua c'era un commento ...
  121    once(abd(finished_reasoning,1)),
  122    no_more_messages.
  123
  124no_more_messages:-
  125    rd(_), fail.
  126no_more_messages:-
  127    rd_noblock(leave_dialogue).
  128
  129%%%%%%%%%%%%%%%%%%%%%%%%%% PROCESS COMMUNICATION %%%%%%%%%%%%%%%%%%%%%%%%%%%
  130% So far, there is no concept of sending a message: everyone can pick a
  131% message from the board, ad the others will not see it.
  132% Let's insert some directionality. Events are of the form
  133%   h(tell(Sender,Receiver,Content),Time)
  134% Only the correct receiver can remove the message from the blackboard.
  135
  136run_dyn_argument_directional(Blocking):-
  137    load_ics,
  138    init_linda_time(IniTime),
  139    current_time(IniTime),
  140    society_goal,
  141    history_dyn_directional(-inf,_TLast,_Closed,Blocking), % qua c'era un commento ...
  142    once(abd(finished_reasoning,1)),
  143    % In realta` e` un po' semplicistico: qualunque cosa l'altro mi dica io
  144    % fallisco e faccio backtracking su society_goal!
  145    % Forse dovrei inserire un punto di scelta in history_dyn_directional:
  146    % li` io ipotizzavo che non arrivassero nuovi eventi, per cui se ne arrivano
  147    % devo fare backtracking.
  148    no_more_incoming_messages.
  149
  150run_dyn_argument_directional_closed(Blocking):-
  151    load_ics,
  152    init_linda_time(IniTime),
  153    current_time(IniTime),
  154    society_goal,
  155    history_dyn_directional(-inf,_TLast,_Closed,Blocking), % qua c'era un commento ...
  156    close_history,
  157    once(abd(finished_reasoning,1)),
  158    % In realta` e` un po' semplicistico: qualunque cosa l'altro mi dica io
  159    % fallisco e faccio backtracking su society_goal!
  160    % Forse dovrei inserire un punto di scelta in history_dyn_directional:
  161    % li` io ipotizzavo che non arrivassero nuovi eventi, per cui se ne arrivano
  162    % devo fare backtracking.
  163    no_more_incoming_messages.
  164
  165
  166send_message(Sender,Receiver,Content,Time):-
  167    % Send the message
  168    out_event_once(tell(Sender,Receiver,Content),Time), % QUI NON SI POTREBBE METTERE UNA OUT_EVENT_ONCE??????
  169    % Save the event in the local cache
  170    % La out_event_once da Time=var se l'evento c'era gia`. In tal caso,
  171    % non lo si salva in cache
  172    (var(Time)
  173        -> true
  174        ;  assertz(hap(tell(Sender,Receiver,Content),Time))).
  175
  176%Se inserendo un evento con get_new_events c'e` un fallimento, lui non re-inserisce
  177%in backtracking l'evento.
  178
  179
  180% Assumes that in the SOKB there exists a predicate me/1, that tells the unique
  181% name of the agent
  182history_dyn_directional(T,Tnew,Closed,Blocking):-
  183    hap(Event,Time),
  184    Time > T, !,
  185    write_debug('Cached event: '), writeln_debug(h(Event,Time)),
  186    h(Event,Time),
  187    history_dyn_directional(Time,Tnew,Closed,Blocking).
  188history_dyn_directional(_T,Tnew,Closed,Blocking):-
  189    me(ME),
  190    get_single_event(Blocking,Closed,tell(_,ME,_),Event),
  191    (Event = h(_,Time)
  192      ->    history_dyn_directional(Time,Tnew,Closed,Blocking)
  193      ;     % either history is closed -> close_history has already been 
  194            % executed (nothing to do)
  195            % or there is no new event: succeed
  196            true
  197    ).
  198    
  199% backtracking: New events have arrived: let us process them!
  200%history_dyn_directional(T,Tnew,Closed,Blocking):-  Questo non considera quello che ho detto io, per cui ripeto sempre le stesse cose!
  201%    me(ME),
  202%    rd(h(tell(_,ME,_),_)), !, 
  203%    get_new_events(Blocking,Closed,tell(_,ME,_)).
  204history_dyn_directional(T,_Tnew,_Closed,_Blocking):-
  205    % No new cached events (i.e., events generated by me)
  206    \+(( hap(_,Time),
  207        Time > T
  208    )),
  209    % No new messages to me
  210    \+(( me(ME),
  211        rd_noblock(h(tell(_,ME,_),_))
  212    )),!,
  213    % Then, it is a failure due to the proof: fail.
  214    fail.
  215% Otherwise, there must be some news: let us process them
  216history_dyn_directional(T,Tnew,Closed,Blocking):-
  217    history_dyn_directional(T,Tnew,Closed,Blocking).
  218%history_dyn_directional(T,Tnew,Closed,Blocking):-
  219%    me(ME),
  220%    rd(h(tell(_,ME,_),_)), !, 
  221%    get_new_events(Blocking,Closed,tell(_,ME,_)).
  222
  223
  224% backtracking, no new events. The reason of failure must be something else,
  225% thus we simply backtrack further.
  226% history_dyn_directional(T,Tnew,Closed,Blocking):- fail.
  227
  228%no_more_incoming_messages:-
  229%    rd_noblock(leave_dialogue).
  230no_more_incoming_messages:-
  231    me(ME),
  232    rd([leave_dialogue,h(tell(_,ME,_),_)],X),
  233    (X = leave_dialogue
  234    -> true
  235    ;  fail
  236    ).
  237
  238
  239%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%   TIME
  240% The first agent sets the time to 0, the others accept the current time
  241init_linda_time(N):-
  242    rd_noblock(linda_time(N)),!.
  243init_linda_time(0):-
  244    out(linda_time(0)).
  245
  246compute_time(Time):-
  247    in(linda_time(Time)),
  248    NewTime is Time+1,
  249    out(linda_time(NewTime)).
  250
  251%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  252% Per velocizzarmi nel far partire i vari processi ...
  253
  254connect:-
  255    ['../linda_server/hostname.pl'],
  256    hostname(HN),
  257    linda_client(HN).
  258%:-compile(sciff).