--::::::::::
--lilpbadv.adb
--::::::::::

package body List_LPBase.Advanced is

function Identical (List_1, List_2: LPList_Type;
                    Equal:          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 Equal(P1.Object, P2.Object) then
          return false;
        else
          return Rec_Eq (P1.Next, P2.Next);
      end if;
      end Rec_Eq;
      ----------------------------------------------------
   begin -- Identical
      return Rec_Eq (List_1.all, List_2.all);
   end      Identical;
   -------------------------------------------------------
function Size (List: LPList_Type) return integer is
   function Rec_Size (Point: List_Ptr) return integer is
      begin -- Rec_Size
         if Point = null then
             return 0;
           else
             return 1+Rec_Size (Point.Next);
         end if;
      end Rec_Size;
      ----------------------------------------------------
   begin -- Size
      return Rec_Size (List.all);
   end Size;
   -------------------------------------------------------
procedure Insert (Object  : in out Object_Type;
                  Position: in     positive;
                  List    : in     LPList_Type) is
   procedure Rec_Insert (Sublist: in    LPList_Type;
                         Count  : in    natural) is
      begin -- Rec_Insert
         if Count = Position then
             New_Head (Object, Sublist);
           else
             Rec_Insert (Tail_Of(Sublist), Count+1);
         end if;
      end Rec_Insert;
      -----------------------------------------------
   begin -- Insert
   if Position > (Size (List)+1) then
       raise List_Underflow;
     elsif Position = (Size (List)+1) then
       Append (List, Object);
     else
       Rec_Insert (List, 1);
   end if;
   end Insert;
   --------------------------------------------------
procedure Remove (List    : in     LPList_Type;
                  Position: in     positive;
                  Object  : in out Object_Type) is
   procedure Rec_Remove (Sublist: in     LPList_Type;
                         Count  : in     natural) is
      begin -- Rec_Remove
         if Count = Position then
             Remove_Head (Sublist, Object);
           else
             Rec_Remove (Tail_Of(Sublist), Count+1);
         end if;
      end Rec_Remove;
      -----------------------------------------------
   begin -- Remove
   if Position > Size(List) then
       raise constraint_error;
     else
       Rec_Remove (List, 1);
   end if;
   end Remove;
   ---------------------------------------------------
procedure Poke (List  : in out LPList_Type;
                Index : in     positive;
                Object: in out Object_Type) is
   procedure Rec_Poke (Sublist: in    LPList_Type;
                       Count  : in    natural) is
      begin -- Rec_Poke
         if Count = Index then
             Update_Head (Sublist, Object);
           else
             Rec_Poke (Tail_Of(Sublist), Count+1);
         end if;
      end Rec_Poke;
      -----------------------------------------------
   begin -- Poke
      if List.all = null then
          raise List_Underflow;
        elsif Index > Size (List) then
          raise constraint_error;
        else
          Rec_Poke (List, 1);
      end if;
   end Poke;
   --------------------------------------------------
function Peek (List: LPList_Type;
               Index   : positive) return Object_Type is
   --Answer: Object_Type;
   function Rec_Peek (Sublist: in     LPList_Type;
                      Count  : in     natural) return Object_Type is
      begin -- Rec_Peek
         if Count = Index then
             return Head_Of(Sublist);
           else
             return Rec_Peek (Tail_Of(Sublist), Count+1);
         end if;
      end Rec_Peek;
      -----------------------------------------------
   begin -- Peek
      if List.all = null then
          raise List_Underflow;
        elsif Index > Size (List) then
          raise constraint_error;
        else
          return Rec_Peek(List, 1);
      end if;
   end Peek;
   --------------------------------------------------

end List_LPBase.Advanced;