--          This file is part of SmartEiffel The GNU Eiffel Compiler.
--       Copyright (C) 1994-2002 LORIA - INRIA - U.H.P. Nancy 1 - FRANCE
--          Dominique COLNET and Suzanne COLLIN - SmartEiffel@loria.fr
--                       http://SmartEiffel.loria.fr
-- SmartEiffel is  free  software;  you can  redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the Free
-- Software  Foundation;  either  version  2, or (at your option)  any  later
-- version. SmartEiffel is distributed in the hope that it will be useful,but
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or  FITNESS FOR A PARTICULAR PURPOSE.   See the GNU General Public License
-- for  more  details.  You  should  have  received a copy of the GNU General
-- Public  License  along  with  SmartEiffel;  see the file COPYING.  If not,
-- write to the  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-- Boston, MA 02111-1307, USA.
--
expanded class POSITION
   --
   -- A position in some source file. Actually the source file can be
   -- some Eiffel source file, some -cecil file or the ACE file.
   --

inherit GLOBALS

feature

   base_class: BASE_CLASS
         -- The corresponding one which may be Void for example when
         -- `is_unknown' or when parsing a -cecil file or the ACE file.

   line: INTEGER is
         -- The corresponding `line' number in the source file or 0
         -- when `is_unknown'.
      local
         bit: BIT Integer_bits
      do
         if mangling.last then
            bit := mangling |>> 1
            bit := bit and 111111111111111B
         else
            bit := mangling |>> 8
            bit := bit and 1111111111111B
         end
         Result := bit.to_integer
      ensure
         not is_unknown implies Result >= 0
      end

   column: INTEGER is
         -- The `column' number in the source file or 0 when `is_unknown' or
         -- when there is not enough space in `mangling' for the `column'.
      local
         bit: BIT Integer_bits
      do
         if mangling.last then
            -- Result is 0 because `column' is not memorized.
         else
            bit := mangling |>> 1; -- To drop the flag.
            bit := bit and 1111111B
            Result := bit.to_integer
         end
      ensure
         Result >= 0
      end

   base_class_name: CLASS_NAME is
         -- The corresponding one when already loaded by the `eiffel_parser'.
      local
         bc: BASE_CLASS
      do
         bc := base_class
         if bc /= Void then
            Result := bc.name
         end
      end

   path: STRING is
         -- The corresponding file `path' or Void when `is_unknown'.
      local
         bc: BASE_CLASS
         id_value: INTEGER
      do
         bc := base_class
         if bc /= Void then
            Result := bc.path
         end
         if Result = Void then
            -- Looking for the path of the -cecil file or for the
            -- path of some ACE file.
            id_value := id
            if id /= 0 then
               Result := id_provider.alias_of(id)
	    else
	       Result := ace.file_path
	    end
         end
      ensure
         Result /= Void implies string_aliaser.item(Result) = Result
      end

   is_unknown: BOOLEAN is
         -- True when the `eiffel_parser' as called `set'.
      do
         Result := mangling.to_integer = 0
      end

   before(other: like Current): BOOLEAN is
         -- Is `Current' position strictly before `other' (which is in the
         -- same source text file).
      require
         path = other.path
      local
         li, other_li: INTEGER
      do
         li := line
         other_li := other.line
         if li < other_li then
            Result := true
         elseif li = other_li then
            Result := column < other.column
         end
      end

   sedb_trace: BOOLEAN is
	 -- Is the run-time trace mechanism activated for this position?
      local
	 bc: BASE_CLASS
      do
	 bc := base_class
	 if bc /= Void then
	    Result := bc.sedb_trace
	 end
      end

   show is
      require
	 not smart_eiffel.no_file_for(base_class_name.to_string)
      local
         li, co, nb: INTEGER; bc: BASE_CLASS; bcn: CLASS_NAME
         name, file_path, the_line: STRING
      do
         li := line
         co := column
         bc := base_class
         if bc /= Void then
            check id = bc.id end
            bcn := base_class_name
         end
         if bcn /= Void then
            name := bcn.to_string
            file_path := bc.path
         end
	 if file_path = Void and then id = 0 then
	    file_path := ace.file_path
	 end
         echo.w_put_string("Line ")
         echo.w_put_integer(li)
         if co > 0 then
            echo.w_put_string(" column ")
            echo.w_put_integer(co)
         end
         echo.w_put_string(" in ")
         if name /= Void then
            echo.w_put_string(name)
         end
         if file_path /= Void then
            echo.w_put_string(" (")
            echo.w_put_string(file_path)
            echo.w_put_character(')')
         end
         echo.w_put_string(" :%N")
         if file_path /= Void then
            the_line := get_line(file_path,li)
            if li > 0 and then the_line /= Void then
               echo.w_put_string(the_line)
               echo.w_put_character('%N')
               if co > 0 then
                  from
                     nb := 1
                  until
                     nb >= co
                  loop
                     if the_line.item(nb) = '%T' then
                        echo.w_put_character('%T')
                     else
                        echo.w_put_character(' ')
                     end
                     nb := nb + 1
                  end
                  echo.w_put_string("^%N")
               end
            end
         end
      end

   append_in(buffer: STRING) is
      require
         buffer /= Void
      local
         li, co: INTEGER; bc: BASE_CLASS; bcn: CLASS_NAME; place: STRING
      do
         li := line
         co := column
         buffer.append("Line ")
         li.append_in(buffer)
         if co > 0 then
            buffer.append(" column ")
            co.append_in(buffer)
         end
         bc := base_class
         if bc /= Void then
            place := bc.path
            if place = Void then
               bcn := bc.name
               if bcn /= Void then
                  place := bcn.to_string
               end
            end
            if place /= Void then
               buffer.append(" in %"")
               buffer.append(place)
               buffer.append(fz_03)
            end
         end
      end

   set_in(bc: like base_class) is
	 -- Assign `Current' in `bc'. This routine is used to create implicit
	 -- Eiffel code. As an example, this is used to define pseudo
	 -- code of class TUPLE which is not truly written.
      require
	 smart_eiffel.no_file_for(bc.name.to_string)
      do
	 eiffel_file(1,1,bc.id,bc)
      end

feature {EIFFEL_PARSER}

   eiffel_file(li, co, class_id: INTEGER; bc: like base_class) is
	 -- The position is in some Eiffel file.
      require
         li >= 1
         co >= 1
         class_id >= 0
      do
         base_class := bc
         check Integer_bits >= 32 end
         if class_id <= 2047 and then li <= 8191 and then co <= 127 then
            mangling := (class_id.to_bit |<< 21);       -- 11 bits for `id'
            mangling := mangling or (li.to_bit |<< 8);  -- 13 bits for `line'
            mangling := mangling or (co.to_bit |<< 1);  -- 7  bits for `column'
         else
            -- The `column' is not memorized.
            mangling := (class_id.to_bit |<< 17);       -- 15 bits for `id'
            mangling := mangling or (li.to_bit |<< 1);  -- 16 bits for `line'
            mangling := mangling or (1).to_bit;         -- forget `column'.
         end
      ensure
         line = li
         id = class_id
         column = 0 or else column = co
      end

feature {ACE}

   ace_file(li, co: INTEGER) is
	 -- The position is in the ACE file.
      require
         li >= 1; co >= 1
      do
         eiffel_file(li,co,0,Void)
      ensure
         line = li
         id = 0
         column = 0 or else column = co
      end


feature {C_PRETTY_PRINTER,E_AGENT}

   mangling: BIT Integer_bits
         -- In order to save memory (there are a lot of objects like `Current'),
         -- the `id' of the class, the `line' and the `column' are saved in this
         -- BIT sequence. Two mangling are used, and the `column' may be
         -- dropped (not memorized, see `set'). This implementation assume
         -- that `Integer_bits' is greater or equal to 32.

feature {NONE}

   id: INTEGER is
      do
         if mangling.last then
            Result := (mangling |>> 17).to_integer
         else
            Result := (mangling |>> 21).to_integer
         end
      ensure
         Result >= 0
      end

   get_line(file_path: STRING; li: INTEGER): STRING is
      require
         not file_path.is_empty
         li > 0
      local
         i: INTEGER
      do
         echo.tfr_connect(tmp_file_read,file_path)
         if tmp_file_read.is_connected then
            from until tmp_file_read.end_of_input or else i = li
            loop
               tmp_file_read.read_line
               i := i + 1
            end
            if not tmp_file_read.end_of_input then
               Result := tmp_file_read.last_string
            end
            tmp_file_read.disconnect
         end
      end

end -- POSITION
