-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

----------------------------------------------------------------------------
-- Overview: Called to check validity of a
-- term node.  Replaces calls to StaticTerm, BaseTypeTerm and CheckTypeTerm
----------------------------------------------------------------------------

separate (Sem.Walk_Expression_P)
procedure Wf_Term
  (Node                    : in     STree.SyntaxNode;
   Scope                   : in     Dictionary.Scopes;
   E_Stack                 : in out Exp_Stack.Exp_Stack_Type;
   T_Stack                 : in     Type_Context_Stack.T_Stack_Type;
   Context_Requires_Static : in     Boolean)
is
   Left, Right, Result : Sem.Exp_Record;
   Op_Node             : STree.SyntaxNode;
   Operator            : SP_Symbols.SP_Symbol;
begin
   Op_Node := STree.Child_Node (Current_Node => Node);
   -- ASSUME Op_Node = term OR factor OR annotation_term OR annotation_factor
   if STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.term
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.annotation_term then
      -- ASSUME Op_Node = term OR annotation_term
      Op_Node := STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => Op_Node));
      -- ASSUME Op_Node = multiply OR divide OR RWmod OR RWrem
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.multiply
           or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.divide
           or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWmod
           or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWrem,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Op_Node = multiply OR divide OR RWmod OR RWrem in Wf_Term");
      -- multiplying_operator exists
      Operator := STree.Syntax_Node_Type (Node => Op_Node);
      Exp_Stack.Pop (Item  => Right,
                     Stack => E_Stack);
      Exp_Stack.Pop (Item  => Left,
                     Stack => E_Stack);
      Result := Null_Type_Record; -- safety: we may not set all fields below

      -- do static checks first
      Result.Is_Constant   := Left.Is_Constant and then Right.Is_Constant;
      Result.Is_Static     := Left.Is_Static and then Right.Is_Static;
      Result.Has_Operators := True;
      if Left.Is_ARange or else Right.Is_ARange then
         Result := Sem.Unknown_Type_Record;
         ErrorHandler.Semantic_Error
           (Err_Num   => 90,
            Reference => ErrorHandler.No_Reference,
            Position  => STree.Node_Position (Node => Op_Node),
            Id_Str    => LexTokenManager.Null_String);
      else -- neither are ranges

         -- now do type compatibility and operator visibility checks
         Check_Binary_Operator
           (Operator      => Operator,
            Left          => Left,
            Right         => Right,
            Scope         => Scope,
            T_Stack       => T_Stack,
            Op_Pos        => STree.Node_Position (Node => Op_Node),
            Left_Pos      => STree.Node_Position (Node => STree.Child_Node (Current_Node => Node)),
            Right_Pos     => STree.Node_Position
              (Node => STree.Next_Sibling
                 (Current_Node => STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node)))),
            Convert       => True,
            Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_term,
            Result        => Result);

         -- Seed Op_Node with type to aid selection of operator in VCG
         STree.Add_Node_Symbol (Node => Op_Node,
                                Sym  => Result.Type_Symbol);

         Calc_Binary_Operator
           (Node_Pos      => STree.Node_Position (Node => Node),
            Operator      => Operator,
            Left_Val      => Left.Value,
            Right_Val     => Right.Value,
            Is_Annotation => STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_term,
            Result        => Result);

         if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.term then
            -- ASSUME STree.Parent_Node (Current_Node => Node) = term
            ----------------------------------------------------------------
            -- If the parent is also a term, then we must have
            -- an unparenthesized expression with two multiplying operators,
            -- such as A * B * C
            --
            -- Here, we issue warning 302 to warn of potential evaluation
            -- order dependency.
            --
            -- We can reduce false-alarm rate here by suppressing the
            -- warning in two specific cases:
            --  a) If the sub-expression under consideration is static
            --     AND the expression as a whole appears in a context
            --     that requires a static expression.  Example: a type
            --     declaration such as
            --       type T is range B * 2 / 3 .. 10;
            --   or
            --  b) A modular-typed expression where the two operators
            --     under consideration are both the same and
            --     commutative.  For example:
            --       A := A * B * C;
            --     where A, B, and C are all of the same modular
            --     (sub-)type.
            --
            -- The same logic is used in wf_simple_expression for
            -- binary adding operators.
            ----------------------------------------------------------------
            if (Context_Requires_Static and then Result.Is_Static)
              or else (Dictionary.TypeIsModular (Result.Type_Symbol)
                         and then Ops_Are_Same_And_Commutative
                         (Operator,
                          STree.Syntax_Node_Type
                            (Node => STree.Child_Node (Current_Node => STree.Next_Sibling (Current_Node => Node))))) then
               null;
            else
               ErrorHandler.Semantic_Warning
                 (Err_Num  => 302,
                  Position => STree.Node_Position (Node => Node),
                  Id_Str   => LexTokenManager.Null_String);
            end if;
         end if;
      end if;
      Result.Errors_In_Expression := Result.Errors_In_Expression
        or else Left.Errors_In_Expression
        or else Right.Errors_In_Expression;
      -- OtherSymbol may carry a function symbol in the case of uses of unchecked_conversion.
      -- This symbol is used (by Wf_Assign) to convery information to the VCG to supress
      -- checks when an unchecked_conversion is assigned to something of the same subtype.
      -- We do not want this mechanism if the unchecked_conversion is sued in any other context
      -- than a direct assignment.  Therefore we clear OtherSymbol here:
      Result.Other_Symbol := Dictionary.NullSymbol;
      Exp_Stack.Push (X     => Result,
                      Stack => E_Stack);
   elsif STree.Syntax_Node_Type (Node => Op_Node) /= SP_Symbols.factor
     and then STree.Syntax_Node_Type (Node => Op_Node) /= SP_Symbols.annotation_factor then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Op_Node = term OR factor OR annotation_term OR annotation_factor in Wf_Term");
   end if;
end Wf_Term;
