-------------------------------------------------------------------------------
-- (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 CStacks;

package body Structures is

   procedure CopyStructure (Heap     : in out Cells.Heap_Record;
                            Root     : in     Cells.Cell;
                            RootCopy :    out Cells.Cell) is
      CopiedCellStack, UnexploredCellStack : CStacks.Stack;
      TopCell, TopCellCopy                 : Cells.Cell;

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

      procedure Mark (C : in Cells.Cell)
      --# global in out CopiedCellStack;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --#        in out UnexploredCellStack;
      --# derives CopiedCellStack,
      --#         UnexploredCellStack   from *,
      --#                                    C,
      --#                                    CopiedCellStack,
      --#                                    Heap &
      --#         Heap,
      --#         Statistics.TableUsage from *,
      --#                                    C,
      --#                                    CopiedCellStack,
      --#                                    Heap,
      --#                                    UnexploredCellStack;
      is
      begin
         if not Cells.Is_Null_Cell (C) then
            if not Cells.Is_Marked (Heap, C) then
               Cells.Mark_Cell (Heap, C);
               CStacks.Push (Heap, C, CopiedCellStack);
               CStacks.Push (Heap, C, UnexploredCellStack);
               Cells.Create_Copy (Heap, C);
            end if;
         end if;
      end Mark;

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

   begin -- CopyStructure;
      CStacks.CreateStack (UnexploredCellStack);
      CStacks.CreateStack (CopiedCellStack);
      Mark (Root);
      RootCopy := Cells.Get_Copy (Heap, Root);
      loop
         exit when CStacks.IsEmpty (UnexploredCellStack);
         TopCell := CStacks.Top (Heap, UnexploredCellStack);
         CStacks.Pop (Heap, UnexploredCellStack);
         Mark (Cells.Get_A_Ptr (Heap, TopCell));
         Mark (Cells.Get_B_Ptr (Heap, TopCell));
         Mark (Cells.Get_C_Ptr (Heap, TopCell));
      end loop;
      loop
         exit when CStacks.IsEmpty (CopiedCellStack);
         TopCell     := CStacks.Top (Heap, CopiedCellStack);
         TopCellCopy := Cells.Get_Copy (Heap, TopCell);
         if not Cells.Is_Null_Cell (Cells.Get_A_Ptr (Heap, TopCell)) then
            Cells.Set_A_Ptr (Heap, TopCellCopy, Cells.Get_Copy (Heap, Cells.Get_A_Ptr (Heap, TopCell)));
         end if;
         if not Cells.Is_Null_Cell (Cells.Get_B_Ptr (Heap, TopCell)) then
            Cells.Set_B_Ptr (Heap, TopCellCopy, Cells.Get_Copy (Heap, Cells.Get_B_Ptr (Heap, TopCell)));
         end if;
         if not Cells.Is_Null_Cell (Cells.Get_C_Ptr (Heap, TopCell)) then
            Cells.Set_C_Ptr (Heap, TopCellCopy, Cells.Get_Copy (Heap, Cells.Get_C_Ptr (Heap, TopCell)));
         end if;
         Cells.UnMark_Cell (Heap, TopCell);
         CStacks.Pop (Heap, CopiedCellStack);
      end loop;
   end CopyStructure;

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

   procedure DisposeOfStructure (Heap : in out Cells.Heap_Record;
                                 Root : in     Cells.Cell) is
      DefunctCellStack, UnexploredCellStack : CStacks.Stack;
      TopCell                               : Cells.Cell;

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

      procedure MarkAndPush (C : in Cells.Cell)
      --# global in out DefunctCellStack;
      --#        in out Heap;
      --#        in out Statistics.TableUsage;
      --#        in out UnexploredCellStack;
      --# derives DefunctCellStack,
      --#         Statistics.TableUsage,
      --#         UnexploredCellStack   from *,
      --#                                    C,
      --#                                    DefunctCellStack,
      --#                                    Heap &
      --#         Heap                  from *,
      --#                                    C,
      --#                                    DefunctCellStack,
      --#                                    UnexploredCellStack;
      is
      begin
         if not Cells.Is_Null_Cell (C) then
            if not Cells.Is_Marked (Heap, C) then
               Cells.Mark_Cell (Heap, C);
               CStacks.Push (Heap, C, DefunctCellStack);
               CStacks.Push (Heap, C, UnexploredCellStack);
            end if;
         end if;
      end MarkAndPush;

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

   begin -- DisposeOfStructure;
      CStacks.CreateStack (UnexploredCellStack);
      CStacks.CreateStack (DefunctCellStack);
      MarkAndPush (Root);
      loop
         exit when CStacks.IsEmpty (UnexploredCellStack);
         TopCell := CStacks.Top (Heap, UnexploredCellStack);
         CStacks.Pop (Heap, UnexploredCellStack);
         MarkAndPush (Cells.Get_A_Ptr (Heap, TopCell));
         MarkAndPush (Cells.Get_B_Ptr (Heap, TopCell));
         MarkAndPush (Cells.Get_C_Ptr (Heap, TopCell));
      end loop;
      loop
         exit when CStacks.IsEmpty (DefunctCellStack);
         Cells.Dispose_Of_Cell (Heap, CStacks.Top (Heap, DefunctCellStack));
         CStacks.Pop (Heap, DefunctCellStack);
      end loop;
   end DisposeOfStructure;

end Structures;
