-------------------------------------------------------------------------------
-- (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 (Sem.CompUnit)
package body Stack
--# own State is S,
--#              Top_Ptr;
is
   subtype Index_Range is Integer range 1 .. ExaminerConstants.WfCompilationUnitStackMax;
   type Stack_Array is array (Index_Range) of Boolean;
   subtype Top_Range is Integer range 0 .. ExaminerConstants.WfCompilationUnitStackMax;

   S       : Stack_Array;
   Top_Ptr : Top_Range;

   procedure Init
   --# global out S;
   --#        out Top_Ptr;
   --# derives S,
   --#         Top_Ptr from ;
   is
   begin
      Top_Ptr := 0;
      S       := Stack_Array'(others => False);
   end Init;

   procedure Push (X : in Boolean)
   --# global in out S;
   --#        in out Top_Ptr;
   --# derives S       from *,
   --#                      Top_Ptr,
   --#                      X &
   --#         Top_Ptr from *;
   is
   begin
      if Top_Ptr < ExaminerConstants.WfCompilationUnitStackMax then
         Top_Ptr     := Top_Ptr + 1;
         S (Top_Ptr) := X;
      else
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Wf_Compilation_Unit_Stack_Overflow,
                                   Msg     => "in Stack.Push");
      end if;
   end Push;

   -- return of Item removed, it is never used, pop just clears a stack item
   procedure Pop
   --# global in out Top_Ptr;
   --# derives Top_Ptr from *;
   is
   begin
      if Top_Ptr > 0 then
         Top_Ptr := Top_Ptr - 1;
      else
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Wf_Compilation_Unit_Stack_Underflow,
                                   Msg     => "in Stack.Pop");
      end if;
   end Pop;

   function Top return Boolean
   --# global in S;
   --#        in Top_Ptr;
   is
   begin
      --# accept Flow, 10, "Expected ineffective assignment to Top_Ptr";
      if Top_Ptr = 0 then
         --# end accept;
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Wf_Compilation_Unit_Stack_Underflow,
                                   Msg     => "in Stack.Top");
      end if;
      return S (Top_Ptr);
   end Top;

end Stack;
