%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                                                           %
%       file:          chart.pl                                             %
%       purpose:       Earley Deduction for Parsing and Generation          %
%       author:        Sebastian Varges                                     %
%       date:          Sat Feb 15 13:31:04 MET 1997                         %
%       related refs:  [Neumann, 1994]                                      %
%                                                                           %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- dynamic table_item /4.
:- dynamic agenda_item /1.
:- dynamic switch /2.
%--------------------------------
earley_proc(Fs,Search,Control,Trace,Display) :-
        clear_tables,
        set_switch(trace,Trace),
        init_agenda(Fs),        
        earley_proc(Search,Fs,Control), 
        !,                              
        display_solutions(Display,Search,Fs). 
/* 
% explicit completeness and coherence for ground semantics/phonetics
earley_solution([Phon,Syn,Sem]) :-
        ground(Phon),
        table_item(nil,ans([PhonAns,Syn,Sem]),[],_),  
        Phon == PhonAns.

earley_solution([Phon,Syn,Sem]) :-
        ground(Sem),
        table_item(nil,ans([Phon,Syn,SemAns]),[],_),  
        Sem == SemAns.
*/
earley_solution(Fs) :-  table_item(nil,ans(Fs),[],_). % unification

clear_tables :-
        retractall(table_item(_,_,_,_)),
        retractall(agenda_item(_)),
        retractall(switch(_,_)).

init_agenda(Fs) :- assertz(agenda_item((node(Fs),ans(Fs),[],(_,0)))).

% loop for processing of agenda items
earley_proc(_,_,_) :- empty_agenda.
earley_proc(Search,Fs,Control) :-
        get_highest_priority_task(CurrentTask),
        trace(newtask,CurrentTask,_),
        add_item(CurrentTask,Control),
        !,                                % tail recursion optimalization
        continuation(Search,Fs,Control).

continuation(first,_,_) :- 
        table_item(nil,ans(_),[],_). % option: first solution
continuation(Search,Fs,Control) :- earley_proc(Search,Fs,Control). 

empty_agenda :- \+ agenda_item(_).

add_task_to_agenda(df,Task) :-    asserta(agenda_item(Task)). % depth-first
add_task_to_agenda(bf,Task) :-    assertz(agenda_item(Task)). % breath-first

get_highest_priority_task(CurrentTask) :-  retract(agenda_item(CurrentTask)).

add_item(CurrentTask,_) :- 
        blocked(CurrentTask),        
        trace(blocking,CurrentTask,_).

add_item((Selected,Head,Body,N),Control) :-        % for non-blocked items:
        add_item_to_table(Selected,Head,Body,N),   %  add them to table
        apply_task(Selected,Head,Body,N,Control).  %  apply inference rules

blocked((Selected,Head,Body,_)) :-                  
        table_item(Selected1,Head1,Body1,_),       
        subsumes_chk((Selected1,Head1,Body1,_),(Selected,Head,Body,_)).

% add_item_to_table(CurrentTask) :- assertz(table_item(CurrentTask)).
add_item_to_table(Selected,Head,Body,N) :- 
        assertz(table_item(Selected,Head,Body,N)).

% call for inference rules
apply_task(nil,Head,[],N,Control) :- passive_completion(Head,N,Control).      

apply_task(node(S),Head,Body,N,Control) :-            
        %% setof(_,active_completion(node(S),Head,Body,N,Control),_). % [Neumann 1994]
        % to make test sentences 42l and 42m work:
        active_completion(node(S),Head,Body,N,Control),fail.

apply_task(node(S),_,_,_,Control) :-  prediction(node(S),Control).                                  

apply_task(node(S),Head,Body,N,Control) :-    
        scanning(node(S),Head,Body,N,Control).

apply_task(prolog(PrologGoal),Head,Body,N,Control) :- 
        prolog_goal(PrologGoal,Head,Body,N,Control). 

apply_task(_,_,_,_,_).


% inference rules
passive_completion(Selected,(_,Index),Control) :-
        table_item(Selected,Head,Body,(N1,Index1)), 
        priority(Body,Head,N1,[Index,Index1],Control,'passive completion'),
        fail.

active_completion(Selected,Head,Body,(N,Index),Control) :-
        table_item(nil,Selected,[],(_,Index1)), 
        priority(Body,Head,N,[Index,Index1],Control,'active completion').

scanning(node(SelFs),Head,Body,(N,Index),Control) :-
        nonchain_rule(SelFs,N1,lex),
        node(N1,SelFs),                 
        priority(Body,Head,N,[Index,N1],Control,scanning),
        fail.

prediction(node(SelFs),Control) :-
        restriction(SelFs,RestrSelFs),  
        (chain_rule(SelFs,N,_);nonchain_rule(SelFs,N,rule)),  
        (node(N,RestrSelFs) <--- Body), 
        priority(Body,node(RestrSelFs),N,N,Control,prediction),
        fail.

prolog_goal(PrologGoal,Head,Body,N,Control) :-
        call(PrologGoal),                               
        priority(Body,Head,N,N,Control,'prolog goal').  

% restriction of feature structure with instantiated category vp
restriction([Phon,syn:[Cat|_],Sem],[Phon,syn:[Cat|_],Sem]) :- Cat == vp,!. 
restriction(X,X).                                                          

% determine new item and add it to agenda
priority(Body,Head,N,Index,Control,InfRule) :-
        task_priority(Body,Head,N,Selected,RedBody,SelectionType),
        trace(InfRule,(Selected,Head,RedBody,(N,Index)),SelectionType),
        add_task_to_agenda(Control,(Selected,Head,RedBody,(N,Index))),!.

% task_priority(+Body,+Head,+N,-Selected,-RedBody),
task_priority([],_,_,nil,[],'nothing to select').  
task_priority([Selected],_,_,Selected,[],'the only element'). 
task_priority([Left,Right],Head,N,Selected,RedBody,'semantic head') :-
        chain_rule(_,N,Nhd),
        sem_inst(Head,Nhd,[Left,Right],Selected,RedBody).
task_priority([Left|Rest],_,_,Left,Rest,'leftmost by default'). 

sem_inst(node([_,_,sem:Sem]),Nhd,[Left,Right],Selected,RedBody) :-
        \+ \+ (   (Sem = [pred:Pred|_], ground(Pred));
                  (Sem = [cont:Cont|_], ground(Cont))  ),
        semantic_head(Nhd,[Left,Right],Selected,RedBody).

semantic_head(left,[Left,Right],Right,[Left]).
semantic_head(right,[Left,Right],Left,[Right]).