/************************************************************/
/************************************************************/
/* LR Control Table for CF Grammars                         */
/*                                                          */
/* Grammars from grammars.pl                                */
/*                                                          */
/* a) contable(+GramNr,-Out)                                */
/* with terminal and non terminal symbols in standard order */      
/* b) contable(+GramNr,+Terms, +NTerms,-Out)                */
/* terminal and non terminal symbols in selcted order       */
/* a) and b) with implicit computation of dotted rule sets  */
/* c) dotsetnet(+GramNr)                                    */
/* computation of transition network of dotted rule sets    */
/* K. Eberle 180801                                         */

/* contable(+GramNr) : Output to Screen */
contable(GramNr) :-
 setem(X,(gram(GramNr,_,NT,L), (X=NT ; member(X,L))),Xs),
 sort(Xs,TNTs),
 sep_nts_ts(TNTs,NTs,Ts),
 contable(GramNr,Ts,NTs,Out),
 m_output(Out).
 
/* contable(+GramNr,-Out) */

contable(GramNr,Out) :-
 setem(X,(gram(GramNr,_,NT,L), (X=NT ; member(X,L))),Xs),
 sort(Xs,TNTs),
 sep_nts_ts(TNTs,NTs,Ts),
 contable(GramNr,Ts,NTs,Out).


sep_nts_ts([E|TNTs],[E|NTs],Ts) :-
 atom_codes(E,L),
 capSym(L), !,
 sep_nts_ts(TNTs,NTs,Ts).
sep_nts_ts([E|TNTs],NTs,[E|Ts]) :-
 sep_nts_ts(TNTs,NTs,Ts). 
sep_nts_ts([],[],[]). 

capSym([Nr|_]) :-
 (Nr >= 65), (Nr =< 90), !.

/* contable(8,[a,n,v,p],['S','NP','VP','PP'],X) */

contable(Gram,Terms,NTerms,Out) :-
 deldotsetnet,
 dotsetnet(Gram,[NrSts,NrTranss]),
 cset(gramid,Gram),
 addaxnew(dotsetnetS(Gram,NrSts,NrTranss)),
 dbgmsg(dsets,NrSts), dbgmsg(dsets,NrTranss),
 append(Terms,['$'],T1), append(T1,NTerms,T2),
 contable(0,T1,T2,NrSts,NrTranss,Out).
 
contable(N,T1,T2,NrSts,NrTranss,[OutN|OutNs]) :-
 contable1(N,T1,T2,NrSts,NrTranss,OutN),
 sum(N,1,N1), 
 (member([N1,_],NrSts) -> contable(N1,T1,T2,NrSts,NrTranss,OutNs) ; OutNs=[]), !.
 
contable1(N,T1,[T|Ts],NrSts,NrTranss,[[N,T,SRs1]|OutN]) :-
 shift(N,T,NrTranss,S),
 reduce(N,T1,T,NrSts,Rs),
 append(S,Rs,SRs),
 consider_acc(N,T,NrSts,A),
 append(SRs,A,SRs1),
 contable1(N,T1,Ts,NrSts,NrTranss,OutN).
contable1(N,_,[],_,_,[]).

shift(N,T,NrTranss,[N1]) :-
 member([N,T,N1],NrTranss), !.
shift(N,T,NrTranss,[]). 

reduce(N,T1,T,NrSts,Rs) :- 
 \+ member(T,T1), !.
reduce(N,T1,T,NrSts,Rs) :-
 setem([r,R],(member([N,Ss],NrSts), member(r(X,L),Ss), deconc(L,L1,['.']), 
 gramid(Id), gram(Id,R,X,L1)),Rs).
 
consider_acc(N,'$',NrSts,[acc]) :-
 member([N,Ss],NrSts),
 member(r('S+',['S','.']),Ss), !.
consider_acc(_,_,_,[]).
 
 
 
 
 /************************************/
/************************************/
/* Construction of dotted rule sets */    
/* + Transition                     */
/************************************/

dotsetnet(GramId) :-
  deldotsetnet,
  dotsetnet(GramId,[NrSts,NrTranss]),
  m_output(NrSts),
  m_output(NrTranss),
  deldotsetnet.
  
dotsetnet(GramId,_) :-
 \+ gram(GramId,_,_,_), !, fail.
dotsetnet(GramId,[NrSts,NrTranss]) :-
 startdotsetnet(GramId),
 transdotsetnet(0),
 setem([Nr,St],state(Nr,St),NrSts),
 setem([Nr1,Sym,Nr2],trans(Nr1,Sym,Nr2),NrTranss).


deldotsetnet :-
 delaxall(state,2),
 delaxall(trans,3),
 delaxall(countst,1),
 delaxall(gramid,1),
 delaxall(trmemo,1).

startdotsetnet(GramId) :-
 cset(gramid,GramId),
 cset(countst,0),
 stateclosure1(GramId,[r('S+',['.','S'])],Rs),
 addaxnew(state(0,Rs)).
 
stateclosure(Nr) :-
 gramid(GID),
 delax(state(Nr,Rs)),
 stateclosure1(GID,Rs,Rs1),
 addaxnew(state(Nr,Rs1)). 

stateclosure1(GID,Rs,Rs1) :-
  member(r(_,Li),Rs), deconc(Li,_,['.',Sym|Re]),
  gram(GID,_,Sym,SLi),
  \+ member(r(Sym,['.'|SLi]),Rs),
  stateclosure1(GID,[r(Sym,['.'|SLi])|Rs],Rs1), !.
stateclosure1(GID,Rs,Rs). 


transdotsetnet(StID) :-
 trmemo(M),
 member(StID,M), !.
transdotsetnet(StID) :-
 state(StID,Rs),
 (trmemo(M) -> delax(trmemo(M)) ; M=[]),
 addax(trmemo([StID|M])),
 member(r(NT,Li),Rs),
 dotdec(Li,Be,[Sym|DRe]),
 append(Be,[Sym,'.'|DRe],Li1),
 add(Sym,r(NT,Li1)),
 fail.
transdotsetnet(StID) :-
 delax(state(s(Sym),Rs)),
 gramid(GID),
 stateclosure1(GID,Rs,Rs1),
 addaxnew(state(s(Sym),Rs1)),
 checkidentity(s(Sym),TID),
 addaxnew(trans(StID,Sym,TID)),
 fail.
transdotsetnet(StID) :-
 trans(StID,_,TID),
 transdotsetnet(TID),
 fail.
transdotsetnet(StID).

 
add(Sym,r(NT,Li1)) :-
 once((
 state(s(Sym),Rs) ; addax(state(s(Sym),[])), Rs=[]
 )),
 (\+ member(r(NT,Li1),Rs) -> delax(state(s(Sym),Rs)), addax(state(s(Sym),[r(NT,Li1)|Rs]))).
 

checkidentity(s(Sym),TID) :-
 state(s(Sym),Rs),
 state(TID,Rs1),
 numb(TID),
 li_equ(Rs,Rs1), 
 delax(state(s(Sym),Rs)), !.
checkidentity(s(Sym),TID) :-
 countst(X),
 sum(X,1,TID),
 cset(countst,TID),
 delax(state(s(Sym),Rs)),
 addaxnew(state(TID,Rs)).

dotdec(Li,Be,[Sym|DRe]) :-
 deconc(Li,Be,['.',Sym|DRe]), !.
 
li_equ([X|Rs],Rs1) :-
 delpm(X,Rs1,Rs2),
 li_equ(Rs,Rs2), !.
li_equ([],[]). 




 