-- This file is  free  software, which  comes  along  with  SmallEiffel. This
-- software  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. You can modify it as you want, provided
-- this header is kept unaltered, and a notification of the changes is added.
-- You  are  allowed  to  redistribute  it and sell it, alone or as a part of 
-- another product.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - colnet@loria.fr 
--                       http://www.loria.fr/SmallEiffel
--
expanded class NATIVE_ARRAY[E]
--
-- This class gives access to the lowest level for arrays both
-- for the C language and Java language.
-- 
-- Warning : using this class makes your Eiffel code non
-- portable on other Eiffel systems.
-- This class may also be modified in further release for a better
-- interoperability between Java and C low level arrays.
--

feature -- Basic features :

   element_sizeof: INTEGER is
	 -- The size in number of bytes for type `E'.
      external "SmallEiffel"
      end;

   calloc(nb_elements: INTEGER): like Current is
	 -- Allocate a new array of `nb_elements' of type `E'.
	 -- The new array is initialized with default values.
      external "SmallEiffel"
      end;

   item(index: INTEGER): E is
	 -- To read an `item'.
	 -- Assume that `calloc' is already done and that `index'
	 -- is the range [0 .. nb_elements-1].
      external "SmallEiffel"
      end;

   put(element: E; index: INTEGER) is
	 -- To write an item.
	 -- Assume that `calloc' is already done and that `index'
	 -- is the range [0 .. nb_elements-1].
      external "SmallEiffel"
      end;

feature 

   realloc(old_nb_elts, new_nb_elts: INTEGER): like Current is
	 -- Assume Current is a valid NATIVE_ARRAY in range 
	 -- [0 .. `old_nb_elts'-1]. Allocate a bigger new array in
	 -- range [0 .. `new_nb_elts'-1].
	 -- Old range is copied in the new allocated array.
	 -- No initialization done for new items in C.
	 -- Initialization is done for Java.
	 --
      require
	 to_pointer.is_not_void;
	 old_nb_elts < new_nb_elts
      do
	 Result := calloc(new_nb_elts);
	 Result.copy_from(Current,old_nb_elts - 1);
      end;

feature -- Comparison :

   memcmp(other: like Current; capacity: INTEGER): BOOLEAN is
	 -- True if all elements in range [0..capacity-1] are
	 -- identical using `equal'. Assume Current and `other' 
	 -- are big enough. 
	 -- See also `fast_memcmp'.
      require
	 capacity > 0 implies other.to_pointer.is_not_void
      local
	 i: INTEGER;
      do
	 from
	    Result := true;
	    i := capacity - 1;
	 until
	    i < 0 or else not Result
	 loop
	    Result := equal_like(item(i),other.item(i));
	    i := i - 1;
	 end;
      end;

   fast_memcmp(other: like Current; capacity: INTEGER): BOOLEAN is
	 -- Same jobs as `memcmp' but uses infix "=" instead `equal'.
      require
	 capacity > 0 implies other.to_pointer.is_not_void
      local
	 i: INTEGER;
      do
	 from
	    Result := true;
	    i := capacity - 1;
	 until
	    i < 0 or else not Result
	 loop
	    Result := item(i) = other.item(i);
	    i := i - 1;
	 end;
      end;

feature -- Searching :

   index_of(element: like item; upper: INTEGER): INTEGER is
	 -- Give the index of the first occurrence of `element' using
	 -- `is_equal' for comparison.
	 -- Answer `upper + 1' when `element' is not inside.
      require
	 upper >= -1
      do
	 from  
	 until
	    Result > upper or else equal_like(element,item(Result))
	 loop
	    Result := Result + 1;
	 end;
      end;

   fast_index_of(element: like item; upper: INTEGER): INTEGER is
	 -- Same as `index_of' but use basic `=' for comparison.
      require
	 upper >= -1
      do
	 from  
	 until
	    Result > upper or else element = item(Result)
	 loop
	    Result := Result + 1;
	 end;
      end;

feature -- Removing :

   remove_first(upper: INTEGER) is
	 -- Assume `upper' is a valid index.
	 -- Move range [1 .. `upper'] by 1 position left.
      require
	 upper >= 0
      local
	 i: INTEGER;
      do
	 from 
	 until
	    i = upper
	 loop
	    put(item(i + 1),i);
	    i := i + 1;
	 end;
      end;

   remove(index, upper: INTEGER) is
	 -- Assume `upper' is a valid index.
	 -- Move range [`index' + 1 .. `upper'] by 1 position left.
      require
	 index >= 0;
	 index <= upper
      local
	 i: INTEGER;
      do
	 from 
	    i := index;
	 until
	    i = upper
	 loop
	    put(item(i + 1),i);
	    i := i + 1;
	 end;
      end;

feature -- Replacing :

   replace_all(old_value, new_value: like item; upper: INTEGER) is
      	 -- Replace all occurences of the element `old_value' by `new_value' 
	 -- using `is_equal' for comparison.
	 -- See also `fast_replace_all' to choose the apropriate one.
      require
	 upper >= -1
      local
	 i: INTEGER;
      do
	 from
	    i := upper;
	 until
	    i < 0
	 loop
	    if equal_like(old_value,item(i)) then
	       put(new_value,i);
	    end;
	    i := i - 1;
	 end;
      end;


   fast_replace_all(old_value, new_value: like item; upper: INTEGER) is
      	 -- Replace all occurences of the element `old_value' by `new_value' 
	 -- using basic `=' for comparison.
	 -- See also `replace_all' to choose the apropriate one.
      require
	 upper >= -1
      local
	 i: INTEGER;
      do
	 from
	    i := upper;
	 until
	    i < 0
	 loop
	    if old_value = item(i) then
	       put(new_value,i);
	    end;
	    i := i - 1;
	 end;
      end;

feature -- Adding :

   copy_at(start_index: INTEGER; model: like Current; model_capacity: INTEGER) is
	 -- Copy range [0 .. model_capacity-1] of `model' starting to 
	 -- write at `start_index' of Current.
	 -- Range [start_index .. start_index+model_capacity] of 
	 -- Current is affected (assume Current is large enough).
      require
	 start_index >= 0;
	 model_capacity >= 0;
	 model_capacity > 0 implies model.to_pointer.is_not_void
      local
	 i1, i2: INTEGER;
      do
	 from
	    i1 := start_index;
	 until
	    i2 = model_capacity
	 loop
	    put(model.item(i2),i1);
	    i2 := i2 + 1;
	    i1 := i1 + 1;
	 end;
      end;

feature -- Other :

   set_all_with(v: like item; upper: INTEGER) is
	 -- Set all elements in range [0 .. upper] with
	 -- value `v'.
      local
	 i: INTEGER;
      do
	 from
	    i := upper;
	 until
	    i < 0
	 loop
	    put(v,i);
	    i := i - 1;
	 end;
      end;

   clear_all(upper: INTEGER) is
	 -- Set all elements in range [0 .. `upper'] with
	 -- the default value.
      local
	 v: E;
	 i: INTEGER;
      do
	 from
	    i := upper;
	 until
	    i < 0
	 loop
	    put(v,i);
	    i := i - 1;
	 end;
      end;

   clear(lower, upper: INTEGER) is
	 -- Set all elements in range [`lower' .. `upper'] with
	 -- the default value
      require
         lower >= 0;
         upper >= lower
      local
         v: E;
         i: INTEGER;
      do
         from
            i := lower
         until
            i > upper
         loop
            put(v, i);
            i := i + 1;
         end
      end

   copy_from(model: like Current; upper: INTEGER) is
	 -- Assume `upper' is a valid index both in Current
	 -- and `model'.
      local
	 i: INTEGER;
      do
	 from
	    i := upper;
	 until
	    i < 0
	 loop
	    put(model.item(i),i);
	    i := i - 1;
	 end;
      end;

   move(lower, upper, offset: INTEGER) is
	 -- Move range [`lower' .. `upper'] by `offset' positions.
	 -- Freed positions are not initialized to default values.
      require
         lower >= 0;
         upper >= lower;
         lower + offset >= 0
      local
         i: INTEGER;
      do
         if offset = 0 then
         elseif offset < 0 then
            from
               i := lower;
            until
               i > upper
            loop
               put(item(i), i + offset);
               i := i + 1;
            end
         else
            from
               i := upper;
            until
               i < lower
            loop
               put(item(i), i + offset);
               i := i - 1;
            end
         end
      end

   nb_occurrences(element: like item; upper: INTEGER): INTEGER is
	 -- Number of occurrences of `element' in range [0..upper]
	 -- using `equal' for comparison.
	 -- See also `fast_nb_occurrences' to chose the apropriate one.
      local
	 i: INTEGER;
      do
	 from  
	    i := upper;
	 until
	    i < 0
	 loop
	    if equal_like(element,item(i)) then
	       Result := Result + 1;
	    end;
	    i := i - 1;
	 end;
      end;

   fast_nb_occurrences(element: like item; upper: INTEGER): INTEGER is
	 -- Number of occurrences of `element' in range [0..upper]
	 -- using basic "=" for comparison.
	 -- See also `fast_nb_occurrences' to chose the apropriate one.
      local
	 i: INTEGER;
      do
	 from  
	    i := upper;
	 until
	    i < 0
	 loop
	    if element = item(i) then
	       Result := Result + 1;
	    end;
	    i := i - 1;
	 end;
      end;

   all_cleared(upper: INTEGER): BOOLEAN is
	 -- Are all items in range [0..upper] set to default
	 -- values?
      require
	 upper >= -1
      local
	 i: INTEGER;
	 model: like item;
      do
	 from
	    Result := true;
	    i := upper;
	 until
	    i < 0 or else not Result
	 loop
	    Result := model = item(i)
	    i := i - 1;
	 end;
      end;

feature -- The Guru section :

   free is
	 -- Do nothing when producing Java byte code.
	 -- Do what's to be done when producing C code (depends
	 -- on GC is on or off).
      obsolete "Replaced by automatic Garbage Collection. %
             %Will be removed in the next release."
      do
      end;

feature -- Interfacing with C :

   to_external: POINTER is
	 -- Gives access to the C pointer on the area of storage.
      do
	 Result := to_pointer;
      end;

   from_pointer(pointer: POINTER): like Current is
	 -- Convert `pointer' into Current type.
      external "SmallEiffel"
      end;

   is_not_void: BOOLEAN is
      do
	 Result := to_pointer.is_not_void;
      end;

feature -- For C only :

   bytes_malloc(nb_bytes: INTEGER): like Current is
      obsolete "Will be removed in the next release."
      external "C_InlineWithoutCurrent"
      alias "malloc"
      end;

feature {NONE}

   frozen equal_like(e1, e2: like item): BOOLEAN is
	 -- Note: this feature is called to avoid calling `equal'
	 -- on expanded types (no automatic conversion to 
	 -- corresponding reference type).
      do
	 if e1.is_basic_expanded_type then
	    Result := e1 = e2;
	 elseif e1.is_expanded_type then
	    Result := e1.is_equal(e2);
	 elseif e1 = e2 then
	    Result := true;
	 elseif e1 = Void or else e2 = Void then
	 else
	    Result := e1.is_equal(e2);
	 end;
      end;

end -- NATIVE_ARRAY[E]