home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / LEX_YACC.ZIP / CREF.L next >
Encoding:
Text File  |  1989-05-28  |  5.7 KB  |  191 lines
  1. %{
  2. (* CREF.L: simple Turbo Pascal cross reference utility
  3.    USAGE: cref <input-file >output-file
  4.    DESCRIPTION: Produces a cross reference listing from the input-file
  5.      (.pas suffix must be specified), written to the output-file (if source
  6.      and target file redirection is ommitted, input comes from stdin, and
  7.      output goes to stdout)
  8.    EXAMPLE: cref <myprog.pas >prn *)
  9.  
  10. program cref;
  11.   uses LexLib;
  12.   type Ident = string[80];
  13.   function upper(id : Ident) : Ident; forward;
  14.     (* converts id to uppercase *)
  15.   function is_keyword(id : Ident) : boolean; forward;
  16.     (* checks whether id is a Turbo Pascal keyword *)
  17.   procedure enter(id : Ident; lineno : integer); forward;
  18.     (* enter id and lineno into binary tree, sorted in lexical order of
  19.        identifiers *)
  20.   procedure print; forward;
  21.     (* prints out the binary tree in inorder *)
  22. %}
  23.  
  24. %start code str comment1 comment2
  25.  
  26. letter                [A-Za-z_]
  27. digit                [0-9]
  28.  
  29. %%
  30.  
  31.   { print line numbers: }
  32.  
  33. \n                begin
  34.                   echo;
  35.                   write(yyout, yylineno:4, ': ')
  36.                 end;
  37.  
  38.   { echo keywords and enter identifier occurrences into binary tree
  39.     (converted to uppercase): }
  40.  
  41. <code>{letter}({letter}|{digit})*
  42.                 begin
  43.                   echo;
  44.                   if not is_keyword(yytext) then
  45.                     enter(upper(yytext), yylineno)
  46.                 end;
  47.  
  48.   { rules to handle strings, comments, and hexadecimals: }
  49.  
  50. <code>'                begin echo; begin_(str) end;
  51. <str>''                echo;
  52. <str>'                begin echo; begin_(code) end;
  53. <code>"(*"            begin echo; begin_(comment1) end;
  54. <code>"{"            begin echo; begin_(comment2) end;
  55. <comment1>"*)"            begin echo; begin_(code) end;
  56. <comment2>"}"                begin echo; begin_(code) end;
  57. <code>"$"({digit}|[A-Fa-f])+    echo;
  58.  
  59. %%
  60.  
  61. function upper(id : Ident) : Ident;
  62.   var i : integer;
  63.   begin
  64.     for i := 1 to length(id) do
  65.       id[i] := upCase(id[i]);
  66.     upper := id
  67.   end(*upper*);
  68. function is_keyword(id : Ident) : boolean;
  69.   (* table of Turbo Pascal keywords: *)
  70.   const
  71.     no_of_keywords = 48;
  72.     keyword : array [1..no_of_keywords] of Ident = (
  73.       'ABSOLUTE',  'AND',       'ARRAY',     'BEGIN',          'CASE',
  74.       'CONST',     'DIV',       'DO',        'DOWNTO',         'ELSE',
  75.       'END',       'EXTERNAL',  'FILE',      'FOR',            'FORWARD',
  76.       'FUNCTION',  'GOTO',      'IF',        'IMPLEMENTATION', 'IN',
  77.       'INLINE',    'INTERFACE', 'INTERRUPT', 'LABEL',          'MOD',
  78.       'NIL',       'NOT',       'OF',        'OR',             'PACKED',
  79.       'PROCEDURE', 'PROGRAM',   'RECORD',    'REPEAT',         'SET',
  80.       'SHL',       'SHR',       'STRING',    'THEN',           'TO',
  81.       'TYPE',      'UNIT',      'UNTIL',     'USES',           'VAR',
  82.       'WHILE',     'WITH',      'XOR');
  83.   var m, n, k : integer;
  84.   begin
  85.     id := upper(id);
  86.     m := 1; n := no_of_keywords;
  87.     is_keyword := true;
  88.     while m<=n do
  89.       begin
  90.         k := m+(n-m) div 2;
  91.         if id=keyword[k] then
  92.           exit
  93.         else if id>keyword[k] then
  94.           m := k+1
  95.         else
  96.           n := k-1
  97.       end;
  98.     is_keyword := false
  99.   end(*is_keyword*);
  100. type
  101.   (* binary tree for identifiers, sorted in lexical order of idents,
  102.      and linked list of integers (line numbers) *)
  103.   BinTree = ^TreeNode;
  104.   IntList = ^ListNode;
  105.   TreeNode = record
  106.                id : Ident;
  107.                linenos : IntList;
  108.                left, right : BinTree;
  109.              end;
  110.   ListNode = record
  111.            lineno : integer;
  112.            next : IntList
  113.          end;
  114. var
  115.   tree : BinTree;
  116.   (* binary tree to store identifier occurrences *)
  117. procedure enter(id : Ident; lineno : integer);
  118.   procedure enter_id(var tree : BinTree; id : Ident; lineno : integer);
  119.     (* enter id, lineno into tree *)
  120.     procedure enter_lineno(var linenos : IntList; lineno : integer);
  121.       (* append lineno to linenos *)
  122.       begin
  123.         if linenos=nil then
  124.           begin
  125.             new(linenos);
  126.             linenos^.lineno := lineno;
  127.             linenos^.next := nil
  128.           end
  129.         else
  130.           enter_lineno(linenos^.next, lineno)
  131.       end(*enter_lineno*);
  132.     begin
  133.       if tree=nil then
  134.         (* add new leave *)
  135.         begin
  136.           new(tree);
  137.           tree^.id := id;
  138.           tree^.linenos := nil;
  139.           tree^.left := nil; tree^.right := nil;
  140.           enter_lineno(tree^.linenos, lineno)
  141.         end
  142.       else if tree^.id=id then
  143.         (* add lineno to the linenos list of this node *)
  144.         enter_lineno(tree^.linenos, lineno)
  145.       else if tree^.id>id then
  146.         (* enter into left subtree *)
  147.         enter_id(tree^.left, id, lineno)
  148.       else
  149.         (* enter into right subtree *)
  150.         enter_id(tree^.right, id, lineno)
  151.     end(*enter_id*);
  152.   begin
  153.     enter_id(tree, id, lineno)
  154.   end(*enter*);
  155. procedure print;
  156.   procedure print_ids(tree : BinTree);
  157.     (* print out tree (inorder) *)
  158.     procedure print_linenos(linenos : IntList);
  159.       (* print linenos list *)
  160.       begin
  161.         if linenos<>nil then with linenos^ do
  162.           begin
  163.             write(yyout, lineno, ' ');
  164.             print_linenos(next)
  165.           end
  166.       end(*print_linenos*);
  167.     begin
  168.       if tree<>nil then with tree^ do
  169.         begin
  170.           print_ids(left);
  171.           write(yyout, '      ', id, '   ');
  172.           print_linenos(linenos);
  173.           writeln(yyout);
  174.           print_ids(right)
  175.         end
  176.     end(*print_ids*);
  177.   begin
  178.     writeln(yyout);
  179.     writeln(yyout);
  180.     print_ids(tree);
  181.   end(*print*);
  182. begin
  183.   (* initialize binary tree, print line counter: *)
  184.   tree := nil;
  185.   write(yyout, yylineno:4, ': ');
  186.   (* process file with yylex and print out cref list contained in binary
  187.      tree *)
  188.   begin_(code);
  189.   if yylex=0 then ;
  190.   print
  191. end.