-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset 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 distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

package body Clists is

   -- A_Ptr fields join the cells of a list.
   -- B_Ptr of a listhead is the last cell in its list.

   --------------------------------------------------------------------------

   function FirstCell (Heap     : Cells.Heap_Record;
                       ListName : Cells.Cell) return Cells.Cell is
   begin
      return Cells.Get_A_Ptr (Heap, ListName);
   end FirstCell;

   --------------------------------------------------------------------------

   function LastCell (Heap     : Cells.Heap_Record;
                      ListName : Cells.Cell) return Cells.Cell is
   begin
      return Cells.Get_B_Ptr (Heap, ListName);
   end LastCell;

   --------------------------------------------------------------------------

   function NextCell (Heap     : Cells.Heap_Record;
                      CellName : Cells.Cell) return Cells.Cell is
   begin
      return Cells.Get_A_Ptr (Heap, CellName);
   end NextCell;

   --------------------------------------------------------------------------

   function IsEmptyList (Heap     : Cells.Heap_Record;
                         ListName : Cells.Cell) return Boolean is
   begin
      return Cells.Is_Null_Cell (FirstCell (Heap, ListName));
   end IsEmptyList;

   --------------------------------------------------------------------------

   procedure AppendCell (Heap     : in out Cells.Heap_Record;
                         CellName : in     Cells.Cell;
                         ListName : in     Cells.Cell) is
   begin
      -- prepare new cell;
      Cells.Set_A_Ptr (Heap, CellName, Cells.Null_Cell);
      -- modify existing pointers of list;
      if IsEmptyList (Heap, ListName) then
         Cells.Set_A_Ptr (Heap, ListName, CellName);
      else
         Cells.Set_A_Ptr (Heap, LastCell (Heap, ListName), CellName);
      end if;
      Cells.Set_B_Ptr (Heap, ListName, CellName);
   end AppendCell;

   --------------------------------------------------------------------------

   procedure Concatenate (Heap   : in out Cells.Heap_Record;
                          List_1 : in     Cells.Cell;
                          List_2 : in     Cells.Cell) is
   begin
      if not IsEmptyList (Heap, List_2) then
         if IsEmptyList (Heap, List_1) then
            Cells.Set_A_Ptr (Heap, List_1, FirstCell (Heap, List_2));
         else
            Cells.Set_A_Ptr (Heap, LastCell (Heap, List_1), FirstCell (Heap, List_2));
         end if;
         Cells.Set_B_Ptr (Heap, List_1, LastCell (Heap, List_2));
      end if;
      Cells.Dispose_Of_Cell (Heap, List_2);
   end Concatenate;

   --------------------------------------------------------------------------

   procedure InsertCell (Heap     : in out Cells.Heap_Record;
                         CellName : in     Cells.Cell;
                         ListName : in     Cells.Cell) is
      M, N         : Cells.Cell;
      GivenVarName : Natural;
   begin
      M            := ListName;
      N            := FirstCell (Heap, ListName);
      GivenVarName := Cells.Get_Natural_Value (Heap, CellName);
      loop
         if Cells.Is_Null_Cell (N) then
            Cells.Set_B_Ptr (Heap, ListName, CellName);
            exit;
         end if;
         if Cells.Get_Natural_Value (Heap, N) > GivenVarName then
            Cells.Set_A_Ptr (Heap, CellName, N);
            exit;
         end if;
         M := N;
         N := NextCell (Heap, N);
      end loop;
      Cells.Set_A_Ptr (Heap, M, CellName);
   end InsertCell;

   --------------------------------------------------------------------------

   procedure TransferCells (Heap   : in out Cells.Heap_Record;
                            List_1 : in     Cells.Cell;
                            List_2 : in     Cells.Cell) is
   begin
      if not IsEmptyList (Heap, List_1) then
         if IsEmptyList (Heap, List_2) then
            Cells.Set_A_Ptr (Heap, List_2, FirstCell (Heap, List_1));
         else
            Cells.Set_A_Ptr (Heap, LastCell (Heap, List_2), FirstCell (Heap, List_1));
         end if;
         Cells.Set_B_Ptr (Heap, List_2, LastCell (Heap, List_1));
      end if;
   end TransferCells;

   --------------------------------------------------------------------------

   procedure CreateList (Heap     : in out Cells.Heap_Record;
                         ListName :    out Cells.Cell) is
   begin
      -- create listhead, with null A_Ptr and B_Ptr;
      Cells.Create_Cell (Heap, ListName);
   end CreateList;

   --------------------------------------------------------------------------

   procedure DisposeOfList (Heap     : in out Cells.Heap_Record;
                            ListName : in     Cells.Cell) is
      ListCell, NextListCell : Cells.Cell;
   begin
      ListCell := FirstCell (Heap, ListName);
      -- dispose of listhead;
      Cells.Dispose_Of_Cell (Heap, ListName);
      -- dispose of list cells;
      loop
         exit when Cells.Is_Null_Cell (ListCell);
         NextListCell := NextCell (Heap, ListCell);
         Cells.Dispose_Of_Cell (Heap, ListCell);
         ListCell := NextListCell;
      end loop;
   end DisposeOfList;

   --------------------------------------------------------------------------

   procedure RemoveLeader (Heap     : in out Cells.Heap_Record;
                           ListName : in     Cells.Cell) is
   begin
      if Cells.Are_Identical (FirstCell (Heap, ListName), LastCell (Heap, ListName)) then
         Cells.Set_A_Ptr (Heap, ListName, Cells.Null_Cell);
         Cells.Set_B_Ptr (Heap, ListName, Cells.Null_Cell);
      else
         Cells.Set_A_Ptr (Heap, ListName, NextCell (Heap, FirstCell (Heap, ListName)));
      end if;
   end RemoveLeader;

end Clists;
