File : asgc-ordered-dlist-dynamic_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.Dlist.Dynamic_Managed is

   procedure Free_Node is new Ada.Unchecked_Deallocation(Node,
                                                         Node_Ptr);

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



   ------------------------------------------------------------------------
   -- Allocate a free node for a new item in the list.
   procedure Alloc_Node (O    : in out Object'Class;
                         Item : out Node_Ptr) is
   begin
      Item := new Node;
   end Alloc_Node;


   ------------------------------------------------------------------------
   -- Free a node that is no longer in use.
   procedure Free_Node (O    : in out Object'Class;
                        Item : in out Node_Ptr) is
   begin
      Free_Node(Item);
   end Free_Node;


   ------------------------------------------------------------------------
   -- 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'Class) 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.Pos = null) then
         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'Class) 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;
   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;


   ------------------------------------------------------------------------
   -- Delete the given reference and free it.
   procedure Delete (O       : in out Object'Class;
                     To_Free : in out Node_Ptr;
                     Is_End  : out End_Marker) is
      Next_Val : Node_Ptr;
   begin
      Next_Val := To_Free.Next;
      if (To_Free /= O.Head) then
         -- Not deleting the first item, modify the prev's next ref.
         To_Free.Prev.Next := Next_Val;

         if (Next_Val = null) then
            -- Deleting the tail, so handle that.
            O.Tail := To_Free.Prev;
            Is_End := Past_End;
         else
            Next_Val.Prev := To_Free.Prev;
            Is_End := Not_Past_End;
         end if;
      else
         -- Deleting the first item, change the head.
         O.Head := Next_Val;
         if (Next_Val = null) then
            -- Deleted the only item.
            O.Tail := null;
            Is_End := Past_End;
         else
            Next_Val.Prev := null;
            Is_End := Not_Past_End;
         end if;
      end if;

      O.Update := O.Update + 1;
      O.Count := O.Count - 1;

      if (O.Cb /= null) then
         Deleted(O.Cb, O, To_Free.Val);
      end if;

      Free_Node(O, To_Free);
   end Delete;


   ------------------------------------------------------------------------
   -- Add the given item before Curr in the list.
   procedure Add_Before (O    : in out Object'Class;
                         Curr : in Node_Ptr;
                         Val  : in Contained_Type) is
      New_Node : Node_Ptr;
   begin
      Alloc_Node(O, New_Node);
      New_Node.Val := Val;
      if (O.Tail = null) then
         -- The list is empty, this becomes the only member.
         O.Head := New_Node;
         O.Tail := New_Node;
      else
         New_Node.Next := Curr;
         New_Node.Prev := Curr.Prev;

         if (O.Head = Curr) then
            -- If we are at the head, the new item becomes the new head.
            O.Head := New_Node;
         else
            Curr.Prev.Next := New_Node;
         end if;

         Curr.Prev := New_Node;
      end if;

      O.Count := O.Count + 1;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Added(O.Cb, O, New_Node.Val);
      end if;
   end Add_Before;

   ------------------------------------------------------------------------
   -- Add the given item after Curr in the list.
   procedure Add_After (O    : in out Object'Class;
                        Curr : in Node_Ptr;
                        Val  : in Contained_Type) is
      New_Node : Node_Ptr;
   begin
      Alloc_Node(O, New_Node);
      New_Node.Val := Val;
      if (O.Tail = null) then
         -- The list is empty, this becomes the only member.
         O.Head := New_Node;
         O.Tail := New_Node;
      else
         New_Node.Next := Curr.Next;
         New_Node.Prev := Curr;
         Curr.Next := New_Node;
         if (O.Tail = Curr) then
            -- If we are at the tail, the new item becomes the new tail.
            O.Tail := New_Node;
         else
            New_Node.Next.Prev := New_Node;
         end if;
      end if;

      O.Count := O.Count + 1;
      O.Update := O.Update + 1;

      if (O.Cb /= null) then
         Added(O.Cb, O, New_Node.Val);
      end if;
   end Add_After;


   ------------------------------------------------------------------------
   -- Using an object and an optional current location, seek to the given
   -- location in the most efficient manner possible.
   function Seek_To (O        : in Object'Class;
                     Loc      : in Positive;
                     Curr     : in Node_Ptr     := null;
                     Curr_Loc : in Positive    := 1)
                     return Node_Ptr is
      Retval       : Node_Ptr;
      Diff         : Integer;
      Seek_Forward : Boolean;
   begin
      -- Start with trying the head node.
      Retval := O.Head;
      Diff := Loc - 1;
      Seek_Forward := True;

      if ((O.Count - Loc) < Diff) then
         -- If the tail location is closer to the position, seek from there.
         Diff := O.Count - Loc;
         Seek_Forward := False;
         Retval := O.Tail;
      end if;

      if (Curr /= null) then
         -- Now check the passed in location and seek from there if it is
         -- closer.
         if ((Curr_Loc >= Loc) and ((Curr_Loc - Loc) < Diff)) then
            Diff := Curr_Loc - Loc;
            Seek_Forward := False;
            Retval := Curr;
         elsif ((Curr_Loc < Loc) and ((Loc - Curr_Loc) < Diff)) then
            Diff := Loc - Curr_Loc;
            Seek_Forward := True;
            Retval := Curr;
         end if;
      end if;

      -- Now do the seek.
      if (Seek_Forward) then
         for I in 1 .. Diff loop
            Retval := Retval.Next;
         end loop;
      else
         for I in 1 .. Diff loop
            Retval := Retval.Prev;
         end loop;
      end if;

      return Retval;
   end Seek_To;


   ------------------------------------------------------------------------
   -- 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
      New_List : Node_Ptr := null;
      New_Curr : Node_Ptr;
      Old_Curr : Node_Ptr := O.Head;
   begin
      if (O.Head = null) then
         O.Head := null;
         O.Tail := null;
      else
         -- Build a whold new list from the current list.
         New_List := new Node;
         New_List.Val := Old_Curr.Val;

         New_Curr := New_List;
         while (Old_Curr.Next /= null) loop
            New_Curr.Next := new Node;
            New_Curr.Next.Prev := New_Curr;
            New_Curr.Next.Val := Old_Curr.Next.Val;
            Old_Curr := Old_Curr.Next;
            New_Curr := New_Curr.Next;
         end loop;
         O.Head := New_List;
         O.Tail := New_Curr;
      end if;

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


   ------------------------------------------------------------------------
   procedure Finalize (O : in out Object) is
      Curr    : Node_Ptr := O.Head;
      Temp    : Node_Ptr;
   begin
      while (Curr /= null) loop
         if (O.Cb /= null) then
            Deleted(O.Cb, O, Curr.Val);
         end if;
         Temp := Curr.Next;
         Free_Node(Curr);
         Curr := Temp;
      end loop;

      O.Is_Free := True;
   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 : Node_Ptr;
      Curr2 : Node_Ptr;
   begin
      Check_Object(O1);
      Check_Object(O2);

      if (O1.Count /= O2.Count) then
         return False;
      else
         -- Compare all the elements in the lists to see if they are the
         -- same.
         Curr1 := O1.Head;
         Curr2 := O2.Head;
         while (Curr1 /= null) loop
            if (Curr2 = null) then
               raise Internal_List_Error;
            end if;

            if (Curr1.Val /= Curr2.Val) then
               return False;
            end if;

            Curr1 := Curr1.Next;
            Curr2 := Curr2.Next;
         end loop;

         if (Curr2 /= null) then
            raise Internal_List_Error;
         end if;

         return True;
      end if;
   end "=";


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

      return O.Count;
   end Member_Count;


   ------------------------------------------------------------------------
   procedure Verify_Integrity (O : in Object) is
      Curr  : Node_Ptr;
      Count : Natural;
   begin
      Check_Object(O);

      if (O.Count = 0) then
         if ((O.Head /= null) or (O.Tail /= null)) then
            raise Internal_List_Error;
         end if;
      else
         Curr := O.Head;
         if (Curr.Prev /= null) then
            raise Internal_List_Error;
         end if;

         -- Go through all the elemenets and make sure the prev and next
         -- pointers point to each other for each node in the list.
         Count := 1;
         while (Curr.Next /= null) loop
            if (Count > O.Count) then
               raise Internal_List_Error;
            end if;
            if (Curr.Next.Prev /= Curr) then
               raise Internal_List_Error;
            end if;
            Curr := Curr.Next;
            Count := Count + 1;
         end loop;

         if (Count /= O.Count) then
            raise Internal_List_Error;
         end if;

         if (Curr /= O.Tail) then
            raise Internal_List_Error;
         end if;
      end if;
   end Verify_Integrity;


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

      return Asgc.Object_Class(Retval);
   end Copy;


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

      Add_Before(Iter.Robj.all, Iter.Pos, Val);
      if (Iter.Pos = null) then
         Iter.Pos := Iter.Robj.Head;
      else
         Iter.Pos := Iter.Pos.Prev;
      end if;
      Iter.Update := Iter.Robj.Update;
   end Add_Before;


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

      Add_After(Iter.Robj.all, Iter.Pos, Val);
      if (Iter.Pos = null) then
         Iter.Pos := Iter.Robj.Tail;
      else
         Iter.Pos := Iter.Pos.Next;
      end if;
      Iter.Offset := Iter.Offset + 1;
      Iter.Update := Iter.Robj.Update;
   end Add_After;


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

      Curr := O.Head;
      while ((Curr /= null) and then(Curr.Val /= Val)) loop
         Curr := Curr.Next;
      end loop;

      if (Curr /= null) then
         Delete(O, Curr, Dummy_Is_End);
      else
         raise Item_Not_Found;
      end if;
   end Delete;


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

      Curr := O.Head;
      while ((Curr /= null) and then(Curr.Val /= Val)) loop
         Curr := Curr.Next;
      end loop;

      return (Curr /= null);
   end Value_Exists;


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

      if (Loc > (O.Count + 1)) then
         raise Constraint_Error;
      end if;

      if (Loc = 1) then
         -- Special case for adding the first value.
         Add_Before(O, O.Head, Val);
      else
         Add_After(O, Seek_To(O, Loc - 1), Val);
      end if;
   end Add_At;


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

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      Curr := Seek_To(O, Loc);
      Old_Val := Curr.Val;
      Curr.Val := 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, Curr.Val);
      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
      Curr : Node_Ptr;
   begin
      Check_Object(O);

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      Curr := Seek_To(O, Loc);
      return Curr.Val;
   end Get_At;


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

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

      Tmp := Pos1.Val;
      Pos1.Val := Pos2.Val;
      Pos2.Val := Tmp;
   end Swap_At;


   ------------------------------------------------------------------------
   procedure Delete_At (O   : in out Object;
                        Loc : in Positive) is
      To_Delete : Node_Ptr;
      Is_End    : End_Marker;
   begin
      Check_Object(O);

      if (Loc > O.Count) then
         raise Constraint_Error;
      end if;

      To_Delete := Seek_To(O, Loc);
      Delete(O, To_Delete, Is_End);
   end Delete_At;


   ------------------------------------------------------------------------
   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);

      Add_After(O, 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 Set (Iter : in Iterator; Val : in Contained_Type) is
      Old_Val : Contained_Type;
   begin
      Check_Iterator(Iter);

      Old_Val := Iter.Pos.Val;
      Iter.Pos.Val := 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.Pos.Val);
      end if;

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


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

      Iter.Pos := Iter.Robj.Head;
      Iter.Update := Iter.Robj.Update;
      if (Iter.Pos = null) then
         Is_End := Past_End;
         Iter.Offset := 0;
      else
         Is_End := Not_Past_End;
         Iter.Offset := 1;
      end if;
   end First;


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

      if (Iter.Pos.Next = null) then
         Is_End := Past_End;
      else
         Iter.Pos := Iter.Pos.Next;
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Offset + 1;
      end if;
   end Next;


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

      Next_Node := Iter.Pos.Next;
      Delete(Iter.Robj.all, Iter.Pos, Local_Is_End);
      if (Local_Is_End = Not_Past_End) then
         Iter.Update := Iter.Robj.Update;
         Iter.Pos := Next_Node;
      end if;
      Is_End := Local_Is_End;
   end Delete;


   ------------------------------------------------------------------------
   function Is_Same (Iter1, Iter2 : in Iterator) return Boolean is
   begin
      Check_Iterator(Iter1);
      Check_Iterator(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.Pos.Val;
   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.Pos.Val;
      Next(Iter, Is_End);
   end Get_Incr;


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

      Val := Iter.Pos.Val;
      Prev(Iter, Is_End);
   end Get_Decr;


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

      Iter.Pos := Iter.Robj.Tail;
      Iter.Update := Iter.Robj.Update;
      if (Iter.Pos = null) then
         Is_End := Past_End;
         Iter.Offset := 0;
      else
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Robj.Count;
      end if;
   end Last;


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

      if (Iter.Pos.Prev = null) then
         Is_End := Past_End;
      else
         Iter.Pos := Iter.Pos.Prev;
         Is_End := Not_Past_End;
         Iter.Offset := Iter.Offset - 1;
      end if;
   end Prev;


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

      if (Loc > Iter.Robj.Count) then
         raise Constraint_Error;
      end if;

      if ((Iter.Update = Iter.Robj.Update)
          and (Iter.Pos /= null))
      then
         -- We have a valid iterator, use it for checking the seek.
         Iter.Pos := Seek_To(Iter.Robj.all, Loc, Iter.Pos, Iter.Offset);
      else
         Iter.Pos := Seek_To(Iter.Robj.all, Loc);
      end if;
      Iter.Offset := Loc;
      Iter.Update := Iter.Robj.Update;
   end Set_Loc;


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

      return Iter.Offset;
   end Get_Loc;


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

      return (Iter1.Offset > Iter2.Offset);
   end Is_After;


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

      return (Iter1.Offset < Iter2.Offset);
   end Is_Before;


   ------------------------------------------------------------------------
   function "-" (Iter1, Iter2 : in Iterator) return Integer is
   begin
      Check_Iterator_Empty_Ok(Iter1);
      Check_Iterator_Empty_Ok(Iter2);

      return (Integer(Iter1.Offset) - Integer(Iter2.Offset));
   end "-";


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

      if ((Offset < 0)
          and then (Iter.Offset <= -Offset))
      then
         raise Constraint_Error;
      elsif ((Offset > 0)
             and then ((Iter.Offset + Offset) > Iter.Robj.Count))
      then
         raise Constraint_Error;
      end if;

      Retval.Robj := Iter.Robj;
      Retval.Offset := Iter.Offset + Offset;
      if (Iter.Offset = 0) then
         Retval.Pos := Seek_To(Iter.Robj.all, Retval.Offset);
      else
         Retval.Pos := Seek_To(Iter.Robj.all,
                               Retval.Offset,
                               Iter.Pos,
                               Iter.Offset);
      end if;

      Retval.Update := Iter.Robj.Update;

      return Retval;
   end "+";


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


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

      Temp := Iter1.Pos.Val;
      Iter1.Pos.Val := Iter2.Pos.Val;
      Iter2.Pos.Val := Temp;
   end Swap;


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

      return (Iter1.Pos.Val = Iter2.Pos.Val);
   end "=";


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

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


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

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


end Asgc.Ordered.Dlist.Dynamic_Managed;