-------------------------------------------------------------------------------
-- (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.Walk_Expression_P)
function Attribute_Designator_Type_From_Context
  (Exp_Node : STree.SyntaxNode;
   E_Stack  : Exp_Stack.Exp_Stack_Type;
   T_Stack  : Type_Context_Stack.T_Stack_Type)
  return     Dictionary.Symbol
is
   Ident_Node       : STree.SyntaxNode;
   Arg_Exp_Node     : STree.SyntaxNode;
   New_Context_Type : Dictionary.Symbol;
   Top_Of_Exp_Stack : Sem.Exp_Record;
   Ident_Str        : LexTokenManager.Lex_String;
begin
   Top_Of_Exp_Stack := Exp_Stack.Top (Stack => E_Stack);

   -- Find the attribute identifier (e.g. "Val" or "Max")
   Ident_Node := STree.Child_Node (Current_Node => Exp_Node);
   -- ASSUME Ident_Node = attribute_designator OR annotation_attribute_designator OR attribute_ident
   if STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.attribute_designator
     or else STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.annotation_attribute_designator then
      -- ASSUME Ident_Node = attribute_designator OR annotation_attribute_designator
      Ident_Node := STree.Next_Sibling (Current_Node => Ident_Node);
   elsif STree.Syntax_Node_Type (Node => Ident_Node) /= SP_Symbols.attribute_ident then
      Ident_Node := STree.NullNode;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = attribute_ident in Attribute_Designator_Type_From_Context");
   end if;
   -- ASSUME Ident_Node = attribute_ident
   SystemErrors.RT_Assert
     (C       => STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.attribute_ident,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Ident_Node = attribute_ident in Attribute_Designator_Type_From_Context");
   Ident_Str := STree.Node_Lex_String (Node => Ident_Node);

   -- Find the (possibly non-existant) first argument.
   Arg_Exp_Node := STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => Ident_Node));
   -- ASSUME Arg_Exp_Node = expression OR annotation_expression OR NULL
   if Arg_Exp_Node = STree.NullNode then
      -- ASSUME Arg_Exp_Node = NULL
      -- No arguments for this attribute, so no change in context
      New_Context_Type := Type_Context_Stack.Top (Stack => T_Stack);
   elsif STree.Syntax_Node_Type (Node => Arg_Exp_Node) = SP_Symbols.expression
     or else STree.Syntax_Node_Type (Node => Arg_Exp_Node) = SP_Symbols.annotation_expression then
      -- ASSUME Arg_Exp_Node = expression OR annotation_expression
      -- This attribute has 1 or 2 arguments.  The context for them
      -- is always the same (phew!), but depends on the prefix
      if (LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ident_Str,
                                                               Lex_Str2 => LexTokenManager.Val_Token) =
            LexTokenManager.Str_Eq
            or else LexTokenManager.Lex_String_Case_Insensitive_Compare
            (Lex_Str1 => Ident_Str,
             Lex_Str2 => LexTokenManager.First_Token) =
            LexTokenManager.Str_Eq
            or else LexTokenManager.Lex_String_Case_Insensitive_Compare
            (Lex_Str1 => Ident_Str,
             Lex_Str2 => LexTokenManager.Last_Token) =
            LexTokenManager.Str_Eq
            or else LexTokenManager.Lex_String_Case_Insensitive_Compare
            (Lex_Str1 => Ident_Str,
             Lex_Str2 => LexTokenManager.Length_Token) =
            LexTokenManager.Str_Eq
            or else LexTokenManager.Lex_String_Case_Insensitive_Compare
            (Lex_Str1 => Ident_Str,
             Lex_Str2 => LexTokenManager.Range_Token) =
            LexTokenManager.Str_Eq
            or else LexTokenManager.Lex_String_Case_Insensitive_Compare
            (Lex_Str1 => Ident_Str,
             Lex_Str2 => LexTokenManager.Mod_Token) =
            LexTokenManager.Str_Eq) then
         -- 'Val takes any integer, modular, or universal integer as argument
         -- in SPARK95, or universal integer only in SPARK83.
         -- Array attributes (when they have an argument) likewise.
         -- There is no context available.
         New_Context_Type := Dictionary.GetUniversalIntegerType;
      elsif (LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ident_Str,
                                                                  Lex_Str2 => LexTokenManager.Tail_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Append_Token) =
               LexTokenManager.Str_Eq) then
         -- Tail and Append never change context
         New_Context_Type := Type_Context_Stack.Top (Stack => T_Stack);
      elsif (LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Ident_Str,
                                                                  Lex_Str2 => LexTokenManager.Pos_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Pred_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Succ_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Min_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Max_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Floor_Token) =
               LexTokenManager.Str_Eq
               or else LexTokenManager.Lex_String_Case_Insensitive_Compare
               (Lex_Str1 => Ident_Str,
                Lex_Str2 => LexTokenManager.Ceiling_Token) =
               LexTokenManager.Str_Eq) then
         -- Other attributes with arguments -
         -- context is the type given by the prefix.
         New_Context_Type := Top_Of_Exp_Stack.Type_Symbol;
      else
         -- Any other attribute with an argument must be an error,
         -- which will be picked up later on in wf_attribute_designator, but
         -- we still have to push something, so...
         New_Context_Type := Type_Context_Stack.Top (Stack => T_Stack);
      end if;
   else
      New_Context_Type := Dictionary.NullSymbol;
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Arg_Exp_Node = expression OR annotation_expression OR NULL in Attribute_Designator_Type_From_Context");
   end if;
   return New_Context_Type;
end Attribute_Designator_Type_From_Context;
