home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compcomp / tpyacc / yref.y < prev    next >
Text File  |  1991-06-17  |  9KB  |  403 lines

  1.  
  2. /* YREF.Y: YREF cross reference utility, V1.1 5-1-91 AG
  3.  
  4.    This is a sample Yacc program which produces complete cross reference
  5.    listings of Yacc source (.y) files. It is based on the same grammar
  6.    which has actually been used to implement Yacc itself, and thus might
  7.    also be useful for other utilities which have to parse Yacc sources.
  8.    The lexical analyzer for this program can be found in YREFLEX.L. The
  9.    units YRefTools and YRefTables supply the additional routines and data
  10.    structures used by the program. To compile the program, issue the
  11.    commands:
  12.      yacc yref
  13.      lex yreflex
  14.      tpc /m yref
  15.  
  16.    The YREF program reads and parses a Yacc source file and produces
  17.    a listing of the source file (with linenumbers), followed by a cross
  18.    reference table of all (literal and nonterminal) identifiers used in the
  19.    grammar, in alphabetical order. For each symbol, YREF lists the type of
  20.    the symbol (if type tags are used), and the corresponding line numbers
  21.    where the symbol occurs. Line numbers marked with an asterisk denote
  22.    places where the corresponding symbol is "defined" (the lines where a
  23.    terminal is introduced in a %token definition, or a nonterminal appears
  24.    on the left-hand side of a rule). Symbols which do not have at least
  25.    one defining position are listed as "undefined symbols" at the end of
  26.    the list; this is useful to check Yacc grammars for "completeness."
  27.  
  28.    YREF does not handle syntactic errors in the source file; it is
  29.    assumed that the input file is a syntactically correct Yacc program.
  30.    If a syntax error is encountered, YREF simply gives an error message
  31.    indicating the offending position, and exits with return code 1.
  32.  
  33.    The command line syntax is as follows:
  34.  
  35.    YREF yacc-file[.Y] [output-file[.REF]]
  36.  
  37.    Default extensions .Y for the input, and .REF for the output file
  38.    are supplied automatically. If the output file name is ommitted,
  39.    it defaults to the name of the input file with new suffix .REF.
  40.  
  41. */
  42.  
  43. %{
  44.  
  45. {$I-}
  46.  
  47. uses YaccLib, LexLib, Dos, YRefTools, YRefTables;
  48.  
  49. procedure yyerror ( msg : String );
  50.   begin
  51.     writeln(msg , ' in line ', yylineno, ' at or near `', yytext, '''');
  52.   end(*yyerror*);
  53.  
  54. var tag : Integer;       (* type tag *)
  55.     symlineno : Integer; (* line number of last identifier *)
  56.  
  57. procedure scan ( var c : Char ); forward;
  58.   (* scan for nonempty character, skipping comments *)
  59.  
  60. procedure skip ( delim : String ); forward;
  61.   (* skip up to next occurrence of delim *)
  62.  
  63. procedure search ( delim : String ); forward;
  64.   (* like skip, but retain found delimiter, and handle embedded strings *)
  65.  
  66. %}
  67.  
  68. /* Tokens of the Yacc language:
  69.  
  70.    Note the use of C_ID to distinguish identifiers which start a new rule.
  71.    This is necessary because the parser is limited to one-symbol lookahead
  72.    and hence could not determine whether an identifier is followed by a
  73.    colon, starting a new rule, or is simply just another nonterminal or
  74.    token identifier in the right-hand of a rule. Thus the lexical analyzer
  75.    performs the necessary lookahead, and returns C_ID if the identifier is
  76.    followed by a colon (skipping blanks and comments), and ID otherwise. */
  77.  
  78. %token
  79.   ID        /* identifiers: {letter}{letter_or_digit}* */
  80.   C_ID        /* identifier which forms left side of rule, i.e. is
  81.            followed by a colon */
  82.   LITERAL       /* literals (strings enclosed in single or double quotes) */
  83.   NUMBER    /* nonnegative integers: {digit}+ */
  84.   PTOKEN PLEFT PRIGHT PNONASSOC PTYPE PSTART PPREC
  85.           /* reserved words: PTOKEN=%token, etc. */
  86.   PP        /* source sections separator %% */
  87.   LCURL        /* curly braces: %{ and %} */
  88.   RCURL
  89.   ',' ':' ';' '|' '{' '}' '<' '>' '='
  90.         /* literals */
  91.  
  92. %start grammar
  93.  
  94. %%
  95.  
  96. grammar        : defs PP rules aux_procs
  97.         ;
  98.  
  99. aux_procs    : /* empty: aux_procs is optional */
  100.  
  101.         | PP { yyaccept; }
  102.  
  103.         ;
  104.  
  105.  
  106. defs        : /* empty */
  107.  
  108.         | defs def
  109.  
  110.         ;
  111.  
  112. def        : PSTART ID
  113.  
  114.         | LCURL { search('%}'); } RCURL
  115.  
  116.         | PTOKEN tag token_list
  117.  
  118.         | PLEFT tag token_list
  119.  
  120.         | PRIGHT tag token_list
  121.  
  122.         | PNONASSOC tag token_list
  123.  
  124.         | PTYPE tag nonterm_list
  125.  
  126.                 | PTYPE tag
  127.  
  128.         ;
  129.  
  130. tag        : /* empty: type tag is optional */
  131.                 { tag := 0; }
  132.         | '<' ID '>'
  133.                         { tag := $2; }
  134.         ;
  135.  
  136. token_list    : token_num
  137.  
  138.         | token_list token_num
  139.  
  140.         | token_list ',' token_num
  141.  
  142.         ;
  143.  
  144. token_num    : LITERAL opt_num
  145.  
  146.                    | ID
  147.                 { add_ref($1, symlineno, true);
  148.                                   set_type($1, tag); }
  149.                   opt_num
  150.  
  151.         ;
  152.  
  153. opt_num         : /* empty */
  154.  
  155.                 | NUMBER
  156.  
  157.                 ;
  158.  
  159. nonterm_list    : nonterm
  160.  
  161.         | nonterm_list nonterm
  162.  
  163.         | nonterm_list ',' nonterm
  164.  
  165.         ;
  166.  
  167. nonterm        : ID
  168.                 { add_ref($1, symlineno, false);
  169.                                   set_type($1, tag); }
  170.         ;
  171.  
  172.  
  173. rules        : rule1
  174.  
  175.         | LCURL { search('%}'); } RCURL rule1
  176.                     /* rules section may be prefixed
  177.                        with `local' Turbo Pascal
  178.                        declarations */
  179.         | rules rule
  180.  
  181.         ;
  182.  
  183. rule1        : C_ID
  184.                 { add_ref($1, symlineno, true); }
  185.           ':' body prec
  186.  
  187.         ;
  188.  
  189. rule        : rule1
  190.  
  191.         | '|' body prec
  192.  
  193.         ;
  194.  
  195. body        : /* empty */
  196.  
  197.         | body LITERAL
  198.  
  199.         | body ID
  200.                 { add_ref($2, symlineno, false); }
  201.                 | body action
  202.  
  203.         ;
  204.  
  205. action        : '{' { search('}'); } '}'
  206.  
  207.         | '=' { skip(';'); }
  208.                         /* old language feature; code must be
  209.                    single statement ending with `;' */
  210.         ;
  211.  
  212. prec        : /* empty */
  213.  
  214.         | PPREC LITERAL opt_action
  215.  
  216.         | PPREC ID
  217.                 { add_ref($2, symlineno, false); }
  218.           opt_action
  219.  
  220.         | prec ';'
  221.  
  222.         ;
  223.  
  224. opt_action    : /* empty */
  225.  
  226.         | action
  227.  
  228.         ;
  229.  
  230. %%
  231.  
  232. procedure scan ( var c : Char );
  233.   label next;
  234.   const tab = #9; nl = #10;
  235.   begin
  236. next:
  237.     c := get_char;
  238.     case c of
  239.       ' ', tab, nl: goto next;
  240.       '/': begin
  241.              c := get_char;
  242.              if c='*' then
  243.                begin
  244.                  skip('*/');
  245.                  goto next;
  246.                end
  247.              else
  248.                begin
  249.                  unget_char(c);
  250.                  unget_char('/');
  251.                  c := '/';
  252.                end;
  253.            end;
  254.       else unget_char(c);
  255.     end;
  256.   end(*scan*);
  257.  
  258. procedure skip ( delim : String );
  259.   var i, j : Integer; c : Char;
  260.   begin
  261.     i := 1;
  262.     while i<=length(delim) do
  263.       begin
  264.         c := get_char;
  265.         if c=delim[i] then
  266.           inc(i)
  267.         else if c<>#0 then
  268.           begin
  269.             for j := i-1 downto 2 do unget_char(delim[j]);
  270.             i := 1;
  271.           end
  272.         else
  273.           exit;
  274.       end;
  275.   end(*skip*);
  276.  
  277. procedure search ( delim : String );
  278.   var i, j : Integer; c : Char;
  279.   begin
  280.     i := 1;
  281.     while i<=length(delim) do
  282.       begin
  283.         c := get_char;
  284.         if c=delim[i] then
  285.           inc(i)
  286.         else if c<>#0 then
  287.           begin
  288.             for j := i-1 downto 2 do unget_char(delim[j]);
  289.             i := 1;
  290.             if c='''' then
  291.               (* skip string *)
  292.               skip('''');
  293.           end
  294.         else
  295.           exit;
  296.       end;
  297.     for i := length(delim) downto 1 do
  298.       unget_char(delim[i]);
  299.   end(*search*);
  300.  
  301. (* Lexical analyzer: *)
  302.  
  303. {$I YRefLex}
  304.  
  305. (* Main program: *)
  306.  
  307. function addExt ( filename, ext : String ) : String;
  308.   (* add default extension to filename *)
  309.   var d : DirStr; n : NameStr; e : ExtStr;
  310.   begin
  311.     fsplit(filename, d, n, e);
  312.     if e='' then e := '.'+ext;
  313.     addExt := d+n+e;
  314.   end(*addExt*);
  315.  
  316. function root ( filename : String ) : String;
  317.   (* return filename with extension stripped off *)
  318.   var d : DirStr; n : NameStr; e : ExtStr;
  319.   begin
  320.     fsplit(filename, d, n, e);
  321.     root := d+n;
  322.   end(*root*);
  323.  
  324. var result, lineno : Integer;
  325.     yfile, reffile, line : String;
  326.  
  327. begin
  328.  
  329.   (* sign-on: *)
  330.  
  331.   writeln('YREF Version 1.0 [Mar 91], Copyright (c) 1991 by Albert Graef');
  332.  
  333.   (* parse command line: *)
  334.  
  335.   case paramCount of
  336.     1 : begin
  337.           yfile   := addExt(paramStr(1), 'y');
  338.           reffile := root(paramStr(1))+'.ref';
  339.         end;
  340.     2 : begin
  341.           yfile   := addExt(paramStr(1), 'y');
  342.           reffile := addExt(paramStr(2), 'ref');
  343.         end;
  344.     else
  345.       begin
  346.         writeln('Usage: YREF yacc-file[.Y] [output-file[.REF]]');
  347.         halt(0);
  348.       end;
  349.   end;
  350.  
  351.   (* open files: *)
  352.  
  353.   assign(yyinput,  yfile);
  354.   assign(yyoutput, reffile);
  355.  
  356.   reset(yyinput);
  357.   if ioresult<>0 then
  358.     begin
  359.       writeln('cannot open file '+yfile);
  360.       halt(1);
  361.     end;
  362.  
  363.   rewrite(yyoutput);
  364.   if ioresult<>0 then
  365.     begin
  366.       writeln('cannot open file '+reffile);
  367.       halt(1);
  368.     end;
  369.  
  370.   (* produce numbered listing: *)
  371.  
  372.   lineno := 1;
  373.   while not eof(yyinput) do
  374.     begin
  375.       readln(yyinput, line); 
  376.       writeln(yyoutput, lineno:5, ':  ', line);
  377.       inc(lineno);
  378.     end;
  379.  
  380.   close(yyinput); reset(yyinput);
  381.  
  382.   (* parse: *)
  383.  
  384.   result := yyparse;
  385.  
  386.   (* produce cross reference listing *)
  387.  
  388.   if result=0 then ref_list;
  389.  
  390.   (* close files: *)
  391.  
  392.   close(yyinput); close(yyoutput);
  393.   if result>0 then erase(yyoutput);
  394.  
  395.   (* terminate: *)
  396.  
  397.   if (result=0) and (n_undef>0) then
  398.     writeln(n_undef, ' undefined symbol(s)');
  399.  
  400.   halt(result);
  401.  
  402. end.
  403.