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

:- begin(gram).

%% Gram'atica basica de portugues
%
   and(nil,A)             ==> A.
   and(A,nil)             ==> A.
   and(A,[])             ==> A.
   and([],A)             ==> 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 -(iq)--> [prel], np, vp, -[?].
 s -(iq2)--> [prel], 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),T) :- append(A,P,T).

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

%% lambda(X,Pro) ------->  X-Pro
%% adjectiv
%% adjp = (elemento -> factos_mod)
 adjp -(adj)--> [adj(_,_)].
 adjp -(adj1)--> [a_nc(_,_)].
    adj(P) ==> X-infon(P,[X]).
    adj1(X::Y) ==> X-infon(Y,[X]).
 adjp -(super)--> [adv], [adj(_,_)].
 adjp -(comp)--> [adv], [adj(_,_)], -[_-que], np.
 adjp -(comp)--> [adv-tão], [adj(_,_)], -[con-como], np.

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

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

%% relativa simples
%% rels
 rels -(que)-->  -[_-que], vpr.
 rels -(cujo)--> -[_-cujo], np, vpr.
    que(V)         ==> V.
    cujo(npq(_,N,Ant),N-V)  ==> Z-q3(o,N,T,V) :-
          and(infon(de,[Z,N]),Ant) =*> T.

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

%% vpr -- frases verbais com falta de um np
 vpr -(fcomp)--> np, *[adv], [v(_,_)], *vcompl.
 vpr > vp.
   fcomp(npq(Q,N,Ant),[],V,[]) ==> Y-q3(Q,N,Ant,infon(V,[N,Y])).

%% frases verbais
 vp -(v)--> *[adv], [v(_,_)], ?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,nc,ind(X)::_).
lex_error(X,np,_::ind(X)).
lex_error(X,adj,ind(X)).
:- end(lex).

%%teste ---------------------------------------------------------------
%
ex(1,'o leão come um galo').
ex(2,'o João come um velho galo').
ex(3,'o joão come um velho galo que alegremente canta em casa').
ex(4,'o cão que ladra não morde').
ex(5,'a raposa cuja pegada o João vira comeu quatro gordas galinhas').
%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,piopardo,do,galo]).
%ex([todo,cão,come,um,velho,galo]).
 
make(A,I,J)  :- ex(A,I),set_string(I),s(J).
make1(A,I,K) :- ex(A,I),set_string(I),s(J),rewrite(J,K,final).
make2(A,I,K) :- ex(A,I),set_string(I),s(J),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]) ].