with TEXT_IO;  use TEXT_IO; 
procedure COUNT_ADA_STATEMENTS is 
  package INT_IO is new INTEGER_IO(INTEGER);
cccccccccdddd  use INTEGER_IO; 

  FILE_NAME  : string (1..260);
  FILE_NAME_LENGTH : NATURAL;

  function LOC (FILE_NAME  : string) return integer is
  --  This function calculates the "lines of code" of a valid Ada fragment
  --  specified by a FILE_NAME string parameter
  --  It need not be a complete compilation unit
  --  but it must have closed all open parentheses and string brackets
  --  The number of lines of code is returned as an INTEGER

  --  The line of code is defined by a semicolon terminator
  --  outside of comments, parentheses, or string or character literals
  --  This definition is insensitive to formatting or layout of the source

  --  This source code of function LOC has 31 lines by this definition
  --  It has 107 physical lines in its initial formatted form
  --  including 39 lines containing only comment and 18 blank lines

  --  There are exotic cases for which this will give the wrong answer

  --  William A. Whitaker  WIS JPMO   3 March 1984

    INPUT   : file_type;
    C       : character := ' ';
    LINES   : integer := 0;
    LEVEL   : integer := 0;

  begin

    open (INPUT, in_file, FILE_NAME);

    loop
      get (INPUT, C);

      --  Check for comment on the line
      if C = '-' then
        get (INPUT, C);
        --  Which is signaled by the '-' following a '-'
        if C = '-' then
          --  Then just skip the rest of the line and go to the next
          SKIP_LINE (INPUT);
        end if;
      end if;

      --  Check for one of the characters which introduce code constructs
      --  like string or character literal or formal parameter list
      --  within which a ';' does not terminate a "line of code"
      if C = '(' or C = '"' or C = '%' or C = ''' then

        --  Check for opening parentheses
        --  Every ';' within is in a formal parameter list
        if C = '(' then
          --  Count the number of levels of parentheses
          LEVEL := LEVEL + 1;
          --  Read ahead until the whole construct is closed, LEVEL = 0
          while LEVEL > 0 loop
            get (INPUT, C);
            if C = '(' then
              --  Increase the level if another '(' is found
              LEVEL := LEVEL + 1;
            elsif C = ')' then
              --  Decrease the level if a ')' is found
              LEVEL := LEVEL - 1;
            end if;
          end loop;

        --  Now check for string brackets of either kind, " or %
        elsif C = '"' or C = '%' then
          --  Treat them in parallel, one must lead off
          if C = '"' then
            loop
              get (INPUT, C);
              --  Loop until the close comes
              --  If there is a doubled character it just starts again
              exit when C = '"';
            end loop;
          --  The '%' is handled exactly the same way as '"'
          elsif C = '%' then
            loop
              get (INPUT, C);
              exit when C = '%';
            end loop;
          end if;

        --  Character literals are just three characters long including '
        elsif C = ''' then
          get (INPUT, C);
          get (INPUT, C);
        end if;

      --  Any ';' that can be found at this point after all exclusions
      --  must be a valid "line of code" terminator
      elsif C = ';' then
        LINES := LINES + 1;

      end if;

    end loop;

  exception
    --  Return through exception since the end of file may be encountered
    --  at several levels in the function and in any case it stops and returns
    --  Otherwise one would use END_OF_FILE but here it would have to appear
    --  in a number of places to no advantage
    --  and would cause multiple exits or returns
    --  This is much cleaner
    when END_ERROR =>
      return LINES;
when NAME_ERROR =>
  new_line;
  put("NAME_ERROR in LOC "); new_line;
  if FILE_NAME(FILE_NAME'LAST-3..FILE_NAME'LAST) /= ".TXT"  then
    put("Maybe you forgot the .TXT?"); new_line;  --  System dependent
    return LOC(FILE_NAME & ".TXT");
  else
    return 0;
  end if;

  end LOC;


begin
  put("Input file name terminated by <RETURN>  => ");
  get_line(FILE_NAME, FILE_NAME_LENGTH);
  new_line; new_line;
  put (LOC (FILE_NAME(1..FILE_NAME_LENGTH))); 
  put (" ADA STATEMENTS IN FILE "); 
  put (FILE_NAME(1..FILE_NAME_LENGTH)); 
  new_line; 
end COUNT_ADA_STATEMENTS; 
