Toy language parser in Pascal taken from "The simple and powerful yfx operator precedence parser" by E. L. Favero. His code is intended to show how one can convert a Prolog DCG into an imperative language. The translation is straightforward and can be used to write a Prolog parser, with dynamic operator precedence, in an imperative language. I a…

pyfx.pas

program pyfx;

type  int  = integer;
      bool = boolean;
      str  = string; 
const fy = 1;
      fx = 2;
      yf = 3;
      xf = 4;
      xfy= 5;
      yfx= 6;
      xfx= 7;
var   SSS:string;
      LAST:int;
      tbOP:array[1..256,fy..xfx] of integer;

procedure tableOP;
begin
  tbOP[ord(’-’),fy]  := 380;
  tbOP[ord(’+’),fy]  := 380;
  tbOP[ord(’#’),fy]  := 380;
  tbOP[ord(’!’),yf]  := 280; 
  tbOP[ord(’@’),xfy] := 500;
  tbOP[ord(’-’),yfx] := 500; 
  tbOP[ord(’+’),yfx] := 500; 
  tbOP[ord(’*’),yfx] := 400; 
  tbOP[ord(’=’),xfx] := 900; 
end;

function prefix(O:char;var P,P1:int):bool; 
begin 
  prefix := true; 
  if tbOP[ord(O),fy] > 0 then 
  begin 
    P := tbOP[ord(O),fy]; 
    P1 := P; 
  end
  else if tbOP[ord(O),fx] > 0 then
  begin
    P := tbOP[ord(O),fx];
    P1 := P-1; 
  end
  else
    prefix := false;
end;

function postfix(O:char; var P, P1:int):bool;
begin
  postfix := true;
  if tbOP[ord(O),yf] > 0 then
  begin 
    P := tbOP[ord(O),yf];
    P1 := P;
  end
  else if tbOP[ord(O),xf] > 0 then
  begin
    P := tbOP[ord(O),xf];
    P1 := P-1;
  end
  else
    postfix := false;
end;

function infix(O:char; var P,P1,P2:int):bool;
begin
  infix := true;
  if tbOP[ord(O),yfx] > 0 then
  begin
    P := tbOP[ord(O),yfx];
    P1 := P;
    P2 := P-1;
  end
  else if tbOP[ord(O),xfy] > 0 then
  begin
    P := tbOP[ord(O),xfy];
    P1 := P-1;
    P2 := P;
  end
  else if tbOP[ord(O),xfx] > 0 then
  begin
    P := tbOP[ord(O),xfx];
    P1 := P-1;
    P2 := P-1;
  end
  else
    infix := false;
end;

procedure setLast(o:int);
begin
  if o > LAST then
    LAST := o;
end;

function dig(var d:char; i:int; var o:int):bool;
begin
  dig := (SSS[i] in [’0’..’9’]);
  d := SSS[i];
  o := i+1;
  setLast(i);
end;

function id(var d:char;i:int;var o:int):bool;
begin
  id := (SSS[i] in [’a’..’z’]);
  d := SSS[i];
  o := i+1;
  setLast(i);
end;

function tk(c:char;i:int;var o:int):bool; 
begin
  tk := (c=SSS[i]);
  o := i+1;
  setLast(i);
end;

function tok(var c:char; i:int; var o:int):bool;
begin
  tok := true;
  c := SSS[i];
  o := i+1;
  setLast(i);
end;

function attr(var o:int; i:int ):bool;
begin
  attr := true;
  o := i;
end;

function attrs(var o:str; i:str):bool;
begin
  attrs := true;
  o:=i;
end;

function term(PP:int;var T0:str; i:int;var o:int):bool;
var
  j, P, PR : int;
  T, T2 : str;
  X, OP : char;
begin
  {-writeln(’term: ’,i,’=’,sss[i]); -}
  term  := id(X ,i,j)  and rTerm(PP,0, X,T0,j,o)
        or dig(X ,i,j) and rTerm(PP,0, X,T0,j,o)
        or tk(’(’,i,j) and term(1200,T, j,j)     and tk(’)’,j,j) and rTerm(PP,0,T,T0,j,o)
        or tk(’L’,i,j) and id(X,j,j)             and tk(’=’,j,j) and term(1200,T,j,j)     and tk(’I’,j,j) and term(1200,T2,j,j) and rTerm(PP,0,’L{’+X+’=’+T+’I’+T2+’}’,T0,j,o)
        or tok(OP,i,j) and prefix(OP,P,PR)       and (P<=PP)     and term(PR,T,j,j)       and rTerm(PP,P,OP+’[’+T+’]’,T0,j,o)
end;

function rTerm(PP,Pi:int; Ti:str; var T0:str; i:int; var o:int):bool;
var j,P,PR,PL : int;
    T : str;
    OP : char;
begin
  {-writeln(’rterm: ’,i,’=’,sss[i], Ti);	-}
  rTerm := tok(OP,i,j) and infix(OP,P,PL,PR) and (P<=PP) and (Pi<=PL) and term(PR,T,j,j)                    and rTerm(PP,P,OP+’(’+Ti+’,’+T+’)’,T0,j,o)
        or tok(OP,i,j) and postfix(OP,P,PL)  and (P<=PP) and (Pi<=PL) and rTerm(PP,P,OP+’[’+Ti+’]’, T0,j,o)
        or true        and attrs(T0,Ti)     and attr(o,i);
end;

procedure s0(i:int; S:str);
var T : str;
    o : int;
begin
  SSS := S+’$’;
  LAST := 0;
  writeln(’test ’,i,’ in: ’, SSS);
  if term(1200,T,1,o) then
    writeln(o,’<=’,last,’<=’,length(SSS),’ out: ’,T)
  else
    writeln(’ERROR’);
  readln;
end;

begin {-main-}
  s0(20,’La=3Ia+2’);
  s0(21,’La=1ILb=2+aILa=a+aIa+(b+1)’);
  s0(22,’La=1+1ILb=3Ia+b’);
  s0(23,’La=1ILb=Lc=2*aIc+2ILa=a-aIa+b’);
  s0(5,’1!!*+(+(+(1)))’);
  s0(6,’a+1+1+-2*3*a*1-a’);
  s0(12,’1@2+1’);
  s0(13,’+1-’);
  s0(11,’(1!!!!!!!!!!)*(++++1)+a+1+1+-2*3*a*1+1+1’);
  s0(14,’1------------------------------------------------1’);
  s0(16,’1--------1----------’); 
end.