DCG ``Pascal''

Damos agora um 'exemplo real', mais complexo. O objectivo é construir uma gramática que defina/descreva uma linguagem de programação do tipo Pascal. De seguida encontra a DCG juntamente com alguns exemplos de programas válidos (teste1,..., teste4).

teste1(P) :-
  parse([program,teste1,';',begin,write,x,'+','y','-',z,'/',2,end],P), !.

teste2(P) :-
  parse(
   [program,teste2,';',begin,if,a,'>',b,then,max,':=',a,else,max,':=',b,end],
   P
  ), !.

teste3(P) :-
  parse(
    [program,repeat,';',begin,i,':=',1,';',repeat,begin,write,i,';',i,':=',
     i,'+',1,end,until,i,'=',11,end],P), !.

teste4(P) :-
  parse([program,ciclofor,';',begin,for,i,'=',1,to,11,step,1,do,write,i,end],
        P), !.

% Parser

parse(Source,Structure) :-
  pl_program(Structure,Source,[]).

pl_program(S) -->
  [program],
  identifier(X),
  [';'],
  statement(S).

statement((S;Ss)) -->
  [begin],
  statement(S),
  rest_statements(Ss).
statement(assign(X,V)) -->
  identifier(X),
  [':='],
  expression(V).
statement(if(T,S1,S2)) -->
  [if],
  test(T),
  [then],
  statement(S1),
  [else],
  statement(S2).
statement(while(T,S)) -->
  [while],
  test(T),
  [do],
  statement(S).

statement(repeat(S,T)) -->
  [repeat],
  statement(S),
  [until],
  test(T).

statement(for(ID,C1,C2,C3,S)) -->
  [for],
  identifier(ID),
  ['='],
  expression(C1),
  [to],
  expression(C2),
  [step],
  expression(C3),
  [do],
  statement(S).

statement(read(X)) -->
  [read],
  identifier(X).
statement(write(X)) -->
  [write],
  expression(X).

rest_statements((S;Ss)) -->
  [';'],
  statement(S),
  rest_statements(Ss).
rest_statements(void) -->
  [end].

expression(X) -->
  pl_constant(X).
expression(expr(Op,X,Y)) -->
  pl_constant(X),
  arithmetic_op(Op),
  expression(Y).

arithmetic_op('+') -->
  ['+'].
arithmetic_op('-') -->
  ['-'].
aritmetic_op('*') -->
  ['*'].
arithmetic_op('/') -->
  ['/'].

pl_constant(name(X)) -->
  identifier(X).
pl_constant(number(X)) -->
  pl_integer(X).

identifier(X) -->
  [X],
  {atom(X)}.

pl_integer(X) -->
  [X],
  {integer(X)}.

test(compare(Op,X,Y)) -->
  expression(X),
  comparison_op(Op),
  expression(Y).

comparison_op('=') -->
  ['='].
comparison_op('<>') -->
  ['<>'].
comparison_op('>') -->
  ['>'].
comparison_op('<') -->
  ['<'].
comparison_op('>=') -->
  ['>='].
comparison_op('<=') -->
  ['<='].