home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / misc / countada.src < prev    next >
Encoding:
Text File  |  1988-05-03  |  4.5 KB  |  136 lines
  1. with TEXT_IO;  use TEXT_IO; 
  2. procedure COUNT_ADA_STATEMENTS is 
  3.   package INT_IO is new INTEGER_IO(INTEGER);
  4. cccccccccdddd  use INTEGER_IO; 
  5.  
  6.   FILE_NAME  : string (1..260);
  7.   FILE_NAME_LENGTH : NATURAL;
  8.  
  9.   function LOC (FILE_NAME  : string) return integer is
  10.   --  This function calculates the "lines of code" of a valid Ada fragment
  11.   --  specified by a FILE_NAME string parameter
  12.   --  It need not be a complete compilation unit
  13.   --  but it must have closed all open parentheses and string brackets
  14.   --  The number of lines of code is returned as an INTEGER
  15.  
  16.   --  The line of code is defined by a semicolon terminator
  17.   --  outside of comments, parentheses, or string or character literals
  18.   --  This definition is insensitive to formatting or layout of the source
  19.  
  20.   --  This source code of function LOC has 31 lines by this definition
  21.   --  It has 107 physical lines in its initial formatted form
  22.   --  including 39 lines containing only comment and 18 blank lines
  23.  
  24.   --  There are exotic cases for which this will give the wrong answer
  25.  
  26.   --  William A. Whitaker  WIS JPMO   3 March 1984
  27.  
  28.     INPUT   : file_type;
  29.     C       : character := ' ';
  30.     LINES   : integer := 0;
  31.     LEVEL   : integer := 0;
  32.  
  33.   begin
  34.  
  35.     open (INPUT, in_file, FILE_NAME);
  36.  
  37.     loop
  38.       get (INPUT, C);
  39.  
  40.       --  Check for comment on the line
  41.       if C = '-' then
  42.         get (INPUT, C);
  43.         --  Which is signaled by the '-' following a '-'
  44.         if C = '-' then
  45.           --  Then just skip the rest of the line and go to the next
  46.           SKIP_LINE (INPUT);
  47.         end if;
  48.       end if;
  49.  
  50.       --  Check for one of the characters which introduce code constructs
  51.       --  like string or character literal or formal parameter list
  52.       --  within which a ';' does not terminate a "line of code"
  53.       if C = '(' or C = '"' or C = '%' or C = ''' then
  54.  
  55.         --  Check for opening parentheses
  56.         --  Every ';' within is in a formal parameter list
  57.         if C = '(' then
  58.           --  Count the number of levels of parentheses
  59.           LEVEL := LEVEL + 1;
  60.           --  Read ahead until the whole construct is closed, LEVEL = 0
  61.           while LEVEL > 0 loop
  62.             get (INPUT, C);
  63.             if C = '(' then
  64.               --  Increase the level if another '(' is found
  65.               LEVEL := LEVEL + 1;
  66.             elsif C = ')' then
  67.               --  Decrease the level if a ')' is found
  68.               LEVEL := LEVEL - 1;
  69.             end if;
  70.           end loop;
  71.  
  72.         --  Now check for string brackets of either kind, " or %
  73.         elsif C = '"' or C = '%' then
  74.           --  Treat them in parallel, one must lead off
  75.           if C = '"' then
  76.             loop
  77.               get (INPUT, C);
  78.               --  Loop until the close comes
  79.               --  If there is a doubled character it just starts again
  80.               exit when C = '"';
  81.             end loop;
  82.           --  The '%' is handled exactly the same way as '"'
  83.           elsif C = '%' then
  84.             loop
  85.               get (INPUT, C);
  86.               exit when C = '%';
  87.             end loop;
  88.           end if;
  89.  
  90.         --  Character literals are just three characters long including '
  91.         elsif C = ''' then
  92.           get (INPUT, C);
  93.           get (INPUT, C);
  94.         end if;
  95.  
  96.       --  Any ';' that can be found at this point after all exclusions
  97.       --  must be a valid "line of code" terminator
  98.       elsif C = ';' then
  99.         LINES := LINES + 1;
  100.  
  101.       end if;
  102.  
  103.     end loop;
  104.  
  105.   exception
  106.     --  Return through exception since the end of file may be encountered
  107.     --  at several levels in the function and in any case it stops and returns
  108.     --  Otherwise one would use END_OF_FILE but here it would have to appear
  109.     --  in a number of places to no advantage
  110.     --  and would cause multiple exits or returns
  111.     --  This is much cleaner
  112.     when END_ERROR =>
  113.       return LINES;
  114. when NAME_ERROR =>
  115.   new_line;
  116.   put("NAME_ERROR in LOC "); new_line;
  117.   if FILE_NAME(FILE_NAME'LAST-3..FILE_NAME'LAST) /= ".TXT"  then
  118.     put("Maybe you forgot the .TXT?"); new_line;  --  System dependent
  119.     return LOC(FILE_NAME & ".TXT");
  120.   else
  121.     return 0;
  122.   end if;
  123.  
  124.   end LOC;
  125.  
  126.  
  127. begin
  128.   put("Input file name terminated by <RETURN>  => ");
  129.   get_line(FILE_NAME, FILE_NAME_LENGTH);
  130.   new_line; new_line;
  131.   put (LOC (FILE_NAME(1..FILE_NAME_LENGTH))); 
  132.   put (" ADA STATEMENTS IN FILE "); 
  133.   put (FILE_NAME(1..FILE_NAME_LENGTH)); 
  134.   new_line; 
  135. end COUNT_ADA_STATEMENTS; 
  136.