with Unchecked_Deallocation;
-- with text_io;
package body List_Pos_LPBase is

procedure Free is new Unchecked_Deallocation (Object_Holder, List_Ptr);
procedure Free is new Unchecked_Deallocation (List_Descriptor, Desc_Ptr);

function Empty (List: LPList_Type) return boolean is
   begin
      if List.Actual = null then
          return true;
        else
          return false;
      end if;
   end Empty;
   -------------------------------------------------------
function Size (List: LPList_Type) return natural is
   Answer : natural := 0;
   Temp : List_Ptr;
   begin -- Size
      if List.Actual /= null then
          Temp := List.Actual.First;
          while Temp /= null loop
             Answer := Answer + 1;
             Temp := Temp.Next;
          end loop;
      end if;
   return Answer;
   end Size;
   -------------------------------------------------------
procedure Insert_First (Object: in out Object_Type;
                        List  : in out LPList_Type ) is
   New_Elem: List_Ptr:= new Object_Holder;
   begin
      if List.Actual = null then
          List.Actual       := new List_Descriptor;
          List.Actual.First := New_Elem;
          List.Actual.Last  := New_Elem;
          List.Actual.Size  := 1;
          List.Actual.Shared:= 1;
          New_Elem.Next     := null; -- New_Elem for circular
          New_Elem.Previous := null; -- New_Elem for circular
          Swap (New_Elem.Object, Object);
          List.Current      := New_Elem;
        else
          Free (New_Elem);
          raise Undefined_Position;
      end if;
      --Move_And_Reset
   end Insert_First;
   -------------------------------------------------------------------
procedure Initialize (List: in out LPList_Type) is
   begin -- Initialize
   List := (null, null);
   end Initialize;
   -------------------------------------------------------
procedure Finalize (List: in out LPList_Type) is
   Ignore: Object_Type;
   begin
--    text_io.Put ("In Finalize"); text_io.New_Line;
      if List.Actual.Shared > 1 then
--        text_io.Put ("shared"); text_io.New_Line;
          List.Actual.Shared:= List.Actual.Shared - 1;
          List:= (null, null);
        else -- if List.Actual /= null then
--        text_io.Put ("while"); text_io.New_Line;
          Move_To_Front (List);
          while List.Actual /= null loop
             Remove_Current (List, Ignore);
             -- Finalize (Ignore);
          end loop;
      end if;
   end Finalize;
   -------------------------------------------------------------------
procedure Append (List    : in out LPList_Type;
                  New_Tail: in out LPList_Type) is
   begin
      if New_Tail.Actual = List.Actual then
          raise Undefined_Position;
        elsif New_Tail.Actual.Shared > 1 then
          raise Invalid_Share;
        elsif not Empty (New_Tail) then
          If Empty (List) then
              List := New_Tail;
              New_Tail := (null, null);
            else
              List.Actual.Last.Next := New_Tail.Actual.First;
              New_Tail.Actual.First.Previous := List.Actual.Last;
              List.Actual.Last := New_Tail.Actual.Last;
              List.Actual.Size := List.Actual.Size + New_Tail.Actual.Size;
              Free (New_Tail.Actual);
              New_Tail.Current:= null;
          end if;
      end if;
   end Append;
   -------------------------------------------------------------------
procedure Append (List    : in out LPList_Type;
                  New_Tail: in out Object_Type) is
   Clone: LPList_Type:= List;
   begin -- Append
      If Empty (List) then
          raise List_Underflow;
        else
          Move_To_Rear (List);
          Insert_After (New_Tail, List);
          if Clone.Current /= null then
              List.Current := Clone.Current;
          end if;
      end if;
   end Append;
   -------------------------------------------------------------------
procedure Copy (Source: in     LPList_Type;
                Target: in out LPList_Type) is
   Temp: LPList_Type:= Source;
   Clone_Obj: Object_Type;
   begin
      if Source.Actual /= null and then
         Source.Actual /= Target.Actual then
          Finalize (Target);
          Initialize (Target);
          Initialize (Clone_Obj);
          if Source.Actual /= null then
              Temp.Current := Temp.Actual.First;
              while Current_Defined (Temp) loop
                 Copy (Temp.Current.Object, Clone_Obj);
                 Insert_After (Clone_Obj, Target);
                 Move_To_Rear (Target);
                 Move_Towards_Rear (Temp);
              end loop;
              Move_To_Front (Target);
          end if;
          Finalize (Clone_Obj);
      end if;
   end Copy;
   -------------------------------------------------------------------
function Current_Defined (List: LPList_Type) return boolean is
   begin -- Current_Defined
      return not (List.Current = null);
   end Current_Defined;
   -------------------------------------------------------------------
function At_Rear (List: LPList_Type) return boolean is
   begin
      if List.Actual = null then
          return false;
        elsif List.Current = null then
          return false;
        elsif List.Current = List.Actual.Last then
          return true;
        else
          return false;
      end if;
   end At_Rear;
   -------------------------------------------------------------------
function At_Front (List: LPList_Type) return boolean is
   begin
      if List.Actual = null then
          return false;
        elsif List.Current = null then
          return false;
        elsif List.Current = List.Actual.First then
          return true;
        else
          return false;
      end if;
   end At_Front;
   -------------------------------------------------------------------
procedure Insert_Before (Object: in out Object_Type;
                         List  : in out LPList_Type) is
   New_Elem: List_Ptr:= new Object_Holder;
   begin
      if List.Actual = null then
          Insert_First (Object, List);
        elsif List.Current = null then
          Free (New_Elem);
          raise Undefined_Position;
        else                         --  The list is not empty
          New_Elem.Previous     := List.Current.Previous;
          List.Current.Previous := New_Elem;
          New_Elem.Next         := List.Current;
          if New_Elem.Previous = null then -- front
              List.Actual.First := New_Elem;
            else
              New_Elem.Previous.Next := New_Elem;
          end if;
          Swap (New_Elem.Object, Object);
          List.Actual.Size := List.Actual.Size + 1;
      end if;
   end Insert_Before;
   -------------------------------------------------------------------
procedure Insert_Before (Objects: in out LPList_Type;
                         List   : in out LPList_Type) is
   begin
      if Objects.Actual = null then
          null;
        elsif Objects.Actual = List.Actual then
          raise Undefined_Position;
        elsif List.Actual = null then
          List := Objects;
          Objects := (null, null);
        elsif List.Current = null then
          raise Undefined_Position;
        else
          Objects.Actual.First.Previous := List.Current.Previous;
          List.Current.Previous         := Objects.Actual.Last;
          Objects.Actual.Last.Next      := List.Current;
          if Objects.Actual.First.Previous = null then -- new front
              List.Actual.First := Objects.Actual.First;
            else
              Objects.Actual.First.Previous.Next:= Objects.Actual.First;
          end if;
          List.Actual.Size:= List.Actual.Size + Objects.Actual.Size;
          Free (Objects.Actual);
          Objects.Current := null;
      end if;
   end Insert_Before;
   -------------------------------------------------------------------
procedure Insert_After (Object: in out Object_Type;
                        List  : in out LPList_Type ) is
   New_Elem: List_Ptr:= new Object_Holder;
   begin
      if List.Actual = null then
          Insert_First (Object, List);
        elsif List.Current = null then
          Free (New_Elem);
          raise Undefined_Position;
        else                     --  The list is not empty
          New_Elem.Next         := List.Current.Next;
          New_Elem.Previous     := List.Current;
          New_Elem.Previous.Next:= New_Elem;
          if New_Elem.Next = null then
              List.Actual.Last:= New_Elem;
            else
              New_Elem.Next.Previous:= New_Elem;
          end if;
          Swap (New_Elem.Object, Object);
          List.Actual.Size:= List.Actual.Size + 1;
      end if;
      --Move_And_Reset
   end Insert_After;
   -------------------------------------------------------------------
procedure Insert_After (Objects: in out LPList_Type;
                        List   : in out LPList_Type) is
   begin
      if Objects.Actual = List.Actual then
          raise Undefined_Position;
        elsif List.Actual = null then
          List := Objects;
          Objects.Current := null;
          Free (Objects.Actual);
        elsif List.Current = null then
          raise Undefined_Position;
        else
          Objects.Actual.First.Previous    := List.Current;
          Objects.Actual.Last.Next         := List.Current.Next;
          List.Current.Next            := Objects.Actual.First;
          if Objects.Actual.Last.Next = null then
              List.Actual.Last:= Objects.Actual.Last;
            else
              Objects.Actual.Last.Next.Previous:= Objects.Actual.Last;
          end if;
          List.Actual.Size:= List.Actual.Size + Objects.Actual.Size;
          Free (Objects.Actual);
      end if;
   end Insert_After;
   -------------------------------------------------------------------
function Current_Object (List: LPList_Type) return Object_Type is
   Answer: Object_Type;
   begin
      if List.Current /= null then
          Copy (List.Current.Object, Answer);
          return Answer;
        else
          raise Undefined_Position;
      end if;
   end Current_Object;
   -------------------------------------------------------------------
procedure Process_Current (List   : in     LPList_Type;
                           Process:        In_Place_Process_Type) is
   begin
      if List.Current /= null then
          Process (List.Current.Object);
        else
          raise Undefined_Position;
      end if;
   end Process_Current;
   -------------------------------------------------------------------
procedure Update_Current (List  : in     LPList_Type;
                          Object: in out Object_Type) is
   begin
      if List.Current /= null then
          Swap (List.Current.Object, Object);
        else
          raise Undefined_Position;
      end if;
   end Update_Current;
   ---------------------------------------------------------------------
procedure Move_To_Front (List: in out LPList_Type) is
   begin
      if List.Actual = null then
          raise List_Underflow;
        else
          List.Current:= List.Actual.First;
      end if;
   end Move_To_Front;
   ---------------------------------------------------------------------
procedure Move_To_Rear (List: in out LPList_Type) is
   begin
      if List.Actual = null then
          raise List_Underflow;
        else
          List.Current:= List.Actual.Last;
      end if;
   end Move_To_Rear;
   ---------------------------------------------------------------------
procedure Move_Towards_Front (List: in out LPList_Type) is
   begin
      if List.Actual = null then
          raise List_Underflow;
        elsif List.Current = null then
          raise Undefined_Position;
        else
          List.Current:= List.Current.Previous;
      end if;
   end Move_Towards_Front;
   ---------------------------------------------------------------------
procedure Move_Towards_Rear (List: in out LPList_Type) is
   begin
      if List.Actual = null then
          raise List_Underflow;
        elsif List.Current = null then
          raise Undefined_Position;
        else
          List.Current:= List.Current.Next;
      end if;
   end Move_Towards_Rear;
   -------------------------------------------------------------------
procedure Swap (Source: in out LPList_Type;
                Target: in out LPList_Type) is
   Temp: LPList_Type := Target;
   begin -- Swap
      Target:= Source;
      Source:= Temp;
   end Swap;
   -------------------------------------------------------------------
procedure Remove_Current (List  : in out LPList_Type;
                          Object: in out Object_Type) is
   Posit: List_Ptr := List.Current;
   begin
--    text_io.Put ("Remove_Current"); text_io.New_Line;
      if List.Actual.Shared > 1 then
          raise Invalid_Remove;
        elsif List.Current = null then
          raise Undefined_Position;
        else
          if List.Actual.Size = 1 then
              Free (List.Actual);
              List.Current:= null;
            else
              if Posit.Previous = null then -- front removed
                  List.Actual.First  := Posit.Next;
                else
                  Posit.Previous.Next := Posit.Next;
              end if;
              if Posit.Next = null then -- rear removed
                  List.Actual.Last:= Posit.Previous;
                  List.Current    := List.Actual.Last;
                else
                  Posit.Next.Previous := Posit.Previous;
                  List.Current:= Posit.Next;
              end if;
              List.Actual.Size:= List.Actual.Size - 1;
          end if;
          -- Move_And_Reset
          Swap (Object, Posit.Object);
          Free (Posit);
      end if;
   end Remove_Current;
   -------------------------------------------------------------------
procedure Slice_Tail (Source: in out LPList_Type;
                      Target: in out LPList_Type) is
   begin -- Slice_Tail
      if Source.Actual = Target.Actual then
          raise Undefined_Position;
        elsif (Source.Actual = null) or (Target.Actual = null) then
          raise Undefined_Position;
        elsif (Target.Actual.Shared > 1) or (Source.Actual.Shared > 1) then
          raise Invalid_Share;
        elsif Source.Current /= null then
          Finalize (Target);
          Initialize (Target);
          If Source.Current /= Source.Actual.Last then
              Target.actual      := new List_Descriptor;
              Target.actual.all  := Source.actual.all;
              Target.Actual.First:= Source.Current.Next;
              Source.Actual.Last := Source.Current;
              Target.Current     := Source.Current.Next;
              -- Correct list size information
              Target.Actual.Size:= Size (Target);
              Source.Actual.Size:= Size (Source);
              -- Fix link in Source
              Source.Actual.Last.Next     := null;
              -- Fix link in Target
              Target.Actual.First.Previous:= null;
          end if;
      end if;
   end Slice_Tail;
   ----------------------------------------------------------------

end List_Pos_LPBase;