AmigActive 3/AACD03.BIN/AACD/Programming/sofa/archive/SmallEiffel.lha/SmallEiffel/lib_std/native_array.e

Text File | 1999-06-05 | 14KB | 514 lines

-- 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 - [e-mail]
--                       http://SmallEiffel.loria.fr
--
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
         is_not_null;
         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.is_not_null
      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.is_not_null
      local
         i: INTEGER;
      do
         from
            Result := true;
            i := capacity - 1;
         until
            i < 0
         loop
            if item(i) = other.item(i) then
               i := i - 1;
            else
               Result := false;
               i := -1;
            end;
         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;

   has(element: like item; upper: INTEGER): BOOLEAN is
         -- Look for `element' using `is_equal' for comparison.
         -- Also consider `has' to choose the most appropriate.
      require
         upper >= -1
      local
         i: INTEGER;
      do
         from
            i := upper;
         until
            Result or else i < 0
         loop
            Result := equal_like(element,item(i));
            i := i - 1;
         end;
      end;

   fast_has(element: like item; upper: INTEGER): BOOLEAN is
         -- Look for `element' using basic `=' for comparison.
         -- Also consider `has' to choose the most appropriate.
      require
         upper >= -1
      local
         i: INTEGER;
      do
         from
            i := upper;
         until
            Result or else i < 0
         loop
            Result := element = item(i);
            i := i - 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.is_not_null
      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 "Since release -0.81, the Garbage Collector is %
               %implemented. This feature will be soon removed."
      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_null: BOOLEAN is
      do
         Result := to_pointer.is_not_null;
      end;

   is_not_void: BOOLEAN is
      obsolete "This feature will be soon removed. %
               %Since release -0.78, the new name for this feature %
               %is `is_not_null'. Please, update your code."
      do
         Result := is_not_null;
      end;

feature -- For C only :

   bytes_malloc(nb_bytes: INTEGER): like Current is
      obsolete "This dangerous feature will be soon removed. %
               %Please, update your code."
      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]