-------------------------------------------------------------------------------
-- (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 Debug;
package body StmtStack is
   EmptyStack : constant StmtStacks :=
     StmtStacks'(Vector  => StmtVector'(others => StmtRecord'(StmtNmbr => 0,
                                                              Kind     => ArcKind'First)),
                 Pointer => 0);

   S : StmtStacks;

   function IsEmpty return Boolean is
   begin
      return S.Pointer = 0;
   end IsEmpty;

   function Top return StmtRecord
   -- pre  not IsEmpty (S);
   is
   begin
      --# accept Flow, 10, "Expected ineffective statement";
      if S.Pointer = 0 then
         --# end accept;
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Statement_Stack_Underflow,
                                   Msg     => "");
      end if;
      return S.Vector (S.Pointer);
   end Top;

   procedure Clear is
   begin
      S := EmptyStack;
   end Clear;

   procedure Pop
   -- pre  not IsEmpty (S);
   is
   begin
      if S.Pointer = 0 then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Statement_Stack_Underflow,
                                   Msg     => "");
      end if;
      S.Pointer := S.Pointer - 1;
   end Pop;

   procedure Push (R : in StmtRecord) is
   begin
      if S.Pointer = StmtRange'Last then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Statement_Stack_Overflow,
                                   Msg     => "");
      end if;
      S.Pointer            := S.Pointer + 1;
      S.Vector (S.Pointer) := R;
   end Push;

   procedure Dump_Stack (Msg : in String) is
      --# hide Dump_Stack;
   begin
      Debug.PrintMsg (Msg, True);
      if S.Pointer = 0 then
         Debug.PrintMsg ("Empty", True);
      else
         Debug.PrintMsg ("Top", True);
         for I in reverse StmtRange range 1 .. S.Pointer loop
            Debug.PrintMsg (ArcKind'Image (S.Vector (I).Kind), False);
            Debug.PrintMsg (Integer'Image (S.Vector (I).StmtNmbr), True);
         end loop;
         Debug.PrintMsg ("Bottom", True);
      end if;
   end Dump_Stack;

begin
   S := EmptyStack;
end StmtStack;
