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