-------------------------------------------------------------------------------
-- (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 an
-- expression node.  Replaces calls to StaticExpression,
-- BaseTypeExpression and CheckTypeExpression
----------------------------------------------------------------------------

separate (Sem.Walk_Expression_P)
procedure Wf_Expression
  (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)
is
   Op_Node             : STree.SyntaxNode;
   Operator            : SP_Symbols.SP_Symbol;
   Left, Right, Result : Sem.Exp_Record;
   Is_Annotation       : Boolean := False;

   ---------------------------------------------------------------------

   procedure Check_Short_Circuit
     (Op            : in     SP_Symbols.SP_Symbol;
      Node_Pos      : in     LexTokenManager.Token_Position;
      Op_Pos        : in     LexTokenManager.Token_Position;
      Is_Annotation : in     Boolean;
      Scope         : in     Dictionary.Scopes;
      E_Stack       : in out Exp_Stack.Exp_Stack_Type)
   --# 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,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         E_Stack,
   --#                                         Is_Annotation,
   --#                                         LexTokenManager.State,
   --#                                         Node_Pos,
   --#                                         Op,
   --#                                         Op_Pos,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys &
   --#         E_Stack                    from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Op;
   is
      Left, Right, Result : Sem.Exp_Record;
   begin
      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
      Result.Is_Static     := CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
        and then Left.Is_Static
        and then Right.Is_Static;
      Result.Is_Constant   := Left.Is_Constant and then Right.Is_Constant;
      Result.Has_Operators := True;
      if Dictionary.TypeIsBoolean (Left.Type_Symbol) and then Dictionary.TypeIsBoolean (Right.Type_Symbol) then
         Result.Is_ARange   := False;
         Result.Type_Symbol := Left.Type_Symbol;
         Calc_Binary_Operator
           (Node_Pos      => Node_Pos,
            Operator      => Op,
            Left_Val      => Left.Value,
            Right_Val     => Right.Value,
            Is_Annotation => Is_Annotation,
            Result        => Result);
      else
         Result := Sem.Unknown_Type_Record;
         ErrorHandler.Semantic_Error_Sym2
           (Err_Num   => 35,
            Reference => ErrorHandler.No_Reference,
            Position  => Op_Pos,
            Sym       => Left.Type_Symbol,
            Sym2      => Right.Type_Symbol,
            Scope     => Scope);
      end if;
      Result.Errors_In_Expression := Result.Errors_In_Expression
        or else Left.Errors_In_Expression
        or else Right.Errors_In_Expression;
      Exp_Stack.Push (X     => Result,
                      Stack => E_Stack);
   end Check_Short_Circuit;

   -----------------------------------------------------------------

   procedure Check_Implication
     (Op_Pos  : in     LexTokenManager.Token_Position;
      E_Stack : in out Exp_Stack.Exp_Stack_Type;
      Scope   : in     Dictionary.Scopes)
   --# 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,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         E_Stack,
   --#                                         LexTokenManager.State,
   --#                                         Op_Pos,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys &
   --#         E_Stack                    from *,
   --#                                         Dictionary.Dict;
   is
      Left, Right, Result : Sem.Exp_Record;
   begin
      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
      Result.Is_Static     := Left.Is_Static and then Right.Is_Static;
      Result.Is_Constant   := Left.Is_Constant and then Right.Is_Constant;
      Result.Has_Operators := True;
      if Dictionary.TypeIsBoolean (Left.Type_Symbol) and then Dictionary.TypeIsBoolean (Right.Type_Symbol) then
         Result.Type_Symbol := Left.Type_Symbol;
      else
         Result := Sem.Unknown_Type_Record;
         ErrorHandler.Semantic_Error_Sym2
           (Err_Num   => 35,
            Reference => ErrorHandler.No_Reference,
            Position  => Op_Pos,
            Sym       => Left.Type_Symbol,
            Sym2      => Right.Type_Symbol,
            Scope     => Scope);
      end if;
      Result.Errors_In_Expression := Result.Errors_In_Expression
        or else Left.Errors_In_Expression
        or else Right.Errors_In_Expression;
      Exp_Stack.Push (X     => Result,
                      Stack => E_Stack);
   end Check_Implication;

begin -- Wf_Expression

   -- ASSUME Node = expression OR expression_rep1 OR expression_rep2 OR expression_rep3 OR expression_rep4 OR expression_rep5 OR
   --               annotation_expression OR annotation_expression_rep1 OR annotation_expression_rep2 OR
   --               annotation_expression_rep3 OR annotation_expression_rep4 OR annotation_expression_rep5 OR
   --               annotation_expression_rep6 OR annotation_expression_rep7
   if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression_rep1
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression_rep2
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression_rep3
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression_rep4
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.expression_rep5 then
      -- ASSUME Node = expression OR expression_rep1 OR expression_rep2 OR expression_rep3 OR expression_rep4 OR expression_rep5
      Is_Annotation := False;
   elsif STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep1
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep2
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep3
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep4
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep5
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep6
     or else STree.Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression_rep7 then
      Is_Annotation := True;
      -- ASSUME Node = annotation_expression OR annotation_expression_rep1 OR annotation_expression_rep2 OR
      --               annotation_expression_rep3 OR annotation_expression_rep4 OR annotation_expression_rep5 OR
      --               annotation_expression_rep6 OR annotation_expression_rep7
   end if;

   Op_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Node));
   -- ASSUME Op_Node = RWand OR RWandthen OR RWor OR RWorelse OR RWxor OR implies OR is_equivalent_to OR NULL
   if STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWand
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWandthen
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWor
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWorelse
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.RWxor
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.implies
     or else STree.Syntax_Node_Type (Node => Op_Node) = SP_Symbols.is_equivalent_to then
      -- ASSUME Op_Node = RWand OR RWandthen OR RWor OR RWorelse OR RWxor OR implies OR is_equivalent_to
      Operator := STree.Syntax_Node_Type (Node => Op_Node);
      if Operator = SP_Symbols.RWandthen or else Operator = SP_Symbols.RWorelse then
         Check_Short_Circuit
           (Op            => Operator,
            Node_Pos      => STree.Node_Position (Node => Node),
            Op_Pos        => STree.Node_Position (Node => Op_Node),
            Is_Annotation => Is_Annotation,
            Scope         => Scope,
            E_Stack       => E_Stack);
      elsif Operator = SP_Symbols.implies or else Operator = SP_Symbols.is_equivalent_to then
         Check_Implication (Op_Pos  => STree.Node_Position (Node => Op_Node),
                            E_Stack => E_Stack,
                            Scope   => Scope);
      elsif Operator = SP_Symbols.RWand or else Operator = SP_Symbols.RWor or else Operator = SP_Symbols.RWxor then
         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
         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;
         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 (Node)),
            Right_Pos     => STree.Node_Position (Node => STree.Next_Sibling (Op_Node)),
            Convert       => True,
            Is_Annotation => Is_Annotation,
            Result        => Result);

         -- check that array bounds match.
         if Result /= Sem.Unknown_Type_Record then
            -- check that whole array operation not being performed on unconstrained array
            if Dictionary.Is_Unconstrained_Array_Type_Mark (Left.Type_Symbol, Scope)
              or else Dictionary.Is_Unconstrained_Array_Type_Mark (Right.Type_Symbol, Scope) then
               Result := Sem.Unknown_Type_Record;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 39,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Op_Node),
                  Id_Str    => LexTokenManager.Null_String);
            elsif Sem.Illegal_Unconstrained (Left_Type  => Left.Type_Symbol,
                                             Right_Type => Right.Type_Symbol) then
               Result := Sem.Unknown_Type_Record;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 418,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Op_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
            if Result /= Sem.Unknown_Type_Record then
               Calc_Binary_Operator
                 (Node_Pos      => STree.Node_Position (Node => Node),
                  Operator      => Operator,
                  Left_Val      => Left.Value,
                  Right_Val     => Right.Value,
                  Is_Annotation => Is_Annotation,
                  Result        => Result);
            end if;
         end if;

         -- test to prevent result being considered unconstrained
         if Dictionary.TypeIsArray (Result.Type_Symbol) then
            Result.Type_Symbol := Left.Type_Symbol;
         end if;

         -- Plant result type for use by VCG
         -- It will be used to identify cases where a special model is needed for bitwise ops
         -- between arrays or modular types
         STree.Add_Node_Symbol (Node => Op_Node,
                                Sym  => Result.Type_Symbol);

         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);
      end if;
   elsif Op_Node /= STree.NullNode then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Op_Node = RWand OR RWandthen OR RWor OR RWorelse OR RWxor OR implies OR " &
           "is_equivalent_to OR NULL in Wf_Expression");
   end if;
end Wf_Expression;
