-------------------------------------------------------------------------------
-- (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)
procedure Check_Binary_Operator
  (Operator      : in     SP_Symbols.SP_Symbol;
   Left          : in     Sem.Exp_Record;
   Right         : in     Sem.Exp_Record;
   Scope         : in     Dictionary.Scopes;
   T_Stack       : in     Type_Context_Stack.T_Stack_Type;
   Op_Pos        : in     LexTokenManager.Token_Position;
   Left_Pos      : in     LexTokenManager.Token_Position;
   Right_Pos     : in     LexTokenManager.Token_Position;
   Convert       : in     Boolean;
   Is_Annotation : in     Boolean;
   Result        : in out Sem.Exp_Record)
is
   Left_Type, Right_Type, Return_Type : Dictionary.Symbol;

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

   function Mixed_Type_Mult_Or_Div
     (Op                    : SP_Symbols.SP_Symbol;
      Left_Type, Right_Type : Dictionary.Symbol;
      Scope                 : Dictionary.Scopes)
     return                  Boolean
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   is
   begin
      return (Op = SP_Symbols.multiply or else Op = SP_Symbols.divide)
        and then (Dictionary.IsFixedPointTypeMark (Right_Type, Scope)
                    or else Dictionary.IsFixedPointTypeMark (Left_Type, Scope)
                    or else (CommandLineData.Ravenscar_Selected
                               and then (Dictionary.IsPredefinedTimeSpanType (Left_Type)
                                           or else Dictionary.IsPredefinedTimeSpanType (Right_Type))));
   end Mixed_Type_Mult_Or_Div;

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

   procedure Hetero_Impl_Type_Conv (Left_Type, Right_Type : in out Dictionary.Symbol;
                                    Scope                 : in     Dictionary.Scopes)
   --# global in CommandLineData.Content;
   --#        in Dictionary.Dict;
   --# derives Left_Type,
   --#         Right_Type from CommandLineData.Content,
   --#                         Dictionary.Dict,
   --#                         Left_Type,
   --#                         Right_Type,
   --#                         Scope;
   is
   begin
      if Dictionary.IsUniversalIntegerType (Left_Type)
        and then (Dictionary.IsFixedPointTypeMark (Right_Type, Scope)
                    or else (CommandLineData.Ravenscar_Selected and then Dictionary.IsPredefinedTimeType (Right_Type))) then
         Left_Type := Dictionary.GetPredefinedIntegerType;
      elsif Dictionary.IsUniversalIntegerType (Right_Type)
        and then (Dictionary.IsFixedPointTypeMark (Left_Type, Scope)
                    or else (CommandLineData.Ravenscar_Selected and then Dictionary.IsPredefinedTimeType (Left_Type))) then
         Right_Type := Dictionary.GetPredefinedIntegerType;
      elsif CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
        and then Dictionary.IsUniversalRealType (Right_Type)
        and then Dictionary.IsFixedPointTypeMark (Left_Type, Scope) then
         Right_Type := Dictionary.GetUniversalFixedType;
      elsif CommandLineData.Content.Language_Profile /= CommandLineData.SPARK83
        and then Dictionary.IsUniversalRealType (Left_Type)
        and then Dictionary.IsFixedPointTypeMark (Right_Type, Scope) then
         Left_Type := Dictionary.GetUniversalFixedType;
      end if;
   end Hetero_Impl_Type_Conv;

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

   procedure Homo_Impl_Type_Conv
     (Operator              : in     SP_Symbols.SP_Symbol;
      Left_Type, Right_Type : in out Dictionary.Symbol;
      Left_Val              : in     Maths.Value;
      Right_Val             : in     Maths.Value;
      Left_Has_Operators    : in     Boolean;
      Right_Has_Operators   : in     Boolean;
      Left_Pos              : in     LexTokenManager.Token_Position;
      Right_Pos             : in     LexTokenManager.Token_Position;
      Is_Annotation         : in     Boolean;
      T_Stack               : in     Type_Context_Stack.T_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,
   --#                                         Is_Annotation,
   --#                                         Left_Has_Operators,
   --#                                         Left_Pos,
   --#                                         Left_Type,
   --#                                         Left_Val,
   --#                                         LexTokenManager.State,
   --#                                         Operator,
   --#                                         Right_Has_Operators,
   --#                                         Right_Pos,
   --#                                         Right_Type,
   --#                                         Right_Val,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys &
   --#         Left_Type                  from *,
   --#                                         Dictionary.Dict,
   --#                                         Left_Has_Operators,
   --#                                         Operator,
   --#                                         Right_Type,
   --#                                         Scope,
   --#                                         T_Stack &
   --#         Right_Type                 from *,
   --#                                         Dictionary.Dict,
   --#                                         Left_Type,
   --#                                         Operator,
   --#                                         Right_Has_Operators,
   --#                                         Scope,
   --#                                         T_Stack;
   --# pre Type_Context_Stack.Stack_Is_Valid (T_Stack);
      is separate;

begin -- Check_Binary_Operator
   Left_Type  := Dictionary.GetRootType (Left.Type_Symbol);
   Right_Type := Dictionary.GetRootType (Right.Type_Symbol);
   -- suppress type conversion in case of fixed point * or /
   if Convert then
      if Mixed_Type_Mult_Or_Div (Op         => Operator,
                                 Left_Type  => Left_Type,
                                 Right_Type => Right_Type,
                                 Scope      => Scope) then
         Hetero_Impl_Type_Conv (Left_Type  => Left_Type,
                                Right_Type => Right_Type,
                                Scope      => Scope);
      else
         Homo_Impl_Type_Conv
           (Operator            => Operator,
            Left_Type           => Left_Type,
            Right_Type          => Right_Type,
            Left_Val            => Left.Value,
            Right_Val           => Right.Value,
            Left_Has_Operators  => Left.Has_Operators,
            Right_Has_Operators => Right.Has_Operators,
            Left_Pos            => Left_Pos,
            Right_Pos           => Right_Pos,
            Is_Annotation       => Is_Annotation,
            T_Stack             => T_Stack,
            Scope               => Scope);
      end if;
   end if;

   Return_Type := Dictionary.Get_Binary_Operator_Type (Name  => Operator,
                                                       Left  => Left_Type,
                                                       Right => Right_Type);
   if Dictionary.Is_Null_Symbol (Return_Type) then
      Result := Sem.Unknown_Type_Record;
      if Dictionary.IsUniversalIntegerType (Left_Type) and then Dictionary.IsModularTypeMark (Right_Type, Scope) then
         ErrorHandler.Semantic_Error_Sym
           (Err_Num   => 804,
            Reference => ErrorHandler.No_Reference,
            Position  => Op_Pos,
            Sym       => Right_Type,
            Scope     => Scope);
      elsif Dictionary.IsUniversalIntegerType (Right_Type) and then Dictionary.IsModularTypeMark (Left_Type, Scope) then
         ErrorHandler.Semantic_Error_Sym
           (Err_Num   => 805,
            Reference => ErrorHandler.No_Reference,
            Position  => Op_Pos,
            Sym       => Left_Type,
            Scope     => Scope);
      else
         ErrorHandler.Semantic_Error_Sym2
           (Err_Num   => 35,
            Reference => ErrorHandler.No_Reference,
            Position  => Op_Pos,
            Sym       => Left_Type,
            Sym2      => Right_Type,
            Scope     => Scope);
      end if;
   elsif not Is_Annotation and then not Dictionary.BinaryOperatorIsVisible (Operator, Left_Type, Right_Type, Scope) then
      Result := Sem.Unknown_Type_Record;
      ErrorHandler.Semantic_Error
        (Err_Num   => 309,
         Reference => ErrorHandler.No_Reference,
         Position  => Op_Pos,
         Id_Str    => LexTokenManager.Null_String);
   else
      -- check whether equality of floats is being used
      if not Is_Annotation
        and then (Operator = SP_Symbols.equals or else Operator = SP_Symbols.not_equal)
        and then (Dictionary.ContainsFloat (Left_Type) or else Dictionary.ContainsFloat (Right_Type)) then
         ErrorHandler.Semantic_Warning (Err_Num  => 308,
                                        Position => Op_Pos,
                                        Id_Str   => LexTokenManager.Null_String);
      end if;
      Result.Type_Symbol := Return_Type;
   end if;
end Check_Binary_Operator;
