--::::::::::
--lipolpad.adb
--::::::::::
with Unchecked_Deallocation;

package body List_Pos_LPBase.Advanced is
   procedure Free is new Unchecked_Deallocation (Object_Holder, List_Ptr);

function Equivalent (List_1, List_2: LPList_Type;
                     EQ: EQ_Type) return boolean is
--    Copy_1: List_Ptr;
--    Copy_2: List_Ptr;
--    Answer: boolean := true;
   function Rec_Eq (P1, P2: List_Ptr) return boolean is
      begin -- Rec_Eq
      if (P1 = null) and (P2 /= null) then
          return false;
        elsif (P1 /= null) and (P2 = null) then
          return false;
        elsif (P1 = null) and (P2 = null) then
          return true;
        elsif not EQ(P1.Object, P2.Object) then
          return false;
        else
          return Rec_Eq (P1.Next, P2.Next);
      end if;
      end Rec_Eq;
      ----------------------------------------------------
   begin -- Equivalent
      if List_1.Actual = List_2.Actual then
          return true;
        else
          return Rec_Eq (List_1.Actual.First, List_2.Actual.First);
      end if;
   end      Equivalent;
   -------------------------------------------------------
function Size_Of (List: LPList_Type) return integer is
   begin -- Size_Of
      if List.Actual = null then
          return 0;
        else
          return List.Actual.Size;
      end if;
   end Size_Of;
   -------------------------------------------------------
procedure Insert (Object  : in out Object_Type;
                  Position: in     positive;
                  List    : in out LPList_Type) is
   begin -- Insert
   if Position = (Size_Of (List) + 1) then
       if List.Actual /= null then
          List.Current := List.Actual.Last;
       end if;
       Insert_After (Object, List);
       Move_Towards_Rear (List);
     else
       Move_To_Front (List);
       for i in 2..Position loop
          Move_Towards_Rear (List);
       end loop;
       Insert_Before (Object, LIst);
       Move_Towards_Front (List);
   end if;
   end Insert;
   --------------------------------------------------
procedure Remove (List    : in out LPList_Type;
                  Position: in     positive;
                  Object  : in out Object_Type) is
   begin -- Remove
   if Position > Size_Of(List) then
       raise constraint_error;
     else
       Move_To_Front (List);
       for i in 2..Position loop
          Move_Towards_Rear (List);
       end loop;
       Remove_Current (List, Object);
   end if;
   end Remove;
   ---------------------------------------------------
procedure Poke (List  : in out LPList_Type;
                Index : in     positive;
                Object: in out Object_Type) is
   begin -- Poke
      if List.Actual = null then
          raise List_Underflow;
        elsif Index > Size_Of (List) then
          raise constraint_error;
        else
          Move_To_Front (List);
          for i in 2..Index loop
             Move_Towards_Rear (List);
          end loop;
          Update_Current (List, Object);
      end if;
   end Poke;
   --------------------------------------------------
function Peek (List: LPList_Type;
               Index   : positive) return Object_Type is
   Clone: LPList_Type := List;
   begin -- Peek
      if List.Actual = null then
          raise List_Underflow;
        elsif Index > Size_Of (List) then
          raise constraint_error;
        else
          Move_To_Front (Clone);
          for i in 2..Index loop
             Move_Towards_Rear (Clone);
          end loop;
          return Current_Object (Clone);
      end if;
   end Peek;
   --------------------------------------------------
procedure Share (Source, Target: in out LPList_Type) is
   begin -- Share
      if Source.Actual = null then
        raise Invalid_Share;
      else
        Finalize (Target);
        Target.Current := Source.Current;
        Target.Actual := Source.Actual;
        Source.Actual.Shared := Source.Actual.Shared + 1;
      end if;
   end Share;
   --------------------------------------------------
function Is_Shared (Source: LPList_Type) return boolean is
   begin -- Is_Shared
      if Source.Actual = null then
          return false;
        else
          return (Source.Actual.Shared > 1);
      end if;
   end Is_Shared;
   --------------------------------------------------

end List_Pos_LPBase.Advanced;