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

separate (DAG)
package body LoopContext is

   procedure Initialize (S : out T) is
   begin
      S.CurrentLoopNumber := 0;
      CStacks.CreateStack (S.LoopStack);
   end Initialize;

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

   procedure EnterLoop
     (Scope     : in     Dictionary.Scopes;
      S         : in out T;
      VCGHeap   : in out Cells.Heap_Record;
      LoopScope :    out Dictionary.Scopes)
   is
      LoopSym  : Dictionary.Symbol;
      LoopCell : Cells.Cell;
   begin
      S.CurrentLoopNumber := S.CurrentLoopNumber + 1;
      LoopSym             := Dictionary.GetLoop (Dictionary.GetRegion (Scope), S.CurrentLoopNumber);
      Cells.Create_Cell (VCGHeap, LoopCell);
      Cells.Set_Symbol_Value (VCGHeap, LoopCell, LoopSym);
      CStacks.Push (VCGHeap, LoopCell, S.LoopStack);
      LoopScope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                              The_Unit       => LoopSym);
      --# accept F, 601, Statistics.TableUsage, Dictionary.Dict, "False coupling expected" &
      --#        F, 601, Statistics.TableUsage, Scope, "False coupling expected" &
      --#        F, 601, Statistics.TableUsage, S.CurrentLoopNumber, "False coupling expected";
   end EnterLoop;

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

   procedure ExitLoop (S         : in out T;
                       VCGHeap   : in out Cells.Heap_Record;
                       LoopScope : in out Dictionary.Scopes) is
   begin
      CStacks.Pop (VCGHeap, S.LoopStack);
      LoopScope := Dictionary.GetEnclosingScope (LoopScope);
   end ExitLoop;

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

   function CurrentLoopSym (S       : T;
                            VCGHeap : Cells.Heap_Record) return Dictionary.Symbol is
   begin
      return Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, S.LoopStack));
   end CurrentLoopSym;

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

   function EnclosingLoopSym
     (S           : T;
      VCGHeap     : Cells.Heap_Record;
      CurrentLoop : Dictionary.Symbol)
     return        Dictionary.Symbol
   is
      LocalStack : CStacks.Stack;
      Result     : Dictionary.Symbol;
   begin
      -- start by looping down stack to find CurrentLoop
      LocalStack := S.LoopStack; -- start at top of stack
      loop
         -- we want to find the current loop symbol on top of our ever-reducing stack
         exit when Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, LocalStack)) = CurrentLoop;
         -- not found, so move down (or shrink) stack
         LocalStack := CStacks.NonDestructivePop (VCGHeap, LocalStack);
         -- error trap for case where we search for a non-existing loop symbol
         exit when CStacks.IsEmpty (LocalStack); -- run out of stack
      end loop;
      -- At this point we either have a stack whose top item is  the current loop or (gross error
      -- condition) an empty stack

      -- We want the next loop entry which we can find by shrnking the stack one more time.
      -- We can do this safely, even in the error case, because the A_Ptr of Null is Null
      LocalStack := CStacks.NonDestructivePop (VCGHeap, LocalStack);

      if CStacks.IsEmpty (LocalStack) then
         -- no enclosing loops
         Result := Dictionary.NullSymbol;
      else
         -- there is an enclosing loop
         Result := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, LocalStack));
      end if;
      return Result;
   end EnclosingLoopSym;

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

   function CurrentLoopParameterSym (S       : T;
                                     VCGHeap : Cells.Heap_Record) return Dictionary.Symbol is
   begin
      return Dictionary.GetLoopParameter (CurrentLoopSym (S, VCGHeap));
   end CurrentLoopParameterSym;

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

   function CurrentLoopMovesInReverse (S       : T;
                                       VCGHeap : Cells.Heap_Record) return Boolean is
   begin
      return Dictionary.LoopParameterMovesInReverse (CurrentLoopParameterSym (S, VCGHeap));
   end CurrentLoopMovesInReverse;

end LoopContext;
