-------------------------------------------------------------------------------
-- (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_Modular
  (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;
   Exp_Type               : Exp_Record;
   Unwanted_Seq           : SeqAlgebra.Seq;
   Modulus                : LexTokenManager.Lex_String;
   Unused_Component_Data  : ComponentManager.ComponentData;
   Type_Symbol            : Dictionary.Symbol;
   System_Sym             : Dictionary.Symbol;
   Max_Binary_Modulus_Sym : Dictionary.Symbol;
   Max_Binary_Modulus_Val : LexTokenManager.Lex_String;
   Result                 : Maths.Value;
   Unused                 : Maths.ErrorCode;
   Modulus_OK             : Boolean;
begin
   case CommandLineData.Content.Language_Profile is
      when CommandLineData.SPARK83 =>
         ErrorHandler.Semantic_Error
           (Err_Num   => 801,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when CommandLineData.SPARK95_Onwards =>
         -- Fetch Modulus, which is a simple_expression
         Exp_Node := Next_Sibling (Current_Node => Child_Node (Current_Node => 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_Modular");
         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                  => Exp_Type,
            Component_Data          => Unused_Component_Data,
            The_Heap                => The_Heap);
         --# end accept;
         SeqAlgebra.DisposeOfSeq (The_Heap, Unwanted_Seq);
         Maths.StorageRep (Exp_Type.Value, Modulus);

         if not (Dictionary.TypeIsInteger (Exp_Type.Type_Symbol)
                   or else Dictionary.TypeIsModular (Exp_Type.Type_Symbol)
                   or else Dictionary.IsUnknownTypeMark (Exp_Type.Type_Symbol)) then
            Modulus := LexTokenManager.Null_String;
            ErrorHandler.Semantic_Error
              (Err_Num   => 38,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Exp_Node),
               Id_Str    => LexTokenManager.Null_String);
         end if;

         if not Exp_Type.Is_Static then
            Modulus := LexTokenManager.Null_String;
            ErrorHandler.Semantic_Error
              (Err_Num   => 36,
               Reference => 1,
               Position  => Node_Position (Node => Exp_Node),
               Id_Str    => LexTokenManager.Null_String);
         elsif Exp_Type.Is_ARange then
            ErrorHandler.Semantic_Error
              (Err_Num   => 114,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Exp_Node),
               Id_Str    => LexTokenManager.Null_String);
         else
            if Maths.IsAPositivePowerOf2 (Exp_Type.Value) then

               -- All is OK so far, so finally check the modulus against
               -- System.Max_Binary_Modulus
               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.Max_Binary_Modulus
                  Max_Binary_Modulus_Sym :=
                    Dictionary.LookupSelectedItem
                    (Prefix   => System_Sym,
                     Selector => LexTokenManager.Max_Binary_Modulus_Token,
                     Scope    => Dictionary.GetScope (System_Sym),
                     Context  => Dictionary.ProgramContext);

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

                     Max_Binary_Modulus_Val := Dictionary.Get_Value (The_Constant => Max_Binary_Modulus_Sym);

                     --# accept Flow, 10, Unused, "Expected ineffective assignment";
                     Maths.LesserOrEqual (Exp_Type.Value, Maths.ValueRep (Max_Binary_Modulus_Val), Result, Unused);

                     Maths.ValueToBool (Result, Modulus_OK, Unused);
                     --# end accept;

                     if not Modulus_OK then
                        ErrorHandler.Semantic_Error
                          (Err_Num   => 783,
                           Reference => ErrorHandler.No_Reference,
                           Position  => Node_Position (Node => Exp_Node),
                           Id_Str    => LexTokenManager.Null_String);
                     end if;
                  end if;
               end if;
            else
               Modulus := LexTokenManager.Null_String;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 800,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Exp_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
         end if;

         Dictionary.Add_Modular_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),
            Modulus     => Modulus,
            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;
   end case;
   --# accept Flow, 33, Unused, "Expected to be neither referenced nor exported";
end Wf_Modular;
