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

separate (Sem.Wf_Basic_Declarative_Item.Wf_Basic_Declaration.Wf_Full_Type_Declaration)
procedure Wf_Integer
  (Node       : in     STree.SyntaxNode;
   Scope      : in     Dictionary.Scopes;
   Ident_Node : in     STree.SyntaxNode;
   Dec_Loc    : in     LexTokenManager.Token_Position;
   The_Heap   : in out Heap.HeapRecord)
is
   Exp_Node                      : STree.SyntaxNode;
   Left_Exp_Type, Right_Exp_Type : Exp_Record;
   Unwanted_Seq                  : SeqAlgebra.Seq;
   Lower, Upper                  : LexTokenManager.Lex_String; -- StoreVals of type's bounds
   Unused_Component_Data         : ComponentManager.ComponentData;
   Type_Symbol                   : Dictionary.Symbol;

   -- Checks that Lower .. Upper are legal wrt System.Min_Int and System.Max_Int
   procedure Check_Against_Root_Integer
     (Dec_Loc      : in LexTokenManager.Token_Position;
      Lower, Upper : in LexTokenManager.Lex_String)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dec_Loc,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Lower,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Upper;
   is
      System_Sym  : Dictionary.Symbol;
      Min_Int_Sym : Dictionary.Symbol;
      Min_Int_Val : LexTokenManager.Lex_String;
      Max_Int_Sym : Dictionary.Symbol;
      Max_Int_Val : LexTokenManager.Lex_String;
      Result      : Maths.Value;
      Unused      : Maths.ErrorCode;
      Range_OK    : Boolean;
   begin
      -- We only check in 95 onwards, since System may not be
      -- specified in the target configuration file in SPARK83 mode.
      case CommandLineData.Content.Language_Profile is
         when CommandLineData.SPARK83 =>
            null;
         when CommandLineData.SPARK95_Onwards =>

            System_Sym :=
              Dictionary.LookupItem
              (Name              => LexTokenManager.System_Token,
               Scope             => Dictionary.GlobalScope,
               Context           => Dictionary.ProgramContext,
               Full_Package_Name => False);

            -- The user may or may not have bothered to supply
            -- package System, so...
            if not Dictionary.Is_Null_Symbol (System_Sym) then

               -- Find System.Min_Int and check Lower against it.
               Min_Int_Sym :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => System_Sym,
                  Selector => LexTokenManager.Min_Int_Token,
                  Scope    => Dictionary.GetScope (System_Sym),
                  Context  => Dictionary.ProgramContext);

               -- Even if the user has supplied a package System, they might
               -- not have declared Min_Int, so again we have to guard...
               if not Dictionary.Is_Null_Symbol (Min_Int_Sym) then

                  Min_Int_Val := Dictionary.Get_Value (The_Constant => Min_Int_Sym);

                  if LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Lower,
                     Lex_Str2 => LexTokenManager.Null_String) /=
                    LexTokenManager.Str_Eq
                    and then LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Min_Int_Val,
                     Lex_Str2 => LexTokenManager.Null_String) /=
                    LexTokenManager.Str_Eq then

                     --# accept Flow, 10, Unused, "Expected ineffective assignment";
                     Maths.GreaterOrEqual (Maths.ValueRep (Lower), Maths.ValueRep (Min_Int_Val), Result, Unused);
                     --# end accept;

                     --# accept Flow, 10, Unused, "Expected ineffective assignment";
                     Maths.ValueToBool (Result, Range_OK, Unused);
                     --# end accept;

                     if not Range_OK then
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 781,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Dec_Loc,
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  end if;

               end if;

               --# assert True; -- for RTC generation

               -- Find System.Max_Int and check Upper against it.
               Max_Int_Sym :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => System_Sym,
                  Selector => LexTokenManager.Max_Int_Token,
                  Scope    => Dictionary.GetScope (System_Sym),
                  Context  => Dictionary.ProgramContext);

               -- Even if the user has supplied a package System, they might
               -- not have declared Max_Int, so again we have to guard...
               if not Dictionary.Is_Null_Symbol (Max_Int_Sym) then

                  Max_Int_Val := Dictionary.Get_Value (The_Constant => Max_Int_Sym);

                  if LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Lower,
                     Lex_Str2 => LexTokenManager.Null_String) /=
                    LexTokenManager.Str_Eq
                    and then LexTokenManager.Lex_String_Case_Insensitive_Compare
                    (Lex_Str1 => Max_Int_Val,
                     Lex_Str2 => LexTokenManager.Null_String) /=
                    LexTokenManager.Str_Eq then

                     --# accept Flow, 10, Unused, "Expected ineffective assignment";
                     Maths.LesserOrEqual (Maths.ValueRep (Upper), Maths.ValueRep (Max_Int_Val), Result, Unused);
                     --# end accept;

                     --# accept Flow, 10, Unused, "Expected ineffective assignment";
                     Maths.ValueToBool (Result, Range_OK, Unused);
                     --# end accept;

                     if not Range_OK then
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 782,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Dec_Loc,
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  end if;

               end if;

            end if;
      end case;
      --# accept Flow, 33, Unused, "Expected to be neither referenced nor exported";
   end Check_Against_Root_Integer;

begin -- Wf_Integer
   Exp_Node := Child_Node (Current_Node => Child_Node (Current_Node => Child_Node (Current_Node => Node)));
   -- ASSUME Exp_Node = attribute OR simple_expression
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.attribute
        or else Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.simple_expression,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Node = attribute OR simple_expression in Wf_Integer");
   SeqAlgebra.CreateSeq (The_Heap, Unwanted_Seq);
   ComponentManager.Initialise (Unused_Component_Data);
   --# accept Flow, 10, Unused_Component_Data, "Expected ineffective assignment";
   Walk_Expression_P.Walk_Expression
     (Exp_Node                => Exp_Node,
      Scope                   => Scope,
      Type_Context            => Dictionary.GetUnknownTypeMark,
      Context_Requires_Static => True,
      Ref_Var                 => Unwanted_Seq,
      Result                  => Left_Exp_Type,
      Component_Data          => Unused_Component_Data,
      The_Heap                => The_Heap);
   --# end accept;
   SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
   Maths.StorageRep (Left_Exp_Type.Value, Lower);
   if Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.attribute then
      -- ASSUME Exp_Node = attribute
      if Left_Exp_Type.Is_ARange then
         Maths.StorageRep (Left_Exp_Type.Range_RHS, Upper);
         ErrorHandler.Semantic_Error
           (Err_Num   => 45,
            Reference => 1,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      else
         Lower := LexTokenManager.Null_String; -- no value in error case
         Upper := LexTokenManager.Null_String; -- no value in error case
         ErrorHandler.Semantic_Error
           (Err_Num   => 98,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   elsif Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.simple_expression then
      -- ASSUME Exp_Node = simple_expression
      if not (Dictionary.TypeIsInteger (Left_Exp_Type.Type_Symbol)
                or else Dictionary.TypeIsModular (Left_Exp_Type.Type_Symbol)
                or else Dictionary.IsUnknownTypeMark (Left_Exp_Type.Type_Symbol)) then
         Lower := LexTokenManager.Null_String; -- no value in error case
         ErrorHandler.Semantic_Error
           (Err_Num   => 38,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      elsif Left_Exp_Type.Is_ARange then
         Lower := LexTokenManager.Null_String; -- no value in error case
         ErrorHandler.Semantic_Error
           (Err_Num   => 114,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;

      Exp_Node := Next_Sibling (Current_Node => Exp_Node);
      -- ASSUME Exp_Node = simple_expression
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Exp_Node) = SP_Symbols.simple_expression,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = simple_expression in Wf_Integer");
      SeqAlgebra.CreateSeq (The_Heap, Unwanted_Seq);
      ComponentManager.Initialise (Unused_Component_Data);
      --# accept Flow, 10, Unused_Component_Data, "Expected ineffective assignment";
      Walk_Expression_P.Walk_Expression
        (Exp_Node                => Exp_Node,
         Scope                   => Scope,
         Type_Context            => Dictionary.GetUnknownTypeMark,
         Context_Requires_Static => True,
         Ref_Var                 => Unwanted_Seq,
         Result                  => Right_Exp_Type,
         Component_Data          => Unused_Component_Data,
         The_Heap                => The_Heap);
      --# end accept;
      SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
      Maths.StorageRep (Right_Exp_Type.Value, Upper);

      if not (Dictionary.TypeIsInteger (Right_Exp_Type.Type_Symbol)
                or else Dictionary.TypeIsModular (Right_Exp_Type.Type_Symbol)
                or else Dictionary.IsUnknownTypeMark (Right_Exp_Type.Type_Symbol)) then
         Upper := LexTokenManager.Null_String; -- no value in error case
         ErrorHandler.Semantic_Error
           (Err_Num   => 38,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      elsif Right_Exp_Type.Is_ARange then
         Lower := LexTokenManager.Null_String; -- no value in error case
         ErrorHandler.Semantic_Error
           (Err_Num   => 114,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;

      if not (Left_Exp_Type.Is_Static and then Right_Exp_Type.Is_Static) then
         ErrorHandler.Semantic_Error
           (Err_Num   => 45,
            Reference => 1,
            Position  => Node_Position (Node => Exp_Node),
            Id_Str    => LexTokenManager.Null_String);
      end if;
   else
      Lower := LexTokenManager.Null_String; -- no value in error case
      Upper := LexTokenManager.Null_String; -- no value in error case
   end if;

   Empty_Type_Check (Dec_Loc => Dec_Loc,
                     Lower   => Lower,
                     Upper   => Upper);
   Check_Against_Root_Integer (Dec_Loc => Dec_Loc,
                               Lower   => Lower,
                               Upper   => Upper);
   Dictionary.Add_Integer_Type
     (Name        => Node_Lex_String (Node => Ident_Node),
      Comp_Unit   => ContextManager.Ops.Current_Unit,
      Declaration => Dictionary.Location'(Start_Position => Dec_Loc,
                                          End_Position   => Dec_Loc),
      Lower       => Lower,
      Upper       => Upper,
      Scope       => Scope,
      Context     => Dictionary.ProgramContext,
      The_Type    => Type_Symbol);
   STree.Add_Node_Symbol (Node => Ident_Node,
                          Sym  => Type_Symbol);
   if ErrorHandler.Generate_SLI then
      SLI.Generate_Xref_Symbol
        (Comp_Unit      => ContextManager.Ops.Current_Unit,
         Parse_Tree     => Ident_Node,
         Symbol         => Type_Symbol,
         Is_Declaration => True);
   end if;
   Heap.ReportUsage (The_Heap);
end Wf_Integer;
