/*************************************************************************
*        YAP Prolog
*       Yap Prolog was developed at NCCUP - Universidade do Porto
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985,86,87,88
**************************************************************************
* File:         jjdcg75.pl
*
* comments:     BNF grammar for Prolog
*
* poisened by:  jj & zp
*
*************************************************************************/

:- op(1200,xfx,--->).
:- op(1200,xfx,-+->).
:- multifile lex_rep/3.
:- op(600,fx,['*','?']).
/*
    Variables X in grammar rule bodies are translated as
    if phrase_zp(X) had been written, where phrase_zp/3 is obvious.
    Also, phrase_zp/2-3 check their first argument.
*/

t_head((LP,List), S, SR, SI, SO, H):- !,
        !,append(List, SR, List2),
        extend([S,List2], LP, SI, SO, H).
t_head(LP-Sem, S, SR, SI, SO, H) :-
        !,t_value(LP,Sem,Ter),
        extend([S,SR], Ter, SI, SO, H).
t_head(LP, S, SR, SI, SO, H) :-
        extend([S,SR], LP, SI, SO, H).
t_head(LP-Sem, S, SR, H) :-
        !,t_value(LP,Sem,Ter),
        extend([S,SR], Ter, H).
t_head(LP, S, SR, H) :-
        !,extend([S,SR], LP, H).

t_body(Var, S, S1, phrase_zp(Var,S,S1)) :-
        var(Var),
        !.
t_body(Var-Sem, S, S1,(t_value(Var,Sem,Ter),phrase_zp(Ter,S,S1))) :-
        var(Var),
        !.
t_body([Var], S, SR, consume(S,Var,SR)) :- var(Var),!.
t_body(!, S, S, !) :- !.
t_body([], S, S1, S=S1) :- !.
t_body([X-Y], S, SR, consume(S,X,Y,SR)) :- !.
t_body([X], S, SR, consume(S,X,SR)) :- !.
t_body([H|T], S, SR, (Tt,Rt) ) :- !,
        t_body([H], S, SR1, Tt),
        t_body(T, SR1, SR, Rt).
t_body({T}, S, S, call(T)) :- var(T),!.
t_body({T}, S, S, T) :- !.
t_body((T,R), S, SR, (Tt,Rt)) :- !,
        t_body(T, S, SR1, Tt),
        t_body(R, SR1, SR, Rt).
t_body((T->R), S, SR, (Tt->Rt)) :- !,
        t_body(T, S, SR1, Tt),
        t_body(R, SR1, SR, Rt).
t_body((T;R), S, SR, (Tt;Rt)) :- !,
        t_body(T, S, S1, T1), t_fill(S, SR, S1, T1, Tt),
        t_body(R, S, S2, R1), t_fill(S, SR, S2, R1, Rt).
t_body((X=Y-Z), S, S, t_value(Y,Z,X)) :- ! .
t_body((Y-Z), S, SR, Tt) :- !,
        t_value(Y,Z,T),
        t_body(T,S,SR,Tt).
t_body(T, S, SR, Tt) :-
        extend([S,SR], T, Tt).

t_fill(S, SR, S1, T, (T,SR=S)) :-
        S1 == S, !.
t_fill(_, SR, SR, T, T).

extend(More, OldT, NewT) :-
        OldT =.. OldL,
        append(OldL, More, NewL),
        NewT =.. NewL.

extend(More, F-SI, SI, SO, NewT) :-
        NewT =.. [F, SO | More].
extend(More, OldT, SI, SO, NewT) :-
        OldT =.. [F, SI | OldL],
        append(OldL, More, NewL),
        NewT =.. [F, SO | NewL].

t_value([X],Sem,[X-Sem]):-!.
t_value(terminal(X),_,[X]):-!.
t_value((X;Y),Sem,(T1;T2)) :-!, t_value(X,Sem,T1), t_value(Y,Sem,T2).
t_value((X,Y),(Sem1,Sem2),(T1,T2)) :-!, t_value(X,Sem1,T1),
                                        t_value(Y,Sem2,T2).
t_value(A,Sem,B)   :- val_meta(A,Sem,B),!.        % para os meta operadores
t_value(A,Sem,Ter) :- nonvar(Ter),!,(Ter=A-Sem,!;
                                     Ter =..[F,Sem|T], A =..[F|T],!) .
t_value(A,Sem,Ter) :-!, A =.. [F|T], Ter =..[F,Sem|T] .

%t_value(A,Sem,Fea,Ter) :- t_value(B,Sem,Ter),(t_value(A,Fea,B) ;
%A=B,Fea=nil),!.

t_tidy(P,P) :- var(P), !.
t_tidy((P1;P2), (Q1;Q2)) :- !,
        t_tidy(P1, Q1),
        t_tidy(P2, Q2).
t_tidy((P1->P2), (Q1->Q2)) :- !,
        t_tidy(P1, Q1),
        t_tidy(P2, Q2).
t_tidy(((P1,P2),P3), Q) :-
        t_tidy((P1,(P2,P3)), Q).
t_tidy((P1,P2), (Q1,Q2)) :- !,
        t_tidy(P1, Q1),
        t_tidy(P2, Q2).
t_tidy(A, A).

consume([lex(X,_,_)|S],X,S) :- !.
consume([X|S],X,S).
consume([H|S],X,S2)     :- lex_rep(H,S,S3),
                           consume(S3,X,S2).

consume([H|S],X,Y,S2)     :- lex_rep(H,S,S3),
                             consume(S3,X,Y,S2).
consume([Z|S],X,Y,S) :- lex_(Z,X,Y).

lex_rep('%%%',[S],[S]).

lex_(X,Y,Z) :- var(X),!,lex(X,Y,Z).
lex_(lex(Pal,X,Y),X,Y) :- !.
lex_(lex(_,_,_),_,_) :- !,fail.
lex_(X,Y,Z) :- lex(X,_,_),!,lex(X,Y,Z).
lex_(X,Y,Z) :- lex_rep(X,_,_),!,fail.
lex_(X,Y,Z) :- lex_error(X,Y,Z).

%add_(X) :- call(X),!.
%add_(X) :- assert(X),!.

%prefixo([],_).
%prefixo([X|Y],[X|Z]) :- prefixo(Y,Z).

phrase_zp(Phrase_ZpDef, WordList) :-
        phrase_zp(Phrase_ZpDef, WordList, []).

phrase_zp(P, S0, S) :-
        (   var(P) % ; primitive(P), \+ atom(P) 
                                                ),  !,
        write(user_error,'Arg 1 of phrase_zp is not callable: '),
        write(user_error, phrase_zp(P,S0,S)),
        nl(user_error),
        fail.
phrase_zp([], S0, S) :- !,
        S0 = S.
phrase_zp([H-Y], S0, S) :- !,
        consume(S0,H,Y,S).
phrase_zp([H|T], S0, S) :- !,
        append([H|T], S, S0).
phrase_zp(Phrase_Zp, S0, S) :-
        t_body(Phrase_Zp, S0, S, Goal), !,
        call(Goal).

append([],L,L).
append([H|T],L,[H|TL]) :- append(T,L,TL).
:- op(1199,xfx,==>).
:- op(1199,xfx,=*>).
:- op(1197,xfx,['-->','-*>']).
:- op(1197,xfx,['-+->','--->']).
:- op(1090,xfx,[!]).
:- multifile ==> /2.
:- multifile ==> /3.
:- multifile term_expansion /3.
bottom ==> fail.

:- dynamic offrules /0 .
t_rewrite(on) :- retractall(offrules).
t_rewrite(off) :- assert(offrules).
:- t_rewrite(on).
 
A =*> B :- rewrite(A,B).

rewrite(X,Y) :- (var(X);offrules),!,X=Y.
rewrite((X,Y),Z) :- !, rewrite(X,X1),rewrite(Y,Y1),
               (X1=nil,Z=Y1; Y1=nil,Z=X1; Z=(X1,Y1)),!.
rewrite(X,Y) :- (X ==> Z) , !, rewrite(Z,Y).
rewrite(fail,_) :- !, fail.
rewrite(X,X) :- !.

rewrite(X,Y,St) :- (var(X);offrules),!,X=Y.
rewrite(X,Y,St) :- ==>(St,X,Z) , !, rewrite(Z,Y,St).
rewrite(fail,_,St) :- !, fail.
rewrite(X,X,St) :- !.

term_expansion((LP--->RP), (H:-rewrite(SI,SO))) :-
        RP == [],
        !,
        t_head(LP, S, S, SI, SO ,H).
term_expansion((LP--->RP), (H:-B)) :-
        t_head(LP, S, SR, SI, SO, H),
        t_body(RP, S, SR, B1),
        t_tidy((B1,rewrite(SI,SO)), B).
term_expansion((LP-+->RP), (H)) :-
        RP == [],
        !,
        t_head(LP, S, S, H).
term_expansion((LP-+->RP), (H:-B)) :-
        t_head(LP, S, SR, H),
        t_body(RP, S, SR, B1),
        t_tidy(B1, B).

/* ----------------------------------------------------------------------
 expancoes condicionais
---------------------------------------------------------------------- */

:- dynamic state_is /1 .
end(X) :- state_is(X),!, retract(state_is(X)) ; 
          write(('error: state not begin... ', X)),fail.
begin(X) :- asserta(state_is(X)).
:- begin(init).

term_expansion((A ! B ==> C),(==>(A,B,C))). 
term_expansion((A ! B ==> C :- D),(==>(A,B,C) :- D)). 
term_expansion(In,Out) :- state_is(State),term_expansion(State,In,Out).
term_expansion(gram,X,Y) :- ==>(gram,X,_),rewrite(X,Z,gram),
        term_expansion(Z,Y).
term_expansion(State,X,Y)  :- ==>(State,X,_),rewrite(X,Y,State).

%-------------------------------------------------------------------------
% metaoperadores default
%-------------------------------------------------------------------------
:- multifile val_meta/3.

?A -+-> A=_-Se, (A; [], {Se=nil}).
*X -+-> X=F-Se, ({Se=[H|T]}, F-H, *F-T; {Se=[]}, []).
+X -+-> X=F-[H|T], F-H, *F-T.
val_meta(?A,Sem,?B):- !,t_value(A,Sem,B).
val_meta(*A,Sem,*B):- !,t_value(A,Sem,B).
val_meta(+A,Sem,+B):- !,t_value(A,Sem,B).