home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 02 / parser / parse3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-06  |  2.6 KB  |  101 lines
  1. {PARSE3.PAS}
  2. {
  3. Description:  Parsing routines for analyzing Pascal programs
  4. Author:       Karl Gerhard
  5. Date:         9/4/87
  6. Application:  IBM PC and compatibles
  7. }
  8.  
  9. {---------------------------------}
  10. Procedure emitter(s:stdstr);
  11. Begin
  12. writeln(FLOG,'  EMITTING ',s);
  13. writeln(' Emitting: ',s);
  14. End;
  15.  
  16. {---------------------------------}
  17. Function parse(plevel:integer; stack:stack_type):boolean;
  18. { main parse routine }
  19. Var
  20.   option_op,tops,rhs:stdstr;
  21.   statok:boolean;
  22.   p:integer;
  23.  
  24. Begin { ----- main parse ------ }
  25. logging(strint(plevel),' -------- PARSER ENTRY');
  26. statok := true;
  27. while statok and (length(stack) > 0) and (the_token <> '') do begin
  28.   tops := pop(stack);
  29.   logging(strint(plevel),' STACK  ' + tops + ' ' + stack);
  30.  
  31.   { optional phrase }
  32.   if tops = '{' then begin
  33.     p := pos('}',stack);
  34.     option_op := copy(stack,1, p - 2);
  35.     delete(stack,1,p + 1);
  36.     repeat logging(#13#10 + strint(plevel), ' OPTION CALL');
  37.     until ( the_token = '' ) or not parse(plevel + 1,option_op);
  38.   end
  39.  
  40.  
  41.   { OR phrase }
  42.   else if stack[1] = '|' then begin
  43.     logging(#13#10 + strint(plevel), ' ALT CALL');
  44.     if parse(plevel + 1,tops) then begin
  45.       while stack[1] = '|' do begin tops := pop(stack); tops := pop(stack);end;
  46.     end
  47.     else begin
  48.       tops := pop(stack);
  49.     end
  50.   end
  51.  
  52.   { check for Any token }
  53.   else if tops = '!ID' then begin
  54.     if the_token[1] in [#58..#64,#32..#47] then begin
  55.       statok := false;
  56.       writeln( 'Parser expected ',color(0,7), ' IDENTIFIER ', color(7,0),
  57.                ' Found ', color(0,7), ' ', the_token, ' ', color(7,0) );
  58.     end
  59.     else begin
  60.       emitter(the_token);
  61.       the_token := getoken;
  62.     end;
  63.   end
  64.  
  65.   { check for EXIT token }
  66.   else if tops = '!EXIT' then begin
  67.     tops := '-' + pop(stack) + '-';
  68.     if pos( '-'+struc(the_token)+'-',tops) > 0 then begin
  69.       statok := false;
  70.     end;
  71.   end
  72.  
  73.   { check for EMPTY token }
  74.   else if tops = '!EMPTY' then begin
  75.   end
  76.  
  77.   { Non-terminal token }
  78.   else if  search_lhs(tops,rhs) then begin
  79.     push(rhs, stack );
  80.   end
  81.  
  82.   { terminal token }
  83.   else if struc(tops) = struc(the_token) then begin
  84.     {statok := true;}
  85.     emitter(the_token);
  86.     the_token := getoken;
  87.   end { terminal token }
  88.  
  89.   { Parse failed }
  90.   else begin
  91.     statok := false;
  92.     if plevel = 1 then
  93.       writeln( 'Parser expected ',color(0,7), ' ', tops, ' ', color(7,0),
  94.                ' Found ', color(0,7), ' ', the_token, ' ', color(7,0) );
  95.   end;
  96. end;
  97. logging(strint(plevel), ' -------- PARSER EXIT ' + bool(statok) + #13#10 );
  98. parse := statok;
  99. End;
  100. 
  101.