-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with SystemErrors;
with Cells.Utility;

package body Cells.Utility.List
is

   --  The overall picture of this datastructure is:
   --
   --  +------+
   --  | List |-------------------------\
   --  +------+                         |
   --     |                             |
   --     | (A - first)                 | (B - last)
   --     |                             |
   --     v                             v
   --  +------+  (A)  +------+  (A)  +------+
   --  |      |------>|      |------>|      |------> null
   --  +------+       +------+       +------+
   --     |              |              |
   --     | (B)          | (B)          | (B)
   --     |              |              |
   --     v              v              v
   --  +------+       +------+       +------+
   --  | DATA |       | DATA |       | DATA |
   --  +------+       +------+       +------+
   --
   --  List also has its `natural' field set to the current length of
   --  the list.

   ------------------------------------------------------------------------------
   --  Queries
   ------------------------------------------------------------------------------

   function Get_Length (VCG_Heap : in Cells.Heap_Record;
                        The_List : in Linked_List)
                       return Natural
   is
   begin
      return Cells.Get_Natural_Value (VCG_Heap, Cells.Cell (The_List));
   end Get_Length;

   ------------------------------------------------------------------------------
   --  List manipulation
   ------------------------------------------------------------------------------

   --  The linked list root has the following fields:
   --     A       : Pointer to the first element or null
   --     B       : Pointer to the last element or null
   --     Natural : Length of the list
   procedure Create
     (VCG_Heap : in out Cells.Heap_Record;
      The_List :    out Linked_List)
   is
      L : Cells.Cell;
   begin
      Cells.Create_Cell (VCG_Heap, L);
      Cells.Set_A_Ptr (VCG_Heap, L, Cells.Null_Cell);
      Cells.Set_B_Ptr (VCG_Heap, L, Cells.Null_Cell);
      Cells.Set_Natural_Value (VCG_Heap, L, 0);

      The_List := Linked_List (L);
   end Create;

   --  Each element of the linked list has the following fields:
   --     A : Pointer to the next element or null
   --     B : Pointer to the content cell
   procedure Append
     (VCG_Heap : in out Cells.Heap_Record;
      The_List : in     Linked_List;
      The_Cell : in     Cells.Cell)
   is
      Prev           : Cells.Cell;
      N              : Cells.Cell;
      Current_Length : Natural;
   begin
      --  Set up the node.
      Cells.Create_Cell (VCG_Heap, N);
      Cells.Set_A_Ptr (VCG_Heap, N, Cells.Null_Cell);
      Cells.Set_B_Ptr (VCG_Heap, N, The_Cell);

      --  Link it into the list.
      if Cells.Is_Null_Cell (Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List))) then
         --  Case 1. We have an empty list.

         --  Update the list to point to our new node.
         Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List), N);
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List), N);
      else
         --  Case 2. We stick it at the end of the existing list.

         --  Point the current last element to this node.
         Prev := Cells.Get_B_Ptr (VCG_Heap, Cells.Cell (The_List));
         Cells.Set_A_Ptr (VCG_Heap, Prev, N);

         --  Update the last element pointer of the list.
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List), N);
      end if;

      --  Increment the length of the list by 1.
      Current_Length := Get_Length (VCG_Heap, The_List);
      SystemErrors.RT_Assert (C       => Current_Length < Natural'Last,
                              Sys_Err => SystemErrors.VCG_Heap_Is_Exhausted,
                              Msg     => "Linked list length exceeds Natural'Last");
      Cells.Set_Natural_Value (VCG_Heap, Cells.Cell (The_List), Current_Length + 1);
   end Append;

   procedure Append_List
     (VCG_Heap           : in out Cells.Heap_Record;
      The_List           : in     Linked_List;
      The_List_To_Append : in     Linked_List)
   is
      Current_Length : Natural;
   begin
      if Cells.Is_Null_Cell (Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append))) then
         --  Case 1. The list to append is empty. Do nothing.
         null;
      elsif Cells.Is_Null_Cell (Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List))) then
         --  Case 2. The list is empty, so it just becomes the list to
         --          append.

         --  Transfer A and B pointer and length.
         Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List),
                          Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append)));
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List),
                          Cells.Get_B_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append)));
         Cells.Set_Natural_Value
           (VCG_Heap, Cells.Cell (The_List),
            Cells.Get_Natural_Value (VCG_Heap,
                                     Cells.Cell (The_List_To_Append)));

         --  Nuke the second list.
         Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append), Cells.Null_Cell);
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append), Cells.Null_Cell);
         Cells.Set_Natural_Value (VCG_Heap, Cells.Cell (The_List_To_Append), 0);
      else
         --  Case 3. Both lists are non-empty. Fiddle the last element
         --          and length of the list and then nuke the second.

         --  Point the last element to the first of the second list.
         Cells.Set_A_Ptr (VCG_Heap, Cells.Get_B_Ptr (VCG_Heap, Cells.Cell (The_List)),
                          Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append)));

         --  Point to the new last element.
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List),
                          Cells.Get_B_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append)));

         --  Update the length.
         SystemErrors.RT_Assert
           (C       => Get_Length (VCG_Heap, The_List) <= Natural'Last - Get_Length (VCG_Heap, The_List_To_Append),
            Sys_Err => SystemErrors.VCG_Heap_Is_Exhausted,
            Msg     => "Linked list length exceeds Natural'Last");
         Current_Length :=
           Get_Length (VCG_Heap, The_List) +
           Get_Length (VCG_Heap, The_List_To_Append);
         Cells.Set_Natural_Value (VCG_Heap, Cells.Cell (The_List), Current_Length);

         --  Nuke the second list.
         Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append), Cells.Null_Cell);
         Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List_To_Append), Cells.Null_Cell);
         Cells.Set_Natural_Value (VCG_Heap, Cells.Cell (The_List_To_Append), 0);
      end if;
   end Append_List;

   procedure Empty
     (VCG_Heap : in out Cells.Heap_Record;
      The_List : in     Linked_List)
   is
      N          : Cells.Cell;
      To_Dispose : Cells.Cell;
   begin
      --  Iterator over element, disposing of them.
      N := Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List));
      while not Cells.Is_Null_Cell (N) loop
         To_Dispose := N;
         N := Cells.Get_A_Ptr (VCG_Heap, N);

         Cells.Dispose_Of_Cell (VCG_Heap, To_Dispose);
      end loop;

      --  Tidy up the linked list.
      Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List), Cells.Null_Cell);
      Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List), Cells.Null_Cell);
      Cells.Set_Natural_Value (VCG_Heap, Cells.Cell (The_List), 0);
   end Empty;

   ------------------------------------------------------------------------------
   --  Iterators
   ------------------------------------------------------------------------------

   function First_Cell
     (VCG_Heap : in Cells.Heap_Record;
      The_List : in Linked_List)
     return Iterator
   is
   begin
      return Iterator (Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List)));
   end First_Cell;

   function Next_Cell
     (VCG_Heap : in Cells.Heap_Record;
      Previous : in Iterator)
     return Iterator
   is
      N : Cells.Cell;
   begin
      if Cells.Is_Null_Cell (Cells.Cell (Previous)) then
         N := Cells.Null_Cell;
      else
         N := Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (Previous));
      end if;
      return Iterator (N);
   end Next_Cell;

   function Current_Cell
     (VCG_Heap : in Cells.Heap_Record;
      Current  : in Iterator)
     return Cells.Cell
   is
      C : Cells.Cell;
   begin
      if Cells.Is_Null_Cell (Cells.Cell (Current)) then
         C := Cells.Null_Cell;
      else
         C := Cells.Get_B_Ptr (VCG_Heap, Cells.Cell (Current));
      end if;
      return C;
   end Current_Cell;

   function Is_Null_Iterator
     (Current : in Iterator)
     return Boolean
   is
   begin
      return Cells.Is_Null_Cell (Cells.Cell (Current));
   end Is_Null_Iterator;

   procedure Join_And
     (VCG_Heap     : in out Cells.Heap_Record;
      The_List     : in     Linked_List;
      The_Conjunct :    out Cells.Cell)
   is
      Iter : Iterator;
      C    : Cells.Cell;
   begin
      The_Conjunct := Cells.Null_Cell;
      Iter := First_Cell (VCG_Heap, The_List);
      while not Is_Null_Iterator (Iter) loop
         C := Current_Cell (VCG_Heap, Iter);

         if Cells.Is_Null_Cell (The_Conjunct) then
            The_Conjunct := C;
         else
            Utility.Conjoin (VCG_Heap, C, The_Conjunct);
         end if;

         Iter := Next_Cell (VCG_Heap, Iter);
      end loop;

      if Cells.Is_Null_Cell (The_Conjunct) then
         Utility.Create_Bool (VCG_Heap, True, The_Conjunct);
      end if;
   end Join_And;

   --  See Knuth, Vol 1, Section 2.2.3, Exercise 7. (I cheated and
   --  copied from the answers...)
   procedure Invert
     (VCG_Heap     : in out Cells.Heap_Record;
      The_List     : in     Linked_List)
   is
      P, Q, R : Cells.Cell;
   begin
      --  I1
      P := Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List));
      Q := Cells.Null_Cell;

      --  I2
      while not Cells.Is_Null_Cell (P) loop
         R := Q;
         Q := P;
         P := Cells.Get_A_Ptr (VCG_Heap, Q);
         Cells.Set_A_Ptr (VCG_Heap, Q, R);
      end loop;

      --  I3 (but also change the pointer to the last cell).
      Cells.Set_B_Ptr (VCG_Heap, Cells.Cell (The_List),
                       Cells.Get_A_Ptr (VCG_Heap, Cells.Cell (The_List)));
      Cells.Set_A_Ptr (VCG_Heap, Cells.Cell (The_List), Q);
   end Invert;

end Cells.Utility.List;
