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

separate (Sem.Walk_Expression_P)
package body Type_Context_Stack is

   procedure Init (Stack : out T_Stack_Type)
   --# post (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#         (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   is
   begin
      Stack.Top_Ptr := 0;
      --# accept Flow, 32, Stack.S, "Safe partial initialisation" &
      --#        Flow, 31, Stack.S, "Safe partial initialisation" &
      --#        Flow, 602, Stack, Stack.S, "Safe partial initialisation";
   end Init;

   procedure Push (X     : in     Dictionary.Symbol;
                   Stack : in out T_Stack_Type)
   --# pre (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#        (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict))) and
   --#   (Dictionary.Is_Null_Symbol (X) or Dictionary.IsTypeMark (X, Dictionary.Dict));
   --# post (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#         (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   is

      procedure Debug
      --# derives ;
      is
         --# hide Debug;
      begin
         if CommandLineData.Content.Debug.Expressions then
            SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Type_Context_Stack PUSH : ", 0);
            E_Strings.Put_String
              (File  => SPARK_IO.Standard_Output,
               E_Str => Dictionary.GenerateSimpleName (Item      => X,
                                                       Separator => "."));
            SPARK_IO.New_Line (SPARK_IO.Standard_Output, 1);
         end if;
      end Debug;

   begin
      if Stack.Top_Ptr < ExaminerConstants.WalkExpStackMax then
         Stack.Top_Ptr           := Stack.Top_Ptr + 1;
         Stack.S (Stack.Top_Ptr) := X;
         Debug;
      else
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Type_Context_Stack_Overflow,
                                   Msg     => "in Type_Context_Stack.Push");
      end if;
      --# accept Flow, 30, Dictionary.Dict, "Variable not referenced nor exported OK";
   end Push;

   procedure Pop (Stack : in out T_Stack_Type)
   --# pre (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#        (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   --# post (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#         (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   is

      procedure Debug
      --# derives ;
      is
         --# hide Debug;
      begin
         if CommandLineData.Content.Debug.Expressions then
            SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Type_Context_Stack POP  : ", 0);
            E_Strings.Put_String
              (File  => SPARK_IO.Standard_Output,
               E_Str => Dictionary.GenerateSimpleName (Item      => Stack.S (Stack.Top_Ptr),
                                                       Separator => "."));
            SPARK_IO.New_Line (SPARK_IO.Standard_Output, 1);
         end if;
      end Debug;

   begin
      if Stack.Top_Ptr > 0 then
         Debug; -- Call Debug _before_ we move the stack pointer!
         Stack.Top_Ptr := Stack.Top_Ptr - 1;
      else
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Type_Context_Stack_Underflow,
                                   Msg     => "in Type_Context_Stack.Pop");
      end if;
      --# accept Flow, 30, Dictionary.Dict, "Variable not referenced nor exported OK";
   end Pop;

   function Top (Stack : T_Stack_Type) return Dictionary.Symbol
   --# pre (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#        (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   --# return S => (Dictionary.Is_Null_Symbol (S) or Dictionary.IsTypeMark (S, Dictionary.Dict));
   is
      Result : Dictionary.Symbol;
   begin
      if Stack.Top_Ptr > 0 then
         Result := Stack.S (Stack.Top_Ptr);
      else
         Result := Dictionary.NullSymbol;
      end if;
      --# accept Flow, 30, Dictionary.Dict, "Variable not referenced nor exported OK" &
      --#        Flow, 50, Dictionary.Dict, "Value is not derived from the imported value OK";
      return Result;
   end Top;

   function Has_One_Entry (Stack : T_Stack_Type) return Boolean
   --# pre (for all I in Index_Range range Index_Range'First .. Stack.Top_Ptr =>
   --#        (Dictionary.Is_Null_Symbol (Stack.S(I)) or Dictionary.IsTypeMark (Stack.S(I), Dictionary.Dict)));
   is
   begin
      return Stack.Top_Ptr = 1;
   end Has_One_Entry;

end Type_Context_Stack;
