File : asgc-ordered-alist-expandable_managed.adb


-- The Ada Structured Library - A set of container classes and general
--   tools for use with Ada95.
-- Copyright (C) 1998-1999  Corey Minyard (minyard@acm.org)
--
-- This library 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 of the License, or (at your
-- option) any later version.
--
-- This library 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 this library; if not, write to the Free Software Foundation, Inc.,
-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be
-- covered by the GNU General Public License.  This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
--

with Ada.Unchecked_Deallocation;

package body Asgc.Ordered.Alist.Expandable_Managed is

   procedure Free_Iterator is new Ada.Unchecked_Deallocation (Iterator,
                                                              Iterator_Ptr);

   procedure Free is new Ada.Unchecked_Deallocation (Vector_Array,
                                                     Vector_Array_Ptr);

   -- An Array List (AList) is a circular data structure implemented with
   -- an array.  It has a Head and a Tail.  The Head is the first item in
   -- the list and the Tail is one past the end of the list.  Because of
   -- this layout, if Head and Tail are equal then the list is empty.
   -- However, this means that the code here must always leave one empty
   -- item in the list, since if the last element was filled in then Head
   -- would equal Tail again.
   --
   -- When operating on this data structure, remember that the data can
   -- "wrap" around the end of the array.  So we might have the instance:
   --
   --              Head               Tail
   --   +-------------------------------------------------+
   --   +            |******************|                 +
   --   +-------------------------------------------------+
   --
   -- which is the easy case, where Head < Tail.  However, if we have a
   -- wrap, we have something like:
   --
   --              Tail               Head
   --   +-------------------------------------------------+
   --   +************|                  |*****************+
   --   +-------------------------------------------------+
   --
   -- where Tail < Head.
   --


   ------------------------------------------------------------------------
   -- Move to the next value in the object, wrapping around the array if
   -- necessary.
   function Next (O : in Object'Class;
                  V : in Positive)
                  return Positive is
   begin
      if (V = O.Data.all'Last) then
         return O.Data.all'First;
      else
         return V + 1;
      end if;
   end Next;

   ------------------------------------------------------------------------
   -- Move to the previous value in the object, wrapping around the array
   -- if necessary.
   function Prev (O : in Object'Class;
                  V : in Positive)
                  return Positive is
   begin
      if (V = O.Data.all'First) then
         return O.Data.all'Last;
      else
         return V - 1;
      end if;
   end Prev;


   ------------------------------------------------------------------------
   -- Increase the size of an expandable vector.
   procedure Increase_Vector_Size (O : in out Object'Class) is
      New_Vector : Vector_Array_Ptr;
      Last_Entry : Positive;
      New_Head   : Positive;
   begin
      if (O.Increment = 0) then
         raise Container_Full;
      end if;

      Last_Entry := Prev(O, O.Tail);
      New_Vector := new Vector_Array(1 .. O.Data.all'Last + O.Increment);
      if (O.Head < Last_Entry) then
         New_Vector.all(1 .. O.Data'Last) := O.Data.all;
         O.Tail := Next(O, Last_Entry);
      else
         New_Head := O.Head + O.Increment;
         New_Vector.all(1 .. Last_Entry) := O.Data.all(1 .. Last_Entry);
         New_Vector.all(New_Head .. New_Vector.all'Last)
           := O.Data.all(O.Head .. O.Data.all'Last);
         O.Head := New_Head;
      end if;
      Free(O.Data);
      O.Data := New_Vector;
   end Increase_Vector_Size;


   ------------------------------------------------------------------------
   -- Check that an object is valid, that is has not been freed.  This is
   -- not a perfect check, but will hopefully help find some bugs.
   procedure Check_Object (O : in Object'Class) is
   begin
      if (O.Is_Free) then
         raise Object_Free;
      end if;
   end Check_Object;


   ------------------------------------------------------------------------
   -- Check that an iterator is valid.  It must not have been freed, it
   -- must be initialized, its object must be valid, and it must not have
   -- been modified since the last time the iterator was positioned.
   procedure Check_Iterator (Iter : in Iterator) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);

      if (Iter.Update /= Iter.Robj.Update) then
         raise Object_Updated;
      end if;

      if (Iter.Robj.Head < Iter.Robj.Tail) then
         if ((Iter.Pos < Iter.Robj.Head) or (Iter.Pos >= Iter.Robj.Tail)) then
            raise Invalid_Iterator;
         end if;
      elsif (Iter.Robj.Head > Iter.Robj.Tail) then
         if ((Iter.Pos < Iter.Robj.Head) and (Iter.Pos >= Iter.Robj.Tail)) then
            raise Invalid_Iterator;
         end if;
      else
         raise Invalid_Iterator;
      end if;
   end Check_Iterator;


   ------------------------------------------------------------------------
   -- Check that an iterator is valid.  It must not have been freed, it
   -- must be initialized, its object must be valid, and it must not have
   -- been modified since the last time the iterator was positioned.
   -- This routine allows the object to be empty.
   procedure Check_Iterator_Empty_Ok (Iter : in Iterator) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);

      if (Iter.Update /= Iter.Robj.Update) then
         raise Object_Updated;
      end if;

      if (Iter.Robj.Head < Iter.Robj.Tail) then
         if ((Iter.Pos < Iter.Robj.Head) or (Iter.Pos >= Iter.Robj.Tail)) then
            raise Invalid_Iterator;
         end if;
      elsif (Iter.Robj.Head > Iter.Robj.Tail) then
         if ((Iter.Pos < Iter.Robj.Head) and (Iter.Pos >= Iter.Robj.Tail)) then
            raise Invalid_Iterator;
         end if;
      end if;
   end Check_Iterator_Empty_Ok;


   ------------------------------------------------------------------------
   -- Check an iterator, but don't bother checking its positions.  This is
   -- primarily for methods that set some the position of the iterator.
   procedure Check_Iterator_No_Pos (Iter : in Iterator) is
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      if (Iter.Robj = null) then
         raise Invalid_Iterator;
      end if;

      Check_Object(Iter.Robj.all);
   end Check_Iterator_No_Pos;


   ------------------------------------------------------------------------
   -- Return the number of items in the container, doing special
   -- calculations if it is a wrap.
   function Count (O : in Object'Class) return Natural is
   begin
      if (O.Head <= O.Tail) then
         return O.Tail - O.Head;
      else
         return ((O.Data.all'Last - O.Head + 1)
                 + (O.Tail - O.Data.all'First));
      end if;
   end Count;


   ------------------------------------------------------------------------
   -- Convert a location in the container (the Nth item in the container
   -- from the user's point of view) into an index into the array.
   function Get_Pos (O   : in Object'Class;
                     Loc : in Positive)
                     return Positive is
      Pos : Positive;
   begin
      if (Loc > Count(O)) then
         raise Constraint_Error;
      end if;

      Pos := O.Head + Loc - 1;
      if (Pos > O.Data.all'Last) then
         Pos := Pos - O.Data.all'Last;
      end if;

      return Pos;
   end Get_Pos;


   ------------------------------------------------------------------------
   -- Convert a location in the container (the Nth item in the container
   -- from the user's point of view) into an index into the array.  Allow
   -- it to go one past the end for addition of elements.
   function Get_Pos_Allow_Addition (O   : in Object'Class;
                                    Loc : in Positive)
                                    return Positive is
      Pos : Positive;
   begin
      if (Loc > (Count(O) + 1)) then
         raise Constraint_Error;
      end if;

      Pos := O.Head + Loc - 1;
      if (Pos > O.Data.all'Last) then
         Pos := Pos - O.Data.all'Last;
      end if;

      return Pos;
   end Get_Pos_Allow_Addition;


   ------------------------------------------------------------------------
   -- Convert an array index into a location in the container.
   function Get_Loc (O   : in Object'Class;
                     Pos : in Positive)
                     return Natural is
      Loc : Positive;
   begin
      if (Pos < O.Head) then
         -- It's a wrap around case.
         Loc := ((Pos - O.Data.all'First)
                 + (O.Data.all'Last - O.Head)
                 + 2);
      else
         Loc := Pos - O.Head + 1;
      end if;

      return Loc;
   end Get_Loc;


   ------------------------------------------------------------------------
   -- Add an item at the specified position in the array.  Although the
   -- location (Loc) of the value will not be changed, the position (Pos)
   -- might be moved depending on how the operation worked.  The new Pos
   -- is returned in that parameter.
   procedure Perform_Add (O   : in out Object'Class;
                          Loc : in Positive;
                          Pos : in out Positive;
                          Val : in Contained_Type) is
      After_Tail : Positive;
      Prev_Pos   : Positive;
      Curr_Pos   : Positive;
   begin
      After_Tail := Next(O, O.Tail);
      if (After_Tail = O.Head) then
         -- Container is full.
         Increase_Vector_Size(O);
         After_Tail := Next(O, O.Tail);
         Pos := Get_Pos_Allow_Addition(O, Loc);
      end if;

      if (Pos = O.Tail) then
         -- Optimize for tail, just add it at the end.
         O.Tail := After_Tail;
      elsif (Pos = O.Head) then
         -- Optimize for head, just move the head index back one and put it
         -- there.
         Pos := Prev(O, Pos);
         O.Head := Pos;
      elsif (Loc < (Count(O) / 2)) then
         -- We are putting it in the first half of the data, so it is less
         -- work to move the beginning data back one.
         Pos := Prev(O, Pos);
         Prev_Pos := Prev(O, O.Head);
         Curr_Pos := O.Head;
         O.Head := Prev_Pos;
         loop
            O.Data(Prev_Pos) := O.Data(Curr_Pos);
            exit when (Curr_Pos = Pos);
            Prev_Pos := Curr_Pos;
            Curr_Pos := Next(O, Curr_Pos);
         end loop;
      else
         -- We are putting it in the second half of the data, so move
         -- everything after the position forward one.
         Prev_Pos := O.Tail;
         Curr_Pos := Prev(O, O.Tail);
         loop
            O.Data(Prev_Pos) := O.Data(Curr_Pos);
            exit when (Curr_Pos = Pos);
            Prev_Pos := Curr_Pos;
            Curr_Pos := Prev(O, Curr_Pos);
         end loop;
         O.Tail := After_Tail;
      end if;
      O.Data(Pos) := Val;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Added(O.Cb, O, O.Data(Pos));
      end if;
   end Perform_Add;

   ------------------------------------------------------------------------
   -- Delete the specified position in the array.  The Pos will reference
   -- the next position in the array after the value was removed, unless
   -- we delete the tail.
   procedure Delete_Pos (O   : in out Object'Class;
                         Pos : in out Positive;
                         Loc : in Positive) is
      Deleted_Val : Contained_Type;
      Prev_Pos    : Positive;
      Curr_Pos    : Positive;
   begin
      Deleted_Val := O.Data(Pos);
      if (Pos = O.Head) then
         O.Head := Next(O, O.Head);
         Pos := O.Head;
      elsif (Pos = O.Tail) then
         O.Tail := Prev(O, O.Tail);
      elsif (Loc < (Count(O) / 2)) then
         -- It's faster to move all the data up one from the head.
         Curr_Pos := Prev(O, Pos);
         Prev_Pos := Pos;
         while (Prev_Pos /= O.Head) loop
            O.Data(Prev_Pos) := O.Data(Curr_Pos);
            Prev_Pos := Curr_Pos;
            Curr_Pos := Prev(O, Curr_Pos);
         end loop;
         O.Head := Next(O, Prev_Pos);
         Pos := Next(O, Pos);
      else
         -- It's faster to move all the back one from the tail.
         Curr_Pos := Next(O, Pos);
         Prev_Pos := Pos;
         while (Prev_Pos /= O.Tail) loop
            O.Data(Prev_Pos) := O.Data(Curr_Pos);
            Prev_Pos := Curr_Pos;
            Curr_Pos := Next(O, Curr_Pos);
         end loop;
         O.Tail := Prev(O, Prev_Pos);
      end if;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Deleted(O.Cb, O, Deleted_Val);
      end if;
   end Delete_Pos;


   ------------------------------------------------------------------------
   -- This is a controlled type, so we have those methods to handle.


   ------------------------------------------------------------------------
   procedure Initialize (O : in out Object) is
   begin
      null;
   end Initialize;


   ------------------------------------------------------------------------
   procedure Adjust (O : in out Object) is
      Old_Vector : Vector_Array_Ptr := O.Data;
      Last_Entry : Positive;
      Curr       : Positive;
   begin
      O.Data := new Vector_Array(Old_Vector.all'Range);
      Last_Entry := Prev(O, O.Tail);
      if (O.Head < Last_Entry) then
         -- Not a wrap around, so a simple assignment will do.
         O.Data.all(O.Head .. Last_Entry) := Old_Vector(O.Head .. Last_Entry);
      elsif(O.Head > Last_Entry) then
         -- A wraparound case, so we need to assign each end of the array.
         O.Data.all(O.Head .. O.Data.all'Last)
           := Old_Vector(O.Head .. O.Data.all'Last);
         O.Data.all(O.Data.all'First .. Last_Entry)
           := Old_Vector(O.Data.all'First .. Last_Entry);
      end if;

      -- Call the Copied callback on each new element if the container has
      -- a callback set.
      if (O.Cb /= null) then
         Curr := O.Head;
         while (Curr /= O.Tail) loop
            Copied(O.Cb, O, O.Data(Curr));
            Curr := Next(O, Curr);
         end loop;
      end if;
   end Adjust;


   ------------------------------------------------------------------------
   procedure Finalize (O : in out Object) is
      Curr : Positive := O.Head;
   begin
      O.Is_Free := True;
      if (O.Cb /= null) then
         while (Curr /= O.Tail) loop
            Deleted(O.Cb, O, O.Data(Curr));
            Curr := Next(O, Curr);
         end loop;
      end if;

      Free(O.Data);
   end Finalize;


   ------------------------------------------------------------------------
   procedure Finalize (Iter : in out Iterator) is
   begin
      Iter.Is_Free := True;
   end Finalize;


   ------------------------------------------------------------------------
   -- The functions that follow are defined as abstract in previous
   -- packages.  See those packages for descriptions of what these
   -- methods do.


   ------------------------------------------------------------------------
   function "=" (O1, O2 : in Object) return Boolean is
      Curr1, Curr2 : Positive;
   begin
      if (Count(O1) /= Count(O2)) then
         return False;
      else
         Curr1 := O1.Head;
         Curr2 := O2.Head;
         while (Curr1 /= O1.Tail) loop
            if (O1.Data(Curr1) /= O2.Data(Curr2)) then
               return False;
            end if;

            Curr1 := Next(O1, Curr1);
            Curr2 := Next(O2, Curr2);
         end loop;
      end if;

      return True;
   end "=";


   ------------------------------------------------------------------------
   procedure Verify_Integrity (O : in Object) is
   begin
      -- Integrity of an AList doesn't really apply.
      Check_Object(O);
   end Verify_Integrity;


   ------------------------------------------------------------------------
   function Copy (O : in Object) return Asgc.Object_Class is
      Retval : Object_Ptr;
   begin
      Retval := new Object(Initial_Size => O.Initial_Size,
                           Increment    => O.Increment);
      Retval.all := O;

      return Asgc.Object_Class(Retval);
   end Copy;


   ------------------------------------------------------------------------
   function Member_Count (O : in Object) return Natural is
   begin
      return Count(O);
   end Member_Count;


   ------------------------------------------------------------------------
   procedure Add_At (O   : in out Object;
                     Loc : in Positive;
                     Val : in Contained_Type) is
      Pos : Positive;
   begin
      Check_Object(O);

      Pos := Get_Pos_Allow_Addition(O, Loc);
      Perform_Add(O, Loc, Pos, Val);
   end Add_At;


   ------------------------------------------------------------------------
   procedure Set_At (O   : in out Object;
                     Loc : in Positive;
                     Val : in Contained_Type) is
      Pos          : Positive;
      Old_Val      : Contained_Type;
   begin
      Check_Object(O);

      Pos := Get_Pos(O, Loc);

      Old_Val := O.Data(Pos);
      O.Data(Pos) := Val;

      -- Add then delete the values in case these are the same value.  This
      -- can avoid some nasty side effects.
      if (O.Cb /= null) then
         Added(O.Cb, O, O.Data(Pos));
      end if;

      if (O.Cb /= null) then
         Deleted(O.Cb, O, Old_Val);
      end if;
   end Set_At;


   ------------------------------------------------------------------------
   function Get_At (O   : in Object;
                    Loc : in Positive)
                    return Contained_Type is
      Pos : Positive;
   begin
      Check_Object(O);

      Pos := Get_Pos(O, Loc);

      return O.Data(Pos);
   end Get_At;


   ------------------------------------------------------------------------
   procedure Swap_At (O          : in out Object;
                      Loc1, Loc2 : in Positive) is
      Tmp  : Contained_Type;
      Pos1 : Positive;
      Pos2 : Positive;
   begin
      Check_Object(O);

      Pos1 := Get_Pos(O, Loc1);
      Pos2 := Get_Pos(O, Loc2);

      Tmp := O.Data(Pos1);
      O.Data(Pos1) := O.Data(Pos2);
      O.Data(Pos2) := Tmp;
   end Swap_At;


   ------------------------------------------------------------------------
   procedure Delete_At (O   : in out Object;
                        Loc : in Positive) is
      Pos : Positive;
   begin
      Check_Object(O);

      Pos := Get_Pos(O, Loc);
      Delete_Pos(O, Pos, Loc);
   end Delete_At;


   ------------------------------------------------------------------------
   procedure Delete (O   : in out Object;
                     Val : in Contained_Type) is
      Curr : Positive;
   begin
      Check_Object(O);

      Curr := O.Head;
      while (Curr /= O.Tail) loop
         if (O.Data(Curr) = Val) then
            Delete_Pos(O, Curr, Get_Loc(O, Curr));
            return;
         end if;

         Curr := Next(O, Curr);
      end loop;

      raise Item_Not_Found;
   end Delete;


   ------------------------------------------------------------------------
   function Value_Exists (O   : in Object;
                          Val : in Contained_Type)
                          return Boolean is
      Curr : Positive;
   begin
      Check_Object(O);

      Curr := O.Head;
      while (Curr /= O.Tail) loop
         if (O.Data(Curr) = Val) then
            return True;
         end if;

         Curr := Next(O, Curr);
      end loop;

      return False;
   end Value_Exists;


   ------------------------------------------------------------------------
   procedure Push (O   : in out Object;
                   Val : in Contained_Type) is
   begin
      Add_At(O, 1, Val);
   end Push;


   ------------------------------------------------------------------------
   procedure Pop (O   : in out Object;
                  Val : out Contained_Type) is
   begin
      Val := Get_At(O, 1);
      Delete_At(O, 1);
   end Pop;


   ------------------------------------------------------------------------
   procedure Enqueue (O   : in out Object;
                      Val : in Contained_Type) is
   begin
      Check_Object(O);

      -- We directly put the value at the tail index, it's a little faster
      -- than computing the end location and adding there.
      Perform_Add(O, Get_Loc(O, O.Tail), O.Tail, Val);
   end Enqueue;


   ------------------------------------------------------------------------
   procedure Dequeue (O   : in out Object;
                      Val : out Contained_Type) is
   begin
      Val := Get_At(O, 1);
      Delete_At(O, 1);
   end Dequeue;


   ------------------------------------------------------------------------
   function New_Iterator (O : access Object) return Asgc.Iterator_Class is
      Retval : Iterator_Ptr;
   begin
      Check_Object(O.all);

      Retval := new Iterator;
      Retval.Robj := Object_Class(O);

      return Asgc.Iterator_Class(Retval);
   end New_Iterator;


   ------------------------------------------------------------------------
   function New_Iterator (O : in Object_class) return Iterator is
      Retval : Iterator;
   begin
      Retval.Robj := O;

      return Retval;
   end New_Iterator;


   ------------------------------------------------------------------------
   procedure Free (Iter : access Iterator) is
      To_Free : Iterator_Ptr := Iterator_Ptr(Iter);
   begin
      if (Iter.Is_Free) then
         raise Iterator_Free;
      end if;

      Free_Iterator(To_Free);
   end Free;


   ------------------------------------------------------------------------
   procedure Set_Container (Iter : in out Iterator;
                            O    : in Asgc.Object_Class) is
   begin
      Check_Object(Object'Class(O.all));

      Iter.Robj := Object_Class(O);
      Iter.Update := Invalid_Update;
   end Set_Container;


   ------------------------------------------------------------------------
   procedure First (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator_No_Pos(Iter);

      if (Iter.Robj.Head = Iter.Robj.Tail) then
         Iter.Pos := Prev(Iter.Robj.all, Iter.Robj.Head);
      else
         Iter.Pos := Iter.Robj.Head;
      end if;
      Iter.Update := Iter.Robj.Update;
      if (Iter.Robj.Head = Iter.Robj.Tail) then
         Is_End := Past_End;
      else
         Is_End := Not_Past_End;
      end if;
   end First;


   ------------------------------------------------------------------------
   procedure Next (Iter : in out Iterator; Is_End : out End_Marker) is
      Next_Pos : Positive;
   begin
      Check_Iterator(Iter);

      Next_Pos := Next(Iter.Robj.all, Iter.Pos);
      if (Next_Pos = Iter.Robj.Tail) then
         Is_End := Past_End;
      else
         Iter.Pos := Next_Pos;
         Is_End := Not_Past_End;
      end if;
   end Next;


   ------------------------------------------------------------------------
   procedure Delete (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      if (Iter.Pos = Iter.Robj.Tail) then
         Delete_Pos(Iter.Robj.all, Iter.Pos, Get_Loc(Iter.Robj.all, Iter.Pos));
         Is_End := Past_End;
      else
         Delete_Pos(Iter.Robj.all, Iter.Pos, Get_Loc(Iter.Robj.all, Iter.Pos));
         Iter.Update := Iter.Robj.Update;
         Is_End := Not_Past_End;
      end if;
   end Delete;


   ------------------------------------------------------------------------
   function Is_Same (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      if (Iter1.Robj /= Iter2.Robj) then
         raise Iterator_Mismatch;
      end if;

      return (Iter1.Pos = Iter2.Pos);
   end Is_Same;


   ------------------------------------------------------------------------
   function Get (Iter : in Iterator) return Contained_Type is
   begin
      Check_Iterator(Iter);

      return Iter.Robj.Data(Iter.Pos);
   end Get;


   ------------------------------------------------------------------------
   procedure Get_Incr (Iter   : in out Iterator;
                       Val    : out Contained_Type;
                       Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      Val := Iter.Robj.Data(Iter.Pos);
      Next(Iter, Is_End);
   end Get_Incr;


   ------------------------------------------------------------------------
   function "=" (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      return (Iter1.Robj.Data(Iter1.Pos)
              = Iter2.Robj.Data(Iter2.Pos));
   end "=";


   ------------------------------------------------------------------------
   function "=" (Iter : in Iterator; Val : in Contained_Type) return Boolean is
   begin
      Check_Iterator(Iter);

      return (Iter.Robj.Data(Iter.Pos) = Val);
   end "=";


   ------------------------------------------------------------------------
   function "=" (Val : in Contained_Type; Iter : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter);

      return (Iter.Robj.Data(Iter.Pos) = Val);
   end "=";


   ------------------------------------------------------------------------
   procedure Last (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator_No_Pos(Iter);

      Iter.Update := Iter.Robj.Update;
      if (Iter.Robj.Head = Iter.Robj.Tail) then
         Iter.Pos := Prev(Iter.Robj.all, Iter.Robj.Head);
         Is_End := Past_End;
      else
         Iter.Pos := Prev(Iter.Robj.all, Iter.Robj.Tail);
         Is_End := Not_Past_End;
      end if;
   end Last;


   ------------------------------------------------------------------------
   procedure Prev (Iter : in out Iterator; Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);

      if (Iter.Pos = Iter.Robj.Head) then
         Is_End := Past_End;
      else
         Is_End := Not_Past_End;
         Iter.Pos := Prev(Iter.Robj.all, Iter.Pos);
      end if;
   end Prev;


   ------------------------------------------------------------------------
   procedure Set_Loc (Iter : out Iterator; Loc : in Positive) is
      Pos : Positive;
   begin
      Check_Iterator_No_Pos(Iter);

      Pos := Get_Pos(Iter.Robj.all, Loc);

      Iter.Update := Iter.Robj.Update;
      Iter.Pos := Pos;
   end Set_Loc;


   ------------------------------------------------------------------------
   function Get_Loc (Iter : in Iterator) return Natural is
   begin
      Check_Iterator_Empty_Ok(Iter);

      return Get_Loc(Iter.Robj.all, Iter.Pos);
   end Get_Loc;


   ------------------------------------------------------------------------
   function Is_After (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      if (Iter1.Robj /= Iter2.Robj) then
         raise Iterator_Mismatch;
      end if;

      -- If we divide the array in to three regions, we have a wraparound
      -- condition if:
      --            Tail               Head
      -- +-------------------------------------------------+
      -- +xxxxxxxxxxxx|                  |xxxxxxxxxxxxxxxxx+
      -- +-------------------------------------------------+
      --
      -- Where the xxx is where valid data is and the blank space is
      -- unused.  The first two cases of the following if/elsif/else handle
      -- this condition, if one iterator is in one region and the other
      -- iterator is in the other region, the answer is static.  Otherwise,
      -- they are both in the same region and a straight comparison is valid.
      if ((Iter1.Pos >= Iter1.Robj.Head) and (Iter2.Pos < Iter1.Robj.Tail))
      then
         return False;
      elsif ((Iter1.Pos < Iter1.Robj.Head) and (Iter2.Pos > Iter1.Robj.Tail))
      then
         return True;
      else
         return (Iter1.Pos > Iter2.Pos);
      end if;
   end Is_After;


   ------------------------------------------------------------------------
   function Is_Before (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      if (Iter1.Robj /= Iter2.Robj) then
         raise Iterator_Mismatch;
      end if;

      -- See Is_After for an explanation of how this works.
      if ((Iter1.Pos >= Iter1.Robj.Head) and (Iter2.Pos < Iter1.Robj.Tail))
      then
         return True;
      elsif ((Iter1.Pos < Iter1.Robj.Head) and (Iter2.Pos > Iter1.Robj.Tail))
      then
         return False;
      else
         return (Iter1.Pos < Iter2.Pos);
      end if;
   end Is_Before;


   ------------------------------------------------------------------------
   function "+" (Iter : in Iterator; Offset : in Integer)
                 return Iterator is
      New_Iterator : Iterator;
      Loc          : Positive;
   begin
      Check_Iterator_Empty_Ok(Iter);

      Loc := Get_Loc(Iter.Robj.all, Iter.Pos);
      if (Offset >= 0) then
         if ((Loc + Offset) > Count(Iter.Robj.all)) then
            raise Constraint_Error;
         end if;
         New_Iterator.Pos := Iter.Pos + Offset;
         if (New_Iterator.Pos > Iter.Robj.Data.all'Last) then
            New_Iterator.Pos := New_Iterator.Pos - Iter.Robj.Data.all'Last;
         end if;
      else
         if (Loc <= -Offset) then
            raise Constraint_Error;
         end if;
         if (Iter.Pos < -Offset) then
            New_Iterator.Pos := Iter.Pos + Iter.Robj.Data.all'Last + Offset;
         else
            New_Iterator.Pos := Iter.Pos + Offset;
         end if;
      end if;
      New_Iterator.Robj := Iter.Robj;
      New_Iterator.Update := New_Iterator.Robj.Update;

      return New_Iterator;
   end "+";


   ------------------------------------------------------------------------
   function "-" (Iter : in Iterator; Offset : in Integer)
                 return Iterator is
   begin
      return (Iter + (- Offset));
   end "-";


   ------------------------------------------------------------------------
   procedure Swap (Iter1, Iter2 : in out Iterator) is
      Tmp1 : Contained_Type;
      Tmp2 : Contained_Type;
   begin
      Check_Iterator(Iter1);
      Check_Iterator(Iter2);

      Tmp1 := Iter1.Robj.Data(Iter1.Pos);
      Tmp2 := Iter2.Robj.Data(Iter2.Pos);
      Iter1.Robj.Data(Iter1.Pos) := Tmp2;
      Iter2.Robj.Data(Iter2.Pos) := Tmp1;

      -- If we are moving items between different containers, we need to be
      -- sure to call added and deleted on them for the specified
      -- containers.  As usual, added is called first and deleted is call
      -- last.
      if (Iter1.Robj /= Iter2.Robj) then
         if (Iter1.Robj.Cb /= null) then
            Added(Iter1.Robj.Cb,
                  Iter1.Robj.all,
                  Iter1.Robj.Data(Iter1.Pos));
         end if;
         if (Iter2.Robj.Cb /= null) then
            Added(Iter2.Robj.Cb,
                  Iter2.Robj.all,
                  Iter2.Robj.Data(Iter2.Pos));
         end if;
         if (Iter1.Robj.Cb /= null) then
            Deleted(Iter1.Robj.Cb, Iter1.Robj.all, Tmp1);
         end if;
         if (Iter2.Robj.Cb /= null) then
            Deleted(Iter2.Robj.Cb, Iter2.Robj.all, Tmp2);
         end if;
      end if;
   end Swap;


   ------------------------------------------------------------------------
   procedure Add_After (Iter : in out Iterator; Val : in Contained_Type) is
      Next_Pos   : Positive;
   begin
      Check_Iterator_Empty_Ok(Iter);

      Next_Pos := Next(Iter.Robj.all, Iter.Pos);

      Perform_Add(Iter.Robj.all,
                  Get_Loc(Iter.Robj.all, Next_Pos),
                  Next_Pos,
                  Val);
      Iter.Update := Iter.Robj.Update;

      Iter.Pos := Next_Pos;
   end Add_After;


   ------------------------------------------------------------------------
   procedure Add_Before (Iter : in out Iterator; Val : in Contained_Type) is
   begin
      Check_Iterator_Empty_Ok(Iter);

      -- Special case to handle empty lists.  When a list is empty, the
      -- iterator will be set to the value before the head index.  When we
      -- do an add_before in that case, we want the iterator to point to
      -- the head for this to work correctly.
      if (Iter.Robj.Head = Iter.Robj.Tail) then
         Iter.Pos := Iter.Robj.Head;
      end if;

      Perform_Add(Iter.Robj.all,
                  Get_Loc(Iter.Robj.all, Iter.Pos),
                  Iter.Pos,
                  Val);
      Iter.Update := Iter.Robj.Update;
   end Add_Before;


   ------------------------------------------------------------------------
   procedure Set (Iter : in Iterator; Val : in Contained_Type) is
      Old_Val : Contained_Type;
   begin
      Check_Iterator(Iter);

      Old_Val := Iter.Robj.Data(Iter.Pos);
      Iter.Robj.Data(Iter.Pos) := Val;

      -- Add then delete the values in case these are the same value.  This
      -- can avoid some nasty side effects.
      if (Iter.Robj.Cb /= null) then
         Added(Iter.Robj.Cb, Iter.Robj.all, Iter.Robj.Data(Iter.Pos));
      end if;

      if (Iter.Robj.Cb /= null) then
         Deleted(Iter.Robj.Cb, Iter.Robj.all, Old_Val);
      end if;
   end Set;


   ------------------------------------------------------------------------
   procedure Get_Decr (Iter   : in out Iterator;
                       Val    : out Contained_Type;
                       Is_End : out End_Marker) is
   begin
      Check_Iterator(Iter);
      Val := Iter.Robj.Data(Iter.Pos);
      Prev(Iter, Is_End);
   end Get_Decr;


end Asgc.Ordered.Alist.Expandable_Managed;