:- op(600,xfy,'::').    % tipagem  classe::instancia
:- multifile ==> /2.
:- multifile ==> /3.
:- multifile lex_error /3.
:- multifile lex_rep /3.
:- multifile lex_rep /4.
:- [jjlex].

:- begin(gram).

%% Gram'atica basica de portugues
%
   and(nil,A)             ==> A.
   and(A,nil)             ==> A.

   mod(Pre,npq(Q,E1,An),E2) ==> q3(Q,E1,An,infon(Pre,[E1,E2])).

%%   npq(Q,E1,An,(nil,E))  ==> npq(Q,E1,An,E).
%%   npq(Q,E1,(nil,An),E)  ==> npq(Q,E1,An,E).
       


%
%% sentence s
%% 
 s -(s)--> np, vp.
% s -(yesno)--> np, vp, -[?].
 s -(iq)--> [ip], np, vp, -[?].
 s -(iq2)--> [ip], np, -[?].
      s(npq(D,N,A),N-Fv) ==> q3(D,N,A,Fv) .
   iq(_,npq(o,N,A),N-Fv) ==> q3(i,N,A,Fv) .
   iq2(_,npq(o,N,A))   ==> q3(i,N,A,nil) .
% 
%% noun phrases
%% np =  npq(quant,elemento,anteced)
 np -(np)--> det, *adjp, n, *n_pcompl.
   np(npq(D,N,Ant),[])         ==> npq(D,N,Ant1) :- rewrite(Ant,Ant1).
   np(npq(D,N,Ant),[N-A|R])    ==> np(npq(D,N,and(Ant,A)),R).
   np(npq(D,N,A),[p(Pr,Np)|R]) ==> np(npq(D,N,and(A,SemPrep)),R):-
          rewrite(mod(Pr,Np,N),SemPrep).
   np(D,A,N-Pred,P)            ==> np(npq(D,N,Pred),AP):-append(A,P,AP).

%% determinante
%% det = {o, um, todo, no, N}
 det -(artnum)--> ?[art], ?[num].
   artnum(nil,nil) ==> o.
   artnum(X,nil)   ==> X.
   artnum(_,Y)     ==> Y.
 
%% noun
%% n = tipo::elemento - pred
 n -(cn)--> [cn].
 n -(pn)--> [pn].
 n -(cnpn)--> [cn], [pn].
    cnpn(Cl::_,Cl2::I) ==> (Cl3::I)-nil :- glb(Cl,Cl2,Cl3).
    cn(X::Y) ==>  (X::Y)-nil.
    pn(X::Y) ==>  (X::Z)-infon(chamado,[X::Z,nome::Y]).

%% lambda(X,Pro) ------->  X-Pro
%% adjectiv
%% adjp = (elemento -> factos_mod)
 adjp -(adj)--> [adj(A,B,C)].
    adj(a1(P)) ==> X-infon(P,[X]).
% adjp -(super)--> [adv(c)], [adj].
% adjp -(comp)--> [adv(c)], [adj], -[relp-que], np.
% adjp -(comp)--> [adv(c)-tao], [adj], -[conj-como], np.

%% complementos apos nome
%% n_pcompl = lambda(elemento,factos_mod) | p(prep,NP)
 n_pcompl > (adjp ; pp ; rel).

%% preposicionais
 pp -(p)--> [prep], np.

%% relativa simples
%% rels
 rels -(que)--> -[relp-que], vpr.
 rels -(cujo)--> -[relp-cujo], np, vpr.
    que(V)     ==> V.
%    cujo(N,V)  ==> 

 rel > rels.
 rel -(preprel)--> [prep], rels.
%    preprel(P,R) ==>

%% vpr -- frases verbais com falta de um np
 vpr -(fcomp)--> np, *[adv(_)], [v(A,B)], *vcompl.
 vpr > vp.
%     fcomp(N,A,V,Vc) ==> 

%% frases verbais
 vp -(v)--> *[adv(_)], [v(A,B)], ?np, *vcompl.
   v(V,nil,C)          ==> X-infon(V/C,[X]).
   v(V,npq(D,E,A),C)   ==> X-q3(D,E,A,F) 
           :- rewrite(infon(V/C,[X,E]),F).
   v(C1,V,N,C2)        ==> v(V,N,C)    :- append(C1,C2,C).

   infon(X/[],Ar)         ==> infon(X,Ar).
   infon(X/[p(P,npq(Q,N,Ant))|R],Ar) ==> q3(Q,N1,Ant,infon(Y/R,[N1|Ar])) 
                          :-  relpp(X,P,N,Y,N1).
   infon(X/[Adv|R],Ar)    ==> infon(Y/R,Ar)      :-  reladv(X,Adv,Y).
%relpp(nasce,em,N,X,em(N)).
relpp(X,em,N,X,em(N)).
reladv(X,A,X-A).

%% adverbios
%
%% complementos de verbo
 vcompl > ([adv(_)] | pp).

:- end(gram).

lex ! [X|L] = Z ==> lex_rep(X,L,Z).

:- begin(lex).
[maior|S] = [mais, grande|S].
[menor|S] = [mais, pequeno|S].
[quem|S] = [pessoa,que|S].
[do|S]   = [lex(de,prep,de),lex(o,art,o)|S].
[no|S]   = [lex(em,prep,em),lex(o,art,o)|S].

lex_error(X,cn,ind(X)::_).
lex_error(X,pn,_::ind(X)).
lex_error(X,adj,ind(X)).
:- end(lex).

%%teste ---------------------------------------------------------------
%
ex([o,joão,come,um,galo]).
ex([o,joão,come,um,velho,galo]).
ex([que,cão,come,um,galo,(?)]).
ex([qual,o,cão,que,come,o,galo,(?)]).
ex([todo,cão,velho,come,4,velho,galo]).
ex([todo,cão,come,um,velho,galo,de,barcelos]).
%ex([o,joão,come,um,velho,galo,que,alegremente,canta,em,casa]).
ex([o,joão,come,um,piopardo,do,galo]).
ex([todo,cão,come,um,velho,galo]).
 
make(I,J) :- ex(I),s(J,I,[]).
make1(I,K) :- ex(I),s(J,I,[]),rewrite(J,K,final).
make2(I,K) :- ex(I),s(J,I,[]),rewrite(J,K,sig).

final ! and(nil,B) ==> B .
final ! and(A,B)   ==> (A1,B1) :- rewrite(A,A1,final),rewrite(B,B1,final).
final ! q3(o,_,X,Y) ==> Z :- rewrite(and(X,Y),Z,final).
final ! q3(todo,X,Y,Z) ==> all(X,Y1,Z1) :- rewrite(Y,Y1,final),
                                            rewrite(Z,Z1,final).
final ! q3(um,X,Y,Z) ==> exist(X,Y1,Z1) :- rewrite(Y,Y1,final),
                                            rewrite(Z,Z1,final).
final ! q3(i,X,Y,Z) ==> quest(X,Y1,Z1)  :- rewrite(Y,Y1,final),
                                            rewrite(Z,Z1,final).
final ! q3(K,C::X,Y,Z) ==> exist(C-set::X,Y1,Z1)  :- integer(K),
              rewrite((infon(card,[C-set::X,K]),Y),Y1,final),
                                            rewrite(Z,Z1,final).
final ! infon(Rel,Args) ==> T :- atom(Rel), T =.. [Rel | Args]. 


sig ! q3(_,_,Y,Z) ==>  L       :- rewrite(Y,Y1,sig),
                                   rewrite(Z,Z1,sig),append(Y1,Z1,L).
sig ! nil ==> [].
sig ! and(B,nil) ==> B.
sig ! and(nil,B) ==> B.
sig ! and(A,B) ==> L :- rewrite(A,A1,sig),rewrite(B,B1,sig),append(A1,B1,L).
sig ! infon(Rel,[Cl::_]) ==> [sig(Rel,[Cl])]. 
sig ! infon(Rel,[Cl1::_ ,Cl2::_]) ==> [ sig(Rel,[Cl1,Cl2]) ].
sig ! infon(Rel,[Cl1::_,Cl2::_,Cl3::_]) ==> [sig(Rel,[Cl1,Cl2,Cl3]) ].