home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / GRAMMAR < prev    next >
Text File  |  1990-08-13  |  2KB  |  63 lines
  1. :- op(255, xfx, '-->').
  2.  
  3.  
  4. /* Grammar Rule translator */
  5.  
  6. $translate_rule((LP-->[]),H) :- !, $t_lp(LP,S,S,H).
  7. $translate_rule((LP-->RP),(H:-B)):-
  8.    $t_lp(LP,S,SR,H),
  9.    $t_rp(RP,S,SR,B1),
  10.    $tidy(B1,B).
  11.  
  12. $t_lp((LP,List),S,SR,H):- !,
  13.    $append(List,SR,List2),
  14.    $add_extra_args([S,List2],LP,H).
  15.  
  16. $t_lp(LP,S,SR,H) :- $add_extra_args([S,SR],LP,H).
  17.  
  18. $t_rp(!,S,S,!) :- !.
  19. $t_rp([],S,S1,S=S1) :- !.
  20. $t_rp([X],S,SR,c(S,X,SR)) :- !.
  21. $t_rp([X|R],S,SR,(c(S,X,SR1),RB)) :- !, $t_rp(R,SR1,SR,RB).
  22. $t_rp({T0},S,S,T) :- !, $compile_arith(T0,T).
  23. $t_rp((T,R),S,SR,(Tt,Rt)) :- !,
  24.    $t_rp(T,S,SR1,Tt),
  25.    $t_rp(R,SR1,SR,Rt).
  26. $t_rp((T;R),S,SR,(Tt;Rt)) :- !,
  27.    $t_or(T,S,SR,Tt),
  28.    $t_or(R,S,SR,Rt).
  29. $t_rp(T,S,SR,Tt) :- $add_extra_args([S,SR],T,Tt).
  30.  
  31. $t_or(X,S0,S,P) :-
  32.    $t_rp(X,S0a,S,Pa),
  33.  ( var(S0a), S0a \== S, !, S0=S0a, P=Pa;
  34.    P=(S0=S0a,Pa) ).
  35.  
  36. $add_extra_args(L,T,T1) :-
  37.    T=..Tl,
  38.    $append(Tl,L,Tl1),
  39.    T1=..Tl1.
  40.  
  41. $append([],L,L) :- !.
  42. $append([X|R],L,[X|R1]) :- $append(R,L,R1).
  43.  
  44. $tidy((P1;P2),(Q1;Q2)) :- !,
  45.    $tidy(P1,Q1),
  46.    $tidy(P2,Q2).
  47. $tidy(((P1,P2),P3),Q) :- $tidy((P1,(P2,P3)),Q).
  48. $tidy((P1,P2),(Q1,Q2)) :- !,
  49.    $tidy(P1,Q1),
  50.    $tidy(P2,Q2).
  51. $tidy(A,A) :- !.
  52.  
  53. c([X|S],X,S).
  54.  
  55. /* Hook to insert grammar rule expansion into main interpreter */
  56.  
  57. :- asserta(($process(X,Y) :- $translate_rule(X,Y))).
  58.  
  59. % hide the new clauses
  60.  
  61. :- hide([$translate_rule(_,_), $t_lp(_,_,_,_), $t_rp(_,_,_,_), $t_or(_,_,_,_),
  62.     $tidy(_,_), $append(_,_,_), $add_extra_args(_,_,_), c(_,_,_)]).
  63.