File : double_linked_list_mixin.adb

with Generic_List_Implementation;

package body Double_Linked_List_Mixin is
   procedure Enshure_Fresh    (Elem : in     T_Class);
   
   procedure Enshure_Fresh (Elem : in     T_Class) is
   begin
      if Elem.Next /= null or Elem.Prev /= null then
         raise Multiple_Inserted_Element;
      end if;
   end Enshure_Fresh;
   
   function Is_Empty (Head : in Double_Linked_List) return Boolean is
   begin
      return Head.Start = null;
   end Is_Empty;
   
   procedure Add_Front (Head  : in out Double_Linked_List;
                        Elem  : in     T_Class) is
   begin
      if Elem = null then
         null;
      elsif Is_Empty (Head) then
         Enshure_Fresh (Elem);
         Head.Start := Elem;
         Elem.Next  := Elem;
         Elem.Prev  := Elem;
      else
         Add_Before (Get_Front_Iterator (Head), Elem);
      end if;
   end Add_Front;

   procedure Add_Rear (Head  : in out Double_Linked_List;
                       Elem  : in     T_Class) is
   begin
      if Is_Empty (Head) then
         Add_Front (Head, Elem);
      else
         Add_Before (Get_Rear_Iterator (Head), Elem);
      end if;
   end Add_Rear;

   procedure Add_Before (Iter : in     Iterator;
                         Elem : in     T_Class) is
      Back : Iterator := Iter;
   begin
      Turn (Back);
      Add_After (Back, Elem);
   end Add_Before;
   
   procedure Add_After (Iter : in     Iterator;
                        Elem : in     T_Class) is
      Curr : T_Class := Get (Iter);
   begin
      if Is_Done (Iter) or Elem = null then
         null;
      else
         Enshure_Fresh (Elem);
         case Iter.D is
            when Front =>
               Elem.Prev      := Curr;
               Elem.Next      := Curr.Next;
               Curr.Next      := Elem;
               Elem.Next.Prev := Elem;
            when Rear =>
               Elem.Next      := Curr;
               Elem.Prev      := Curr.Prev;
               Curr.Prev      := Elem;
               Elem.Prev.Next := Elem;
               if Curr = Iter.L.Start then
                  Iter.L.Start := Elem;
               end if;
         end case;
      end if;
   end Add_After;


   procedure Delete_Front (Head  : in out Double_Linked_List) is
      Iter : Iterator := Get_Front_Iterator (Head);
   begin
      Delete (Iter);
   end Delete_Front;
   
   procedure Delete_Rear (Head  : in out Double_Linked_List) is
      Iter : Iterator := Get_Rear_Iterator (Head);
   begin
      Delete (Iter);
   end Delete_Rear;
   
   procedure Delete (Iter : in out Iterator) is
   begin
      if Is_Done (Iter) then
         raise Delete_After_List;
      end if;
      
      declare
         Curr : T_Class := Get (Iter);
         Next : T_Class := Curr.Next;
         Prev : T_Class := Curr.Prev;
      begin
         if Curr = Next then
            Iter.L.Start := null;
         else
            if Curr = Iter.L.Start then
               Iter.L.Start := Next;
            end if;
            Next.Prev := Prev;
            Prev.Next := Next;
         end if;

         Curr.Next := null;
         Curr.Prev := null;
      end;
      
      Set_Done (Iter);
   end Delete;
   
   --  Explicit Iterator
   function  Get_Front_Iterator (Head : in Double_Linked_List)
     return Iterator is
   begin
      return Iterator'(L => Head'Unrestricted_Access,
                       P => Head.Start,
                       D => Front);
   end Get_Front_Iterator;
   
   function  Get_Rear_Iterator (Head : in Double_Linked_List)
     return Iterator is
      Iter : Iterator := (L => Head'Unrestricted_Access,
                          P => Head.Start,
                          D => Rear);
   begin
      if Iter.P /= null then
         Iter.P := Iter.P.Prev;
      end if;

      return Iter;
   end Get_Rear_Iterator;
   
   function Is_Done (Iter  : in Iterator) return Boolean is
   begin
      return Iter.P = null;
   end Is_Done;
   
   function Get (Iter : in Iterator) return T_Class is
   begin
      return Iter.P;
   end Get;
   
   procedure Advance (Iter : in out Iterator) is
   begin
      if not Is_Done (Iter) then
         case Iter.D is
            when Front =>
               if Iter.P.Next = Iter.L.Start then
                  Set_Done (Iter);
               else
                  Iter.P := Iter.P.Next;
               end if;
            when Rear  =>
               if Iter.P = Iter.L.Start then
                  Set_Done (Iter);
               else
                  Iter.P := Iter.P.Prev;
               end if;
         end case;
      end if;
   end Advance;
   
   procedure Set_Done (Iter : in out Iterator) is
   begin
      Iter.P := null;
   end Set_Done;
   
   procedure Turn (Iter : in out Iterator) is
   begin
      case Iter.D is
         when Front => Iter.D := Rear;
         when Rear  => Iter.D := Front;
      end case;
   end Turn;
   
   --  ----------------------  --
   --  generic implementation  --
   --  ----------------------  --
   procedure Delete_After_Element (Iter : in     Iterator);
   procedure Delete_After_Element (Iter : in     Iterator) is
      Curr : Iterator := Iter;
   begin
      Advance (Curr);
      Delete  (Curr);
   end Delete_After_Element;
   
   package GIF is new Generic_List_Implementation (
      Base => Base,               S        => S,
      T    => T,                  T_Class  => T_Class,
      List => Double_Linked_List, Iterator => Iterator,
      Is_Empty             => Is_Empty,
      Add_Front            => Add_Front,
      Add_After_Element    => Add_After,
      Delete_Front         => Delete_Front,
      Delete_After_Element => Delete_After_Element,
      Get_Iterator         => Get_Front_Iterator,
      Is_Done              => Is_Done,
      Get                  => Get,
      Advance              => Advance,
      Set_Done             => Set_Done
   );
   
   procedure Add_Before_First (Head : in out Double_Linked_List;
                               Elem : in     T_Class) is
      procedure ABF is new GIF.Add_Before (Is_Match => Is_Match);
   begin
      ABF (Head, Elem);
   end Add_Before_First;

   procedure Add_After_First (Head : in out Double_Linked_List;
                              Elem : in     T_Class) is
      procedure AAF is new GIF.Add_After (Is_Match => Is_Match);
   begin
      AAF (Head, Elem);
   end Add_After_First;
   
   function Find_First (Head : in Double_Linked_List) return Iterator is
      function FF is new GIF.Find_First (Is_Match => Is_Match);
   begin
      return FF (Head);
   end Find_First;
   
   function Find_Next (Iter : in Iterator) return Iterator is
      function FN is new GIF.Find_Next (Is_Match => Is_Match);
   begin
      return FN (Iter);
   end Find_Next;
   
   procedure For_First_Matches (Head : in     Double_Linked_List) is
      procedure FFM is new GIF.For_Matches (Is_Match => Is_Match,
                                            On_Item  => On_Item);
   begin
      FFM (Head);
   end For_First_Matches;
   
   procedure For_First_All (Head : in     Double_Linked_List) is
      procedure FFA is new GIF.For_Each (On_Item  => On_Item);
   begin
      FFA (Head);
   end For_First_All;
   
   procedure Delete_First_Matches (Head : in out Double_Linked_List) is
      procedure DFM is new GIF.Delete_Matches (Is_Match => Is_Match);
   begin
      DFM (Head);
   end Delete_First_Matches;
   
   procedure Delete_First_Match (Head : in out Double_Linked_List) is
      procedure DFM is new GIF.Delete_Match (Is_Match => Is_Match);
   begin
      DFM (Head);
   end Delete_First_Match;
   
   --  ----------------------  --
   --  generic implementation  --
   --  ----------------------  --
   package GIR is new Generic_List_Implementation (
      Base => Base,               S        => S,
      T    => T,                  T_Class  => T_Class,
      List => Double_Linked_List, Iterator => Iterator,
      Is_Empty             => Is_Empty,
      Add_Front            => Add_Rear,
      Add_After_Element    => Add_After,
      Delete_Front         => Delete_Rear,
      Delete_After_Element => Delete_After_Element,
      Get_Iterator         => Get_Rear_Iterator,
      Is_Done              => Is_Done,
      Get                  => Get,
      Advance              => Advance,
      Set_Done             => Set_Done
   );
   
   procedure Add_After_Last (Head : in out Double_Linked_List;
                             Elem : in     T_Class) is
      procedure AAL is new GIR.Add_Before (Is_Match => Is_Match);
   begin
      AAL (Head, Elem);
   end Add_After_Last;

   procedure Add_Before_Last (Head : in out Double_Linked_List;
                              Elem : in     T_Class) is
      procedure ABL is new GIR.Add_After (Is_Match => Is_Match);
   begin
      ABL (Head, Elem);
   end Add_Before_Last;
   
   function Find_Last (Head : in Double_Linked_List) return Iterator is
      function FL is new GIR.Find_First (Is_Match => Is_Match);
   begin
      return FL (Head);
   end Find_Last;
   
   procedure For_Last_Matches (Head : in     Double_Linked_List) is
      procedure FLM is new GIR.For_Matches (Is_Match => Is_Match,
                                            On_Item  => On_Item);
   begin
      FLM (Head);
   end For_Last_Matches;
   
   procedure For_Last_All (Head : in     Double_Linked_List) is
      procedure FLA is new GIR.For_Each (On_Item  => On_Item);
   begin
      FLA (Head);
   end For_Last_All;
   
   procedure Delete_Last_Matches (Head : in out Double_Linked_List) is
      procedure DLM is new GIR.Delete_Matches (Is_Match => Is_Match);
   begin
      DLM (Head);
   end Delete_Last_Matches;
   
   procedure Delete_Last_Match (Head : in out Double_Linked_List) is
      procedure DLM is new GIR.Delete_Match (Is_Match => Is_Match);
   begin
      DLM (Head);
   end Delete_Last_Match;

end Double_Linked_List_Mixin;