-------------------------------------------------------------------------------
-- (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.Wf_Attribute_Designator)
procedure Calc_Attribute
  (Node         : in     STree.SyntaxNode;
   Attrib_Name  : in     LexTokenManager.Lex_String;
   Prefix       : in     Dictionary.Symbol;
   Scope        : in     Dictionary.Scopes;
   Base_Found   : in     Boolean;
   Argument     : in out Maths.Value;
   RHS_Of_Range :    out Maths.Value)
is

   type Err_Lookup is array (Boolean) of Natural;
   Which_Err : constant Err_Lookup := Err_Lookup'(False => 402,
                                                  True  => 399);

   Err             : Maths.ErrorCode;
   Local_Base_Type : Dictionary.Symbol;
   Argument_Local  : Maths.Value;

   procedure Calc_Array_Attribute
     (Attrib_Name  : in     LexTokenManager.Lex_String;
      Prefix       : in     Dictionary.Symbol;
      Scope        : in     Dictionary.Scopes;
      Base_Found   : in     Boolean;
      Argument     : in out Maths.Value;
      RHS_Of_Range : in out Maths.Value;
      Err          : in out Maths.ErrorCode)
   --# global in Dictionary.Dict;
   --#        in LexTokenManager.State;
   --# derives Argument,
   --#         Err,
   --#         RHS_Of_Range from *,
   --#                           Argument,
   --#                           Attrib_Name,
   --#                           Base_Found,
   --#                           Dictionary.Dict,
   --#                           LexTokenManager.State,
   --#                           Prefix,
   --#                           Scope;
   is
      Dimension     : Positive;
      V_Low, V_High : Maths.Value;

      function Get_Dimension (Argument : Maths.Value) return Positive is
         Unused_Err : Maths.ErrorCode;
         Dimension  : Integer;
      begin
         if Maths.HasNoValue (Argument) then
            Dimension := 1;
         else
            --# accept Flow, 10, Unused_Err, "Expected ineffective assignment";
            Maths.ValueToInteger (Argument, -- expect ineffective assign to Unused_Err
                                  -- to get
                                  Dimension, Unused_Err);
            --# end accept;
            if Dimension <= 0 then
               Dimension := 1;
            end if;
         end if;
         --# accept Flow, 33, Unused_Err, "Expected to be neither referenced nor exported";
         return Dimension;
      end Get_Dimension;

   begin -- Calc_Array_Attribute
      if Base_Found then
         -- the only valid attribute would be size and we never know what
         -- the size of things is so we can only return the null value
         Argument := Maths.NoValue;
      elsif Dictionary.Is_Unconstrained_Array_Type_Mark (Prefix, Scope) then
         Argument := Maths.NoValue;
      else -- a constrained array type or subtype
         Dimension := Get_Dimension (Argument);
         if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                                 Lex_Str2 => LexTokenManager.Range_Token) =
           LexTokenManager.Str_Eq then
            Argument     := Maths.ValueRep (Dictionary.GetArrayAttributeValue (LexTokenManager.First_Token, Prefix, Dimension));
            RHS_Of_Range := Maths.ValueRep (Dictionary.GetArrayAttributeValue (LexTokenManager.Last_Token, Prefix, Dimension));
         elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Attrib_Name,
            Lex_Str2 => LexTokenManager.Length_Token) =
           LexTokenManager.Str_Eq then
            V_Low  := Maths.ValueRep (Dictionary.GetArrayAttributeValue (LexTokenManager.First_Token, Prefix, Dimension));
            V_High := Maths.ValueRep (Dictionary.GetArrayAttributeValue (LexTokenManager.Last_Token, Prefix, Dimension));
            --# accept Flow, 10, Err, "Expected ineffective assignment";
            Maths.Subtract (V_High, -- flow error expected
                            V_Low, Argument, Err);
            --# end accept;
            V_High := Argument;
            Maths.Add (V_High, Maths.OneInteger, Argument, Err);
         else -- first/last
            Argument := Maths.ValueRep (Dictionary.GetArrayAttributeValue (Attrib_Name, Prefix, Dimension));
         end if;
      end if;
   end Calc_Array_Attribute;

begin -- Calc_Attribute

   -- this procedure is only called wf_attribute_designator if the attribute
   -- is well-formed.

   RHS_Of_Range := Maths.NoValue;  -- default value unless 'RANGE processed

   if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                           Lex_Str2 => LexTokenManager.Succ_Token) =
     LexTokenManager.Str_Eq then
      Maths.SuccOp (Argument, Err);

      Local_Base_Type := Dictionary.GetRootType (Prefix);

      if Dictionary.TypeIsModular (Local_Base_Type) then
         Maths.Modulus
           (FirstNum  => Argument,
            SecondNum => Maths.ValueRep
              (Dictionary.GetScalarAttributeValue
                 (Base     => False,
                  Name     => LexTokenManager.Modulus_Token,
                  TypeMark => Local_Base_Type)),
            Result    => Argument_Local,
            Ok        => Err);
      else
         Sem.Constraint_Check
           (Val           => Argument,
            New_Val       => Argument_Local,
            Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_attribute_designator,
            Typ           => Local_Base_Type,
            Position      => STree.Node_Position (Node => Node));
      end if;
      Argument := Argument_Local;
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Pred_Token) =
     LexTokenManager.Str_Eq then
      Maths.PredOp (Argument, Err);

      Local_Base_Type := Dictionary.GetRootType (Prefix);

      if Dictionary.TypeIsModular (Local_Base_Type) then
         Maths.Modulus
           (FirstNum  => Argument,
            SecondNum => Maths.ValueRep
              (Dictionary.GetScalarAttributeValue
                 (Base     => False,
                  Name     => LexTokenManager.Modulus_Token,
                  TypeMark => Local_Base_Type)),
            Result    => Argument_Local,
            Ok        => Err);
      else
         Sem.Constraint_Check
           (Val           => Argument,
            New_Val       => Argument_Local,
            Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_attribute_designator,
            Typ           => Local_Base_Type,
            Position      => STree.Node_Position (Node => Node));
      end if;
      Argument := Argument_Local;
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Floor_Token) =
     LexTokenManager.Str_Eq then
      Maths.Floor (Argument, Argument_Local, Err);
      Argument        := Argument_Local;
      Local_Base_Type := Dictionary.GetRootType (Prefix);
      Sem.Constraint_Check
        (Val           => Argument,
         New_Val       => Argument_Local,
         Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_attribute_designator,
         Typ           => Local_Base_Type,
         Position      => STree.Node_Position (Node => Node));
      Argument := Argument_Local;
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Ceiling_Token) =
     LexTokenManager.Str_Eq then
      Maths.Ceiling (Argument, Argument_Local, Err);
      Argument        := Argument_Local;
      Local_Base_Type := Dictionary.GetRootType (Prefix);
      Sem.Constraint_Check
        (Val           => Argument,
         New_Val       => Argument_Local,
         Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_attribute_designator,
         Typ           => Local_Base_Type,
         Position      => STree.Node_Position (Node => Node));
      Argument := Argument_Local;
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Mod_Token) =
     LexTokenManager.Str_Eq then
      Local_Base_Type := Dictionary.GetRootType (Prefix);
      Maths.Modulus
        (FirstNum  => Argument,
         SecondNum => Maths.ValueRep
           (Dictionary.GetScalarAttributeValue
              (Base     => False,
               Name     => LexTokenManager.Modulus_Token,
               TypeMark => Local_Base_Type)),
         Result    => Argument_Local,
         Ok        => Err);
      Argument := Argument_Local;
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Val_Token) =
     LexTokenManager.Str_Eq then
      Err := Maths.NoError;
      -- upper and lower bounds check required
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Pos_Token) =
     LexTokenManager.Str_Eq then
      Err := Maths.NoError;
      -- no action required, no error can occur
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Valid_Token) =
     LexTokenManager.Str_Eq then
      Err := Maths.NoError;
      -- no action required, no error can occur
   elsif LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attrib_Name,
                                                              Lex_Str2 => LexTokenManager.Size_Token) =
     LexTokenManager.Str_Eq then
      Err      := Maths.NoError;
      Argument := Maths.ValueRep (Dictionary.TypeSizeAttribute (Prefix));
   elsif Dictionary.TypeIsScalar (Prefix) then
      Err      := Maths.NoError;
      Argument := Maths.ValueRep (Dictionary.GetScalarAttributeValue (Base_Found, Attrib_Name, Prefix));
   elsif Dictionary.TypeIsArray (Prefix) then
      Err := Maths.NoError;
      Calc_Array_Attribute
        (Attrib_Name  => Attrib_Name,
         Prefix       => Prefix,
         Scope        => Scope,
         Base_Found   => Base_Found,
         Argument     => Argument,
         RHS_Of_Range => RHS_Of_Range,
         Err          => Err);
   else -- non-implemented attribute - should never occur
      Argument := Maths.NoValue;
      Err      := Maths.NoError;
   end if;

   case Err is
      when Maths.NoError =>
         null;
      when Maths.DivideByZero =>
         Argument := Maths.NoValue;
         ErrorHandler.Semantic_Error
           (Err_Num   => 400,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when Maths.ConstraintError =>
         Argument := Maths.NoValue;
         ErrorHandler.Semantic_Error
           (Err_Num   => Which_Err (STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_attribute_designator),
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when Maths.OverFlow =>
         Argument := Maths.NoValue;
         ErrorHandler.Semantic_Warning
           (Err_Num  => 200,
            Position => STree.Node_Position (Node => Node),
            Id_Str   => LexTokenManager.Null_String);
      when others => -- indicates internal error in maths package
         Argument := Maths.NoValue;
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Math_Error,
                                   Msg     => "in Calc_Attribute");
   end case;
end Calc_Attribute;
