Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             S E M _ E V A L                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT 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 GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

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

with Atree;    use Atree;

with Checks;   use Checks;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Eval_Fat; use Eval_Fat;

with Exp_Util; use Exp_Util;

with Lib;      use Lib;

with Namet;    use Namet;

with Nmake;    use Nmake;

with Nlists;   use Nlists;

with Opt;      use Opt;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sem_Type; use Sem_Type;

with Sem_Warn; use Sem_Warn;

with Sinfo;    use Sinfo;

with Snames;   use Snames;

with Stand;    use Stand;

with Stringt;  use Stringt;

with Tbuild;   use Tbuild;

package body Sem_Eval is

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

   -- Handling of Compile Time Evaluation --

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

   --  The compile time evaluation of expressions is distributed over several

   --  Eval_xxx procedures. These procedures are called immediately after

   --  a subexpression is resolved and is therefore accomplished in a bottom

   --  up fashion. The flags are synthesized using the following approach.

   --    Is_Static_Expression is determined by following the detailed rules

   --    in RM 4.9(4-14). This involves testing the Is_Static_Expression

   --    flag of the operands in many cases.

   --    Raises_Constraint_Error is set if any of the operands have the flag

   --    set or if an attempt to compute the value of the current expression

   --    results in detection of a runtime constraint error.

   --  As described in the spec, the requirement is that Is_Static_Expression

   --  be accurately set, and in addition for nodes for which this flag is set,

   --  Raises_Constraint_Error must also be set. Furthermore a node which has

   --  Is_Static_Expression set, and Raises_Constraint_Error clear, then the

   --  requirement is that the expression value must be precomputed, and the

   --  node is either a literal, or the name of a constant entity whose value

   --  is a static expression.

   --  The general approach is as follows. First compute Is_Static_Expression.

   --  If the node is not static, then the flag is left off in the node and

   --  we are all done. Otherwise for a static node, we test if any of the

   --  operands will raise constraint error, and if so, propagate the flag

   --  Raises_Constraint_Error to the result node and we are done (since the

   --  error was already posted at a lower level).

   --  For the case of a static node whose operands do not raise constraint

   --  error, we attempt to evaluate the node. If this evaluation succeeds,

   --  then the node is replaced by the result of this computation. If the

   --  evaluation raises constraint error, then we rewrite the node with

   --  Apply_Compile_Time_Constraint_Error to raise the exception and also

   --  to post appropriate error messages.

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

   -- Local Data --

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

   type Bits is array (Nat range <>) of Boolean;

   --  Used to convert unsigned (modular) values for folding logical ops

   --  The following definitions are used to maintain a cache of nodes that

   --  have compile time known values. The cache is maintained only for

   --  discrete types (the most common case), and is populated by calls to

   --  Compile_Time_Known_Value and Expr_Value, but only used by Expr_Value

   --  since it is possible for the status to change (in particular it is

   --  possible for a node to get replaced by a constraint error node).

   CV_Bits : constant := 5;

   --  Number of low order bits of Node_Id value used to reference entries

   --  in the cache table.

   CV_Cache_Size : constant Nat := 2 ** CV_Bits;

   --  Size of cache for compile time values

   subtype CV_Range is Nat range 0 .. CV_Cache_Size;

   type CV_Entry is record

      N : Node_Id;

      V : Uint;

   end record;

   type CV_Cache_Array is array (CV_Range) of CV_Entry;

   CV_Cache : CV_Cache_Array := (others => (Node_High_Bound, Uint_0));

   --  This is the actual cache, with entries consisting of node/value pairs,

   --  and the impossible value Node_High_Bound used for unset entries.

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

   -- Local Subprograms --

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

   function From_Bits (B : Bits; T : Entity_Id) return Uint;

   --  Converts a bit string of length B'Length to a Uint value to be used

   --  for a target of type T, which is a modular type. This procedure

   --  includes the necessary reduction by the modulus in the case of a

   --  non-binary modulus (for a binary modulus, the bit string is the

   --  right length any way so all is well).

   function Get_String_Val (N : Node_Id) return Node_Id;

   --  Given a tree node for a folded string or character value, returns

   --  the corresponding string literal or character literal (one of the

   --  two must be available, or the operand would not have been marked

   --  as foldable in the earlier analysis of the operation).

   function OK_Bits (N : Node_Id; Bits : Uint) return Boolean;

   --  Bits represents the number of bits in an integer value to be computed

   --  (but the value has not been computed yet). If this value in Bits is

   --  reasonable, a result of True is returned, with the implication that

   --  the caller should go ahead and complete the calculation. If the value

   --  in Bits is unreasonably large, then an error is posted on node N, and

   --  False is returned (and the caller skips the proposed calculation).

   procedure Out_Of_Range (N : Node_Id);

   --  This procedure is called if it is determined that node N, which

   --  appears in a non-static context, is a compile time known value

   --  which is outside its range, i.e. the range of Etype. This is used

   --  in contexts where this is an illegality if N is static, and should

   --  generate a warning otherwise.

   procedure Rewrite_In_Raise_CE (N : Node_Id; Exp : Node_Id);

   --  N and Exp are nodes representing an expression, Exp is known

   --  to raise CE. N is rewritten in term of Exp in the optimal way.

   function String_Type_Len (Stype : Entity_Id) return Uint;

   --  Given a string type, determines the length of the index type, or,

   --  if this index type is non-static, the length of the base type of

   --  this index type. Note that if the string type is itself static,

   --  then the index type is static, so the second case applies only

   --  if the string type passed is non-static.

   function Test (Cond : Boolean) return Uint;

   pragma Inline (Test);

   --  This function simply returns the appropriate Boolean'Pos value

   --  corresponding to the value of Cond as a universal integer. It is

   --  used for producing the result of the static evaluation of the

   --  logical operators

   procedure Test_Expression_Is_Foldable

     (N    : Node_Id;

      Op1  : Node_Id;

      Stat : out Boolean;

      Fold : out Boolean);

   --  Tests to see if expression N whose single operand is Op1 is foldable,

   --  i.e. the operand value is known at compile time. If the operation is

   --  foldable, then Fold is True on return, and Stat indicates whether

   --  the result is static (i.e. both operands were static). Note that it

   --  is quite possible for Fold to be True, and Stat to be False, since

   --  there are cases in which we know the value of an operand even though

   --  it is not technically static (e.g. the static lower bound of a range

   --  whose upper bound is non-static).

   --

   --  If Stat is set False on return, then Test_Expression_Is_Foldable makes a

   --  call to Check_Non_Static_Context on the operand. If Fold is False on

   --  return, then all processing is complete, and the caller should

   --  return, since there is nothing else to do.

   --

   --  If Stat is set True on return, then Is_Static_Expression is also set

   --  true in node N. There are some cases where this is over-enthusiastic,

   --  e.g. in the two operand case below, for string comaprison, the result

   --  is not static even though the two operands are static. In such cases,

   --  the caller must reset the Is_Static_Expression flag in N.

   procedure Test_Expression_Is_Foldable

     (N    : Node_Id;

      Op1  : Node_Id;

      Op2  : Node_Id;

      Stat : out Boolean;

      Fold : out Boolean);

   --  Same processing, except applies to an expression N with two operands

   --  Op1 and Op2.

   procedure To_Bits (U : Uint; B : out Bits);

   --  Converts a Uint value to a bit string of length B'Length

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

   -- Check_Non_Static_Context --

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

   procedure Check_Non_Static_Context (N : Node_Id) is

      T         : constant Entity_Id := Etype (N);

      Checks_On : constant Boolean   :=

                    not Index_Checks_Suppressed (T)

                      and not Range_Checks_Suppressed (T);

   begin

      --  Ignore cases of non-scalar types or error types

      if T = Any_Type or else not Is_Scalar_Type (T) then

         return;

      end if;

      --  At this stage we have a scalar type. If we have an expression

      --  that raises CE, then we already issued a warning or error msg

      --  so there is nothing more to be done in this routine.

      if Raises_Constraint_Error (N) then

         return;

      end if;

      --  Now we have a scalar type which is not marked as raising a

      --  constraint error exception. The main purpose of this routine

      --  is to deal with static expressions appearing in a non-static

      --  context. That means that if we do not have a static expression

      --  then there is not much to do. The one case that we deal with

      --  here is that if we have a floating-point value that is out of

      --  range, then we post a warning that an infinity will result.

      if not Is_Static_Expression (N) then

         if Is_Floating_Point_Type (T)

           and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)

         then

            Error_Msg_N

              ("?float value out of range, infinity will be generated", N);

         end if;

         return;

      end if;

      --  Here we have the case of outer level static expression of

      --  scalar type, where the processing of this procedure is needed.

      --  For real types, this is where we convert the value to a machine

      --  number (see RM 4.9(38)). Also see ACVC test C490001. We should

      --  only need to do this if the parent is a constant declaration,

      --  since in other cases, gigi should do the necessary conversion

      --  correctly, but experimentation shows that this is not the case

      --  on all machines, in particular if we do not convert all literals

      --  to machine values in non-static contexts, then ACVC test C490001

      --  fails on Sparc/Solaris and SGI/Irix.

      if Nkind (N) = N_Real_Literal

        and then not Is_Machine_Number (N)

        and then not Is_Generic_Type (Etype (N))

        and then Etype (N) /= Universal_Real

      then

         --  Check that value is in bounds before converting to machine

         --  number, so as not to lose case where value overflows in the

         --  least significant bit or less. See B490001.

         if Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then

            Out_Of_Range (N);

            return;

         end if;

         --  Note: we have to copy the node, to avoid problems with conformance

         --  of very similar numbers (see ACVC tests B4A010C and B63103A).

         Rewrite (N, New_Copy (N));

         if not Is_Floating_Point_Type (T) then

            Set_Realval

              (N, Corresponding_Integer_Value (N) * Small_Value (T));

         elsif not UR_Is_Zero (Realval (N)) then

            --  Note: even though RM 4.9(38) specifies biased rounding,

            --  this has been modified by AI-100 in order to prevent

            --  confusing differences in rounding between static and

            --  non-static expressions. AI-100 specifies that the effect

            --  of such rounding is implementation dependent, and in GNAT

            --  we round to nearest even to match the run-time behavior.

            Set_Realval

              (N, Machine (Base_Type (T), Realval (N), Round_Even, N));

         end if;

         Set_Is_Machine_Number (N);

      end if;

      --  Check for out of range universal integer. This is a non-static

      --  context, so the integer value must be in range of the runtime

      --  representation of universal integers.

      --  We do this only within an expression, because that is the only

      --  case in which non-static universal integer values can occur, and

      --  furthermore, Check_Non_Static_Context is currently (incorrectly???)

      --  called in contexts like the expression of a number declaration where

      --  we certainly want to allow out of range values.

      if Etype (N) = Universal_Integer

        and then Nkind (N) = N_Integer_Literal

        and then Nkind (Parent (N)) in N_Subexpr

        and then

          (Intval (N) < Expr_Value (Type_Low_Bound (Universal_Integer))

            or else

           Intval (N) > Expr_Value (Type_High_Bound (Universal_Integer)))

      then

         Apply_Compile_Time_Constraint_Error

           (N, "non-static universal integer value out of range?",

            CE_Range_Check_Failed);

      --  Check out of range of base type

      elsif Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then

         Out_Of_Range (N);

      --  Give warning if outside subtype (where one or both of the bounds of

      --  the subtype is static). This warning is omitted if the expression

      --  appears in a range that could be null (warnings are handled elsewhere

      --  for this case).

      elsif T /= Base_Type (T)

        and then Nkind (Parent (N)) /= N_Range

      then

         if Is_In_Range (N, T, Assume_Valid => True) then

            null;

         elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then

            Apply_Compile_Time_Constraint_Error

              (N, "value not in range of}?", CE_Range_Check_Failed);

         elsif Checks_On then

            Enable_Range_Check (N);

         else

            Set_Do_Range_Check (N, False);

         end if;

      end if;

   end Check_Non_Static_Context;

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

   -- Check_String_Literal_Length --

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

   procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id) is

   begin

      if not Raises_Constraint_Error (N)

        and then Is_Constrained (Ttype)

      then

         if

           UI_From_Int (String_Length (Strval (N))) /= String_Type_Len (Ttype)

         then

            Apply_Compile_Time_Constraint_Error

              (N, "string length wrong for}?",

               CE_Length_Check_Failed,

               Ent => Ttype,

               Typ => Ttype);

         end if;

      end if;

   end Check_String_Literal_Length;

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

   -- Compile_Time_Compare --

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

   function Compile_Time_Compare

     (L, R         : Node_Id;

      Assume_Valid : Boolean) return Compare_Result

   is

      Discard : aliased Uint;

   begin

      return Compile_Time_Compare (L, R, Discard'Access, Assume_Valid);

   end Compile_Time_Compare;

   function Compile_Time_Compare

     (L, R         : Node_Id;

      Diff         : access Uint;

      Assume_Valid : Boolean;

      Rec          : Boolean := False) return Compare_Result

   is

      Ltyp : Entity_Id := Underlying_Type (Etype (L));

      Rtyp : Entity_Id := Underlying_Type (Etype (R));

      --  These get reset to the base type for the case of entities where

      --  Is_Known_Valid is not set. This takes care of handling possible

      --  invalid representations using the value of the base type, in

      --  accordance with RM 13.9.1(10).

      Discard : aliased Uint;

      procedure Compare_Decompose

        (N : Node_Id;

         R : out Node_Id;

         V : out Uint);

      --  This procedure decomposes the node N into an expression node and a

      --  signed offset, so that the value of N is equal to the value of R plus

      --  the value V (which may be negative). If no such decomposition is

      --  possible, then on return R is a copy of N, and V is set to zero.

      function Compare_Fixup (N : Node_Id) return Node_Id;

      --  This function deals with replacing 'Last and 'First references with

      --  their corresponding type bounds, which we then can compare. The

      --  argument is the original node, the result is the identity, unless we

      --  have a 'Last/'First reference in which case the value returned is the

      --  appropriate type bound.

      function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean;

      --  Even if the context does not assume that values are valid, some

      --  simple cases can be recognized.

      function Is_Same_Value (L, R : Node_Id) return Boolean;

      --  Returns True iff L and R represent expressions that definitely

      --  have identical (but not necessarily compile time known) values

      --  Indeed the caller is expected to have already dealt with the

      --  cases of compile time known values, so these are not tested here.

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

      -- Compare_Decompose --

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

      procedure Compare_Decompose

        (N : Node_Id;

         R : out Node_Id;

         V : out Uint)

      is

      begin

         if Nkind (N) = N_Op_Add

           and then Nkind (Right_Opnd (N)) = N_Integer_Literal

         then

            R := Left_Opnd (N);

            V := Intval (Right_Opnd (N));

            return;

         elsif Nkind (N) = N_Op_Subtract

           and then Nkind (Right_Opnd (N)) = N_Integer_Literal

         then

            R := Left_Opnd (N);

            V := UI_Negate (Intval (Right_Opnd (N)));

            return;

         elsif Nkind (N) = N_Attribute_Reference  then

            if Attribute_Name (N) = Name_Succ then

               R := First (Expressions (N));

               V := Uint_1;

               return;

            elsif Attribute_Name (N) = Name_Pred then

               R := First (Expressions (N));

               V := Uint_Minus_1;

               return;

            end if;

         end if;

         R := N;

         V := Uint_0;

      end Compare_Decompose;

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

      -- Compare_Fixup --

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

      function Compare_Fixup (N : Node_Id) return Node_Id is

         Indx : Node_Id;

         Xtyp : Entity_Id;

         Subs : Nat;

      begin

         if Nkind (N) = N_Attribute_Reference

           and then (Attribute_Name (N) = Name_First

                       or else

                     Attribute_Name (N) = Name_Last)

         then

            Xtyp := Etype (Prefix (N));

            --  If we have no type, then just abandon the attempt to do

            --  a fixup, this is probably the result of some other error.

            if No (Xtyp) then

               return N;

            end if;

            --  Dereference an access type

            if Is_Access_Type (Xtyp) then

               Xtyp := Designated_Type (Xtyp);

            end if;

            --  If we don't have an array type at this stage, something

            --  is peculiar, e.g. another error, and we abandon the attempt

            --  at a fixup.

            if not Is_Array_Type (Xtyp) then

               return N;

            end if;

            --  Ignore unconstrained array, since bounds are not meaningful

            if not Is_Constrained (Xtyp) then

               return N;

            end if;

            if Ekind (Xtyp) = E_String_Literal_Subtype then

               if Attribute_Name (N) = Name_First then

                  return String_Literal_Low_Bound (Xtyp);

               else         -- Attribute_Name (N) = Name_Last

                  return Make_Integer_Literal (Sloc (N),

                    Intval => Intval (String_Literal_Low_Bound (Xtyp))

                                + String_Literal_Length (Xtyp));

               end if;

            end if;

            --  Find correct index type

            Indx := First_Index (Xtyp);

            if Present (Expressions (N)) then

               Subs := UI_To_Int (Expr_Value (First (Expressions (N))));

               for J in 2 .. Subs loop

                  Indx := Next_Index (Indx);

               end loop;

            end if;

            Xtyp := Etype (Indx);

            if Attribute_Name (N) = Name_First then

               return Type_Low_Bound (Xtyp);

            else -- Attribute_Name (N) = Name_Last

               return Type_High_Bound (Xtyp);

            end if;

         end if;

         return N;

      end Compare_Fixup;

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

      -- Is_Known_Valid_Operand --

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

      function Is_Known_Valid_Operand (Opnd : Node_Id) return Boolean is

      begin

         return (Is_Entity_Name (Opnd)

                  and then

                    (Is_Known_Valid (Entity (Opnd))

                      or else Ekind (Entity (Opnd)) = E_In_Parameter

                      or else

                        (Ekind (Entity (Opnd)) in Object_Kind

                           and then Present (Current_Value (Entity (Opnd))))))

           or else Is_OK_Static_Expression (Opnd);

      end Is_Known_Valid_Operand;

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

      -- Is_Same_Value --

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

      function Is_Same_Value (L, R : Node_Id) return Boolean is

         Lf : constant Node_Id := Compare_Fixup (L);

         Rf : constant Node_Id := Compare_Fixup (R);

         function Is_Same_Subscript (L, R : List_Id) return Boolean;

         --  L, R are the Expressions values from two attribute nodes for First

         --  or Last attributes. Either may be set to No_List if no expressions

         --  are present (indicating subscript 1). The result is True if both

         --  expressions represent the same subscript (note one case is where

         --  one subscript is missing and the other is explicitly set to 1).

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

         -- Is_Same_Subscript --

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

         function Is_Same_Subscript (L, R : List_Id) return Boolean is

         begin

            if L = No_List then

               if R = No_List then

                  return True;

               else

                  return Expr_Value (First (R)) = Uint_1;

               end if;

            else

               if R = No_List then

                  return Expr_Value (First (L)) = Uint_1;

               else

                  return Expr_Value (First (L)) = Expr_Value (First (R));

               end if;

            end if;

         end Is_Same_Subscript;

      --  Start of processing for Is_Same_Value

      begin

         --  Values are the same if they refer to the same entity and the

         --  entity is non-volatile. This does not however apply to Float

         --  types, since we may have two NaN values and they should never

         --  compare equal.

         if Nkind_In (Lf, N_Identifier, N_Expanded_Name)

           and then Nkind_In (Rf, N_Identifier, N_Expanded_Name)

           and then Entity (Lf) = Entity (Rf)

           and then Present (Entity (Lf))

           and then not Is_Floating_Point_Type (Etype (L))

           and then not Is_Volatile_Reference (L)

           and then not Is_Volatile_Reference (R)

         then

            return True;

         --  Or if they are compile time known and identical

         elsif Compile_Time_Known_Value (Lf)

                 and then

               Compile_Time_Known_Value (Rf)

           and then Expr_Value (Lf) = Expr_Value (Rf)

         then

            return True;

         --  False if Nkind of the two nodes is different for remaining cases

         elsif Nkind (Lf) /= Nkind (Rf) then

            return False;

         --  True if both 'First or 'Last values applying to the same entity

         --  (first and last don't change even if value does). Note that we

         --  need this even with the calls to Compare_Fixup, to handle the

         --  case of unconstrained array attributes where Compare_Fixup

         --  cannot find useful bounds.

         elsif Nkind (Lf) = N_Attribute_Reference

           and then Attribute_Name (Lf) = Attribute_Name (Rf)

           and then (Attribute_Name (Lf) = Name_First

                       or else

                     Attribute_Name (Lf) = Name_Last)

           and then Nkind_In (Prefix (Lf), N_Identifier, N_Expanded_Name)

           and then Nkind_In (Prefix (Rf), N_Identifier, N_Expanded_Name)

           and then Entity (Prefix (Lf)) = Entity (Prefix (Rf))

           and then Is_Same_Subscript (Expressions (Lf), Expressions (Rf))

         then

            return True;

         --  True if the same selected component from the same record

         elsif Nkind (Lf) = N_Selected_Component

           and then Selector_Name (Lf) = Selector_Name (Rf)

           and then Is_Same_Value (Prefix (Lf), Prefix (Rf))

         then

            return True;

         --  True if the same unary operator applied to the same operand

         elsif Nkind (Lf) in N_Unary_Op

           and then Is_Same_Value (Right_Opnd (Lf), Right_Opnd (Rf))

         then

            return True;

         --  True if the same binary operator applied to the same operands

         elsif Nkind (Lf) in N_Binary_Op

           and then Is_Same_Value (Left_Opnd  (Lf), Left_Opnd  (Rf))

           and then Is_Same_Value (Right_Opnd (Lf), Right_Opnd (Rf))

         then

            return True;

         --  All other cases, we can't tell, so return False

         else

            return False;

         end if;

      end Is_Same_Value;

   --  Start of processing for Compile_Time_Compare

   begin

      Diff.all := No_Uint;

      --  If either operand could raise constraint error, then we cannot

      --  know the result at compile time (since CE may be raised!)

      if not (Cannot_Raise_Constraint_Error (L)

                and then

              Cannot_Raise_Constraint_Error (R))

      then

         return Unknown;

      end if;

      --  Identical operands are most certainly equal

      if L = R then

         return EQ;

      --  If expressions have no types, then do not attempt to determine if

      --  they are the same, since something funny is going on. One case in

      --  which this happens is during generic template analysis, when bounds

      --  are not fully analyzed.

      elsif No (Ltyp) or else No (Rtyp) then

         return Unknown;

      --  We do not attempt comparisons for packed arrays arrays represented as

      --  modular types, where the semantics of comparison is quite different.

      elsif Is_Packed_Array_Type (Ltyp)

        and then Is_Modular_Integer_Type (Ltyp)

      then

         return Unknown;

      --  For access types, the only time we know the result at compile time

      --  (apart from identical operands, which we handled already) is if we

      --  know one operand is null and the other is not, or both operands are

      --  known null.

      elsif Is_Access_Type (Ltyp) then

         if Known_Null (L) then

            if Known_Null (R) then

               return EQ;

            elsif Known_Non_Null (R) then

               return NE;

            else

               return Unknown;

            end if;

         elsif Known_Non_Null (L) and then Known_Null (R) then

            return NE;

         else

            return Unknown;

         end if;

      --  Case where comparison involves two compile time known values

      elsif Compile_Time_Known_Value (L)

        and then Compile_Time_Known_Value (R)

      then

         --  For the floating-point case, we have to be a little careful, since

         --  at compile time we are dealing with universal exact values, but at

         --  runtime, these will be in non-exact target form. That's why the

         --  returned results are LE and GE below instead of LT and GT.

         if Is_Floating_Point_Type (Ltyp)

              or else

            Is_Floating_Point_Type (Rtyp)

         then